X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=htmlgen.lisp;h=8f84664ed95e0723f6a87f9ff2d3a08702c087f4;hb=b3c9c7b9676331743746cf6f10d870e7c4eeec52;hp=ade02768dcec83f390dd072151da943b6fa236d7;hpb=6ec49bfd3b5c1d91421258e9452ce38f99f49681;p=lml2.git diff --git a/htmlgen.lisp b/htmlgen.lisp index ade0276..8f84664 100644 --- a/htmlgen.lisp +++ b/htmlgen.lisp @@ -1,6 +1,6 @@ ;; -*- mode: common-lisp; package: lml2 -*- ;; -;; $Id: htmlgen.lisp,v 1.17 2003/07/21 16:20:47 kevin Exp $ +;; $Id: htmlgen.lisp,v 1.20 2003/08/02 10:02:51 kevin Exp $ ;; ;; copyright (c) 1986-2000 Franz Inc, Berkeley, CA ;; copyright (c) 2003 Kevin Rosenberg @@ -44,15 +44,11 @@ ) (defmacro html (&rest forms &environment env) - ;; just emit html to the current stream - ;;(process-html-forms forms env) - (post-process-html-forms - (process-html-forms forms env)) - ) + (process-html-forms forms env))) (defun post-process-html-forms (input-forms) - "KMR: Walk through forms and combining write-strings" + "KMR: Walk through forms and combine write-strings" (let (res strs last-stream) (flet ((flush-strings () (when strs @@ -68,22 +64,21 @@ ((atom form) (flush-strings) (push form res)) + ((and (eq (car form) 'cl:write-string) + (stringp (cadr form))) + (if strs + (if (eq last-stream (third form)) + (setq strs (concatenate 'string strs (second form))) + (progn + (flush-strings) + (setq strs (second form)) + (setq last-stream (third form)))) + (progn + (setq strs (second form)) + (setq last-stream (third form))))) (t - (cond - ((eq (car form) 'cl:write-string) - (if strs - (if (eq last-stream (third form)) - (setq strs (concatenate 'string strs (second form))) - (progn - (flush-strings) - (setq strs (second form)) - (setq last-stream (third form)))) - (progn - (setq strs (second form)) - (setq last-stream (third form))))) - (t - (flush-strings) - (push form res))))))))) + (flush-strings) + (push (post-process-html-forms form) res))))))) (defmacro html-out-stream-check (stream) @@ -818,7 +813,9 @@ ;; must use syntax (declare (ignore ent args argsp)) `(progn + #+ignore (write-string "