steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Farkup parser rewrite

db4
Daniel Ehrenberg 2009-03-16 00:42:48 -05:00
parent 03684713c9
commit 941e56b046
2 changed files with 218 additions and 154 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

100
basis/farkup/farkup-tests.factor
View File

@ -20,50 +20,50 @@ link-no-follow? off
] unit-test ] unit-test
[ "<p>a-b</p>" ] [ "a-b" convert-farkup ] unit-test [ "<p>a-b</p>" ] [ "a-b" convert-farkup ] unit-test
[ "<p>*foo\nbar\n</p>" ] [ "*foo\nbar\n" convert-farkup ] unit-test [ "<p><strong>foo</strong></p><p>bar</p>" ] [ "*foo\nbar\n" convert-farkup ] unit-test
[ "<p><strong>Wow!</strong></p>" ] [ "*Wow!*" convert-farkup ] unit-test [ "<p><strong>Wow!</strong></p>" ] [ "*Wow!*" convert-farkup ] unit-test
[ "<p><em>Wow.</em></p>" ] [ "_Wow._" convert-farkup ] unit-test [ "<p><em>Wow.</em></p>" ] [ "_Wow._" convert-farkup ] unit-test
[ "<p>*</p>" ] [ "*" convert-farkup ] unit-test [ "<p><strong></strong></p>" ] [ "*" convert-farkup ] unit-test
[ "<p>*</p>" ] [ "\\*" convert-farkup ] unit-test [ "<p>*</p>" ] [ "\\*" convert-farkup ] unit-test
[ "<p>**</p>" ] [ "\\**" convert-farkup ] unit-test [ "<p>*<strong></strong></p>" ] [ "\\**" convert-farkup ] unit-test
[ "<ul><li>a-b</li></ul>" ] [ "-a-b" convert-farkup ] unit-test [ "<ul><li>a-b</li></ul>" ] [ "-a-b" convert-farkup ] unit-test
[ "<ul><li>foo</li></ul>" ] [ "-foo" convert-farkup ] unit-test [ "<ul><li>foo</li></ul>" ] [ "-foo" convert-farkup ] unit-test
[ "<ul><li>foo</li>\n</ul>" ] [ "-foo\n" convert-farkup ] unit-test [ "<ul><li>foo</li></ul>" ] [ "-foo\n" convert-farkup ] unit-test
[ "<ul><li>foo</li>\n<li>bar</li></ul>" ] [ "-foo\n-bar" convert-farkup ] unit-test [ "<ul><li>foo</li><li>bar</li></ul>" ] [ "-foo\n-bar" convert-farkup ] unit-test
[ "<ul><li>foo</li>\n<li>bar</li>\n</ul>" ] [ "-foo\n-bar\n" convert-farkup ] unit-test [ "<ul><li>foo</li><li>bar</li></ul>" ] [ "-foo\n-bar\n" convert-farkup ] unit-test
[ "<ul><li>foo</li>\n</ul><p>bar\n</p>" ] [ "-foo\nbar\n" convert-farkup ] unit-test [ "<ul><li>foo</li></ul><p>bar</p>" ] [ "-foo\nbar\n" convert-farkup ] unit-test
[ "<ol><li>a-b</li></ol>" ] [ "#a-b" convert-farkup ] unit-test [ "<ol><li>a-b</li></ol>" ] [ "#a-b" convert-farkup ] unit-test
[ "<ol><li>foo</li></ol>" ] [ "#foo" convert-farkup ] unit-test [ "<ol><li>foo</li></ol>" ] [ "#foo" convert-farkup ] unit-test
[ "<ol><li>foo</li>\n</ol>" ] [ "#foo\n" convert-farkup ] unit-test [ "<ol><li>foo</li></ol>" ] [ "#foo\n" convert-farkup ] unit-test
[ "<ol><li>foo</li>\n<li>bar</li></ol>" ] [ "#foo\n#bar" convert-farkup ] unit-test [ "<ol><li>foo</li><li>bar</li></ol>" ] [ "#foo\n#bar" convert-farkup ] unit-test
[ "<ol><li>foo</li>\n<li>bar</li>\n</ol>" ] [ "#foo\n#bar\n" convert-farkup ] unit-test [ "<ol><li>foo</li><li>bar</li></ol>" ] [ "#foo\n#bar\n" convert-farkup ] unit-test
[ "<ol><li>foo</li>\n</ol><p>bar\n</p>" ] [ "#foo\nbar\n" convert-farkup ] unit-test [ "<ol><li>foo</li></ol><p>bar</p>" ] [ "#foo\nbar\n" convert-farkup ] unit-test
[ "\n\n" ] [ "\n\n" convert-farkup ] unit-test [ "" ] [ "\n\n" convert-farkup ] unit-test
[ "\n\n" ] [ "\r\n\r\n" convert-farkup ] unit-test [ "" ] [ "\r\n\r\n" convert-farkup ] unit-test
[ "\n\n\n\n" ] [ "\r\r\r\r" convert-farkup ] unit-test [ "" ] [ "\r\r\r\r" convert-farkup ] unit-test
[ "\n\n\n" ] [ "\r\r\r" convert-farkup ] unit-test [ "" ] [ "\r\r\r" convert-farkup ] unit-test
[ "\n\n\n" ] [ "\n\n\n" convert-farkup ] unit-test [ "" ] [ "\n\n\n" convert-farkup ] unit-test
[ "<p>foo\n</p><p>bar</p>" ] [ "foo\n\nbar" convert-farkup ] unit-test [ "<p>foo</p><p>bar</p>" ] [ "foo\n\nbar" convert-farkup ] unit-test
[ "<p>foo\n</p><p>bar</p>" ] [ "foo\r\n\r\nbar" convert-farkup ] unit-test [ "<p>foo</p><p>bar</p>" ] [ "foo\r\n\r\nbar" convert-farkup ] unit-test
[ "<p>foo\n</p><p>bar</p>" ] [ "foo\r\rbar" convert-farkup ] unit-test [ "<p>foo</p><p>bar</p>" ] [ "foo\r\rbar" convert-farkup ] unit-test
[ "<p>foo\n</p><p>bar</p>" ] [ "foo\r\r\nbar" convert-farkup ] unit-test [ "<p>foo</p><p>bar</p>" ] [ "foo\r\r\nbar" convert-farkup ] unit-test
[ "\n<p>bar\n</p>" ] [ "\nbar\n" convert-farkup ] unit-test [ "<p>bar</p>" ] [ "\nbar\n" convert-farkup ] unit-test
[ "\n<p>bar\n</p>" ] [ "\rbar\r" convert-farkup ] unit-test [ "<p>bar</p>" ] [ "\rbar\r" convert-farkup ] unit-test
[ "\n<p>bar\n</p>" ] [ "\r\nbar\r\n" convert-farkup ] unit-test [ "<p>bar</p>" ] [ "\r\nbar\r\n" convert-farkup ] unit-test
[ "<p>foo\n</p><p>bar</p>" ] [ "foo\n\n\nbar" convert-farkup ] unit-test [ "<p>foo</p><p>bar</p>" ] [ "foo\n\n\nbar" convert-farkup ] unit-test
[ "" ] [ "" convert-farkup ] unit-test [ "" ] [ "" convert-farkup ] unit-test
[ "<p>|a</p>" ] [ "<table><tr><td>a</td></tr></table>" ]
[ "|a" convert-farkup ] unit-test [ "|a" convert-farkup ] unit-test
[ "<table><tr><td>a</td></tr></table>" ] [ "<table><tr><td>a</td></tr></table>" ]
@ -78,24 +78,24 @@ link-no-follow? off
[ "<table><tr><td>a</td><td>b</td></tr><tr><td>c</td><td>d</td></tr></table>" ] [ "<table><tr><td>a</td><td>b</td></tr><tr><td>c</td><td>d</td></tr></table>" ]
[ "|a|b|\n|c|d|\n" convert-farkup ] unit-test [ "|a|b|\n|c|d|\n" convert-farkup ] unit-test
[ "<p><strong>foo</strong>\n</p><h1>aheading</h1>\n<p>adfasd</p>" ] [ "<p><strong>foo</strong></p><h1>aheading</h1><p>adfasd</p>" ]
[ "*foo*\n=aheading=\nadfasd" convert-farkup ] unit-test [ "*foo*\n=aheading=\nadfasd" convert-farkup ] unit-test
[ "<h1>foo</h1>\n" ] [ "=foo=\n" convert-farkup ] unit-test [ "<h1>foo</h1>" ] [ "=foo=\n" convert-farkup ] unit-test
[ "<p>lol</p><h1>foo</h1>\n" ] [ "lol=foo=\n" convert-farkup ] unit-test [ "<p>lol=foo=</p>" ] [ "lol=foo=\n" convert-farkup ] unit-test
[ "<p>=foo\n</p>" ] [ "=foo\n" convert-farkup ] unit-test [ "<p>=foo</p>" ] [ "=foo\n" convert-farkup ] unit-test
[ "<p>=foo</p>" ] [ "=foo" convert-farkup ] unit-test [ "<p>=foo</p>" ] [ "=foo" convert-farkup ] unit-test
[ "<p>==foo</p>" ] [ "==foo" convert-farkup ] unit-test [ "<p>==foo</p>" ] [ "==foo" convert-farkup ] unit-test
[ "<p>=</p><h1>foo</h1>" ] [ "==foo=" convert-farkup ] unit-test [ "<h1>foo</h1>" ] [ "==foo=" convert-farkup ] unit-test
[ "<h2>foo</h2>" ] [ "==foo==" convert-farkup ] unit-test [ "<h2>foo</h2>" ] [ "==foo==" convert-farkup ] unit-test
[ "<h2>foo</h2>" ] [ "==foo==" convert-farkup ] unit-test [ "<h2>foo</h2>" ] [ "==foo==" convert-farkup ] unit-test
[ "<p>=</p><h2>foo</h2>" ] [ "===foo==" convert-farkup ] unit-test [ "<h2>foo</h2>" ] [ "===foo==" convert-farkup ] unit-test
[ "<h1>foo</h1><p>=</p>" ] [ "=foo==" convert-farkup ] unit-test [ "<h1>foo</h1>" ] [ "=foo==" convert-farkup ] unit-test
[ "<pre><span class=\"KEYWORD3\">int</span> <span class=\"FUNCTION\">main</span><span class=\"OPERATOR\">(</span><span class=\"OPERATOR\">)</span></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 [ "[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=\"image: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><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\">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=\"http://lol.com\">haha</a></p>" ] [ "[[http://lol.com|haha]]" convert-farkup ] unit-test
@ -111,11 +111,11 @@ link-no-follow? off
[ "<pre>hello</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>" "<p>Feature comparison:</p><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>"
] [ "Feature comparison:\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 ] [ "Feature comparison:\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>Feature comparison:\n</p><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:</p><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>"
] [ "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 ] [ "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
[ [
@ -131,33 +131,33 @@ link-no-follow? off
[ "<p>&lt;foo&gt;</p>" ] [ "<foo>" convert-farkup ] unit-test [ "<p>&lt;foo&gt;</p>" ] [ "<foo>" convert-farkup ] unit-test
[ "<p>asdf\n<ul><li>lol</li>\n<li>haha</li></ul></p>" ] [ "asdf\n-lol\n-haha" convert-farkup ] unit-test [ "<p>asdf</p><ul><li>lol</li><li>haha</li></ul>" ] [ "asdf\n-lol\n-haha" convert-farkup ] unit-test
[ "<p>asdf\n</p><ul><li>lol</li>\n<li>haha</li></ul>" ] [ "<p>asdf</p><ul><li>lol</li><li>haha</li></ul>" ]
[ "asdf\n\n-lol\n-haha" convert-farkup ] unit-test [ "asdf\n\n-lol\n-haha" convert-farkup ] unit-test
[ "<hr/>" ] [ "___" convert-farkup ] unit-test [ "<hr/>" ] [ "___" convert-farkup ] unit-test
[ "<hr/>\n" ] [ "___\n" convert-farkup ] unit-test [ "<hr/>" ] [ "___\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</pre></p>" ] [ "<p>before:</p><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>" ]
[ "before:\n[factor{{ 1 2 3 } 1 tail}]" convert-farkup ] unit-test [ "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 [ "[[Factor]]-rific!" convert-farkup ] unit-test
[ "<p>[ factor { 1 2 3 }]</p>" ] [ "<pre> 1 2 3 </pre>" ]
[ "[ factor { 1 2 3 }]" convert-farkup ] unit-test [ "[ factor { 1 2 3 }]" convert-farkup ] unit-test
[ "<p>paragraph\n<hr/></p>" ] [ "<p>paragraph</p><hr/>" ]
[ "paragraph\n___" convert-farkup ] unit-test [ "paragraph\n___" convert-farkup ] unit-test
[ "<p>paragraph\n a ___ b</p>" ] [ "<p>paragraph</p><p> a <em></em><em> b</em></p>" ]
[ "paragraph\n a ___ b" convert-farkup ] unit-test [ "paragraph\n a ___ b" convert-farkup ] unit-test
[ "\n<ul><li> a</li>\n</ul><hr/>" ] [ "<ul><li> a</li></ul><hr/>" ]
[ "\n- a\n___" convert-farkup ] unit-test [ "\n- a\n___" convert-farkup ] unit-test
[ "<p>hello_world how are you today?\n<ul><li> hello_world how are you today?</li></ul></p>" ] [ "<p>hello<em>world how are you today?</em></p><ul><li> hello<em>world how are you today?</em></li></ul>" ]
[ "hello_world how are you today?\n- hello_world how are you today?" convert-farkup ] unit-test [ "hello_world how are you today?\n- hello_world how are you today?" convert-farkup ] unit-test
: check-link-escaping ( string -- link ) : check-link-escaping ( string -- link )
@ -168,3 +168,15 @@ link-no-follow? off
[ "<foo>" ] [ "[[<foo>]]" check-link-escaping ] unit-test [ "<foo>" ] [ "[[<foo>]]" check-link-escaping ] unit-test
[ "&blah;" ] [ "[[&blah;]]" 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
[ "<h1>The <em>important</em> thing</h1>" ] [ "=The _important_ thing=" convert-farkup ] unit-test
[ "<p><a href=\"Foo\"><strong>emphasized</strong> text</a></p>" ] [ "[[Foo|*emphasized* text]]" convert-farkup ] unit-test
[ "<table><tr><td><strong>bold</strong></td><td><em>italics</em></td></tr></table>" ]
[ "|*bold*|_italics_|" convert-farkup ] unit-test
[ "<p><em>italics<strong>both</strong></em></p>" ] [ "_italics*both" convert-farkup ] unit-test
[ "<p><em>italics<strong>both</strong></em></p>" ] [ "_italics*both*" convert-farkup ] unit-test
[ "<p><em>italics<strong>both</strong></em></p>" ] [ "_italics*both*_" convert-farkup ] unit-test
[ "<p><em>italics<strong>both</strong></em></p>" ] [ "_italics*both_" convert-farkup ] unit-test
[ "<p><em>italics<strong>both</strong></em>after<strong></strong></p>" ] [ "_italics*both_after*" convert-farkup ] unit-test
[ "<table><tr><td>foo|bar</td></tr></table>" ] [ "|foo\\|bar|" convert-farkup ] unit-test
[ "<p></p>" ] [ "\\" convert-farkup ] unit-test

272
basis/farkup/farkup.factor Executable file → Normal file
View File

@ -1,10 +1,9 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays combinators io USING: sequences kernel splitting lists fry accessors assocs math.order
io.streams.string kernel math namespaces peg peg.ebnf math combinators namespaces urls.encoding xml.syntax xmode.code2html
sequences sequences.deep strings xml.entities xml.syntax xml.data arrays strings vectors xml.writer io.streams.string locals
vectors splitting xmode.code2html urls.encoding xml.data unicode.categories ;
xml.writer ;
IN: farkup IN: farkup
SYMBOL: relative-link-prefix SYMBOL: relative-link-prefix
@ -39,123 +38,174 @@ TUPLE: line-break ;
: simple-link-title ( string -- string' ) : simple-link-title ( string -- string' )
dup absolute-url? [ "/" split1-last swap or ] unless ; dup absolute-url? [ "/" split1-last swap or ] unless ;
EBNF: parse-farkup ! _foo*bar_baz*bing works like <i>foo*bar</i>baz<b>bing</b>
nl = ("\r\n" | "\r" | "\n") => [[ drop "\n" ]] ! I could support overlapping, but there's not a good use case for it.
whitespace = " " | "\t" | nl
heading1 = "=" (!("=" | nl).)+ "=" DEFER: (parse-paragraph)
=> [[ second >string heading1 boa ]]
heading2 = "==" (!("=" | nl).)+ "==" : parse-paragraph ( string -- seq )
=> [[ second >string heading2 boa ]] (parse-paragraph) list>array ;
heading3 = "===" (!("=" | nl).)+ "===" : make-paragraph ( string -- paragraph )
=> [[ second >string heading3 boa ]] parse-paragraph paragraph boa ;
heading4 = "====" (!("=" | nl).)+ "====" : cut-half-slice ( string i -- before after-slice )
=> [[ second >string heading4 boa ]] [ head ] [ 1+ short tail-slice ] 2bi ;
heading = heading4 | heading3 | heading2 | heading1 : find-cut ( string quot -- before after delimiter )
dupd find
[ [ cut-half-slice ] [ f ] if* ] dip ; inline
: parse-delimiter ( string delimiter class -- paragraph )
[ '[ _ = ] find-cut drop ] dip
'[ parse-paragraph _ new swap >>child ]
[ (parse-paragraph) ] bi* cons ;
: delimiter-class ( delimiter -- class )
H{
{ CHAR: * strong }
{ CHAR: _ emphasis }
{ CHAR: ^ superscript }
{ CHAR: ~ subscript }
{ CHAR: % inline-code }
} at ;
strong = "*" (!("*" | nl).)+ "*" : parse-link ( string -- paragraph-list )
=> [[ second >string strong boa ]] rest-slice "]]" split1-slice [
"|" split1
[ "" like dup simple-link-title ] unless*
[ "image:" ?head ] dip swap [ image boa ] [ parse-paragraph link boa ] if
] dip [ (parse-paragraph) cons ] when* ;
emphasis = "_" (!("_" | nl).)+ "_" : ?first ( seq -- elt ) 0 swap ?nth ;
=> [[ second >string emphasis boa ]]
superscript = "^" (!("^" | nl).)+ "^" : parse-big-link ( before after -- link rest )
=> [[ second >string superscript boa ]] dup ?first CHAR: [ =
[ parse-link ]
[ [ CHAR: [ suffix ] [ (parse-paragraph) ] bi* ]
if ;
subscript = "~" (!("~" | nl).)+ "~" : escape ( before after -- before' after' )
=> [[ second >string subscript boa ]] [ nil ] [ unclip-slice swap [ suffix ] dip (parse-paragraph) ] if-empty ;
inline-code = "%" (!("%" | nl).)+ "%" : (parse-paragraph) ( string -- list )
=> [[ second >string inline-code boa ]] [ nil ] [
[ "*_^~%[\\" member? ] find-cut [
{
{ CHAR: [ [ parse-big-link ] }
{ CHAR: \\ [ escape ] }
[ dup delimiter-class parse-delimiter ]
} case cons
] [ drop "" like 1list ] if*
] if-empty ;
link-content = (!("|"|"]").)+ : <farkup-state> ( string -- state ) string-lines ;
=> [[ >string ]] : look ( state i -- char ) swap first ?nth ;
: done? ( state -- ? ) empty? ;
: take-line ( state -- state' line ) unclip-slice ;
image-link = "[[image:" link-content "|" link-content "]]" : take-lines ( state char -- state' lines )
=> [[ [ second >string ] [ fourth >string ] bi image boa ]] dupd '[ ?first _ = not ] find drop
| "[[image:" link-content "]]" [ cut-slice ] [ f ] if* swap ;
=> [[ second >string f image boa ]]
simple-link = "[[" link-content "]]" :: (take-until) ( state delimiter accum -- string/f state' )
=> [[ second >string dup simple-link-title link boa ]] state empty? [ accum "\n" join f ] [
state unclip-slice :> first :> rest
first delimiter split1 :> after :> before
before accum push
after [
accum "\n" join
rest after prefix
] [
rest delimiter accum (take-until)
] if
] if ;
labeled-link = "[[" link-content "|" link-content "]]" : take-until ( state delimiter -- string/f state' )
=> [[ [ second >string ] [ fourth >string ] bi link boa ]] V{ } clone (take-until) ;
link = image-link | labeled-link | simple-link : count= ( string -- n )
dup <reversed> [ [ CHAR: = = not ] find drop 0 or ] bi@ min ;
escaped-char = "\" . : trim= ( string -- string' )
=> [[ second 1string ]] [ CHAR: = = ] trim ;
inline-tag = strong | emphasis | superscript | subscript | inline-code : make-heading ( string class -- heading )
| link | escaped-char [ trim= parse-paragraph ] dip boa ; inline
: parse-heading ( state -- state' heading )
take-line dup count= {
{ 0 [ make-paragraph ] }
{ 1 [ heading1 make-heading ] }
{ 2 [ heading2 make-heading ] }
{ 3 [ heading3 make-heading ] }
{ 4 [ heading4 make-heading ] }
[ drop heading4 make-heading ]
} case ;
: trim-row ( seq -- seq' )
rest
dup peek empty? [ but-last ] when ;
inline-delimiter = '*' | '_' | '^' | '~' | '%' | '\' | '[' : ?peek ( seq -- elt/f )
[ f ] [ peek ] if-empty ;
cell = (!(inline-delimiter | '|' | nl).)+ : coalesce ( rows -- rows' )
=> [[ >string ]] V{ } clone [
'[
table-column = (list | cell | inline-tag | inline-delimiter ) '|' _ dup ?peek ?peek CHAR: \\ =
=> [[ first ]] [ [ pop "|" rot 3append ] keep ] when
table-row = "|" (table-column)+ push
=> [[ second table-row boa ]] ] each
table = ((table-row nl => [[ first ]] )+ table-row? | table-row) ] keep ;
=> [[ table boa ]]
text = (!(nl | code | heading | inline-delimiter | table ).)+ : parse-table ( state -- state' table )
=> [[ >string ]] CHAR: | take-lines [
"|" split
trim-row
coalesce
[ parse-paragraph ] map
table-row boa
] map table boa ;
paragraph-nl-item = nl list : parse-line ( state -- state' item )
| nl line take-line dup "___" =
| nl => [[ line-breaks? get [ drop line-break new ] when ]] [ drop line new ] [ make-paragraph ] if ;
paragraph-item = (table | code | text | inline-tag | inline-delimiter)+
paragraph = ((paragraph-item paragraph-nl-item)+ nl+ => [[ first ]]
| (paragraph-item paragraph-nl-item)+ paragraph-item?
| paragraph-item)
=> [[ paragraph boa ]]
: parse-list ( state char class -- state' list )
[
take-lines
[ rest parse-paragraph list-item boa ] map
] dip boa ; inline
list-item = (cell | inline-tag | inline-delimiter)* : parse-ul ( state -- state' ul )
CHAR: - unordered-list parse-list ;
ordered-list-item = '#' list-item : parse-ol ( state -- state' ul )
=> [[ second list-item boa ]] CHAR: # ordered-list parse-list ;
ordered-list = ((ordered-list-item nl)+ ordered-list-item? | ordered-list-item)
=> [[ ordered-list boa ]]
unordered-list-item = '-' list-item : parse-code ( state -- state' item )
=> [[ second list-item boa ]] dup 1 look CHAR: [ =
unordered-list = ((unordered-list-item nl)+ unordered-list-item? | unordered-list-item) [ unclip-slice make-paragraph ] [
=> [[ unordered-list boa ]] "{" take-until [ rest ] dip
"}]" take-until
[ code boa ] dip swap
] if ;
list = ordered-list | unordered-list : parse-item ( state -- state' item )
dup 0 look {
{ CHAR: = [ parse-heading ] }
{ CHAR: | [ parse-table ] }
{ CHAR: _ [ parse-line ] }
{ CHAR: - [ parse-ul ] }
{ CHAR: # [ parse-ol ] }
{ CHAR: [ [ parse-code ] }
{ f [ rest-slice f ] }
[ drop take-line make-paragraph ]
} case ;
: parse-farkup ( string -- farkup )
line = '___' <farkup-state> [ dup done? not ] [ parse-item ] produce nip sift ;
=> [[ drop line new ]]
named-code
= '[' (!('{' | whitespace | '[').)+ '{' (!("}]").)+ "}]"
=> [[ [ second >string ] [ fourth >string ] bi code boa ]]
simple-code
= "[{" (!("}]").)+ "}]"
=> [[ second >string f swap code boa ]]
code = named-code | simple-code
stand-alone
= (line | code | heading | list | table | paragraph | nl)*
;EBNF
CONSTANT: invalid-url "javascript:alert('Invalid URL in farkup');" CONSTANT: invalid-url "javascript:alert('Invalid URL in farkup');"
@ -168,19 +218,6 @@ CONSTANT: invalid-url "javascript:alert('Invalid URL in farkup');"
[ relative-link-prefix get prepend "" like url-encode ] [ relative-link-prefix get prepend "" like url-encode ]
} cond ; } cond ;
: write-link ( href text -- xml )
[ check-url link-no-follow? get "nofollow" and ] dip
[XML <a href=<-> rel=<->><-></a> XML] ;
: write-image-link ( href text -- xml )
disable-images? get [
2drop
[XML <strong>Images are not allowed</strong> XML]
] [
[ check-url ] [ f like ] bi*
[XML <img src=<-> alt=<->/> XML]
] if ;
: render-code ( string mode -- xml ) : render-code ( string mode -- xml )
[ string-lines ] dip htmlize-lines [ string-lines ] dip htmlize-lines
[XML <pre><-></pre> XML] ; [XML <pre><-></pre> XML] ;
@ -206,11 +243,27 @@ M: ordered-list (write-farkup) "ol" farkup-inside ;
M: paragraph (write-farkup) "p" farkup-inside ; M: paragraph (write-farkup) "p" farkup-inside ;
M: table (write-farkup) "table" farkup-inside ; M: table (write-farkup) "table" farkup-inside ;
: write-link ( href text -- xml )
[ check-url link-no-follow? get "nofollow" and ] dip
[XML <a href=<-> rel=<->><-></a> XML] ;
: write-image-link ( href text -- xml )
disable-images? get [
2drop
[XML <strong>Images are not allowed</strong> XML]
] [
[ check-url ] [ f like ] bi*
[XML <img src=<-> alt=<->/> XML]
] if ;
: open-link ( link -- href text )
[ href>> ] [ text>> (write-farkup) ] bi ;
M: link (write-farkup) M: link (write-farkup)
[ href>> ] [ text>> ] bi write-link ; open-link write-link ;
M: image (write-farkup) M: image (write-farkup)
[ href>> ] [ text>> ] bi write-image-link ; open-link write-image-link ;
M: code (write-farkup) M: code (write-farkup)
[ string>> ] [ mode>> ] bi render-code ; [ string>> ] [ mode>> ] bi render-code ;
@ -228,9 +281,7 @@ M: table-row (write-farkup)
M: string (write-farkup) ; M: string (write-farkup) ;
M: vector (write-farkup) [ (write-farkup) ] map ; M: array (write-farkup) [ (write-farkup) ] map ;
M: f (write-farkup) ;
: farkup>xml ( string -- xml ) : farkup>xml ( string -- xml )
parse-farkup (write-farkup) ; parse-farkup (write-farkup) ;
@ -240,3 +291,4 @@ M: f (write-farkup) ;
: convert-farkup ( string -- string' ) : convert-farkup ( string -- string' )
[ write-farkup ] with-string-writer ; [ write-farkup ] with-string-writer ;