Fix some farkup bugs

basis/farkup/farkup-docs.factor

@@ -9,7 +9,7 @@ HELP: write-farkup
 { $values { "string" string } }
 { $description "Parse a Farkup string and writes the resulting HTML to " { $link output-stream } "." } ;
 
-HELP: farkup ( string -- farkup )
+HELP: parse-farkup ( string -- farkup )
 { $values { "string" string } { "farkup" "a Farkup syntax tree node" } }
 { $description "Parses Farkup and outputs a tree of " { $link "farkup-ast" } "." } ;
 
@@ -18,7 +18,7 @@ HELP: (write-farkup)
 { $description "Writes a Farkup syntax tree as HTML on " { $link output-stream } "." } ;
 
 ARTICLE: "farkup-ast" "Farkup syntax tree nodes"
-"The " { $link farkup } " word outputs a tree of nodes corresponding to the Farkup syntax of the input string. This tree can be programatically traversed and mutated before being passed on to " { $link write-farkup } "."
+"The " { $link parse-farkup } " word outputs a tree of nodes corresponding to the Farkup syntax of the input string. This tree can be programatically traversed and mutated before being passed on to " { $link write-farkup } "."
 { $subsection heading1 }
 { $subsection heading2 }
 { $subsection heading3 }
@@ -44,7 +44,7 @@ $nl
 { $subsection convert-farkup }
 { $subsection write-farkup }
 "The syntax tree of a piece of Farkup can also be inspected and modified:"
-{ $subsection farkup }
+{ $subsection parse-farkup }
 { $subsection (write-farkup) }
 { $subsection "farkup-ast" } ;
 

basis/farkup/farkup-tests.factor

@@ -118,3 +118,7 @@ link-no-follow? off
 ] unit-test
 
 [ "<p><a href='a'>a</a> <a href='b'>c</a></p>" ] [ "[[a]] [[b|c]]" convert-farkup ] unit-test
+
+[ "<p><a href='C%2b%2b'>C++</a></p>" ] [ "[[C++]]" convert-farkup ] unit-test
+
+[ "<p>&lt;foo&gt;</p>" ] [ "<foo>" convert-farkup ] unit-test

basis/farkup/farkup.factor

@@ -1,29 +1,29 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays combinators html.elements io io.streams.string
+USING: accessors arrays combinators html.elements io
-kernel math memoize namespaces peg peg.ebnf prettyprint
+io.streams.string kernel math memoize namespaces peg peg.ebnf
-sequences sequences.deep strings xml.entities vectors splitting
+prettyprint sequences sequences.deep strings xml.entities
-xmode.code2html ;
+vectors splitting xmode.code2html urls ;
 IN: farkup
 
 SYMBOL: relative-link-prefix
 SYMBOL: disable-images?
 SYMBOL: link-no-follow?
 
-TUPLE: heading1 obj ;
+TUPLE: heading1 child ;
-TUPLE: heading2 obj ;
+TUPLE: heading2 child ;
-TUPLE: heading3 obj ;
+TUPLE: heading3 child ;
-TUPLE: heading4 obj ;
+TUPLE: heading4 child ;
-TUPLE: strong obj ;
+TUPLE: strong child ;
-TUPLE: emphasis obj ;
+TUPLE: emphasis child ;
-TUPLE: superscript obj ;
+TUPLE: superscript child ;
-TUPLE: subscript obj ;
+TUPLE: subscript child ;
-TUPLE: inline-code obj ;
+TUPLE: inline-code child ;
-TUPLE: paragraph obj ;
+TUPLE: paragraph child ;
-TUPLE: list-item obj ;
+TUPLE: list-item child ;
-TUPLE: list obj ;
+TUPLE: list child ;
-TUPLE: table obj ;
+TUPLE: table child ;
-TUPLE: table-row obj ;
+TUPLE: table-row child ;
 TUPLE: link href text ;
 TUPLE: image href text ;
 TUPLE: code mode string ;
@@ -34,7 +34,7 @@ TUPLE: code mode string ;
 : simple-link-title ( string -- string' )
     dup absolute-url? [ "/" last-split1 swap or ] unless ;
 
-EBNF: farkup
+EBNF: parse-farkup
 nl               = ("\r\n" | "\r" | "\n") => [[ drop "\n" ]]
 2nl              = nl nl
 
@@ -65,7 +65,7 @@ subscript     = "~" (!("~" | nl).)+ "~"
 inline-code   = "%" (!("%" | nl).)+ "%"
     => [[ second >string inline-code boa ]]
 
-escaped-char  = "\" .                => [[ second ]]
+escaped-char  = "\" .                => [[ second 1string ]]
 
 link-content     = (!("|"|"]").)+
 
@@ -89,20 +89,26 @@ inline-tag       = strong | emphasis | superscript | subscript | inline-code
 
 inline-delimiter = '*' | '_' | '^' | '~' | '%' | '\' | '['
 
-table-column     = (list | (!(nl | inline-delimiter | '|').)+ | inline-tag | 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 ]]
 
-paragraph-item = ( table | (!(nl | code | heading | inline-delimiter | table ).) | inline-tag | inline-delimiter)+
+text = (!(nl | code | heading | inline-delimiter | table ).)+
+    => [[ >string ]]
+
+paragraph-item = (table | text | 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)*
+list-item      = '-' (cell | inline-tag)*
     => [[ second list-item boa ]]
 list = ((list-item nl)+ list-item? | list-item)
     => [[ list boa ]]
@@ -136,7 +142,7 @@ stand-alone
 
 : write-link ( href text -- )
     escape-link
-    [ <a =href link-no-follow? get [ "true" =nofollow ] when a> ]
+    [ <a url-encode =href link-no-follow? get [ "true" =nofollow ] when a> ]
     [ write </a> ]
     bi* ;
 
@@ -146,7 +152,7 @@ stand-alone
         <strong> "Images are not allowed" write </strong>
     ] [
         escape-link
-        [ <img =src ] [ [ =alt ] unless-empty img/> ] bi*
+        [ <img url-encode =src ] [ [ =alt ] unless-empty img/> ] bi*
     ] if ;
 
 : render-code ( string mode -- string' )
@@ -161,31 +167,30 @@ GENERIC: (write-farkup) ( farkup -- )
 : <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: heading1 (write-farkup) [ child>> (write-farkup) ] "h1" in-tag. ;
-M: heading2 (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "h2" in-tag. ;
+M: heading2 (write-farkup) [ child>> (write-farkup) ] "h2" in-tag. ;
-M: heading3 (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "h3" in-tag. ;
+M: heading3 (write-farkup) [ child>> (write-farkup) ] "h3" in-tag. ;
-M: heading4 (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "h4" in-tag. ;
+M: heading4 (write-farkup) [ child>> (write-farkup) ] "h4" in-tag. ;
-M: strong (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "strong" in-tag. ;
+M: strong (write-farkup) [ child>> (write-farkup) ] "strong" in-tag. ;
-M: emphasis (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "em" in-tag. ;
+M: emphasis (write-farkup) [ child>> (write-farkup) ] "em" in-tag. ;
-M: superscript (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "sup" in-tag. ;
+M: superscript (write-farkup) [ child>> (write-farkup) ] "sup" in-tag. ;
-M: subscript (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "sub" in-tag. ;
+M: subscript (write-farkup) [ child>> (write-farkup) ] "sub" in-tag. ;
-M: inline-code (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "code" in-tag. ;
+M: inline-code (write-farkup) [ child>> (write-farkup) ] "code" in-tag. ;
-M: list-item (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "li" in-tag. ;
+M: list-item (write-farkup) [ child>> (write-farkup) ] "li" in-tag. ;
-M: list (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "ul" in-tag. ;
+M: list (write-farkup) [ child>> (write-farkup) ] "ul" in-tag. ;
-M: paragraph (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "p" in-tag. ;
+M: paragraph (write-farkup) [ child>> (write-farkup) ] "p" in-tag. ;
-M: link (write-farkup) ( obj -- ) [ href>> ] [ text>> ] bi write-link ;
+M: link (write-farkup) [ href>> ] [ text>> ] bi write-link ;
-M: image (write-farkup) ( obj -- ) [ href>> ] [ text>> ] bi write-image-link ;
+M: image (write-farkup) [ href>> ] [ text>> ] bi write-image-link ;
-M: code (write-farkup) ( obj -- ) [ string>> ] [ mode>> ] bi render-code ;
+M: code (write-farkup) [ string>> ] [ mode>> ] bi render-code ;
 M: table-row (write-farkup) ( obj -- )
-    obj>> [ [ [ (write-farkup) ] "td" in-tag. ] each ] "tr" in-tag. ;
+    child>> [ [ [ (write-farkup) ] "td" in-tag. ] each ] "tr" in-tag. ;
-M: table (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "table" in-tag. ;
+M: table (write-farkup) [ child>> (write-farkup) ] "table" in-tag. ;
-M: fixnum (write-farkup) ( obj -- ) write1 ;
+M: string (write-farkup) escape-string write ;
-M: string (write-farkup) ( obj -- ) write ;
+M: vector (write-farkup) [ (write-farkup) ] each ;
-M: vector (write-farkup) ( obj -- ) [ (write-farkup) ] each ;
+M: f (write-farkup) drop ;
-M: f (write-farkup) ( obj -- ) drop ;
 
 : write-farkup ( string -- )
-    farkup (write-farkup) ;
+    parse-farkup (write-farkup) ;
 
 : convert-farkup ( string -- string' )
-    farkup [ (write-farkup) ] with-string-writer ;
+    parse-farkup [ (write-farkup) ] with-string-writer ;