Initial commit. Fork HTML-Template

CHANGELOG

@@ -0,0 +1,66 @@
+Version 0.9.1
+2007-11-16
+Fixed bug in SKIP-LEADING-WHITESPACE (thanks to Chaitanya Gupta)
+
+Version 0.9.0
+2007-03-09
+Hand down external format to included files (suggested by Igor Plekhov)
+
+Version 0.8.0
+2006-12-12
+Added TMPL_CALL (thanks to Marijn Haverbeke)
+
+Version 0.7.0
+2006-09-30
+Added TMPL_REPEAT
+
+Version 0.6.0
+2006-09-14
+Changed default for *VALUE-ACCESS-FUNCTION*
+Added *STRING-MODIFIER*	
+Added ESCAPE-xxx functions (from CL-WHO)
+Fixed docs for hyperdoc support
+General documentation enhancements
+Fixed test.lisp w.r.t. *FORMAT-NON-STRINGS*	
+
+Version 0.5.0
+2006-09-08
+Added *FORMAT-NON-STRINGS*
+
+Version 0.4.0
+2006-04-03
+Added TMPL_UNLESS (requested by Igor Plekhov)
+
+Version 0.3.1
+2005-08-05
+Introduced *FORCE-DEFAULT*
+
+Version 0.3.0
+2005-07-03
+Introduced *TEMPLATE-OUTPUT* so template printers don't interfer with *STANDARD-OUTPUT* (proposed by Norman Werner)
+Small enhancements to docs
+
+Version 0.2.0
+2005-06-09
+Added :DO-NOT-CACHE option to CREATE-TEMPLATE-PRINTER
+Added clever DEFMETHOD trick by Peter Seibel
+Fixed bug in READ-UNTIL which doesn't affect HTML-TEMPLATE
+Better example in docs inspired by Bruce R. Lewis' critique on lisp-web
+Mention asdf-install in docs
+Added hyperdoc support
+Added :HTML-TEMPLATE to *FEATURES*
+
+Version 0.1.2
+2003-07-15
+Argh, typo in index.html... :(
+
+Version 0.1.1
+2003-07-15
+Cleaner use of restarts thanks to James Anderson and Kent M. Pitman
+Updated docs accordingly (removed stuff about OTHER-VALUE)
+Removed ECL specific stuff (no longer necessary due to recent ECL fixes by Juan Jose Garcia Ripoll)
+Corrected date of 0.1.0 release in CHANGELOG (don't laugh!)
+
+Version 0.1.0
+2003-07-15
+Initial release

INSTALLATION

@@ -0,0 +1,33 @@
+Installation of HTML-TEMPLATE
+
+1. Probably the easiest way is
+
+     (load "/path/to/html-template/load.lisp")
+
+   This should compile and load HTML-TEMPLATE on most Common Lisp
+   implementations.
+
+2. With MK:DEFSYSTEM you can make a symlink from 'html-template.system'
+   to your central registry and then issue the command
+
+     (mk:compile-system "html-template")
+
+   Note that this relies on TRUENAME returning the original file a
+   symbolic link is pointing to. With AllegroCL 6.2 this will only
+   work if you've applied all patches with (SYS:UPDATE-ALLEGRO).
+
+3. You can also use ASDF instead of MK:DEFSYSTEM in a similar way:
+
+     (asdf:operate 'asdf:compile-op :html-template)
+     (asdf:operate 'asdf:load-op :html-template)
+
+After installing HTML-TEMPLATE you can LOAD the file "test.lisp" to
+check if everything works as expected.
+
+Complete documentation for HTML-TEMPLATE can be found in the 'doc'
+directory.
+
+HTML-TEMPLATE also supports Nikodemus Siivola's HYPERDOC, see
+<http://common-lisp.net/project/hyperdoc/> and
+<http://www.cliki.net/hyperdoc>.
+

api.lisp

@@ -0,0 +1,160 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HTML-TEMPLATE; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/html-template/api.lisp,v 1.22 2007/03/09 13:09:16 edi Exp $
+
+;;; Copyright (c) 2003-2007, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package #:html-template)
+
+(defgeneric create-template-printer (template
+                                     &key force
+                                          element-type
+                                          if-does-not-exist
+                                          external-format)
+  (:documentation "Creates a template printer from TEMPLATE which is
+an open input stream, a string, or a pathname.  If FORCE is true a
+printer will be newly created no matter what the state of the cache
+is.  If FORCE is :DO-NOT-CACHE the newly created printer won't be
+cached.  Other keyword arguments will be given to WITH-OPEN-FILE.
+Keyword arguments will only be accepted if TEMPLATE is a PATHNAME."))
+
+(defmethod create-template-printer ((input-stream stream) &rest rest)
+  (when rest
+    (signal-template-invocation-error
+     "This method doesn't accept keyword arguments"))
+  (let ((*standard-input* input-stream))
+    (%create-template-printer-aux nil nil)))
+
+(defmethod create-template-printer ((string string) &rest rest)
+  (when rest
+    (signal-template-invocation-error
+     "This method doesn't accept keyword arguments"))
+  (with-input-from-string (*standard-input* string)
+    (%create-template-printer-aux nil nil)))
+
+(defmethod create-template-printer ((pathname pathname)
+                                    &key (force *force-default*)
+                                         (element-type #-:lispworks 'character
+                                                       #+:lispworks 'lw:simple-char)
+                                         (if-does-not-exist :error)
+                                         (external-format *external-format*))
+  (let* ((merged-pathname (merge-pathnames pathname
+                                           *default-template-pathname*))
+         (file-write-date (or *no-cache-check*
+                              (file-write-date merged-pathname))))
+    (destructuring-bind (hashed-printer . creation-date)
+        ;; see if a printer for this pathname is in the cache
+        (or (gethash merged-pathname *printer-hash*)
+            '(nil . nil))
+      (when (and hashed-printer
+                 ;; and if we may use it
+                 (not force)
+                 ;; and if it's not too old (or maybe we don't have to
+                 ;; check)
+                 (or *no-cache-check*
+                     (and file-write-date
+                          (<= file-write-date creation-date))))
+        (return-from create-template-printer hashed-printer))
+      (let ((new-printer
+              ;; push this pathname onto stack of included files (so
+              ;; to say) to make sure a file can't include itself
+              ;; recursively
+              (let ((*included-files* (cons merged-pathname
+                                            *included-files*))
+                    (*external-format* external-format))
+                (with-open-file (*standard-input* merged-pathname
+                                 :direction :input
+                                 :if-does-not-exist if-does-not-exist
+                                 :element-type element-type
+                                 :external-format external-format)
+                  (%create-template-printer-aux nil nil)))))
+        ;; cache newly created printer (together with current time)
+        (unless (eq force :do-not-cache)
+          (setf (gethash merged-pathname *printer-hash*)
+                  (cons new-printer (get-universal-time))))
+        ;; optionally issue a warning
+        (when *warn-on-creation*
+          (warn "New template printer for ~S created" merged-pathname))
+        new-printer))))
+
+(defgeneric fill-and-print-template (template/printer values
+                                     &key stream
+                                     &allow-other-keys)
+  (:documentation "Fills the template denoted by TEMPLATE/PRINTER with
+VALUES and print it to STREAM. If TEMPLATE/PRINTER is a function uses
+it as if it were a template printer, otherwise creates a printer \(or
+pull one out of the cache) with CREATE-TEMPLATE-PRINTER. Optional
+keyword arguments are given to CREATE-TEMPLATE printer and can only be
+used if TEMPLATE/PRINTER is a pathname."))
+
+(defmethod fill-and-print-template ((function function) values
+                                    &rest rest
+                                    &key (stream *default-template-output*))
+  (remf rest :stream)
+  (when rest
+    (signal-template-invocation-error
+     "This method doesn't accept keyword arguments other than STREAM"))
+  (let ((*template-output* stream))
+    (funcall function values)))
+
+(defmethod fill-and-print-template ((string string) values
+                                    &rest rest
+                                    &key (stream *default-template-output*))
+  (remf rest :stream)
+  (when rest
+    (signal-template-invocation-error
+     "This method doesn't accept keyword arguments other than STREAM"))
+  (let ((*template-output* stream))
+    (funcall (create-template-printer string) values)))
+
+(defmethod fill-and-print-template ((input-stream stream) values
+                                    &rest rest
+                                    &key (stream *default-template-output*))
+  (remf rest :stream)
+  (when rest
+    (signal-template-invocation-error
+     "This method doesn't accept keyword arguments other than STREAM"))
+  (let ((*template-output* stream))
+    (funcall (create-template-printer input-stream) values)))
+
+(defmethod fill-and-print-template ((pathname pathname) values
+                                    &rest rest
+                                    &key (stream *default-template-output*))
+  (remf rest :stream)
+  (let ((*template-output* stream))
+    (funcall (apply #'create-template-printer pathname rest) values)))
+
+(defun clear-template-cache ()
+  "Complete clears all template printers from the cache."
+  (clrhash *printer-hash*)
+  (values))
+
+(defun delete-from-template-cache (pathname)
+  "Deletes the template printer denoted by PATHNAME from the
+cache. Returns true if such a printer existed, false otherwise."
+  (remhash (merge-pathnames pathname
+                            *default-template-pathname*)
+           *printer-hash*))