Some improvements to farkup link handling

basis/farkup/farkup-tests.factor

@@ -1,8 +1,11 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: farkup kernel peg peg.ebnf tools.test ;
+USING: farkup kernel peg peg.ebnf tools.test namespaces ;
 IN: farkup.tests
 
+[ "Baz" ] [ "Foo/Bar/Baz" simple-link-title ] unit-test
+[ "Baz" ] [ "Baz" simple-link-title ] unit-test
+
 [ ] [
     "abcd-*strong*\nasdifj\nweouh23ouh23"
     "paragraph" \ farkup rule parse drop
@@ -81,10 +84,15 @@ IN: farkup.tests
 [ "<pre><span class='KEYWORD3'>int</span> <span class='FUNCTION'>main</span><span class='OPERATOR'>(</span><span class='OPERATOR'>)</span>\n</pre>" ]
 [ "[c{int main()}]" convert-farkup ] unit-test
 
-[ "<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\">lol.com</a></p>" ] [ "[[lol.com]]" convert-farkup ] unit-test
+[ "<p><a href='http://lol.com'>http://lol.com</a></p>" ] [ "[[http://lol.com]]" convert-farkup ] unit-test
-[ "<p><a href=\"lol.com\">haha</a></p>" ] [ "[[lol.com|haha]]" convert-farkup ] unit-test
+[ "<p><a href='http://lol.com'>haha</a></p>" ] [ "[[http://lol.com|haha]]" convert-farkup ] unit-test
+[ "<p><a href='Foo/Bar'>Bar</a></p>" ] [ "[[Foo/Bar]]" convert-farkup ] unit-test
+
+"/wiki/view/" relative-link-prefix [
+    [ "<p><a href='/wiki/view/Foo/Bar'>Bar</a></p>" ] [ "[[Foo/Bar]]" convert-farkup ] unit-test
+] with-variable
 
 [ ] [ "[{}]" convert-farkup drop ] unit-test
 

basis/farkup/farkup.factor

@@ -28,6 +28,12 @@ TUPLE: link href text ;
 TUPLE: image href text ;
 TUPLE: code mode string ;
 
+: absolute-url? ( string -- ? )
+    { "http://" "https://" "ftp://" } [ head? ] with contains? ;
+
+: simple-link-title ( string -- string' )
+    dup absolute-url? [ "/" last-split1 swap or ] unless ;
+
 EBNF: farkup
 nl               = ("\r\n" | "\r" | "\n") => [[ drop "\n" ]]
 2nl              = nl nl
@@ -67,7 +73,7 @@ image-link       = "[[image:" (!("|") .)+  "|" (!("]]").)+ "]]"
                     => [[ second >string f image boa ]]
 
 simple-link      = "[[" (!("|]" | "]]") .)+ "]]"
-    => [[ second >string dup link boa ]]
+    => [[ second >string dup simple-link-title link boa ]]
 
 labelled-link    = "[[" (!("|") .)+ "|" (!("]]").)+ "]]"
     => [[ [ second >string ] [ fourth >string ] bi link boa ]]
@@ -119,31 +125,26 @@ stand-alone
         { [ dup empty? ] [ drop invalid-url ] }
         { [ dup [ 127 > ] contains? ] [ drop invalid-url ] }
         { [ dup first "/\\" member? ] [ drop invalid-url ] }
-        { [ CHAR: : over member? ] [
+        { [ CHAR: : over member? ] [ dup absolute-url? [ drop invalid-url ] unless ] }
-            dup { "http://" "https://" "ftp://" } [ head? ] with contains?
-            [ drop invalid-url ] unless
-        ] }
         [ relative-link-prefix get prepend ]
     } cond ;
 
 : escape-link ( href text -- href-esc text-esc )
     >r check-url escape-quoted-string r> escape-string ;
 
-: write-link ( text href -- )
+: write-link ( href text -- )
     escape-link
-    "<a" write
+    [ <a =href link-no-follow? get [ "true" =nofollow ] when a> ]
-    " href=\"" write write "\"" write
+    [ write </a> ]
-    link-no-follow? get [ " nofollow=\"true\"" write ] when
+    bi* ;
-    ">" write write "</a>" write ;
 
 : write-image-link ( href text -- )
     disable-images? get [
-        2drop "<strong>Images are not allowed</strong>" write
+        2drop
+        <strong> "Images are not allowed" write </strong>
     ] [
         escape-link
-        >r "<img src=\"" write write "\"" write r>
+        [ <img =src ] [ [ =alt ] unless-empty img/> ] bi*
-        [ " alt=\"" write write "\"" write ] unless-empty
-        "/>" write
     ] if ;
 
 : render-code ( string mode -- string' )
@@ -170,7 +171,7 @@ M: inline-code write-farkup ( obj -- ) [ obj>> write-farkup ] "code" in-tag. ;
 M: list-item write-farkup ( obj -- ) [ obj>> write-farkup ] "li" in-tag. ;
 M: list write-farkup ( obj -- ) [ obj>> write-farkup ] "ul" in-tag. ;
 M: paragraph write-farkup ( obj -- ) [ obj>> write-farkup ] "p" in-tag. ;
-M: link write-farkup ( obj -- ) [ text>> ] [ href>> ] bi write-link ;
+M: link write-farkup ( obj -- ) [ href>> ] [ text>> ] bi write-link ;
 M: image write-farkup ( obj -- ) [ href>> ] [ text>> ] bi write-image-link ;
 M: code write-farkup ( obj -- ) [ string>> ] [ mode>> ] bi render-code ;
 M: table-row write-farkup ( obj -- )

basis/html/elements/elements.factor

@@ -142,6 +142,7 @@ SYMBOL: html
     "ol" "li" "form" "a" "p" "html" "head" "body" "title"
     "b" "i" "ul" "table" "tbody" "tr" "td" "th" "pre" "textarea"
     "script" "div" "span" "select" "option" "style" "input"
+    "strong"
 ] [ define-closed-html-word ] each
 
 ! Define some open HTML tags
@@ -160,6 +161,8 @@ SYMBOL: html
     "src" "language" "colspan" "onchange" "rel"
     "width" "selected" "onsubmit" "xmlns" "lang" "xml:lang"
     "media" "title" "multiple" "checked"
+    "summary" "cellspacing" "align" "scope" "abbr"
+    "nofollow" "alt"
 ] [ define-attribute-word ] each
 
 >>