[ "<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>"
] [ "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
[ "<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>" ]
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
\ No newline at end of file
+[ "C++" ] [ "[[C++]]" check-link-escaping ] unit-test
! 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
=> [[ second >string inline-code boa ]]
link-content = (!("|"|"]").)+
+ => [[ >string ]]
image-link = "[[image:" link-content "|" link-content "]]"
=> [[ [ second >string ] [ fourth >string ] bi image boa ]]
simple-code
= "[{" (!("}]").)+ "}]"
- => [[ second f swap code boa ]]
+ => [[ second >string f swap code boa ]]
code = named-code | simple-code
{ [ 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 ;
-
-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 ;
+: render-code ( string mode -- xml )
+ [ string-lines ] dip htmlize-lines
+ [XML <pre><-></pre> XML] ;
+
+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 ;
-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 ;
projects / factor.git / commitdiff