steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix simple links

db4
Slava Pestov 2008-05-27 00:01:04 -05:00
parent c3aa938869
commit 8f69fd5aa8
2 changed files with 7 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/farkup/farkup-tests.factor
View File

@ -67,7 +67,7 @@ IN: farkup.tests
[ "<p><img src=\"lol.jpg\"/></p>" ] [ "[[image:lol.jpg]]" convert-farkup ] unit-test [ "<p><img src=\"lol.jpg\"/></p>" ] [ "[[image:lol.jpg]]" convert-farkup ] unit-test
[ "<p><img src=\"lol.jpg\" alt=\"teh lol\"/></p>" ] [ "[[image:lol.jpg|teh lol]]" convert-farkup ] unit-test [ "<p><img src=\"lol.jpg\" alt=\"teh lol\"/></p>" ] [ "[[image:lol.jpg|teh lol]]" convert-farkup ] unit-test
[ "<p><a href=\"lol.com\"></a></p>" ] [ "[[lol.com]]" convert-farkup ] unit-test [ "<p><a href=\"lol.com\">lol.com</a></p>" ] [ "[[lol.com]]" convert-farkup ] unit-test
[ "<p><a href=\"lol.com\">haha</a></p>" ] [ "[[lol.com|haha]]" convert-farkup ] unit-test [ "<p><a href=\"lol.com\">haha</a></p>" ] [ "[[lol.com|haha]]" convert-farkup ] unit-test
[ ] [ "[{}]" convert-farkup drop ] unit-test [ ] [ "[{}]" convert-farkup drop ] unit-test

8
extra/farkup/farkup.factor
View File

@ -6,6 +6,8 @@ splitting io.streams.string peg.parsers
sequences.deep unicode.categories ; sequences.deep unicode.categories ;
IN: farkup IN: farkup
SYMBOL: relative-link-prefix
<PRIVATE <PRIVATE
: delimiters ( -- string ) : delimiters ( -- string )
@ -68,7 +70,9 @@ MEMO: eq ( -- parser )
CHAR: : over member? [ CHAR: : over member? [
dup { "http://" "https://" "ftp://" } [ head? ] with contains? dup { "http://" "https://" "ftp://" } [ head? ] with contains?
[ drop "/" ] unless [ drop "/" ] unless
] when ; ] [
relative-link-prefix get prepend
] if ;
: escape-link ( href text -- href-esc text-esc ) : escape-link ( href text -- href-esc text-esc )
>r check-url escape-quoted-string r> escape-string ; >r check-url escape-quoted-string r> escape-string ;
@ -100,7 +104,7 @@ MEMO: simple-link ( -- parser )
"[[" token hide , "[[" token hide ,
[ "|]" member? not ] satisfy repeat1 , [ "|]" member? not ] satisfy repeat1 ,
"]]" token hide , "]]" token hide ,
] seq* [ first f make-link ] action ; ] seq* [ first dup make-link ] action ;
MEMO: labelled-link ( -- parser ) MEMO: labelled-link ( -- parser )
[ [