Merge branch 'master' of git://factorcode.org/git/factor

extra/farkup/farkup-tests.factor

@@ -2,11 +2,25 @@ USING: farkup kernel tools.test ;
 IN: temporary
 
 [ "<ul><li>foo</li></ul>" ] [ "-foo" parse-farkup ] unit-test
-[ "<ul><li>foo</li></ul>" ] [ "-foo\n" parse-farkup ] unit-test
+[ "<ul><li>foo</li></ul>\n" ] [ "-foo\n" parse-farkup ] unit-test
 [ "<ul><li>foo</li><li>bar</li></ul>" ] [ "-foo\n-bar" parse-farkup ] unit-test
-[ "<ul><li>foo</li><li>bar</li></ul>" ] [ "-foo\n-bar\n" parse-farkup ] unit-test
+[ "<ul><li>foo</li><li>bar</li></ul>\n" ] [ "-foo\n-bar\n" parse-farkup ] unit-test
 
-[ "<ul><li>foo</li></ul><p>bar</p>" ] [ "-foo\nbar\n" parse-farkup ] unit-test
+[ "<ul><li>foo</li></ul>\n<p>bar\n</p>" ] [ "-foo\nbar\n" parse-farkup ] unit-test
-[ "*foo\nbar\n" parse-farkup ] must-fail
+[ "<p>*foo\nbar\n</p>" ] [ "*foo\nbar\n" parse-farkup ] unit-test
 [ "<p><strong>Wow!</strong></p>" ] [ "*Wow!*" parse-farkup ] unit-test
 [ "<p><em>Wow.</em></p>" ] [ "_Wow._" parse-farkup ] unit-test
+
+[ "<p>*</p>" ] [ "*" parse-farkup ] unit-test
+[ "<p>*</p>" ] [ "\\*" parse-farkup ] unit-test
+[ "<p>**</p>" ] [ "\\**" parse-farkup ] unit-test
+
+[ "" ] [ "\n\n" parse-farkup ] unit-test
+[ "\n" ] [ "\n\n\n" parse-farkup ] unit-test
+[ "<p>foo</p><p>bar</p>" ] [ "foo\n\nbar" parse-farkup ] unit-test
+
+[ "\n<p>bar\n</p>" ] [ "\nbar\n" parse-farkup ] unit-test
+
+[ "<p>foo</p>\n<p>bar</p>" ] [ "foo\n\n\nbar" parse-farkup ] unit-test
+
+[ "" ] [ "" parse-farkup ] unit-test

extra/farkup/farkup.factor

@@ -3,23 +3,37 @@
 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 ;
+
+: surround-with-foo ( string tag -- seq )
+    dup <foo> swap </foo> swapd 3array ;
+
 : delimited ( str html -- parser )
     [
         over token hide ,
-        text [ dup <foo> swap </foo> swapd 3array ] swapd curry action ,
+        text [ surround-with-foo ] swapd curry action ,
         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 ;
@@ -29,6 +43,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' )
@@ -60,14 +75,22 @@ MEMO: link ( -- parser ) [ simple-link , labelled-link , ] choice* ;
 DEFER: line
 MEMO: list-item ( -- parser )
     [
-        "-" token hide ,
+        "-" token hide , line ,
-        line ,
+    ] seq* [ "li" surround-with-foo ] action ;
-    ] 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 ;
+    [ "ul" surround-with-foo ] action ;
+
+MEMO: table-column ( -- parser ) [ "|" token text ] seq* ;
+MEMO: table-row ( -- parser )
+    [
+        "|" 
+    ] seq* ; 
+MEMO: table ( -- parser )
+    [
+        "|" 
+    ] seq* ;
 
 MEMO: code ( -- parser )
     [
@@ -81,29 +104,26 @@ 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 ,
         superscript , subscript , inline-code ,
+        escaped-char , delimiter ,
     ] choice* repeat1 ;
 
 MEMO: paragraph ( -- parser )
+    line
+    "\n" token over 2seq repeat0
+    "\n" token "\n" token ensure-not 2seq optional 3seq
     [
-        line [
+        dup [ dup string? not swap [ blank? ] all? or ] deep-all?
-            dup [ [ blank? ] all? ] deep-all?
         [ "<p>" swap "</p>" 3array ] unless
-        ] action ,
+    ] action ;
-        "\n" token hide ,
-    ] choice* ;
 
 MEMO: farkup ( -- parser )
     [
-        list , h1 , h2 , h3 , h4 , code , paragraph , 2nl ,
+        list , h1 , h2 , h3 , h4 , code , paragraph , 2nl , nl ,
-    ] choice* repeat1 ;
+    ] choice* repeat0 "\n" token optional 2seq ;
 
 : parse-farkup ( string -- string' )
     farkup parse parse-result-ast

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 ;