the new farkup using ebnf

removed authors.factor which shouldn't have been there anyway

diff --git a/extra/farkup/authors.txt b/extra/farkup/authors.txt
new file mode 100644 (file)
index 0000000..5674120
--- /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 (file)
index 0000000..b2b662d
--- /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 (file)
index 0000000..005e875
--- /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
+
+[ "<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

diff --git a/extra/farkup/farkup.factor b/extra/farkup/farkup.factor
new file mode 100644 (file)
index 0000000..baf2cca
--- /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
+    "<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 ;

diff --git a/extra/farkup/summary.txt b/extra/farkup/summary.txt
new file mode 100644 (file)
index 0000000..c6e75d2
--- /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 (file)
index 0000000..8e27be7
--- /dev/null
+++ b/extra/farkup/tags.txt
@@ -0,0 +1 @@
+text