steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix some farkup bugs

db4
Slava Pestov 2008-09-19 15:46:02 -05:00
parent 90e440bf60
commit 5647d08f59
3 changed files with 61 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/farkup/farkup-docs.factor
View File

@ -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" } ;

4
basis/farkup/farkup-tests.factor
View File

@ -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

103
basis/farkup/farkup.factor
View File

@ -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
kernel math memoize namespaces peg peg.ebnf prettyprint
sequences sequences.deep strings xml.entities vectors splitting
xmode.code2html ;
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 urls ;
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: heading1 child ;
TUPLE: heading2 child ;
TUPLE: heading3 child ;
TUPLE: heading4 child ;
TUPLE: strong child ;
TUPLE: emphasis child ;
TUPLE: superscript child ;
TUPLE: subscript child ;
TUPLE: inline-code child ;
TUPLE: paragraph child ;
TUPLE: list-item child ;
TUPLE: list child ;
TUPLE: table child ;
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: 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 -- ) [ href>> ] [ text>> ] 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: heading1 (write-farkup) [ child>> (write-farkup) ] "h1" in-tag. ;
M: heading2 (write-farkup) [ child>> (write-farkup) ] "h2" in-tag. ;
M: heading3 (write-farkup) [ child>> (write-farkup) ] "h3" in-tag. ;
M: heading4 (write-farkup) [ child>> (write-farkup) ] "h4" in-tag. ;
M: strong (write-farkup) [ child>> (write-farkup) ] "strong" in-tag. ;
M: emphasis (write-farkup) [ child>> (write-farkup) ] "em" in-tag. ;
M: superscript (write-farkup) [ child>> (write-farkup) ] "sup" in-tag. ;
M: subscript (write-farkup) [ child>> (write-farkup) ] "sub" in-tag. ;
M: inline-code (write-farkup) [ child>> (write-farkup) ] "code" in-tag. ;
M: list-item (write-farkup) [ child>> (write-farkup) ] "li" in-tag. ;
M: list (write-farkup) [ child>> (write-farkup) ] "ul" in-tag. ;
M: paragraph (write-farkup) [ child>> (write-farkup) ] "p" in-tag. ;
M: link (write-farkup) [ href>> ] [ text>> ] bi write-link ;
M: image (write-farkup) [ href>> ] [ text>> ] bi write-image-link ;
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. ;
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 ;
child>> [ [ [ (write-farkup) ] "td" in-tag. ] each ] "tr" in-tag. ;
M: table (write-farkup) [ child>> (write-farkup) ] "table" in-tag. ;
M: string (write-farkup) escape-string write ;
M: vector (write-farkup) [ (write-farkup) ] each ;
M: f (write-farkup) 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 ;