XMode improvements

release
Slava Pestov 2007-12-08 03:23:14 -05:00
parent 6dc58c3a1f
commit 6beab4c06f
5 changed files with 40 additions and 48 deletions

View File

@ -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)

View File

@ -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 -- )

View File

@ -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

View File

@ -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

View File

@ -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 ;