Changed printing subsystem interface to allow direct output to

streams. Added 'ps-to-stream' function.

diff --git a/docs/reference.lisp b/docs/reference.lisp
index 173e70b..77677de 100644 (file)
--- a/docs/reference.lisp
+++ b/docs/reference.lisp
@@ -1000,7 +1000,7 @@ a-variable  => aVariable;
 ((@ document write)
   (ps-html ((:a :href "#"
                 :onclick (ps-inline (transport))) "link")))
-=> document.write('<A HREF=\"#\" ONCLICK=\"' + ('javascript:' + 'transport' + '(' + ')') + '\">link</A>');
+=> document.write('<A HREF=\"#\" ONCLICK=\"' + ('javascript:' + 'transport()') + '\">link</A>');
 
 ;;; Forms may be used in attribute lists to conditionally generate
 ;;; the next attribute. In this example the textarea is sometimes disabled.

diff --git a/src/compilation-interface.lisp b/src/compilation-interface.lisp
index 17edd00..7670e7f 100644 (file)
--- a/src/compilation-interface.lisp
+++ b/src/compilation-interface.lisp
@@ -2,19 +2,36 @@
 
 (defparameter *js-target-version* 1.3)
 
+(defvar *parenscript-stream* nil)
+
 (defmacro ps (&body body)
   "Given Parenscript forms (an implicit progn), compiles those forms
 to a JavaScript string at macro-expansion time."
-  (let ((s (gensym)))
-    `(with-output-to-string (,s)
-       ,@(mapcar (lambda (x)
-                   `(write-string ,x ,s))
-                 (parenscript-print
-                  (ps-compile-statement `(progn ,@body)))))))
+  (let ((printed-forms (parenscript-print
+                        (ps-compile-statement `(progn ,@body))
+                        nil)))
+    (if (and (not (cdr printed-forms))
+             (stringp (car printed-forms)))
+        (car printed-forms)
+        (let ((s (gensym)))
+          `(with-output-to-string (,s)
+             ,@(mapcar (lambda (x) `(write-string ,x ,s)) printed-forms))))))
+
+(defmacro ps-to-stream (stream &body body)
+  (let ((printed-forms (parenscript-print
+                        (ps-compile-statement `(progn ,@body))
+                        nil)))
+    `(let ((*parenscript-stream* ,stream))
+       ,@(mapcar (lambda (x) `(write-string ,x *parenscript-stream*)) printed-forms))))
+
 (defun ps* (&rest body)
   "Compiles BODY to a JavaScript string.
 Body is evaluated."
-  (compiled-form-to-string (ps-compile-statement `(progn ,@body))))
+  (let ((*psw-stream* (or *parenscript-stream*
+                          (make-string-output-stream))))
+    (parenscript-print (ps-compile-statement `(progn ,@body)) t)
+    (unless *parenscript-stream*
+      (get-output-stream-string *psw-stream*))))
 
 (defmacro ps-doc (&body body)
   "Expands Parenscript forms in a clean environment."
@@ -27,11 +44,6 @@ Body is evaluated."
         (*ps-special-variables* nil))
     (ps* ps-form)))
 
-(defun compiled-form-to-string (ps-compiled-form)
-  (with-output-to-string (s)
-    (dolist (x (parenscript-print ps-compiled-form))
-      (write-string (if (stringp x) x (eval x)) s))))
-
 (defvar *js-inline-string-delimiter* #\"
   "Controls the string delimiter char used when compiling Parenscript in ps-inline.")
 
@@ -41,13 +53,17 @@ Body is evaluated."
 (defmacro/ps ps-inline (form &optional (string-delimiter *js-inline-string-delimiter*))
   `(concatenate 'string "javascript:"
                 ,@(let ((*js-string-delimiter* string-delimiter))
-                    (parenscript-print (ps-compile form)))))
+                    (parenscript-print (ps-compile form) nil))))
 
 (defvar *ps-read-function* #'read
   "This should be a function that takes the same inputs and returns the same
 outputs as the common lisp read function.  We declare it as a variable to allow
 a user-supplied reader instead of the default lisp reader.")
 
+(defun compiled-form-to-string (ps-compiled-form)
+  (with-output-to-string (*psw-stream*)
+    (parenscript-print ps-compiled-form t)))
+
 (defun ps-compile-stream (stream)
   "Compiles a source stream as if it were a file.  Outputs a Javascript string."
   (let ((*ps-compilation-level* :toplevel)

diff --git a/src/package.lisp b/src/package.lisp
index 7874c7e..4173e9e 100644 (file)
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -219,6 +219,7 @@
       #:*js-target-version*
       #:compile-script
       #:ps
+      #:ps-to-stream
       #:ps-doc
       #:ps-doc*
       #:ps*

diff --git a/src/printer.lisp b/src/printer.lisp
index 97c6d08..db34da6 100644 (file)
--- a/src/printer.lisp
+++ b/src/printer.lisp
@@ -10,19 +10,36 @@ in an html attribute delimited by #\\\" as opposed to #\\', or
 vice-versa.")
 
 (defvar *indent-level*)
-(defvar *print-accumulator*)
 
-(defmethod parenscript-print (form)
+(defvar *psw-stream*)
+
+(defun parenscript-print (form immediate?)
+  (declare (special immediate?))
   (let ((*indent-level* 0)
-        (*print-accumulator* ()))
+        (*psw-stream* (if immediate?
+                          *psw-stream*
+                          (make-string-output-stream)))
+        (%psw-accumulator ()))
+    (declare (special %psw-accumulator))
     (if (and (listp form) (eq 'js:block (car form))) ; ignore top-level block
         (loop for (statement . remaining) on (cdr form) do
-             (ps-print statement) (psw ";") (when remaining (psw #\Newline)))
+             (ps-print statement) (psw #\;) (when remaining (psw #\Newline)))
         (ps-print form))
-    (nreverse *print-accumulator*)))
+    (unless immediate?
+      (reverse (cons (get-output-stream-string *psw-stream*) %psw-accumulator)))))
 
 (defun psw (obj)
-  (push (if (characterp obj) (string obj) obj) *print-accumulator*))
+  (declare (special %psw-accumulator immediate?))
+  (typecase obj
+    (string (write-string obj *psw-stream*))
+    (character (write-char obj *psw-stream*))
+    (otherwise
+     (if immediate?
+         (write-string (eval obj) *psw-stream*)
+         (setf %psw-accumulator
+               (cons obj
+                     (cons (get-output-stream-string *psw-stream*)
+                           %psw-accumulator)))))))
 
 (defgeneric ps-print% (special-form-name special-form-args))
 
@@ -71,12 +88,12 @@ arguments, defines a printer for that form using the given body."
           for code = (char-code char)
           for special = (lisp-special-char-to-js char)
           do (cond (special (psw #\\) (psw special))
-                   ((or (<= code #x1f) (>= code #x80)) (psw (format nil "\\u~4,'0x" code)))
+                   ((or (<= code #x1f) (>= code #x80)) (format *psw-stream* "\\u~4,'0x" code))
                    (t (psw char))))
     (psw *js-string-delimiter*)))
 
 (defmethod ps-print ((number number))
-  (psw (format nil (if (integerp number) "~S" "~F") number)))
+  (format *psw-stream* (if (integerp number) "~S" "~F") number))
 
 ;;; expression and operator precedence rules
 
@@ -121,10 +138,10 @@ arguments, defines a printer for that form using the given body."
         (if (>= (expression-precedence arg) precedence)
             (parenthesize-print arg)
             (ps-print arg))
-        (when remaining (psw (format nil " ~(~A~) " op)))))
+        (when remaining (format *psw-stream* " ~(~A~) " op))))
 
 (defprinter js:unary-operator (op arg &key prefix space)
-  (when prefix (psw (format nil "~(~a~)~:[~; ~]" op space)))
+  (when prefix (format *psw-stream* "~(~a~)~:[~; ~]" op space))
   (if (> (expression-precedence arg)
          (op-precedence (case op
                           (+ 'unary+)
@@ -132,7 +149,7 @@ arguments, defines a printer for that form using the given body."
                           (t op))))
       (parenthesize-print arg)
       (ps-print arg))
-  (unless prefix (psw (format nil "~(~a~)" op))))
+  (unless prefix (format *psw-stream* "~(~a~)" op)))
 
 (defprinter js:funcall (fun-designator &rest args)
   (funcall (if (member (car fun-designator) '(js:variable js:aref js:slot-value js:funcall))
@@ -163,7 +180,7 @@ arguments, defines a printer for that form using the given body."
   (print-fun-def name args body))
 
 (defun print-fun-def (name args body-block)
-  (psw (format nil "function ~:[~;~A~](" name (symbol-to-js-string name)))
+  (format *psw-stream* "function ~:[~;~A~](" name (symbol-to-js-string name))
   (loop for (arg . remaining) on args do
         (psw (symbol-to-js-string arg)) (when remaining (psw ", ")))
   (psw ") ")
@@ -298,10 +315,8 @@ arguments, defines a printer for that form using the given body."
 
 ;;; regex
 (defprinter js:regex (regex)
-  (flet ((first-slash-p (string)
-           (and (> (length string) 0) (char= (char string 0) #\/))))
-    (let ((slash (unless (first-slash-p regex) "/")))
-      (psw (format nil (concatenate 'string slash "~A" slash) regex)))))
+  (let ((slash (unless (and (> (length regex) 0) (char= (char regex 0) #\/)) "/")))
+    (psw (concatenate 'string slash regex slash))))
 
 ;;; conditional compilation
 (defprinter js:cc-if (test &rest body)

diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp
index ee4ea47..1064aa8 100644 (file)
--- a/t/ps-tests.lisp
+++ b/t/ps-tests.lisp
@@ -541,7 +541,7 @@ __setf_someThing(_js1, _js2, _js3);")
                      :onclick (ps-inline (transport)))
                  img))
        img))
-  "document.write(LINKORNOT == 1 ? '<A HREF=\"#\" ONCLICK=\"' + ('javascript:' + 'transport' + '(' + ')') + '\">' + img + '</A>' : img);")
+  "document.write(LINKORNOT == 1 ? '<A HREF=\"#\" ONCLICK=\"' + ('javascript:' + 'transport()') + '\">' + img + '</A>' : img);")
 
 (test-ps-js negate-number-literal ;; ok, this was broken and fixed before, but no one bothered to add the test!
   (- 1)

diff --git a/t/reference-tests.lisp b/t/reference-tests.lisp
index 8712a4f..a96133c 100644 (file)
--- a/t/reference-tests.lisp
+++ b/t/reference-tests.lisp
@@ -532,7 +532,7 @@ for (var i in obj) {
   ((@ document write)
   (ps-html ((:a :href "#"
                 :onclick (ps-inline (transport))) "link")))
-  "document.write('<A HREF=\"#\" ONCLICK=\"' + ('javascript:' + 'transport' + '(' + ')') + '\">link</A>');")
+  "document.write('<A HREF=\"#\" ONCLICK=\"' + ('javascript:' + 'transport()') + '\">link</A>');")
 
 (test-ps-js the-html-generator-4
   (let ((disabled nil)