XMode improvements
parent
6dc58c3a1f
commit
6beab4c06f
|
@ -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)
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
: rest-of-line ( -- str )
|
||||
line get position get tail-slice ;
|
||||
|
||||
GENERIC: text-matches? ( position text -- match-count/f )
|
||||
|
||||
M: f text-matches? 2drop f ;
|
||||
M: f text-matches?
|
||||
2drop f ;
|
||||
|
||||
M: string text-matches?
|
||||
>r line get swap tail-slice r>
|
||||
[ head? ] keep length and ;
|
||||
|
||||
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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
Loading…
Reference in New Issue