From 5647d08f5905b8b35d539ffbef7ffed64e044c6b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 19 Sep 2008 15:46:02 -0500 Subject: [PATCH] Fix some farkup bugs --- basis/farkup/farkup-docs.factor | 6 +- basis/farkup/farkup-tests.factor | 4 ++ basis/farkup/farkup.factor | 103 ++++++++++++++++--------------- 3 files changed, 61 insertions(+), 52 deletions(-) diff --git a/basis/farkup/farkup-docs.factor b/basis/farkup/farkup-docs.factor index f2d53d2362..6e7a5ddcb0 100644 --- a/basis/farkup/farkup-docs.factor +++ b/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" } ; diff --git a/basis/farkup/farkup-tests.factor b/basis/farkup/farkup-tests.factor index e25fa34960..cc032913b7 100644 --- a/basis/farkup/farkup-tests.factor +++ b/basis/farkup/farkup-tests.factor @@ -118,3 +118,7 @@ link-no-follow? off ] unit-test [ "

a c

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

C++

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

<foo>

" ] [ "" convert-farkup ] unit-test diff --git a/basis/farkup/farkup.factor b/basis/farkup/farkup.factor index 4d6ac127ad..cc56f48949 100644 --- a/basis/farkup/farkup.factor +++ b/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 -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 - [ ] + [ ] [ write ] bi* ; @@ -146,7 +152,7 @@ stand-alone "Images are not allowed" write ] [ escape-link - [ ] bi* + [ ] bi* ] if ; : render-code ( string mode -- string' ) @@ -161,31 +167,30 @@ GENERIC: (write-farkup) ( farkup -- ) : ( 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 -- ) [ 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 ;