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

extra/farkup/authors.factor

@@ -0,0 +1,2 @@
+Doug Coleman
+Slava Pestov

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." } ;

extra/farkup/farkup-tests.factor

@@ -0,0 +1,12 @@
+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><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></ul><p>bar</p>" ] [ "-foo\nbar\n" parse-farkup ] unit-test
+[ "*foo\nbar\n" parse-farkup ] must-fail
+[ "<p><strong>Wow!</strong></p>" ] [ "*Wow!*" parse-farkup ] unit-test
+[ "<p><em>Wow.</em></p>" ] [ "_Wow._" parse-farkup ] unit-test

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 <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 ;

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>