111 lines
3.3 KiB
Factor
111 lines
3.3 KiB
Factor
|
! 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 <foo> swap </foo> 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
|
||
|
|
[ "<a href=\"" , >r , r> "\">" , [ , ] when* "</a>" , ] { } 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" <foo> swap "li" </foo> 3array ] action ;
|
||
|
|
|
||
|
|
MEMO: list ( -- parser )
|
||
|
|
list-item "\n" token hide list-of
|
||
|
|
[ "ul" <foo> swap "ul" </foo> 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?
|
||
|
|
[ "<p>" swap "</p>" 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 ;
|