From ff7bf5d729b51a5e99dc69543ce27564ce8849a3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 10 Dec 2007 02:20:36 -0500 Subject: [PATCH] XMode fixes --- extra/xmode/catalog/catalog.factor | 56 ++++++++++++++++++-- extra/xmode/marker/marker-tests.factor | 6 +++ extra/xmode/marker/marker.factor | 46 ++++++---------- extra/xmode/marker/state/state.factor | 15 ++---- extra/xmode/modes/catalog | 3 ++ extra/xmode/modes/fhtml.xml | 49 +++++++++-------- extra/xmode/rules/rules.factor | 1 + extra/xmode/utilities/utilities-tests.factor | 2 +- 8 files changed, 108 insertions(+), 70 deletions(-) diff --git a/extra/xmode/catalog/catalog.factor b/extra/xmode/catalog/catalog.factor index 866bd69106..d880ca3789 100644 --- a/extra/xmode/catalog/catalog.factor +++ b/extra/xmode/catalog/catalog.factor @@ -1,5 +1,6 @@ -USING: xmode.loader xmode.utilities namespaces -assocs sequences kernel io.files xml memoize words globs ; +USING: xmode.loader xmode.utilities xmode.rules namespaces +strings splitting assocs sequences kernel io.files xml memoize +words globs ; IN: xmode.catalog TUPLE: mode file file-name-glob first-line-glob ; @@ -34,11 +35,60 @@ TAGS> : reset-catalog ( -- ) f \ modes set-global ; -MEMO: load-mode ( name -- rule-sets ) +MEMO: (load-mode) ( name -- rule-sets ) modes at mode-file "extra/xmode/modes/" swap append resource-path parse-mode ; +DEFER: load-mode + +SYMBOL: rule-sets + +: get-rule-set ( name -- rules ) + dup string? [ + "::" split1 [ swap load-mode ] [ rule-sets get ] if* at + ] when ; + +: resolve-delegate ( rule -- ) + dup rule-delegate dup + [ get-rule-set swap set-rule-delegate ] [ 2drop ] if ; + +: each-rule ( rule-set quot -- ) + >r rule-set-rules values concat r> each ; inline + +: resolve-delegates ( ruleset -- ) + [ resolve-delegate ] each-rule ; + +: ?update ( keyword-map/f keyword-map -- keyword-map ) + over [ dupd update ] [ nip clone ] if ; + +: import-keywords ( parent child -- ) + over >r [ rule-set-keywords ] 2apply ?update + r> set-rule-set-keywords ; + +: import-rules ( parent child -- ) + swap [ add-rule ] curry each-rule ; + +: resolve-imports ( ruleset -- ) + dup rule-set-imports [ + get-rule-set + dup resolve-delegates + 2dup import-keywords + import-rules + ] curry* each ; + +: finalize-rule-set ( ruleset -- ) + dup rule-set-finalized? [ drop ] [ + t over set-rule-set-finalized? + dup resolve-imports + resolve-delegates + ] if ; + +: load-mode ( name -- rule-sets ) + (load-mode) dup rule-sets [ + dup [ nip finalize-rule-set ] assoc-each + ] with-variable ; + : reset-modes ( -- ) \ load-mode "memoize" word-prop clear-assoc ; diff --git a/extra/xmode/marker/marker-tests.factor b/extra/xmode/marker/marker-tests.factor index 5b0aff2050..b9621a112a 100755 --- a/extra/xmode/marker/marker-tests.factor +++ b/extra/xmode/marker/marker-tests.factor @@ -127,3 +127,9 @@ IN: temporary ] [ f "Comment {XXX}" "rebol" load-mode tokenize-line nip ] unit-test + +[ + +] [ + f "font:75%/1.6em \"Lucida Grande\", \"Lucida Sans Unicode\", verdana, geneva, sans-serif;" "css" load-mode tokenize-line 2drop +] unit-test diff --git a/extra/xmode/marker/marker.factor b/extra/xmode/marker/marker.factor index b22844b45b..b8331fe6b6 100755 --- a/extra/xmode/marker/marker.factor +++ b/extra/xmode/marker/marker.factor @@ -24,18 +24,8 @@ strings regexp splitting parser-combinators ; : mark-number ( keyword -- id ) keyword-number? DIGIT and ; -: resolve-delegate ( name -- rules ) - dup string? [ - "::" split1 [ swap load-mode ] [ rule-sets get ] if* at - ] when ; - -: rule-set-keyword-maps ( ruleset -- seq ) - dup rule-set-imports - [ resolve-delegate rule-set-keyword-maps ] map concat - swap rule-set-keywords add ; - : mark-keyword ( keyword -- id ) - current-rule-set rule-set-keyword-maps assoc-stack ; + current-rule-set rule-set-keywords at ; : add-remaining-token ( -- ) current-rule-set rule-set-default prev-token, ; @@ -102,10 +92,6 @@ M: regexp text-matches? DEFER: get-rules -: get-imported-rules ( vector/f char ruleset -- vector/f ) - rule-set-imports - [ resolve-delegate get-rules ?push-all ] curry* each ; - : get-always-rules ( vector/f ruleset -- vector/f ) f swap rule-set-rules at ?push-all ; @@ -113,10 +99,7 @@ DEFER: get-rules >r ch>upper r> rule-set-rules at ?push-all ; : get-rules ( char ruleset -- seq ) - f -rot - [ get-char-rules ] 2keep - [ get-always-rules ] keep - get-imported-rules ; + f -rot [ get-char-rules ] keep get-always-rules ; GENERIC: handle-rule-start ( match-count rule -- ) @@ -173,7 +156,7 @@ M: seq-rule handle-rule-start mark-token add-remaining-token tuck rule-body-token next-token, - rule-delegate [ resolve-delegate push-context ] when* ; + rule-delegate [ push-context ] when* ; UNION: abstract-span-rule span-rule eol-span-rule ; @@ -184,7 +167,7 @@ M: abstract-span-rule handle-rule-start tuck rule-match-token* next-token, ! ... end subst ... dup context get set-line-context-in-rule - rule-delegate resolve-delegate push-context ; + rule-delegate push-context ; M: span-rule handle-rule-end 2drop ; @@ -230,10 +213,12 @@ M: mark-previous-rule handle-rule-start : handle-no-word-break ( -- ) context get line-context-parent [ - line-context-in-rule dup rule-no-word-break? [ - rule-match-token* prev-token, - pop-context - ] [ drop ] if + line-context-in-rule [ + dup rule-no-word-break? [ + rule-match-token* prev-token, + pop-context + ] [ drop ] if + ] when* ] when* ; : check-rule ( -- ) @@ -300,14 +285,17 @@ M: mark-previous-rule handle-rule-start : unwind-no-line-break ( -- ) context get line-context-parent [ - line-context-in-rule rule-no-line-break? [ - pop-context - unwind-no-line-break - ] when + line-context-in-rule [ + rule-no-line-break? [ + pop-context + unwind-no-line-break + ] when + ] when* ] when* ; : tokenize-line ( line-context line rules -- line-context' seq ) [ + "MAIN" swap at -rot init-token-marker mark-token-loop mark-remaining diff --git a/extra/xmode/marker/state/state.factor b/extra/xmode/marker/state/state.factor index fc731aba34..35e6bbef18 100755 --- a/extra/xmode/marker/state/state.factor +++ b/extra/xmode/marker/state/state.factor @@ -4,7 +4,6 @@ IN: xmode.marker.state ! Based on org.gjt.sp.jedit.syntax.TokenMarker -SYMBOL: rule-sets SYMBOL: line SYMBOL: last-offset SYMBOL: position @@ -37,12 +36,6 @@ SYMBOL: delegate-end-escaped? >r position get 2dup + r> token, position get + dup 1- position set last-offset set ; -: get-rule-set ( name -- rule-set ) - rule-sets get at ; - -: main-rule-set ( -- rule-set ) - "MAIN" get-rule-set ; - : push-context ( rules -- ) context [ ] change ; @@ -51,12 +44,10 @@ SYMBOL: delegate-end-escaped? dup context set f swap set-line-context-in-rule ; -: init-token-marker ( prev-context line rules -- ) - rule-sets set +: init-token-marker ( main prev-context line -- ) line set + [ ] [ f ] ?if context set 0 position set 0 last-offset set 0 whitespace-end set - process-escape? on - [ clone ] [ main-rule-set f ] if* - context set ; + process-escape? on ; diff --git a/extra/xmode/modes/catalog b/extra/xmode/modes/catalog index cd1da3dd1f..f4300b456b 100644 --- a/extra/xmode/modes/catalog +++ b/extra/xmode/modes/catalog @@ -125,6 +125,9 @@ + + diff --git a/extra/xmode/modes/fhtml.xml b/extra/xmode/modes/fhtml.xml index 23abd4f70a..68646e2321 100644 --- a/extra/xmode/modes/fhtml.xml +++ b/extra/xmode/modes/fhtml.xml @@ -1,25 +1,24 @@ - - - - - - - - - - - - - - - - - - <% - %> - - - - - - + + + + + + + + + + + + + + + + + + <% + %> + + + + + diff --git a/extra/xmode/rules/rules.factor b/extra/xmode/rules/rules.factor index 85d50a5bbe..acc6308c6f 100755 --- a/extra/xmode/rules/rules.factor +++ b/extra/xmode/rules/rules.factor @@ -20,6 +20,7 @@ escape-rule highlight-digits? digit-re no-word-sep +finalized? ; : init-rule-set ( ruleset -- ) diff --git a/extra/xmode/utilities/utilities-tests.factor b/extra/xmode/utilities/utilities-tests.factor index ed8193cdcf..d31aac64ae 100644 --- a/extra/xmode/utilities/utilities-tests.factor +++ b/extra/xmode/utilities/utilities-tests.factor @@ -2,7 +2,7 @@ IN: temporary USING: xmode.utilities tools.test xml xml.data kernel strings vectors sequences io.files prettyprint assocs ; -[ 3 "hi" ] [ +[ "hi" 3 ] [ { 1 2 3 4 5 6 7 8 } [ H{ { 3 "hi" } } at ] map-find ] unit-test