Farkup and xmode.code2html switched to using xml.interpolate
Daniel Ehrenberg
parent
dd553440dc
commit
73f30edb29
|
|
@ -92,22 +92,22 @@ link-no-follow? off
|
|||
[ "<p>=</p><h2>foo</h2>" ] [ "===foo==" convert-farkup ] unit-test
|
||||
[ "<h1>foo</h1><p>=</p>" ] [ "=foo==" convert-farkup ] unit-test
|
||||
|
||||
[ "<pre><span class='KEYWORD3'>int</span> <span class='FUNCTION'>main</span><span class='OPERATOR'>(</span><span class='OPERATOR'>)</span>\n</pre>" ]
|
||||
[ "<pre><span class=\"KEYWORD3\">int</span> <span class=\"FUNCTION\">main</span><span class=\"OPERATOR\">(</span><span class=\"OPERATOR\">)</span></pre>" ]
|
||||
[ "[c{int main()}]" convert-farkup ] unit-test
|
||||
|
||||
[ "<p><img src='lol.jpg'/></p>" ] [ "[[image:lol.jpg]]" convert-farkup ] unit-test
|
||||
[ "<p><img src='lol.jpg' alt='teh lol'/></p>" ] [ "[[image:lol.jpg|teh lol]]" convert-farkup ] unit-test
|
||||
[ "<p><a href='http://lol.com'>http://lol.com</a></p>" ] [ "[[http://lol.com]]" convert-farkup ] unit-test
|
||||
[ "<p><a href='http://lol.com'>haha</a></p>" ] [ "[[http://lol.com|haha]]" convert-farkup ] unit-test
|
||||
[ "<p><a href='Foo/Bar'>Bar</a></p>" ] [ "[[Foo/Bar]]" convert-farkup ] unit-test
|
||||
[ "<p><img src=\"lol.jpg\"/></p>" ] [ "[[image:lol.jpg]]" convert-farkup ] unit-test
|
||||
[ "<p><img src=\"lol.jpg\" alt=\"teh lol\"/></p>" ] [ "[[image:lol.jpg|teh lol]]" convert-farkup ] unit-test
|
||||
[ "<p><a href=\"http://lol.com\">http://lol.com</a></p>" ] [ "[[http://lol.com]]" convert-farkup ] unit-test
|
||||
[ "<p><a href=\"http://lol.com\">haha</a></p>" ] [ "[[http://lol.com|haha]]" convert-farkup ] unit-test
|
||||
[ "<p><a href=\"Foo/Bar\">Bar</a></p>" ] [ "[[Foo/Bar]]" convert-farkup ] unit-test
|
||||
|
||||
"/wiki/view/" relative-link-prefix [
|
||||
[ "<p><a href='/wiki/view/Foo/Bar'>Bar</a></p>" ] [ "[[Foo/Bar]]" convert-farkup ] unit-test
|
||||
[ "<p><a href=\"/wiki/view/Foo/Bar\">Bar</a></p>" ] [ "[[Foo/Bar]]" convert-farkup ] unit-test
|
||||
] with-variable
|
||||
|
||||
[ ] [ "[{}]" convert-farkup drop ] unit-test
|
||||
|
||||
[ "<pre>hello\n</pre>" ] [ "[{hello}]" convert-farkup ] unit-test
|
||||
[ "<pre>hello</pre>" ] [ "[{hello}]" convert-farkup ] unit-test
|
||||
|
||||
[
|
||||
"<p>Feature comparison:\n<table><tr><td>a</td><td>Factor</td><td>Java</td><td>Lisp</td></tr><tr><td>Coolness</td><td>Yes</td><td>No</td><td>No</td></tr><tr><td>Badass</td><td>Yes</td><td>No</td><td>No</td></tr><tr><td>Enterprise</td><td>Yes</td><td>Yes</td><td>No</td></tr><tr><td>Kosher</td><td>Yes</td><td>No</td><td>Yes</td></tr></table></p>"
|
||||
|
|
@ -118,15 +118,15 @@ link-no-follow? off
|
|||
] [ "Feature comparison:\n\n|a|Factor|Java|Lisp|\n|Coolness|Yes|No|No|\n|Badass|Yes|No|No|\n|Enterprise|Yes|Yes|No|\n|Kosher|Yes|No|Yes|\n" convert-farkup ] unit-test
|
||||
|
||||
[
|
||||
"<p>This wiki is written in <a href='Factor'>Factor</a> and is hosted on a <a href='http://linode.com'>http://linode.com</a> virtual server.</p>"
|
||||
"<p>This wiki is written in <a href=\"Factor\">Factor</a> and is hosted on a <a href=\"http://linode.com\">http://linode.com</a> virtual server.</p>"
|
||||
] [
|
||||
"This wiki is written in [[Factor]] and is hosted on a [[http://linode.com|http://linode.com]] virtual server."
|
||||
convert-farkup
|
||||
] unit-test
|
||||
|
||||
[ "<p><a href='a'>a</a> <a href='b'>c</a></p>" ] [ "[[a]] [[b|c]]" convert-farkup ] unit-test
|
||||
[ "<p><a href=\"a\">a</a> <a href=\"b\">c</a></p>" ] [ "[[a]] [[b|c]]" convert-farkup ] unit-test
|
||||
|
||||
[ "<p><a href='C%2b%2b'>C++</a></p>" ] [ "[[C++]]" convert-farkup ] unit-test
|
||||
[ "<p><a href=\"C%2b%2b\">C++</a></p>" ] [ "[[C++]]" convert-farkup ] unit-test
|
||||
|
||||
[ "<p><foo></p>" ] [ "<foo>" convert-farkup ] unit-test
|
||||
|
||||
|
|
@ -138,10 +138,10 @@ link-no-follow? off
|
|||
[ "<hr/>" ] [ "___" convert-farkup ] unit-test
|
||||
[ "<hr/>\n" ] [ "___\n" convert-farkup ] unit-test
|
||||
|
||||
[ "<p>before:\n<pre><span class='OPERATOR'>{</span> <span class='DIGIT'>1</span> <span class='DIGIT'>2</span> <span class='DIGIT'>3</span> <span class='OPERATOR'>}</span> <span class='DIGIT'>1</span> tail\n</pre></p>" ]
|
||||
[ "<p>before:\n<pre><span class=\"OPERATOR\">{</span> <span class=\"DIGIT\">1</span> <span class=\"DIGIT\">2</span> <span class=\"DIGIT\">3</span> <span class=\"OPERATOR\">}</span> <span class=\"DIGIT\">1</span> tail</pre></p>" ]
|
||||
[ "before:\n[factor{{ 1 2 3 } 1 tail}]" convert-farkup ] unit-test
|
||||
|
||||
[ "<p><a href='Factor'>Factor</a>-rific!</p>" ]
|
||||
[ "<p><a href=\"Factor\">Factor</a>-rific!</p>" ]
|
||||
[ "[[Factor]]-rific!" convert-farkup ] unit-test
|
||||
|
||||
[ "<p>[ factor { 1 2 3 }]</p>" ]
|
||||
|
|
@ -163,7 +163,7 @@ link-no-follow? off
|
|||
convert-farkup string>xml-chunk
|
||||
"a" deep-tag-named "href" swap at url-decode ;
|
||||
|
||||
[ "Trader Joe's" ] [ "[[Trader Joe's]]" check-link-escaping ] unit-test
|
||||
[ "Trader Joe\"s" ] [ "[[Trader Joe\"s]]" check-link-escaping ] unit-test
|
||||
[ "<foo>" ] [ "[[<foo>]]" check-link-escaping ] unit-test
|
||||
[ "&blah;" ] [ "[[&blah;]]" check-link-escaping ] unit-test
|
||||
[ "C++" ] [ "[[C++]]" check-link-escaping ] unit-test
|
||||
[ "C++" ] [ "[[C++]]" check-link-escaping ] unit-test
|
||||
|
|
|
|||
|
|
@ -2,8 +2,9 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays combinators html.elements io
|
||||
io.streams.string kernel math namespaces peg peg.ebnf
|
||||
sequences sequences.deep strings xml.entities
|
||||
vectors splitting xmode.code2html urls.encoding ;
|
||||
sequences sequences.deep strings xml.entities xml.interpolate
|
||||
vectors splitting xmode.code2html urls.encoding xml.data
|
||||
xml.writer ;
|
||||
IN: farkup
|
||||
|
||||
SYMBOL: relative-link-prefix
|
||||
|
|
@ -74,6 +75,7 @@ inline-code = "%" (!("%" | nl).)+ "%"
|
|||
=> [[ second >string inline-code boa ]]
|
||||
|
||||
link-content = (!("|"|"]").)+
|
||||
=> [[ >string ]]
|
||||
|
||||
image-link = "[[image:" link-content "|" link-content "]]"
|
||||
=> [[ [ second >string ] [ fourth >string ] bi image boa ]]
|
||||
|
|
@ -146,7 +148,7 @@ named-code
|
|||
|
||||
simple-code
|
||||
= "[{" (!("}]").)+ "}]"
|
||||
=> [[ second f swap code boa ]]
|
||||
=> [[ second >string f swap code boa ]]
|
||||
|
||||
code = named-code | simple-code
|
||||
|
||||
|
|
@ -163,66 +165,75 @@ stand-alone
|
|||
{ [ dup [ 127 > ] contains? ] [ drop invalid-url ] }
|
||||
{ [ dup first "/\\" member? ] [ drop invalid-url ] }
|
||||
{ [ CHAR: : over member? ] [ dup absolute-url? [ drop invalid-url ] unless ] }
|
||||
[ relative-link-prefix get prepend ]
|
||||
} cond ;
|
||||
[ relative-link-prefix get prepend "" like ]
|
||||
} cond url-encode ;
|
||||
|
||||
: escape-link ( href text -- href-esc text-esc )
|
||||
[ check-url ] dip escape-string ;
|
||||
: write-link ( href text -- xml )
|
||||
[ check-url link-no-follow? get "true" and ] dip
|
||||
[XML <a href=<-> nofollow=<->><-></a> XML] ;
|
||||
|
||||
: write-link ( href text -- )
|
||||
escape-link
|
||||
[ <a url-encode =href link-no-follow? get [ "true" =nofollow ] when a> ]
|
||||
[ write </a> ]
|
||||
bi* ;
|
||||
|
||||
: write-image-link ( href text -- )
|
||||
: write-image-link ( href text -- xml )
|
||||
disable-images? get [
|
||||
2drop
|
||||
<strong> "Images are not allowed" write </strong>
|
||||
[XML <strong>Images are not allowed</strong> XML]
|
||||
] [
|
||||
escape-link
|
||||
[ <img url-encode =src ] [ [ =alt ] unless-empty img/> ] bi*
|
||||
[ check-url ] [ f like ] bi*
|
||||
[XML <img src=<-> alt=<->/> XML]
|
||||
] if ;
|
||||
|
||||
: render-code ( string mode -- string' )
|
||||
[ string-lines ] dip
|
||||
[
|
||||
<pre>
|
||||
htmlize-lines
|
||||
</pre>
|
||||
] with-string-writer write ;
|
||||
: render-code ( string mode -- xml )
|
||||
[ string-lines ] dip htmlize-lines
|
||||
[XML <pre><-></pre> XML] ;
|
||||
|
||||
GENERIC: (write-farkup) ( farkup -- )
|
||||
: <foo.> ( string -- ) <foo> write ;
|
||||
: </foo.> ( string -- ) </foo> write ;
|
||||
: in-tag. ( obj quot string -- ) [ <foo.> call ] keep </foo.> ; inline
|
||||
M: heading1 (write-farkup) [ child>> (write-farkup) ] "h1" in-tag. ;
|
||||
M: heading2 (write-farkup) [ child>> (write-farkup) ] "h2" in-tag. ;
|
||||
M: heading3 (write-farkup) [ child>> (write-farkup) ] "h3" in-tag. ;
|
||||
M: heading4 (write-farkup) [ child>> (write-farkup) ] "h4" in-tag. ;
|
||||
M: strong (write-farkup) [ child>> (write-farkup) ] "strong" in-tag. ;
|
||||
M: emphasis (write-farkup) [ child>> (write-farkup) ] "em" in-tag. ;
|
||||
M: superscript (write-farkup) [ child>> (write-farkup) ] "sup" in-tag. ;
|
||||
M: subscript (write-farkup) [ child>> (write-farkup) ] "sub" in-tag. ;
|
||||
M: inline-code (write-farkup) [ child>> (write-farkup) ] "code" in-tag. ;
|
||||
M: list-item (write-farkup) [ child>> (write-farkup) ] "li" in-tag. ;
|
||||
M: unordered-list (write-farkup) [ child>> (write-farkup) ] "ul" in-tag. ;
|
||||
M: ordered-list (write-farkup) [ child>> (write-farkup) ] "ol" in-tag. ;
|
||||
M: paragraph (write-farkup) [ child>> (write-farkup) ] "p" in-tag. ;
|
||||
M: link (write-farkup) [ href>> ] [ text>> ] bi write-link ;
|
||||
M: image (write-farkup) [ href>> ] [ text>> ] bi write-image-link ;
|
||||
M: code (write-farkup) [ string>> ] [ mode>> ] bi render-code ;
|
||||
M: line (write-farkup) drop <hr/> ;
|
||||
M: line-break (write-farkup) drop <br/> nl ;
|
||||
M: table-row (write-farkup) ( obj -- )
|
||||
child>> [ [ [ (write-farkup) ] "td" in-tag. ] each ] "tr" in-tag. ;
|
||||
M: table (write-farkup) [ child>> (write-farkup) ] "table" in-tag. ;
|
||||
M: string (write-farkup) escape-string write ;
|
||||
M: vector (write-farkup) [ (write-farkup) ] each ;
|
||||
M: f (write-farkup) drop ;
|
||||
GENERIC: (write-farkup) ( farkup -- xml )
|
||||
|
||||
: farkup-inside ( farkup name -- xml )
|
||||
<simple-name> swap T{ attrs } swap
|
||||
child>> (write-farkup) 1array <tag> ;
|
||||
|
||||
M: heading1 (write-farkup) "h1" farkup-inside ;
|
||||
M: heading2 (write-farkup) "h2" farkup-inside ;
|
||||
M: heading3 (write-farkup) "h3" farkup-inside ;
|
||||
M: heading4 (write-farkup) "h4" farkup-inside ;
|
||||
M: strong (write-farkup) "strong" farkup-inside ;
|
||||
M: emphasis (write-farkup) "em" farkup-inside ;
|
||||
M: superscript (write-farkup) "sup" farkup-inside ;
|
||||
M: subscript (write-farkup) "sub" farkup-inside ;
|
||||
M: inline-code (write-farkup) "code" farkup-inside ;
|
||||
M: list-item (write-farkup) "li" farkup-inside ;
|
||||
M: unordered-list (write-farkup) "ul" farkup-inside ;
|
||||
M: ordered-list (write-farkup) "ol" farkup-inside ;
|
||||
M: paragraph (write-farkup) "p" farkup-inside ;
|
||||
M: table (write-farkup) "table" farkup-inside ;
|
||||
|
||||
M: link (write-farkup)
|
||||
[ href>> ] [ text>> ] bi write-link ;
|
||||
|
||||
M: image (write-farkup)
|
||||
[ href>> ] [ text>> ] bi write-image-link ;
|
||||
|
||||
M: code (write-farkup)
|
||||
[ string>> ] [ mode>> ] bi render-code ;
|
||||
|
||||
M: line (write-farkup)
|
||||
drop [XML <hr/> XML] ;
|
||||
|
||||
M: line-break (write-farkup)
|
||||
drop [XML <br/> XML] ;
|
||||
|
||||
M: table-row (write-farkup)
|
||||
child>>
|
||||
[ (write-farkup) [XML <td><-></td> XML] ] map
|
||||
[XML <tr><-></tr> XML] ;
|
||||
|
||||
M: string (write-farkup) ;
|
||||
|
||||
M: vector (write-farkup) [ (write-farkup) ] map ;
|
||||
|
||||
M: f (write-farkup) ;
|
||||
|
||||
: write-farkup ( string -- )
|
||||
parse-farkup (write-farkup) ;
|
||||
parse-farkup (write-farkup) write-xml-chunk ;
|
||||
|
||||
: convert-farkup ( string -- string' )
|
||||
parse-farkup [ (write-farkup) ] with-string-writer ;
|
||||
[ write-farkup ] with-string-writer ;
|
||||
|
|
|
|||
|
|
@ -1,48 +1,45 @@
|
|||
USING: xmode.tokens xmode.marker xmode.catalog kernel
|
||||
USING: xmode.tokens xmode.marker xmode.catalog kernel locals
|
||||
html.elements io io.files sequences words io.encodings.utf8
|
||||
namespaces xml.entities accessors ;
|
||||
namespaces xml.entities accessors xml.interpolate locals xml.writer ;
|
||||
IN: xmode.code2html
|
||||
|
||||
: htmlize-tokens ( tokens -- )
|
||||
: htmlize-tokens ( tokens -- xml )
|
||||
[
|
||||
[ str>> ] [ id>> ] bi [
|
||||
<span name>> =class span> escape-string write </span>
|
||||
] [
|
||||
escape-string write
|
||||
] if*
|
||||
] each ;
|
||||
name>> swap
|
||||
[XML <span class=<->><-></span> XML]
|
||||
] [ ] if*
|
||||
] map ;
|
||||
|
||||
: htmlize-line ( line-context line rules -- line-context' )
|
||||
: htmlize-line ( line-context line rules -- line-context' xml )
|
||||
tokenize-line htmlize-tokens ;
|
||||
|
||||
: htmlize-lines ( lines mode -- )
|
||||
f swap load-mode [ htmlize-line nl ] curry reduce drop ;
|
||||
: htmlize-lines ( lines mode -- xml )
|
||||
f -rot load-mode [ htmlize-line ] curry map nip ;
|
||||
|
||||
: default-stylesheet ( -- )
|
||||
<style>
|
||||
"resource:basis/xmode/code2html/stylesheet.css"
|
||||
utf8 file-contents escape-string write
|
||||
</style> ;
|
||||
: default-stylesheet ( -- xml )
|
||||
"resource:basis/xmode/code2html/stylesheet.css"
|
||||
utf8 file-contents
|
||||
[XML <style><-></style> XML] ;
|
||||
|
||||
: htmlize-stream ( path stream -- )
|
||||
lines swap
|
||||
<html>
|
||||
:: htmlize-stream ( path stream -- xml )
|
||||
stream lines
|
||||
[ "" ] [ first find-mode path swap htmlize-lines ]
|
||||
if-empty :> input
|
||||
default-stylesheet :> stylesheet
|
||||
<XML <html>
|
||||
<head>
|
||||
default-stylesheet
|
||||
<title> dup escape-string write </title>
|
||||
<-stylesheet->
|
||||
<title><-path-></title>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
over empty?
|
||||
[ 2drop ]
|
||||
[ over first find-mode htmlize-lines ] if
|
||||
</pre>
|
||||
<pre><-input-></pre>
|
||||
</body>
|
||||
</html> ;
|
||||
</html> XML> ;
|
||||
|
||||
: htmlize-file ( path -- )
|
||||
dup utf8 [
|
||||
dup ".html" append utf8 [
|
||||
input-stream get htmlize-stream
|
||||
input-stream get htmlize-stream write-xml
|
||||
] with-file-writer
|
||||
] with-file-reader ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue