From: Raimon Grau <raimonster@gmail.com>
Date: Wed, 1 May 2013 23:12:22 +0000 (+0200)
Subject: princ-to-string to implement ~a and ~S format directives
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=3713725936840f8fed051cc0045cdb4486e80b7b;p=jscl.git

princ-to-string to implement ~a and ~S format directives
---

diff --git a/src/print.lisp b/src/print.lisp
index c8b035c..4894970 100644
--- a/src/print.lisp
+++ b/src/print.lisp
@@ -18,7 +18,9 @@
 
 ;;; Printer
 
-(defun prin1-to-string (form)
+(defvar *print-escape* t)
+
+(defun write-to-string (form)
   (cond
     ((symbolp form)
      (multiple-value-bind (symbol foundp)
@@ -34,7 +36,9 @@
                      ":" name)))))
     ((integerp form) (integer-to-string form))
     ((floatp form) (float-to-string form))
-    ((stringp form) (concat "\"" (escape-string form) "\""))
+    ((stringp form) (if *print-escape*
+			(concat "\"" (escape-string form) "\"")
+		      form))
     ((functionp form)
      (let ((name (oget form "fname")))
        (if name
@@ -57,6 +61,14 @@
     (t
      (concat "#<javascript object>"))))
 
+(defun prin1-to-string (form)
+  (let ((*print-escape* t))
+    (write-to-string form)))
+
+(defun princ-to-string (form)
+  (let ((*print-escape* nil))
+    (write-to-string form)))
+
 (defun write-line (x)
   (write-string x)
   (write-string *newline*)
@@ -85,7 +97,7 @@
 		((char= next #\%)
 		 (setq res (concat res *newline*)))
 		(t
-		 (format-special next (car arguments))
+		 (setq res (concat res (format-special next (car arguments))))
 		 (setq arguments (cdr arguments)))))
 	    (setq res (concat res (char-to-string c))))
 	(incf i)))
@@ -97,4 +109,6 @@
 
 
  (defun format-special (chr arg)
-   chr)
+   (case chr
+     (#\S (prin1-to-string arg))
+     (#\a (princ-to-string arg))))
diff --git a/tests/format.lisp b/tests/format.lisp
index a37ed09..3491010 100644
--- a/tests/format.lisp
+++ b/tests/format.lisp
@@ -6,3 +6,7 @@
 
 (test (string= "a
 a" (format nil "a~%a")))
+
+(test (string= "this is foo" (format nil "this is ~a" "foo")))
+
+(test (string= "this is \"foo\"" (format nil "this is ~S" "foo")))