Commits

Anonymous committed 35de810

Fixed formatting

  • Participants
  • Parent commits d492beb

Comments (0)

Files changed (3)

File taglibraries/html.lisp

 (defhtmltag span)
 
 (defhtmltag textarea
-    :attributes (
-		 (name
-		  :initform nil
-		  :initarg :name
-		  :accessor name-of
-		  )
-		 (cols
-		  :initform nil
-		  :initarg :cols
-		  :accessor cols-for
-		  )
-		 (rows
-		  :initform nil
-		  :initarg :rows
-		  :accessor rows-for
-		  )
-		 )
-)
+    :attributes ((name :initform nil :initarg :name :accessor name-of)
+		 (cols :initform nil :initarg :cols :accessor cols-for)
+		 (rows :initform nil :initarg :rows :accessor rows-for)))
 
 (defhtmltag input
     :noendtag t
-    :attributes (
-		 (name
-		  :initform nil
-		  :initarg :name
-		  :accessor name-of
-		  )
-		 (type
-		  :initform "text"
-		  :initarg :type
-		  :accessor input-type-of
-		  )
-		 (value
-		  :initform nil
-		  :initarg :value
-		  :accessor value-of
-		  )
-		 )
-    )
+    :attributes ((name :initform nil :initarg :name :accessor name-of)
+		 (type :initform "text" :initarg :type :accessor input-type-of)
+		 (value :initform nil :initarg :value :accessor value-of)))
 
 (defhtmltag submit
-    :content (input (+@ :type "submit" :value "OK") )
-    )
+    :content (input (+@ :type "submit" :value "OK") ))
 
 (defhtmltag checkbox
     :bases (input)
     :tag (call-next-method) ;; has same tag as parent (input)
-    :attributes (
-		 (_label  ;; don't render label attribute
-		  :initarg :label
-		  :initform nil
-		  )
-		 (type ;; have to override base attribute on input
-		  :initform "checkbox"
-		  )
-		 (checked
-		  :initarg :checked
-		  :initform nil
-		  )
-		 )
+    :attributes ((_label :initarg :label :initform nil) ;; don't render label attribute
+		 (type :initform "checkbox") ;; have to override base attribute on input
+		 (checked :initarg :checked :initform nil))
     :content (with-slots (id _label class style) *current-tag* 
 	       (list
 		(when _label
-		  (list _label +nbsp+)
-		  )
+		  (list _label +nbsp+))
 		(html
-		 (call-next-method)
-		 )
-		)
-	       )
-    )
+		 (call-next-method)))))
 
 (defhtmltag text-field
     :bases (input)
     :tag (call-next-method)
-    :attributes (
-		 (_label
-		  :initarg :label
-		  :initform nil
-		  )
-		 )
+    :attributes ((_label :initarg :label :initform nil))
     :content (with-slots (id _label class style) *current-tag* 
 	       (list (when _label
-		       _label
-		       )
+		       _label)
 		     (html
-		      (call-next-method)
-		      )
-		     )
-	       )
-    )
+		      (call-next-method)))))
 
 (defhtmltag form
-    :attributes (
-		 (action
-		  :initform nil
-		  :initarg :action
-		  :accessor action-of
-		  )
-		 (method
-		  :initform "GET"
-		  :initarg :method
-		  :accessor method-of
-		  )
-		 )
-    )
+    :attributes ((action :initform nil :initarg :action :accessor action-of ) 
+		 (method :initform "GET" :initarg :method :accessor method-of)))
 
 (defhtmltag img
     :noendtag t
-    :attributes (
-		 (src
-		  :initform nil
-		  :initarg :src
-		  )
-		 (usemap
-		  :initform nil
-		  :initarg :usemap
-		  )
-		 (alt
-		  :initform nil
-		  :initarg :alt
-		  )
-		 (width
-		  :initform nil
-		  :initarg :width
-		  )
-		 (height
-		  :initform nil
-		  :initarg :height
-		  )
-		 (border
-		  :initform nil
-		  :initarg :border
-		  )
-		 )
-    )
+    :attributes ((src :initform nil :initarg :src)
+		 (usemap :initform nil :initarg :usemap)
+		 (alt :initform nil :initarg :alt)
+		 (width :initform nil :initarg :width) 
+		 (height :initform nil :initarg :height) 
+		 (border :initform nil :initarg :border)))
 
 (defhtmltag imgmap
     :tag "map"
-    :attributes (
-		 (name
-		  :initform nil
-		  :initarg :name
-		  )
-		 )
-    )
+    :attributes ((name :initform nil :initarg :name)))
 
 (defhtmltag area
     :noendtag t
-    :attributes (
-		 (shape
-		  :initform nil
-		  :initarg :shape
-		  )
-		 (coords
-		  :initform nil
-		  :initarg :coords
-		  )
-		 (href
-		  :initform nil
-		  :initarg :href
-		  )
-		 )
-    )
+    :attributes ((shape :initform nil :initarg :shape)
+		 (coords :initform nil :initarg :coords)
+		 (href :initform nil :initarg :href)))
 
-(defhtmltag table
-    )
+(defhtmltag table)
 
-(defhtmltag tr
-    )
+(defhtmltag tr)
 
 (defhtmltag th
-    :tag "thead"
-    )
+    :tag "thead")
 
 (defhtmltag td
-    :attributes ( (colspan :initform nil :initarg :colspan) )
-    )
+    :attributes ( (colspan :initform nil :initarg :colspan) ))
 
 (defhtmltag a
-    :attributes (
-		 (name
-		  :initform nil
-		  :initarg :name
-		  )
-		 (href
-		  :initform nil
-		  :initarg :href
-		  )
-		 )
-    )
+    :attributes ((name :initform nil :initarg :name)
+		 (href :initform nil :initarg :href)))
 
 (defhtmltag b)
 
 (defhtmltag pre)
 
 (defhtmltag br
-    :noendtag t
-    )
+    :noendtag t)
 
 (defhtmltag iframe
-    :attributes (
-		 (src
-		  :initform nil
-		  :initarg :src
-		  )
-		 (frameborder
-		  :initform nil
-		  :initarg :frameborder
-		  )
-		 (allowtransparency
-		  :initform nil
-		  :initarg :allowtransparency
-		  )
-		 (width
-		  :initform nil
-		  :initarg :width
-		  )
-		 (height
-		  :initform nil
-		  :initarg :height
-		  )
-		 )
-    )
+    :attributes ((src :initform nil :initarg :src)
+		 (frameborder :initform nil :initarg :frameborder)
+		 (allowtransparency :initform nil :initarg :allowtransparency)
+		 (width :initform nil :initarg :width)
+		 (height :initform nil :initarg :height)))
 
 (defmacro hout (format-string &rest args )
   "Macro to simplify writing out html to correct stream"
-  `(format *html-out* ,format-string ,@args)
-  )
+  `(format *html-out* ,format-string ,@args))
 
 ;;;------------------------------------------------------------------------------------
 ;;; Dynamic variables
 ;;;------------------------------------------------------------------------------------
 
 (defvar *current-tag* nil
-  "The current tag under construction (if any)"
-  )
+  "The current tag under construction (if any)")
 
 (defvar *html-out* *standard-output* 
-  "Output stream for rendering html"
-  )
+  "Output stream for rendering html")
 
 (defvar *page-title* ""
-  "The title of the page as it should be presented to the user in the browser"
-)
+  "The title of the page as it should be presented to the user in the browser")
 
 (defvar *page-links* ()
-  "A list of link tags that should appear in the head of the page"
-  )
+  "A list of link tags that should appear in the head of the page")
 
-(defvar *page-scripts*
-      ()
-  "A list of strings, each representing a script added to the page"
-      )
+(defvar *page-scripts* ()
+  "A list of strings, each representing a script added to the page")
 
-(defvar *page-ready-scripts*
-      ()
-  "A list of strings, each representing script to be run when the document is ready (after load)"
-      )
+(defvar *page-ready-scripts* ()
+  "A list of strings, each representing script to be run when the document is ready (after load)")
 
-(defvar *page-styles*
-  ()
-  "A list of strings, each representing CSS added to the page"
-  )
+(defvar *page-styles* ()
+  "A list of strings, each representing CSS added to the page")
 
-(defvar *page-style-sheets*
-      ()
-  "A list of strings, each pointing to a styleseheet that the page referneces"
-      )
-(defvar *page-script-libraries*
-      ()
-  "A list of strings, each pointing to a script library that the page referneces"
-      )
+(defvar *page-style-sheets* ()
+  "A list of strings, each pointing to a styleseheet that the page references")
+
+(defvar *page-script-libraries* ()
+  "A list of strings, each pointing to a script library that the page referneces")
 
 ;;;------------------------------------------------------------------------------------
 ;;; Types
 ;;;------------------------------------------------------------------------------------
 (defclass htmltag ()
-  (
-   (_body 
-    :initform ()
-    :initarg :body
-    :accessor body-of
-    )
-   (id ;; corresponds the id of the DOM element, if needed
-    :initform ()
-    :initarg :id
-    :accessor html-id
-    )
-   (class ;; corresponds to class attribute for CSS style information
-    :initform nil
-    :initarg :class
-    :accessor css-class
-    )
-   (style
-    :initform nil
-    :initarg :style
-    :accessor style-of
-    )
-   (rel
-    :initform nil
-    :initarg :rel
-    :accessor rel-of
-    )
-   )
-  )
+  ((_body :initform () :initarg :body :accessor body-of)
+   ;; corresponds the id of the DOM element, if needed
+   (id :initform () :initarg :id :accessor html-id)
+   ;; corresponds to class attribute for CSS style information
+   (class :initform nil :initarg :class :accessor css-class)
+   (style :initform nil :initarg :style :accessor style-of)
+   (rel :initform nil :initarg :rel :accessor rel-of)))
 
 ;;;------------------------------------------------------------------------------------
 ;;; Tag requirements of tag libraries
 ; -- Tag library functions that tags require for rendering
 
 (defvar *available-tag-libraries* (make-hash-table :test 'eql)
-  "All tag libraries"
-)
+  "All tag libraries")
 
 (defvar *tag-library* nil
-  "Current tag library to which new tag defintions will belong"
-  )
+  "Current tag library to which new tag defintions will belong")
 
 (defgeneric add-tag-to-library (tag-name &optional tag-library)
-  (:documentation "Called at the point of tag definition to add the tag to the library"
-		  )
-  )
+  (:documentation "Called at the point of tag definition to add the tag to the library"))
 
 (defgeneric expand-expression-with-libraries (expr &optional *available-tag-libraries*)
-  (:documentation "Expand the expression using the provided libraries")
-  )
+  (:documentation "Expand the expression using the provided libraries"))
 
 
 ;;;------------------------------------------------------------------------------------
 
 (defgeneric tag-name (*current-tag*)
   (:documentation "Return the name of the tag as a string 
-used for rendering in html"
-		  )
-  )
+used for rendering in html"))
 
 (defgeneric tag-library-name-for-tag (*current-tag*)
-  (:documentation "Return the name of the tag library in which the tag is defined")
-  )
+  (:documentation "Return the name of the tag library in which the tag is defined"))
 
 (defgeneric tag-expansion (some-tag-symbol)
   (:documentation "Return the macro for expanding a tag expression
-into a tag object"
-		  )
-  )
+into a tag object"))
 
 (defgeneric tag-has-body-p (some-tag-symbol)
   (:documentation "Return t (the default) if a tag expects to 
    have a tag body; nil otherwise.  If no body, that implies
    the tag treats the raw body as an initializer for the tag,
    and that a custom html method will then use the tag's
-   slots to render appropriate html."
-		  )
-  )
+   slots to render appropriate html."))
 
 (defgeneric tag-has-end-tag-p (*current-tag*)
   (:documentation "Return t (the default) if a tag expects to 
    have an end tag rendered (e.g., </a>); nil otherwise.  If nil,
    then the tag's rendering only includes the start tag and content
-   (if any).  Examples of use is the <img> and <input> tags."
-		  )
-  )
+   (if any).  Examples of use is the <img> and <input> tags."))
 
 
 (defgeneric tag-separate-initializer-and-body (some-tag-symbol raw-body)
    Default behavior takes the first list starting ith +@ and uses the
    cdr of that list as the arguments to a make-instance call for that
    tag class.  All other items in the list will be returned in the 2nd
-   value for the body of the tag"
-		  )
-)
+   value for the body of the tag"))
 
 (defgeneric tag-attributes (*current-tag*)
-  (:documentation "Return a list of attribute names for the tag")
-  )
+  (:documentation "Return a list of attribute names for the tag"))
 
 (defgeneric render-tag-scripts (*current-tag*)
   (:documentation
-    "Return the script that should be shared by all instances
+   "Return the script that should be shared by all instances
      of some-tag's class within the same context (page, stylesheet, etc.)
-    "
-    )
-  )
+    "))
 
 (defgeneric render-tag-ready-scripts (*current-tag*)
   (:documentation
      first loads.  During rendering, scripts are accumulated by visiting each tag
      in the page (depth, then breadth), and adding each unique script
      (based on string comparison) to the end of a list.  Consequently,
-     outer tags have their ready script run before inner tags.
-    "
-    )
-  )
+     outer tags have their ready script run before inner tags."))
 
 (defgeneric render-tag-script-libraries (*current-tag*)
   (:documentation
     "Return a list of strings pointing to script libraries used
-     by instances of this tag
-    "
-    )
-  )
+     by instances of this tag"))
 
 (defgeneric render-tag-styles (*current-tag*)
   (:documentation
-    "Return a list of styles expected by instances of this tag
-    "
-    )
-  )
+    "Return a list of styles expected by instances of this tag"))
 
 (defgeneric render-tag-style-sheets (*current-tag*)
   (:documentation
     "Return a list of strings pointing to stylesheets used
-     by instances of this tag
-    "
-    )
-  )
+     by instances of this tag"))
 
 (defgeneric render-tag-start (*current-tag*)
   (:documentation "Render the beginning of a tag, including its attributes (by
-    calling render-attributes)")
-  )
+    calling render-attributes)"))
 
 (defgeneric render-tag-attributes (*current-tag*)
-  (:documentation "Render a tag's attributes as string of name=value pairs")
-  )
+  (:documentation "Render a tag's attributes as string of name=value pairs"))
 
 (defgeneric render-tag-body (*current-tag*)
-  (:documentation "Render the body of a tag as html")
-  )
+  (:documentation "Render the body of a tag as html"))
 
 (defgeneric render-tag-end (*current-tag*)
-  (:documentation "Render the end of a tag")
-  )
+  (:documentation "Render the end of a tag"))
 
 (defgeneric render-tag-content (*current-tag*)
   (:documentation "Render just the content portion of the tag (no styles or scripts):
    usually, the start tag, the rendered body, and the end tag.  In tags
-   that have a custom html representation, this is usually the method overriden."
-		  )
-)
+   that have a custom html representation, this is usually the method overriden."))
 
 (defgeneric render-as-html (some-expr)
-  (:documentation "Return some expression as an HTML string")
-  )
+  (:documentation "Return some expression as an HTML string"))
 
 
 ;;;------------------------------------------------------------------------------------
 ;;;------------------------------------------------------------------------------------
 
 (defmethod tag-library-name-for-tag ( (*current-tag* htmltag) )
-  (intern (package-name (symbol-package (tag-name *current-tag*))) 'keyword)
-  )
+  (intern (package-name (symbol-package (tag-name *current-tag*))) 'keyword))
 
 (defmethod tag-attributes ( (some-tag-name symbol) )
   (loop for a in (mapcar (lambda (s) (slot-definition-name s))
-		 (class-slots (find-class some-tag-name))
-		 )
+		 (class-slots (find-class some-tag-name)))
        unless (equal a '_body)
        collect a))
 
        collect a))
 
 (defmethod render-tag-scripts ((some-tag-name symbol))
-    nil
-    )
+    nil)
 
 (defmethod render-tag-scripts ((*current-tag* htmltag))
-    nil
-    )
+    nil)
 
 (defmethod render-tag-ready-scripts((some-tag-name symbol))
-    nil
-    )
+    nil)
 
 (defmethod render-tag-ready-scripts((*current-tag* htmltag))
-    nil
-    )
+    nil)
 
 (defmethod render-tag-script-libraries((some-tag-name symbol))
-    nil
-    )
+    nil)
 
 (defmethod render-tag-script-libraries ((*current-tag* htmltag))
-    nil
-  )
+    nil)
 
 (defmethod render-tag-styles ((some-tag-name symbol))
-    nil
-    )
+    nil)
 
 (defmethod render-tag-styles ((*current-tag* htmltag))
-    nil
-  )
+    nil)
 
 (defmethod render-tag-style-sheets ((some-tag-name symbol))
-    nil
-    )
+    nil)
 
 (defmethod render-tag-style-sheets ((*current-tag* htmltag))
-  nil
-  )
+  nil)
 
 (defmethod tag-expansion ( (name symbol) )
   `(,name (&rest content)
-	  (let (
-		(name (quote ,name))
-		)
+	  (let ((name (quote ,name)))
 	    (multiple-value-bind (initializer body) (tag-separate-initializer-and-body (quote ,name) content)
-	      `(let (
-		     (*current-tag* (make-instance (quote ,name)
-						   ,@initializer
-						   )
-		       )
-		     )
-
-		 (setf (body-of *current-tag*) (list ,@body))
-
-		 *current-tag*
-		 )
-	      )
-	    )
-	  )
-  )
+	      `(let ((*current-tag* (make-instance (quote ,name) ,@initializer)))
+		 (setf (body-of *current-tag*) (list ,@body)) *current-tag*)))))
 
 (defmethod tag-has-body-p ( (some-tag-symbol symbol) )
-  t
-  )
+  t)
 
 (defmethod tag-has-end-tag-p ( (*current-tag* htmltag) )
-  t
-  )
+  t)
 
 (defmethod tag-separate-initializer-and-body ( (some-tag-symbol symbol) raw-body)
   (if (tag-has-body-p some-tag-symbol)
   (render-tag-style-sheets *current-tag* )
   (render-tag-ready-scripts *current-tag* )
 
-  (render-tag-content *current-tag* )
-)
+  (render-tag-content *current-tag* ))
 
 (defmethod render-as-html ( (some-expr t) )
-  (hout "~a" some-expr)
-)
+  (hout "~a" some-expr))
 
 (defmethod render-as-html ( (some-list list) )
   (dolist (item some-list)
-    (render-as-html item)
-    )
-)
+    (render-as-html item)))
 
 (defmethod render-tag-start ( (*current-tag* htmltag) )
-  (let (
-	(name (tag-name *current-tag* ) )
-	)
+  (let ((name (tag-name *current-tag* ) ))
     (hout "<~a" (string-downcase name) )
     (render-tag-attributes *current-tag*)
-    (format *html-out* ">~%")
-    )
-)
+    (format *html-out* ">~%")))
 
 (defmethod render-tag-attributes ( (*current-tag* htmltag) )
   (hout "~:{ ~a='~a'~}" 
 	  (mapcar (lambda (a)
-		    (list (string-downcase (symbol-name a)) (slot-value *current-tag* a))
-		    )
-		  (tag-attributes *current-tag*)
-		  )
-	  )
-  )
+		    (list (string-downcase (symbol-name a)) (slot-value *current-tag* a)))
+		  (tag-attributes *current-tag*))))
 
 (defmethod render-tag-body ( (*current-tag* htmltag) )
   (dolist (some-expr (body-of *current-tag*) )
-    (render-as-html some-expr)
-    )
-  )
+    (render-as-html some-expr)))
 
 
 (defmethod render-tag-end ( (*current-tag* htmltag) )
-  (let (
-	(name (tag-name *current-tag* ) )
-	)
-    (hout "</~a>~%" (string-downcase name) )
-    )
-  )
+  (let ((name (tag-name *current-tag* ) ))
+    (hout "</~a>~%" (string-downcase name) )))
 
 (defmethod render-tag-content ( (*current-tag* htmltag) )
   (render-tag-start *current-tag* )
   (render-tag-body *current-tag* )
   (if (tag-has-end-tag-p *current-tag*)
-      (render-tag-end *current-tag* )
-      )
-  )
+      (render-tag-end *current-tag* )))
 
 ;;;------------------------------------------------------------------------------------
 ;;; Functions
 ;;;------------------------------------------------------------------------------------
 
 (defmacro expansion (expr)
-  `(expand-expression-with-libraries (quote ,expr) *available-tag-libraries*)
-  )
+  `(expand-expression-with-libraries (quote ,expr) *available-tag-libraries*))
 
 (defmacro tags (expr)
-  (expand-expression-with-libraries expr *available-tag-libraries*)
-       )
+  (expand-expression-with-libraries expr *available-tag-libraries*))
 
 (defmacro +title (expr)
   `(progn
      (setf *page-title* ,expr)
-     nil
-     )
-  )
+     nil))
 
-(defmacro +link (
-		 &key
+(defmacro +link (&key
 		 ((:rel rel) nil)
 		 ((:type type) nil)
-		 ((:href href) nil)
-		 )
+		 ((:href href) nil))
   `(progn
      (pushnew (list ,rel ,type ,href)
 	      *page-links*
-	      :test 'equal
-	      )
-     nil
-     )
-  )
+	      :test 'equal)
+     nil))
 
 (defmacro putend (some-object some-place)
   "Append some-object to the end of the list in some-place.
    "
   `(setf ,some-place
          (nconc ,some-place
-                 (list ,some-object)
-                 )
-         )
-  )
+                 (list ,some-object))))
 
 (defmacro putendnew (some-object some-place
 		     &key 
-		     ((:test test) 'equal)
-		     )
+		     ((:test test) 'equal))
   `(if (not (member ,some-object ,some-place :test ,test) )
-       (putend ,some-object ,some-place)
-       )
-  )
+       (putend ,some-object ,some-place)))
 
 (defmacro union-ordered (some-list some-place)
   `(dolist (item ,some-list)
      (putendnew item
 		,some-place
-		:test 'equal
-		)))
+		:test 'equal)))
 
 (defmacro defhtmltag (name
 		      &key
 		      ((:ready ready) nil)
 		      ((:style style) nil)
 		      ((:style-sheets style-sheets) nil)
-		      ((:script-libraries script-libraries) nil)
-		      )
+		      ((:script-libraries script-libraries) nil))
   (declare 
-   ; (type (or null string) script ready style)
-   (type (or null list) style-sheets script-libraries)
-   )
+   ;; (type (or null string) script ready style)
+   (type (or null list) style-sheets script-libraries))
   `(progn
 
      (add-tag-to-library (quote ,name) *tag-library*)
 
      (export (list
-	      (quote ,name)
-	      )
-	     )
+	      (quote ,name)))
 
      (defclass ,name (,@bases htmltag)
-       (,@attributes)
-       )
+       (,@attributes))
 
      ;; TODO should consider undefining some of these methods, 
      ;; to avoid lingering effects when tags redefined (e.g, 
      (defmethod tag-name ( (*current-tag* ,name) )
        ,(if tag
 	    tag	    
-	    `(quote ,name)
-	    )
-       )
+	    `(quote ,name)))
 
      ,(unless hasbody
 	      `(defmethod tag-has-body-p ( (some-tag-symbol (eql (quote ,name) ) ) )
-		 nil
-		 )
-	      )
+		 nil))
 
      ,(when noendtag
 	      `(defmethod tag-has-end-tag-p ( (some-tag  ,name) )
-		 nil
-		 )
-	      )
+		 nil))
 
      ,(when script
 	    `(defmethod render-tag-scripts ( (*current-tag* ,name) )
 	         (union-ordered (list (format nil "/* --------- Script for tag ~a:~a ------------- */~%"
 					      (tag-library-name-for-tag *current-tag*)
-					      (tag-name *current-tag*)
-					      )
-				      ,script
-				      ) 
-				*page-scripts* 
-				)
-	       )
-	    )
+					      (tag-name *current-tag*))
+				      ,script)
+				*page-scripts* )))
 
      ,(when ready
 	    `(defmethod render-tag-ready-scripts ( (*current-tag* ,name) )
 	       (union-ordered (list (format nil "/* --------- Initialization for tag ~a:~a ------------- */~%"
 					      (tag-library-name-for-tag *current-tag*)
-					      (tag-name *current-tag*)
-					      )
-			       ,ready
-			       )
-			      *page-ready-scripts*
-			      )
-	       )
-	    )
+					      (tag-name *current-tag*))
+			       ,ready)
+			      *page-ready-scripts*)))
 	    
      ,(when script-libraries
 	    `(defmethod render-tag-script-libraries ( (*current-tag* ,name) )
-	       (union-ordered ,script-libraries *page-script-libraries*)
-	       )
-	    )
+	       (union-ordered ,script-libraries *page-script-libraries*)))
 
      ,(when style
 	    `(defmethod render-tag-styles ( (*current-tag* ,name) )
 	       (union-ordered (list (format nil "/* --------- Styles for tag ~a:~a ------------- */~%"
 					    (tag-library-name-for-tag *current-tag*)
-					    (tag-name *current-tag*)
-					    )
-				    ,style
-				    )
-			      *page-styles*
-			      )
-	       )
-	    )
+					    (tag-name *current-tag*))
+				    ,style)
+			      *page-styles*)))
 
      ,(when style-sheets
 	    `(defmethod render-tag-style-sheets ( (*current-tag* ,name) )
-	       (union-ordered ,style-sheets *page-style-sheets*)
-	       )
-	    )
+	       (union-ordered ,style-sheets *page-style-sheets*)))
 
      ,(when content
 	    `(defmethod render-tag-content ( (*current-tag* ,name) )
 	       ;; setup appropriate globals 
-	       (let* (
-		      ;; getting the tag library here does not involve a "forward reference"
-		      ;; as everything has already been defined above
-		      (*tag-library* (gethash (tag-library-name-for-tag *current-tag*) 
-					      *available-tag-libraries*
-					      ) 
-			)
+	       ;; getting the tag library here does not involve a "forward reference"
+	       ;; as everything has already been defined above
+	       (let* ((*tag-library* (gethash (tag-library-name-for-tag *current-tag*) 
+					      *available-tag-libraries*))
 		      ;; this part is a bit of a forward reference, as we're
 		      ;; using an accessor on a tag library object
-		      (*package* (tag-library-package *tag-library*))
-		      )
+		      (*package* (tag-library-package *tag-library*)))
 		 ;; render the content expression instead of the usual content rendering
-		 (render-as-html (tags ,content) )
-		 )
-	       )
-	    )
-
-     )
-  )
+		 (render-as-html (tags ,content) ))))))
 
 (defmacro defentity (name text &optional documentation)
   "Defines an entity usable in HTML"
   `(progn
      (defvar ,name ,text ,documentation)
-     (export (list (quote ,name) ) )
-     )
-  )
+     (export (list (quote ,name)))))
 
 (defmacro html (&rest body)
   "Interpret the body as html markup, returning an HTML fragment"
-  `(let (
-	 (*page-title* ())
+  `(let ((*page-title* ())
 	 (*page-links* ())
 	 (*page-style-sheets* ())
 	 (*page-styles* ())
 	 (*page-script-libraries* ())
 	 (*page-scripts* ())
-	 (*page-ready-scripts* ())
-	 )
-     (let (
-	   (content (with-output-to-string (*html-out*)
-		      (render-as-html (tags ,@body) )
-		      )
-	     )
-	   )
-       (values content *page-title* *page-links* *page-style-sheets* *page-styles* *page-script-libraries* *page-scripts* *page-ready-scripts*)
-       )
-     )
-  )
+	 (*page-ready-scripts* ()))
+     (let ((content (with-output-to-string (*html-out*)
+		      (render-as-html (tags ,@body) ))))
+       (values content *page-title* *page-links* *page-style-sheets* *page-styles* *page-script-libraries* *page-scripts* *page-ready-scripts*))))
 
 (defmacro page (&rest raw-body)
   "Interpret the raw body as html markup, and return a complete HTML page.  Remember, this is usually called in a loop of all available user agents"
 		   (hout "<head>~%")
 
 		   (when *page-title*
-		     (hout "<title>~a</title>~%" *page-title*)
-		     )
+		     (hout "<title>~a</title>~%" *page-title*))
 
 		   (when *page-links*
 		     (dolist (link *page-links*)
 		       (destructuring-bind (rel type href) link
 			 (hout "<link~@[ rel='~a'~]~@[ type='~a'~]~@[ href='~a'~]/>~%"
-			       rel type href
-			       )
-			 )
-		       )	     
-		     )
+			       rel type href))))
 
 		   (when *page-style-sheets*
 		     (dolist (style-sheet *page-style-sheets*)
 		       (hout "<link type='text/css' href='~a' rel='stylesheet' />~%"
-			     style-sheet 
-			     )
-		       )
-		     )
+			     style-sheet )))
 		   
 		   (when *page-styles*
 		     (hout "<style type='text/css'>~%~%~{~a~%~}~%</style>~%"
-			   *page-styles*
-			   )
-		     )
+			   *page-styles*))
 
 		   (when *page-script-libraries*
 		     (dolist (library *page-script-libraries*)
 		       (hout "<script type='text/javascript' src='~a'></script>~%"
-			     library
-			     )
-		       )
-		     )
+			     library)))
 		   
 		   (when (and *page-scripts*
-			      (not (equal *page-scripts* ""))
-			      )
+			      (not (equal *page-scripts* "")))
 		     (hout "<script type='text/javascript'>~%~%~{~a~%~}~%</script>~%"
-			   *page-scripts*
-			   )
-		     )
+			   *page-scripts*))
+
 		   (when (and *page-ready-scripts*
-			      (not (equal *page-ready-scripts* ""))
-			      )
+			      (not (equal *page-ready-scripts* "")))
 		     (progn
 		       (hout "<script type='text/javascript'>~%~%")
 		       (hout "$(function(){~%~{~a~%~}~%~%"
-			     *page-ready-scripts*
-			     )
+			     *page-ready-scripts*)
 		       (hout "~%});")
-		       (hout "~%</script>~%")
-		       )
-		     )
+		       (hout "~%</script>~%")))
 		   (hout "</head>~%")
 
 		   (hout "<body>~%")

File templates.lisp

 
 (defvar *template-provider-registry* ()
   "List of template providers, each of which will be called to resolve a template name
-  to locate an appropriate template"
-)
+  to locate an appropriate template")
 
 (defvar *template-cache* (make-hash-table :test 'equal)
-  "Cache of template names to template obejcts"
-  )
+  "Cache of template names to template objects")
 
 (defvar *template* ()
   "While reading a template, this is the current template object for whom
-   a definition is being read"
-  )
+   a definition is being read")
 
 (defvar *minimum-template-stale-time* 1
   "Minimum time in seconds for which a template must remain stale (e.g. not expire,
-   before reloading from its source"
-)
+   before reloading from its source")
 
 ;;;------------------------------------------------------------------------------------
 ;;; Conditions
 ;;;------------------------------------------------------------------------------------
 
 (define-condition template-not-found-error (error) 
-  (
-   (template-path
-    :initarg :path
-    :reader template-path
-    )
-   )
+  ((template-path :initarg :path :reader template-path))
   (:report (lambda (condition stream)
              (format stream "Could not find template ~a~%."
-                     (template-path condition)
-		     )
-	     )
-	   )
-  )
+                     (template-path condition)))))
 
 ;;;------------------------------------------------------------------------------------
 ;;; Templates
 ;;;------------------------------------------------------------------------------------
 
 (defclass template ()
-  (
-   (path
-    :initarg :path
-    :reader template-path
-    )
-   (provider
-    :initarg :provider
-    :accessor template-provider
-    )
-   (libraries
-    :initform ()
-    :accessor tag-libraries-used
-    )
-   (modified-time
-    :initform (now)
-    :accessor modified-time-of
-    )
-   (package
-    :initform (make-package (gensym))
-    :initarg :package
-    :accessor template-package
-    )
-   (args
-    :initform ()
-    :initarg :args
-    :accessor template-args
-    )
-   (kwargs
-    :initform ()
-    :initarg :kwargs
-    :accessor template-keyword-args
-    )
-   (definition
-    :initform ()
-    :initarg :definition
-    :accessor definition-of
-    )
-   )
-)
+  ((path :initarg :path :reader template-path)
+   (provider :initarg :provider :accessor template-provider)
+   (libraries :initform () :accessor tag-libraries-used)
+   (modified-time :initform (now) :accessor modified-time-of)
+   (package :initform (make-package (gensym)) :initarg :package :accessor template-package)
+   (args :initform () :initarg :args :accessor template-args)
+   (kwargs :initform () :initarg :kwargs :accessor template-keyword-args)
+   (definition :initform () :initarg :definition :accessor definition-of)))
 
 (defgeneric template-stalep (tmpl)
   (:method ( (tmpl template) )
     (if (definition-of tmpl)
 	(timestamp> (now) 
-	   (timestamp+ (modified-time-of tmpl) *minimum-template-stale-time* :sec)
-	   )
-	t
-	)
-    )
-  )
+		    (timestamp+ (modified-time-of tmpl) *minimum-template-stale-time* :sec))
+	t)))
 
 (defgeneric template-tags-expiredp (tmpl)
   (:documentation "Return t if any of the known required tag libraries
-   used in the template have expired; nil otherwise"
-		  )
+   used in the template have expired; nil otherwise")
   (:method ( (tmpl template) )
     (find-if #'(lambda (library-name) 
-		 (let (
-		       (library (find-cached-tag-library library-name))
-		       )
+		 (let ((library (find-cached-tag-library library-name)))
 		   (if library
 		       (tag-library-expiredp (find-cached-tag-library library-name) )
-		       t
-		       )
-		   )
-		 )
-	     (tag-libraries-used tmpl )
-	     )
-    )
-  )
+		       t)))
+	     (tag-libraries-used tmpl ))))
 
 (defgeneric template-expiredp (tmpl)
   (:method ( (tmpl template) )
     (when (template-stalep tmpl)
       (or (template-tags-expiredp tmpl)
 	  (not (slot-boundp tmpl 'provider) )
-	  (provider-template-expiredp tmpl (template-provider tmpl) )
-	  )
-      )
-    )
-  )
+	  (provider-template-expiredp tmpl (template-provider tmpl) )))))
 
 ;;;------------------------------------------------------------------------------------
 ;;; Template providers
 ;;;------------------------------------------------------------------------------------
 
 (defclass template-provider ()
-  ()
-  )
+  ())
 
 ; -- Base functions suggested all providers implement
 
 (defgeneric provider-template-expiredp (*template* provider)
   (:documentation "Return t if the provider considers
-   the template expired, otherwise nil"
-		  )
+   the template expired, otherwise nil")
   (:method ( tmpl (provider template-provider)  )
-    t
-    )
-  )
+    t))
 
 (defgeneric load-template-from-provider (*template* template-path provider)
   (:documentation "If the provider can provide a template with the indicated path,
-   return the template; otherwise, return nil"
-		  )
-  )
+   return the template; otherwise, return nil"))
 
 ; -- Helper and framework functions
 
   (if (listp expr)
       (cond ;; will likely need to add more cases over time
 	( (eql '+tag-library (car expr) ) (eval expr) t )
-	( (eql 'use-package (car expr) ) (eval expr) t )
-	)	   ; defaults to nil if no match, meaning no directive
-      nil
-      )
-  )
+	( (eql 'use-package (car expr) ) (eval expr) t ))	   
+      ;; defaults to nil if no match, meaning no directive
+      nil))
 
 (defgeneric read-template-definition (input-stream template-package template-args template-keyword-args)
-  (:documentation "Read a template definition from a stream"
-		  )
+  (:documentation "Read a template definition from a stream")
 
   (:method ( (input-stream stream) (template-package package) (template-args list) (template-keyword-args list) )
-    (let (
-	  (*package* template-package)
-	  (*read-eval* nil) 
-	  )
-					; import arguments into the template package--otherwise reader will create different symbols
+    (let ((*package* template-package)
+	  (*read-eval* nil) )
+      ;; import arguments into the template package--otherwise reader will create different symbols
       (dolist (arg template-args)
-	(import arg template-package)
-	)
+	(import arg template-package))
       (dolist (kwarg template-keyword-args)
-	(import kwarg template-package)
-	)
-					; setup template package for use
+	(import kwarg template-package))
+      ;; setup template package for use
       (use-package 'cl template-package)
       (use-package 'cl-user template-package)
       (use-package 'hh-web-tags template-package)
-					; read template
+      ;; read template
       (loop 
 	 while (listen input-stream)
 	 for expr = (with-tag-reader () (read input-stream)) then (with-tag-reader () (read input-stream))
-	 unless (process-directive expr) collect expr
-	 )
-      )
-    )
+	 unless (process-directive expr) collect expr)))
   (:method ( (input-string string) (template-package package) (template-args list) (template-keyword-args list) )
     (with-input-from-string (input-stream input-string)
-      (read-template-definition input-stream template-package template-args template-keyword-args)
-      )
-    )
-  )
+      (read-template-definition input-stream template-package template-args template-keyword-args))))
 
 (defun load-template-definition (*template* template-path &optional (*template-provider-registry* *template-provider-registry*) )
   "Load the indicated template definition from the first provider that can"
   (when *template-provider-registry*
-    (let* (
-	   (template-provider (car *template-provider-registry*) )
+    (let* ((template-provider (car *template-provider-registry*) )
 	   (found-template-definition (when template-provider
-					(load-template-from-provider *template* template-path template-provider ) 
-					)
-	     )
-	   )
+					(load-template-from-provider *template* template-path template-provider ))))
       (if found-template-definition
 	  found-template-definition
-	  (load-template-definition *template* template-path (cdr *template-provider-registry*) )
-	  )
-      )
-    )
-  )
+	  (load-template-definition *template* template-path (cdr *template-provider-registry*) )))))
 
 (defgeneric load-template (template-path &optional template-args template-keyword-args)
   (:method (template-path &optional (template-args nil) (template-keyword-args nil) )
     (let* ((*template* (make-instance 'template 
 				      :path template-path
 				      :args template-args 
-				      :kwargs template-keyword-args
-				      )) 
+				      :kwargs template-keyword-args)) 
 	   (*package* (template-package *template*))
 	   (definition (eval `(lambda (,@template-args ,@(if template-keyword-args `(&key ,@template-keyword-args)) )
 				,@(or (load-template-definition *template* template-path)
   (remhash template-path *template-cache*)
   ;; also, delete the template's package...could clutter up the runtime
   (when (template-package cached-template)
-    (delete-package (template-package cached-template))
-    )
-  )
+    (delete-package (template-package cached-template))))
 
 (defun find-cached-template (template-path)
-  (let (
-	(cached-template (gethash template-path *template-cache* nil) )
-	)
+  (let ((cached-template (gethash template-path *template-cache* nil) ))
     (if cached-template
 	(if (template-expiredp cached-template) 
 	    (progn
 	      (flush-template template-path cached-template)
-	      nil
-	      )
-	    cached-template
-	    )
-	)
-    )
-  )
+	      nil)
+	    cached-template))))
 
 ;; -------- File-based template provider ---------------------
 ;; 
 ;;  that serves templates from a filesystem
 
 (defclass file-based-template-provider (template-provider)
-  (
-   )
-  (:documentation "Generalized type for providers serving templates from the filesystem")
-)
+  ()
+  (:documentation "Generalized type for providers serving templates from the filesystem"))
 
 (defgeneric template-provider-base-directory (provider)
   (:documentation "Returns the base directory on a fileystem for templates 
-    served by the provider.  Directory name should end in /."
-		  )
-  )
+    served by the provider.  Directory name should end in /."))
 
 (defgeneric template-full-path (template-path provider)
   (:method (template-path (provider file-based-template-provider) )
-    (let (
-	   (provider-path (template-provider-base-directory provider) )
-					; folder-name should be an absolute path, ending / to indicate directory
-	   )
+    (let ((provider-path (template-provider-base-directory provider) ))
+	  ;; folder-name should be an absolute path, ending / to indicate directory
       (merge-pathnames (make-pathname :directory (pathname-directory template-path)
 				      :name (pathname-name template-path)
-				      :type (pathname-type template-path)
-				      ) 
+				      :type (pathname-type template-path)) 
 		       (make-pathname :host (pathname-host provider-path)
-				      :directory (pathname-directory provider-path)
-				      )
-		       )
-      )
-    )
-)
+				      :directory (pathname-directory provider-path))))))
 
 (defgeneric template-file-modified-time (template-path provider)
   (:method (template-path (provider file-based-template-provider) )
-    (let (
-	  (full-path (template-full-path template-path provider) )
-	  )
-      (unix-to-timestamp (sb-posix:stat-mtime (sb-posix:stat full-path)) )
-      )
-    )
-  )
+    (let ((full-path (template-full-path template-path provider) ))
+      (unix-to-timestamp (sb-posix:stat-mtime (sb-posix:stat full-path)) ))))
 
 ; -- Implementation of base template-provider functions
 
 (defmethod provider-template-expiredp (*template* (provider file-based-template-provider) )
-  (let (
-	(full-path (template-full-path (template-path *template*) provider) )
-	)
+  (let ((full-path (template-full-path (template-path *template*) provider) ))
     (timestamp> (template-file-modified-time full-path provider)
-		(modified-time-of *template*)
-		)
-    )
-  )
+		(modified-time-of *template*))))
 
 (defmethod load-template-from-provider ( (*template* template) template-path (provider file-based-template-provider) )
-  (let (
-	(full-path (template-full-path template-path provider) )
-	)
+  (let ((full-path (template-full-path template-path provider) ))
     (when (probe-file full-path)
       (setf (template-provider *template*) provider)
       (setf (modified-time-of *template*) 
 	    (template-file-modified-time template-path provider))
       (read-template-definition (open full-path :direction :input) (template-package *template*)
 				(template-args *template*)
-				(template-keyword-args *template*)
-				)
-      )
-    )
-  )
+				(template-keyword-args *template*)))))
 
 ;; -------- Folder provider ---------------------
 ;; 
 ;;  folder on the filesystem
 
 (defclass folder-template-provider (file-based-template-provider)
-  (
-   (folder
-    :initarg :folder
-    :accessor folder-of
-    )
-   )
-)
+  ((folder :initarg :folder :accessor folder-of)))
 
 (defmethod template-provider-base-directory ( (provider folder-template-provider) )
-  (folder-of provider)
-  )
+  (folder-of provider))
 
 (defun create-folder-template-provider (folder)
-  (make-instance 'folder-template-provider :folder folder)
-  )
+  (make-instance 'folder-template-provider :folder folder))
 
 ;; -------- ASDF system provider ---------------------
 ;; 
 ;;
 
 (defclass asdf-system-provider (file-based-template-provider)
-  (
-   (system
-    :initform nil
-    :initarg :system
-    :accessor system-of
-    )
-   )
-)
+  ((system :initform nil :initarg :system :accessor system-of)))
 
 (defmethod template-provider-base-directory ( (provider asdf-system-provider) )
-  (asdf:system-relative-pathname (system-of provider) (make-pathname :directory `(:relative "templates")) )
-  )
+  (asdf:system-relative-pathname (system-of provider) (make-pathname :directory `(:relative "templates")) ))
 
 (defun create-asdf-system-template-provider (system)
-  (make-instance 'asdf-system-provider :system system)
-)
+  (make-instance 'asdf-system-provider :system system))
 
 ; -- Implementation of base template-provider functions
 
 (defmethod provider-template-expiredp (*template* (provider asdf-system-provider) )
-  (let (
-	(full-path (template-full-path (template-path *template*) provider) )
-	)
+  (let ((full-path (template-full-path (template-path *template*) provider) ))
     (when (probe-file full-path) ;; if file does not exist, no point in declaring it expired--can't reload anyway
       (timestamp> (template-file-modified-time full-path provider)
-		  (modified-time-of *template*)
-		  )
-      )
-    )
-  )
+		  (modified-time-of *template*)))))
 
 (defmethod load-template-from-provider ( (*template* template) template-path (provider asdf-system-provider) )
-  (let (
-	(full-path (template-full-path template-path provider) )
-	)
+  (let ((full-path (template-full-path template-path provider) ))
     (when (probe-file full-path)
       (setf (template-provider *template*) provider)
       (setf (modified-time-of *template*) 
-	    (template-file-modified-time template-path provider)
-	    )
+	    (template-file-modified-time template-path provider))
       (read-template-definition (open full-path :direction :input) (template-package *template*)
 				(template-args *template*)
-				(template-keyword-args *template*)
-				)
-      )
-    )
-  )
+				(template-keyword-args *template*)))))
 
 
 ;;;------------------------------------------------------------------------------------
 		       path
 		       &key
 		       ((:args template-args) nil)
-		       ((:kwargs template-keyword-args) nil)
-		       )
+		       ((:kwargs template-keyword-args) nil))
   `(progn
 
      ;; pre-load -- note that this will likely create definitions in error, because a template cannot be found
 
 (defun local-tag-library-provider-registry-symbol () 
   "Returns a symbol in the current package for storing the tag library provider registry expected by the package"
-  (intern "*PACKAGE-TAG-LIBRARY-PROVIDER-REGISTRY*" *package*) 
-  )
+  (intern "*PACKAGE-TAG-LIBRARY-PROVIDER-REGISTRY*" *package*) )
 
-(defmacro deftemplates (
-			&key
+(defmacro deftemplates (&key
 			((:tag-library-packages tag-library-packages) nil)
 			((:template-packages template-packages) nil)
-			((:templates templates) nil)
-			)
-  (let (
-	(template-provider-registry (local-template-provider-registry-symbol) )
-	(tag-library-provider-registry (local-tag-library-provider-registry-symbol) )
-	)
+			((:templates templates) nil))
+  (let ((template-provider-registry (local-template-provider-registry-symbol) )
+	(tag-library-provider-registry (local-tag-library-provider-registry-symbol) ))
     `(progn
        (defparameter ,template-provider-registry
 	 (list ,@(append (mapcar (lambda (template-package)
-				   `(create-asdf-system-template-provider (quote ,template-package))
-				   )
-				 template-packages
-				 )
-			 (list `(create-asdf-system-template-provider 'hh-web-tags ) ) ;; always here by default
-			 )
-	       )
-	 )
+				   `(create-asdf-system-template-provider (quote ,template-package)))
+				 template-packages)
+			 ;; always here by default
+			 (list `(create-asdf-system-template-provider 'hh-web-tags)))))
 
        (defparameter ,tag-library-provider-registry
 	 (list ,@(append (mapcar (lambda (tag-library-package)
-				   `(create-asdf-system-tag-library-provider (quote ,tag-library-package) )
-				   )
-				 tag-library-packages
-				 )
-			 (list `(create-asdf-system-tag-library-provider 'hh-web-tags ) ) ;; always here by default
-			 ) 
-	       )
-	 )
+				   `(create-asdf-system-tag-library-provider (quote ,tag-library-package)))
+				 tag-library-packages)
+			 ;; always here by default
+			 (list `(create-asdf-system-tag-library-provider 'hh-web-tags )))))
 
-       (let (
-	     (*tag-library-provider-registry* ,tag-library-provider-registry)
-	     (*template-provider-registry* ,template-provider-registry)
-	     )
+       (let ((*tag-library-provider-registry* ,tag-library-provider-registry)
+	     (*template-provider-registry* ,template-provider-registry))
 	 ,@(mapcar (lambda (template)
-		     `(deftemplate ,@template)
-		     )
-		   templates
-		   )
-	 )
-       )
-    )
-  )
+		     `(deftemplate ,@template))
+		   templates)))))
 
 ;;;------------------------------------------------------------------------------------
 ;;;  Tag library use in templates
    current package (e.g., found by looking at *package* in
    dynamic environment
    "
-  (let (
-	  (library (import-tag-library library-name) )
-	  )
-     (when library
-       (when *template*
-	 (putendnew library-name (tag-libraries-used *template*) :test 'equal)
-	 )
-       library
-       )
-     )
-  nil
-  )
+  (let ((library (import-tag-library library-name)))
+    (when library
+      (when *template*
+	(putendnew library-name (tag-libraries-used *template*) :test 'equal))
+      library))
+  nil)