From 3713725936840f8fed051cc0045cdb4486e80b7b Mon Sep 17 00:00:00 2001 From: Raimon Grau Date: Thu, 2 May 2013 01:12:22 +0200 Subject: [PATCH] princ-to-string to implement ~a and ~S format directives --- src/print.lisp | 22 ++++++++++++++++++---- tests/format.lisp | 4 ++++ 2 files changed, 22 insertions(+), 4 deletions(-) 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 "#")))) +(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"))) -- 1.7.10.4