X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fprint.lisp;h=a8ac834dbb42f969dd2678bd937aff63e34812c6;hb=ce86ba5f70b9e35bfb795402913f417de493e23f;hp=7582f16535aa42ec68916a14fb6480864aa3bdad;hpb=018d8f643addb34a348093cba371652df3da0c12;p=jscl.git

diff --git a/src/print.lisp b/src/print.lisp
index 7582f16..a8ac834 100644
--- a/src/print.lisp
+++ b/src/print.lisp
@@ -16,8 +16,25 @@
 ;; You should have received a copy of the GNU General Public License
 ;; along with JSCL.  If not, see <http://www.gnu.org/licenses/>.
 
+(/debug "loading print.lisp!")
+
 ;;; Printer
 
+(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 "\"")))
+
 ;;; Return T if the string S contains characters which need to be
 ;;; escaped to print the symbol name, NIL otherwise.
 (defun escape-symbol-name-p (s)
@@ -198,7 +215,7 @@
                          (#\space "space")
                          (otherwise (string form)))))
               ((stringp form) (if *print-escape*
-                                  (concat "\"" (escape-string form) "\"")
+                                  (lisp-escape-string form)
                                   form))
               ((functionp form)
                (let ((name (oget form "fname")))
@@ -266,6 +283,8 @@
                 (concatf res "~"))
                ((char= next #\%)
                 (concatf res *newline*))
+               ((char= next #\*)
+                (pop arguments))
                (t
                 (concatf res (format-special next (car arguments)))
                 (pop arguments))))
@@ -278,6 +297,6 @@
         res)))
 
 (defun format-special (chr arg)
-  (case chr
+  (case (char-upcase chr)
     (#\S (prin1-to-string arg))
-    (#\a (princ-to-string arg))))
+    (#\A (princ-to-string arg))))