steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

XMode fixes

release
Slava Pestov 2007-12-10 02:20:36 -05:00
parent aa55747647
commit ff7bf5d729
8 changed files with 108 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
extra/xmode/catalog/catalog.factor
View File

@ -1,5 +1,6 @@
USING: xmode.loader xmode.utilities namespaces USING: xmode.loader xmode.utilities xmode.rules namespaces
assocs sequences kernel io.files xml memoize words globs ; strings splitting assocs sequences kernel io.files xml memoize
words globs ;
IN: xmode.catalog IN: xmode.catalog
TUPLE: mode file file-name-glob first-line-glob ; TUPLE: mode file file-name-glob first-line-glob ;
@ -34,11 +35,60 @@ TAGS>
: reset-catalog ( -- ) : reset-catalog ( -- )
f \ modes set-global ; f \ modes set-global ;
MEMO: load-mode ( name -- rule-sets ) MEMO: (load-mode) ( name -- rule-sets )
modes at mode-file modes at mode-file
"extra/xmode/modes/" swap append "extra/xmode/modes/" swap append
resource-path <file-reader> parse-mode ; 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 ( -- ) : reset-modes ( -- )
\ load-mode "memoize" word-prop clear-assoc ; \ load-mode "memoize" word-prop clear-assoc ;

6
extra/xmode/marker/marker-tests.factor
View File

@ -127,3 +127,9 @@ IN: temporary
] [ ] [
f "Comment {XXX}" "rebol" load-mode tokenize-line nip f "Comment {XXX}" "rebol" load-mode tokenize-line nip
] unit-test ] unit-test
[
] [
f "font:75%/1.6em \"Lucida Grande\", \"Lucida Sans Unicode\", verdana, geneva, sans-serif;" "css" load-mode tokenize-line 2drop
] unit-test

46
extra/xmode/marker/marker.factor
View File

@ -24,18 +24,8 @@ strings regexp splitting parser-combinators ;
: mark-number ( keyword -- id ) : mark-number ( keyword -- id )
keyword-number? DIGIT and ; 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 ) : mark-keyword ( keyword -- id )
current-rule-set rule-set-keyword-maps assoc-stack ; current-rule-set rule-set-keywords at ;
: add-remaining-token ( -- ) : add-remaining-token ( -- )
current-rule-set rule-set-default prev-token, ; current-rule-set rule-set-default prev-token, ;
@ -102,10 +92,6 @@ M: regexp text-matches?
DEFER: get-rules 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 ) : get-always-rules ( vector/f ruleset -- vector/f )
f swap rule-set-rules at ?push-all ; 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 ; >r ch>upper r> rule-set-rules at ?push-all ;
: get-rules ( char ruleset -- seq ) : get-rules ( char ruleset -- seq )
f -rot f -rot [ get-char-rules ] keep get-always-rules ;
[ get-char-rules ] 2keep
[ get-always-rules ] keep
get-imported-rules ;
GENERIC: handle-rule-start ( match-count rule -- ) GENERIC: handle-rule-start ( match-count rule -- )
@ -173,7 +156,7 @@ M: seq-rule handle-rule-start
mark-token mark-token
add-remaining-token add-remaining-token
tuck rule-body-token next-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 ; 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, tuck rule-match-token* next-token,
! ... end subst ... ! ... end subst ...
dup context get set-line-context-in-rule dup context get set-line-context-in-rule
rule-delegate resolve-delegate push-context ; rule-delegate push-context ;
M: span-rule handle-rule-end M: span-rule handle-rule-end
2drop ; 2drop ;
@ -230,10 +213,12 @@ M: mark-previous-rule handle-rule-start
: handle-no-word-break ( -- ) : handle-no-word-break ( -- )
context get line-context-parent [ context get line-context-parent [
line-context-in-rule dup rule-no-word-break? [ line-context-in-rule [
rule-match-token* prev-token, dup rule-no-word-break? [
pop-context rule-match-token* prev-token,
] [ drop ] if pop-context
] [ drop ] if
] when*
] when* ; ] when* ;
: check-rule ( -- ) : check-rule ( -- )
@ -300,14 +285,17 @@ M: mark-previous-rule handle-rule-start
: unwind-no-line-break ( -- ) : unwind-no-line-break ( -- )
context get line-context-parent [ context get line-context-parent [
line-context-in-rule rule-no-line-break? [ line-context-in-rule [
pop-context rule-no-line-break? [
unwind-no-line-break pop-context
] when unwind-no-line-break
] when
] when*
] when* ; ] when* ;
: tokenize-line ( line-context line rules -- line-context' seq ) : tokenize-line ( line-context line rules -- line-context' seq )
[ [
"MAIN" swap at -rot
init-token-marker init-token-marker
mark-token-loop mark-token-loop
mark-remaining mark-remaining

15
extra/xmode/marker/state/state.factor
View File

@ -4,7 +4,6 @@ IN: xmode.marker.state
! Based on org.gjt.sp.jedit.syntax.TokenMarker ! Based on org.gjt.sp.jedit.syntax.TokenMarker
SYMBOL: rule-sets
SYMBOL: line SYMBOL: line
SYMBOL: last-offset SYMBOL: last-offset
SYMBOL: position SYMBOL: position
@ -37,12 +36,6 @@ SYMBOL: delegate-end-escaped?
>r position get 2dup + r> token, >r position get 2dup + r> token,
position get + dup 1- position set last-offset set ; 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 -- ) : push-context ( rules -- )
context [ <line-context> ] change ; context [ <line-context> ] change ;
@ -51,12 +44,10 @@ SYMBOL: delegate-end-escaped?
dup context set dup context set
f swap set-line-context-in-rule ; f swap set-line-context-in-rule ;
: init-token-marker ( prev-context line rules -- ) : init-token-marker ( main prev-context line -- )
rule-sets set
line set line set
[ ] [ f <line-context> ] ?if context set
0 position set 0 position set
0 last-offset set 0 last-offset set
0 whitespace-end set 0 whitespace-end set
process-escape? on process-escape? on ;
[ clone ] [ main-rule-set f <line-context> ] if*
context set ;

3
extra/xmode/modes/catalog
View File

@ -125,6 +125,9 @@
<MODE NAME="eiffel" FILE="eiffel.xml" <MODE NAME="eiffel" FILE="eiffel.xml"
FILE_NAME_GLOB="*.e" /> FILE_NAME_GLOB="*.e" />
<MODE NAME="fhtml" FILE="fhtml.xml"
FILE_NAME_GLOB="*.{furnace,fhtml}" />
<MODE NAME="factor" FILE="factor.xml" <MODE NAME="factor" FILE="factor.xml"
FILE_NAME_GLOB="*.factor"/> FILE_NAME_GLOB="*.factor"/>

31
extra/xmode/modes/fhtml.xml
View File

@ -5,21 +5,20 @@
<!-- fhtml (factor+html) mode --> <!-- fhtml (factor+html) mode -->
<MODE> <MODE>
<PROPS> <PROPS>
<PROPERTY NAME="commentStart" VALUE="&lt;!--" /> <PROPERTY NAME="commentStart" VALUE="&lt;!--" />
<PROPERTY NAME="commentEnd" VALUE="--&gt;" /> <PROPERTY NAME="commentEnd" VALUE="--&gt;" />
<PROPERTY NAME="commentStart" VALUE="&lt;%#" /> <PROPERTY NAME="commentStart" VALUE="&lt;%#" />
<PROPERTY NAME="commentEnd" VALUE="%&gt;" /> <PROPERTY NAME="commentEnd" VALUE="%&gt;" />
<PROPERTY NAME="tabSize" VALUE="4" /> <PROPERTY NAME="tabSize" VALUE="4" />
<PROPERTY NAME="noTabs" VALUE="true" /> <PROPERTY NAME="noTabs" VALUE="true" />
</PROPS> </PROPS>
<RULES IGNORE_CASE="TRUE"> <RULES IGNORE_CASE="TRUE">
<SPAN TYPE="MARKUP" DELEGATE="factor::MAIN"> <SPAN TYPE="MARKUP" DELEGATE="factor::MAIN">
<BEGIN>&lt;%</BEGIN> <BEGIN>&lt;%</BEGIN>
<END>%&gt;</END> <END>%&gt;</END>
</SPAN> </SPAN>
<IMPORT DELEGATE="html::MAIN" /> <IMPORT DELEGATE="html::MAIN" />
</RULES> </RULES>
</MODE> </MODE>

1
extra/xmode/rules/rules.factor
View File

@ -20,6 +20,7 @@ escape-rule
highlight-digits? highlight-digits?
digit-re digit-re
no-word-sep no-word-sep
finalized?
; ;
: init-rule-set ( ruleset -- ) : init-rule-set ( ruleset -- )

2
extra/xmode/utilities/utilities-tests.factor
View File

@ -2,7 +2,7 @@ IN: temporary
USING: xmode.utilities tools.test xml xml.data USING: xmode.utilities tools.test xml xml.data
kernel strings vectors sequences io.files prettyprint assocs ; 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 { 1 2 3 4 5 6 7 8 } [ H{ { 3 "hi" } } at ] map-find
] unit-test ] unit-test