← Back to branch summary

~ubuntu-branches/ubuntu/gutsy/vnc4/gutsy

« back to all changes in this revision

Viewing changes to unix/xc/programs/xedit/lisp/modules/progmodes/html.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Ola Lundqvist
  • Date: 2006-05-15 20:35:17 UTC
  • mfrom: (1.1.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20060515203517-l4lre1ku942mn26k
Tags: 4.1.1+X4.3.0-10
* Correction of critical security issue. Thanks to Martin Kogler
  <e9925248@student.tuwien.ac.at> that informed me about the issue,
  and provided the patch.
  This flaw was originally found by Steve Wiseman of intelliadmin.com.
* Applied patch from Javier Kohen <jkohen@users.sourceforge.net> that
  inform the user that only 8 first characters of the password will
  actually be used when typing more than 8 characters, closes:
  #355619.

Show diffs side-by-side

added added

removed removed

Lines of Context:
unix/xc/programs/xedit/lisp/modules/progmodes/html.lsp
 
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.3 2002/10/06 17:11:48 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
)