From 08051d9ba827c736eb6d2c9c950b04bac5fcf2fd Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Tue, 29 Sep 2015 12:15:00 -0700
Subject: [PATCH] html.entities: faster html-escape by going through string
 once.

---
 extra/html/entities/entities-tests.factor |  2 ++
 extra/html/entities/entities.factor       | 35 ++++++++++++++++-------
 2 files changed, 27 insertions(+), 10 deletions(-)

diff --git a/extra/html/entities/entities-tests.factor b/extra/html/entities/entities-tests.factor
index a9cdbd1a4db..903008a9ba1 100644
--- 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 f4638fcc00a..71b2affbedd 100644
--- 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