Loose changes

sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/specials.lisp

@@ -0,0 +1,151 @@
+;;; -*- 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))))