] 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>" ]
[ "<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
[ "<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
[
[ "<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 )
[ "<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
-! 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
: 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
-
-heading1 = "=" (!("=" | nl).)+ "="
- => [[ second >string heading1 boa ]]
-
-heading2 = "==" (!("=" | nl).)+ "=="
- => [[ second >string heading2 boa ]]
-
-heading3 = "===" (!("=" | nl).)+ "==="
- => [[ second >string heading3 boa ]]
-
-heading4 = "====" (!("=" | nl).)+ "===="
- => [[ second >string heading4 boa ]]
-
-heading = heading4 | heading3 | heading2 | heading1
-
-
-
-strong = "*" (!("*" | nl).)+ "*"
- => [[ second >string strong boa ]]
-
-emphasis = "_" (!("_" | nl).)+ "_"
- => [[ second >string emphasis boa ]]
-
-superscript = "^" (!("^" | nl).)+ "^"
- => [[ second >string superscript boa ]]
-
-subscript = "~" (!("~" | nl).)+ "~"
- => [[ second >string subscript boa ]]
-
-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 ]]
- | "[[image:" link-content "]]"
- => [[ second >string f image boa ]]
-
-simple-link = "[[" link-content "]]"
- => [[ second >string dup simple-link-title link boa ]]
-
-labeled-link = "[[" link-content "|" link-content "]]"
- => [[ [ second >string ] [ fourth >string ] bi link boa ]]
-
-link = image-link | labeled-link | simple-link
-
-escaped-char = "\" .
- => [[ second 1string ]]
-
-inline-tag = strong | emphasis | superscript | subscript | inline-code
- | link | escaped-char
-
-
-
-inline-delimiter = '*' | '_' | '^' | '~' | '%' | '\' | '['
-
-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 ]]
-
-text = (!(nl | code | heading | inline-delimiter | table ).)+
- => [[ >string ]]
-
-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 ]]
-
-
-list-item = (cell | inline-tag | inline-delimiter)*
-
-ordered-list-item = '#' list-item
- => [[ second list-item boa ]]
-ordered-list = ((ordered-list-item nl)+ ordered-list-item? | ordered-list-item)
- => [[ ordered-list boa ]]
-
-unordered-list-item = '-' list-item
- => [[ second list-item boa ]]
-unordered-list = ((unordered-list-item nl)+ unordered-list-item? | unordered-list-item)
- => [[ unordered-list boa ]]
-
-list = ordered-list | unordered-list
-
-
-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
+! _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.
+
+DEFER: (parse-paragraph)
+
+: parse-paragraph ( string -- seq )
+ (parse-paragraph) list>array ;
+
+: make-paragraph ( string -- paragraph )
+ parse-paragraph paragraph boa ;
+
+: cut-half-slice ( string i -- before after-slice )
+ [ head ] [ 1+ short tail-slice ] 2bi ;
+
+: 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 ;
+
+: 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* ;
+
+: ?first ( seq -- elt ) 0 swap ?nth ;
+
+: parse-big-link ( before after -- link rest )
+ dup ?first CHAR: [ =
+ [ parse-link ]
+ [ [ CHAR: [ suffix ] [ (parse-paragraph) ] bi* ]
+ if ;
+
+: escape ( before after -- before' after' )
+ [ nil ] [ unclip-slice swap [ suffix ] dip (parse-paragraph) ] if-empty ;
+
+: (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 ;
+
+: <farkup-state> ( string -- state ) string-lines ;
+: look ( state i -- char ) swap first ?nth ;
+: done? ( state -- ? ) empty? ;
+: take-line ( state -- state' line ) unclip-slice ;
+
+: take-lines ( state char -- state' lines )
+ dupd '[ ?first _ = not ] find drop
+ [ cut-slice ] [ f ] if* swap ;
+
+:: (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 ;
+: take-until ( state delimiter -- string/f state' )
+ V{ } clone (take-until) ;
+
+: count= ( string -- n )
+ dup <reversed> [ [ CHAR: = = not ] find drop 0 or ] bi@ min ;
+
+: trim= ( string -- string' )
+ [ CHAR: = = ] trim ;
+
+: 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 ;
+
+: ?peek ( seq -- elt/f )
+ [ f ] [ peek ] if-empty ;
+
+: coalesce ( rows -- rows' )
+ V{ } clone [
+ '[
+ _ dup ?peek ?peek CHAR: \\ =
+ [ [ pop "|" rot 3append ] keep ] when
+ push
+ ] each
+ ] keep ;
+
+: parse-table ( state -- state' table )
+ CHAR: | take-lines [
+ "|" split
+ trim-row
+ coalesce
+ [ parse-paragraph ] map
+ table-row boa
+ ] map table 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
+
+: parse-ul ( state -- state' ul )
+ CHAR: - unordered-list parse-list ;
+
+: parse-ol ( state -- state' ul )
+ CHAR: # ordered-list parse-list ;
+
+: parse-code ( state -- state' item )
+ dup 1 look CHAR: [ =
+ [ unclip-slice make-paragraph ] [
+ "{" take-until [ rest ] dip
+ "}]" take-until
+ [ code boa ] dip swap
+ ] if ;
-stand-alone
- = (line | code | heading | list | table | paragraph | nl)*
-;EBNF
+: 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 )
+ <farkup-state> [ dup done? not ] [ parse-item ] produce nip sift ;
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] ;
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 ;
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) ;
: convert-farkup ( string -- string' )
[ write-farkup ] with-string-writer ;
+
projects / factor.git / commitdiff