XMode fixes

diff --git a/extra/xmode/catalog/catalog.factor b/extra/xmode/catalog/catalog.factor
index 866bd6910696732935f5a3e0cdf941476bd864d2..d880ca3789c27a4d195caeedf26e28eb205437fb 100644 (file)
--- 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 ;
 

diff --git a/extra/xmode/marker/marker-tests.factor b/extra/xmode/marker/marker-tests.factor
index 5b0aff2050c8fa042f7f6cf935ae64f05b83afbc..b9621a112a1f7803d9d0aa86bab6e5d6c0631757 100755 (executable)
--- 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

diff --git a/extra/xmode/marker/marker.factor b/extra/xmode/marker/marker.factor
index b22844b45b4a7e5d6aacb17a7e10d3d714629baa..b8331fe6b6bead84a1722deebd53b3354d707ae9 100755 (executable)
--- 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

diff --git a/extra/xmode/marker/state/state.factor b/extra/xmode/marker/state/state.factor
index fc731aba3474d971b6e08f9ccf116ae0b51e0829..35e6bbef188c3a1b4d10d07d07811b5842cbc35c 100755 (executable)
--- 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 ;

diff --git a/extra/xmode/modes/catalog b/extra/xmode/modes/catalog
index cd1da3dd1ff5eb353fd1c517c8897ef189510db7..f4300b456bbed8fd605b0d4118451ffdd9d54867 100644 (file)
--- a/extra/xmode/modes/catalog
+++ b/extra/xmode/modes/catalog
@@ -125,6 +125,9 @@
 <MODE NAME="eiffel"            FILE="eiffel.xml"\r
                                FILE_NAME_GLOB="*.e" />\r
 \r
+<MODE NAME="fhtml"             FILE="fhtml.xml"\r
+                               FILE_NAME_GLOB="*.{furnace,fhtml}" />\r
+\r
 <MODE NAME="factor"            FILE="factor.xml"\r
                                FILE_NAME_GLOB="*.factor"/>\r
 \r

diff --git a/extra/xmode/modes/fhtml.xml b/extra/xmode/modes/fhtml.xml
index 23abd4f70ae53331210aa4e28da9b47d5608177c..68646e2321f80e3e39a9f6a9c39057acca722b8e 100644 (file)
--- a/extra/xmode/modes/fhtml.xml
+++ b/extra/xmode/modes/fhtml.xml
@@ -1,25 +1,24 @@
-<?xml version="1.0"?>\r
-\r
-<!DOCTYPE MODE SYSTEM "xmode.dtd">\r
-\r
-<!-- fhtml (factor+html) mode -->\r
-\r
-<MODE>\r
-        <PROPS>\r
-                <PROPERTY NAME="commentStart" VALUE="&lt;!--" />\r
-                <PROPERTY NAME="commentEnd" VALUE="--&gt;" />\r
-                <PROPERTY NAME="commentStart" VALUE="&lt;%#" />\r
-                <PROPERTY NAME="commentEnd" VALUE="%&gt;" />\r
-                <PROPERTY NAME="tabSize" VALUE="4" />\r
-                <PROPERTY NAME="noTabs" VALUE="true" />\r
-        </PROPS>\r
-        <RULES IGNORE_CASE="TRUE">\r
-                <SPAN TYPE="MARKUP" DELEGATE="factor::MAIN">\r
-                        <BEGIN>&lt;%</BEGIN>\r
-                        <END>%&gt;</END>\r
-                </SPAN>\r
-\r
-                <IMPORT DELEGATE="html::MAIN" />\r
-        </RULES>\r
-</MODE>\r
-\r
+<?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>

diff --git a/extra/xmode/rules/rules.factor b/extra/xmode/rules/rules.factor
index 85d50a5bbe93d22ce37f7cd50de7a75a690efab4..acc6308c6fed88ebf39732960dbd229a4d8236b7 100755 (executable)
--- 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 -- )

diff --git a/extra/xmode/utilities/utilities-tests.factor b/extra/xmode/utilities/utilities-tests.factor
index ed8193cdcf3cc69e70ec2500472f6164e8e4b663..d31aac64ae83f41634e1444a8bda8eed73ffb25f 100644 (file)
--- 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