XMode improvements

diff --git a/extra/xmode/keyword-map/keyword-map.factor b/extra/xmode/keyword-map/keyword-map.factor
index b75c24393c1f664bc512ca3e0d5a9e485db7aec3..350d8572a0a002804329bc07daee74d69bda611b 100644 (file)
--- a/extra/xmode/keyword-map/keyword-map.factor
+++ b/extra/xmode/keyword-map/keyword-map.factor
@@ -22,8 +22,6 @@ M: keyword-map set-at
 M: keyword-map clear-assoc
     [ delegate clear-assoc ] keep invalid-no-word-sep ;
 
-M: keyword-map assoc-find >r delegate r> assoc-find ;
-
 M: keyword-map >alist delegate >alist ;
 
 : (keyword-map-no-word-sep)

diff --git a/extra/xmode/loader/loader.factor b/extra/xmode/loader/loader.factor
index db3d0fbf416d9dce98d54e48e18ad28ca8e97c9d..ac1d1d66caf57d4e66eee2ee4101daa464f38a56 100755 (executable)
--- a/extra/xmode/loader/loader.factor
+++ b/extra/xmode/loader/loader.factor
@@ -1,11 +1,12 @@
-USING: xmode.tokens xmode.rules
-xmode.keyword-map xml.data xml.utilities xml assocs
-kernel combinators sequences math.parser namespaces parser
-xmode.utilities regexp io.files ;
+USING: xmode.tokens xmode.rules xmode.keyword-map xml.data
+xml.utilities xml assocs kernel combinators sequences
+math.parser namespaces parser xmode.utilities regexp io.files ;
 IN: xmode.loader
 
 ! Based on org.gjt.sp.jedit.XModeHandler
 
+SYMBOL: ignore-case?
+
 ! Attribute utilities
 : string>boolean ( string -- ? ) "TRUE" = ;
 
@@ -33,11 +34,11 @@ IN: xmode.loader
 
 : parse-literal-matcher ( tag -- matcher )
     dup children>string
-    \ ignore-case? get [ <ignore-case> ] when
+    ignore-case? get <string-matcher>
     swap position-attrs <matcher> ;
 
 : parse-regexp-matcher ( tag -- matcher )
-    dup children>string <regexp>
+    dup children>string ignore-case? get <regexp>
     swap position-attrs <matcher> ;
 
 ! SPAN's children
@@ -137,13 +138,13 @@ RULE: MARK_PREVIOUS mark-previous-rule
     >r dup name-tag string>token swap children>string r> set-at ;
 
 TAG: KEYWORDS ( rule-set tag -- key value )
-    \ ignore-case? get <keyword-map>
+    ignore-case? get <keyword-map>
     swap child-tags [ over parse-keyword-tag ] each
     swap set-rule-set-keywords ;
 
 TAGS>
 
-: ?<regexp> dup [ <regexp> ] when ;
+: ?<regexp> dup [ ignore-case? get <regexp> ] when ;
 
 : (parse-rules-tag) ( tag -- rule-set )
     <rule-set>
@@ -159,10 +160,9 @@ TAGS>
 
 : parse-rules-tag ( tag -- rule-set )
     dup (parse-rules-tag) [
-        [
-            dup rule-set-ignore-case? \ ignore-case? set
+        dup rule-set-ignore-case? ignore-case? [
             swap child-tags [ parse-rule-tag ] curry* each
-        ] with-scope
+        ] with-variable
     ] keep ;
 
 : merge-rule-set-props ( props rule-set -- )

diff --git a/extra/xmode/marker/marker.factor b/extra/xmode/marker/marker.factor
index dda5d64c9ccb3bf0ff3201fee2b7a361849256ee..fa77159f962a964848f22cb82ccbd34b4e9b1624 100755 (executable)
--- a/extra/xmode/marker/marker.factor
+++ b/extra/xmode/marker/marker.factor
@@ -1,8 +1,8 @@
 IN: xmode.marker
 USING: kernel namespaces xmode.rules xmode.tokens
-xmode.marker.state xmode.marker.context
-xmode.utilities xmode.catalog sequences math
-assocs combinators combinators.lib strings regexp splitting ;
+xmode.marker.state xmode.marker.context xmode.utilities
+xmode.catalog sequences math assocs combinators combinators.lib
+strings regexp splitting parser-combinators ;
 
 ! Based on org.gjt.sp.jedit.syntax.TokenMarker
 
@@ -62,31 +62,27 @@ M: rule match-position drop position get ;
         [ over matcher-at-word-start?     over last-offset get =    implies ]
     } && 2nip ;
 
-GENERIC: text-matches? ( position text -- match-count/f )
+: rest-of-line ( -- str )
+    line get position get tail-slice ;
 
-M: f text-matches? 2drop f ;
+GENERIC: text-matches? ( position text -- match-count/f )
 
-M: string text-matches?
-    >r line get swap tail-slice r>
-    [ head? ] keep length and ;
+M: f text-matches?
+    2drop f ;
 
-M: ignore-case text-matches?
-    >r line get swap tail-slice r>
-    ignore-case-string
-    2dup shorter? [
-        2drop f
-    ] [
-        [ length head-slice ] keep
-        [ [ >upper ] 2apply sequence= ] keep
-        length and
-    ] if ;
+M: string-matcher text-matches?
+    [
+        dup string-matcher-string
+        swap string-matcher-ignore-case?
+        string-head?
+    ] keep string-matcher-string length and ;
 
 M: regexp text-matches?
-    2drop f ; ! >r line get swap tail-slice r> match-head ;
+    match-head ;
 
 : rule-start-matches? ( rule -- match-count/f )
     dup rule-start tuck swap can-match-here? [
-        position get swap matcher-text text-matches?
+        rest-of-line swap matcher-text text-matches?
     ] [
         drop f
     ] if ;
@@ -96,8 +92,8 @@ M: regexp text-matches?
         dup rule-start swap can-match-here? 0 and
     ] [
         dup rule-end tuck swap can-match-here? [
-            position get swap matcher-text
-            context get line-context-end or
+            rest-of-line
+            swap matcher-text context get line-context-end or
             text-matches?
         ] [
             drop f

diff --git a/extra/xmode/marker/state/state.factor b/extra/xmode/marker/state/state.factor
index 958c23a2bc1d78578efa280eb22e8e18c9ef0a8e..fc731aba3474d971b6e08f9ccf116ae0b51e0829 100755 (executable)
--- a/extra/xmode/marker/state/state.factor
+++ b/extra/xmode/marker/state/state.factor
@@ -51,10 +51,6 @@ SYMBOL: delegate-end-escaped?
     dup context set
     f swap set-line-context-in-rule ;
 
-: terminal-rule-set ( -- rule-set )
-    get-rule-set rule-set-default standard-rule-set
-    push-context ;
-
 : init-token-marker ( prev-context line rules -- )
     rule-sets set
     line set

diff --git a/extra/xmode/rules/rules.factor b/extra/xmode/rules/rules.factor
index 906fba3140d2ed8a0c997f6dff4acf790776e844..85d50a5bbe93d22ce37f7cd50de7a75a690efab4 100755 (executable)
--- a/extra/xmode/rules/rules.factor
+++ b/extra/xmode/rules/rules.factor
@@ -2,9 +2,9 @@ USING: xmode.tokens xmode.keyword-map kernel
 sequences vectors assocs strings memoize regexp ;
 IN: xmode.rules
 
-TUPLE: ignore-case string ;
+TUPLE: string-matcher string ignore-case? ;
 
-C: <ignore-case> ignore-case
+C: <string-matcher> string-matcher
 
 ! Based on org.gjt.sp.jedit.syntax.ParserRuleSet
 TUPLE: rule-set
@@ -97,7 +97,7 @@ TUPLE: mark-previous-rule ;
 TUPLE: escape-rule ;
 
 : <escape-rule> ( string -- rule )
-    f f f <matcher>
+    f <string-matcher> f f f <matcher>
     escape-rule construct-rule
     [ set-rule-start ] keep ;
 
@@ -105,9 +105,7 @@ GENERIC: text-hash-char ( text -- ch )
 
 M: f text-hash-char ;
 
-M: string text-hash-char first ;
-
-M: ignore-case text-hash-char ignore-case-string first ;
+M: string-matcher text-hash-char string-matcher-string first ;
 
 M: regexp text-hash-char drop f ;
 
@@ -121,6 +119,10 @@ M: regexp text-hash-char drop f ;
     r> rule-set-rules inverted-index ;
 
 : add-escape-rule ( string ruleset -- )
-    >r <escape-rule> r>
-    2dup set-rule-set-escape-rule
-    add-rule ;
+    over [
+        >r <escape-rule> r>
+        2dup set-rule-set-escape-rule
+        add-rule
+    ] [
+        2drop
+    ] if ;