XMode fixes
parent
aa55747647
commit
ff7bf5d729
|
@ -1,5 +1,6 @@
|
|||
USING: xmode.loader xmode.utilities namespaces
|
||||
assocs sequences kernel io.files xml memoize words globs ;
|
||||
USING: xmode.loader xmode.utilities xmode.rules namespaces
|
||||
strings splitting assocs sequences kernel io.files xml memoize
|
||||
words globs ;
|
||||
IN: xmode.catalog
|
||||
|
||||
TUPLE: mode file file-name-glob first-line-glob ;
|
||||
|
@ -34,11 +35,60 @@ TAGS>
|
|||
: reset-catalog ( -- )
|
||||
f \ modes set-global ;
|
||||
|
||||
MEMO: load-mode ( name -- rule-sets )
|
||||
MEMO: (load-mode) ( name -- rule-sets )
|
||||
modes at mode-file
|
||||
"extra/xmode/modes/" swap append
|
||||
resource-path <file-reader> parse-mode ;
|
||||
|
||||
DEFER: load-mode
|
||||
|
||||
SYMBOL: rule-sets
|
||||
|
||||
: get-rule-set ( name -- rules )
|
||||
dup string? [
|
||||
"::" split1 [ swap load-mode ] [ rule-sets get ] if* at
|
||||
] when ;
|
||||
|
||||
: resolve-delegate ( rule -- )
|
||||
dup rule-delegate dup
|
||||
[ get-rule-set swap set-rule-delegate ] [ 2drop ] if ;
|
||||
|
||||
: each-rule ( rule-set quot -- )
|
||||
>r rule-set-rules values concat r> each ; inline
|
||||
|
||||
: resolve-delegates ( ruleset -- )
|
||||
[ resolve-delegate ] each-rule ;
|
||||
|
||||
: ?update ( keyword-map/f keyword-map -- keyword-map )
|
||||
over [ dupd update ] [ nip clone ] if ;
|
||||
|
||||
: import-keywords ( parent child -- )
|
||||
over >r [ rule-set-keywords ] 2apply ?update
|
||||
r> set-rule-set-keywords ;
|
||||
|
||||
: import-rules ( parent child -- )
|
||||
swap [ add-rule ] curry each-rule ;
|
||||
|
||||
: resolve-imports ( ruleset -- )
|
||||
dup rule-set-imports [
|
||||
get-rule-set
|
||||
dup resolve-delegates
|
||||
2dup import-keywords
|
||||
import-rules
|
||||
] curry* each ;
|
||||
|
||||
: finalize-rule-set ( ruleset -- )
|
||||
dup rule-set-finalized? [ drop ] [
|
||||
t over set-rule-set-finalized?
|
||||
dup resolve-imports
|
||||
resolve-delegates
|
||||
] if ;
|
||||
|
||||
: load-mode ( name -- rule-sets )
|
||||
(load-mode) dup rule-sets [
|
||||
dup [ nip finalize-rule-set ] assoc-each
|
||||
] with-variable ;
|
||||
|
||||
: reset-modes ( -- )
|
||||
\ load-mode "memoize" word-prop clear-assoc ;
|
||||
|
||||
|
|
|
@ -127,3 +127,9 @@ IN: temporary
|
|||
] [
|
||||
f "Comment {XXX}" "rebol" load-mode tokenize-line nip
|
||||
] unit-test
|
||||
|
||||
[
|
||||
|
||||
] [
|
||||
f "font:75%/1.6em \"Lucida Grande\", \"Lucida Sans Unicode\", verdana, geneva, sans-serif;" "css" load-mode tokenize-line 2drop
|
||||
] unit-test
|
||||
|
|
|
@ -24,18 +24,8 @@ strings regexp splitting parser-combinators ;
|
|||
: mark-number ( keyword -- id )
|
||||
keyword-number? DIGIT and ;
|
||||
|
||||
: resolve-delegate ( name -- rules )
|
||||
dup string? [
|
||||
"::" split1 [ swap load-mode ] [ rule-sets get ] if* at
|
||||
] when ;
|
||||
|
||||
: rule-set-keyword-maps ( ruleset -- seq )
|
||||
dup rule-set-imports
|
||||
[ resolve-delegate rule-set-keyword-maps ] map concat
|
||||
swap rule-set-keywords add ;
|
||||
|
||||
: mark-keyword ( keyword -- id )
|
||||
current-rule-set rule-set-keyword-maps assoc-stack ;
|
||||
current-rule-set rule-set-keywords at ;
|
||||
|
||||
: add-remaining-token ( -- )
|
||||
current-rule-set rule-set-default prev-token, ;
|
||||
|
@ -102,10 +92,6 @@ M: regexp text-matches?
|
|||
|
||||
DEFER: get-rules
|
||||
|
||||
: get-imported-rules ( vector/f char ruleset -- vector/f )
|
||||
rule-set-imports
|
||||
[ resolve-delegate get-rules ?push-all ] curry* each ;
|
||||
|
||||
: get-always-rules ( vector/f ruleset -- vector/f )
|
||||
f swap rule-set-rules at ?push-all ;
|
||||
|
||||
|
@ -113,10 +99,7 @@ DEFER: get-rules
|
|||
>r ch>upper r> rule-set-rules at ?push-all ;
|
||||
|
||||
: get-rules ( char ruleset -- seq )
|
||||
f -rot
|
||||
[ get-char-rules ] 2keep
|
||||
[ get-always-rules ] keep
|
||||
get-imported-rules ;
|
||||
f -rot [ get-char-rules ] keep get-always-rules ;
|
||||
|
||||
GENERIC: handle-rule-start ( match-count rule -- )
|
||||
|
||||
|
@ -173,7 +156,7 @@ M: seq-rule handle-rule-start
|
|||
mark-token
|
||||
add-remaining-token
|
||||
tuck rule-body-token next-token,
|
||||
rule-delegate [ resolve-delegate push-context ] when* ;
|
||||
rule-delegate [ push-context ] when* ;
|
||||
|
||||
UNION: abstract-span-rule span-rule eol-span-rule ;
|
||||
|
||||
|
@ -184,7 +167,7 @@ M: abstract-span-rule handle-rule-start
|
|||
tuck rule-match-token* next-token,
|
||||
! ... end subst ...
|
||||
dup context get set-line-context-in-rule
|
||||
rule-delegate resolve-delegate push-context ;
|
||||
rule-delegate push-context ;
|
||||
|
||||
M: span-rule handle-rule-end
|
||||
2drop ;
|
||||
|
@ -230,10 +213,12 @@ M: mark-previous-rule handle-rule-start
|
|||
|
||||
: handle-no-word-break ( -- )
|
||||
context get line-context-parent [
|
||||
line-context-in-rule dup rule-no-word-break? [
|
||||
rule-match-token* prev-token,
|
||||
pop-context
|
||||
] [ drop ] if
|
||||
line-context-in-rule [
|
||||
dup rule-no-word-break? [
|
||||
rule-match-token* prev-token,
|
||||
pop-context
|
||||
] [ drop ] if
|
||||
] when*
|
||||
] when* ;
|
||||
|
||||
: check-rule ( -- )
|
||||
|
@ -300,14 +285,17 @@ M: mark-previous-rule handle-rule-start
|
|||
|
||||
: unwind-no-line-break ( -- )
|
||||
context get line-context-parent [
|
||||
line-context-in-rule rule-no-line-break? [
|
||||
pop-context
|
||||
unwind-no-line-break
|
||||
] when
|
||||
line-context-in-rule [
|
||||
rule-no-line-break? [
|
||||
pop-context
|
||||
unwind-no-line-break
|
||||
] when
|
||||
] when*
|
||||
] when* ;
|
||||
|
||||
: tokenize-line ( line-context line rules -- line-context' seq )
|
||||
[
|
||||
"MAIN" swap at -rot
|
||||
init-token-marker
|
||||
mark-token-loop
|
||||
mark-remaining
|
||||
|
|
|
@ -4,7 +4,6 @@ IN: xmode.marker.state
|
|||
|
||||
! Based on org.gjt.sp.jedit.syntax.TokenMarker
|
||||
|
||||
SYMBOL: rule-sets
|
||||
SYMBOL: line
|
||||
SYMBOL: last-offset
|
||||
SYMBOL: position
|
||||
|
@ -37,12 +36,6 @@ SYMBOL: delegate-end-escaped?
|
|||
>r position get 2dup + r> token,
|
||||
position get + dup 1- position set last-offset set ;
|
||||
|
||||
: get-rule-set ( name -- rule-set )
|
||||
rule-sets get at ;
|
||||
|
||||
: main-rule-set ( -- rule-set )
|
||||
"MAIN" get-rule-set ;
|
||||
|
||||
: push-context ( rules -- )
|
||||
context [ <line-context> ] change ;
|
||||
|
||||
|
@ -51,12 +44,10 @@ SYMBOL: delegate-end-escaped?
|
|||
dup context set
|
||||
f swap set-line-context-in-rule ;
|
||||
|
||||
: init-token-marker ( prev-context line rules -- )
|
||||
rule-sets set
|
||||
: init-token-marker ( main prev-context line -- )
|
||||
line set
|
||||
[ ] [ f <line-context> ] ?if context set
|
||||
0 position set
|
||||
0 last-offset set
|
||||
0 whitespace-end set
|
||||
process-escape? on
|
||||
[ clone ] [ main-rule-set f <line-context> ] if*
|
||||
context set ;
|
||||
process-escape? on ;
|
||||
|
|
|
@ -125,6 +125,9 @@
|
|||
<MODE NAME="eiffel" FILE="eiffel.xml"
|
||||
FILE_NAME_GLOB="*.e" />
|
||||
|
||||
<MODE NAME="fhtml" FILE="fhtml.xml"
|
||||
FILE_NAME_GLOB="*.{furnace,fhtml}" />
|
||||
|
||||
<MODE NAME="factor" FILE="factor.xml"
|
||||
FILE_NAME_GLOB="*.factor"/>
|
||||
|
||||
|
|
|
@ -1,25 +1,24 @@
|
|||
<?xml version="1.0"?>
|
||||
|
||||
<!DOCTYPE MODE SYSTEM "xmode.dtd">
|
||||
|
||||
<!-- fhtml (factor+html) mode -->
|
||||
|
||||
<MODE>
|
||||
<PROPS>
|
||||
<PROPERTY NAME="commentStart" VALUE="<!--" />
|
||||
<PROPERTY NAME="commentEnd" VALUE="-->" />
|
||||
<PROPERTY NAME="commentStart" VALUE="<%#" />
|
||||
<PROPERTY NAME="commentEnd" VALUE="%>" />
|
||||
<PROPERTY NAME="tabSize" VALUE="4" />
|
||||
<PROPERTY NAME="noTabs" VALUE="true" />
|
||||
</PROPS>
|
||||
<RULES IGNORE_CASE="TRUE">
|
||||
<SPAN TYPE="MARKUP" DELEGATE="factor::MAIN">
|
||||
<BEGIN><%</BEGIN>
|
||||
<END>%></END>
|
||||
</SPAN>
|
||||
|
||||
<IMPORT DELEGATE="html::MAIN" />
|
||||
</RULES>
|
||||
</MODE>
|
||||
|
||||
<?xml version="1.0"?>
|
||||
|
||||
<!DOCTYPE MODE SYSTEM "xmode.dtd">
|
||||
|
||||
<!-- fhtml (factor+html) mode -->
|
||||
|
||||
<MODE>
|
||||
<PROPS>
|
||||
<PROPERTY NAME="commentStart" VALUE="<!--" />
|
||||
<PROPERTY NAME="commentEnd" VALUE="-->" />
|
||||
<PROPERTY NAME="commentStart" VALUE="<%#" />
|
||||
<PROPERTY NAME="commentEnd" VALUE="%>" />
|
||||
<PROPERTY NAME="tabSize" VALUE="4" />
|
||||
<PROPERTY NAME="noTabs" VALUE="true" />
|
||||
</PROPS>
|
||||
<RULES IGNORE_CASE="TRUE">
|
||||
<SPAN TYPE="MARKUP" DELEGATE="factor::MAIN">
|
||||
<BEGIN><%</BEGIN>
|
||||
<END>%></END>
|
||||
</SPAN>
|
||||
|
||||
<IMPORT DELEGATE="html::MAIN" />
|
||||
</RULES>
|
||||
</MODE>
|
||||
|
|
|
@ -20,6 +20,7 @@ escape-rule
|
|||
highlight-digits?
|
||||
digit-re
|
||||
no-word-sep
|
||||
finalized?
|
||||
;
|
||||
|
||||
: init-rule-set ( ruleset -- )
|
||||
|
|
|
@ -2,7 +2,7 @@ IN: temporary
|
|||
USING: xmode.utilities tools.test xml xml.data
|
||||
kernel strings vectors sequences io.files prettyprint assocs ;
|
||||
|
||||
[ 3 "hi" ] [
|
||||
[ "hi" 3 ] [
|
||||
{ 1 2 3 4 5 6 7 8 } [ H{ { 3 "hi" } } at ] map-find
|
||||
] unit-test
|
||||
|
||||
|
|
Loading…
Reference in New Issue