Farkup parser rewrite
Daniel Ehrenberg
parent
03684713c9
commit
941e56b046
|
|
@ -20,50 +20,50 @@ link-no-follow? off
|
|||
] 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><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>*<strong></strong></p>" ] [ "\\**" 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>\n</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>\n<li>bar</li>\n</ul>" ] [ "-foo\n-bar\n" convert-farkup ] unit-test
|
||||
[ "<ul><li>foo</li></ul>" ] [ "-foo\n" convert-farkup ] unit-test
|
||||
[ "<ul><li>foo</li><li>bar</li></ul>" ] [ "-foo\n-bar" 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>foo</li></ol>" ] [ "#foo" convert-farkup ] unit-test
|
||||
[ "<ol><li>foo</li>\n</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>\n<li>bar</li>\n</ol>" ] [ "#foo\n#bar\n" convert-farkup ] unit-test
|
||||
[ "<ol><li>foo</li></ol>" ] [ "#foo\n" convert-farkup ] unit-test
|
||||
[ "<ol><li>foo</li><li>bar</li></ol>" ] [ "#foo\n#bar" 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" ] [ "\r\n\r\n" convert-farkup ] unit-test
|
||||
[ "\n\n\n\n" ] [ "\r\r\r\r" convert-farkup ] unit-test
|
||||
[ "\n\n\n" ] [ "\r\r\r" convert-farkup ] unit-test
|
||||
[ "\n\n\n" ] [ "\n\n\n" convert-farkup ] unit-test
|
||||
[ "<p>foo\n</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\n</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
|
||||
[ "" ] [ "\n\n" convert-farkup ] unit-test
|
||||
[ "" ] [ "\r\n\r\n" convert-farkup ] unit-test
|
||||
[ "" ] [ "\r\r\r\r" convert-farkup ] unit-test
|
||||
[ "" ] [ "\r\r\r" convert-farkup ] unit-test
|
||||
[ "" ] [ "\n\n\n" convert-farkup ] unit-test
|
||||
[ "<p>foo</p><p>bar</p>" ] [ "foo\n\nbar" convert-farkup ] unit-test
|
||||
[ "<p>foo</p><p>bar</p>" ] [ "foo\r\n\r\nbar" convert-farkup ] unit-test
|
||||
[ "<p>foo</p><p>bar</p>" ] [ "foo\r\rbar" 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
|
||||
[ "\n<p>bar\n</p>" ] [ "\rbar\r" convert-farkup ] unit-test
|
||||
[ "\n<p>bar\n</p>" ] [ "\r\nbar\r\n" convert-farkup ] unit-test
|
||||
[ "<p>bar</p>" ] [ "\nbar\n" convert-farkup ] unit-test
|
||||
[ "<p>bar</p>" ] [ "\rbar\r" 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
|
||||
|
||||
[ "<p>|a</p>" ]
|
||||
[ "<table><tr><td>a</td></tr></table>" ]
|
||||
[ "|a" convert-farkup ] unit-test
|
||||
|
||||
[ "<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>" ]
|
||||
[ "|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
|
||||
|
||||
[ "<h1>foo</h1>\n" ] [ "=foo=\n" convert-farkup ] unit-test
|
||||
[ "<p>lol</p><h1>foo</h1>\n" ] [ "lol=foo=\n" convert-farkup ] unit-test
|
||||
[ "<p>=foo\n</p>" ] [ "=foo\n" convert-farkup ] unit-test
|
||||
[ "<h1>foo</h1>" ] [ "=foo=\n" convert-farkup ] unit-test
|
||||
[ "<p>lol=foo=</p>" ] [ "lol=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>=</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
|
||||
[ "<p>=</p><h2>foo</h2>" ] [ "===foo==" convert-farkup ] unit-test
|
||||
[ "<h1>foo</h1><p>=</p>" ] [ "=foo==" convert-farkup ] unit-test
|
||||
[ "<h2>foo</h2>" ] [ "===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>" ]
|
||||
[ "[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><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
|
||||
|
|
@ -111,11 +111,11 @@ link-no-follow? off
|
|||
[ "<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
|
||||
|
||||
[
|
||||
"<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
|
||||
|
||||
[
|
||||
|
|
@ -131,33 +131,33 @@ link-no-follow? off
|
|||
|
||||
[ "<p><foo></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
|
||||
|
||||
[ "<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
|
||||
|
||||
[ "<p><a href=\"Factor\">Factor</a>-rific!</p>" ]
|
||||
[ "[[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
|
||||
|
||||
[ "<p>paragraph\n<hr/></p>" ]
|
||||
[ "<p>paragraph</p><hr/>" ]
|
||||
[ "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
|
||||
|
||||
[ "\n<ul><li> a</li>\n</ul><hr/>" ]
|
||||
[ "<ul><li> a</li></ul><hr/>" ]
|
||||
[ "\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
|
||||
|
||||
: check-link-escaping ( string -- link )
|
||||
|
|
@ -168,3 +168,15 @@ link-no-follow? off
|
|||
[ "<foo>" ] [ "[[<foo>]]" check-link-escaping ] unit-test
|
||||
[ "&blah;" ] [ "[[&blah;]]" 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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
USING: accessors arrays combinators io
|
||||
io.streams.string kernel math namespaces peg peg.ebnf
|
||||
sequences sequences.deep strings xml.entities xml.syntax
|
||||
vectors splitting xmode.code2html urls.encoding xml.data
|
||||
xml.writer ;
|
||||
USING: sequences kernel splitting lists fry accessors assocs math.order
|
||||
math combinators namespaces urls.encoding xml.syntax xmode.code2html
|
||||
xml.data arrays strings vectors xml.writer io.streams.string locals
|
||||
unicode.categories ;
|
||||
IN: farkup
|
||||
|
||||
SYMBOL: relative-link-prefix
|
||||
|
|
@ -39,123 +38,174 @@ TUPLE: line-break ;
|
|||
: simple-link-title ( string -- string' )
|
||||
dup absolute-url? [ "/" split1-last swap or ] unless ;
|
||||
|
||||
EBNF: parse-farkup
|
||||
nl = ("\r\n" | "\r" | "\n") => [[ drop "\n" ]]
|
||||
whitespace = " " | "\t" | nl
|
||||
! _foo*bar_baz*bing works like <i>foo*bar</i>baz<b>bing</b>
|
||||
! I could support overlapping, but there's not a good use case for it.
|
||||
|
||||
heading1 = "=" (!("=" | nl).)+ "="
|
||||
=> [[ second >string heading1 boa ]]
|
||||
DEFER: (parse-paragraph)
|
||||
|
||||
heading2 = "==" (!("=" | nl).)+ "=="
|
||||
=> [[ second >string heading2 boa ]]
|
||||
: parse-paragraph ( string -- seq )
|
||||
(parse-paragraph) list>array ;
|
||||
|
||||
heading3 = "===" (!("=" | nl).)+ "==="
|
||||
=> [[ second >string heading3 boa ]]
|
||||
: make-paragraph ( string -- paragraph )
|
||||
parse-paragraph paragraph boa ;
|
||||
|
||||
heading4 = "====" (!("=" | nl).)+ "===="
|
||||
=> [[ second >string heading4 boa ]]
|
||||
: cut-half-slice ( string i -- before after-slice )
|
||||
[ 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).)+ "*"
|
||||
=> [[ second >string strong boa ]]
|
||||
: parse-link ( string -- paragraph-list )
|
||||
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).)+ "_"
|
||||
=> [[ second >string emphasis boa ]]
|
||||
: ?first ( seq -- elt ) 0 swap ?nth ;
|
||||
|
||||
superscript = "^" (!("^" | nl).)+ "^"
|
||||
=> [[ second >string superscript boa ]]
|
||||
: parse-big-link ( before after -- link rest )
|
||||
dup ?first CHAR: [ =
|
||||
[ parse-link ]
|
||||
[ [ CHAR: [ suffix ] [ (parse-paragraph) ] bi* ]
|
||||
if ;
|
||||
|
||||
subscript = "~" (!("~" | nl).)+ "~"
|
||||
=> [[ second >string subscript boa ]]
|
||||
: escape ( before after -- before' after' )
|
||||
[ nil ] [ unclip-slice swap [ suffix ] dip (parse-paragraph) ] if-empty ;
|
||||
|
||||
inline-code = "%" (!("%" | nl).)+ "%"
|
||||
=> [[ second >string inline-code boa ]]
|
||||
: (parse-paragraph) ( string -- list )
|
||||
[ 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 = (!("|"|"]").)+
|
||||
=> [[ >string ]]
|
||||
: <farkup-state> ( string -- state ) string-lines ;
|
||||
: look ( state i -- char ) swap first ?nth ;
|
||||
: done? ( state -- ? ) empty? ;
|
||||
: take-line ( state -- state' line ) unclip-slice ;
|
||||
|
||||
image-link = "[[image:" link-content "|" link-content "]]"
|
||||
=> [[ [ second >string ] [ fourth >string ] bi image boa ]]
|
||||
| "[[image:" link-content "]]"
|
||||
=> [[ second >string f image boa ]]
|
||||
: take-lines ( state char -- state' lines )
|
||||
dupd '[ ?first _ = not ] find drop
|
||||
[ cut-slice ] [ f ] if* swap ;
|
||||
|
||||
simple-link = "[[" link-content "]]"
|
||||
=> [[ second >string dup simple-link-title link boa ]]
|
||||
:: (take-until) ( state delimiter accum -- string/f state' )
|
||||
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 "]]"
|
||||
=> [[ [ second >string ] [ fourth >string ] bi link boa ]]
|
||||
: take-until ( state delimiter -- string/f state' )
|
||||
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 = "\" .
|
||||
=> [[ second 1string ]]
|
||||
: trim= ( string -- string' )
|
||||
[ CHAR: = = ] trim ;
|
||||
|
||||
inline-tag = strong | emphasis | superscript | subscript | inline-code
|
||||
| link | escaped-char
|
||||
: make-heading ( string class -- heading )
|
||||
[ 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).)+
|
||||
=> [[ >string ]]
|
||||
|
||||
table-column = (list | cell | inline-tag | inline-delimiter ) '|'
|
||||
=> [[ first ]]
|
||||
table-row = "|" (table-column)+
|
||||
=> [[ second table-row boa ]]
|
||||
table = ((table-row nl => [[ first ]] )+ table-row? | table-row)
|
||||
=> [[ table boa ]]
|
||||
: coalesce ( rows -- rows' )
|
||||
V{ } clone [
|
||||
'[
|
||||
_ dup ?peek ?peek CHAR: \\ =
|
||||
[ [ pop "|" rot 3append ] keep ] when
|
||||
push
|
||||
] each
|
||||
] keep ;
|
||||
|
||||
text = (!(nl | code | heading | inline-delimiter | table ).)+
|
||||
=> [[ >string ]]
|
||||
: parse-table ( state -- state' table )
|
||||
CHAR: | take-lines [
|
||||
"|" split
|
||||
trim-row
|
||||
coalesce
|
||||
[ parse-paragraph ] map
|
||||
table-row boa
|
||||
] map table boa ;
|
||||
|
||||
paragraph-nl-item = nl list
|
||||
| nl line
|
||||
| nl => [[ line-breaks? get [ drop line-break new ] when ]]
|
||||
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-line ( state -- state' item )
|
||||
take-line dup "___" =
|
||||
[ drop line new ] [ make-paragraph ] if ;
|
||||
|
||||
: 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
|
||||
=> [[ second list-item boa ]]
|
||||
ordered-list = ((ordered-list-item nl)+ ordered-list-item? | ordered-list-item)
|
||||
=> [[ ordered-list boa ]]
|
||||
: parse-ol ( state -- state' ul )
|
||||
CHAR: # ordered-list parse-list ;
|
||||
|
||||
unordered-list-item = '-' list-item
|
||||
=> [[ second list-item boa ]]
|
||||
unordered-list = ((unordered-list-item nl)+ unordered-list-item? | unordered-list-item)
|
||||
=> [[ unordered-list boa ]]
|
||||
: parse-code ( state -- state' item )
|
||||
dup 1 look CHAR: [ =
|
||||
[ unclip-slice make-paragraph ] [
|
||||
"{" 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 ;
|
||||
|
||||
|
||||
line = '___'
|
||||
=> [[ 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
|
||||
: parse-farkup ( string -- farkup )
|
||||
<farkup-state> [ dup done? not ] [ parse-item ] produce nip sift ;
|
||||
|
||||
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 ]
|
||||
} 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 )
|
||||
[ string-lines ] dip htmlize-lines
|
||||
[XML <pre><-></pre> XML] ;
|
||||
|
|
@ -206,11 +243,27 @@ M: ordered-list (write-farkup) "ol" farkup-inside ;
|
|||
M: paragraph (write-farkup) "p" 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)
|
||||
[ href>> ] [ text>> ] bi write-link ;
|
||||
open-link write-link ;
|
||||
|
||||
M: image (write-farkup)
|
||||
[ href>> ] [ text>> ] bi write-image-link ;
|
||||
open-link write-image-link ;
|
||||
|
||||
M: code (write-farkup)
|
||||
[ string>> ] [ mode>> ] bi render-code ;
|
||||
|
|
@ -228,9 +281,7 @@ M: table-row (write-farkup)
|
|||
|
||||
M: string (write-farkup) ;
|
||||
|
||||
M: vector (write-farkup) [ (write-farkup) ] map ;
|
||||
|
||||
M: f (write-farkup) ;
|
||||
M: array (write-farkup) [ (write-farkup) ] map ;
|
||||
|
||||
: farkup>xml ( string -- xml )
|
||||
parse-farkup (write-farkup) ;
|
||||
|
|
@ -240,3 +291,4 @@ M: f (write-farkup) ;
|
|||
|
||||
: convert-farkup ( string -- string' )
|
||||
[ write-farkup ] with-string-writer ;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue