From: Wade Humeniuk
Subject: HTML Generation
Date: Thu, 17 Aug 2000 00:00:00 +0000
Message-ID: <399BFD55.530218FD@cadvision.com> This is a multi-part message in MIME format.
--------------27C0640670C9054AF0F72694
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
I have been playing with CL-HTTP and ASERVE, seeing if I get dynamic web
page generation and was not happy with either of their web generation
utilities, so I created my own. For anyone that is interested here is
an example and the lisp file is attached. I called it primitive-html.
It does not do any end tag balancing for you but the resulting code
looks a lot like HTML. I found it more natural. The HTML is based on
Transitional HTML 4.0. ACL 5.0.1 gives a lot of warnings about non top
level exports, anyone have an idea on how to fix it?
The package defintion for ACL is
(defpackage :primitive-html
(:use :common-lisp :excl)
(:export "HTML-CONTENT"
"*PRIMITIVE-HTML-STREAM*"))
An example of using it (under CL-HTTP)
(http:export-url (http:merge-url "/abc/student-administration")
:computed
:authentication-realm :student-admin
:private t
:language :en
:response-function
(lambda (url stream)
(http:with-successful-response (stream :html :content-location
url)
(let ((*primitive-html-stream* stream))
(<html>)
(<head>)
(<title>)
(write-string "Welcome to the ABC Student Administrative System"
stream)
(</title>)
(<body> :bgcolor :white)
(<center>)
(<img> :src "Pegasus.gif")
(<h3>)
(write-string "Welcome to the ABC Charter Public School's Online "
stream)
(write-string "Student Administration System." stream)
(</h3>)
(</center>)
(<h4>)(<u>)(html-content "Classrooms")(</u>)(</h4>)
(<form> :action "/abc/classroom" :method 'post)
(<select> :name "room-id" :size 10)
(dolist (classroom (p-symbol-value '*classrooms*))
(progn
(<option> :value (symbol-name (classroom-room-id classroom)))
(format stream "~A, ~A (~A)"
(teacher-surname
(classroom-teacher classroom))
(teacher-given-names
(classroom-teacher classroom))
(classroom-room-id classroom))))
(</select>)(<br>)
(<input> :type 'submit :value "View Classroom")
(</form>)
(</body>)
(</html>)))))
--------------27C0640670C9054AF0F72694
Content-Type: text/plain; charset=us-ascii;
name="primitive-html.cl"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="primitive-html.cl"
(in-package "PRIMITIVE-HTML")
(eval-when (:compile-toplevel :load-toplevel)
(defvar *primitive-html-stream* t)
(defvar *single-value-attributes*))
(defun html-content (obj &optional (stream *primitive-html-stream*))
(let ((*print-case* :downcase))
(princ obj stream)))
(defun write-attribute (attr stream)
(if (typep attr 'symbol)
(write-string (string-downcase (symbol-name attr)) stream)
(prin1 attr stream)))
(defmacro deftag (tagsym &key element attributes end-tag)
(let* ((docstring
(format nil "~A: <~S>. The <~S> Tag has the attributes ~{ ~S~}."
(or element "Generic Tag")
tagsym tagsym attributes))
(tag-funcsym (intern (format nil "<~S>" tagsym)))
(endtag-funcsym (intern (format nil "</~S>" tagsym)))
(tag-arglist (mapcar (lambda (attr) (list attr nil)) attributes))
(tag-body
(mapcar (lambda (attr)
(if (member attr *single-value-attributes*)
`(when ,attr
(write-char #\space stream)
(write-string ,(string-downcase (symbol-name attr)) stream))
`(when ,attr
(write-char #\space stream)
(write-string ,(string-downcase (symbol-name attr)) stream)
(write-char #\= stream)
(write-attribute ,attr stream))))
attributes)))
`(progn
(defun ,tag-funcsym (&key ,@tag-arglist (stream *primitive-html-stream*))
,docstring
(write-string ,(concatenate 'string "<" (string-downcase (symbol-name tagsym))) stream)
,@tag-body
(write-char #\> stream))
(export ',tag-funcsym)
(unless (eq ,end-tag :forbidden)
(defun ,endtag-funcsym (&key (stream *primitive-html-stream*))
(write-string ,(string-downcase (symbol-name endtag-funcsym)) stream))
(export ',endtag-funcsym)))))
;; HTML 4.0 TAGS
;; Using Transitional Element Specs
(defvar *%html.version*
"-//W3C//DTD HTML 4.0 Transitional//EN")
(defvar *%html.version.uri*
"http://www.w3.org/TR/RBC-html40/loose.dtd")
(defun <!doctype> (&key (stream *primitive-html-stream*))
(format stream "<!DOCTYPE HTML PUBLIC ~A ~A>"
*%html.version*
*%html.version.uri*))
;;================ Generic Attributes ========================
(eval-when (:compile-toplevel :load-toplevel)
(defvar *%coreattrs* '(id class style title))
(defvar *%i18n* '(lang dir))
(defvar *%events*
'(onclick ondblclick onmousedown onmouseup onmouseover
onmousemove onmouseout onkeypress onkeydown onkeyup)
"HTML 4.0 Specification %events attributes.")
(defvar *%attrs* (append *%coreattrs* *%i18n* *%events*))
(defvar *single-value-attributes*
'(ismap declare nohref noshade noresize disabled readonly multiple defer
nowrap compact)))
;;================ Text Markup ================================
;; %fontstyle TT | I | B | U | S | STRIKE | BIG | SMALL
(deftag tt
:element "Teletype Text"
:attributes #.*%attrs*)
(deftag i
:element "Italic Text"
:attributes #.*%attrs*)
(deftag b
:element "Bold Text"
:attributes #.*%attrs*)
(deftag u
:element "Underlined Text"
:attributes #.*%attrs*)
(deftag s
:element "Strike-Through Text"
:attributes #.*%attrs*)
(deftag strike
:element "Strike-Through Text"
:attributes #.*%attrs*)
(deftag big
:element "Large Font"
:attributes #.*%attrs*)
(deftag small
:element "Small Font"
:attributes #.*%attrs*)
;; %phrase EM | STRONG | DFN | CODE | SAMP | KBD | VAR | CITE | ABBR
;; | ACRONYM
(deftag em
:element "Emphasis"
:attributes #.*%attrs*)
(deftag strong
:element "Stronger Emphasis"
:attributes #.*%attrs*)
(deftag dfn
:element "Defiining Instance"
:attributes #.*%attrs*)
(deftag code
:element "Computer Code"
:attributes #.*%attrs*)
(deftag samp
:element "Sample Output"
:attributes #.*%attrs*)
(deftag kbd
:element "Text by User"
:attributes #.*%attrs*)
(deftag var
:element "Variable Instance"
:attributes #.*%attrs*)
(deftag cite
:element "Citation"
:attributes #.*%attrs*)
(deftag abbr
:element "Abbreviation"
:attributes #.*%attrs*)
(deftag acronym
:element "Acronym"
:attributes #.*%attrs*)
(deftag sub
:element "Subscript"
:attributes #.*%attrs*)
(deftag sup
:element "Superscript"
:attributes #.*%attrs*)
(deftag span
:element "Inline Structure"
:attributes #.*%attrs*)
(deftag bdo
:element "I18N BiDi Over-ride"
:attributes #.(append *%coreattrs* '(lang dir)))
(deftag basefont
:element "Base Font"
:end-tag :forbidden
:attributes (id size color face))
(deftag font
:element "Local Change to Font"
:attributes #.(append *%coreattrs* *%i18n* '(size color face)))
(deftag br
:element "Forced Line Break"
:end-tag :forbidden
:attributes #.(append *%coreattrs* '(clear)))
;; ==================== Document Body ==========================
(deftag body
:element "Document Body"
:attributes #.(append *%attrs*
'(onload onunload background text link
vlink alink bgcolor)))
(deftag address
:element "Information on Author"
:attributes #.*%attrs*)
(deftag div
:element "Block Level Structure"
:attributes #.*%attrs*)
(deftag center
:element "Shorthand for DIV align-center"
:attributes #.*%attrs*)
;; ===================== Anchor Element =========================
(deftag a
:element "Anchor"
:attributes #.(append *%attrs*
'(charset type name href
hreflang rel rev accesskey shape
coords tabindex onfocus onblur)))
;; ===================== Client Side Image Maps ================
(deftag map
:element "Client-Side Image Map"
:attributes #.(append *%attrs* '(name)))
(deftag area
:element "Client-Side Image Map Area"
:end-tag :forbidden
:attributes #.(append *%attrs*
'(shape coords href nohref alt
tabindex accesskey onfocus onblur)))
;; ====================== The LINK Element ======================
(deftag link
:element "Media Independent Link"
:end-tag :forbidden
:attributes #.(append *%attrs*
'(charset href hreflang type rel rev media)))
;; ====================== Images ================================
(deftag img
:element "Embedded Image"
:end-tag :forbidden
:attributes #.(append *%attrs*
'(src alt longdesc height width
usemap ismap align border hspace
vspace)))
;; ====================== ObJECT ================================
(deftag object
:element "Generic Embedded Object"
:attributes #.(append *%attrs*
'(declare classid codebase data type codetype
archive standby height width usemap name
tabindex align border hspace vspace)))
(deftag param
:element "Named Property Value"
:end-tag :forbidden
:attributes (id name value valuetype type))
;; ======================= Java APPLET ============================
(deftag applet
:element "Java Applet (or other executable content)"
:attributes #.(append *%coreattrs*
'(codebase archive code object alt name width
height align hspace vspace)))
;; ======================= Horizontal Rule ========================
(deftag hr
:element "Horizontal Rule"
:end-tag :forbidden
:attributes #.(append *%coreattrs*
*%events*
'(align noshade size width)))
;; ======================= Paragraphs ============================
(deftag p
:element "Paragraph"
:attributes #.(append *%attrs* '(align)))
;; ======================= Headings ===============================
(deftag h1
:element "Heading Level 1"
:attributes #.(append *%attrs* '(align)))
(deftag h2
:element "Heading Level 2"
:attributes #.(append *%attrs* '(align)))
(deftag h3
:element "Heading Level 3"
:attributes #.(append *%attrs* '(align)))
(deftag h4
:element "Heading Level 4"
:attributes #.(append *%attrs* '(align)))
(deftag h5
:element "Heading Level 5"
:attributes #.(append *%attrs* '(align)))
(deftag h6
:element "Heading Level 6"
:attributes #.(append *%attrs* '(align)))
;; ======================= Preformatted Text =======================
(deftag pre
:element "Preformatted text"
:attributes #.(append *%attrs* '(width)))
;; ======================= Inline Quotes ===========================
(deftag q
:element "Inline Quotation"
:attributes #.(append *%attrs* '(cite)))
;; ======================= Block Like Quotes =======================
(deftag blockquote
:element "Long Quotation"
:attributes #.(append *%attrs* '(cite)))
;; ======================= Inserted/Deleted Text ===================
(deftag ins
:element "Inserted Text"
:attributes #.(append *%attrs* '(cite datetime)))
(deftag del
:element "Deleted Text"
:attributes #.(append *%attrs* '(cite datetime)))
;; ======================= Lists ===================================
(deftag dl
:element "Direction List"
:attributes #.(append *%attrs* '(compact)))
(deftag dt
:element "Direction Term"
:attributes #.*%attrs*)
(deftag dd
:element "Direction Description"
:attributes #.*%attrs*)
(deftag ol
:element "Ordered List"
:attributes #.(append *%attrs* '(type compact start)))
(deftag ul
:element "Unordered List"
:attributes #.(append *%attrs* '(type compact)))
(deftag dir
:element "Directory List"
:attributes #.(append *%attrs* '(compact)))
(deftag menu
:element "Menu List"
:attributes #.(append *%attrs* '(compact)))
(deftag li
:element "Unordered List"
:attributes #.*%attrs*)
;; ===================== Forms ================================
;; FORMS
(deftag form
:element "Interactive Form"
:attributes #.(append *%attrs*
'(action method enctype onsubmit onreset
target accept-charset)))
(deftag label
:element "Form Field Label Text"
:attributes #.(append *%attrs* '(for accesskey onfocus onblur)))
(deftag input
:element "Form Control"
:end-tag :forbidden
:attributes #.(append *%attrs*
'(type name value checked disabled
readonly size maxlength src alt
usemap tabindex accesskey onfocus
onblur onselect onchange accept
align)))
(deftag select
:element "Option Selector"
:attributes #.(append *%attrs*
'(name size multiple disabled tabindex
onfocus onblur onchange)))
(deftag optgroup
:element "Option Group"
:attributes #.(append *%attrs* '(disabled label)))
(deftag option
:element "Selectable Choice"
:attributes #.(append *%attrs* '(selected disabled label value)))
(deftag textarea
:element "Multi-line Text Field"
:attributes #.(append *%attrs*
'(name rows cols disabled readonly tabindex
accesskey onfocus onblur onselect onchange)))
(deftag fieldset
:element "Form Control Group"
:attributes #.*%attrs*)
(deftag legend
:element "Fieldset Legend"
:attributes #.(append *%attrs* '(accesskey align)))
(deftag button
:element "Push Button"
:attributes #.(append *%attrs*
'(name value type disabled tabindex
accesskey onfocus onblur)))
;; ======================= Tables ================================
;; TABLES
(eval-when (:compile-toplevel :load-toplevel)
(defvar *%cellhalign* '(align char charoff))
(defvar *%cellvalign* '(valign)))
(deftag table
:element "Table Element"
:attributes #.(append *%attrs*
'(summary width border frame rules
cellspacing cellpadding bgcolor)))
(deftag caption
:element "Table Caption"
:attributes #.(append *%attrs* '(align)))
(deftag colgroup
:element "Table Column Group"
:attributes #.(append *%attrs*
'(span width)
*%cellhalign* *%cellvalign*))
(deftag col
:element "Table Column"
:end-tag :forbidden
:attributes #.(append *%attrs*
'(span width)
*%cellhalign* *%cellvalign*))
(deftag thead
:element "Table Header"
:attributes #.(append *%attrs* *%cellhalign* *%cellvalign*))
(deftag tbody
:element "Table Body"
:attributes #.(append *%attrs* *%cellhalign* *%cellvalign*))
(deftag tfoot
:element "Table Footer"
:attributes #.(append *%attrs* *%cellhalign* *%cellvalign*))
(deftag tr
:element "Table Row"
:attributes #.(append *%attrs* *%cellhalign* *%cellvalign*
'(bgcolor)))
(deftag th
:element "Table Header Cell"
:attributes #.(append *%attrs*
'(abbr axis headers scope rowspan colspan)
*%cellhalign*
*%cellvalign*
'(nowrap width height)))
(deftag td
:element "Table Data Cell"
:attributes #.(append *%attrs*
'(abbr axis headers scope rowspan colspan)
*%cellhalign*
*%cellvalign*
'(nowrap width height)))
;;====================== Document Frames =====================
(deftag frameset
:element "Windows Subdivision"
:attributes #.(append *%coreattrs* '(rows cols onload onunload)))
(deftag frame
:element "Subwindow"
:end-tag :forbidden
:attributes #.(append *%coreattrs*
'(longdesc name src frameborder marginwindow
marginheight noresize scrolling)))
(deftag iframe
:element "Inline Subwindow"
:attributes #.(append *%coreattrs*
'(longdesc name src frameborder marginwidth
marginheight scrolling align height width)))
(deftag noframes
:element "Alternate non-frame-based rendering"
:attributes #.*%attrs*)
;; ======================= Docuemnt Head ========================
;; HEAD ELEMENTS
(deftag head
:element "Document Head"
:attributes #.(append *%i18n* '(profile)))
(deftag title
:element "Document Title"
:attributes #.*%i18n*)
(deftag isindex
:element "Single Line Prompt"
:end-tag :forbidden
:attributes #.(append *%coreattrs* *%i18n* '(prompt)))
(deftag base
:element "Document Base URI"
:end-tag :forbidden
:attributes (href target))
(deftag meta
:element "Metainformation"
:end-tag :forbidden
:attributes #.(append *%i18n*
'(http-equiv name content scheme)))
(deftag style
:element "Style Info"
:attributes #.(append *%i18n* '(type media title)))
(deftag script
:element "Script Statements"
:attributes (charset type src defer event for))
(deftag noscript
:element "Non-Script-Based Rendering"
:attributes #.*%attrs*)
;;====================== Document Structure ==================
(deftag html
:element "Document Root"
:attributes #.(append *%i18n* '(version)))
--------------27C0640670C9054AF0F72694-- From: John Foderaro
Subject: Re: HTML Generation
Date: Sat, 19 Aug 2000 00:00:00 +0000
Message-ID: <MPG.14085128d09cb48f98968d@news.dnai.com> For those interested in seeing the difference in syntax
between the html generator mentioned in this thread and
the one that comes with AllegroServe, I've shown how this
would be expressed in AllegroServe. Maybe someone can
convert it to cl-http's html generation language and post
that too.
First the original way......
(let ((*primitive-html-stream* stream))
(<html>)
(<head>)
(<title>)
(write-string "Welcome to the ABC Student Administrative System"
stream)
(</title>)
(<body> :bgcolor :white)
(<center>)
(<img> :src "Pegasus.gif")
(<h3>)
(write-string "Welcome to the ABC Charter Public School's Online "
stream)
(write-string "Student Administration System." stream)
(</h3>)
(</center>)
(<h4>)(<u>)(html-content "Classrooms")(</u>)(</h4>)
(<form> :action "/abc/classroom" :method 'post)
(<select> :name "room-id" :size 10)
(dolist (classroom (p-symbol-value '*classrooms*))
(progn
(<option> :value (symbol-name (classroom-room-id classroom)))
(format stream "~A, ~A (~A)"
(teacher-surname
(classroom-teacher classroom))
(teacher-given-names
(classroom-teacher classroom))
(classroom-room-id classroom))))
(</select>)(<br>)
(<input> :type 'submit :value "View Classroom")
(</form>)
(</body>)
(</html>)))))
================
now using ... AllegroServe's html generator
(html
(:html
(:title "Welcome to the ABC Student Administrative System")
((:body :bgcolor "white")
(:center
((:img :src "Pegasus.gif"))
(:h3 "Welcome to the ABC Charter Public School's Online "
"Student Administration System."))
(:h4 (:u "Classrooms"))
((:form :action "/abc/classroom" :method "POST")
((:select :name "room-id" :size 10)
(dolist classroom (p-symbol-value '*classrooms*)
(html
((:option :value (symbol-name (classroom-room-id classroom)))
(:princ-safe
(format nil "~A, ~A (~A)"
(teacher-surname
(classroom-teacher classroom))
(teacher-given-names
(classroom-teacher classroom))
(classroom-room-id classroom)))))))
:br
((:input :type "submit" :value "View Classroom"))))))
From: Rainer Joswig
Subject: Re: HTML Generation
Date: Sat, 19 Aug 2000 00:00:00 +0000
Message-ID: <joswig-8FBDCC.18505819082000@news.is-europe.net> In article <··························@news.dnai.com>, John Foderaro
<···@franz.com> wrote:
> For those interested in seeing the difference in syntax
> between the html generator mentioned in this thread and
> the one that comes with AllegroServe, I've shown how this
> would be expressed in AllegroServe. Maybe someone can
> convert it to cl-http's html generation language and post
> that too.
Without checking the correctness, here is a rough sketch
using package HTML2 :
(flet ((choice-string (classroom)
(format nil "~A, ~A (~A)"
(teacher-surname
(classroom-teacher classroom))
(teacher-given-names
(classroom-teacher classroom))
(classroom-room-id classroom))))
(with-html-document ()
(with-document-preamble ()
(declare-title "Welcome to the ABC Student Administrative System"))
(netscape2.0:with-document-body (:background :white)
(netscape1.1:with-centering ()
(image "Pegasus.gif" "Pegasus")
(with-section-heading
("Welcome to the ABC Charter Public School's Online Student Administration System.")
(with-section-heading ("Classrooms")
(with-fillout-form (:post "/abc/classroom")
(accept-input
:select-choices "room-id"
:choices (loop for classroom in (p-symbol-value '*classrooms*)
collect (list (choice-string classroom)
:value (symbol-name (classroom-room-id classroom)))))
(break-line)
(accept-input 'submit-button "View Classroom"))))))))
--
Rainer Joswig, Hamburg, Germany
Email: ·············@corporate-world.lisp.de