diff --git a/extra/xmode/keyword-map/keyword-map.factor b/extra/xmode/keyword-map/keyword-map.factor index b75c24393c..350d8572a0 100644 --- a/extra/xmode/keyword-map/keyword-map.factor +++ b/extra/xmode/keyword-map/keyword-map.factor @@ -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) diff --git a/extra/xmode/loader/loader.factor b/extra/xmode/loader/loader.factor index db3d0fbf41..ac1d1d66ca 100755 --- a/extra/xmode/loader/loader.factor +++ b/extra/xmode/loader/loader.factor @@ -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 [ ] when + ignore-case? get swap position-attrs ; : parse-regexp-matcher ( tag -- matcher ) - dup children>string + dup children>string ignore-case? get swap position-attrs ; ! 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 + ignore-case? get swap child-tags [ over parse-keyword-tag ] each swap set-rule-set-keywords ; TAGS> -: ? dup [ ] when ; +: ? dup [ ignore-case? get ] when ; : (parse-rules-tag) ( tag -- 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 -- ) diff --git a/extra/xmode/marker/marker.factor b/extra/xmode/marker/marker.factor index dda5d64c9c..fa77159f96 100755 --- a/extra/xmode/marker/marker.factor +++ b/extra/xmode/marker/marker.factor @@ -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 diff --git a/extra/xmode/marker/state/state.factor b/extra/xmode/marker/state/state.factor index 958c23a2bc..fc731aba34 100755 --- a/extra/xmode/marker/state/state.factor +++ b/extra/xmode/marker/state/state.factor @@ -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 diff --git a/extra/xmode/rules/rules.factor b/extra/xmode/rules/rules.factor index 906fba3140..85d50a5bbe 100755 --- a/extra/xmode/rules/rules.factor +++ b/extra/xmode/rules/rules.factor @@ -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 +C: string-matcher ! Based on org.gjt.sp.jedit.syntax.ParserRuleSet TUPLE: rule-set @@ -97,7 +97,7 @@ TUPLE: mark-previous-rule ; TUPLE: escape-rule ; : ( string -- rule ) - f f f + f f f f 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 r> - 2dup set-rule-set-escape-rule - add-rule ; + over [ + >r r> + 2dup set-rule-set-escape-rule + add-rule + ] [ + 2drop + ] if ;