XMode loads now

extra/xmode/loader/loader.factor

@@ -1,59 +1,11 @@
-USING: xmode.tokens xmode.rules xmode.keyword-map xml.data
+USING: xmode.loader.syntax xmode.tokens xmode.rules
-xml.utilities xml assocs kernel combinators sequences
+xmode.keyword-map xml.data xml.utilities xml assocs kernel
-math.parser namespaces parser xmode.utilities regexp io.files ;
+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" = ;
-
-: string>match-type ( string -- obj )
-    {
-        { "RULE" [ f ] }
-        { "CONTEXT" [ t ] }
-        [ string>token ]
-    } case ;
-
-: string>rule-set-name "MAIN" or ;
-
-! PROP, PROPS
-: parse-prop-tag ( tag -- key value )
-    "NAME" over at "VALUE" rot at ;
-
-: parse-props-tag ( tag -- assoc )
-    child-tags
-    [ parse-prop-tag ] H{ } map>assoc ;
-
-: position-attrs ( tag -- at-line-start? at-whitespace-end? at-word-start? )
-    ! XXX Wrong logic!
-    { "AT_LINE_START" "AT_WHITESPACE_END" "AT_WORD_START" }
-    swap [ at string>boolean ] curry map first3 ;
-
-: parse-literal-matcher ( tag -- matcher )
-    dup children>string
-    ignore-case? get <string-matcher>
-    swap position-attrs <matcher> ;
-
-: parse-regexp-matcher ( tag -- matcher )
-    dup children>string ignore-case? get <regexp>
-    swap position-attrs <matcher> ;
-
-! SPAN's children
-<TAGS: parse-begin/end-tag
-
-TAG: BEGIN
-    ! XXX
-    parse-literal-matcher swap set-rule-start ;
-
-TAG: END
-    ! XXX
-    parse-literal-matcher swap set-rule-end ;
-
-TAGS>
-
 ! RULES and its children
 <TAGS: parse-rule-tag
 
@@ -66,56 +18,12 @@ TAG: IMPORT ( rule-set tag -- )
 TAG: TERMINATE ( rule-set tag -- )
     "AT_CHAR" swap at string>number swap set-rule-set-terminate-char ;
 
-: (parse-rule-tag) ( rule-set tag specs class -- )
-    construct-rule swap init-from-tag swap add-rule ; inline
-
-: RULE:
-    scan scan-word
-    parse-definition { } make
-    swap [ (parse-rule-tag) ] 2curry (TAG:) ; parsing
-
-: shared-tag-attrs
-    { "TYPE" string>token set-rule-body-token } , ; inline
-
-: delegate-attr
-    { "DELEGATE" f set-rule-delegate } , ;
-
-: regexp-attr
-    { "HASH_CHAR" f set-rule-chars } , ;
-
-: match-type-attr
-    { "MATCH_TYPE" string>match-type set-rule-match-token } , ;
-
-: span-attrs
-    { "NO_LINE_BREAK" string>boolean set-rule-no-line-break? } ,
-    { "NO_WORD_BREAK" string>boolean set-rule-no-word-break? } ,
-    { "NO_ESCAPE" string>boolean set-rule-no-escape? } , ;
-
-: literal-start
-    [ parse-literal-matcher swap set-rule-start ] , ;
-
-: regexp-start
-    [ parse-regexp-matcher swap set-rule-start ] , ;
-
-: literal-end
-    [ parse-literal-matcher swap set-rule-end ] , ;
-
 RULE: SEQ seq-rule
     shared-tag-attrs delegate-attr literal-start ;
 
 RULE: SEQ_REGEXP seq-rule
     shared-tag-attrs delegate-attr regexp-attr regexp-start ;
 
-: parse-begin/end-tags
-    [
-        ! XXX: handle position attrs on span tag itself
-        child-tags [ parse-begin/end-tag ] with each
-    ] , ;
-
-: init-span-tag [ drop init-span ] , ;
-
-: init-eol-span-tag [ drop init-eol-span ] , ;
-
 RULE: SPAN span-rule
     shared-tag-attrs delegate-attr match-type-attr span-attrs parse-begin/end-tags init-span-tag ;
 
@@ -134,9 +42,6 @@ RULE: MARK_FOLLOWING mark-following-rule
 RULE: MARK_PREVIOUS mark-previous-rule
     shared-tag-attrs match-type-attr literal-start ;
 
-: parse-keyword-tag ( tag keyword-map -- )
-    >r dup name-tag string>token swap children>string r> set-at ;
-
 TAG: KEYWORDS ( rule-set tag -- key value )
     ignore-case? get <keyword-map>
     swap child-tags [ over parse-keyword-tag ] each

extra/xmode/loader/syntax/syntax.factor

@@ -0,0 +1,101 @@
+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.syntax
+
+SYMBOL: ignore-case?
+
+! Rule tag parsing utilities
+: (parse-rule-tag) ( rule-set tag specs class -- )
+    construct-rule swap init-from-tag swap add-rule ; inline
+
+: RULE:
+    scan scan-word
+    parse-definition { } make
+    swap [ (parse-rule-tag) ] 2curry (TAG:) ; parsing
+
+! Attribute utilities
+: string>boolean ( string -- ? ) "TRUE" = ;
+
+: string>match-type ( string -- obj )
+    {
+        { "RULE" [ f ] }
+        { "CONTEXT" [ t ] }
+        [ string>token ]
+    } case ;
+
+: string>rule-set-name "MAIN" or ;
+
+! PROP, PROPS
+: parse-prop-tag ( tag -- key value )
+    "NAME" over at "VALUE" rot at ;
+
+: parse-props-tag ( tag -- assoc )
+    child-tags
+    [ parse-prop-tag ] H{ } map>assoc ;
+
+: position-attrs ( tag -- at-line-start? at-whitespace-end? at-word-start? )
+    ! XXX Wrong logic!
+    { "AT_LINE_START" "AT_WHITESPACE_END" "AT_WORD_START" }
+    swap [ at string>boolean ] curry map first3 ;
+
+: parse-literal-matcher ( tag -- matcher )
+    dup children>string
+    ignore-case? get <string-matcher>
+    swap position-attrs <matcher> ;
+
+: parse-regexp-matcher ( tag -- matcher )
+    dup children>string ignore-case? get <regexp>
+    swap position-attrs <matcher> ;
+
+: shared-tag-attrs
+    { "TYPE" string>token set-rule-body-token } , ; inline
+
+: delegate-attr
+    { "DELEGATE" f set-rule-delegate } , ;
+
+: regexp-attr
+    { "HASH_CHAR" f set-rule-chars } , ;
+
+: match-type-attr
+    { "MATCH_TYPE" string>match-type set-rule-match-token } , ;
+
+: span-attrs
+    { "NO_LINE_BREAK" string>boolean set-rule-no-line-break? } ,
+    { "NO_WORD_BREAK" string>boolean set-rule-no-word-break? } ,
+    { "NO_ESCAPE" string>boolean set-rule-no-escape? } , ;
+
+: literal-start
+    [ parse-literal-matcher swap set-rule-start ] , ;
+
+: regexp-start
+    [ parse-regexp-matcher swap set-rule-start ] , ;
+
+: literal-end
+    [ parse-literal-matcher swap set-rule-end ] , ;
+
+! SPAN's children
+<TAGS: parse-begin/end-tag
+
+TAG: BEGIN
+    ! XXX
+    parse-literal-matcher swap set-rule-start ;
+
+TAG: END
+    ! XXX
+    parse-literal-matcher swap set-rule-end ;
+
+TAGS>
+
+: parse-begin/end-tags
+    [
+        ! XXX: handle position attrs on span tag itself
+        child-tags [ parse-begin/end-tag ] with each
+    ] , ;
+
+: init-span-tag [ drop init-span ] , ;
+
+: init-eol-span-tag [ drop init-eol-span ] , ;
+
+: parse-keyword-tag ( tag keyword-map -- )
+    >r dup name-tag string>token swap children>string r> set-at ;

extra/xmode/tokens/tokens.factor

@@ -1,20 +1,18 @@
-USING: parser words sequences namespaces kernel assocs ;
+USING: parser words sequences namespaces kernel assocs
+compiler.units ;
 IN: xmode.tokens
 
 ! Based on org.gjt.sp.jedit.syntax.Token
 SYMBOL: tokens
 
-: string>token ( string -- id ) tokens get at ;
+[
-
+    { "COMMENT1" "COMMENT2" "COMMENT3" "COMMENT4" "DIGIT" "FUNCTION" "INVALID" "KEYWORD1" "KEYWORD2" "KEYWORD3" "KEYWORD4" "LABEL" "LITERAL1" "LITERAL2" "LITERAL3" "LITERAL4" "MARKUP" "OPERATOR" "END" "NULL" } [
-: TOKENS:
-    ";" parse-tokens [
         create-in dup define-symbol
         dup word-name swap
-    ] H{ } map>assoc tokens set-global ; parsing
+    ] H{ } map>assoc tokens set-global
+] with-compilation-unit
 
-TOKENS: COMMENT1 COMMENT2 COMMENT3 COMMENT4 DIGIT FUNCTION
+: string>token ( string -- id ) tokens get at ;
-INVALID KEYWORD1 KEYWORD2 KEYWORD3 KEYWORD4 LABEL LITERAL1
-LITERAL2 LITERAL3 LITERAL4 MARKUP OPERATOR END NULL ;
 
 TUPLE: token str id ;
 

extra/xmode/utilities/utilities.factor

@@ -55,4 +55,4 @@ SYMBOL: tag-handler-word
 : TAGS>
     tag-handler-word get
     tag-handlers get >alist [ >r dup name-tag r> case ] curry
-    define-compound ; parsing
+    define ; parsing