Commits

Anonymous committed c80193a

Deleting existing hh-web source in preparation for setting up as a submodule

Comments (0)

Files changed (5)

hh-web-tags.asd

-;; Copyright (c) 2010 Haphazard House LLC
-
-;; Permission is hereby granted, free of charge, to any person obtaining a copy
-;; of this software and associated documentation files (the "Software"), to deal
-;; in the Software without restriction, including without limitation the rights
-;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-;; copies of the Software, and to permit persons to whom the Software is
-;; furnished to do so, subject to the following conditions:
-
-;; The above copyright notice and this permission notice shall be included in
-;; all copies or substantial portions of the Software.
-
-;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-;; THE SOFTWARE.
-
-(defpackage #:hh-web-asd
-  (:use :cl :asdf))
-
-(in-package :hh-web-asd)
-
-(defsystem hh-web
-  :name "hh-web"
-  :version "0.01"
-  :serial t
-  :components (
-               (:file "package-hh-web")
-	       (:file "utils")
-	       (:file "logs")
-               (:file "tags")
-	       (:file "taglibraries")
-	       (:file "cookies")
-	       (:file "templates")
-	       (:file "services")
-	       (:file "cache")
-	       (:file "urls")
-	       (:file "server")
-	       )
-  :depends-on (
-	       ; external packages
-	       "log5"
-	       "hunchentoot"
-	       "drakma"
-	       "parenscript"
-	       "cl-ppcre"
-	       "local-time"
-
-	       ; project packages
-               )
-  )
-
-(defsystem hh-web-tests
-  :name "hh-web-tests"
-  :version "0.01"
-  :serial t
-  :components (
-               (:file "tests")
-               	)
-  :depends-on (
-               "hh-web"
-        )
-  )

package-hh-web-tags.lisp

-;; Copyright (c) 2010 Haphazard House LLC
-
-;; Permission is hereby granted, free of charge, to any person obtaining a copy
-;; of this software and associated documentation files (the "Software"), to deal
-;; in the Software without restriction, including without limitation the rights
-;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-;; copies of the Software, and to permit persons to whom the Software is
-;; furnished to do so, subject to the following conditions:
-
-;; The above copyright notice and this permission notice shall be included in
-;; all copies or substantial portions of the Software.
-
-;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-;; THE SOFTWARE.
-
-(defpackage #:hh-web-asd
-  (:use :cl :asdf))
-
-(in-package :hh-web-asd)
-
-(defpackage :hh-web
-  (:nicknames :hh-web)
-  (:use :cl :sb-mop :cl-ppcre :local-time)
-  (:export
-    
-    ;; Exported symbols go here
-    
-    )
-  )

taglibraries.lisp

-;; Copyright (c) 2010 Haphazard House LLC
-
-;; Permission is hereby granted, free of charge, to any person obtaining a copy
-;; of this software and associated documentation files (the "Software"), to deal
-;; in the Software without restriction, including without limitation the rights
-;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-;; copies of the Software, and to permit persons to whom the Software is
-;; furnished to do so, subject to the following conditions:
-
-;; The above copyright notice and this permission notice shall be included in
-;; all copies or substantial portions of the Software.
-
-;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-;; THE SOFTWARE.
-
-(in-package :hh-web)
-
-(export
- (list
-
-  '*tag-library*
-  '*tag-library-provider-registry*
-  'create-folder-tag-library-provider
-  'create-asdf-system-tag-library-provider
-
-  'in-tag-library
-  'use-tag-library
-  '+tag-library
-
-  )
- )
-
-;;;------------------------------------------------------------------------------------
-;;; Dynamic variables
-;;;------------------------------------------------------------------------------------
-
-(defvar *tag-library-provider-registry* ()
-  "A list of functions such that when each is called with 1 argument (a tag name), they
-  return the tag source as a stream or string"
-  )
-
-(defvar *minimum-tag-library-stale-time* 1
-  "Minimum time in seconds for which a tag library must remain stale (e.g. not expire)
-   before reloading from its source"
-)
-
-;;;------------------------------------------------------------------------------------
-;;; Conditions
-;;;------------------------------------------------------------------------------------
-
-(define-condition library-not-found-error (error) 
-  (
-   (library-name
-    :initarg :name
-    :reader library-name
-    )
-   )
-  (:report (lambda (condition stream)
-             (format stream "Could not find tag library ~a~%."
-                     (library-name condition)
-		     )
-	     )
-	   )
-  )
-
-;;;------------------------------------------------------------------------------------
-;;; Tag libraries
-;;;------------------------------------------------------------------------------------
-
-(defclass tag-library ()
-  (
-   (name
-    :initarg :name
-    :reader tag-library-name
-    )
-   (provider
-    :initarg :provider
-    :accessor tag-library-provider
-    )
-   (modified-time
-    :initform (now)
-    :accessor modified-time-of
-    )
-   (package
-    :initform nil
-    :initarg :package
-    :accessor tag-library-package
-    )
-   (libraries
-    :initform ()
-    :accessor tag-libraries-used
-    :documentation "A list of symbols identifying other libraries upon 
-    which this one depends"
-    )
-   (tags
-    :initform ()
-    :accessor tag-library-tags
-    :documentation "A list of symbols identifying tags defined by this library"
-    )
-
-   )
-)
-
-(defmethod initialize-instance :after ( (library tag-library) &key )
-  (let* (
-	 (pkg-name (intern (symbol-name (tag-library-name library) )
-			   'cl-user
-			   )
-	   )
-	 (pkg (or (find-package pkg-name)
-		  (make-package pkg-name) 
-		  )
-	   )
-	 )
-    (setf (tag-library-package library) pkg)
-    library
-    )
-  )
-
-(defgeneric tag-library-stalep (library)
-  (:method ( (library tag-library) )
-    (timestamp> (now) 
-       (timestamp+ (modified-time-of library) *minimum-tag-library-stale-time* :sec)
-       )
-    )
-  )
-
-(defgeneric tag-library-expiredp (library)
-  (:documentation "Return if the library (or any of its dependent libraries) has epxired")
-  )
-
-;;;------------------------------------------------------------------------------------
-;;; Tag library providers
-;;;------------------------------------------------------------------------------------
-
-(defclass tag-library-provider ()
-  ()
-  )
-
-; -- Base functions suggested all providers implement
-
-(defgeneric provider-tag-library-expiredp (library provider)
-  (:documentation "Return t if the provider considers
-   the tag library expired, otherwise nil"
-		  )
-  (:method ( library (provider tag-library-provider)  )
-    t
-    )
-  )
-
-(defgeneric load-tag-library-from-provider (library-name provider)
-  (:documentation "If the provider can provide a tag library with the indicated name,
-   return the tag library; otherwise, return nil"
-		  )
-  )
-
-; -- Helper and framework functions
-
-(defgeneric read-tag-library (input-stream)
-  (:documentation "Read in a tag library from a stream"
-		  )
-
-  (:method ( (input-stream stream) )
-    (let (
-	  (*tag-library* nil)
-	  (*read-eval* nil) 
-	  (*package* (find-package 'cl-user) )
-	  )
-      ;; read tag library
-      (use-package :hh-web *package*)
-      (loop 
-	 ;; TODO as a consequence of how this is implemented, any whitespace after last tag 
-	 ;; causes an irrelevant EOF error
-	 while (listen input-stream)
-	 do (eval (read input-stream) )
-	 )
-      ;; expecting an in-tag-library call inside the file
-      ;; to set the value of this variable
-      *tag-library* 
-      )
-    )
-  (:method ( (input-string string) )
-    (with-input-from-string (input-stream input-string)
-      (read-tag-library input-stream)
-      )
-    )
-  )
-
-(defgeneric load-tag-library (library-name &optional *tag-library-provider-registry*)
-  (:documentation "Load the tag library from the first provider that can provide it")
-  (:method (library-name &optional (*tag-library-provider-registry* *tag-library-provider-registry*) )
-    (when *tag-library-provider-registry*
-      (let* (
-	     (provider (car *tag-library-provider-registry*) )
-	     (found-tag-library (when provider
-				  (load-tag-library-from-provider library-name provider ) 
-				  )
-	       )
-	     )
-	(if found-tag-library
-	    (progn
-	      (setf (gethash library-name *available-tag-libraries*) found-tag-library)
-	      found-tag-library
-	      )
-	    (load-tag-library library-name (cdr *tag-library-provider-registry*) )
-	    )
-	)
-      )
-    )
-  )
-
-(defun flush-tag-library (library-name cached-library)
-  "Safely a cached library, typically for reloading"
-  ;; remove the library from the cache
-  (remhash library-name *available-tag-libraries*)
-  ;; also, delete the library's package...should make it easier to redefine it
-  (when (template-package cached-library)
-    (delete-package (tag-library-package cached-library))
-    )
-  )
-
-(defun find-cached-tag-library (library-name)
-  (let (
-	(cached-library (gethash library-name *available-tag-libraries* nil) )
-	)
-    (if cached-library
-	(if (tag-library-expiredp cached-library) 
-	    (progn
-	      (remhash library-name *available-tag-libraries*)
-	      nil
-	      )
-	    cached-library
-	    )
-	)
-    )
-  )
-
-(defmethod tag-library-expiredp ( (library tag-library) )
-  (when (tag-library-stalep library)
-    (or (not (slot-boundp library 'provider)) ;; in case a library fails during creation with no provider found
-	(provider-tag-library-expiredp library (tag-library-provider library) )
-	(find-if #'(lambda (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 library )
-		 )
-	)
-    )
-  )
-
-;; -------- Folder provider ---------------------
-;; 
-;;  provides tag libraries in individual files of a specified 
-;;  folder on the filesystem
-;;
-
-(defclass folder-tag-library-provider (tag-library-provider)
-  (
-   (folder
-    :initarg :folder
-    :accessor folder-of
-    )
-   )
-)
-
-(defgeneric tag-library-full-path (library-name provider)
-  (:method (library-name (provider folder-tag-library-provider) )
-    (let (
-	   (provider-path (folder-of provider) )
-					; folder-name should be an absolute path, ending / to indicate directory
-	   )
-      (merge-pathnames (make-pathname :name (pathname-name (string-downcase
-							    (symbol-name library-name)
-							    )
-							   )
-				      :type "lisp"
-				      ) 
-		       (make-pathname :host (pathname-host provider-path)
-				      :directory (pathname-directory provider-path)
-				      )
- 		       )
-      )
-    )
-)
-
-(defgeneric tag-library-file-modified-time (library-name provider)
-  (:method (library-name (provider folder-tag-library-provider) )
-    (let (
-	  (full-path (tag-library-full-path library-name provider) )
-	  )
-      (unix-to-timestamp (sb-posix:stat-mtime (sb-posix:stat full-path)) )
-      )
-    )
-  )
-
-(defun create-folder-tag-library-provider (folder)
-  (make-instance 'folder-tag-library-provider :folder folder)
-  )
-
-(defun create-asdf-system-tag-library-provider (system)
-  (make-instance 'folder-tag-library-provider 
-		 :folder (asdf:system-relative-pathname 
-					(asdf:find-system system) 
-					(make-pathname :directory `(:relative "taglibraries") )
-					)
-		 )
-  )
-
-
-; -- Implementation of base tag-library-provider functions
-
-(defmethod provider-tag-library-expiredp (library (provider folder-tag-library-provider) )
-  (timestamp>  (tag-library-file-modified-time (tag-library-name library) provider)
-	(modified-time-of library)
-	)
-  )
-
-(defmethod load-tag-library-from-provider (library-name  (provider folder-tag-library-provider))
-  (let (
-	(full-path (tag-library-full-path library-name provider) )
-	)
-    (when (probe-file full-path)
-      (let (
-	    (library (read-tag-library (open full-path :direction :input) )
-	      )
-	    )
-	;; TODO note: if there is a failure during read, then neither of the following 2
-	;; statements will execute
-	(setf (tag-library-provider library) provider)
-	(setf (modified-time-of library) 
-	      (tag-library-file-modified-time library-name provider)
-	      )
-	library
-	)
-      )
-    )
-  )
-
-
-
-; -- Tag library support for rendering to html
-
-;; generic function declared in tags.lisp, because tags need to invoke the function 
-;; at point of tag declaration
-
-(defmethod add-tag-to-library ( (tag-name symbol) &optional (*tag-library* *tag-library*))
-  (if *tag-library*
-      (putendnew tag-name (tag-library-tags *tag-library*) :test 'equal)
-      )
-  )
-
-(defmethod expand-expression-with-libraries (expr &optional (*available-tag-libraries* *available-tag-libraries*))
-  `(macrolet (
-	      ,@(tag-library-tag-expansions (hash-contents *available-tag-libraries*))
-	      )
-     ,expr
-     )
-  )
-
-(defgeneric tag-library (name)
-  (:documentation "Return the library with the indicated name")
-)
-
-(defgeneric tag-library-tag-expansions (some-library)
-  (:documentation "For some library, return the list of macro expansions 
-   for each tag in the library")
-  )
-
-(defmethod tag-library ( (name symbol) )
-  (gethash name *available-tag-libraries*)
-  )
-
-(defmethod tag-library-tag-expansions ( (some-library tag-library) )
-  (mapcar (lambda (each-tag) (tag-expansion each-tag) )
-	  (tag-library-tags some-library)
-	  )
-  )
-
-(defmethod tag-library-tag-expansions ( (some-library (eql 'nil) ) )
-  nil
-  )
-
-(defmethod tag-library-tag-expansions ( (some-library symbol) )
-  (tag-library-tag-expansions (tag-library some-library))
-  )
-
-(defmethod tag-library-tag-expansions ( (some-libraries list) )
-  "Gather all tag expansions for all libraries in the list"
-  
-  (apply 'concatenate (cons 'list 
-			    (mapcar (lambda (each-library) 
-				      (tag-library-tag-expansions each-library)
-				      )
-				    some-libraries
-				    )
-			    )
-	 )
-  )
-
-;;;------------------------------------------------------------------------------------
-;;;  Tag library language
-;;;
-;;;  Macros & functions used in a tag library file
-;;;
-
-(defmacro in-tag-library (library-name)
-  "All following tag definitions will go into this named library"
-  `(let* (
-	  (library (make-instance 'tag-library :name (quote ,library-name)) )
-	  (library-package (tag-library-package library) )
-	  )
-     (setf (gethash (quote ,library-name) *available-tag-libraries*)
-	   library
-	   )
-     (setf *package* library-package )
-     (setf *tag-library* library)
-
-     ;; setup tag library package for use
-     (use-package 'cl library-package)
-     (use-package 'cl-user library-package)
-     (use-package 'hh-web library-package)
-     library
-     )
-  )
-
-(defun import-tag-library (library-name)
-  (let (
-	(library (or (find-cached-tag-library library-name) 
-		     (load-tag-library library-name)
-		     )
-	  )
-	)
-    (if library
-	(progn
-	  (use-package (tag-library-package library) *package*)
-	  library
-	  )
-	(error 'tag-library-not-found-error :name library-name)
-	)
-    )
-  )
-
-(defun use-tag-library (library-name)
-  "Add the named tag library to the list of libraries used by the
-  active tag library"
-  (let* (
-	 (library (import-tag-library library-name) )
-	 )
-    (when library
-      (when *tag-library*
-	(putendnew library-name (tag-libraries-used *tag-library*) :test 'equal)
-	)
-      library
-      )
-    )
-  )
-
-
-
-	

tags.lisp

-;; Copyright (c) 2010 Haphazard House LLC
-
-;; Permission is hereby granted, free of charge, to any person obtaining a copy
-;; of this software and associated documentation files (the "Software"), to deal
-;; in the Software without restriction, including without limitation the rights
-;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-;; copies of the Software, and to permit persons to whom the Software is
-;; furnished to do so, subject to the following conditions:
-
-;; The above copyright notice and this permission notice shall be included in
-;; all copies or substantial portions of the Software.
-
-;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-;; THE SOFTWARE.
-
-(in-package :hh-web)
-
-(export 
- (list
-
-  'hout
-  'defhtmltag
-  '_body
-  'defentity
-  '*current-tag*
-  '*tag-library-registry*
-  'body-of
-  'style-of 
-  'html-id
-  'css-class
-  'style-of
-  'rel-of
-  'id
-  'class
-  'style
-  'rel
-  'htmltag
-  'render-as-html
-  '+@
-  '+title
-  '+link
-  'hout
-  'expansion
-  'tags
-  'html
-  'page
- 
-  )
- )
-
-(defmacro hout (format-string &rest args )
-  "Macro to simplify writing out html to correct stream"
-  `(format *html-out* ,format-string ,@args)
-  )
-
-;;;------------------------------------------------------------------------------------
-;;; Dynamic variables
-;;;------------------------------------------------------------------------------------
-
-(defvar *current-tag* nil
-  "The current tag under construction (if any)"
-  )
-
-(defvar *html-out* *standard-output* 
-  "Output stream for rendering html"
-  )
-
-(defvar *page-title* ""
-  "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"
-  )
-
-(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-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"
-      )
-
-;;;------------------------------------------------------------------------------------
-;;; 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
-    )
-   )
-  )
-
-;;;------------------------------------------------------------------------------------
-;;; 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"
-)
-
-(defvar *tag-library* nil
-  "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"
-		  )
-  )
-
-(defgeneric expand-expression-with-libraries (expr &optional *available-tag-libraries*)
-  (:documentation "Expand the expression using the provided libraries")
-  )
-
-
-;;;------------------------------------------------------------------------------------
-;;; Generics
-;;;------------------------------------------------------------------------------------
-
-(defgeneric tag-name (*current-tag*)
-  (:documentation "Return the name of the tag as a string 
-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")
-  )
-
-(defgeneric tag-expansion (some-tag-symbol)
-  (:documentation "Return the macro for expanding a tag expression
-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."
-		  )
-  )
-
-(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."
-		  )
-  )
-
-
-(defgeneric tag-separate-initializer-and-body (some-tag-symbol raw-body)
-  (:documentation "Return 2 values (nil if the value is not applicable):
-   the first is the tag initializer, the 2nd is the tag's computed 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"
-		  )
-)
-
-(defgeneric tag-attributes (*current-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
-     of some-tag's class within the same context (page, stylesheet, etc.)
-    "
-    )
-  )
-
-(defgeneric render-tag-ready-scripts (*current-tag*)
-  (:documentation
-    "Return a string representing script to run when a page
-     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.
-    "
-    )
-  )
-
-(defgeneric render-tag-script-libraries (*current-tag*)
-  (:documentation
-    "Return a list of strings pointing to script libraries used
-     by instances of this tag
-    "
-    )
-  )
-
-(defgeneric render-tag-styles (*current-tag*)
-  (:documentation
-    "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
-    "
-    )
-  )
-
-(defgeneric render-tag-start (*current-tag*)
-  (:documentation "Render the beginning of a tag, including its attributes (by
-    calling render-attributes)")
-  )
-
-(defgeneric render-tag-attributes (*current-tag*)
-  (: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")
-  )
-
-(defgeneric render-tag-end (*current-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."
-		  )
-)
-
-(defgeneric render-as-html (some-expr)
-  (:documentation "Return some expression as an HTML string")
-  )
-
-
-;;;------------------------------------------------------------------------------------
-;;; Methods
-;;;------------------------------------------------------------------------------------
-
-(defmethod tag-library-name-for-tag ( (*current-tag* htmltag) )
-  (intern (package-name (symbol-package (tag-name *current-tag*))) 'keyword)
-  )
-
-(defmethod tag-attributes ( (some-tag-name symbol) )
-  (select (mapcar (lambda (s) (slot-definition-name s))
-		 (class-slots (find-class some-tag-name))
-		 )
-	  (lambda (a) 
-	    (not (equal a '_body))
-	    )
-	  )
-  )
-
-(defmethod tag-attributes ( (*current-tag* htmltag) )
-  (select (tag-attributes (type-of *current-tag*))
-	  (lambda (a)
-	    (not (equal (slot-value *current-tag* a) nil))
-	    )
-	  )
-  )
-
-(defmethod render-tag-scripts ((some-tag-name symbol))
-    nil
-    )
-
-(defmethod render-tag-scripts ((*current-tag* htmltag))
-    nil
-    )
-
-(defmethod render-tag-ready-scripts((some-tag-name symbol))
-    nil
-    )
-
-(defmethod render-tag-ready-scripts((*current-tag* htmltag))
-    nil
-    )
-
-(defmethod render-tag-script-libraries((some-tag-name symbol))
-    nil
-    )
-
-(defmethod render-tag-script-libraries ((*current-tag* htmltag))
-    nil
-  )
-
-(defmethod render-tag-styles ((some-tag-name symbol))
-    nil
-    )
-
-(defmethod render-tag-styles ((*current-tag* htmltag))
-    nil
-  )
-
-(defmethod render-tag-style-sheets ((some-tag-name symbol))
-    nil
-    )
-
-(defmethod render-tag-style-sheets ((*current-tag* htmltag))
-  nil
-  )
-
-(defmethod tag-expansion ( (name symbol) )
-  `(,name (&rest content)
-	  (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*
-		 )
-	      )
-	    )
-	  )
-  )
-
-(defmethod tag-has-body-p ( (some-tag-symbol symbol) )
-  t
-  )
-
-(defmethod tag-has-end-tag-p ( (*current-tag* htmltag) )
-  t
-  )
-
-(defmethod tag-separate-initializer-and-body ( (some-tag-symbol symbol) raw-body)
-  (if (tag-has-body-p some-tag-symbol)
-      (let (
-	    (body (select raw-body
-			  (lambda (b) 
-			    (if (and (listp b) (equal '+@ (car b)))
-				nil
-				t
-				)
-			    )
-			  )
-	      )
-	    (initializer (cdr (car (select raw-body
-					   (lambda (b) 
-					     (and (listp b) (equal '+@ (car b)))
-					     )
-					   )
-				   )
-			      )
-	      )
-	    )
-	(values initializer body)
-	)  
-      (values raw-body nil)
-      )
-  )
-
-(defmethod render-as-html ( (*current-tag* htmltag) )
-
-  (render-tag-script-libraries *current-tag* )
-  (render-tag-scripts *current-tag* )
-  (render-tag-styles *current-tag* )
-  (render-tag-style-sheets *current-tag* )
-  (render-tag-ready-scripts *current-tag* )
-
-  (render-tag-content *current-tag* )
-)
-
-(defmethod render-as-html ( (some-expr t) )
-  (hout "~a" some-expr)
-)
-
-(defmethod render-as-html ( (some-list list) )
-  (dolist (item some-list)
-    (render-as-html item)
-    )
-)
-
-(defmethod render-tag-start ( (*current-tag* htmltag) )
-  (let (
-	(name (tag-name *current-tag* ) )
-	)
-    (hout "<~a" (string-downcase name) )
-    (render-tag-attributes *current-tag*)
-    (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*)
-		  )
-	  )
-  )
-
-(defmethod render-tag-body ( (*current-tag* htmltag) )
-  (dolist (some-expr (body-of *current-tag*) )
-    (render-as-html some-expr)
-    )
-  )
-
-
-(defmethod render-tag-end ( (*current-tag* htmltag) )
-  (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* )
-      )
-  )
-
-;;;------------------------------------------------------------------------------------
-;;; Functions
-;;;------------------------------------------------------------------------------------
-
-(defun separate-initializer-and-body (raw-body)
-  (let (
-	(body (select raw-body
-		      (lambda (b) 
-			(if (and (listp b) (equal '+@ (car b)))
-			    nil
-			    t
-			    )
-			)
-		      )
-	  )
-	(initializer (cdr (car (select raw-body
-				       (lambda (b) 
-					 (and (listp b) (equal '+@ (car b)))
-					 )
-				       )
-			       )
-			  )
-	  )
-	)
-    (values initializer body)
-    )
-  )
-
-;;;------------------------------------------------------------------------------------
-;;; Macros
-;;;------------------------------------------------------------------------------------
-
-(defmacro expansion (expr)
-  `(expand-expression-with-libraries (quote ,expr) *available-tag-libraries*)
-  )
-
-(defmacro tags (expr)
-  (expand-expression-with-libraries expr *available-tag-libraries*)
-       )
-
-(defmacro +title (expr)
-  `(progn
-     (setf *page-title* ,expr)
-     nil
-     )
-  )
-
-(defmacro +link (
-		 &key
-		 ((:rel rel) nil)
-		 ((:type type) nil)
-		 ((:href href) nil)
-		 )
-  `(progn
-     (pushnew (list ,rel ,type ,href)
-	      *page-links*
-	      :test 'equal
-	      )
-     nil
-     )
-  )
-
-(defmacro defhtmltag (name
-		      &key
-		      ((:tag tag) nil)
-		      ((:bases bases) nil) ; other base classes here
-		      ((:attributes attributes) nil)
-		      ((:hasbody hasbody) t)
-		      ((:noendtag noendtag) nil)
-		      ((:content content) nil)
-		      ((:script script) nil)
-		      ((:ready ready) nil)
-		      ((:style style) nil)
-		      ((:style-sheets style-sheets) nil)
-		      ((:script-libraries script-libraries) nil)
-		      )
-  (declare 
-   ; (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)
-	      )
-	     )
-
-     (defclass ,name (,@bases htmltag)
-       (,@attributes)
-       )
-
-     ;; TODO should consider undefining some of these methods, 
-     ;; to avoid lingering effects when tags redefined (e.g, 
-     ;; define scripts, then redefine without scripts, method
-     ;; for scripts still exists)
-
-     (defmethod tag-name ( (*current-tag* ,name) )
-       ,(if tag
-	    tag	    
-	    `(quote ,name)
-	    )
-       )
-
-     ,(unless hasbody
-	      `(defmethod tag-has-body-p ( (some-tag-symbol (eql (quote ,name) ) ) )
-		 nil
-		 )
-	      )
-
-     ,(when noendtag
-	      `(defmethod tag-has-end-tag-p ( (some-tag  ,name) )
-		 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* 
-				)
-	       )
-	    )
-
-     ,(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*
-			      )
-	       )
-	    )
-	    
-     ,(when script-libraries
-	    `(defmethod render-tag-script-libraries ( (*current-tag* ,name) )
-	       (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*
-			      )
-	       )
-	    )
-
-     ,(when style-sheets
-	    `(defmethod render-tag-style-sheets ( (*current-tag* ,name) )
-	       (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*
-					      ) 
-			)
-		      ;; 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*))
-		      )
-		 ;; render the content expression instead of the usual content rendering
-		 (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) ) )
-     )
-  )
-
-(defmacro html (&rest body)
-  "Interpret the body as html markup, returning an HTML fragment"
-  `(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*)
-       )
-     )
-  )
-
-(defmacro page (&rest raw-body)
-  "Interpret the raw body as html markup, and return a complete HTML page"
-  `(multiple-value-bind (page-attributes body) (separate-initializer-and-body (quote ,raw-body))
-     (declare (ignorable page-attributes body ) )
-     (multiple-value-bind (page-content *page-title* *page-links* *page-style-sheets* *page-styles* *page-script-libraries* *page-scripts* *page-ready-scripts*) 
-	   (html (list ,@raw-body) )
-					; now render the page
-	 (with-output-to-string (*html-out*)
-	   (hout "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\">~%")
-	   (hout "<html xmlns=\"http://www.w3.org/1999/xhtml\">~%")
-	   (hout "<head>~%")
-
-	   (when *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
-		       )
-		 )
-	       )	     
-	     )
-
-	   (when *page-style-sheets*
-	       (dolist (style-sheet *page-style-sheets*)
-		 (hout "<link type='text/css' href='~a' rel='stylesheet' />~%"
-		       style-sheet 
-		       )
-		 )
-	       )
-             
-	   (when *page-styles*
-	       (hout "<style type='text/css'>~%~%~{~a~%~}~%</style>~%"
-		     *page-styles*
-		     )
-	       )
-
-	   (when *page-script-libraries*
-	       (dolist (library *page-script-libraries*)
-		 (hout "<script type='text/javascript' src='~a'></script>~%"
-		       library
-		       )
-		 )
-	       )
-             
-	   (when (and *page-scripts*
-		    (not (equal *page-scripts* ""))
-		    )
-	       (hout "<script type='text/javascript'>~%~%~{~a~%~}~%</script>~%"
-		     *page-scripts*
-		     )
-	       )
-	   (when (and *page-ready-scripts*
-		    (not (equal *page-ready-scripts* ""))
-		    )
-	       (progn
-		 (hout "<script type='text/javascript'>~%~%")
-		 (hout "$(function(){~%~{~a~%~}~%~%"
-		       *page-ready-scripts*
-		       )
-		 (hout "~%});")
-		 (hout "~%</script>~%")
-		 )
-	       )
-	   (hout "</head>~%")
-
-	   (hout "<body>~%")
-
-	   (hout "~a~%" page-content)
-
-	   (hout "</body>~%")
-
-	   (hout "</html>~%")
-	   )
-	 )
-     )
-  )

templates.lisp

-;; Copyright (c) 2010 Haphazard House LLC
-
-;; Permission is hereby granted, free of charge, to any person obtaining a copy
-;; of this software and associated documentation files (the "Software"), to deal
-;; in the Software without restriction, including without limitation the rights
-;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-;; copies of the Software, and to permit persons to whom the Software is
-;; furnished to do so, subject to the following conditions:
-
-;; The above copyright notice and this permission notice shall be included in
-;; all copies or substantial portions of the Software.
-
-;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-;; THE SOFTWARE.
-
-(in-package :hh-web)
-
-(export 
- (list
-
-  'template
-  'deftemplate
-  'deftemplates
-  '*template*
-  '*template-provider-registry*
-  'create-folder-template-provider
-  'create-asdf-system-template-provider
-
-  )
-)
-
-;;;------------------------------------------------------------------------------------
-;;; Dynamic variables
-;;;------------------------------------------------------------------------------------
-
-(defvar *template-provider-registry* ()
-  "List of template providers, each of which will be called to resolve a template name
-  to locate an appropriate template"
-)
-
-(defvar *template-cache* (make-hash-table :test 'equal)
-  "Cache of template names to template obejcts"
-  )
-
-(defvar *template* ()
-  "While reading a template, this is the current template object for whom
-   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"
-)
-
-;;;------------------------------------------------------------------------------------
-;;; Conditions
-;;;------------------------------------------------------------------------------------
-
-(define-condition template-not-found-error (error) 
-  (
-   (template-path
-    :initarg :path
-    :reader template-path
-    )
-   )
-  (:report (lambda (condition stream)
-             (format stream "Could not find template ~a~%."
-                     (template-path condition)
-		     )
-	     )
-	   )
-  )
-
-;;;------------------------------------------------------------------------------------
-;;; Templates
-;;;------------------------------------------------------------------------------------
-
-(defclass template ()
-  (
-   (path
-    :initarg :path
-    :reader template-path
-    )
-   (provider
-    :initarg :provider
-    :accessor template-provider
-    )
-   (libraries
-    :initform nil
-    :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
-	)
-    )
-  )
-
-(defgeneric template-tags-expiredp (tmpl)
-  (:documentation "Return t if any of the known required tag libraries
-   used in the template have expired; nil otherwise"
-		  )
-  (:method ( (tmpl template) )
-    (find-if #'(lambda (library-name) 
-		 (let (
-		       (library (find-cached-tag-library library-name))
-		       )
-		   (if library
-		       (tag-library-expiredp (hh-web::find-cached-tag-library library-name) )
-		       t
-		       )
-		   )
-		 )
-	     (hh-web::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) )
-	  )
-      )
-    )
-  )
-
-;;;------------------------------------------------------------------------------------
-;;; 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"
-		  )
-  (:method ( tmpl (provider template-provider)  )
-    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"
-		  )
-  )
-
-; -- Helper and framework functions
-
-(defun process-directive (expr)
-  "Useful for pre-processing specific expressions as directives inside a template;
-  returns nil if the expression is *not* a directive--returns t if the expr
-  should be regarded as a directive and discarded"
-  (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
-      )
-  )
-
-(defgeneric read-template-definition (input-stream template-package template-args template-keyword-args)
-  (: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
-      (dolist (arg template-args)
-	(import arg template-package)
-	)
-      (dolist (kwarg template-keyword-args)
-	(import kwarg template-package)
-	)
-					; setup template package for use
-      (use-package 'cl template-package)
-      (use-package 'cl-user template-package)
-      (use-package 'hh-web template-package)
-					; read template
-      (loop 
-	 while (listen input-stream)
-	 for expr = (read input-stream) then (read input-stream)
-	 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)
-      )
-    )
-  )
-
-(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*) )
-	   (found-template-definition (when 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*) )
-	  )
-      )
-    )
-  )
-
-(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
-			       )
-	    )
-	   (*package (template-package *template*))
-	   (definition (eval `(lambda (,@template-args ,@(if template-keyword-args `(&key ,@template-keyword-args)) )
-				,@(or (load-template-definition *template* template-path)
-				      `( 
-					(error 'template-not-found-error :path ,template-path) 
-					)
-				      )
-			       )
-		      )
-	    )
-	  )
-      (setf (definition-of *template*) definition)
-      (setf (gethash template-path *template-cache*) *template*)
-      *template*
-      )
-    )
-  )
-
-(defun flush-template (template-path cached-template)
-  "Safely a cached template, typically for reloading"
-  ;; remove the template from the cache
-  (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))
-    )
-  )
-
-(defun find-cached-template (template-path)
-  (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
-	    )
-	)
-    )
-  )
-
-;; -------- File-based template provider ---------------------
-;; 
-;;  Generalized definitions designed to aid any 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")
-)
-
-(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 /."
-		  )
-  )
-
-(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
-	   )
-      (merge-pathnames (make-pathname :directory (pathname-directory template-path)
-				      :name (pathname-name template-path)
-				      :type (pathname-type template-path)
-				      ) 
-		       (make-pathname :host (pathname-host 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)) )
-      )
-    )
-  )
-
-; -- 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) )
-	)
-    (timestamp> (template-file-modified-time full-path provider)
-		(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) )
-	)
-    (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*)
-				)
-      )
-    )
-  )
-
-;; -------- Folder provider ---------------------
-;; 
-;;  provides templates in individual files of a specified 
-;;  folder on the filesystem
-
-(defclass folder-template-provider (file-based-template-provider)
-  (
-   (folder
-    :initarg :folder
-    :accessor folder-of
-    )
-   )
-)
-
-(defmethod template-provider-base-directory ( (provider folder-template-provider) )
-  (folder-of provider)
-  )
-
-(defun create-folder-template-provider (folder)
-  (make-instance 'folder-template-provider :folder folder)
-  )
-
-;; -------- ASDF system provider ---------------------
-;; 
-;;  Services for templates a "templates" folder using 
-;;  asdf:system-relative-pathname and the indicated system, and provides
-;;  templates in individual files from any of those locations
-;;
-
-(defclass asdf-system-provider (file-based-template-provider)
-  (
-   (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")) )
-  )
-
-(defun create-asdf-system-template-provider (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) )
-	)
-    (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*)
-		  )
-      )
-    )
-  )
-
-(defmethod load-template-from-provider ( (*template* template) template-path (provider asdf-system-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 declaration
-;;;
-;;;  Templates can have arguments, both positional and keyword.  It is important
-;;;  that these argument lists have no specializers or other qualifiers (such as 
-;;;  default values), as the same lists will be used both to declare arguments to 
-;;;  the template invocation macro and to pass values to the template's definition 
-;;;  function.
-;;;
-;;;------------------------------------------------------------------------------------
-
-(defmacro deftemplate (name
-		       path
-		       &key
-		       ((:args template-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
-     ;; doing this so that a "reload" later can find all the templates to reload
-     (load-template ,path (quote ,template-args) (quote ,template-keyword-args) )
-
-     ;; create a macro to invoke the template
-     (defmacro ,name (,@template-args ,@(if template-keyword-args `(&key ,@template-keyword-args)) )
-       (let (
-	     (path (quote ,path) )
-	     (template-args (quote ,template-args) )
-	     (template-arg-values (list ,@template-args) )
-	     (template-keyword-args (quote ,template-keyword-args) )
-	     )
-	 `(let (
-		(tmpl (or (find-cached-template ,path) 
-			  (load-template ,path (quote ,template-args) (quote ,template-keyword-args) )
-			  )
-		  )
-		)
-	    (when tmpl
-	      (let ((*template* tmpl)
-		    (*package* (template-package tmpl)))
-		(funcall (definition-of tmpl) ,@template-arg-values ,@template-keyword-args))
-	      )
-	    )
-	 )
-       )
-     )
-  )
-
-(defun local-template-provider-registry-symbol () 
-  "Returns a symbol in the current package for storing the template provider registry expected by the package"
-  (intern "*PACKAGE-TEMPLATE-PROVIDER-REGISTRY*" *package*) 
-  )
-
-(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*) 
-  )
-
-(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) )
-	)
-    `(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 ) ) ;; always here by default
-			 )
-	       )
-	 )
-
-       (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 ) ) ;; always here by default
-		       ) 
-	     )
-       )
-
-       (let (
-	     (*tag-library-provider-registry* ,tag-library-provider-registry)
-	     (*template-provider-registry* ,template-provider-registry)
-	     )
-	 ,@(mapcar (lambda (template)
-		     `(deftemplate ,@template)
-		     )
-		   templates
-		   )
-	 )
-     )
-  )
-  )
-
-;;;------------------------------------------------------------------------------------
-;;;  Tag library use in templates
-;;;
-;;;  Used at top of template files; modifies the template's package (actually, *package*)
-;;;  to use the tag library's package.
-;;;
-
-(defun +tag-library (library-name)
-  "Find the tag-library (if possible), and import it into the
-   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
-  )