From 9301f992fc419b10953de8fd2075099c00b90d0e Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Mon, 21 Jul 2003 16:36:22 +0000 Subject: [PATCH] r5371: *** empty log message *** --- debian/changelog | 6 ++++++ htmlgen.lisp | 21 ++++++++++----------- 2 files changed, 16 insertions(+), 11 deletions(-) diff --git a/debian/changelog b/debian/changelog index 47a8376..c8f4007 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-lml2 (1.4-1) unstable; urgency=low + + * Add code walker to collapse sequential constant strings + + -- Kevin M. Rosenberg Mon, 21 Jul 2003 10:31:40 -0600 + cl-lml2 (1.3-1) unstable; urgency=low * New upstream diff --git a/htmlgen.lisp b/htmlgen.lisp index ade0276..b920ec0 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.18 2003/07/21 16:36:22 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 @@ -70,7 +66,8 @@ (push form res)) (t (cond - ((eq (car form) 'cl:write-string) + ((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))) @@ -889,9 +886,11 @@ (named-function html-write-string-function (lambda (ent args argsp body) (declare (ignore ent args argsp)) - `(progn ,@(mapcar #'(lambda (bod) - `(write-string ,bod *html-stream*)) - body)))) + (if (= (length body) 1) + `(write-string ,(car body) *html-stream*) + `(progn ,@(mapcar #'(lambda (bod) + `(write-string ,bod *html-stream*)) + body))))) (named-function html-write-string-print-function (lambda (ent cmd args form subst unknown stream) -- 2.34.1