Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
152 lines (119 sloc) 5.56 KB
;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: X-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 #:x-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 :x-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))))