From 89cf1a9e0c28e8e4707f5541b831b5025f953956 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Tue, 15 Jul 2003 19:25:28 +0000 Subject: [PATCH] r5309: *** empty log message *** --- ChangeLog | 14 ++ README | 2 + debian/changelog | 6 + debian/rules | 2 +- doc/readme.html | 8 +- doc/readme.lml | 16 +-- htmlgen.lisp | 330 +++++++++++++++++++++++++---------------------- lml2.asd | 5 +- tests.lisp | 117 ++++++++++++++--- 9 files changed, 304 insertions(+), 196 deletions(-) create mode 100644 ChangeLog create mode 100644 README diff --git a/ChangeLog b/ChangeLog new file mode 100644 index 0000000..1168561 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,14 @@ +2003-07-15 Kevin M. Rosenberg + + * htmlgen.lisp: + - Finished removal of if* macro + - Added attribute processing tags + (:if :when :optional :format :fformat) + - Ensured that attribute values are quoted + (html ((:div width 5))) =>
+ * lml2.asd: Remove ifstar.lisp + * tests.lisp: + - Port tests from first LML package + - Add tests for new features + + diff --git a/README b/README new file mode 100644 index 0000000..de6426b --- /dev/null +++ b/README @@ -0,0 +1,2 @@ +See doc/readme.lml for a brief introduction + diff --git a/debian/changelog b/debian/changelog index 5e50b61..47a8376 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-lml2 (1.3-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg Tue, 15 Jul 2003 12:18:46 -0600 + cl-lml2 (1.2.0-1) unstable; urgency=low * New upstream: diff --git a/debian/rules b/debian/rules index 10e30a0..c0a9dbe 100755 --- a/debian/rules +++ b/debian/rules @@ -63,7 +63,7 @@ binary-arch: build install # dh_installman # dh_installinfo # dh_undocumented - dh_installchangelogs + dh_installchangelogs ChangeLog dh_strip dh_compress dh_fixperms diff --git a/doc/readme.html b/doc/readme.html index 51fa64d..0d40d82 100644 --- a/doc/readme.html +++ b/doc/readme.html @@ -1,9 +1,7 @@ LML2 README

LML2 Documentation

Overview

LML2 is a Common Lisp package for generating HTML and XHTML documents. LML2 is based on:

The home page for LML2 is http://lml2.b9.com/.

Differences between LML2 and LML

The syntax and HTML generation for LML2 are based on Franz's htmlgen macro. Personally, I like the syntax of LML better than LML2, but there are advantages of Franz's approach:

  • Faster compilation and runtime HTML generation
  • Behavior of tags is extensible

Differences between LML2 and htmlgen

  • LML2 is XHTML compatible with close tags so that (html :hr) now produces '<hr />'
  • Lowercase tag names so that (html ((:p class 'a))) now produces '<p class="a"></p>
  • Addition of new tags such as :insert-file, :nbsp, :jscript
  • Removal of the if* macro from the htmlgen.lisp source code
  • Incorporation of LML's standard site macro and other helper functions.

Installation

The easiest way to install LML is to use the Debian GNU/Linux operating system. You can then use the command apt-get install cl-lml2 to automatically download and install the LML2 package.

On a non-Debian system, you need to have ASDF installed to load the system definition file. You will need to change the source - pathname in the system file to match the location where you have installed LML.

Usage

Currently, there is no documentation on the functions provided by LML2. However, the source code is instructive and there are example files included in the LML2 package.

Examples

Iteration
(html
+       pathname in the system file to match the location where you have installed LML.
Usage
Currently, there is no documentation on the functions provided by LML2. However, the source code is instructive and there are example files included in the LML2 package.
Examples
Iteration
(html
    (:i "The square of the first five integers are: ")
-   (:b
-   (loop as x from 1 to 5 
-     doing
-     (lml-format " ~D" (* x x)))))
The square of the first five integers are:  1 4 9 16 25
View this page's LML2 source.

\ No newline at end of file
+   (:b (loop as x from 1 to 5 
+           doing (html  (:princ (* x x))))))
The square of the first five integers are: 1 4 9 16 25

View this page's LML2 source.

\ No newline at end of file diff --git a/doc/readme.lml b/doc/readme.lml index e330c31..5be2b43 100644 --- a/doc/readme.lml +++ b/doc/readme.lml @@ -43,7 +43,9 @@ (:li "Lowercase tag names so that (html ((:p class 'a))) now produces '<p class=\"a\"></p>") (:li "Addition of new tags such as :insert-file, :nbsp, :jscript") (:li "Removal of the if* macro from the htmlgen.lisp source code") - (:li "Incorporation of LML's standard site macro and other helper functions.")) + (:li "Incorporation of LML's standard site macro and other helper functions.") + (:li "Addition of special attribute tags (:if :when :optional :format :format") + (:li "Automatic quoting of attribute values for non-string values")) (:h2 "Installation") (:p @@ -73,16 +75,12 @@ (:pre "(html (:i \"The square of the first five integers are: \") - (:b - (loop as x from 1 to 5 - doing - (lml-format \" ~D\" (* x x)))))")) + (:b (loop as x from 1 to 5 + doing (html " " (:princ (* x x))))))")) (:td (:i "The square of the first five integers are: ") - (:b - (loop as x from 1 to 5 - doing - (lml-format " ~D" (* x x)))))) + (:b (loop as x from 1 to 5 + doing (html " " (:princ (* x x))))))) )) :hr (:p diff --git a/htmlgen.lisp b/htmlgen.lisp index 07548e7..570caef 100644 --- a/htmlgen.lisp +++ b/htmlgen.lisp @@ -1,6 +1,6 @@ ;; -*- mode: common-lisp; package: lml2 -*- ;; -;; $Id: htmlgen.lisp,v 1.14 2003/07/15 16:52:23 kevin Exp $ +;; $Id: htmlgen.lisp,v 1.15 2003/07/15 19:25:28 kevin Exp $ ;; ;; copyright (c) 1986-2000 Franz Inc, Berkeley, CA ;; copyright (c) 2003 Kevin Rosenberg @@ -9,7 +9,9 @@ ;; - Support XHTML end tags ;; - lowercase symbol names for attributes ;; - Add custom tags such as :jscript, :insert-file, :load-file, :nbsp -;; - removal of if* macro -- partially complete +;; - removal of if* macro +;; - Add attribute conditions +;; - Automatic conversion to strings for attribute values ;; ;; This code is free software; you can redistribute it and/or ;; modify it under the terms of the version 2.1 of @@ -70,26 +72,28 @@ ;; body is the body if any of the form ;; (let (spec) - (if* (setq spec (html-process-special ent)) - then ; do something different - (push (funcall spec ent args argsp body) res) - elseif (null argsp) - then ; singleton tag, just do the set - (push `(,(html-process-macro ent) :set) res) - nil - else (if* (equal args '(:unset)) - then ; ((:tag :unset)) is a special case. - ; that allows us to close off singleton tags - ; printed earlier. - (push `(,(html-process-macro ent) :unset) res) - nil - else ; some args - (push `(,(html-process-macro ent) - ,args - ,(process-html-forms body env)) - res) - nil))))) - + (cond + ((setq spec (html-process-special ent)) + ;; do something different + (push (funcall spec ent args argsp body) res)) + ((null argsp) + ;; singleton tag, just do the set + (push `(,(html-process-macro ent) :set) res) + nil) + (t + (cond ((equal args '(:unset)) + ;; ((:tag :unset)) is a special case. + ;; that allows us to close off singleton tags + ;; printed earlier. + (push `(,(html-process-macro ent) :unset) res) + nil) + (t + ;; some args + (push `(,(html-process-macro ent) + ,args + ,(process-html-forms body env)) + res) + nil))))))) (do* ((xforms forms (cdr xforms)) @@ -98,32 +102,36 @@ (setq form (macroexpand form env)) - (if* (atom form) - then (if* (keywordp form) - then (let ((ent (gethash form *html-process-table*))) - (if (null ent) - (error "unknown html keyword ~s" form) - (do-ent ent nil nil nil))) - elseif (stringp form) - then ; turn into a print of it - (push `(write-string ,form *html-stream*) res) - else (push form res)) - else (let ((first (car form))) - (if* (keywordp first) - then ; (:xxx . body) form - (let ((ent (gethash first - *html-process-table*))) - (if (null ent) - (error "unknown html keyword ~s" form) - (do-ent ent nil t (cdr form)))) - elseif (and (consp first) (keywordp (car first))) - then ; ((:xxx args ) . body) - (let ((ent (gethash (car first) - *html-process-table*))) - (if (null ent) - (error "unknown html keyword ~s" form) - (do-ent ent (cdr first) t (cdr form)))) - else (push form res)))))) + (if (atom form) + (cond + ((keywordp form) + (let ((ent (gethash form *html-process-table*))) + (if (null ent) + (error "unknown html keyword ~s" form) + (do-ent ent nil nil nil)))) + ((stringp form) + ;; turn into a print of it + (push `(write-string ,form *html-stream*) res)) + (t + (push form res))) + (let ((first (car form))) + (cond + ((keywordp first) + ;; (:xxx . body) form + (let ((ent (gethash first + *html-process-table*))) + (if (null ent) + (error "unknown html keyword ~s" form) + (do-ent ent nil t (cdr form))))) + ((and (consp first) (keywordp (car first))) + ;; ((:xxx args ) . body) + (let ((ent (gethash (car first) + *html-process-table*))) + (if (null ent) + (error "unknown html keyword ~s" form) + (do-ent ent (cdr first) t (cdr form))))) + (t + (push form res))))))) `(progn ,@(nreverse res)))) @@ -152,13 +160,6 @@ ((null xx) (nreverse res)) (case name - (:if* - (push `(if* ,value - then (write-string ,(format nil " ~(~a~)" (third xx)) - *html-stream*) - (prin1-safe-http-string ,(fourth xx))) - res) - (pop xx) (pop xx)) (:fformat (unless (and (listp value) (>= (length value) 2)) @@ -178,12 +179,14 @@ (fformat nil ,(second value) ,@(cddr value))) res)) (:optional - (push `(when ,(second value) - (write-string - ,(format nil " ~(~a~)" (first value)) - *html-stream*) - (prin1-safe-http-string ,(second value))) - res)) + (let ((eval-if (gensym "EVAL-IF-"))) + (push `(let ((,eval-if ,(second value))) + (when ,eval-if + (write-string + ,(format nil " ~(~a~)" (first value)) + *html-stream*) + (prin1-safe-http-string ,eval-if))) + res))) (:if (unless (and (listp value) (>= (length value) 3) @@ -197,6 +200,15 @@ ,(third value) ,(fourth value)))) res))) + (:when + (unless (and (listp value) + (= (length value) 3)) + (error ":when must be given a list with 3 elements")) + (push `(when ,(second value) + (write-string ,(format nil " ~(~a~)" (first value)) + *html-stream*) + (prin1-safe-http-string ,(third value))) + res)) (t (push `(write-string ,(format nil " ~(~a~)" name) *html-stream*) res) @@ -272,9 +284,15 @@ ;; print the contents inside a string double quotes (which should ;; not be turned into "'s ;; symbols are turned into their name + ;; + ;; non-string and non-symbols are written to a string and quoted + (unless (and (symbolp val) (equal "" (symbol-name val))) (write-char #\= *html-stream*) + (when (not (or (stringp val) + (symbolp val))) + (setq val (write-to-string val))) (if (or (stringp val) (and (symbolp val) (setq val (string-downcase @@ -296,23 +314,17 @@ (when (< start i) (write-sequence string stream :start start :end i))) - (let ((ch (schar string i)) - (cvt )) - (if* (eql ch #\<) - then (setq cvt "<") - elseif (eq ch #\>) - then (setq cvt ">") - elseif (eq ch #\&) - then (setq cvt "&") - elseif (eq ch #\") - then (setq cvt """)) + (let* ((ch (schar string i)) + (cvt (case ch + (#\< "<") + (#\> ">") + (#\& "&") + (#\" """)))) (when cvt ;; must do a conversion, emit previous chars first - (when (< start i) (write-sequence string stream :start start :end i)) (write-string cvt stream) - (setq start (1+ i)))))) @@ -341,55 +353,58 @@ (let* ((attrs) (attr-name) (name) - (possible-kwd (if* (atom form) - then form - elseif (consp (car form)) - then (setq attrs (cdar form)) - (caar form) - else (car form))) + (possible-kwd (cond + ((atom form) form) + ((consp (car form)) + (setq attrs (cdar form)) + (caar form)) + (t (car form)))) print-handler ent) - (if* (keywordp possible-kwd) - then (if* (null (setq ent (gethash possible-kwd *html-process-table*))) - then (if unknown - (return-from html-print-subst - (funcall unknown form stream)) - (error "unknown html tag: ~s" possible-kwd)) - else ; see if we should subst - (if* (and subst - attrs - (setq attr-name (html-process-name-attr ent)) - (setq name (getf attrs attr-name)) - (setq attrs (html-find-value name subst))) - then - (return-from html-print-subst - (if* (functionp (cdr attrs)) - then - (funcall (cdr attrs) stream) - else (html-print-subst - (cdr attrs) - subst - stream - unknown))))) - - (setq print-handler - (html-process-print ent))) - (if* (atom form) - then (if* (keywordp form) - then (funcall print-handler ent :set nil nil nil nil stream) - elseif (stringp form) - then (write-string form stream) - else (princ form stream)) - elseif ent - then (funcall print-handler - ent - :full - (when (consp (car form)) (cdr (car form))) - form - subst - unknown - stream) - else (error "Illegal form: ~s" form)))) + (when (keywordp possible-kwd) + (if (null (setq ent (gethash possible-kwd *html-process-table*))) + (if unknown + (return-from html-print-subst + (funcall unknown form stream)) + (error "unknown html tag: ~s" possible-kwd)) + ;; see if we should subst + (when (and subst + attrs + (setq attr-name (html-process-name-attr ent)) + (setq name (getf attrs attr-name)) + (setq attrs (html-find-value name subst))) + (return-from html-print-subst + (if (functionp (cdr attrs)) + (funcall (cdr attrs) stream) + (html-print-subst + (cdr attrs) + subst + stream + unknown))))) + + (setq print-handler + (html-process-print ent))) + + (cond + ((atom form) + (cond + ((keywordp form) + (funcall print-handler ent :set nil nil nil nil stream)) + ((stringp form) + (write-string form stream)) + (t + (princ form stream)))) + (ent + (funcall print-handler + ent + :full + (when (consp (car form)) (cdr (car form))) + form + subst + unknown + stream)) + (t + (error "Illegal form: ~s" form))))) (defun html-find-value (key subst) @@ -403,21 +418,21 @@ (do* ((entlist alist (cdr entlist)) (ent (car entlist) (car entlist))) ((null entlist) (setq alist nil)) - (if* (consp (car ent)) - then ; this is another alist - (when (cdr entlist) - (push (cdr entlist) to-process)) - (setq alist ent) - (return) ; exit do* - elseif (equal key (car ent)) - then (return-from html-find-value ent))) + (cond + ((consp (car ent)) + ;; this is another alist + (when (cdr entlist) + (push (cdr entlist) to-process)) + (setq alist ent) + (return)) ; exit do* + ((equal key (car ent)) + (return-from html-find-value ent)))) - (if* (null alist) - then ; we need to find a new alist to process - - (if to-process - (setq alist (pop to-process)) - (return)))))) + (when (null alist) + ;; we need to find a new alist to process + (if to-process + (setq alist (pop to-process)) + (return)))))) (defun html-standard-print (ent cmd args form subst unknown stream) ;; the print handler for the normal html operators @@ -426,29 +441,30 @@ (format stream "<~a>" (html-process-key ent))) (:full ; set, do body and then unset (let (iter) - (if* args - then (if* (and (setq iter (getf args :iter)) - (setq iter (html-find-value iter subst))) - then ; remove the iter and pre - (setq args (copy-list args)) - (remf args :iter) - (funcall (cdr iter) - (cons (cons (caar form) - args) - (cdr form)) - subst - stream) - (return-from html-standard-print) - else - (format stream "<~a" (html-process-key ent)) - (do ((xx args (cddr xx))) - ((null xx)) - ; assume that the arg is already escaped - ; since we read it - ; from the parser - (format stream " ~a=\"~a\"" (car xx) (cadr xx))) - (format stream ">")) - else (format stream "<~a>" (html-process-key ent))) + (if args + (cond + ((and (setq iter (getf args :iter)) + (setq iter (html-find-value iter subst))) + ;; remove the iter and pre + (setq args (copy-list args)) + (remf args :iter) + (funcall (cdr iter) + (cons (cons (caar form) + args) + (cdr form)) + subst + stream) + (return-from html-standard-print)) + (t + (format stream "<~a" (html-process-key ent)) + (do ((xx args (cddr xx))) + ((null xx)) + ; assume that the arg is already escaped + ; since we read it + ; from the parser + (format stream " ~a=\"~a\"" (car xx) (cadr xx))) + (format stream ">"))) + (format stream "<~a>" (html-process-key ent))) (dolist (ff (cdr form)) (html-print-subst ff subst stream unknown))) (when (html-process-has-inverse ent) diff --git a/lml2.asd b/lml2.asd index f72c08b..bfb4520 100644 --- a/lml2.asd +++ b/lml2.asd @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Aug 2002 ;;;; -;;;; $Id: lml2.asd,v 1.2 2003/06/20 04:14:20 kevin Exp $ +;;;; $Id: lml2.asd,v 1.3 2003/07/15 19:25:28 kevin Exp $ ;;;; ;;;; This file, part of LML2, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -31,9 +31,8 @@ :components ((:file "package") - (:file "ifstar" :depends-on ("package")) (:file "data" :depends-on ("package")) - (:file "htmlgen" :depends-on ("ifstar" "data")) + (:file "htmlgen" :depends-on ("data")) (:file "utils" :depends-on ("package")) (:file "files" :depends-on ("utils" "htmlgen")) (:file "base" :depends-on ("files")) diff --git a/tests.lisp b/tests.lisp index 6116688..12265fb 100644 --- a/tests.lisp +++ b/tests.lisp @@ -2,12 +2,12 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: lml-tests.lisp -;;;; Purpose: lml tests file +;;;; Name: tests.lisp +;;;; Purpose: tests file ;;;; Author: Kevin M. Rosenberg ;;;; Date Started: Apr 2003 ;;;; -;;;; $Id: tests.lisp,v 1.2 2003/07/12 17:54:05 kevin Exp $ +;;;; $Id: tests.lisp,v 1.3 2003/07/15 19:25:28 kevin Exp $ ;;;; ;;;; This file, part of LML2, is Copyright (c) 2000-2003 by Kevin Rosenberg. ;;;; Rights of modification and redistribution are in the LICENSE file. @@ -16,55 +16,130 @@ (in-package #:cl) (defpackage #:lml-tests - (:use #:lml #:cl #:rtest)) + (:use #:lml2 #:cl #:rtest)) (in-package #:lml-tests) (rem-all-tests) (deftest lml.0 (with-output-to-string (s) - (let ((*html-output* s)) - (div))) + (let ((*html-stream* s)) + (html (:div)))) "
") (deftest lml.1 (with-output-to-string (s) - (let ((*html-output* s)) - (span-c foo "Foo Bar"))) + (let ((*html-stream* s)) + (html ((:span class 'foo) "Foo Bar")))) "Foo Bar") (deftest lml.2 (with-output-to-string (s) - (let ((*html-output* s)) - (table-c foo :style "width:80%" "Foo" " Bar" " test"))) + (let ((*html-stream* s)) + (html ((:table class "foo" :style "width:80%") + "Foo" " Bar" " test")))) "Foo Bar test
") (deftest lml.3 (with-output-to-string (s) - (let ((*html-output* s) + (let ((*html-stream* s) (a 5.5d0)) - (p a))) + (html (:p (:princ a))))) "

5.5d0

") (deftest lml.4 (with-output-to-string (s) - (let ((*html-output* s) + (let ((*html-stream* s) (a 0.75)) - (img "http://localhost/test.png" :width a))) + (html ((:img :src "http://localhost/test.png" :width a))))) "") (deftest lml.5 (with-output-to-string (s) - (let ((*html-output* s)) - (div "Start" - (p "Testing")))) + (let ((*html-stream* s)) + (html + (:div "Start" + (:p "Testing"))))) "
Start

Testing

") (deftest lml.6 (with-output-to-string (s) - (let ((*html-output* s)) - (div :style "font-weight:bold" - "Start" - (p-c a_class "Testing")))) + (let ((*html-stream* s)) + (html + ((:div :style "font-weight:bold") + "Start" + ((:p class 'a_class) "Testing"))))) "
Start

Testing

") +(deftest lml.7 + (with-output-to-string (s) + (let ((*html-stream* s) + (class "aclass")) + (html + ((:div :optional (:class class)) + "bod")))) + "
bod
") + +(deftest lml.8 + (with-output-to-string (s) + (let ((*html-stream* s) + (class nil)) + (html + ((:div :optional (:class class)) + "bod")))) + "
bod
") + +(deftest lml.9 + (with-output-to-string (s) + (let ((*html-stream* s) + (do-class t) + (class "aclass")) + (html + ((:div :when (:class do-class class)) + "bod")))) + "
bod
") + +(deftest lml.10 + (with-output-to-string (s) + (let ((*html-stream* s) + (do-class nil) + (class "aclass")) + (html + ((:div :when (:class do-class class)) + "bod")))) + "
bod
") + + +(deftest lml.11 + (with-output-to-string (s) + (let ((*html-stream* s) + (v 10)) + (html + ((:div :fformat (:onclick "a&b('~A')" v)))))) + "
") + +(deftest lml.12 + (with-output-to-string (s) + (let ((*html-stream* s) + (v 10)) + (html + ((:div :format (:onclick "a&b('~A')" v)))))) + "
") + +(deftest lml.13 + (with-output-to-string (s) + (let ((*html-stream* s) + (selector t) + (v 10)) + (html + ((:div :if (:width selector 1 2)))))) + "
") + +(deftest lml.14 + (with-output-to-string (s) + (let ((*html-stream* s) + (selector nil) + (v 10)) + (html + ((:div :if (:width selector 1 2)))))) + "
") -- 2.34.1