XMode fixes

2007-12-10 02:20:36 -05:00 · 2007-12-10 02:20:36 -05:00 · ff7bf5d729
parent aa55747647
commit ff7bf5d729
8 changed files with 108 additions and 70 deletions
--- a/extra/xmode/catalog/catalog.factor
+++ b/extra/xmode/catalog/catalog.factor
@ -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 ;

--- a/extra/xmode/marker/marker-tests.factor
+++ b/extra/xmode/marker/marker-tests.factor
@ -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
--- a/extra/xmode/marker/marker.factor
+++ b/extra/xmode/marker/marker.factor
@ -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
--- a/extra/xmode/marker/state/state.factor
+++ b/extra/xmode/marker/state/state.factor
@ -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 ;
--- a/extra/xmode/modes/catalog
+++ b/extra/xmode/modes/catalog
@ -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"/>

--- a/extra/xmode/modes/fhtml.xml
+++ b/extra/xmode/modes/fhtml.xml
@ -1,25 +1,24 @@
-<?xml version="1.0"?>
-
-<!DOCTYPE MODE SYSTEM "xmode.dtd">
-
-<!-- fhtml (factor+html) mode -->
-
-<MODE>
-        <PROPS>
-                <PROPERTY NAME="commentStart" VALUE="&lt;!--" />
-                <PROPERTY NAME="commentEnd" VALUE="--&gt;" />
-                <PROPERTY NAME="commentStart" VALUE="&lt;%#" />
-                <PROPERTY NAME="commentEnd" VALUE="%&gt;" />
-                <PROPERTY NAME="tabSize" VALUE="4" />
-                <PROPERTY NAME="noTabs" VALUE="true" />
-        </PROPS>
-        <RULES IGNORE_CASE="TRUE">
-                <SPAN TYPE="MARKUP" DELEGATE="factor::MAIN">
-                        <BEGIN>&lt;%</BEGIN>
-                        <END>%&gt;</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="&lt;!--" />
+		<PROPERTY NAME="commentEnd" VALUE="--&gt;" />
+		<PROPERTY NAME="commentStart" VALUE="&lt;%#" />
+		<PROPERTY NAME="commentEnd" VALUE="%&gt;" />
+		<PROPERTY NAME="tabSize" VALUE="4" />
+		<PROPERTY NAME="noTabs" VALUE="true" />
+	</PROPS>
+	<RULES IGNORE_CASE="TRUE">
+		<SPAN TYPE="MARKUP" DELEGATE="factor::MAIN">
+			<BEGIN>&lt;%</BEGIN>
+			<END>%&gt;</END>
+		</SPAN>
+
+		<IMPORT DELEGATE="html::MAIN" />
+	</RULES>
+</MODE>
--- a/extra/xmode/rules/rules.factor
+++ b/extra/xmode/rules/rules.factor
@ -20,6 +20,7 @@ escape-rule
 highlight-digits?
 digit-re
 no-word-sep
+finalized?
 ;

 : init-rule-set ( ruleset -- )
--- a/extra/xmode/utilities/utilities-tests.factor
+++ b/extra/xmode/utilities/utilities-tests.factor
@ -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