html.entities: faster html-escape by going through string once.

diff --git a/extra/html/entities/entities-tests.factor b/extra/html/entities/entities-tests.factor
index a9cdbd1a4db7075ad029814d20e7ea336a1f7b5a..903008a9ba114face88ac281aaffcc52c4d2feeb 100644 (file)
--- a/extra/html/entities/entities-tests.factor
+++ b/extra/html/entities/entities-tests.factor
@@ -6,6 +6,8 @@ IN: html.entities
 { "<foo>" } [ "&lt;foo&gt;" html-unescape ] unit-test
 { "This &that" } [ "This &amp;that" html-unescape ] unit-test
 { "This &that" } [ "This &ampthat" html-unescape ] unit-test
+{ "a&b<c>d" } [ "a&amp;b&lt;c&gt;d" html-unescape ] unit-test
 
 { "&amp;" } [ "&" html-escape ] unit-test
 { "&lt;foo&gt;" } [ "<foo>" html-escape ] unit-test
+{ "a&amp;b&lt;c&gt;d" } [ "a&b<c>d" html-escape ] unit-test

diff --git a/extra/html/entities/entities.factor b/extra/html/entities/entities.factor
index f4638fcc00a289c174a89ec5fc294aa36982e73c..71b2affbeddab9054e64aa7eb753d5b9419fe4af 100644 (file)
--- a/extra/html/entities/entities.factor
+++ b/extra/html/entities/entities.factor
@@ -1,20 +1,35 @@
 ! Copyright (C) 2014 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license
 
-USING: assocs combinators.short-circuit kernel locals make math
-math.order math.parser math.ranges regexp sequences splitting
-strings ;
+USING: assocs combinators.short-circuit kernel literals locals
+make math math.order math.parser math.ranges regexp sequences
+splitting strings ;
 
 IN: html.entities
 
+<PRIVATE
+
+CONSTANT: html-escapes {
+    { CHAR: & "&amp;" }
+    { CHAR: < "&lt;" }
+    { CHAR: > "&gt;" }
+    { CHAR: \" "&quot;" }
+    { CHAR: ' "&#39;" }
+}
+
+: next-escape ( seq -- i elt )
+    [ html-escapes key? ] find ;
+
+: escape, ( seq i elt -- seq' )
+    [ [ head-slice , ] [ 1 + tail-slice ] 2bi ]
+    [ html-escapes at , ] bi* ;
+
+PRIVATE>
+
 : html-escape ( str -- newstr )
-    {
-        { "&" "&amp;" }
-        { "<" "&lt;" }
-        { ">" "&gt;" }
-        { "\"" "&quot;" }
-        { "'" "&#39;" }
-    } [ replace ] assoc-each ;
+    [
+        [ dup next-escape dup ] [ escape, ] while 2drop ,
+    ] { } make dup length 1 > [ concat ] [ first ] if ;
 
 <PRIVATE