diff --git a/extra/xmode/README.txt b/extra/xmode/README.txt
index bf73042030..57d9f42b22 100755
--- a/extra/xmode/README.txt
+++ b/extra/xmode/README.txt
@@ -32,10 +32,10 @@ to depend on:
it inherits the value of the NO_WORD_SEP attribute from the previous
RULES tag.
- The Factor implementation does not duplicate this behavior.
+ The Factor implementation does not duplicate this behavior. If you
+ find a mode file which depends on this flaw, please fix it and submit
+ the changes to the jEdit project.
-This is still a work in progress. If you find any behavioral differences
-between the Factor implementation and the original jEdit code, please
-report them as bugs. Also, if you wish to contribute a new or improved
-mode file, please contact the jEdit project. Updated mode files in jEdit
-will be periodically imported into the Factor source tree.
+If you wish to contribute a new or improved mode file, please contact
+the jEdit project. Updated mode files in jEdit will be periodically
+imported into the Factor source tree.
diff --git a/extra/xmode/code2html/code2html.factor b/extra/xmode/code2html/code2html.factor
old mode 100644
new mode 100755
index 02bf74dc23..5dc44841d3
--- a/extra/xmode/code2html/code2html.factor
+++ b/extra/xmode/code2html/code2html.factor
@@ -15,8 +15,10 @@ IN: xmode.code2html
: htmlize-line ( line-context line rules -- line-context' )
tokenize-line htmlize-tokens ;
-: htmlize-lines ( lines rules -- )
- f -rot [ htmlize-line nl ] curry each drop
;
+: htmlize-lines ( lines mode -- )
+
+ f swap load-mode [ htmlize-line nl ] curry reduce drop
+
;
: default-stylesheet ( -- )
;
+: htmlize-stream ( path stream -- )
+ lines swap
+
+
+ default-stylesheet
+ dup write
+
+
+ over empty?
+ [ 2drop ]
+ [ over first find-mode htmlize-lines ] if
+
+ ;
+
: htmlize-file ( path -- )
- dup lines dup empty? [ 2drop ] [
- swap dup ".html" append [
- [
-
-
- dup write
- default-stylesheet
-
-
- over first
- find-mode
- load-mode
- htmlize-lines
-
-
- ] with-html-stream
- ] with-stream
- ] if ;
+ dup over ".html" append
+ [ htmlize-stream ] with-stream ;
diff --git a/extra/xmode/loader/loader.factor b/extra/xmode/loader/loader.factor
index c6b5cad9d1..db3d0fbf41 100755
--- a/extra/xmode/loader/loader.factor
+++ b/extra/xmode/loader/loader.factor
@@ -32,10 +32,13 @@ IN: xmode.loader
swap [ at string>boolean ] curry map first3 ;
: parse-literal-matcher ( tag -- matcher )
- dup children>string swap position-attrs ;
+ dup children>string
+ \ ignore-case? get [ ] when
+ swap position-attrs ;
: parse-regexp-matcher ( tag -- matcher )
- dup children>string swap position-attrs ;
+ dup children>string
+ swap position-attrs ;
! SPAN's children
token swap children>string rot set-at ;
+: parse-keyword-tag ( tag keyword-map -- )
+ >r dup name-tag string>token swap children>string r> set-at ;
TAG: KEYWORDS ( rule-set tag -- key value )
- >r rule-set-keywords r>
- child-tags [ parse-keyword-tag ] curry* each ;
+ \ ignore-case? get
+ swap child-tags [ over parse-keyword-tag ] each
+ swap set-rule-set-keywords ;
TAGS>
+: ? dup [ ] when ;
+
: (parse-rules-tag) ( tag -- rule-set )
{
{ "SET" string>rule-set-name set-rule-set-name }
{ "IGNORE_CASE" string>boolean set-rule-set-ignore-case? }
{ "HIGHLIGHT_DIGITS" string>boolean set-rule-set-highlight-digits? }
- { "DIGIT_RE" set-rule-set-digit-re } ! XXX
+ { "DIGIT_RE" ? set-rule-set-digit-re }
{ "ESCAPE" f add-escape-rule }
{ "DEFAULT" string>token set-rule-set-default }
{ "NO_WORD_SEP" f set-rule-set-no-word-sep }
@@ -153,9 +159,10 @@ TAGS>
: parse-rules-tag ( tag -- rule-set )
dup (parse-rules-tag) [
- swap child-tags [
- parse-rule-tag
- ] curry* each
+ [
+ dup rule-set-ignore-case? \ ignore-case? set
+ swap child-tags [ parse-rule-tag ] curry* each
+ ] with-scope
] keep ;
: merge-rule-set-props ( props rule-set -- )
diff --git a/extra/xmode/marker/marker-tests.factor b/extra/xmode/marker/marker-tests.factor
index cb7f2960a4..5b0aff2050 100755
--- a/extra/xmode/marker/marker-tests.factor
+++ b/extra/xmode/marker/marker-tests.factor
@@ -109,3 +109,21 @@ IN: temporary
] [
f "$FOO" "shellscript" load-mode tokenize-line nip
] unit-test
+
+[
+ {
+ T{ token f "AND" KEYWORD1 }
+ }
+] [
+ f "AND" "pascal" load-mode tokenize-line nip
+] unit-test
+
+[
+ {
+ T{ token f "Comment {" COMMENT1 }
+ T{ token f "XXX" COMMENT1 }
+ T{ token f "}" COMMENT1 }
+ }
+] [
+ f "Comment {XXX}" "rebol" load-mode tokenize-line nip
+] unit-test
diff --git a/extra/xmode/marker/marker.factor b/extra/xmode/marker/marker.factor
index cd9eacbb88..dda5d64c9c 100755
--- a/extra/xmode/marker/marker.factor
+++ b/extra/xmode/marker/marker.factor
@@ -15,8 +15,8 @@ assocs combinators combinators.lib strings regexp splitting ;
[ dup [ digit? ] contains? ]
[
dup [ digit? ] all? [
- current-rule-set rule-set-digit-re dup
- [ dupd 2drop f ] [ drop f ] if
+ current-rule-set rule-set-digit-re
+ dup [ dupd matches? ] [ drop f ] if
] unless*
]
} && nip ;
@@ -26,7 +26,7 @@ assocs combinators combinators.lib strings regexp splitting ;
: resolve-delegate ( name -- rules )
dup string? [
- "::" split1 [ swap load-mode at ] [ rule-sets get at ] if*
+ "::" split1 [ swap load-mode ] [ rule-sets get ] if* at
] when ;
: rule-set-keyword-maps ( ruleset -- seq )
@@ -45,13 +45,6 @@ assocs combinators combinators.lib strings regexp splitting ;
dup mark-number [ ] [ mark-keyword ] ?if
[ prev-token, ] when* ;
-: check-terminate-char ( -- )
- current-rule-set rule-set-terminate-char [
- position get <= [
- terminated? on
- ] when
- ] when* ;
-
: current-char ( -- char )
position get line get nth ;
@@ -74,11 +67,22 @@ GENERIC: text-matches? ( position text -- match-count/f )
M: f text-matches? 2drop f ;
M: string text-matches?
- ! XXX ignore case
>r line get swap tail-slice r>
[ head? ] keep length and ;
-! M: regexp text-matches? ... ;
+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: regexp text-matches?
+ 2drop f ; ! >r line get swap tail-slice r> match-head ;
: rule-start-matches? ( rule -- match-count/f )
dup rule-start tuck swap can-match-here? [
@@ -284,8 +288,6 @@ M: mark-previous-rule handle-rule-start
: mark-token-loop ( -- )
position get line get length < [
- check-terminate-char
-
{
[ check-end-delegate ]
[ check-every-rule ]
@@ -302,8 +304,7 @@ M: mark-previous-rule handle-rule-start
: unwind-no-line-break ( -- )
context get line-context-parent [
- line-context-in-rule rule-no-line-break?
- terminated? get or [
+ line-context-in-rule rule-no-line-break? [
pop-context
unwind-no-line-break
] when
diff --git a/extra/xmode/marker/state/state.factor b/extra/xmode/marker/state/state.factor
index cce7c7567a..958c23a2bc 100755
--- a/extra/xmode/marker/state/state.factor
+++ b/extra/xmode/marker/state/state.factor
@@ -16,7 +16,6 @@ SYMBOL: seen-whitespace-end?
SYMBOL: escaped?
SYMBOL: process-escape?
SYMBOL: delegate-end-escaped?
-SYMBOL: terminated?
: current-rule ( -- rule )
context get line-context-in-rule ;
diff --git a/extra/xmode/rules/rules.factor b/extra/xmode/rules/rules.factor
index 7206668edb..906fba3140 100755
--- a/extra/xmode/rules/rules.factor
+++ b/extra/xmode/rules/rules.factor
@@ -1,7 +1,11 @@
USING: xmode.tokens xmode.keyword-map kernel
-sequences vectors assocs strings memoize ;
+sequences vectors assocs strings memoize regexp ;
IN: xmode.rules
+TUPLE: ignore-case string ;
+
+C: ignore-case
+
! Based on org.gjt.sp.jedit.syntax.ParserRuleSet
TUPLE: rule-set
name
@@ -20,12 +24,11 @@ no-word-sep
: init-rule-set ( ruleset -- )
#! Call after constructor.
- >r H{ } clone H{ } clone V{ } clone f r>
+ >r H{ } clone H{ } clone V{ } clone r>
{
set-rule-set-rules
set-rule-set-props
set-rule-set-imports
- set-rule-set-keywords
} set-slots ;
: ( -- ruleset )
@@ -46,8 +49,9 @@ MEMO: standard-rule-set ( id -- ruleset )
] when* ;
: rule-set-no-word-sep* ( ruleset -- str )
- dup rule-set-keywords keyword-map-no-word-sep*
- swap rule-set-no-word-sep "_" 3append ;
+ dup rule-set-no-word-sep
+ swap rule-set-keywords dup [ keyword-map-no-word-sep* ] when
+ "_" 3append ;
! Match restrictions
TUPLE: matcher text at-line-start? at-whitespace-end? at-word-start? ;
@@ -97,10 +101,20 @@ TUPLE: escape-rule ;
escape-rule construct-rule
[ set-rule-start ] keep ;
+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: regexp text-hash-char drop f ;
+
: rule-chars* ( rule -- string )
dup rule-chars
swap rule-start matcher-text
- dup string? [ first add ] [ drop ] if ;
+ text-hash-char [ add ] when* ;
: add-rule ( rule ruleset -- )
>r dup rule-chars* >upper swap