the new farkup using ebnf
removed authors.factor which shouldn't have been there anywaydb4
Doug Coleman
parent
f4e34ce0e1
commit
cbf190ab76
|
|
@ -0,0 +1,2 @@
|
|||
Doug Coleman
|
||||
Slava Pestov
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
USING: help.markup help.syntax ;
|
||||
IN: farkup
|
||||
|
||||
HELP: convert-farkup
|
||||
{ $values { "string" "a string" } { "string'" "a string" } }
|
||||
{ $description "Parse a string as farkup (Factor mARKUP) and output the result aas an string of HTML." } ;
|
||||
|
|
@ -0,0 +1,97 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: farkup kernel peg peg.ebnf tools.test ;
|
||||
IN: farkup.tests
|
||||
|
||||
[ ] [
|
||||
"abcd-*strong*\nasdifj\nweouh23ouh23"
|
||||
"paragraph" \ farkup rule parse drop
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
"abcd-*strong*\nasdifj\nweouh23ouh23\n"
|
||||
"paragraph" \ farkup rule parse drop
|
||||
] 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>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>*</p>" ] [ "\\*" convert-farkup ] unit-test
|
||||
[ "<p>**</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>\n</ul><p>bar\n</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</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>foo</p><p>bar</p>" ] [ "foo\n\n\nbar" convert-farkup ] unit-test
|
||||
|
||||
[ "" ] [ "" convert-farkup ] unit-test
|
||||
|
||||
[ "<p>|a</p>" ]
|
||||
[ "|a" convert-farkup ] unit-test
|
||||
|
||||
[ "<table><tr><td>a</td></tr></table>" ]
|
||||
[ "|a|" convert-farkup ] unit-test
|
||||
|
||||
[ "<table><tr><td>a</td><td>b</td></tr></table>" ]
|
||||
[ "|a|b|" convert-farkup ] unit-test
|
||||
|
||||
[ "<table><tr><td>a</td><td>b</td></tr><tr><td>c</td><td>d</td></tr></table>" ]
|
||||
[ "|a|b|\n|c|d|" convert-farkup ] unit-test
|
||||
|
||||
[ "<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>" ]
|
||||
[ "*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
|
||||
[ "<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
|
||||
[ "<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
|
||||
|
||||
[ "<pre><span class='KEYWORD3'>int</span> <span class='FUNCTION'>main</span><span class='OPERATOR'>(</span><span class='OPERATOR'>)</span>\n</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=\"lol.com\">lol.com</a></p>" ] [ "[[lol.com]]" convert-farkup ] unit-test
|
||||
[ "<p><a href=\"lol.com\">haha</a></p>" ] [ "[[lol.com|haha]]" convert-farkup ] unit-test
|
||||
|
||||
[ ] [ "[{}]" convert-farkup drop ] 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|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:</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
|
||||
|
|
@ -0,0 +1,180 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays combinators html.elements io io.streams.string
|
||||
kernel math memoize namespaces peg peg.ebnf prettyprint
|
||||
sequences sequences.deep strings xml.entities vectors splitting
|
||||
xmode.code2html ;
|
||||
IN: farkup
|
||||
|
||||
SYMBOL: relative-link-prefix
|
||||
SYMBOL: disable-images?
|
||||
SYMBOL: link-no-follow?
|
||||
|
||||
TUPLE: heading1 obj ;
|
||||
TUPLE: heading2 obj ;
|
||||
TUPLE: heading3 obj ;
|
||||
TUPLE: heading4 obj ;
|
||||
TUPLE: strong obj ;
|
||||
TUPLE: emphasis obj ;
|
||||
TUPLE: superscript obj ;
|
||||
TUPLE: subscript obj ;
|
||||
TUPLE: inline-code obj ;
|
||||
TUPLE: paragraph obj ;
|
||||
TUPLE: list-item obj ;
|
||||
TUPLE: list obj ;
|
||||
TUPLE: table obj ;
|
||||
TUPLE: table-row obj ;
|
||||
TUPLE: link href text ;
|
||||
TUPLE: image href text ;
|
||||
TUPLE: code mode string ;
|
||||
|
||||
EBNF: farkup
|
||||
nl = ("\r\n" | "\r" | "\n") => [[ drop "\n" ]]
|
||||
2nl = nl 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 ]]
|
||||
|
||||
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 ]]
|
||||
|
||||
escaped-char = "\" . => [[ second ]]
|
||||
|
||||
image-link = "[[image:" (!("|") .)+ "|" (!("]]").)+ "]]"
|
||||
=> [[ [ second >string ] [ fourth >string ] bi image boa ]]
|
||||
| "[[image:" (!("]").)+ "]]"
|
||||
=> [[ second >string f image boa ]]
|
||||
|
||||
simple-link = "[[" (!("|]" | "]]") .)+ "]]"
|
||||
=> [[ second >string dup link boa ]]
|
||||
|
||||
labelled-link = "[[" (!("|") .)+ "|" (!("]]").)+ "]]"
|
||||
=> [[ [ second >string ] [ fourth >string ] bi link boa ]]
|
||||
|
||||
link = image-link | labelled-link | simple-link
|
||||
|
||||
heading = heading4 | heading3 | heading2 | heading1
|
||||
|
||||
inline-tag = strong | emphasis | superscript | subscript | inline-code
|
||||
| link | escaped-char
|
||||
|
||||
inline-delimiter = '*' | '_' | '^' | '~' | '%' | '\' | '['
|
||||
|
||||
table-column = (list | (!(nl | inline-delimiter | '|').)+ | inline-tag | inline-delimiter ) '|'
|
||||
=> [[ first ]]
|
||||
table-row = "|" (table-column)+
|
||||
=> [[ second table-row boa ]]
|
||||
table = ((table-row nl => [[ first ]] )+ table-row? | table-row)
|
||||
=> [[ table boa ]]
|
||||
|
||||
paragraph-item = ( table | (!(nl | code | heading | inline-delimiter | table ).) | inline-tag | inline-delimiter)+
|
||||
paragraph = ((paragraph-item nl => [[ first ]])+ nl+ => [[ first ]]
|
||||
| (paragraph-item nl)+ paragraph-item?
|
||||
| paragraph-item)
|
||||
=> [[ paragraph boa ]]
|
||||
|
||||
list-item = '-' ((!(inline-delimiter | nl).)+ | inline-tag)*
|
||||
=> [[ second list-item boa ]]
|
||||
list = ((list-item nl)+ list-item? | list-item)
|
||||
=> [[ list boa ]]
|
||||
|
||||
code = '[' (!('{' | nl | '[').)+ '{' (!("}]").)+ "}]"
|
||||
=> [[ [ second >string ] [ fourth >string ] bi code boa ]]
|
||||
|
||||
stand-alone = (code | heading | list | table | paragraph | nl)*
|
||||
;EBNF
|
||||
|
||||
|
||||
|
||||
: invalid-url "javascript:alert('Invalid URL in farkup');" ;
|
||||
|
||||
: check-url ( href -- href' )
|
||||
{
|
||||
{ [ dup empty? ] [ drop invalid-url ] }
|
||||
{ [ dup [ 127 > ] contains? ] [ drop invalid-url ] }
|
||||
{ [ dup first "/\\" member? ] [ drop invalid-url ] }
|
||||
{ [ CHAR: : over member? ] [
|
||||
dup { "http://" "https://" "ftp://" } [ head? ] with contains?
|
||||
[ drop invalid-url ] unless
|
||||
] }
|
||||
[ relative-link-prefix get prepend ]
|
||||
} cond ;
|
||||
|
||||
: escape-link ( href text -- href-esc text-esc )
|
||||
>r check-url escape-quoted-string r> escape-string ;
|
||||
|
||||
: write-link ( text href -- )
|
||||
escape-link
|
||||
"<a" write
|
||||
" href=\"" write write "\"" write
|
||||
link-no-follow? get [ " nofollow=\"true\"" write ] when
|
||||
">" write write "</a>" write ;
|
||||
|
||||
: write-image-link ( href text -- )
|
||||
disable-images? get [
|
||||
2drop "<strong>Images are not allowed</strong>" write
|
||||
] [
|
||||
escape-link
|
||||
>r "<img src=\"" write write "\"" write r>
|
||||
dup empty? [ drop ] [ " alt=\"" write write "\"" write ] if
|
||||
"/>" write
|
||||
] if ;
|
||||
|
||||
: render-code ( string mode -- string' )
|
||||
>r string-lines r>
|
||||
[
|
||||
<pre>
|
||||
htmlize-lines
|
||||
</pre>
|
||||
] with-string-writer write ;
|
||||
|
||||
GENERIC: write-farkup ( obj -- )
|
||||
: <foo.> ( string -- ) <foo> write ;
|
||||
: </foo.> ( string -- ) </foo> write ;
|
||||
: in-tag. ( obj quot string -- ) [ <foo.> call ] keep </foo.> ; inline
|
||||
M: heading1 write-farkup ( obj -- ) [ obj>> write-farkup ] "h1" in-tag. ;
|
||||
M: heading2 write-farkup ( obj -- ) [ obj>> write-farkup ] "h2" in-tag. ;
|
||||
M: heading3 write-farkup ( obj -- ) [ obj>> write-farkup ] "h3" in-tag. ;
|
||||
M: heading4 write-farkup ( obj -- ) [ obj>> write-farkup ] "h4" in-tag. ;
|
||||
M: strong write-farkup ( obj -- ) [ obj>> write-farkup ] "strong" in-tag. ;
|
||||
M: emphasis write-farkup ( obj -- ) [ obj>> write-farkup ] "em" in-tag. ;
|
||||
M: superscript write-farkup ( obj -- ) [ obj>> write-farkup ] "sup" in-tag. ;
|
||||
M: subscript write-farkup ( obj -- ) [ obj>> write-farkup ] "sub" in-tag. ;
|
||||
M: inline-code write-farkup ( obj -- ) [ obj>> write-farkup ] "code" in-tag. ;
|
||||
M: list-item write-farkup ( obj -- ) [ obj>> write-farkup ] "li" in-tag. ;
|
||||
M: list write-farkup ( obj -- ) [ obj>> write-farkup ] "ul" in-tag. ;
|
||||
M: paragraph write-farkup ( obj -- ) [ obj>> write-farkup ] "p" in-tag. ;
|
||||
M: link write-farkup ( obj -- ) [ text>> ] [ href>> ] bi write-link ;
|
||||
M: image write-farkup ( obj -- ) [ href>> ] [ text>> ] bi write-image-link ;
|
||||
M: code write-farkup ( obj -- ) [ string>> ] [ mode>> ] bi render-code ;
|
||||
M: table-row write-farkup ( obj -- )
|
||||
obj>> [ [ [ write-farkup ] "td" in-tag. ] each ] "tr" in-tag. ;
|
||||
M: table write-farkup ( obj -- ) [ obj>> write-farkup ] "table" in-tag. ;
|
||||
M: fixnum write-farkup ( obj -- ) write1 ;
|
||||
M: string write-farkup ( obj -- ) write ;
|
||||
M: vector write-farkup ( obj -- ) [ write-farkup ] each ;
|
||||
M: f write-farkup ( obj -- ) drop ;
|
||||
|
||||
: convert-farkup ( string -- string' )
|
||||
farkup [ write-farkup ] with-string-writer ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Simple markup language for generating HTML
|
||||
|
|
@ -0,0 +1 @@
|
|||
text
|
||||
Loading…
Reference in New Issue