From f5ffe129c45d75d9f360d02d9b8823907b163347 Mon Sep 17 00:00:00 2001
From: Owen Rodley <Strigoides@gmail.com>
Date: Wed, 5 Jun 2013 16:39:57 +1200
Subject: [PATCH] Use two different string-escape functions One for Lisp
 string literals, and the other for Javascript string
 literals, the difference being the option to use
 single-quoted strings in Javascript

---
 src/compiler.lisp |   44 +++++++++++++++++++++++++++++++++++---------
 src/print.lisp    |    2 +-
 2 files changed, 36 insertions(+), 10 deletions(-)

diff --git a/src/compiler.lisp b/src/compiler.lisp
index fb9f62d..c824940 100644
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -266,9 +266,9 @@
       (js!selfcall
         "var func = " (join strs) ";" *newline*
         (when name
-          (code "func.fname = " (escape-string name) ";" *newline*))
+          (code "func.fname = " (js-escape-string name) ";" *newline*))
         (when docstring
-          (code "func.docstring = " (escape-string docstring) ";" *newline*))
+          (code "func.docstring = " (js-escape-string docstring) ";" *newline*))
         "return func;" *newline*)
       (apply #'code strs)))
 
@@ -482,12 +482,23 @@
 
 
 ;;; Compilation of literals an object dumping
-(defun escape-string (string)
+
+;;; Two seperate functions are needed for escaping strings:
+;;;  One for producing JavaScript string literals (which are singly or
+;;;   doubly quoted)
+;;;  And one for producing Lisp strings (which are only doubly quoted)
+;;;
+;;; The same function would suffice for both, but for javascript string
+;;; literals it is neater to use either depending on the context, e.g:
+;;;  foo's => "foo's"
+;;;  "foo" => '"foo"'
+;;; which avoids having to escape quotes where possible
+(defun js-escape-string (string)
   (let ((index 0)
         (size (length string))
         (seen-single-quote nil)
         (seen-double-quote nil))
-    (flet ((%escape-string (string escape-single-quote-p)
+    (flet ((%js-escape-string (string escape-single-quote-p)
              (let ((output "")
                    (index 0))
                (while (< index size)
@@ -513,10 +524,25 @@
       ;; Then pick the appropriate way to escape the quotes
       (cond
         ((not seen-single-quote)
-         (concat "'"   (%escape-string string nil) "'"))
+         (concat "'"   (%js-escape-string string nil) "'"))
         ((not seen-double-quote)
-         (concat "\""  (%escape-string string nil) "\""))
-        (t (concat "'" (%escape-string string t)   "'"))))))
+         (concat "\""  (%js-escape-string string nil) "\""))
+        (t (concat "'" (%js-escape-string string t)   "'"))))))
+
+(defun lisp-escape-string (string)
+  (let ((output "")
+        (index 0)
+        (size (length string)))
+    (while (< index size)
+      (let ((ch (char string index)))
+        (when (or (char= ch #\") (char= ch #\\))
+          (setq output (concat output "\\")))
+        (when (or (char= ch #\newline))
+          (setq output (concat output "\\"))
+          (setq ch #\n))
+        (setq output (concat output (string ch))))
+      (incf index))
+    (concat "\"" output "\"")))
 
 ;;; BOOTSTRAP MAGIC: We record the macro definitions as lists during
 ;;; the bootstrap. Once everything is compiled, we want to dump the
@@ -570,13 +596,13 @@
     (concat "[" (join (mapcar #'literal elements) ", ") "]")))
 
 (defun dump-string (string)
-  (code "make_lisp_string(" (escape-string string) ")"))
+  (code "make_lisp_string(" (js-escape-string string) ")"))
 
 (defun literal (sexp &optional recursive)
   (cond
     ((integerp sexp) (integer-to-string sexp))
     ((floatp sexp) (float-to-string sexp))
-    ((characterp sexp) (escape-string (string sexp)))
+    ((characterp sexp) (js-escape-string (string sexp)))
     (t
      (or (cdr (assoc sexp *literal-table* :test #'eql))
          (let ((dumped (typecase sexp
diff --git a/src/print.lisp b/src/print.lisp
index f5e3f3b..db6b9a2 100644
--- a/src/print.lisp
+++ b/src/print.lisp
@@ -194,7 +194,7 @@
                          (#\space "space")
                          (otherwise (string form)))))
               ((stringp form) (if *print-escape*
-                                  (escape-string form)
+                                  (lisp-escape-string form)
                                   form))
               ((functionp form)
                (let ((name (oget form "fname")))
-- 
1.7.10.4