151 lines
5.5 KiB
Common Lisp
151 lines
5.5 KiB
Common Lisp
;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HTML-TEMPLATE; Base: 10 -*-
|
|
;;; $Header: /usr/local/cvsrep/html-template/specials.lisp,v 1.24 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)
|
|
|
|
(defvar *find-string-hash* (make-hash-table :test #'equal)
|
|
"Hash tables used internally by READ-UNTIL to cache offset arrays.")
|
|
|
|
(defvar *template-start-marker* "<!--"
|
|
"The string template tags must start with")
|
|
(defvar *template-end-marker* "-->"
|
|
"The string template tags must end with")
|
|
|
|
(defvar *printer-hash* (make-hash-table :test #'equal)
|
|
"The cache for template printers.
|
|
Each entry is of the form (PRINTER . WRITE-DATE).")
|
|
|
|
(defvar *default-template-pathname* (make-pathname)
|
|
"Each pathname is merged with this value before it is used by
|
|
CREATE-TEMPLATE-PRINTER.")
|
|
|
|
(defvar *default-template-output* *standard-output*
|
|
"The output stream used by FILL-AND-PRINT-TEMPLATE when no STREAM
|
|
keyword was provided.")
|
|
|
|
(defvar *template-output* nil
|
|
"The output stream that's used internally.")
|
|
|
|
(defvar *convert-nil-to-empty-string* t
|
|
"Controls whether NIL values should resolve to empty strings or
|
|
raise an error.")
|
|
|
|
(defvar *format-non-strings* t
|
|
"Controls whether TMPL_VAR will accept values which aren't
|
|
strings and convert them using \(FORMAT NIL \"~A\" ...).")
|
|
|
|
(defvar *sequences-are-lists* t
|
|
"Controls whether TMPL_LOOP printers expect lists or vectors.")
|
|
|
|
(defvar *upcase-attribute-strings* t
|
|
"Controls whether attribute strings associated with template tags
|
|
are upcased before they are interned.")
|
|
|
|
(defvar *no-cache-check* nil
|
|
"Controls whether the FILE-WRITE-DATE check will be circumvented
|
|
when using FILL-AND-PRINT-TEMPLATE.")
|
|
|
|
(defvar *template-symbol-package* (find-package '#:keyword)
|
|
"The package symbols are interned into.")
|
|
|
|
(defvar *ignore-empty-lines* nil
|
|
"Controls whether template tags on their own lines produce empty
|
|
lines or not.")
|
|
|
|
(defvar *warn-on-creation* t
|
|
"Controls whether a warning should be signaled if a new template
|
|
printer is created from a pathname argument.")
|
|
|
|
(defvar *current-line* 1
|
|
"Internal line counter of the parser.")
|
|
(defvar *current-column* 0
|
|
"Internal column counter of the parser.")
|
|
|
|
(defvar *included-files* nil
|
|
"Internally used by CREATE-TEMPLATE-PRINTER-AUX to avoid infinite
|
|
TMPL_INCLUDE loops.")
|
|
|
|
(defvar *external-format* :default
|
|
"The external format used when opening files.")
|
|
|
|
(defvar *value-access-function*
|
|
(lambda (symbol values &optional in-loop-p)
|
|
(let ((result (getf values symbol)))
|
|
(cond ((and in-loop-p *sequences-are-lists*)
|
|
(loop for element in result
|
|
when (and element (listp element))
|
|
;; keep values from upper levels
|
|
collect (append element values)
|
|
else
|
|
collect element))
|
|
(t result))))
|
|
"The function which associates \(attribute) symbols with their
|
|
values.")
|
|
|
|
(defvar *call-template-access-function* #'car
|
|
"Accessor function for extracting the called template from a
|
|
TMPL_CALL form.")
|
|
|
|
(defvar *call-value-access-function* #'cdr
|
|
"Accessor function for extracting the values from a TMPL_CALL
|
|
form.")
|
|
|
|
(defvar *force-default* nil
|
|
"The default value for the FORCE keyword argument to
|
|
CREATE-TEMPLATE-PRINTER.")
|
|
|
|
(defvar *string-modifier* 'escape-string-iso-8859-1
|
|
"The function which is applied to strings which replace
|
|
TMPL_VAR tags. Use #'CL:IDENTITY if you don't want to change the
|
|
strings.")
|
|
|
|
(defparameter *escape-char-p*
|
|
#'(lambda (char)
|
|
(or (find char "<>&'\"")
|
|
(> (char-code char) 127)))
|
|
"Used by ESCAPE-STRING to test whether a character should be escaped.")
|
|
|
|
;; stuff for Nikodemus Siivola's HYPERDOC
|
|
;; see <http://common-lisp.net/project/hyperdoc/>
|
|
;; and <http://www.cliki.net/hyperdoc>
|
|
;; also used by LW-ADD-ONS
|
|
|
|
(defvar *hyperdoc-base-uri* "http://weitz.de/html-template/")
|
|
|
|
(let ((exported-symbols-alist
|
|
(loop for symbol being the external-symbols of :html-template
|
|
collect (cons symbol
|
|
(concatenate 'string
|
|
"#"
|
|
(string-downcase symbol))))))
|
|
(defun hyperdoc-lookup (symbol type)
|
|
(declare (ignore type))
|
|
(cdr (assoc symbol
|
|
exported-symbols-alist
|
|
:test #'eq))))
|