basis/xmode/loader/loader.factor

   1 USING: accessors assocs kernel math.parser namespaces sequences
   2 xml xml.data xml.syntax xml.traversal xmode.keyword-map
   3 xmode.loader.syntax xmode.rules xmode.tokens xmode.utilities ;
   4 IN: xmode.loader
   5
   6 ! Based on org.gjt.sp.jedit.XModeHandler
   7
   8 ! RULES and its children
   9 TAGS: parse-rule-tag ( rule-set tag -- )
  10
  11 TAG: PROPS parse-rule-tag
  12     parse-props-tag >>props drop ;
  13
  14 TAG: IMPORT parse-rule-tag
  15     "DELEGATE" attr swap import-rule-set ;
  16
  17 TAG: TERMINATE parse-rule-tag
  18     "AT_CHAR" attr string>number >>terminate-char drop ;
  19
  20 RULE: SEQ seq-rule parse-rule-tag
  21     shared-tag-attrs delegate-attr literal-start ;
  22
  23 RULE: SEQ_REGEXP seq-rule parse-rule-tag
  24     shared-tag-attrs delegate-attr regexp-attr regexp-start ;
  25
  26 RULE: SPAN span-rule parse-rule-tag
  27     shared-tag-attrs delegate-attr match-type-attr span-attrs parse-begin/end-tags init-span-tag ;
  28
  29 RULE: SPAN_REGEXP span-rule parse-rule-tag
  30     shared-tag-attrs delegate-attr match-type-attr span-attrs regexp-attr parse-begin/end-tags init-span-tag ;
  31
  32 RULE: EOL_SPAN eol-span-rule parse-rule-tag
  33     shared-tag-attrs delegate-attr match-type-attr literal-start init-eol-span-tag ;
  34
  35 RULE: EOL_SPAN_REGEXP eol-span-rule parse-rule-tag
  36     shared-tag-attrs delegate-attr match-type-attr regexp-attr regexp-start init-eol-span-tag ;
  37
  38 RULE: MARK_FOLLOWING mark-following-rule parse-rule-tag
  39     shared-tag-attrs match-type-attr literal-start ;
  40
  41 RULE: MARK_PREVIOUS mark-previous-rule parse-rule-tag
  42     shared-tag-attrs match-type-attr literal-start ;
  43
  44 TAG: KEYWORDS parse-rule-tag
  45     rule-set get ignore-case?>> <keyword-map>
  46     swap children-tags [ over parse-keyword-tag ] each
  47     swap keywords<< ;
  48
  49 : ?<regexp> ( string/f -- regexp/f )
  50     dup [ rule-set get ignore-case?>> <?insensitive-regexp> ] when ;
  51
  52 : (parse-rules-tag) ( tag -- rule-set )
  53     rule-set get {
  54         { "SET" string>rule-set-name name<< }
  55         { "IGNORE_CASE" string>boolean ignore-case?<< }
  56         { "HIGHLIGHT_DIGITS" string>boolean highlight-digits?<< }
  57         { "DIGIT_RE" ?<regexp> digit-re<< }
  58         { "ESCAPE" f add-escape-rule }
  59         { "DEFAULT" string>token default<< }
  60         { "NO_WORD_SEP" f no-word-sep<< }
  61     } init-from-tag ;
  62
  63 : parse-rules-tag ( tag -- rule-set )
  64     <rule-set> rule-set [
  65         [ (parse-rules-tag) ] [ children-tags ] bi
  66         [ parse-rule-tag ] with each
  67         rule-set get
  68     ] with-variable ;
  69
  70 : merge-rule-set-props ( props rule-set -- )
  71     [ assoc-union ] change-props drop ;
  72
  73 ! Top-level entry points
  74 : parse-mode-tag ( tag -- rule-sets )
  75     dup "RULES" tags-named [
  76         parse-rules-tag [ name>> ] keep
  77     ] H{ } map>assoc
  78     swap "PROPS" tag-named [
  79         parse-props-tag over values
  80         [ merge-rule-set-props ] with each
  81     ] when* ;
  82
  83 : parse-mode ( filename -- rule-sets )
  84     file>xml parse-mode-tag ;