2
;; Copyright (c) 2002 by The XFree86 Project, Inc.
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:
11
;; The above copyright notice and this permission notice shall be included in
12
;; all copies or substantial portions of the Software.
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
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
27
;; Author: Paulo César Pereira de Andrade
30
;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/sgml.lsp,v 1.2 2002/10/06 17:11:48 paulo Exp $
36
;; Default property the text is shown.
37
(defsynprop *prop-sgml-default*
39
:font "-*-helvetica-medium-r-*-*-12-*-*-*-*-*-*-1"
43
(defsynprop *prop-sgml-default-short*
45
:font "-*-helvetica-medium-r-*-*-12-*-*-*-*-*-*-1"
51
(defsynprop *prop-sgml-sect*
53
:font "-*-helvetica-bold-r-*-*-17-*-*-*-*-*-*-1"
57
;; Monospaced property.
58
(defsynprop *prop-sgml-tt*
60
:font "-*-courier-medium-r-*-*-12-*-*-*-*-*-*-1"
65
(defsynprop *prop-sgml-it*
67
:font "-*-helvetica-medium-o-*-*-12-*-*-*-*-*-*-1"
71
;; Bold font property.
72
(defsynprop *prop-sgml-bf*
74
:font "-*-helvetica-bold-r-*-*-12-*-*-*-*-*-*-1"
78
;; Looks like a link...
79
(defsynprop *prop-sgml-link*
81
:font "-*-helvetica-medium-r-*-*-12-*-*-*-*-*-*-1"
86
;; Monospaced, also looks like a link...
87
(defsynprop *prop-sgml-email*
89
:font "-*-courier-medium-r-*-*-12-*-*-*-*-*-*-1"
94
;; Another monospaced property,
95
(defsynprop *prop-sgml-screen*
97
:font "-*-fixed-*-*-*-*-*-*-*-*-*-*-*-1"
101
(defsynprop *prop-sgml-maybe-entity*
103
:font "*lucidatypewriter-medium-r*-12-*"
104
:foreground "VioletRed4"
105
:background "LightYellow"
108
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
109
;; The macros sgml-syntoken and sgml-syntable allows creating rules for
110
;; matching text inside tags in the format:
111
;; <tag> or <tag arg=value> or <tag arg1=value ... argn=value>
114
;; The generated rules don't allow things like: < tag> or </tag >
116
;; This could also be done as a normal definition, with a starting rule like:
117
;; "<(tag1|tag2|tag3)\\>"
118
;; and an ending rule like:
119
;; "</(tag1|tag2|tag3)>"
120
;; But is implemented in way that will fail on purpose for things like:
121
;; <tag1>any text</tag3></tag1>
123
;; NOTE: These definitions aren't cheap in the time required to process the
124
;; file, and are just adaptations/tests with the syntax-highlight code,
125
;; probably it is better to avoid using it in other syntax definitions.
126
;; NOTE2: It cannot be defined as a single macro because it is required to
127
;; generate 2 entries in the main SGML syntax highlight definition,
128
;; or, should generate the entire definition from a macro; you will
129
;; need to type the tag name twice, but shouldn't be a problem if
130
;; you are using sgml :-)
131
;; XXX: Maybe the syntax-highlight code could save the starting match and
132
;; apply a regex generated at run-time to check for the ending tag,
133
;; but this probably would make the parser too slow, better to have
134
;; a specialized parser if that is required...
135
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
136
(defmacro sgml-syntoken (name)
137
`(syntoken (string-concat "<" ,name "\\>")
140
:begin (intern (string-concat ,name "$") 'keyword))
142
(defmacro sgml-syntable (name property)
145
(label (intern (string-concat ,name "$") 'keyword))
146
(nested-label (intern (string (gensym)) 'keyword))
148
(syntable label *prop-preprocessor* nil
149
;; tag is still open, process any options
150
(synaugment :generic-tag)
153
:property *prop-preprocessor*
155
;; Generate a nested table that includes everything, and only
156
;; returns when the closing tag is found.
157
(syntable nested-label ,property nil
158
(syntoken (string-concat "</" ,name ">")
161
:property *prop-preprocessor*
168
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
169
;; Generate tokens for tags that don't require and ending tag.
170
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
171
(defmacro sgml-syntable-simple (name property)
174
(label (intern (string-concat ,name "$") 'keyword))
175
(nested-label (intern (string (gensym)) 'keyword))
177
(syntable label *prop-preprocessor* nil
178
;; tag is still open, process any options
179
(synaugment :generic-tag)
182
:property *prop-preprocessor*
184
;; Generate a nested table that finishes whenever an unmatched
185
;; start or end tag is found.
186
(syntable nested-label ,property nil
191
:begin :simple-nested-tag)
192
;; These will take precedence over other rules
197
:begin :simple-nested-tag)
201
:property *prop-preprocessor*
208
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
209
;; Define some macros to generate tokens for tags in the format:
211
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
212
(defmacro sgml-syntoken-short (name)
213
`(syntoken (string-concat "<" ,name "/")
215
:property *prop-preprocessor*
216
:begin (intern (string-concat ,name "/") 'keyword))
218
(defmacro sgml-syntable-short (name property)
219
`(syntable (intern (string-concat ,name "/") 'keyword) ,property nil
222
:property *prop-preprocessor*
225
:property *prop-control*
231
;; The main SGML syntax table
232
(defsyntax *sgml-mode* :main *prop-sgml-default* nil nil
238
(syntable :comment *prop-comment* nil
239
;; Only one rule, to finish the comment.
246
(syntoken "&[a-zA-Z0-9_.-]+;"
247
:property *prop-constant*)
248
;; Probably an entity, missing ending `;'
249
(syntoken "&[a-zA-Z0-9_.-]+"
250
:property *prop-sgml-maybe-entity*)
253
(syntable :string *prop-string* nil
254
;; Ignore escaped characters.
256
;; Rule to finish the string.
263
(syntable :link *prop-preprocessor* nil
264
;; No link string following "url="
267
:property *prop-control*
273
(syntable :link-string *prop-sgml-link* nil
274
;; Ignore escaped characters.
276
;; Rule to finish the link, note that returns two levels.
288
;; Rules for "special" tags
289
(syntable :special-tag *prop-preprocessor* nil
292
:property *prop-preprocessor*
294
;; Finish the "special" tag
298
(syntable :brackets *prop-sgml-default* nil
301
:property *prop-preprocessor*
306
:property *prop-preprocessor*
309
(syntoken "%[a-zA-Z0-9_.-]+;?"
310
:property *prop-annotation*)
311
;; Allow everything inside the brackets
314
;; Don't use generic tag tokens, only create a rule for strings
319
;; Allow everything inside the "special" tag
324
(sgml-syntoken-short "tt")
325
(sgml-syntable-short "tt" *prop-sgml-tt*)
326
(sgml-syntoken-short "it")
327
(sgml-syntable-short "it" *prop-sgml-it*)
328
(sgml-syntoken-short "bf")
329
(sgml-syntable-short "bf" *prop-sgml-bf*)
330
(sgml-syntoken-short "em")
331
(sgml-syntable-short "em" *prop-sgml-bf*)
335
:property *prop-preprocessor*
337
(syntable :short-tag *prop-sgml-default-short* nil
340
:property *prop-preprocessor*
343
:property *prop-control*
347
;; Don't allow spaces, this may and may not be the start of a tag,
348
;; but the syntax-highlight definition is not specialized...
349
(syntoken "<([^/a-zA-Z]|$)"
350
:property *prop-control*)
352
;; Some tags that require an end tag
354
(sgml-syntable "tt" *prop-sgml-tt*)
355
(sgml-syntoken "code")
356
(sgml-syntable "code" *prop-sgml-tt*)
357
(sgml-syntoken "tag")
358
(sgml-syntable "tag" *prop-sgml-tt*)
359
(sgml-syntoken "verb")
360
(sgml-syntable "verb" *prop-sgml-tt*)
361
(sgml-syntoken "programlisting")
362
(sgml-syntable "programlisting" *prop-sgml-tt*)
364
(sgml-syntable "it" *prop-sgml-it*)
366
(sgml-syntable "bf" *prop-sgml-bf*)
368
(sgml-syntable "em" *prop-sgml-bf*)
369
(sgml-syntoken "mail")
370
(sgml-syntable "mail" *prop-sgml-email*)
371
(sgml-syntoken "email")
372
(sgml-syntable "email" *prop-sgml-email*)
373
(sgml-syntoken "screen")
374
(sgml-syntable "screen" *prop-sgml-screen*)
375
(sgml-syntoken "tscreen")
376
(sgml-syntable "tscreen" *prop-sgml-screen*)
379
;; Helper for tags that don't need an ending one.
380
;; NOTE: Since the parser is not specialized, if the tag is
381
;; folowed by one that has a special property defined here,
382
;; it may not be detected, i.e. put a <p> after the <sect>
384
(syntable :simple-nested-tag *prop-preprocessor* nil
385
;; tag is still open, process any options
386
(synaugment :generic-tag)
389
:property *prop-preprocessor*
392
(sgml-syntoken "sect")
393
(sgml-syntable-simple "sect" *prop-sgml-sect*)
394
(sgml-syntoken "sect1")
395
(sgml-syntable-simple "sect1" *prop-sgml-sect*)
396
(sgml-syntoken "sect2")
397
(sgml-syntable-simple "sect2" *prop-sgml-sect*)
404
;; Table :generic-tag is defined to be augmented, no rule to finish it.
405
(syntable :generic-tag *prop-preprocessor* nil
418
:property *prop-control*)
420
(syntable :tag *prop-preprocessor* nil
425
;; Import generic definitions
426
(synaugment :generic-tag)
added
removed
xedit/lisp/modules/progmodes/sgml.lsp
