Commit fbe58998 authored by Marco Baringer's avatar Marco Baringer

commited old version...

parent 431c5a41
;;;; -*- lisp -*- ;;;; -*- lisp -*-
;;;_* File Info ;;;_* File Info
;;;; $Id: yaclml.lisp,v 1.6 2003/08/16 15:39:03 mb Exp $ ;;;; $Id: html.lisp,v 1.1 2003/08/17 14:15:04 mbaringer Exp $
;;;; ;;;;
;;;; Copyright (c) 2002-2003, Edward Marco Baringer ;;;; Copyright (c) 2002-2003, Edward Marco Baringer
;;;; All rights reserved. ;;;; All rights reserved.
...@@ -80,61 +80,61 @@ PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" ...@@ -80,61 +80,61 @@ PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\"
(defhtml-tag <:BASEFONT :block :coreattrs size face color) (defhtml-tag <:BASEFONT :block :coreattrs size face color)
(defhtml-tag <:BGSOUND :coreattrs src loop volume balance) (defhtml-tag <:BGSOUND :block :coreattrs src loop volume balance)
(defhtml-tag <:BIG :coreattrs) (defhtml-tag <:BIG :inline :coreattrs)
(defhtml-tag <:BLINK :coreattrs) (defhtml-tag <:BLINK :inline :coreattrs)
(defhtml-tag <:BLOCKQUOTE :coreattrs cite) (defhtml-tag <:BLOCKQUOTE :block :coreattrs cite)
(defhtml-tag <:BODY :block :coreattrs bgcolor link vlink alink text (defhtml-tag <:BODY :block :coreattrs bgcolor link vlink alink text
background bgproperties topmargin leftmargin background bgproperties topmargin leftmargin
rightmargin bottommargin marginwidth marginheight) rightmargin bottommargin marginwidth marginheight)
(defhtml-tag <:BR :coreattrs clear) (defhtml-tag <:BR :inline :coreattrs clear)
(defhtml-tag <:CAPTION :coreattrs align valign) (defhtml-tag <:CAPTION :inline :coreattrs align valign)
(defhtml-tag <:CENTER :coreattrs) (defhtml-tag <:CENTER :inline :coreattrs)
(defhtml-tag <:CITE :coreattrs) (defhtml-tag <:CITE :inline :coreattrs)
(defhtml-tag <:CODE :coreattrs) (defhtml-tag <:CODE :block :coreattrs)
(defhtml-tag <:COL :coreattrs span width align valign bgcolor) (defhtml-tag <:COL :block :coreattrs span width align valign bgcolor)
(defhtml-tag <:COLGROUP :coreattrs span width align valign bgcolor) (defhtml-tag <:COLGROUP :block :coreattrs span width align valign bgcolor)
(defhtml-tag <:DEL :coreattrs datetime cite) (defhtml-tag <:DEL :inline :coreattrs datetime cite)
(defhtml-tag <:DFN :coreattrs) (defhtml-tag <:DFN :inline :coreattrs)
(defhtml-tag <:DIR :coreattrs) (defhtml-tag <:DIR :inline :coreattrs)
(defhtml-tag <:DIV :coreattrs align) (defhtml-tag <:DIV :block :coreattrs align)
(defhtml-tag <:DL :coreattrs) (defhtml-tag <:DL :block :coreattrs)
(defhtml-tag <:DT :coreattrs) (defhtml-tag <:DT :inline :coreattrs)
(defhtml-tag <:DD :coreattrs) (defhtml-tag <:DD :inline :coreattrs)
(defhtml-tag <:EM :coreattrs) (defhtml-tag <:EM :inline :coreattrs)
(defhtml-tag <:EMBED :coreattrs src pluginspace width height align (defhtml-tag <:EMBED :block :coreattrs src pluginspace width height align
type) type)
(defhtml-tag <:FONT :coreattrs size face color point-size weight) (defhtml-tag <:FONT :inline :coreattrs size face color point-size weight)
(defhtml-tag <:FORM :coreattrs action target method enctype name (defhtml-tag <:FORM :block :coreattrs action target method enctype name
accept accept-charset) accept accept-charset)
(defhtml-tag <:FRAME :coreattrs src name scrolling norize width (defhtml-tag <:FRAME :block :coreattrs src name scrolling norize width
height marginwidth marginheight frameborder height marginwidth marginheight frameborder
bordercolor) bordercolor)
(defhtml-tag <:FRAMESET :coreattrs cols rows border framespacing (defhtml-tag <:FRAMESET :block :coreattrs cols rows border framespacing
frameborder bordercolor) frameborder bordercolor)
(defhtml-tag <:H1 :inline :coreattrs align) (defhtml-tag <:H1 :inline :coreattrs align)
...@@ -155,138 +155,138 @@ PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" ...@@ -155,138 +155,138 @@ PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\"
(defhtml-tag <:HTML :block :coreattrs lang) (defhtml-tag <:HTML :block :coreattrs lang)
(defhtml-tag <:I :coreattrs) (defhtml-tag <:I :inline :coreattrs)
(defhtml-tag <:IFRAME :coreattrs src width height hspace vspace (defhtml-tag <:IFRAME :black :coreattrs src width height hspace vspace
align name scrolling warginwidth warginheight align name scrolling warginwidth warginheight
frameborder bgcolor) frameborder bgcolor)
(defhtml-tag <:IMG :coreattrs src width height hspace vspace (defhtml-tag <:IMG :inline :coreattrs src width height hspace vspace
border alt align usemap ismap lowsrc dynsrc loop border alt align usemap ismap lowsrc dynsrc loop
longdesc) longdesc)
(defhtml-tag <:INPUT :coreattrs name value type size maxlength (defhtml-tag <:INPUT :inline :coreattrs name value type size maxlength
checked accept src align width height border alt checked accept src align width height border alt
usemap ismap) usemap ismap)
(defhtml-tag <:INS :coreattrs datetime cite) (defhtml-tag <:INS :inline :coreattrs datetime cite)
(defhtml-tag <:ISINDEX :coreattrs) (defhtml-tag <:ISINDEX :inline :coreattrs)
(defhtml-tag <:KBD :coreattrs) (defhtml-tag <:KBD :inline :coreattrs)
(defhtml-tag <:LANG :coreattrs) (defhtml-tag <:LANG :inline :coreattrs)
(defhtml-tag <:LH :coreattrs) (defhtml-tag <:LH :inline :coreattrs)
(defhtml-tag <:LI :coreattrs type value) (defhtml-tag <:LI :block :coreattrs type value)
(defhtml-tag <:LINK :coreattrs rel type ref rev target charset media) (defhtml-tag <:LINK :block :coreattrs rel type href rev target charset media)
(defhtml-tag <:LISTING :coreattrs) (defhtml-tag <:LISTING :inline :coreattrs)
(defhtml-tag <:MAP :coreattrs name) (defhtml-tag <:MAP :block :coreattrs name)
(defhtml-tag <:MARQUEE :coreattrs width height hspace vspace (defhtml-tag <:MARQUEE :block :coreattrs width height hspace vspace
scrollAmount scrollDelay truespeed loop behavior scrollAmount scrollDelay truespeed loop behavior
direction bgcolor) direction bgcolor)
(defhtml-tag <:MATH :coreattrs) (defhtml-tag <:MATH :inline :coreattrs)
(defhtml-tag <:MENU :coreattrs) (defhtml-tag <:MENU :inline :coreattrs)
(defhtml-tag <:META :coreattrs name content http-equiv scheme) (defhtml-tag <:META :block :coreattrs name content http-equiv scheme)
(defhtml-tag <:MULTICOL :coreattrs cols gutter width) (defhtml-tag <:MULTICOL :block :coreattrs cols gutter width)
(defhtml-tag <:NOBR :coreattrs) (defhtml-tag <:NOBR :inline :coreattrs)
(defhtml-tag <:NOEMBED :coreattrs) (defhtml-tag <:NOEMBED :block :coreattrs)
(defhtml-tag <:NOFRAMES :coreattrs) (defhtml-tag <:NOFRAMES :block :coreattrs)
(defhtml-tag <:NOLAYER :coreattrs) (defhtml-tag <:NOLAYER :block :coreattrs)
(defhtml-tag <:NOSCRIPT :coreattrs) (defhtml-tag <:NOSCRIPT :block :coreattrs)
(defhtml-tag <:NOTE :coreattrs) (defhtml-tag <:NOTE :block :coreattrs)
(defhtml-tag <:OL :coreattrs type start) (defhtml-tag <:OL :block :coreattrs type start)
(defhtml-tag <:OBJECT :coreattrs classid codebase code type data (defhtml-tag <:OBJECT :block :coreattrs classid codebase code type data
width height hspace vspace align) width height hspace vspace align)
(defhtml-tag <:OVERLAY :coreattrs) (defhtml-tag <:OVERLAY :block :coreattrs)
(defhtml-tag <:OPTION :coreattrs value selected) (defhtml-tag <:OPTION :inline :coreattrs value selected)
(defhtml-tag <:P :block :coreattrs align) (defhtml-tag <:P :block :coreattrs align)
(defhtml-tag <:PARAM :coreattrs valuetype name value) (defhtml-tag <:PARAM :block :coreattrs valuetype name value)
(defhtml-tag <:PLAINTEXT :coreattrs) (defhtml-tag <:PLAINTEXT :block :coreattrs)
(defhtml-tag <:PRE :coreattrs) (defhtml-tag <:PRE :inline :coreattrs)
(defhtml-tag <:Q :coreattrs) (defhtml-tag <:Q :inline :coreattrs)
(defhtml-tag <:RANGE :coreattrs) (defhtml-tag <:RANGE :inline :coreattrs)
(defhtml-tag <:S :coreattrs) (defhtml-tag <:S :inline :coreattrs)
(defhtml-tag <:SAMP :coreattrs) (defhtml-tag <:SAMP :inline :coreattrs)
(defhtml-tag <:SCRIPT :coreattrs language type src for event defer (defhtml-tag <:SCRIPT :block :coreattrs language type src for event defer
charset) charset)
(defhtml-tag <:SELECT :coreattrs name size multiple) (defhtml-tag <:SELECT :inline :coreattrs name size multiple)
(defhtml-tag <:SMALL :coreattrs) (defhtml-tag <:SMALL :inline :coreattrs)
(defhtml-tag <:SPACER :coreattrs type size width height) (defhtml-tag <:SPACER :inline :coreattrs type size width height)
(defhtml-tag <:SPAN :coreattrs) (defhtml-tag <:SPAN :inline :coreattrs)
(defhtml-tag <:STRIKE :coreattrs) (defhtml-tag <:STRIKE :inline :coreattrs)
(defhtml-tag <:STRONG :coreattrs) (defhtml-tag <:STRONG :inline :coreattrs)
(defhtml-tag <:STYLE :coreattrs media type) (defhtml-tag <:STYLE :block :coreattrs media type)
(defhtml-tag <:SUB :coreattrs) (defhtml-tag <:SUB :inline :coreattrs)
(defhtml-tag <:SUP :coreattrs) (defhtml-tag <:SUP :inline :coreattrs)
(defhtml-tag <:TAB :coreattrs) (defhtml-tag <:TAB :inline :coreattrs)
(defhtml-tag <:TABLE :coreattrs border cellspacing cellpadding (defhtml-tag <:TABLE :block :coreattrs border cellspacing cellpadding
bgcolor background bordercolor bordercolorlight bgcolor background bordercolor bordercolorlight
bordercolordark width height hspace vspace align cols bordercolordark width height hspace vspace align cols
frame rules summary) frame rules summary)
(defhtml-tag <:TBODY :coreattrs align valign bgcolor) (defhtml-tag <:TBODY :block :coreattrs align valign bgcolor)
(defhtml-tag <:TD :coreattrs align valign bgcolor background (defhtml-tag <:TD :inline :coreattrs align valign bgcolor background
bordercolor colspan rowspan width height headers scope bordercolor colspan rowspan width height headers scope
abbr axis) abbr axis)
(defhtml-tag <:TEXTAREA :coreattrs cols rows readonly wrap name) (defhtml-tag <:TEXTAREA :inline :coreattrs cols rows readonly wrap name)
(defhtml-tag <:TEXTFLOW :coreattrs) (defhtml-tag <:TEXTFLOW :inline :coreattrs)
(defhtml-tag <:TFOOT :coreattrs) (defhtml-tag <:TFOOT :block :coreattrs)
(defhtml-tag <:TH :coreattrs) (defhtml-tag <:TH :inline :coreattrs)
(defhtml-tag <:THEAD :coreattrs) (defhtml-tag <:THEAD :inline :coreattrs)
(defhtml-tag <:TITLE :coreattrs) (defhtml-tag <:TITLE :inline :coreattrs)
(defhtml-tag <:TR :coreattrs align valign width height bgcolor (defhtml-tag <:TR :block :coreattrs align valign width height bgcolor
bordercolor) bordercolor)
(defhtml-tag <:TT :coreattrs) (defhtml-tag <:TT :inline :coreattrs)
(defhtml-tag <:U :coreattrs) (defhtml-tag <:U :inline :coreattrs)
(defhtml-tag <:UL :coreattrs type) (defhtml-tag <:UL :inline :coreattrs type)
;;;; -*- lisp -*- ;;;; -*- lisp -*-
;;;; $Id: packages.lisp,v 1.6 2003/08/13 21:53:46 mb Exp $ ;;;; $Id: packages.lisp,v 1.1 2003/08/17 14:15:04 mbaringer Exp $
;;;; ;;;;
;;;; Copyright (c) 2002-2003, Edward Marco Baringer ;;;; Copyright (c) 2002-2003, Edward Marco Baringer
;;;; All rights reserved. ;;;; All rights reserved.
...@@ -162,7 +162,7 @@ ...@@ -162,7 +162,7 @@
#:href #:href
#:stylesheet #:stylesheet
#:prin #:prin
#:as-is #:prin-raw
#:page #:page
#:section #:section
#:itemize #:itemize
......
;;;; -*- lisp -*- ;;;; -*- lisp -*-
;;;; $Id: yaclml.lisp,v 1.6 2003/08/16 15:39:03 mb Exp $ ;;;; $Id: yaclml.lisp,v 1.1 2003/08/17 14:15:04 mbaringer Exp $
;;;; ;;;;
;;;; Copyright (c) 2002-2003, Edward Marco Baringer ;;;; Copyright (c) 2002-2003, Edward Marco Baringer
;;;; All rights reserved. ;;;; All rights reserved.
...@@ -47,7 +47,9 @@ ...@@ -47,7 +47,9 @@
(defun yaclml-princ (item) (defun yaclml-princ (item)
"Request that the result of the form ITEM be printed at run item." "Request that the result of the form ITEM be printed at run item."
(declare (special tag-code %indent%)) (declare (special tag-code %indent%))
(if (constantp item) (if (or (stringp item)
(characterp item)
(numberp item))
(push (princ-to-string item) tag-code) (push (princ-to-string item) tag-code)
(push `(princ ,item *yaclml-stream*) tag-code))) (push `(princ ,item *yaclml-stream*) tag-code)))
...@@ -118,7 +120,7 @@ ...@@ -118,7 +120,7 @@
(yaclml-do-body (list b)))) (yaclml-do-body (list b))))
((or (stringp form) ((or (stringp form)
(characterp form)) (characterp form))
(yaclml-princ form)) (yaclml-princ (escape-as-html (string form))))
(t (t
(yaclml-collect form))))) (yaclml-collect form)))))
...@@ -145,6 +147,16 @@ ...@@ -145,6 +147,16 @@
form)) form))
(fold-strings tag-code)))))))) (fold-strings tag-code))))))))
(defmacro within-tag ((name-string &rest attributes) &rest body)
(if body
`(progn
(open-tag ,name-string nil ,@(loop while attributes
collect `(cons ,(pop attributes) ,(pop attributes))))
,@body
(close-tag ,name-string nil))
`(empty-tag ,name-string nil ,@(loop while attributes
collect `(cons ,(pop attributes) ,(pop attributes))))))
(defmacro defsimple-xtag (name indentp &rest attributes) (defmacro defsimple-xtag (name indentp &rest attributes)
(let ((name-string (string-downcase (string name)))) (let ((name-string (string-downcase (string name))))
`(deftag ,name (&attribute ,@attributes &body body) `(deftag ,name (&attribute ,@attributes &body body)
...@@ -215,6 +227,12 @@ ...@@ -215,6 +227,12 @@
`((locally ,@body)) `((locally ,@body))
body))))) body)))))
(deftag <:prin (thing)
(yaclml-collect `(princ (escape-as-html (princ-to-string ,data)) *yaclml-stream*)))
(deftag <:prin-raw (thing)
(yaclml-collect `(princ ,thing *yaclml-stream*)))
(defun |[ reader| (stream char) (defun |[ reader| (stream char)
(declare (ignore char)) (declare (ignore char))
(with-collector (forms) (with-collector (forms)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment