From: Vladimir Sedach Date: Wed, 26 Nov 2008 05:50:18 +0000 (-0700) Subject: Implemented who-ps-html, which is like the ps-html macro but taking CL-WHO like synta... X-Git-Url: http://git.hcoop.net/clinton/parenscript.git/commitdiff_plain/1937c30a73058fff719dc060354326863448c4fc Implemented who-ps-html, which is like the ps-html macro but taking CL-WHO like syntax. Changed the behavior of ps-html to preserve the case of tag and attribute symbols when printing. --- diff --git a/docs/reference.lisp b/docs/reference.lisp index 0cd7a0c..5979eb9 100644 --- a/docs/reference.lisp +++ b/docs/reference.lisp @@ -1073,10 +1073,10 @@ a-variable => aVariable ;;; compiler. The resulting expression is a JavaScript expression. (ps-html ((:a :href "foobar") "blorg")) -=> 'blorg' +=> 'blorg' (ps-html ((:a :href (generate-a-link)) "blorg")) -=> 'blorg' +=> 'blorg' ;;; We can recursively call the ParenScript compiler in an HTML ;;; expression. @@ -1084,7 +1084,7 @@ a-variable => aVariable (document.write (ps-html ((:a :href "#" :onclick (lisp (ps-inline (transport)))) "link"))) -=> document.write('link') +=> document.write('link') ;;; Forms may be used in attribute lists to conditionally generate ;;; the next attribute. In this example the textarea is sometimes disabled. @@ -1097,9 +1097,9 @@ a-variable => aVariable => var disabled = null; var authorized = true; element.innerHTML = - 'Edit me'; + 'Edit me'; ;;;# Macrology ;;;t \index{macro} diff --git a/src/lib/ps-html.lisp b/src/lib/ps-html.lisp dissimilarity index 98% index f24682a..d2d96cc 100644 --- a/src/lib/ps-html.lisp +++ b/src/lib/ps-html.lisp @@ -1,60 +1,79 @@ -(in-package :parenscript) - -(defun process-html-forms (forms) ; this needs a rewrite - (let ((res ())) - (labels ((handle-form (form) - (cond ((keywordp form) - (push (format nil "<~A/>" - (string-downcase (symbol-name form))) res)) - - ((atom form) - (push form res)) - - ((and (consp form) - (keywordp (first form))) - (let ((node-name (string-downcase (symbol-name (first form))))) - (push (format nil "<~A>" node-name) res) - (map nil #'handle-form (cdr form)) - (push (format nil "" node-name) res))) - - ((and (consp form) - (consp (first form)) - (keywordp (caar form))) - (let ((node-name (string-downcase (symbol-name (caar form))))) - (push (format nil "<~A" node-name) res) - - (loop with attrs = (cdar form) - while attrs - for attr-name = (pop attrs) - for attr-test = (when (not (keywordp attr-name)) - (let ((test attr-name)) - (setf attr-name (pop attrs)) - test)) - for attr-val = (pop attrs) - do - (if attr-test - (push `(if ,attr-test - (+ ,(format nil " ~A=\"" (string-downcase (symbol-name attr-name))) - ,attr-val - "\"") - "") - res) - (progn - (push (format nil " ~A=\"" (string-downcase (symbol-name attr-name))) - res) - (push attr-val res) - (push "\"" res)))) - (push ">" res) - (map nil #'handle-form (cdr form)) - (push (format nil "" node-name) res))) - - ((consp form) - (push form res))))) - (map nil #'handle-form forms) - (concat-constant-strings (reverse res))))) - -(defpsmacro ps-html (&rest html-forms) - (cons '+ (process-html-forms html-forms))) - -(defmacro ps-html (&rest html-forms) - `(format nil "~@{~A~}" ,@(process-html-forms html-forms))) +(in-package :parenscript) + +(defun concat-constant-strings (str-list) + (reverse (reduce (lambda (optimized-list next-obj) + (if (and (or (numberp next-obj) (stringp next-obj)) (stringp (car optimized-list))) + (cons (format nil "~a~a" (car optimized-list) next-obj) (cdr optimized-list)) + (cons next-obj optimized-list))) + (cons () str-list)))) + +(defun process-html-forms-lhtml (forms) + (let ((r ())) + (labels ((process-form (form) + (cond ((keywordp form) (push (format nil "<~A />" form) r)) + ((atom form) (push form r)) + ((and (consp form) (keywordp (car form))) + (push (format nil "<~A>" (car form)) r) + (map nil #'process-form (cdr form)) + (push (format nil "" (car form)) r)) + ((and (consp form) (consp (first form)) (keywordp (caar form))) + (push (format nil "<~A" (caar form)) r) + (loop with attrs = (cdar form) + while attrs + for attr-name = (pop attrs) + for attr-test = (when (not (keywordp attr-name)) + (let ((test attr-name)) + (setf attr-name (pop attrs)) + test)) + for attr-val = (pop attrs) + do + (if attr-test + (push `(if ,attr-test + (concat-string ,(format nil " ~A=\"" attr-name) ,attr-val "\"") + "") + r) + (progn + (push (format nil " ~A=\"" attr-name) r) + (push attr-val r) + (push "\"" r)))) + (push ">" r) + (map nil #'process-form (cdr form)) + (push (format nil "" (caar form)) r)) + (t (push form r))))) + (map nil #'process-form forms) + (concat-constant-strings (reverse r))))) + +(defun process-html-forms-cl-who (forms) + (let ((r ())) + (labels ((process-form (form) + (cond ((keywordp form) (push (format nil "<~A />" form) r)) + ((atom form) (push form r)) + ((and (consp form) (keywordp (car form))) + (push (format nil "<~A" (car form)) r) + (let (content) + (labels ((process-attributes (attrs) + (cond ((= 1 (length attrs)) (setf content (car attrs))) + ((consp (car attrs)) + (push `(if ,(first attrs) + (concat-string ,(format nil " ~A=\"" (second attrs)) ,(third attrs) "\"") + "") + r) + (process-attributes (cdddr attrs))) + (t (push (format nil " ~A=\"" (first attrs)) r) + (push (second attrs) r) + (push "\"" r) + (process-attributes (cddr attrs)))))) + (process-attributes (cdr form)) + (push ">" r) + (when content + (map nil #'process-form content)))) + (push (format nil "" (car form)) r)) + (t (push form r))))) + (map nil #'process-form forms) + (concat-constant-strings (reverse r))))) + +(defmacro+ps ps-html (&rest html-forms) + `(concat-string ,@(process-html-forms-lhtml html-forms))) + +(defmacro+ps who-ps-html (&rest html-forms) + `(concat-string ,@(process-html-forms-cl-who html-forms))) diff --git a/src/lib/ps-macro-lib.lisp b/src/lib/ps-macro-lib.lisp index 51ea696..83dba18 100644 --- a/src/lib/ps-macro-lib.lisp +++ b/src/lib/ps-macro-lib.lisp @@ -77,3 +77,10 @@ (defpsmacro concatenate (result-type &rest sequences) (assert (equal result-type ''string) () "Right now Parenscript 'concatenate' only support strings.") (cons '+ sequences)) + +(defmacro concat-string (&rest things) + `(format nil "~@{~A~}" ,@things)) + +(defpsmacro concat-string (&rest things) + (cons '+ things)) + diff --git a/src/package.lisp b/src/package.lisp index 4eedcbd..4992492 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -143,6 +143,7 @@ ;; html generator for javascript #:ps-html + #:who-ps-html ;; utils #:do-set-timeout diff --git a/src/utils.lisp b/src/utils.lisp index f253f0e..d3b6ccc 100644 --- a/src/utils.lisp +++ b/src/utils.lisp @@ -25,13 +25,6 @@ (when keep-separators (push (string (char string i)) res)) (setf last (1+ i))))) -(defun concat-constant-strings (list) - (reverse (reduce (lambda (optimized-list next-obj) - (if (and (or (numberp next-obj) (stringp next-obj)) (stringp (car optimized-list))) - (cons (format nil "~a~a" (car optimized-list) next-obj) (cdr optimized-list)) - (cons next-obj optimized-list))) - (cons () list)))) - (defparameter *special-chars* '((#\! . "Bang") (#\? . "What") diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp index 73c4e4c..4477531 100644 --- a/t/ps-tests.lisp +++ b/t/ps-tests.lisp @@ -415,7 +415,7 @@ x = 2 + sideEffect() + x + 5;") :onclick (lisp (ps-inline (transport)))) img)) img)) - "document.write(LINKORNOT == 1 ? '' + img + '' : img)") + "document.write(LINKORNOT == 1 ? '' + img + '' : 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 ec31e30..99b3706 100644 --- a/t/reference-tests.lisp +++ b/t/reference-tests.lisp @@ -579,17 +579,17 @@ for (var k in obj) { (test-ps-js the-html-generator-1 (ps-html ((:a :href "foobar") "blorg")) - "'blorg'") + "'blorg'") (test-ps-js the-html-generator-2 (ps-html ((:a :href (generate-a-link)) "blorg")) - "'blorg'") + "'blorg'") (test-ps-js the-html-generator-3 (document.write (ps-html ((:a :href "#" :onclick (lisp (ps-inline (transport)))) "link"))) - "document.write('link')") + "document.write('link')") (test-ps-js the-html-generator-4 (let* ((disabled nil) @@ -600,7 +600,7 @@ for (var k in obj) { "var disabled = null; var authorized = true; element.innerHTML = -'Edit me';") +'Edit me';")