specials.lisp 1 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package:CL-WHO; Base: 10 -*-
2 ;;; $Header: /usr/local/cvsrep/cl-who/specials.lisp,v 1.6 2009/01/26 11:10:49 edi Exp $
3
4 ;;; Copyright (c) 2003-2009, Dr. Edmund Weitz. All rights reserved.
5
6 ;;; Redistribution and use in source and binary forms, with or without
7 ;;; modification, are permitted provided that the following conditions
8 ;;; are met:
9
10 ;;; * Redistributions of source code must retain the above copyright
11 ;;; notice, this list of conditions and the following disclaimer.
12
13 ;;; * Redistributions in binary form must reproduce the above
14 ;;; copyright notice, this list of conditions and the following
15 ;;; disclaimer in the documentation and/or other materials
16 ;;; provided with the distribution.
17
18 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
19 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
20 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
21 ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
22 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
23 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
24 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
25 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
26 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
27 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
28 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
29
30 (in-package :cl-who)
31
32 #+:sbcl
33 (defmacro defconstant (name value &optional doc)
34 "Make sure VALUE is evaluated only once \(to appease SBCL)."
35 `(cl:defconstant ,name (if (boundp ',name) (symbol-value ',name) ,value)
36 ,@(when doc (list doc))))
37
38 (defvar *prologue*
39 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"
40 "This is the first line that'll be printed if the :PROLOGUE keyword
41 argument is T")
42
43 (defvar *escape-char-p*
44 (lambda (char)
45 (or (find char "<>&'\"")
46 (> (char-code char) 127)))
47 "Used by ESCAPE-STRING to test whether a character should be escaped.")
48
49 (defvar *indent* nil
50 "Whether to insert line breaks and indent. Also controls amount of
51 indentation dynamically.")
52
53 (defvar *html-mode* :xml
54 ":SGML for \(SGML-)HTML, :XML \(default) for XHTML, :HTML5 for HTML5.")
55
56 (defvar *downcase-tokens-p* t
57 "If NIL, a keyword symbol representing a tag or attribute name will
58 not be automatically converted to lowercase. This is useful when one
59 needs to output case sensitive XML.")
60
61 (defvar *attribute-quote-char* #\'
62 "Quote character for attributes.")
63
64 (defvar *empty-tag-end* " />"
65 "End of an empty tag. Default is XML style.")
66
67 (defvar *html-no-indent-tags*
68 '(:pre :textarea)
69 "The list of HTML tags that should disable indentation inside them. The initial
70 value is a list containing only :PRE and :TEXTAREA.")
71
72 (defvar *html-empty-tags*
73 '(:area
74 :atop
75 :audioscope
76 :base
77 :basefont
78 :br
79 :choose
80 :col
81 :command
82 :embed
83 :frame
84 :hr
85 :img
86 :input
87 :isindex
88 :keygen
89 :left
90 :limittext
91 :link
92 :meta
93 :nextid
94 :of
95 :over
96 :param
97 :range
98 :right
99 :source
100 :spacer
101 :spot
102 :tab
103 :track
104 :wbr)
105 "The list of HTML tags that should be output as empty tags.
106 See *HTML-EMPTY-TAG-AWARE-P*.")
107
108 (defvar *html-empty-tag-aware-p* t
109 "Set this to NIL to if you want to use CL-WHO as a strict XML
110 generator. Otherwise, CL-WHO will only write empty tags listed
111 in *HTML-EMPTY-TAGS* as <tag/> \(XHTML mode) or <tag> \(SGML
112 mode and HTML5 mode). For all other tags, it will always generate
113 <tag></tag>.")
114
115 (defconstant +newline+ (make-string 1 :initial-element #\Newline)
116 "Used for indentation.")
117
118 (defconstant +spaces+ (make-string 2000
119 :initial-element #\Space
120 :element-type 'base-char)
121 "Used for indentation.")
122