1 USING: accessors xmode.tokens xmode.keyword-map kernel
2 sequences vectors assocs strings memoize unicode.case
3 regexp regexp.backend ; ! regexp.backend has the regexp class
6 TUPLE: string-matcher string ignore-case? ;
8 C: <string-matcher> string-matcher
10 ! Based on org.gjt.sp.jedit.syntax.ParserRuleSet
27 : <rule-set> ( -- ruleset )
31 V{ } clone >>imports ;
33 MEMO: standard-rule-set ( id -- ruleset )
34 <rule-set> swap >>default ;
36 : import-rule-set ( import ruleset -- )
39 : inverted-index ( hashes key index -- )
40 [ swapd push-at ] 2curry each ;
42 : ?push-all ( seq1 seq2 -- seq1+seq2 )
44 over [ [ V{ } like ] dip over push-all ] [ nip ] if
47 : rule-set-no-word-sep* ( ruleset -- str )
50 dup [ keyword-map-no-word-sep* ] when
54 TUPLE: matcher text at-line-start? at-whitespace-end? at-word-start? ;
58 ! Based on org.gjt.sp.jedit.syntax.ParserRule
71 TUPLE: seq-rule < rule ;
73 TUPLE: span-rule < rule ;
75 TUPLE: eol-span-rule < rule ;
77 : init-span ( rule -- )
78 dup delegate>> [ drop ] [
79 dup body-token>> standard-rule-set
83 : init-eol-span ( rule -- )
85 t >>no-line-break? drop ;
87 TUPLE: mark-following-rule < rule ;
89 TUPLE: mark-previous-rule < rule ;
91 TUPLE: escape-rule < rule ;
93 : <escape-rule> ( string -- rule )
94 f <string-matcher> f f f <matcher>
95 escape-rule new swap >>start ;
97 GENERIC: text-hash-char ( text -- ch )
101 M: string-matcher text-hash-char string>> first ;
103 M: regexp text-hash-char drop f ;
105 : rule-chars* ( rule -- string )
106 [ chars>> ] [ start>> ] bi text>>
107 text-hash-char [ suffix ] when* ;
109 : add-rule ( rule ruleset -- )
110 [ dup rule-chars* >upper swap ] dip rules>> inverted-index ;
112 : add-escape-rule ( string ruleset -- )
114 [ <escape-rule> ] dip