From a5807774e094779db56882efdc75e5191c289e72 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 26 Feb 2008 12:50:19 -0600 Subject: [PATCH 1/4] add rules to allow * by itself add escape characters --- extra/farkup/farkup-tests.factor | 12 ++++++++---- extra/farkup/farkup.factor | 28 ++++++++++++++++++++-------- 2 files changed, 28 insertions(+), 12 deletions(-) diff --git a/extra/farkup/farkup-tests.factor b/extra/farkup/farkup-tests.factor index 1964b2b8a6..4d418ab99c 100644 --- a/extra/farkup/farkup-tests.factor +++ b/extra/farkup/farkup-tests.factor @@ -2,11 +2,15 @@ USING: farkup kernel tools.test ; IN: temporary [ "" ] [ "-foo" parse-farkup ] unit-test -[ "" ] [ "-foo\n" parse-farkup ] unit-test +[ "\n" ] [ "-foo\n" parse-farkup ] unit-test [ "" ] [ "-foo\n-bar" parse-farkup ] unit-test -[ "" ] [ "-foo\n-bar\n" parse-farkup ] unit-test +[ "\n" ] [ "-foo\n-bar\n" parse-farkup ] unit-test -[ "

bar

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

\nbar\n

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

*foo\nbar\n

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

Wow!

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

Wow.

" ] [ "_Wow._" parse-farkup ] unit-test + +[ "

*

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

*

" ] [ "\\*" parse-farkup ] unit-test +[ "

**

" ] [ "\\**" parse-farkup ] unit-test diff --git a/extra/farkup/farkup.factor b/extra/farkup/farkup.factor index 084b1c80cb..ff39606853 100644 --- a/extra/farkup/farkup.factor +++ b/extra/farkup/farkup.factor @@ -3,16 +3,24 @@ 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 ; +html.elements sequences.deep ascii ; +! unicode.categories ; USE: tools.walker IN: farkup MEMO: any-char ( -- parser ) [ drop t ] satisfy ; +: delimiters ( -- string ) + "*_^~%=[-|\\\n" ; inline + MEMO: text ( -- parser ) - [ "*_^~%=[-|\n" member? not ] satisfy repeat1 + [ delimiters member? not ] satisfy repeat1 [ >string escape-string ] action ; +MEMO: delimiter ( -- parser ) + [ dup delimiters member? swap CHAR: \n = not and ] satisfy + [ 1string ] action ; + : delimited ( str html -- parser ) [ over token hide , @@ -20,6 +28,9 @@ MEMO: text ( -- parser ) token hide , ] seq* ; +MEMO: escaped-char ( -- parser ) + [ "\\" token hide , any-char , ] seq* [ >string ] action ; + MEMO: strong ( -- parser ) "*" "strong" delimited ; MEMO: emphasis ( -- parser ) "_" "em" delimited ; MEMO: superscript ( -- parser ) "^" "sup" delimited ; @@ -89,16 +100,17 @@ MEMO: line ( -- parser ) [ text , strong , emphasis , link , superscript , subscript , inline-code , + escaped-char , delimiter , ] choice* repeat1 ; MEMO: paragraph ( -- parser ) [ - line [ - dup [ [ blank? ] all? ] deep-all? - [ "

" swap "

" 3array ] unless - ] action , - "\n" token hide , - ] choice* ; + line , + "\n" token , + ] choice* repeat1 [ + dup [ dup string? not swap [ blank? ] all? or ] deep-all? + [ "

" swap "

" 3array ] unless + ] action ; MEMO: farkup ( -- parser ) [ From 59c0c66857c9cd4ecae0e4c68daa269f06f7ccd6 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 26 Feb 2008 15:06:23 -0600 Subject: [PATCH 2/4] make farkup pass the empty string better handling of \n and special characters add escaped chars --- extra/farkup/farkup-tests.factor | 12 +++++++++++- extra/farkup/farkup.factor | 17 ++++++++++++----- 2 files changed, 23 insertions(+), 6 deletions(-) diff --git a/extra/farkup/farkup-tests.factor b/extra/farkup/farkup-tests.factor index 4d418ab99c..ec1b915d4d 100644 --- a/extra/farkup/farkup-tests.factor +++ b/extra/farkup/farkup-tests.factor @@ -6,7 +6,7 @@ IN: temporary [ "" ] [ "-foo\n-bar" parse-farkup ] unit-test [ "\n" ] [ "-foo\n-bar\n" parse-farkup ] unit-test -[ "

\nbar\n

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

bar\n

" ] [ "-foo\nbar\n" parse-farkup ] unit-test [ "

*foo\nbar\n

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

Wow!

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

Wow.

" ] [ "_Wow._" parse-farkup ] unit-test @@ -14,3 +14,13 @@ IN: temporary [ "

*

" ] [ "*" parse-farkup ] unit-test [ "

*

" ] [ "\\*" parse-farkup ] unit-test [ "

**

" ] [ "\\**" parse-farkup ] unit-test + +[ "" ] [ "\n\n" parse-farkup ] unit-test +[ "\n" ] [ "\n\n\n" parse-farkup ] unit-test +[ "

foo

bar

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

bar\n

" ] [ "\nbar\n" parse-farkup ] unit-test + +[ "

foo

\n

bar

" ] [ "foo\n\n\nbar" parse-farkup ] unit-test + +[ "" ] [ "" parse-farkup ] unit-test diff --git a/extra/farkup/farkup.factor b/extra/farkup/farkup.factor index ff39606853..e605483f54 100644 --- a/extra/farkup/farkup.factor +++ b/extra/farkup/farkup.factor @@ -40,6 +40,7 @@ MEMO: h1 ( -- parser ) "=" "h1" delimited ; MEMO: h2 ( -- parser ) "==" "h2" delimited ; MEMO: h3 ( -- parser ) "===" "h3" delimited ; MEMO: h4 ( -- parser ) "====" "h4" delimited ; +MEMO: nl ( -- parser ) "\n" token ; MEMO: 2nl ( -- parser ) "\n\n" token hide ; : render-code ( string mode -- string' ) @@ -104,19 +105,25 @@ MEMO: line ( -- parser ) ] choice* repeat1 ; MEMO: paragraph ( -- parser ) + line + "\n" token over 2seq repeat0 + "\n" token "\n" token ensure-not 2seq optional 3seq [ - line , - "\n" token , - ] choice* repeat1 [ dup [ dup string? not swap [ blank? ] all? or ] deep-all? [ "

" swap "

" 3array ] unless ] action ; MEMO: farkup ( -- parser ) [ - list , h1 , h2 , h3 , h4 , code , paragraph , 2nl , - ] choice* repeat1 ; + list , h1 , h2 , h3 , h4 , code , paragraph , 2nl , nl , + ] choice* repeat0 "\n" token optional 2seq ; : parse-farkup ( string -- string' ) farkup parse parse-result-ast [ [ dup string? [ write ] [ drop ] if ] deep-each ] with-string-writer ; + +! paragraph + ! [ + ! line , + ! "\n" token , + ! ] choice* repeat1 From 75a2838a7c3c82a72e1d3b2304377c8322891ad6 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 26 Feb 2008 15:17:04 -0600 Subject: [PATCH 3/4] clean up duplication of words that used --- extra/farkup/farkup.factor | 33 +++++++++++++++++---------------- 1 file changed, 17 insertions(+), 16 deletions(-) diff --git a/extra/farkup/farkup.factor b/extra/farkup/farkup.factor index e605483f54..aadc61be85 100644 --- a/extra/farkup/farkup.factor +++ b/extra/farkup/farkup.factor @@ -21,10 +21,13 @@ MEMO: delimiter ( -- parser ) [ dup delimiters member? swap CHAR: \n = not and ] satisfy [ 1string ] action ; +: surround-with-foo ( string tag -- seq ) + dup swap swapd 3array ; + : delimited ( str html -- parser ) [ over token hide , - text [ dup swap swapd 3array ] swapd curry action , + text [ surround-with-foo ] swapd curry action , token hide , ] seq* ; @@ -72,14 +75,22 @@ MEMO: link ( -- parser ) [ simple-link , labelled-link , ] choice* ; DEFER: line MEMO: list-item ( -- parser ) [ - "-" token hide , - line , - ] seq* - [ "li" swap "li" 3array ] action ; + "-" token hide , line , + ] seq* [ "li" surround-with-foo ] action ; MEMO: list ( -- parser ) list-item "\n" token hide list-of - [ "ul" swap "ul" 3array ] action ; + [ "ul" surround-with-foo ] action ; + +MEMO: table-column ( -- parser ) [ "|" token text ] seq* ; +MEMO: table-row ( -- parser ) + [ + "|" + ] seq* ; +MEMO: table ( -- parser ) + [ + "|" + ] seq* ; MEMO: code ( -- parser ) [ @@ -93,10 +104,6 @@ MEMO: code ( -- parser ) ] 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 , @@ -121,9 +128,3 @@ MEMO: farkup ( -- parser ) : parse-farkup ( string -- string' ) farkup parse parse-result-ast [ [ dup string? [ write ] [ drop ] if ] deep-each ] with-string-writer ; - -! paragraph - ! [ - ! line , - ! "\n" token , - ! ] choice* repeat1 From 11147c7bc03c29e31f1b5eaf7e86495171ff0ef3 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 26 Feb 2008 15:17:17 -0600 Subject: [PATCH 4/4] add 2seq, 3seq --- extra/peg/peg.factor | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 8298814017..6e42668436 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -306,6 +306,12 @@ MEMO: range ( min max -- parser ) : seq ( seq -- parser ) seq-parser construct-boa init-parser ; +: 2seq ( parser1 parser2 -- parser ) + 2array seq ; + +: 3seq ( parser1 parser2 parser3 -- parser ) + 3array seq ; + : seq* ( quot -- paser ) { } make seq ; inline @@ -343,7 +349,7 @@ MEMO: delay ( parser -- parser ) delay-parser construct-boa init-parser ; MEMO: list-of ( items separator -- parser ) - hide over 2array seq repeat0 [ concat ] action 2array seq [ unclip 1vector swap first append ] action ; + hide over 2seq repeat0 [ concat ] action 2seq [ unclip 1vector swap first append ] action ; MEMO: 'digit' ( -- parser ) [ digit? ] satisfy [ digit> ] action ;