dup "::" split1 [ swap (load-mode) ] [ rule-sets get ] if*
dup -roll at* [ nip ] [ drop no-such-rule-set ] if ;
+DEFER: finalize-rule-set
+
: resolve-delegate ( rule -- )
- dup delegate>> dup string?
- [ get-rule-set nip swap (>>delegate) ] [ 2drop ] if ;
+ dup delegate>> dup string? [
+ get-rule-set
+ dup rule-set? [ "not a rule set" throw ] unless
+ swap rule-sets [ dup finalize-rule-set ] with-variable
+ >>delegate drop
+ ] [ 2drop ] if ;
: each-rule ( rule-set quot -- )
[ rules>> values concat ] dip each ; inline
: resolve-imports ( ruleset -- )
dup imports>> [
get-rule-set swap rule-sets [
- dup resolve-delegates
- 2dup import-keywords
- import-rules
+ [ nip resolve-delegates ]
+ [ import-keywords ]
+ [ import-rules ]
+ 2tri
] with-variable
] with each ;
ERROR: mutually-recursive-rulesets ruleset ;
+
: finalize-rule-set ( ruleset -- )
- dup finalized?>> {
- { f [
- {
- [ 1 >>finalized? drop ]
- [ resolve-imports ]
- [ resolve-delegates ]
- [ t >>finalized? drop ]
- } cleave
- ] }
- { t [ drop ] }
- { 1 [ mutually-recursive-rulesets ] }
- } case ;
+ dup finalized?>> [ drop ] [
+ t >>finalized?
+ [ resolve-imports ]
+ [ resolve-delegates ]
+ bi
+ ] if ;
: finalize-mode ( rulesets -- )
rule-sets [
IN: xmode.code2html.tests
USING: xmode.code2html xmode.catalog
tools.test multiline splitting memoize
-kernel ;
+kernel io.streams.string xml.writer ;
[ ] [ \ (load-mode) reset-memoized ] unit-test
<" <style type="text/css" media="screen" >
* {margin:0; padding:0; border:0;} ">
string-lines "html" htmlize-lines drop
+] unit-test
+
+[ ] [
+ "test.c"
+ <" int x = "hi";
+/* a comment */ "> <string-reader> htmlize-stream
+ write-xml
] unit-test
\ No newline at end of file
[ str>> ] [ id>> ] bi [
name>> swap
[XML <span class=<->><-></span> XML]
- ] [ ] if*
+ ] when*
] map ;
: htmlize-line ( line-context line rules -- line-context' xml )
tokenize-line htmlize-tokens ;
: htmlize-lines ( lines mode -- xml )
- [ f ] 2dip load-mode [ htmlize-line ] curry map nip ;
+ [ f ] 2dip load-mode [ htmlize-line "\n" suffix ] curry map nip ;
: default-stylesheet ( -- xml )
"resource:basis/xmode/code2html/stylesheet.css"
:: htmlize-stream ( path stream -- xml )
stream lines
- [ "" ] [ first find-mode path swap htmlize-lines ]
+ [ "" ] [ path over first find-mode htmlize-lines ]
if-empty :> input
default-stylesheet :> stylesheet
<XML <html>
shared-tag-attrs match-type-attr literal-start ;
TAG: KEYWORDS ( rule-set tag -- key value )
- ignore-case? get <keyword-map>
+ rule-set get ignore-case?>> <keyword-map>
swap child-tags [ over parse-keyword-tag ] each
swap (>>keywords) ;
TAGS>
: ?<regexp> ( string/f -- regexp/f )
- dup [ ignore-case? get <regexp> ] when ;
+ dup [ rule-set get ignore-case?>> <regexp> ] when ;
: (parse-rules-tag) ( tag -- rule-set )
- <rule-set>
+ <rule-set> dup rule-set set
{
{ "SET" string>rule-set-name (>>name) }
{ "IGNORE_CASE" string>boolean (>>ignore-case?) }
} init-from-tag ;
: parse-rules-tag ( tag -- rule-set )
- dup (parse-rules-tag) [
- dup ignore-case?>> ignore-case? [
- swap child-tags [ parse-rule-tag ] with each
- ] with-variable
- ] keep ;
+ [
+ [ (parse-rules-tag) ] [ child-tags ] bi
+ [ parse-rule-tag ] with each
+ rule-set get
+ ] with-scope ;
: merge-rule-set-props ( props rule-set -- )
[ assoc-union ] change-props drop ;
-! Copyright (C) 2007, 2008 Slava Pestov.
+! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors xmode.tokens xmode.rules xmode.keyword-map
xml.data xml.utilities xml assocs kernel combinators sequences
math.parser namespaces make parser lexer xmode.utilities
-parser-combinators.regexp io.files ;
+parser-combinators.regexp io.files splitting arrays ;
IN: xmode.loader.syntax
-SYMBOL: ignore-case?
-
! Rule tag parsing utilities
: (parse-rule-tag) ( rule-set tag specs class -- )
new swap init-from-tag swap add-rule ; inline
: parse-literal-matcher ( tag -- matcher )
dup children>string
- ignore-case? get <string-matcher>
+ rule-set get ignore-case?>> <string-matcher>
swap position-attrs <matcher> ;
: parse-regexp-matcher ( tag -- matcher )
- dup children>string ignore-case? get <regexp>
+ dup children>string rule-set get ignore-case?>> <regexp>
swap position-attrs <matcher> ;
: shared-tag-attrs ( -- )
{ "TYPE" string>token (>>body-token) } , ; inline
+: parse-delegate ( string -- pair )
+ "::" split1 [ rule-set get swap ] unless* 2array ;
+
: delegate-attr ( -- )
{ "DELEGATE" f (>>delegate) } , ;
-USING: accessors kernel ;
+USING: accessors kernel xmode.rules ;
IN: xmode.marker.context
! Based on org.gjt.sp.jedit.syntax.TokenMarker.LineContext
;
: <line-context> ( ruleset parent -- line-context )
- over [ "no context" throw ] unless
+ over rule-set? [ "not a rule-set" throw ] unless
line-context new
swap >>parent
swap >>in-rule-set ;
mark-token
add-remaining-token
tuck body-token>> next-token,
- delegate>> [ push-context ] when* ;
+ get-delegate [ push-context ] when* ;
UNION: abstract-span-rule span-rule eol-span-rule ;
tuck rule-match-token* next-token,
! ... end subst ...
dup context get (>>in-rule)
- delegate>> push-context ;
+ get-delegate push-context ;
M: span-rule handle-rule-end
2drop ;
projects / factor.git / commitdiff