diff --git a/extra/farkup/authors.txt b/extra/farkup/authors.txt new file mode 100644 index 0000000000..5674120196 --- /dev/null +++ b/extra/farkup/authors.txt @@ -0,0 +1,2 @@ +Doug Coleman +Slava Pestov diff --git a/extra/farkup/farkup-docs.factor b/extra/farkup/farkup-docs.factor new file mode 100644 index 0000000000..b2b662db82 --- /dev/null +++ b/extra/farkup/farkup-docs.factor @@ -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." } ; diff --git a/extra/farkup/farkup-tests.factor b/extra/farkup/farkup-tests.factor new file mode 100644 index 0000000000..005e875d89 --- /dev/null +++ b/extra/farkup/farkup-tests.factor @@ -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 + +[ "

a-b

" ] [ "a-b" convert-farkup ] unit-test +[ "

*foo\nbar\n

" ] [ "*foo\nbar\n" convert-farkup ] unit-test +[ "

Wow!

" ] [ "*Wow!*" convert-farkup ] unit-test +[ "

Wow.

" ] [ "_Wow._" convert-farkup ] unit-test + +[ "

*

" ] [ "*" convert-farkup ] unit-test +[ "

*

" ] [ "\\*" convert-farkup ] unit-test +[ "

**

" ] [ "\\**" convert-farkup ] unit-test + +[ "" ] [ "-a-b" convert-farkup ] unit-test +[ "" ] [ "-foo" convert-farkup ] unit-test +[ "" ] [ "-foo\n" convert-farkup ] unit-test +[ "" ] [ "-foo\n-bar" convert-farkup ] unit-test +[ "" ] [ "-foo\n-bar\n" convert-farkup ] unit-test + +[ "

bar\n

" ] [ "-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 +[ "

foo

bar

" ] [ "foo\n\nbar" convert-farkup ] unit-test +[ "

foo

bar

" ] [ "foo\r\n\r\nbar" convert-farkup ] unit-test +[ "

foo

bar

" ] [ "foo\r\rbar" convert-farkup ] unit-test +[ "

foo

bar

" ] [ "foo\r\r\nbar" convert-farkup ] unit-test + +[ "\n

bar\n

" ] [ "\nbar\n" convert-farkup ] unit-test +[ "\n

bar\n

" ] [ "\rbar\r" convert-farkup ] unit-test +[ "\n

bar\n

" ] [ "\r\nbar\r\n" convert-farkup ] unit-test + +[ "

foo

bar

" ] [ "foo\n\n\nbar" convert-farkup ] unit-test + +[ "" ] [ "" convert-farkup ] unit-test + +[ "

|a

" ] +[ "|a" convert-farkup ] unit-test + +[ "
a
" ] +[ "|a|" convert-farkup ] unit-test + +[ "
ab
" ] +[ "|a|b|" convert-farkup ] unit-test + +[ "
ab
cd
" ] +[ "|a|b|\n|c|d|" convert-farkup ] unit-test + +[ "
ab
cd
" ] +[ "|a|b|\n|c|d|\n" convert-farkup ] unit-test + +[ "

foo\n

aheading

\n

adfasd

" ] +[ "*foo*\n=aheading=\nadfasd" convert-farkup ] unit-test + +[ "

foo

\n" ] [ "=foo=\n" convert-farkup ] unit-test +[ "

lol

foo

\n" ] [ "lol=foo=\n" convert-farkup ] unit-test +[ "

=foo\n

" ] [ "=foo\n" convert-farkup ] unit-test +[ "

=foo

" ] [ "=foo" convert-farkup ] unit-test +[ "

==foo

" ] [ "==foo" convert-farkup ] unit-test +[ "

=

foo

" ] [ "==foo=" convert-farkup ] unit-test +[ "

foo

" ] [ "==foo==" convert-farkup ] unit-test +[ "

foo

" ] [ "==foo==" convert-farkup ] unit-test +[ "

=

foo

" ] [ "===foo==" convert-farkup ] unit-test +[ "

foo

=

" ] [ "=foo==" convert-farkup ] unit-test + +[ "
int main()\n
" ] +[ "[c{int main()}]" convert-farkup ] unit-test + +[ "

" ] [ "[[image:lol.jpg]]" convert-farkup ] unit-test +[ "

\"teh

" ] [ "[[image:lol.jpg|teh lol]]" convert-farkup ] unit-test +[ "

lol.com

" ] [ "[[lol.com]]" convert-farkup ] unit-test +[ "

haha

" ] [ "[[lol.com|haha]]" convert-farkup ] unit-test + +[ ] [ "[{}]" convert-farkup drop ] unit-test + +[ + "

Feature comparison:\n
aFactorJavaLisp
CoolnessYesNoNo
BadassYesNoNo
EnterpriseYesYesNo
KosherYesNoYes

" +] [ "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:

aFactorJavaLisp
CoolnessYesNoNo
BadassYesNoNo
EnterpriseYesYesNo
KosherYesNoYes
" +] [ "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 diff --git a/extra/farkup/farkup.factor b/extra/farkup/farkup.factor new file mode 100644 index 0000000000..baf2ccaba2 --- /dev/null +++ b/extra/farkup/farkup.factor @@ -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 + "" write write "" write ; + +: write-image-link ( href text -- ) + disable-images? get [ + 2drop "Images are not allowed" write + ] [ + escape-link + >r " + dup empty? [ drop ] [ " alt=\"" write write "\"" write ] if + "/>" write + ] if ; + +: render-code ( string mode -- string' ) + >r string-lines r> + [ +
+            htmlize-lines
+        
+ ] with-string-writer write ; + +GENERIC: write-farkup ( obj -- ) +: ( string -- ) write ; +: ( string -- ) write ; +: in-tag. ( obj quot string -- ) [ call ] keep ; 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 ; diff --git a/extra/farkup/summary.txt b/extra/farkup/summary.txt new file mode 100644 index 0000000000..c6e75d28a9 --- /dev/null +++ b/extra/farkup/summary.txt @@ -0,0 +1 @@ +Simple markup language for generating HTML diff --git a/extra/farkup/tags.txt b/extra/farkup/tags.txt new file mode 100644 index 0000000000..8e27be7d61 --- /dev/null +++ b/extra/farkup/tags.txt @@ -0,0 +1 @@ +text