1;;
2;; Copyright (c) 2002 by The XFree86 Project, Inc.
3;;
4;; Permission is hereby granted, free of charge, to any person obtaining a
5;; copy of this software and associated documentation files (the "Software"),
6;; to deal in the Software without restriction, including without limitation
7;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
8;; and/or sell copies of the Software, and to permit persons to whom the
9;; Software is furnished to do so, subject to the following conditions:
10;;
11;; The above copyright notice and this permission notice shall be included in
12;; all copies or substantial portions of the Software.
13;;
14;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
17;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
18;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
19;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
20;; SOFTWARE.
21;;
22;; Except as contained in this notice, the name of the XFree86 Project shall
23;; not be used in advertising or otherwise to promote the sale, use or other
24;; dealings in this Software without prior written authorization from the
25;; XFree86 Project.
26;;
27;; Author: Paulo César Pereira de Andrade
28;;
29;;
30;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/html.lsp,v 1.2 2002/09/22 18:41:27 paulo Exp $
31;;
32
33(require "syntax")
34(in-package "XEDIT")
35
36#|
37  This is not a validation tool for html.
38
39  It is possible to, using macros generate all combinations of text attributes,
40  to properly handle <b>...<i>...</i>...</b> etc, as well as generating macros
41  to automatically closing tags, but for now this file was built to work as an
42  experience with the syntax highlight code.
43|#
44
45(defsynprop *prop-html-default*
46    "default"
47    :font	"-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-1"
48    :foreground	"Gray10")
49
50(defsynprop *prop-html-bold*
51    "bold"
52    :font	"-*-lucida-bold-r-*-*-14-*-*-*-*-*-*-1"
53    :foreground	"Gray15")
54
55(defsynprop *prop-html-italic*
56    "italic"
57    :font	"-*-lucida-medium-i-*-*-14-*-*-*-*-*-*-1"
58    :foreground	"Gray10")
59
60(defsynprop *prop-html-pre*
61    "pre"
62    :font	"-*-courier-medium-r-*-*-14-*-*-*-*-*-*-1"
63    :foreground	"Gray10")
64
65(defsynprop *prop-html-link*
66    "link"
67    :font	"-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-1"
68    :foreground	"Blue"
69    :underline "t")
70
71(defsynprop *prop-html-small*
72    "small"
73    :font	"-*-lucida-medium-r-*-*-10-*-*-*-*-*-*-1"
74    :foreground	"Gray10")
75
76(defsynprop *prop-html-big*
77    "big"
78    :font	"-*-lucida-medium-r-*-*-20-*-*-*-*-*-*-1"
79    :foreground	"Gray15")
80
81(defsynprop *prop-html-name*
82    "name"
83    :font	"-*-lucida-bold-r-*-*-14-*-*-*-*-*-*-1"
84    :foreground	"Black"
85    :background "rgb:e/f/e")
86
87(defsynprop *prop-html-h1*
88    "h1"
89    :font	"-*-lucida-bold-r-*-*-20-*-*-*-*-*-*-1"
90    :foreground	"Gray15")
91
92(defsynprop *prop-html-h2*
93    "h2"
94    :font	"-*-lucida-bold-r-*-*-17-*-*-*-*-*-*-1"
95    :foreground	"Gray15")
96
97(defsynprop *prop-html-h4*
98    "h4"
99    :font	"-*-lucida-bold-r-*-*-12-*-*-*-*-*-*-1"
100    :foreground	"Gray15")
101
102(defsynprop *prop-html-h5*
103    "h5"
104    :font	"-*-lucida-bold-r-*-*-10-*-*-*-*-*-*-1"
105    :foreground	"Gray15")
106
107(defsynprop *prop-html-li*
108    "li"
109    :font	"-*-lucida-bold-r-*-*-8-*-*-*-*-*-*-1"
110    :foreground	"rgb:0/5/0"
111    :underline	t)
112
113(defsynprop *prop-html-hr*
114    "hr"
115    :font	"-*-courier-bold-r-*-*-12-*-*-*-*-*-*-1"
116    :foreground	"rgb:0/5/0"
117    :overstrike	t)
118
119(defsynprop *prop-html-title*
120    "title"
121    :font	"-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-1"
122    :foreground	"Red3"
123    :underline "t")
124
125(defsynprop *prop-html-tag*
126    "tag"
127    :font	"-*-courier-medium-r-*-*-10-*-*-*-*-*-*-1"
128    :foreground	"green4")
129
130(defsynprop *prop-html-string*
131    "string"
132    :font	"-*-lucida-medium-r-*-*-10-*-*-*-*-*-*-1"
133    :foreground	"RoyalBlue2")
134
135(defsynprop *prop-html-comment*
136    "comment"
137    :font	"-*-courier-medium-o-*-*-10-*-*-*-*-*-*-1"
138    :foreground	"SlateBlue3")
139
140(defsynprop *prop-html-entity*
141    "entity"
142    :font	"-*-lucida-medium-r-*-*-12-*-*-*-*-*-*-1"
143    :foreground	"Red4")
144
145(defsynprop *prop-html-unknown*
146    "unknown"
147    :font	"-*-courier-bold-r-*-*-10-*-*-*-*-*-*-1"
148    :foreground	"yellow"
149    :background "red")
150
151(defmacro html-syntoken (name)
152    `(syntoken (string-concat "<" ,name "\\>")
153	:icase t :contained t
154	:begin (intern (string-concat ,name "$") 'keyword)))
155(defmacro html-syntable (name property)
156    `(let
157	((label (intern (string-concat ,name "$") 'keyword))
158	 (nested-label (intern (string (gensym)) 'keyword)))
159	(syntable label *prop-html-tag* nil
160	    (synaugment :generic-tag)
161	    (syntoken ">" :nospec t :property *prop-html-tag* :begin nested-label)
162	    (syntable nested-label ,property nil
163		(syntoken (string-concat "</" ,name ">")
164		    :icase t :nospec t :property *prop-html-tag* :switch -2)
165		(syntoken (string-concat "</" ,name "\\s*$")
166		    :icase t :contained t :begin :continued-end-tag)
167		(synaugment :main)))))
168
169
170(defsyntax *html-mode* :main *prop-html-default* nil nil
171    (syntoken "<!--" :nospec t :contained t :begin :comment)
172    (syntable :comment *prop-html-comment* nil
173	(syntoken "-->" :nospec t :switch -1))
174    (syntoken "&([a-zA-Z0-9_.-]+|#\\x\\x?);?" :property *prop-html-entity*)
175    (syntoken "<li>" :nospec t :icase t :property *prop-html-li*)
176    (syntoken "<hr>" :nospec t :icase t :property *prop-html-hr*)
177
178    (syntoken "<img\\>" :icase t :contained t :begin :tag)
179    (syntoken "<(p|br)>" :icase t :property *prop-html-tag*)
180
181    ;; If in the toplevel, unbalanced!
182    ;; XXX When adding new nested tables, don't forget to update this pattern.
183    (syntoken
184	(string-concat
185	    "</("
186	    "b|strong|i|em|address|pre|code|tt|small|big|a|span|div|"
187	    "h1|h2|h3|h4|h5|title|font|ol|ul|dl|dt|dd|menu"
188	    ")\\>")
189	:icase t :property *prop-html-unknown* :begin :unbalanced)
190    (syntable :unbalanced *prop-html-unknown* nil
191	(syntoken ">" :nospec t :switch :main)
192	(synaugment :generic-tag)
193    )
194
195    #||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
196    ;; XXX ONLY add a rule for "html", "head" and "body" if you want to do a
197    ;; more complete check for common errors. If you add those rules, it will
198    ;; reparse the entire file at every character typed (unless there are
199    ;; errors in which case the parser resets the state).
200    ;; For visualization only that would be OK...
201    ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||#
202
203    (html-syntoken "b")
204    (html-syntable "b" *prop-html-bold*)
205    (html-syntoken "strong")
206    (html-syntable "strong" *prop-html-bold*)
207
208    (html-syntoken "i")
209    (html-syntable "i" *prop-html-italic*)
210    (html-syntoken "em")
211    (html-syntable "em" *prop-html-italic*)
212    (html-syntoken "address")
213    (html-syntable "address" *prop-html-italic*)
214
215    (html-syntoken "pre")
216    (html-syntable "pre" *prop-html-pre*)
217    (html-syntoken "code")
218    (html-syntable "code" *prop-html-pre*)
219    (html-syntoken "tt")
220    (html-syntable "tt" *prop-html-pre*)
221
222    (html-syntoken "small")
223    (html-syntable "small" *prop-html-small*)
224
225    (html-syntoken "big")
226    (html-syntable "big" *prop-html-big*)
227
228    ;; Cannot hack html-syntoken and html-syntable to handle this,
229    ;; as the option to <a may be in the next line.
230    (syntoken "<a\\>" :icase t :contained t :begin :a)
231    (syntable :a *prop-html-tag* nil
232	;; Tag is open
233	(syntoken "\\<href\\>" :icase t :begin :a-href)
234	(syntoken "\\<name\\>" :icase t :begin :a-name)
235	(syntoken "<" :nospec t :property *prop-html-unknown* :switch -2)
236	(synaugment :generic-tag)
237	(syntoken ">" :nospec t :begin :a-generic-text)
238	(syntable :a-href *prop-html-tag* nil
239	    (syntoken ">" :nospec t :begin :a-href-text)
240	    (synaugment :generic-tag)
241	    (syntable :a-href-text *prop-html-link* nil
242		(syntoken "</a>"
243		    :icase t :nospec t :property *prop-html-tag* :switch -3)
244		(syntoken "</a\\s*$" :icase t :begin :continued-nested-end-tag)
245		(synaugment :main)
246	    )
247	)
248	(syntable :a-name *prop-html-tag* nil
249	    (syntoken ">" :nospec t :begin :a-name-text)
250	    (synaugment :generic-tag)
251	    (syntable :a-name-text *prop-html-name* nil
252		(syntoken "</a>"
253		    :icase t :nospec t :property *prop-html-tag* :switch -3)
254		(syntoken "</a\\s*$" :icase t :begin :continued-nested-end-tag)
255		(synaugment :main)
256	    )
257	)
258	(syntable :a-generic-text nil nil
259	    (syntoken "</a>"
260		:icase t :nospec t :property *prop-html-tag* :switch -2)
261	    (syntoken "<a/\\s$" :icase t :begin :continued-end-tag)
262	    (synaugment :main)
263	)
264    )
265
266    ;; Do nothing, just check start/end tags
267    (html-syntoken "ol")
268    (html-syntable "ol" nil)
269    (html-syntoken "ul")
270    (html-syntable "ul" nil)
271    (html-syntoken "dl")
272    (html-syntable "dl" nil)
273    ;; Maybe <dt> and <dd> should be in a special table, to not require
274    ;; and ending tag.
275    ;; XXX Maybe should also add a table for <p>.
276    (html-syntoken "dt")
277    (html-syntable "dt" nil)
278    (html-syntoken "dd")
279    (html-syntable "dd" nil)
280
281    (html-syntoken "span")
282    (html-syntable "span" nil)
283    (html-syntoken "div")
284    (html-syntable "div" nil)
285    (html-syntoken "menu")
286    (html-syntable "menu" nil)
287
288    (html-syntoken "h1")
289    (html-syntable "h1" *prop-html-h1*)
290    (html-syntoken "h2")
291    (html-syntable "h2" *prop-html-h2*)
292    (html-syntoken "h3")
293    (html-syntable "h3" *prop-html-bold*)
294    (html-syntoken "h4")
295    (html-syntable "h4" *prop-html-h4*)
296    (html-syntoken "h5")
297    (html-syntable "h5" *prop-html-h5*)
298    (html-syntoken "title")
299    (html-syntable "title" *prop-html-title*)
300
301    (html-syntoken "font")
302    (html-syntable "font" *prop-control*)
303
304    (syntoken "<" :nospec t :contained t :begin :tag)
305    (syntable :generic-tag *prop-html-tag* nil
306	(syntoken "\"" :nospec t :contained t :begin :string)
307	(syntoken "<" :nospec t :property *prop-html-unknown*)
308    )
309    (syntable :tag *prop-html-tag* nil
310	(syntoken ">" :nospec t :switch -1)
311	(synaugment :generic-tag)
312    )
313	;; Tag ended in a newline, common practice...
314    (syntable :continued-end-tag *prop-html-tag* nil
315	(syntoken ">" :nospec t :switch -3)
316	(synaugment :generic-tag)
317    )
318    (syntable :continued-nested-end-tag *prop-html-tag* nil
319	(syntoken ">" :nospec t :switch -4)
320	(synaugment :generic-tag)
321    )
322
323    (syntable :string *prop-html-string* nil
324	(syntoken "\\\\.")
325	(syntoken "\"" :nospec t :switch -1)
326    )
327)
328