diff --git a/extra/farkup/authors.factor b/extra/farkup/authors.factor new file mode 100644 index 0000000000..5674120196 --- /dev/null +++ b/extra/farkup/authors.factor @@ -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..5d59a093af --- /dev/null +++ b/extra/farkup/farkup-docs.factor @@ -0,0 +1,6 @@ +USING: help.markup help.syntax ; +IN: farkup + +HELP: parse-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..1964b2b8a6 --- /dev/null +++ b/extra/farkup/farkup-tests.factor @@ -0,0 +1,12 @@ +USING: farkup kernel tools.test ; +IN: temporary + +[ "" ] [ "-foo" parse-farkup ] unit-test +[ "" ] [ "-foo\n" parse-farkup ] unit-test +[ "" ] [ "-foo\n-bar" parse-farkup ] unit-test +[ "" ] [ "-foo\n-bar\n" parse-farkup ] unit-test + +[ "

bar

" ] [ "-foo\nbar\n" parse-farkup ] unit-test +[ "*foo\nbar\n" parse-farkup ] must-fail +[ "

Wow!

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

Wow.

" ] [ "_Wow._" parse-farkup ] unit-test diff --git a/extra/farkup/farkup.factor b/extra/farkup/farkup.factor new file mode 100644 index 0000000000..084b1c80cb --- /dev/null +++ b/extra/farkup/farkup.factor @@ -0,0 +1,110 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays io kernel memoize namespaces peg +peg.ebnf sequences strings html.elements xml.entities +xmode.code2html splitting io.streams.string html +html.elements sequences.deep unicode.categories ; +USE: tools.walker +IN: farkup + +MEMO: any-char ( -- parser ) [ drop t ] satisfy ; + +MEMO: text ( -- parser ) + [ "*_^~%=[-|\n" member? not ] satisfy repeat1 + [ >string escape-string ] action ; + +: delimited ( str html -- parser ) + [ + over token hide , + text [ dup swap swapd 3array ] swapd curry action , + token hide , + ] seq* ; + +MEMO: strong ( -- parser ) "*" "strong" delimited ; +MEMO: emphasis ( -- parser ) "_" "em" delimited ; +MEMO: superscript ( -- parser ) "^" "sup" delimited ; +MEMO: subscript ( -- parser ) "~" "sub" delimited ; +MEMO: inline-code ( -- parser ) "%" "code" delimited ; +MEMO: h1 ( -- parser ) "=" "h1" delimited ; +MEMO: h2 ( -- parser ) "==" "h2" delimited ; +MEMO: h3 ( -- parser ) "===" "h3" delimited ; +MEMO: h4 ( -- parser ) "====" "h4" delimited ; +MEMO: 2nl ( -- parser ) "\n\n" token hide ; + +: render-code ( string mode -- string' ) + >r string-lines r> + [ [ htmlize-lines ] with-html-stream ] with-string-writer ; + +: make-link ( href text -- seq ) + >r escape-quoted-string r> escape-string + [ "r , r> "\">" , [ , ] when* "" , ] { } make ; + +MEMO: simple-link ( -- parser ) + [ + "[[" token hide , + [ "|]" member? not ] satisfy repeat1 , + "]]" token hide , + ] seq* [ first f make-link ] action ; + +MEMO: labelled-link ( -- parser ) + [ + "[[" token hide , + [ CHAR: | = not ] satisfy repeat1 , + "|" token hide , + [ CHAR: ] = not ] satisfy repeat1 , + "]]" token hide , + ] seq* [ first2 make-link ] action ; + +MEMO: link ( -- parser ) [ simple-link , labelled-link , ] choice* ; + +DEFER: line +MEMO: list-item ( -- parser ) + [ + "-" token hide , + line , + ] seq* + [ "li" swap "li" 3array ] action ; + +MEMO: list ( -- parser ) + list-item "\n" token hide list-of + [ "ul" swap "ul" 3array ] action ; + +MEMO: code ( -- parser ) + [ + "[" token hide , + [ "{" member? not ] satisfy repeat1 optional [ >string ] action , + "{" token hide , + [ + [ any-char , "}]" token ensure-not , ] seq* + repeat1 [ concat >string ] action , + [ any-char , "}]" token hide , ] seq* optional [ >string ] action , + ] seq* [ concat ] action , + ] seq* [ first2 swap render-code ] action ; + +MEMO: table-column ( -- parser ) [ "|" token text ] seq* ; +MEMO: table-row ( -- parser ) [ ] seq* ; +MEMO: table ( -- parser ) [ "[" ] seq* ; + +MEMO: line ( -- parser ) + [ + text , strong , emphasis , link , + superscript , subscript , inline-code , + ] choice* repeat1 ; + +MEMO: paragraph ( -- parser ) + [ + line [ + dup [ [ blank? ] all? ] deep-all? + [ "

" swap "

" 3array ] unless + ] action , + "\n" token hide , + ] choice* ; + +MEMO: farkup ( -- parser ) + [ + list , h1 , h2 , h3 , h4 , code , paragraph , 2nl , + ] choice* repeat1 ; + +: parse-farkup ( string -- string' ) + farkup parse parse-result-ast + [ [ dup string? [ write ] [ drop ] if ] deep-each ] with-string-writer ; diff --git a/extra/sequences/deep/deep.factor b/extra/sequences/deep/deep.factor index c55647bbcb..27b875bd8f 100644 --- a/extra/sequences/deep/deep.factor +++ b/extra/sequences/deep/deep.factor @@ -34,6 +34,9 @@ IN: sequences.deep : deep-contains? ( obj quot -- ? ) deep-find* nip ; inline +: deep-all? ( obj quot -- ? ) + [ not ] compose deep-contains? not ; inline + : deep-change-each ( obj quot -- ) over branch? [ [ [ call ] keep over >r deep-change-each r>