|
0
|
1 ;; Created by: Joe Wells, jbw@csb.bu.edu
|
|
|
2 ;; Created on: Sat Sep 30 17:25:40 1995
|
|
|
3 ;; Filename: w3-parse.el
|
|
|
4 ;; Purpose: Parse HTML and/or SGML for Emacs W3 browser.
|
|
|
5
|
|
2
|
6 ;; Copyright © 1995, 1996 Joseph Brian Wells
|
|
|
7 ;; Copyright © 1993, 1994, 1995 by William M. Perry (wmperry@cs.indiana.edu)
|
|
0
|
8 ;;
|
|
|
9 ;; This program is free software; you can redistribute it and/or modify
|
|
|
10 ;; it under the terms of the GNU General Public License as published by
|
|
|
11 ;; the Free Software Foundation; either version 2 of the License, or
|
|
|
12 ;; (at your option) any later version.
|
|
|
13 ;;
|
|
|
14 ;; This program is distributed in the hope that it will be useful,
|
|
|
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
17 ;; GNU General Public License for more details.
|
|
|
18 ;;
|
|
|
19 ;; You should have received a copy of the GNU General Public License
|
|
|
20 ;; along with this program; if not, write to the Free Software
|
|
|
21 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
22 ;;
|
|
|
23 ;; On November 13, 1995, the license was available at
|
|
|
24 ;; <URL:ftp://prep.ai.mit.edu/pub/gnu/COPYING-2.0>. It may still be
|
|
|
25 ;; obtainable via that URL.
|
|
|
26
|
|
|
27
|
|
|
28 ;;;
|
|
|
29 ;;; Trying to make the best of an evil speed hack.
|
|
|
30 ;;;
|
|
|
31
|
|
|
32 ;; Explanation:
|
|
|
33
|
|
|
34 ;; Basically, this file provides one big function (w3-parse-buffer) and
|
|
|
35 ;; some data structures. However, to avoid code redundancy, I have broken
|
|
|
36 ;; out some common subexpressions of w3-parse-buffer into separate
|
|
|
37 ;; functions. I have declared these separate functions with "defsubst" so
|
|
|
38 ;; they will be inlined into w3-parse-buffer. Also, I have defined them
|
|
|
39 ;; within eval-when-compile forms, so no definitions will be emitted into
|
|
|
40 ;; the .elc file for these separate functions. (They will work normally
|
|
|
41 ;; when the uncompiled file is loaded.)
|
|
|
42
|
|
|
43 ;; Each of these subfunctions use some scratch variables in a purely local
|
|
|
44 ;; fashion. In good software design, I would declare these variables as
|
|
|
45 ;; close to their use as possible with "let". However, "let"-binding
|
|
|
46 ;; variables is *SLOW* in Emacs Lisp, even when compiled. Since each of
|
|
|
47 ;; these functions is executed one or more time during each iteration of
|
|
|
48 ;; the main loop, I deemed this too expensive. So the main function does
|
|
|
49 ;; the "let"-binding of these variables. However, I still want to declare
|
|
|
50 ;; them close to their use, partially to keep the compiler from crying
|
|
|
51 ;; "Wolf!" when there is no danger (well, maybe a little danger :-), so I
|
|
|
52 ;; define some macros for this purpose.
|
|
|
53
|
|
|
54 ;; Also, there are some variables which are updated throughout the file
|
|
|
55 ;; (remember this is really all one function). Some of the code which
|
|
|
56 ;; updates them is located inside the subfunctions. So that the compiler
|
|
|
57 ;; will not complain, these variables are defined with defvar.
|
|
|
58
|
|
|
59 (require 'w3-vars)
|
|
|
60
|
|
|
61 (eval-when-compile
|
|
|
62 (defconst w3-p-s-var-list nil
|
|
|
63 "A list of the scratch variables used by functions called by
|
|
|
64 w3-parse-buffer which it is w3-parse-buffer's responsibility to
|
|
|
65 \"let\"-bind.")
|
|
|
66
|
|
|
67 ;; *** This is unused and does not belong right here anyway.
|
|
|
68 (defmacro w3-resolve-numeric-entity (ent)
|
|
|
69 "Return a string representing the numeric entity ENT (&#ENT;)"
|
|
|
70 (` (if (< (, ent) 256)
|
|
|
71 (char-to-string (, ent))
|
|
|
72 (format "[Too large character: %s]" (, ent)))))
|
|
|
73
|
|
|
74 (defmacro w3-p-s-var-def (var)
|
|
|
75 "Declare VAR as a scratch variable which w3-parse-buffer must
|
|
|
76 \"let\"-bind."
|
|
|
77 (` (eval-when-compile
|
|
|
78 (defvar (, var))
|
|
|
79 (or (memq '(, var) w3-p-s-var-list)
|
|
|
80 (setq w3-p-s-var-list (cons '(, var) w3-p-s-var-list))))))
|
|
|
81
|
|
|
82 (defmacro w3-p-s-let-bindings (&rest body)
|
|
|
83 "\"let\"-bind all of the variables in w3-p-s-var-list in BODY."
|
|
|
84 (` (let (, w3-p-s-var-list)
|
|
|
85 (,@ body))))
|
|
|
86 (put 'w3-p-s-let-bindings 'lisp-indent-function 0)
|
|
|
87 (put 'w3-p-s-let-bindings 'edebug-form-spec t)
|
|
|
88
|
|
|
89 (defvar w3-p-d-current-element)
|
|
|
90 (put 'w3-p-d-current-element 'variable-documentation
|
|
|
91 "Information structure for the current open element.")
|
|
|
92
|
|
|
93 (defvar w3-p-d-exceptions)
|
|
|
94 (put 'w3-p-d-exceptions 'variable-documentation
|
|
|
95 "Alist specifying elements (dis)allowed because of an (ex|in)clusion
|
|
|
96 exception of some containing element (not necessarily the immediately
|
|
|
97 containing element). Each item specifies a transition for an element
|
|
|
98 which overrides that specified by the current element's content model.
|
|
|
99 Each item is of the form (TAG ACTION *same ERRORP).")
|
|
|
100
|
|
|
101 (defvar w3-p-d-in-parsed-marked-section)
|
|
|
102 (put 'w3-p-d-in-parsed-marked-section 'variable-documentation
|
|
|
103 "Are we in a parsed marked section so that we have to scan for \"]]>\"?")
|
|
|
104
|
|
|
105 (defvar w3-p-d-non-markup-chars)
|
|
|
106 (put 'w3-p-d-non-markup-chars 'variable-documentation
|
|
|
107 "The characters that do not indicate the start of markup, in the format
|
|
|
108 for an argument to skip-chars-forward.")
|
|
|
109
|
|
|
110 (defvar w3-p-d-null-end-tag-enabled)
|
|
|
111 (put 'w3-p-d-null-end-tag-enabled 'variable-documentation
|
|
|
112 "Is the null end tag (\"/\") enabled?")
|
|
|
113
|
|
|
114 (defvar w3-p-d-open-element-stack)
|
|
|
115 (put 'w3-p-d-open-element-stack 'variable-documentation
|
|
|
116 "A stack of the currently open elements, with the innermost enclosing
|
|
|
117 element on top and the outermost on bottom.")
|
|
|
118
|
|
|
119 (defvar w3-p-d-parse-tag-stream-tail-pointer)
|
|
|
120 (put 'w3-p-d-parse-tag-stream-tail-pointer 'variable-documentation
|
|
|
121 "Points to last cons cell in parse-tag stream. We add items to tail of
|
|
|
122 parse-tag-stream instead of head.")
|
|
|
123
|
|
|
124 (defvar w3-p-d-shortrefs)
|
|
|
125 (put 'w3-p-d-shortrefs 'variable-documentation
|
|
|
126 "An alist of the magic entity reference strings in the current
|
|
|
127 between-tags region and their replacements. Each item is of the format
|
|
|
128 \(REGEXP . REPLACEMENT-STRING\). Although in SGML shortrefs normally name
|
|
|
129 entities whose value should be used as the replacement, we have
|
|
|
130 preexpanded the entities for speed. We have also regexp-quoted the
|
|
|
131 strings to be replaced, so they can be used with looking-at. This should
|
|
|
132 never be in an element's overrides field unless
|
|
|
133 w3-p-d-shortref-chars is also in the field.")
|
|
|
134
|
|
|
135 (defvar w3-p-d-shortref-chars)
|
|
|
136 (put 'w3-p-d-shortref-chars 'variable-documentation
|
|
|
137 "A string of the characters which can start shortrefs in the current
|
|
|
138 between-tags region. This must be in a form which can be passed to
|
|
|
139 skip-chars-forward and must contain exactly the characters which start the
|
|
|
140 entries in w3-p-d-shortrefs. If this variable is mentioned in the
|
|
|
141 overrides field of an element, its handling is magical in that the
|
|
|
142 variable w3-p-d-non-markup-chars is saved to the element's undo-list and
|
|
|
143 updated at the same time. This should never be in an element's overrides
|
|
|
144 field unless w3-p-d-shortrefs is also in the field.")
|
|
|
145
|
|
|
146 (defvar w3-p-d-tag-name)
|
|
|
147 (put 'w3-p-d-tag-name 'variable-documentation
|
|
|
148 "Name of tag we are looking at, as an Emacs Lisp symbol.
|
|
|
149 Only non-nil when we are looking at a tag.")
|
|
|
150
|
|
|
151 (defvar w3-p-d-end-tag-p)
|
|
|
152 (put 'w3-p-d-end-tag-p 'variable-documentation
|
|
|
153 "Is the tag we are looking at an end tag?
|
|
|
154 Only non-nil when we are looking at a tag.")
|
|
|
155
|
|
|
156 )
|
|
|
157
|
|
|
158
|
|
|
159 ;;;
|
|
|
160 ;;; HTML syntax error messages.
|
|
|
161 ;;;
|
|
|
162
|
|
|
163 (eval-when-compile
|
|
|
164
|
|
|
165 (defvar w3-p-d-debug-url)
|
|
|
166 (put 'w3-p-d-debug-url 'variable-documentation
|
|
|
167 "Whether to print the URL being parsed before an error messages.
|
|
|
168 Only true for the first error message.")
|
|
|
169
|
|
|
170 ;; The level parameter indicates whether the error is (1) very
|
|
|
171 ;; serious, must be displayed to all users, (2) invalid HTML, but the
|
|
|
172 ;; user should only be told if the user has indicated interest, or (3)
|
|
|
173 ;; valid HTML which is bad because it appears to rely on the way certain
|
|
|
174 ;; browsers will display it, which should only be displayed to the user
|
|
|
175 ;; if they have really asked for it.
|
|
|
176
|
|
|
177 (defmacro w3-debug-html (&rest body)
|
|
|
178 "Emit a warning message.
|
|
|
179 These keywords may be used at the beginning of the arguments:
|
|
|
180 :mandatory-if sexp -- force printing if sexp evaluates non-nil.
|
|
|
181 :bad-style -- do not print unless w3-debug-html is 'style.
|
|
|
182 :outer -- do not include the current element in the element
|
|
|
183 context we report.
|
|
|
184 :nocontext -- do not include context where error detected.
|
|
|
185 The remaining parameters are treated as the body of a progn, the value of
|
|
|
186 which must be a string to use as the error message."
|
|
|
187 (let (mandatory-if bad-style outer nocontext condition)
|
|
|
188 (while (memq (car body) '(:mandatory-if :bad-style :outer :nocontext))
|
|
|
189 (cond ((eq ':mandatory-if (car body))
|
|
|
190 (setq mandatory-if (car (cdr body)))
|
|
|
191 (setq body (cdr (cdr body))))
|
|
|
192 ((eq ':bad-style (car body))
|
|
|
193 (setq bad-style t)
|
|
|
194 (setq body (cdr body)))
|
|
|
195 ((eq ':nocontext (car body))
|
|
|
196 (setq nocontext t)
|
|
|
197 (setq body (cdr body)))
|
|
|
198 ((eq ':outer (car body))
|
|
|
199 (setq outer t)
|
|
|
200 (setq body (cdr body)))))
|
|
|
201 (setq condition (if bad-style
|
|
|
202 '(eq 'style w3-debug-html)
|
|
|
203 'w3-debug-html))
|
|
|
204 (if mandatory-if
|
|
|
205 (setq condition
|
|
|
206 (` (or (, mandatory-if)
|
|
|
207 (, condition)))))
|
|
|
208 (` (if (, condition)
|
|
|
209 (let ((message (progn (,@ body))))
|
|
|
210 (if message
|
|
|
211 (w3-debug-html-aux message
|
|
|
212 (,@ (if nocontext
|
|
|
213 (list outer nocontext)
|
|
|
214 (if outer '(t)))))))))))
|
|
|
215
|
|
|
216 ;; This is unsatisfactory.
|
|
|
217 (put 'w3-debug-html 'lisp-indent-function 0)
|
|
|
218
|
|
|
219 (put 'w3-debug-html 'edebug-form-spec
|
|
|
220 '([&rest &or ":nocontext" ":outer" [":mandatory-if" form] ":bad-style"]
|
|
|
221 &rest form))
|
|
|
222 )
|
|
|
223
|
|
|
224 (defun w3-debug-html-aux (message &optional outer nocontext)
|
|
|
225 (let (
|
|
|
226 ;; We have already determined whether the user should see the
|
|
|
227 ;; message, so don't let w3-warn suppress it.
|
|
|
228 (w3-debug-html t))
|
|
|
229 ;; Print the URL before the first error message for a document.
|
|
|
230 (cond (w3-p-d-debug-url
|
|
|
231 (let ((url (url-view-url t)))
|
|
|
232 (w3-warn 'html
|
|
|
233 (if (or (null url)
|
|
|
234 (string-equal "" url))
|
|
|
235 (format "HTML errors for buffer %s"
|
|
|
236 (current-buffer))
|
|
|
237 (format "HTML errors for <URL:%s>" url))))
|
|
|
238 (setq w3-p-d-debug-url nil)))
|
|
|
239 (w3-warn 'html
|
|
|
240 (if nocontext
|
|
|
241 message
|
|
|
242 (concat message
|
|
|
243 ;; Display context information for each error
|
|
|
244 ;; message.
|
|
|
245 "\n Containing elements: "
|
|
|
246 (w3-open-elements-string (if outer 1))
|
|
|
247 (concat
|
|
|
248 "\n Text around error: "
|
|
|
249 (save-restriction
|
|
|
250 (widen)
|
|
|
251 (progn
|
|
|
252 (insert "*ERROR*")
|
|
|
253 (prog1
|
|
|
254 (w3-quote-for-string
|
|
|
255 (buffer-substring
|
|
|
256 (max (- (point) 27) (point-min))
|
|
|
257 (min (+ (point) 20) (point-max))))
|
|
|
258 (delete-char -7))))))))))
|
|
|
259
|
|
|
260 (defun w3-quote-for-string (string)
|
|
|
261 (save-excursion
|
|
|
262 (set-buffer (get-buffer-create " w3-quote-whitespace"))
|
|
|
263 (erase-buffer)
|
|
|
264 (insert string)
|
|
|
265 (goto-char (point-min))
|
|
|
266 (insert "\"")
|
|
|
267 (while (progn
|
|
|
268 (skip-chars-forward "^\"\\\t\n\r")
|
|
|
269 (not (eobp)))
|
|
|
270 (insert "\\" (cdr (assq (following-char) '((?\" . "\"")
|
|
|
271 (?\\ . "\\")
|
|
|
272 (?\t . "t")
|
|
|
273 (?\n . "n")
|
|
|
274 (?\r . "r")))))
|
|
|
275 (delete-char 1))
|
|
|
276 (insert "\"")
|
|
|
277 (buffer-string)))
|
|
|
278
|
|
|
279
|
|
|
280 ;;;
|
|
|
281 ;;; General entity references and numeric character references.
|
|
|
282 ;;;
|
|
|
283
|
|
|
284 ;; *** MULE conversion?
|
|
|
285 ;; *** I18N HTML support?
|
|
|
286
|
|
|
287 (let ((html-entities w3-html-entities))
|
|
|
288 (while html-entities
|
|
|
289 (put (car (car html-entities)) 'html-entity-expansion
|
|
|
290 (cons 'CDATA (if (integerp (cdr (car html-entities)))
|
|
2
|
291 (char-to-string
|
|
|
292 (let ((c (cdr (car html-entities))))
|
|
|
293 (cond
|
|
|
294 ((and (> c 127) (boundp 'MULE))
|
|
|
295 (make-character lc-ltn1 c))
|
|
|
296 ;;((and (> c 127) (featurep 'mule))
|
|
|
297 ;; What???
|
|
|
298 ;;)
|
|
|
299 (t
|
|
|
300 c))))
|
|
0
|
301 (cdr (car html-entities)))))
|
|
|
302 (setq html-entities (cdr html-entities))))
|
|
|
303
|
|
|
304 ;; These are handled differently than the normal HTML entities because
|
|
|
305 ;; we need to define the entities with 'nil instead of 'CDATA so
|
|
|
306 ;; that they are correctly scanned for new markup.
|
|
|
307 ;;
|
|
|
308 ;; from jbw@cs.bu.edu
|
|
|
309 ;;
|
|
|
310 ;;> Of course, this differs from the specification a bit. The W3C tech
|
|
|
311 ;;> report defines all of these as SYSTEM entities. This potentially means
|
|
|
312 ;;> that they can be used in more contexts. The method I outlined above
|
|
|
313 ;;> means "&smiley;" can only be used in contexts where IMG is a valid
|
|
|
314 ;;> element. I am not sure exactly where it is okay to use a SYSTEM entity.
|
|
|
315 ;;> I think anywhere that data characters are accepted.
|
|
|
316 ;;
|
|
|
317 ;; I find this acceptable, as just what the hell are you supposed to do with
|
|
|
318 ;; &computer; as part of a value of a form input when you display it and/or
|
|
|
319 ;; submit it?!
|
|
|
320
|
|
|
321 (let ((html-entities w3-graphic-entities)
|
|
|
322 (cur nil))
|
|
|
323 (while html-entities
|
|
|
324 (setq cur (car html-entities)
|
|
|
325 html-entities (cdr html-entities))
|
|
|
326 (put (nth 0 cur) 'html-entity-expansion
|
|
2
|
327 (cons 'nil (format "<img src=\"%s/%s%s\" alt=\"%s\">"
|
|
0
|
328 w3-icon-directory
|
|
|
329 (nth 1 cur)
|
|
|
330 (if w3-icon-format
|
|
|
331 (concat "." (symbol-name w3-icon-format))
|
|
|
332 "")
|
|
|
333 (or (nth 3 cur) (nth 2 cur)))))))
|
|
|
334
|
|
|
335 ;; These are the general entities in HTML 3.0 in terms of which the math
|
|
|
336 ;; shortrefs are defined:
|
|
|
337 ;;
|
|
|
338 ;; <!ENTITY REF1 STARTTAG "SUP">
|
|
|
339 ;; <!ENTITY REF2 ENDTAG "SUP">
|
|
|
340 ;; <!ENTITY REF3 STARTTAG "SUB">
|
|
|
341 ;; <!ENTITY REF4 ENDTAG "SUB">
|
|
|
342 ;; <!ENTITY REF5 STARTTAG "BOX">
|
|
|
343 ;; <!ENTITY REF6 ENDTAG "BOX">
|
|
|
344 ;;
|
|
|
345 ;; We're ignoring them because these names should really be local to the
|
|
|
346 ;; DTD and not visible in the document. They might change at any time in
|
|
|
347 ;; future HTML standards.
|
|
|
348
|
|
|
349 ;; <!--Entities for language-dependent presentation (BIDI and contextual analysis) -->
|
|
|
350 ;; <!ENTITY zwnj CDATA "‌"-- zero width non-joiner-->
|
|
|
351 ;; <!ENTITY zwj CDATA "‍"-- zero width joiner-->
|
|
|
352 ;; <!ENTITY lrm CDATA "‎"-- left-to-right mark-->
|
|
|
353 ;; <!ENTITY rlm CDATA "‏"-- right-to-left mark-->
|
|
|
354
|
|
|
355 ;; Entity names are case sensitive!
|
|
|
356
|
|
|
357 ;; & should only be recognized when followed by letter or # and
|
|
|
358 ;; digit or # and letter.
|
|
|
359
|
|
|
360 (eval-when-compile
|
|
|
361
|
|
|
362 (w3-p-s-var-def w3-p-s-entity)
|
|
|
363 (w3-p-s-var-def w3-p-s-pos)
|
|
|
364 (w3-p-s-var-def w3-p-s-num)
|
|
|
365 ;; Destroys free variables:
|
|
|
366 ;; w3-p-s-entity, w3-p-s-pos, w3-p-s-num
|
|
|
367 ;; Depends on case-fold-search being t.
|
|
|
368 (defsubst w3-expand-entity-at-point-maybe ()
|
|
|
369 ;; We are looking at a &.
|
|
|
370 ;; Only &A or  or &#A syntax is special.
|
|
|
371 (cond
|
|
|
372 ((and (looking-at "&\\([a-z][-a-z0-9.]*\\)[\ ;\n]?") ; \n should be \r
|
|
|
373 ;; We are looking at a general entity reference, maybe undefined.
|
|
|
374 (setq w3-p-s-entity
|
|
|
375 (get
|
|
|
376 (intern (buffer-substring (match-beginning 1) (match-end 1)))
|
|
|
377 'html-entity-expansion)))
|
|
|
378
|
|
|
379 ;; If the reference was undefined, then for SGML, we should really
|
|
|
380 ;; issue a warning and delete the reference. However, the HTML
|
|
|
381 ;; standard (contradicting the SGML standard) says to leave the
|
|
|
382 ;; undefined reference in the text.
|
|
|
383
|
|
|
384 ;; We are looking at a defined general entity reference.
|
|
|
385 (replace-match "")
|
|
|
386 (cond ((eq 'CDATA (car w3-p-s-entity))
|
|
|
387 ;; Leave point after expansion so we don't rescan it.
|
|
|
388 (insert (cdr w3-p-s-entity)))
|
|
|
389 ((memq (car w3-p-s-entity) '(nil STARTTAG ENDTAG MS MD))
|
|
|
390 ;; nil is how I mark ordinary entities.
|
|
|
391 ;; The replacement text gets rescanned for all of these.
|
|
|
392 (setq w3-p-s-pos (point))
|
|
|
393 (insert (cdr (assq (car w3-p-s-entity)
|
|
|
394 '((nil . "")
|
|
|
395 (STARTTAG . "<")
|
|
|
396 (ENDTAG . "</")
|
|
|
397 (MS . "<![")
|
|
|
398 (MD . "<!"))))
|
|
|
399 (cdr w3-p-s-entity)
|
|
|
400 (cdr (assq (car w3-p-s-entity)
|
|
|
401 '((nil . "")
|
|
|
402 (STARTTAG . ">")
|
|
|
403 (ENDTAG . ">")
|
|
|
404 (MS . "]]>")
|
|
|
405 (MD . ">")))))
|
|
|
406 (goto-char w3-p-s-pos)
|
|
|
407 ;; *** Strictly speaking, if we parse anything from the
|
|
|
408 ;; replacement text, it must end before the end of the
|
|
|
409 ;; replacement text.
|
|
|
410 )
|
|
|
411 ((eq 'SDATA (car w3-p-s-entity))
|
|
|
412 (insert "[Unimplemented SDATA \"%s\"]" (cdr w3-p-s-entity)))
|
|
|
413 ((eq 'PI (car w3-p-s-entity))
|
|
|
414 ;; We are currently ignoring processing instructions.
|
|
|
415 ;; *** Strictly speaking, we should issue a warning if this
|
|
|
416 ;; occurs in a attribute value.
|
|
|
417 )
|
|
|
418 (t
|
|
|
419 ;; *** We don't handle external entities yet.
|
|
|
420 (error "[Unimplemented entity: \"%s\"]" w3-p-s-entity))))
|
|
|
421
|
|
|
422 ((looking-at "&#[0-9][0-9]*\\([\ ;\n]?\\)") ; \n should be \r
|
|
|
423 ;; We are looking at a numeric character reference.
|
|
|
424 ;; Ensure the number is already terminated by a semicolon or carriage
|
|
|
425 ;; return so we can use "read" to get it as a number quickly.
|
|
|
426 (cond ((= (match-beginning 1) (match-end 1))
|
|
|
427 ;; This is very uncommon, so we don't have to be quick here but
|
|
|
428 ;; rather correct.
|
|
|
429 (save-excursion
|
|
|
430 (goto-char (match-end 0)) ; same as match-end 1
|
|
|
431 (insert ?\;))
|
|
|
432 ;; Set up the match data properly
|
|
|
433 (looking-at "&#[0-9][0-9]*;")))
|
|
|
434 (forward-char 2)
|
|
|
435 (setq w3-p-s-num (read (current-buffer)))
|
|
|
436 ;; Always leave point after the expansion of a numeric
|
|
|
437 ;; character reference, like it were a CDATA entity.
|
|
|
438 (replace-match "")
|
|
|
439 ;; char-to-string will hopefully do something useful with characters
|
|
|
440 ;; larger than 255. I think in MULE it does. Is this true?
|
|
|
441 ;; Bill wants to call w3-resolve-numeric-entity here, but I think
|
|
|
442 ;; that functionality belongs in char-to-string.
|
|
|
443 ;; The largest valid character in the I18N version of HTML is 65533.
|
|
|
444 ;; <URL:ftp://ds.internic.net/internet-drafts/draft-ietf-html-i18n-01.txt>
|
|
2
|
445 ;; wrongo! Apparently, mule doesn't do sane things with char-to-string
|
|
|
446 ;; -wmp 7/9/96
|
|
|
447 (insert (char-to-string
|
|
|
448 (cond
|
|
|
449 ((and (boundp 'MULE) (> w3-p-s-num 127))
|
|
|
450 (make-character lc-ltn1 w3-p-s-num))
|
|
|
451 ;;((and (featurep 'mule) (> w3-p-s-num 127))
|
|
|
452 ;;what??
|
|
|
453 ;;)
|
|
|
454 (t
|
|
|
455 w3-p-s-num)))))
|
|
0
|
456 ((looking-at "&#\\(re\\|rs\\|space\\|tab\\)[\ ;\n]?") ; \n should be \r
|
|
|
457 (replace-match (assq (upcase (char-after (+ 3 (point))))
|
|
|
458 '(;; *** Strictly speaking, record end should be
|
|
|
459 ;; carriage return.
|
|
|
460 (?E . "\n") ; RE
|
|
|
461 ;; *** And record start should be line feed.
|
|
|
462 (?S . "") ; RS
|
|
|
463 (?P . " ") ; SPACE
|
|
|
464 (?A . "\t")))) ; TAB
|
|
|
465 ;; Leave point after the expansion of a character reference, so it
|
|
|
466 ;; doesn't get rescanned.
|
|
|
467 ;; *** Strictly speaking, we should issue a warning for &#foo; if foo
|
|
|
468 ;; is not a function character in the SGML declaration.
|
|
|
469 )
|
|
|
470
|
|
|
471 ((eq ?& (following-char))
|
|
|
472 ;; We are either looking at an undefined reference or a & that does
|
|
|
473 ;; not start a reference (in which case we should not have been called).
|
|
|
474 ;; Skip over the &.
|
|
|
475 (forward-char 1))
|
|
|
476
|
|
|
477 (t
|
|
|
478 ;; What is the code doing calling us if we're not looking at a "&"?
|
|
|
479 (error "this should never happen"))))
|
|
|
480
|
|
|
481 )
|
|
|
482
|
|
|
483
|
|
|
484 ;;;
|
|
|
485 ;;; Syntax table used in markup declarations.
|
|
|
486 ;;;
|
|
|
487
|
|
|
488 (defvar w3-sgml-md-syntax-table
|
|
|
489 (let ((table (make-syntax-table))
|
|
|
490 (items '(
|
|
|
491 (0 "." 255) ; clear everything
|
|
|
492 (?\r " ")
|
|
|
493 (?\t " ")
|
|
|
494 (?\n " ")
|
|
|
495 (32 " ") ; space
|
|
|
496 (?< "\(>")
|
|
|
497 (?> "\)<")
|
|
|
498 (?\( "\(\)")
|
|
|
499 (?\) "\)\(")
|
|
|
500 (?\[ "\(\]")
|
|
|
501 (?\] "\)\[")
|
|
|
502 (?\" "\"")
|
|
|
503 (?\' "\"")
|
|
|
504 (?a "w" ?z)
|
|
|
505 (?A "w" ?Z)
|
|
|
506 (?0 "w" ?9)
|
|
|
507 (?. "w")
|
|
|
508 ;; "-" can be a character in a NAME, but it is also used in
|
|
|
509 ;; "--" as both a comment start and end within SGML
|
|
|
510 ;; declarations ("<!" ... ">"). In HTML, it is only used
|
|
|
511 ;; as a NAME character in the parameter entities
|
|
|
512 ;; Content-Type, HTTP-Method, and style-notations and in
|
|
|
513 ;; the attribute name http-equiv and in the notation names
|
|
|
514 ;; dsssl-lite and w3c-style. We would like to be able to
|
|
|
515 ;; train Emacs to skip over these kinds of comments with
|
|
|
516 ;; forward-sexp and backward-sexp. Is there any way to
|
|
|
517 ;; teach Emacs how to do this? It doesn't seem to be the
|
|
|
518 ;; case.
|
|
|
519 (?- "w")
|
|
|
520 )))
|
|
|
521 (while items
|
|
|
522 (let* ((item (car items))
|
|
|
523 (char (car item))
|
|
|
524 (syntax (car (cdr item)))
|
|
|
525 (bound (or (car-safe (cdr-safe (cdr item)))
|
|
|
526 char)))
|
|
|
527 (while (<= char bound)
|
|
|
528 (modify-syntax-entry char syntax table)
|
|
|
529 (setq char (1+ char))))
|
|
|
530 (setq items (cdr items)))
|
|
|
531 table)
|
|
|
532 "A syntax table for parsing SGML markup declarations.")
|
|
|
533
|
|
|
534
|
|
|
535 ;;;
|
|
|
536 ;;; Element information data type.
|
|
|
537 ;;;
|
|
|
538
|
|
|
539 ;; The element information data type is used in two ways:
|
|
|
540 ;;
|
|
|
541 ;; * To store the DTD, there is one element record for each element in
|
|
|
542 ;; the DTD.
|
|
|
543 ;;
|
|
|
544 ;; * To store information for open elements in the current parse tree.
|
|
|
545 ;; Each such element is initialized by copying the element record
|
|
|
546 ;; from the DTD. This means that values in the fields can not be
|
|
|
547 ;; destructively altered, although of course the fields can be
|
|
|
548 ;; changed.
|
|
|
549
|
|
|
550 ;; The cells in this vector are:
|
|
|
551 ;;
|
|
|
552 ;; name: the element's name (a generic identifier).
|
|
|
553 ;;
|
|
|
554 ;; end-tag-name: a symbol whose name should be the result of prefixing
|
|
|
555 ;; the generic-identifier with a slash. This is a convenience value for
|
|
|
556 ;; interfacing with the display engine which expects a stream of start
|
|
|
557 ;; and end tags in this format rather than a tree.
|
|
|
558 ;;
|
|
|
559 ;; content-model: a data structure describing what elements or character
|
|
|
560 ;; data we expect to find within this element. This is either a symbol
|
|
|
561 ;; listed here:
|
|
|
562 ;;
|
|
|
563 ;; EMPTY: no content, no end-tag allowed.
|
|
|
564 ;; CDATA: all data characters until "</[a-z]" is seen.
|
|
|
565 ;; XCDATA: special non-SGML-standard mode which includes all data
|
|
|
566 ;; characters until "</foo" is seen where "foo" is the name of this
|
|
|
567 ;; element. (for XMP and LISTING)
|
|
|
568 ;; XXCDATA: special non-SGML-standard mode which includes all data
|
|
|
569 ;; until end-of-entity (end-of-buffer for us). (for PLAINTEXT)
|
|
|
570 ;; RCDATA: all data characters until "</[a-z]" is seen, except that
|
|
|
571 ;; entities are expanded first, although the expansions are not
|
|
|
572 ;; scanned for end-tags.
|
|
|
573 ;; XINHERIT: special non-SGML-standard mode which means to use the
|
|
|
574 ;; content model of the containing element instead.
|
|
|
575 ;;
|
|
|
576 ;; or a vector of this structure:
|
|
|
577 ;;
|
|
|
578 ;; [(INCLUDES INCSPACEP (((TAG ...) . TRANSITION) ...) DEFAULT) ...]
|
|
|
579 ;;
|
|
|
580 ;; where INCLUDES is of the format:
|
|
|
581 ;;
|
|
|
582 ;; (TAG ...)
|
|
|
583 ;;
|
|
|
584 ;; where each TRANSITION is one of these:
|
|
|
585 ;;
|
|
|
586 ;; (ACTION NEW-STATE ERRORP)
|
|
|
587 ;; (ACTION NEW-STATE)
|
|
|
588 ;; (ACTION)
|
|
|
589 ;;
|
|
|
590 ;; where DEFAULT is one of these:
|
|
|
591 ;;
|
|
|
592 ;; nil or TRANSITION
|
|
|
593 ;;
|
|
|
594 ;; where the meaning of the components is:
|
|
|
595 ;;
|
|
|
596 ;; INCLUDES is a list of tags for which the transition (*include *same
|
|
|
597 ;; nil) applies.
|
|
|
598 ;;
|
|
|
599 ;; DEFAULT if non-nil is a transition that should be taken when
|
|
|
600 ;; matching any possibility not explicitly listed in another
|
|
|
601 ;; TRANSITION, except for data characters containing only whitespace.
|
|
|
602 ;;
|
|
|
603 ;; INCSPACEP specifies how to handle data characters which include
|
|
|
604 ;; only whitespace characters. The value is non-nil to indicate
|
|
|
605 ;; (*include *same nil) or nil to indicate (*discard *same nil).
|
|
|
606 ;;
|
|
|
607 ;; TAG is a symbol corresponding to the start-tag we are looking at,
|
|
|
608 ;; or *data when seeing character data that includes at least one
|
|
|
609 ;; non-space character.
|
|
|
610 ;;
|
|
|
611 ;; ACTION is one of:
|
|
|
612 ;; *close: Close this element and try again using content model of
|
|
|
613 ;; enclosing element. (Note that this does not apply to the
|
|
|
614 ;; case of an element being closed by its own end-tag.)
|
|
|
615 ;; *include: Process new element as subelement of this one or
|
|
|
616 ;; include data characters directly.
|
|
|
617 ;; *discard: Discard a start-tag or data characters.
|
|
|
618 ;; *retry: Try again after processing NEW-STATE and ERRORP.
|
|
|
619 ;; ELEMENT: Open ELEMENT (with default attributes), then try again
|
|
|
620 ;; using its content model.
|
|
|
621 ;;
|
|
|
622 ;; NEW-STATE (optional, default *same) is the index of the state to
|
|
|
623 ;; move to after processing the element or one of these:
|
|
|
624 ;; *same: no state change occurs.
|
|
2
|
625 ;; *next: change the current state + 1.
|
|
0
|
626 ;; The initial state is 0. NEW-STATE does not matter if ACTION is
|
|
|
627 ;; *close.
|
|
|
628 ;;
|
|
|
629 ;; ERRORP (optional, default nil) if non-nil indicates this transition
|
|
|
630 ;; represents an error. The error message includes this value if it
|
|
|
631 ;; is a string.
|
|
|
632 ;;
|
|
|
633 ;; If no matching transition is found, the default transition is
|
|
|
634 ;; (*discard *same "not allowed here").
|
|
|
635 ;;
|
|
|
636 ;; overrides: An alist of pairs of the form (VAR REPLACEP . VALUE).
|
|
|
637 ;; When this element is opened, the old value of VAR is saved in the
|
|
|
638 ;; undo-list. If REPLACEP is non-nil, then VAR gets value VALUE,
|
|
|
639 ;; otherwise VAR gets value (append VALUE (symbol-value VAR)). Useful
|
|
|
640 ;; values for VAR are:
|
|
|
641 ;;
|
|
|
642 ;; w3-p-d-exceptions: See doc string.
|
|
|
643 ;;
|
|
|
644 ;; w3-p-d-shortrefs: See doc string.
|
|
|
645 ;;
|
|
|
646 ;; w3-p-d-shortref-chars: See doc string.
|
|
|
647 ;;
|
|
|
648 ;; end-tag-omissible: Whether it is legal to omit the end-tag of this
|
|
|
649 ;; element. If an end-tag is inferred for an element whose end tag is
|
|
|
650 ;; not omissible, an error message is given.
|
|
|
651 ;;
|
|
|
652 ;; state: The current state in the content model. Preset to the initial
|
|
|
653 ;; state of 0.
|
|
|
654 ;;
|
|
|
655 ;; undo-list: an alist of of former values of local variables
|
|
|
656 ;; of w3-parse-buffer to restore upon closing this element. Each
|
|
|
657 ;; item on the list is of the format (VAR . VALUE-TO-RESTORE).
|
|
|
658 ;;
|
|
|
659 ;; attributes: an alist of attributes and values. Each item on
|
|
|
660 ;; this list is of the format (ATTRIBUTE-NAME . VALUE). Each
|
|
|
661 ;; ATTRIBUTE-NAME is a symbol and each attribute value is a
|
|
|
662 ;; string.
|
|
|
663 ;;
|
|
|
664 ;; content: a list of the accumulated content of the element. While the
|
|
|
665 ;; element is open, the list is in order from latest to earliest,
|
|
|
666 ;; otherwise it is in order from earliest to latest. Each member is
|
|
|
667 ;; either a string of data characters or a list of the form (NAME
|
|
|
668 ;; ATTRIBUTES CONTENT), where NAME is the subelement's name, ATTRIBUTES
|
|
|
669 ;; is an alist of the subelement's attribute names (lowercase symbols)
|
|
|
670 ;; and their values (strings), and CONTENT is the subelement's content.
|
|
|
671
|
|
|
672 (eval-when-compile
|
|
|
673
|
|
|
674 (defconst w3-element-fields
|
|
|
675 '(name end-tag-name content-model state overrides undo-list
|
|
|
676 content attributes end-tag-omissible deprecated))
|
|
|
677
|
|
|
678 (let* ((fields w3-element-fields)
|
|
|
679 (index (1- (length fields))))
|
|
|
680 (while fields
|
|
|
681 (let* ((field (symbol-name (car fields)))
|
|
|
682 (get-sym (intern (concat "w3-element-" field)))
|
|
|
683 (set-sym (intern (concat "w3-set-element-" field))))
|
|
|
684 (eval (` (progn
|
|
|
685 (defmacro (, get-sym) (element)
|
|
|
686 (list 'aref element (, index)))
|
|
|
687 (defmacro (, set-sym) (element value)
|
|
|
688 (list 'aset element (, index) value))))))
|
|
|
689 (setq fields (cdr fields))
|
|
|
690 (setq index (1- index))))
|
|
|
691
|
|
|
692 (defmacro w3-make-element ()
|
|
|
693 (list 'make-vector (length w3-element-fields) nil))
|
|
|
694
|
|
|
695 ;; *** move this to be with DTD declaration.
|
|
|
696 (defmacro w3-fresh-element-for-tag (tag)
|
|
|
697 (` (copy-sequence
|
|
|
698 (or (get (, tag) 'html-element-info)
|
|
|
699 (error "unimplemented element %s"
|
|
|
700 (w3-sgml-name-to-string (, tag)))))))
|
|
|
701
|
|
|
702 ;; *** move this to be with DTD declaration.
|
|
|
703 (defmacro w3-known-element-p (tag)
|
|
|
704 (` (get (, tag) 'html-element-info)))
|
|
|
705
|
|
|
706 (defsubst w3-sgml-name-to-string (sym)
|
|
|
707 (upcase (symbol-name sym)))
|
|
|
708
|
|
|
709 )
|
|
|
710
|
|
|
711
|
|
|
712 ;;;
|
|
|
713 ;;; Parse tree manipulation.
|
|
|
714 ;;;
|
|
|
715
|
|
|
716 ;; ;; Find the name of the previous element or a substring of the
|
|
|
717 ;; ;; preceding data characters.
|
|
|
718 ;; (let ((content (w3-element-content (car stack))))
|
|
|
719 ;; (while content
|
|
|
720 ;; (cond
|
|
|
721 ;; ((and (stringp (car content))
|
|
|
722 ;; (not (string-match "\\`[ \t\n\r]*\\'" (car content))))
|
|
|
723 ;; (setq prior-item (car content))
|
|
|
724 ;; ;; Trim trailing whitespace
|
|
|
725 ;; (if (string-match "\\(.*[^ \t\n\r]\\)[ \t\n\r]*\\'" prior-item)
|
|
|
726 ;; (setq prior-item (substring prior-item 0 (match-end 1))))
|
|
|
727 ;; (if (> (length prior-item) 8)
|
|
|
728 ;; (setq prior-item (concat "..." (substring prior-item -8))))
|
|
|
729 ;; (setq prior-item (w3-quote-for-string prior-item))
|
|
|
730 ;; (setq prior-item (concat "\(after " prior-item "\)"))
|
|
|
731 ;; (setq content nil))
|
|
|
732 ;; ((and (consp (car content))
|
|
|
733 ;; (symbolp (car (car content))))
|
|
|
734 ;; (setq prior-item
|
|
|
735 ;; (concat "\(after "
|
|
|
736 ;; (w3-sgml-name-to-string (car (car content)))
|
|
|
737 ;; "\)"))
|
|
|
738 ;; (setq content nil))
|
|
|
739 ;; (t
|
|
|
740 ;; (setq content (cdr content))))))
|
|
|
741
|
|
|
742 ;; Only used for HTML debugging.
|
|
|
743 (defun w3-open-elements-string (&optional skip-count)
|
|
|
744 (let* ((stack (nthcdr (or skip-count 0)
|
|
|
745 (cons w3-p-d-current-element
|
|
|
746 w3-p-d-open-element-stack)))
|
|
|
747 ;;(prior-item "(at start)")
|
|
|
748 result)
|
|
|
749 ;; Accumulate the names of the enclosing elements.
|
|
|
750 (while stack
|
|
|
751 (let ((element (w3-element-name (car stack))))
|
|
|
752 (if (eq '*holder element)
|
|
|
753 nil
|
|
|
754 ;; Only include *DOCUMENT if there are no other elements.
|
|
|
755 (if (or (not (eq '*document element))
|
|
|
756 (null result))
|
|
|
757 (setq result (cons (w3-sgml-name-to-string element)
|
|
|
758 result)))))
|
|
|
759 (setq stack (cdr stack)))
|
|
|
760 (setq result (mapconcat 'identity result ":"))
|
|
|
761 (if result
|
|
|
762 ;;(concat
|
|
|
763 result
|
|
|
764 ;; prior-item)
|
|
|
765 "[nowhere!]")))
|
|
|
766
|
|
|
767 ;; *** This doesn't really belong here, but where?
|
|
|
768 (eval-when-compile
|
|
|
769 (defmacro w3-invalid-sgml-chars ()
|
|
|
770 "Characters not allowed in an SGML document using the reference
|
|
|
771 concrete syntax (i.e. HTML). Returns a string in the format expected by
|
|
|
772 skip-chars-forward."
|
|
|
773 "\000-\010\013\014\016-\037\177-\237"))
|
|
|
774
|
|
|
775 (eval-when-compile
|
|
|
776 ;; Uses:
|
|
|
777 ;; w3-p-d-null-end-tag-enabled, w3-p-d-in-parsed-marked-section,
|
|
|
778 ;; w3-p-d-shortref-chars
|
|
|
779 ;; Modifies free variable:
|
|
|
780 ;; w3-p-d-non-markup-chars
|
|
|
781 (defsubst w3-update-non-markup-chars ()
|
|
|
782 (setq w3-p-d-non-markup-chars
|
|
|
783 (concat "^&<"
|
|
|
784 (w3-invalid-sgml-chars)
|
|
|
785 (if w3-p-d-null-end-tag-enabled "/" "")
|
|
|
786 (if w3-p-d-in-parsed-marked-section "]" "")
|
|
|
787 (or w3-p-d-shortref-chars ""))))
|
|
|
788
|
|
|
789 ;; Modifies free variable:
|
|
|
790 ;; w3-p-d-parse-tag-stream-tail-pointer
|
|
|
791 (defsubst w3-add-display-item (tag value)
|
|
|
792 (setcdr w3-p-d-parse-tag-stream-tail-pointer
|
|
|
793 (list (cons tag value)))
|
|
|
794 (setq w3-p-d-parse-tag-stream-tail-pointer
|
|
|
795 (cdr w3-p-d-parse-tag-stream-tail-pointer)))
|
|
|
796
|
|
|
797 )
|
|
|
798
|
|
|
799 (eval-when-compile
|
|
|
800 (w3-p-s-var-def w3-p-s-overrides)
|
|
|
801 (w3-p-s-var-def w3-p-s-undo-list)
|
|
|
802 (w3-p-s-var-def w3-p-s-var)
|
|
|
803 ;; Uses free variables:
|
|
|
804 ;; w3-p-d-non-markup-chars
|
|
|
805 ;; Modifies free variables:
|
|
|
806 ;; w3-p-d-current-element, w3-p-d-open-element-stack
|
|
|
807 ;; Destroys free variables:
|
|
|
808 ;; w3-p-s-overrides, w3-p-s-undo-list, w3-p-s-var
|
|
|
809 (defsubst w3-open-element (tag attributes)
|
|
|
810
|
|
|
811 ;; Send trailing data character item in the old current element to
|
|
|
812 ;; display engine.
|
|
|
813 (if (stringp (car-safe (w3-element-content w3-p-d-current-element)))
|
|
|
814 (w3-add-display-item
|
|
|
815 'text
|
|
|
816 (car-safe (w3-element-content w3-p-d-current-element))))
|
|
|
817
|
|
|
818 ;; Push new element on stack.
|
|
|
819 (setq w3-p-d-open-element-stack (cons w3-p-d-current-element
|
|
|
820 w3-p-d-open-element-stack))
|
|
|
821 (setq w3-p-d-current-element (w3-fresh-element-for-tag tag))
|
|
|
822
|
|
|
823 ;; Warn if deprecated or obsolete.
|
|
|
824 (if (w3-element-deprecated w3-p-d-current-element)
|
|
|
825 (w3-debug-html :outer
|
|
|
826 (format "%s element %s."
|
|
|
827 (if (eq 'obsolete
|
|
|
828 (w3-element-deprecated w3-p-d-current-element))
|
|
|
829 "Obsolete"
|
|
|
830 "Deprecated")
|
|
|
831 (w3-sgml-name-to-string
|
|
|
832 (w3-element-name w3-p-d-current-element)))))
|
|
|
833
|
|
|
834 ;; Store attributes.
|
|
|
835 ;; *** we are not handling #CURRENT attributes (HTML has none).
|
|
|
836 (w3-set-element-attributes w3-p-d-current-element attributes)
|
|
|
837 ;; *** Handle default attribute values.
|
|
|
838 ;; *** Fix the attribute name for unnamed values. Right now they will
|
|
|
839 ;; be in the attribute list as items of the format (VALUE . VALUE) where
|
|
|
840 ;; both occurrences of VALUE are the same. The first one needs to be
|
|
|
841 ;; changed to the proper attribute name by consulting the DTD.
|
|
|
842 ;; ********************
|
|
|
843
|
|
|
844 ;; Handle syntax/semantics overrides of new current element.
|
|
|
845 (cond ((w3-element-overrides w3-p-d-current-element)
|
|
|
846 (setq w3-p-s-overrides
|
|
|
847 (w3-element-overrides w3-p-d-current-element))
|
|
|
848 (setq w3-p-s-undo-list nil)
|
|
|
849 (while w3-p-s-overrides
|
|
|
850 (setq w3-p-s-var (car (car w3-p-s-overrides)))
|
|
|
851 (setq w3-p-s-undo-list
|
|
|
852 (cons (cons w3-p-s-var
|
|
|
853 (symbol-value w3-p-s-var))
|
|
|
854 w3-p-s-undo-list))
|
|
|
855 (set w3-p-s-var (if (car (cdr (car w3-p-s-overrides)))
|
|
|
856 (cdr (cdr (car w3-p-s-overrides)))
|
|
|
857 (append (cdr (cdr (car w3-p-s-overrides)))
|
|
|
858 (symbol-value w3-p-s-var))))
|
|
|
859 ;; *** HACK HACK.
|
|
|
860 ;; Magic handling of w3-p-d-shortref-chars.
|
|
|
861 (cond ((eq 'w3-p-d-shortref-chars w3-p-s-var)
|
|
|
862 (setq w3-p-s-undo-list
|
|
|
863 (cons (cons 'w3-p-d-non-markup-chars
|
|
|
864 w3-p-d-non-markup-chars)
|
|
|
865 w3-p-s-undo-list))
|
|
|
866 (w3-update-non-markup-chars)))
|
|
|
867 (setq w3-p-s-overrides (cdr w3-p-s-overrides)))
|
|
|
868 (w3-set-element-undo-list w3-p-d-current-element
|
|
|
869 w3-p-s-undo-list)))
|
|
|
870
|
|
|
871 ;; Handle content-model inheritance. (Very non-SGML!)
|
|
|
872 (if (eq 'XINHERIT (w3-element-content-model w3-p-d-current-element))
|
|
|
873 (w3-set-element-content-model
|
|
|
874 w3-p-d-current-element
|
|
|
875 (w3-element-content-model (car w3-p-d-open-element-stack))))
|
|
|
876
|
|
|
877 ;; Send the start-tag and attributes to the display engine.
|
|
|
878 (if (memq tag '(plaintext style xmp textarea))
|
|
|
879 ;; Garbage special-casing for old display engine.
|
|
|
880 ;; Nothing is sent until end-tag is found.
|
|
|
881 ;; The DTD will ensure no subelements of these elements.
|
|
|
882 nil
|
|
|
883 ;; Normal procedure.
|
|
|
884 (w3-add-display-item tag attributes)))
|
|
|
885 )
|
|
|
886
|
|
|
887 ;; The protocol for handing items to the display engine is as follows.
|
|
|
888 ;;
|
|
|
889 ;; For an element, send (START-TAG . ATTS), each member of the content,
|
|
|
890 ;; and (END-TAG . nil) if the element is allowed to have an end tag.
|
|
|
891 ;;
|
|
|
892 ;; For data characters, send (text . DATA-CHARACTERS).
|
|
|
893 ;;
|
|
|
894 ;; Exceptions:
|
|
|
895 ;;
|
|
|
896 ;; For PLAINTEXT, STYLE, XMP, TEXTAREA send:
|
|
|
897 ;; (START-TAG . ((data . DATA-CHARACTERS) . ATTS)).
|
|
|
898 ;;
|
|
|
899 ;; *** This requires somehow eliminating any subelements of the TEXTAREA
|
|
|
900 ;; element. TEXTAREA can contain subelements in HTML 3.0.
|
|
|
901 ;;
|
|
|
902 ;; For LISTING, send (text . DATA-CHARACTERS). (Is this really correct or
|
|
|
903 ;; is this perhaps a bug in the old parser?) I'm ignoring this for now.
|
|
|
904
|
|
|
905 (eval-when-compile
|
|
|
906 (w3-p-s-var-def w3-p-s-undo-list)
|
|
|
907 (w3-p-s-var-def w3-p-s-content)
|
|
|
908 (w3-p-s-var-def w3-p-s-end-tag)
|
|
|
909 ;; Modifies free variables:
|
|
|
910 ;; w3-p-d-current-element, w3-p-d-open-element-stack
|
|
|
911 ;; Accesses free variables:
|
|
|
912 ;; w3-p-d-tag-name, w3-p-d-end-tag-p
|
|
|
913 ;; Destroys free variables:
|
|
|
914 ;; w3-p-s-undo-list, w3-p-s-content, w3-p-s-end-tag
|
|
|
915 (defsubst w3-close-element (&optional inferred)
|
|
|
916 ;; inferred: non-nil if the end-tag of the current element is being
|
|
|
917 ;; inferred due to the presence of content not allowed in the current
|
|
|
918 ;; element. If t, then the tag causing this is in w3-p-d-tag-name and
|
|
|
919 ;; w3-p-d-end-tag-p.
|
|
|
920 ;; (OLD: ... otherwise it is a symbol indicating the start-tag
|
|
|
921 ;; of an element or *data or *space indicating data characters.)
|
|
|
922
|
|
|
923 (cond ((and inferred
|
|
|
924 (not (w3-element-end-tag-omissible w3-p-d-current-element)))
|
|
|
925 (w3-debug-html
|
|
|
926 (format "</%s> end-tag not omissible (required due to %s)"
|
|
|
927 (w3-sgml-name-to-string
|
|
|
928 (w3-element-name w3-p-d-current-element))
|
|
|
929 (cond ((eq t inferred)
|
|
|
930 (format (if w3-p-d-end-tag-p
|
|
|
931 "</%s> end-tag"
|
|
|
932 "start-tag for %s")
|
|
|
933 (w3-sgml-name-to-string
|
|
|
934 w3-p-d-tag-name)))
|
|
|
935 ;; *** Delete this functionality?
|
|
|
936 ((memq inferred '(*space *data))
|
|
|
937 "data characters")
|
|
|
938 ((symbolp inferred)
|
|
|
939 (format "start-tag for %s"
|
|
|
940 (w3-sgml-name-to-string inferred)))
|
|
|
941 )))))
|
|
|
942
|
|
|
943 ;; Undo any variable bindings of this element.
|
|
|
944 (cond ((w3-element-undo-list w3-p-d-current-element)
|
|
|
945 (setq w3-p-s-undo-list
|
|
|
946 (w3-element-undo-list w3-p-d-current-element))
|
|
|
947 (while w3-p-s-undo-list
|
|
|
948 (set (car (car w3-p-s-undo-list))
|
|
|
949 (cdr (car w3-p-s-undo-list)))
|
|
|
950 (setq w3-p-s-undo-list (cdr w3-p-s-undo-list)))))
|
|
|
951
|
|
|
952 (setq w3-p-s-end-tag
|
|
|
953 (w3-element-end-tag-name w3-p-d-current-element))
|
|
|
954
|
|
|
955 ;; Fix up the content of the current element in preparation for putting
|
|
|
956 ;; it in the parent.
|
|
|
957 ;; Remove trailing newline from content, if there is one, otherwise send
|
|
|
958 ;; any trailing data character item to display engine.
|
|
|
959 (setq w3-p-s-content (w3-element-content w3-p-d-current-element))
|
|
|
960 (cond ((null w3-p-s-content))
|
|
|
961 ((equal "\n" (car w3-p-s-content))
|
|
|
962 (setq w3-p-s-content (cdr w3-p-s-content)))
|
|
|
963 ((and (stringp (car w3-p-s-content))
|
|
|
964 ;; Garbage special-casing for old display engine.
|
|
|
965 (not (memq w3-p-s-end-tag
|
|
|
966 '(/plaintext /style /xmp /textarea))))
|
|
|
967 (w3-add-display-item 'text (car w3-p-s-content))))
|
|
|
968
|
|
|
969 ;; Send the end-tag to the display engine, but only if the element is
|
|
|
970 ;; allowed to have an end tag.
|
|
|
971 (cond ((memq w3-p-s-end-tag '(/plaintext /style /xmp /textarea))
|
|
|
972 ;; Garbage special-casing for old display engine.
|
|
|
973 ;; Format old display engine expects for these elements:
|
|
|
974 ;; (START-TAG . ((data . DATA-CHARACTERS) . ATTRIBUTES))
|
|
|
975 (w3-add-display-item
|
|
|
976 ;; Use the *start*-tag, not the end-tag.
|
|
|
977 (w3-element-name w3-p-d-current-element)
|
|
|
978 (cons (cons 'data
|
|
|
979 (condition-case nil
|
|
|
980 (mapconcat 'identity w3-p-s-content "")
|
|
|
981 (error "eeek! subelement content!")))
|
|
|
982 (w3-element-attributes w3-p-d-current-element))))
|
|
|
983 ;; *** Handle LISTING the way the old parser did.
|
|
|
984 ((eq 'EMPTY (w3-element-content-model w3-p-d-current-element))
|
|
|
985 ;; Do nothing, can't have an end tag.
|
|
|
986 )
|
|
|
987 (t
|
|
|
988 ;; Normal case.
|
|
|
989 (w3-add-display-item w3-p-s-end-tag nil)
|
|
|
990 (if (null w3-p-s-content)
|
|
|
991 (w3-debug-html
|
|
|
992 :bad-style :outer
|
|
|
993 ;; Don't warn for empty TD elements or empty A elements
|
|
|
994 ;; with no HREF attribute.
|
|
|
995 ;; *** Crude hack that should really be encoded in the
|
|
|
996 ;; element database somehow.
|
|
|
997 (if (or (not (memq (w3-element-name w3-p-d-current-element)
|
|
|
998 '(a td)))
|
|
|
999 (assq 'href
|
|
|
1000 (w3-element-attributes w3-p-d-current-element)))
|
|
|
1001 (format "Empty %s element."
|
|
|
1002 (w3-sgml-name-to-string
|
|
|
1003 (w3-element-name w3-p-d-current-element))))))))
|
|
|
1004
|
|
|
1005 ;; Put the current element in the proper place in its parent.
|
|
|
1006 ;; This will cause an error if we overpop the stack.
|
|
|
1007 (w3-set-element-content
|
|
|
1008 (car w3-p-d-open-element-stack)
|
|
|
1009 (cons (list (w3-element-name w3-p-d-current-element)
|
|
|
1010 (w3-element-attributes w3-p-d-current-element)
|
|
|
1011 (nreverse w3-p-s-content))
|
|
|
1012 (w3-element-content (car w3-p-d-open-element-stack))))
|
|
|
1013
|
|
|
1014 ;; Pop the stack.
|
|
|
1015 (setq w3-p-d-current-element (car w3-p-d-open-element-stack))
|
|
|
1016 (setq w3-p-d-open-element-stack (cdr w3-p-d-open-element-stack)))
|
|
|
1017
|
|
|
1018 )
|
|
|
1019
|
|
|
1020
|
|
|
1021 ;;;
|
|
|
1022 ;;; A pseudo-DTD for HTML.
|
|
|
1023 ;;;
|
|
|
1024
|
|
|
1025 (eval-when-compile
|
|
|
1026 ;; This works around the following bogus compiler complaint:
|
|
|
1027 ;; While compiling the end of the data in file w3-parse.el:
|
|
|
1028 ;; ** the function w3-expand-parameters is not known to be defined.
|
|
|
1029 ;; This is a bogus error. Anything of this form will trigger this message:
|
|
|
1030 ;; (eval-when-compile (defun xyzzy () (xyzzy)))
|
|
|
1031 (defun w3-expand-parameters (pars data) nil))
|
|
|
1032
|
|
|
1033 (eval-when-compile
|
|
|
1034 (defun w3-expand-parameters (pars data)
|
|
|
1035 (cond ((null data)
|
|
|
1036 nil)
|
|
|
1037 ((consp data)
|
|
|
1038 ;; This has to be written carefully to avoid exceeding the
|
|
|
1039 ;; maximum lisp function call nesting depth.
|
|
|
1040 (let (result)
|
|
|
1041 (while (consp data)
|
|
|
1042 (let ((car-exp (w3-expand-parameters pars (car data))))
|
|
|
1043 (setq result
|
|
|
1044 (if (and (symbolp (car data))
|
|
|
1045 (not (eq car-exp (car data)))
|
|
|
1046 ;; An expansion occurred.
|
|
|
1047 (listp car-exp))
|
|
|
1048 ;; The expansion was a list, which we splice in.
|
|
|
1049 (condition-case err
|
|
|
1050 (append (reverse car-exp) result)
|
|
|
1051 (wrong-type-argument
|
|
|
1052 (if (eq 'listp (nth 1 err))
|
|
|
1053 ;; Wasn't really a "list" since the last
|
|
|
1054 ;; cdr wasn't nil, so don't try to splice
|
|
|
1055 ;; it in.
|
|
|
1056 (cons car-exp result)
|
|
|
1057 (signal (car err) (cdr err)))))
|
|
|
1058 (cons car-exp result))))
|
|
|
1059 (setq data (cdr data)))
|
|
|
1060 (append (nreverse result)
|
|
|
1061 (w3-expand-parameters pars data))))
|
|
|
1062 ((symbolp data)
|
|
|
1063 (let ((sym-exp (cdr-safe (assq data pars))))
|
|
|
1064 (if sym-exp
|
|
|
1065 (w3-expand-parameters pars sym-exp)
|
|
|
1066 data)))
|
|
|
1067 ((vectorp data)
|
|
|
1068 (let ((i 0)
|
|
|
1069 (result (copy-sequence data)))
|
|
|
1070 (while (< i (length data))
|
|
|
1071 (aset result i
|
|
|
1072 (w3-expand-parameters pars (aref data i)))
|
|
|
1073 (setq i (1+ i)))
|
|
|
1074 result))
|
|
|
1075 (t
|
|
|
1076 data))))
|
|
|
1077
|
|
|
1078 (eval-when-compile
|
|
|
1079 (defun w3-unfold-dtd (items)
|
|
|
1080 (let (result)
|
|
|
1081 (while items
|
|
|
1082 (let* ((item (car items))
|
|
|
1083 (names (car item))
|
|
|
1084 (content-model
|
|
|
1085 (or (cdr-safe (assq 'content-model item))
|
|
|
1086 (error "impossible")))
|
|
|
1087 (overrides (cdr-safe (assq 'overrides item)))
|
|
|
1088 (end-tag-omissible
|
|
|
1089 (or (cdr-safe (assq 'end-tag-omissible item))
|
|
|
1090 ;; *** Is this SGML standard?
|
|
|
1091 (eq 'EMPTY content-model)))
|
|
|
1092 (deprecated (cdr-safe (assq 'deprecated item)))
|
|
|
1093 element
|
|
|
1094 name)
|
|
|
1095 (while names
|
|
|
1096 (setq name (car names))
|
|
|
1097 (setq names (cdr names))
|
|
|
1098
|
|
|
1099 ;; Create and initialize the element information data
|
|
|
1100 ;; structure.
|
|
|
1101 (setq element (w3-make-element))
|
|
|
1102 (w3-set-element-name element name)
|
|
|
1103 (w3-set-element-end-tag-name
|
|
|
1104 element
|
|
|
1105 (intern (concat "/" (symbol-name name))))
|
|
|
1106 (w3-set-element-state element 0)
|
|
|
1107 (w3-set-element-content-model element content-model)
|
|
|
1108 (w3-set-element-end-tag-omissible element end-tag-omissible)
|
|
|
1109
|
|
|
1110 (or (memq deprecated '(nil t obsolete))
|
|
|
1111 (error "impossible"))
|
|
|
1112 (w3-set-element-deprecated element deprecated)
|
|
|
1113
|
|
|
1114 ;; Inclusions and exclusions are specified differently in the
|
|
|
1115 ;; human-coded DTD than in the format the implementation uses.
|
|
|
1116 ;; The human-coded version is designed to be easy to edit and to
|
|
|
1117 ;; work with w3-expand-parameters while the internal version is
|
|
|
1118 ;; designed to be fast. We have to translate here. This work
|
|
|
1119 ;; is repeated for every element listed in `names' so that the
|
|
|
1120 ;; exclusion exception error messages can be accurate.
|
|
|
1121 (let ((inclusions (cdr-safe (assq 'inclusions item)))
|
|
|
1122 (exclusions (cdr-safe (assq 'exclusions item)))
|
|
|
1123 (exclusion-mode '*close)
|
|
|
1124 (exclusion-message
|
|
|
1125 (format "%s exclusion" (w3-sgml-name-to-string name)))
|
|
|
1126 exceptions)
|
|
|
1127 (while inclusions
|
|
|
1128 (setq exceptions (cons (cons (car inclusions)
|
|
|
1129 '(*include *same nil))
|
|
|
1130 exceptions))
|
|
|
1131 (setq inclusions (cdr inclusions)))
|
|
|
1132 (while exclusions
|
|
|
1133 (cond ((memq (car exclusions) '(*discard *include *close))
|
|
|
1134 (setq exclusion-mode (car exclusions)))
|
|
|
1135 ((stringp (car exclusions))
|
|
|
1136 (setq exclusion-message (car exclusions)))
|
|
|
1137 (t
|
|
|
1138 (setq exceptions (cons (list (car exclusions)
|
|
|
1139 exclusion-mode
|
|
|
1140 '*same
|
|
|
1141 exclusion-message)
|
|
|
1142 exceptions))))
|
|
|
1143 (setq exclusions (cdr exclusions)))
|
|
|
1144 (let ((overrides (if exceptions
|
|
|
1145 (cons (cons 'w3-p-d-exceptions
|
|
|
1146 (cons nil exceptions))
|
|
|
1147 overrides)
|
|
|
1148 overrides)))
|
|
|
1149 (w3-set-element-overrides element overrides)))
|
|
|
1150
|
|
|
1151 (setq result (cons (cons name element) result))))
|
|
|
1152 (setq items (cdr items)))
|
|
|
1153 result)))
|
|
|
1154
|
|
|
1155 ;; Load the HTML DTD.
|
|
|
1156 ;; <URL:ftp://ds.internic.net/rfc/rfc1866.txt>
|
|
|
1157 ;; *** Be sure to incorporate rfc1867 when attribute-checking is added.
|
|
|
1158 ;; *** Write function to check sanity of the content-model forms.
|
|
|
1159 ;; *** I18N: Add Q, BDO, SPAN
|
|
|
1160 (mapcar
|
|
|
1161 (function
|
|
|
1162 (lambda (pair)
|
|
|
1163 (put (car pair) 'html-element-info (cdr pair))))
|
|
|
1164 ;; The purpose of this complexity is to speed up loading by
|
|
|
1165 ;; pre-evaluating as much as possible at compile time.
|
|
|
1166 (eval-when-compile
|
|
|
1167 (w3-unfold-dtd
|
|
|
1168 (w3-expand-parameters
|
|
|
1169 '(
|
|
|
1170 (%headempty . (link base meta range))
|
|
2
|
1171 (%headmisc . (script))
|
|
0
|
1172 (%head-deprecated . (nextid))
|
|
|
1173
|
|
|
1174 ;; client-side imagemaps
|
|
|
1175 (%imagemaps . (area map))
|
|
|
1176 ;; special action is taken for %text inside %body.content in the
|
|
|
1177 ;; content model of each element.
|
|
|
1178 (%body.content . (%heading %block hr div address %imagemaps))
|
|
|
1179
|
|
|
1180 (%heading . (h1 h2 h3 h4 h5 h6))
|
|
|
1181
|
|
|
1182 ;; Emacs-w3 extensions
|
|
|
1183 (%emacsw3-crud . (pinhead flame cookie yogsothoth hype peek))
|
|
|
1184
|
|
2
|
1185 (%block . (p %list dl form %preformatted font
|
|
0
|
1186 %blockquote isindex fn table fig note
|
|
2
|
1187 center %block-deprecated %block-obsoleted))
|
|
0
|
1188 (%list . (ul ol))
|
|
|
1189 (%preformatted . (pre))
|
|
|
1190 (%blockquote . (bq))
|
|
|
1191 (%block-deprecated . (dir menu blockquote))
|
|
|
1192 (%block-obsoleted . (xmp listing))
|
|
|
1193
|
|
|
1194 ;; Why is IMG in this list?
|
|
|
1195 (%pre.exclusion . (*include img *discard tab math big small sub sup))
|
|
|
1196
|
|
2
|
1197 (%text . (*data b %notmath sub sup %emacsw3-crud))
|
|
0
|
1198 (%notmath . (%special %font %phrase %misc))
|
|
2
|
1199 (%font . (i u s strike tt big small sub sup
|
|
|
1200 roach secret wired)) ;; B left out for MATH
|
|
|
1201 (%phrase . (em strong dfn code samp kbd var cite blink))
|
|
|
1202 (%special . (a img applet font br script map math tab))
|
|
|
1203 (%misc . (q lang au person acronym abbrev ins del))
|
|
0
|
1204
|
|
|
1205 (%formula . (*data %math))
|
|
|
1206 (%math . (box above below %mathvec root sqrt array sub sup
|
|
|
1207 %mathface))
|
|
|
1208 (%mathvec . (vec bar dot ddot hat tilde))
|
|
|
1209 (%mathface . (b t bt))
|
|
|
1210
|
|
|
1211 (%mathdelims . (over atop choose left right of))
|
|
|
1212
|
|
|
1213 ;; What the hell? This takes BODYTEXT????? No way!
|
|
|
1214 (%bq-content-model . [(nil
|
|
|
1215 nil
|
|
|
1216 (((bodytext) *include *next))
|
|
|
1217 (bodytext *next))
|
|
|
1218 (nil
|
|
|
1219 nil
|
|
|
1220 (((credit) *include *next))
|
|
|
1221 nil)
|
|
|
1222 (nil nil nil nil)
|
|
|
1223 ])
|
|
|
1224
|
|
|
1225 ;; non-default bad HTML handling.
|
|
|
1226 (%in-text-ignore . ((p %heading) *discard *same error))
|
|
|
1227 )
|
|
|
1228 '(
|
|
|
1229 ;; A dummy element that will contain *document.
|
|
|
1230 ((*holder)
|
|
|
1231 (content-model . [(nil nil nil nil)]))
|
|
|
1232 ;; The root of the parse tree. We start with a pseudo-element
|
|
|
1233 ;; named *document for convenience.
|
|
|
1234 ((*document)
|
|
|
1235 (content-model . [(nil nil (((html) *include *next)) (html *next))
|
|
|
1236 (nil
|
|
|
1237 nil
|
|
|
1238 nil
|
|
|
1239 (*include *same "after document end"))])
|
|
|
1240 (end-tag-omissible . t))
|
|
|
1241 ;; HTML O O (HEAD, BODY)
|
|
|
1242 ((html)
|
|
|
1243 (content-model . [(nil
|
|
|
1244 nil
|
|
|
1245 (((head) *include *next))
|
|
|
1246 (head *next))
|
|
|
1247 (nil
|
|
|
1248 nil
|
|
|
1249 (((body) *include *next)
|
|
|
1250 ;; Netscape stuff
|
|
|
1251 ((frameset) *include 4)
|
|
|
1252 )
|
|
|
1253 (body *next))
|
|
|
1254 (nil
|
|
|
1255 nil
|
|
|
1256 (((plaintext) *include *next))
|
|
|
1257 (*retry *next))
|
|
|
1258 (nil
|
|
|
1259 nil
|
|
|
1260 nil
|
|
|
1261 (*include *same "after BODY"))
|
|
|
1262 (nil
|
|
|
1263 nil
|
|
|
1264 nil
|
|
|
1265 (*include *same "after FRAMESET"))
|
|
|
1266 ])
|
|
|
1267 (end-tag-omissible . t))
|
|
|
1268 ((head)
|
|
2
|
1269 (content-model . [((title isindex %headempty %headmisc
|
|
|
1270 style %head-deprecated)
|
|
0
|
1271 nil
|
|
|
1272 nil
|
|
|
1273 ;; *** Should only close if tag can
|
|
|
1274 ;; legitimately follow head. So many can that
|
|
|
1275 ;; I haven't bothered to enumerate them.
|
|
|
1276 (*close))])
|
|
|
1277 (end-tag-omissible . t))
|
|
2
|
1278 ;; SCRIPT - - (#PCDATA)
|
|
|
1279 ((script)
|
|
|
1280 (content-model . CDATA ; not official, but allows
|
|
|
1281 ; comment hiding of script
|
|
|
1282 ))
|
|
0
|
1283 ;; TITLE - - (#PCDATA)
|
|
|
1284 ((title)
|
|
|
1285 (content-model . RCDATA ; not official
|
|
|
1286 ;; [((*data) include-space nil nil)]
|
|
|
1287 ))
|
|
|
1288 ;; STYLE - O (#PCDATA)
|
|
|
1289 ;; STYLE needs to be #PCDATA to allow omitted end tag. Bleagh.
|
|
|
1290 ((style)
|
|
2
|
1291 (content-model . CDATA)
|
|
0
|
1292 (end-tag-omissible . t))
|
|
|
1293 ((body)
|
|
|
1294 (content-model . [((banner) nil nil (*retry *next))
|
|
|
1295 ((bodytext) nil nil (bodytext *next))
|
|
|
1296 (nil nil (((plaintext) *close)) nil)])
|
|
|
1297 (inclusions . (spot))
|
|
|
1298 (end-tag-omissible . t))
|
|
|
1299 ;; Do I really want to include BODYTEXT? It has something to do
|
|
|
1300 ;; with mixed content screwing things up, and I don't understand
|
|
|
1301 ;; it. Wait! It's used by BQ!
|
|
|
1302 ((bodytext)
|
|
|
1303 (content-model . [((%body.content)
|
|
|
1304 nil
|
|
|
1305 ;; Push <P> before data characters. Non-SGML.
|
|
|
1306 (((%text) p)
|
|
|
1307 ;; Closing when seeing CREDIT is a stupidity
|
|
|
1308 ;; caused by BQ's sharing of BODYTEXT. BQ
|
|
|
1309 ;; should have its own BQTEXT.
|
|
|
1310 ((credit plaintext) *close))
|
|
|
1311 nil)])
|
|
|
1312 (end-tag-omissible . t))
|
|
2
|
1313 ((div banner center)
|
|
0
|
1314 (content-model . [((%body.content)
|
|
|
1315 nil
|
|
|
1316 ;; Push <P> before data characters. Non-SGML.
|
|
|
1317 (((%text) p))
|
|
|
1318 nil)]))
|
|
|
1319 ((address)
|
|
|
1320 (content-model . [((p)
|
|
|
1321 nil
|
|
|
1322 ;; Push <P> before data characters. Non-SGML.
|
|
|
1323 (((%text) p))
|
|
|
1324 nil)]))
|
|
|
1325 ((%heading)
|
|
|
1326 (content-model . [((%text)
|
|
|
1327 include-space
|
|
|
1328 ((%in-text-ignore))
|
|
|
1329 nil)]))
|
|
|
1330 ((p)
|
|
|
1331 (content-model . [((%text)
|
|
|
1332 include-space
|
|
|
1333 nil
|
|
|
1334 ;; *** Should only close if tag can
|
|
|
1335 ;; legitimately follow P. So many can that I
|
|
|
1336 ;; don't bother to enumerate here.
|
|
|
1337 (*close))])
|
|
|
1338 (end-tag-omissible . t))
|
|
|
1339 ((ul ol)
|
|
|
1340 (content-model . [((lh)
|
|
|
1341 nil
|
|
|
1342 (((li) *include *next))
|
|
|
1343 (*retry *next))
|
|
|
1344 ((li)
|
|
|
1345 nil
|
|
|
1346 ;; Push <LI> before data characters or block
|
|
|
1347 ;; elements.
|
|
|
1348 ;; Non-SGML.
|
|
|
1349 (((%text %block) li *same error))
|
|
|
1350 nil)]))
|
|
|
1351 ((lh)
|
|
|
1352 (content-model . [((%text)
|
|
|
1353 include-space
|
|
|
1354 (((dd dt li) *close)
|
|
|
1355 (%in-text-ignore))
|
|
|
1356 nil)])
|
|
|
1357 (end-tag-omissible . t))
|
|
|
1358 ((dir menu)
|
|
|
1359 (content-model . [((li)
|
|
|
1360 nil
|
|
|
1361 (((%text) li *same error))
|
|
|
1362 nil)])
|
|
|
1363 (exclusions . (%block))
|
|
|
1364 (deprecated . t))
|
|
|
1365 ((li)
|
|
|
1366 (content-model . [((%block)
|
|
|
1367 nil
|
|
|
1368 (((li) *close)
|
|
|
1369 ;; Push <P> before data characters. Non-SGML.
|
|
|
1370 ((%text) p))
|
|
|
1371 nil)])
|
|
|
1372 (end-tag-omissible . t)
|
|
|
1373 ;; Better bad HTML handling.
|
|
|
1374 ;; Technically, there are a few valid documents that this will
|
|
|
1375 ;; hose, because you can have H1 inside FORM inside LI. However,
|
|
|
1376 ;; I don't think that should be allowed anyway.
|
|
|
1377 (exclusions . (*discard "not allowed here" %heading)))
|
|
|
1378 ((dl)
|
|
|
1379 (content-model . [((lh)
|
|
|
1380 nil
|
|
|
1381 (((dt dd) *include *next))
|
|
|
1382 (*retry *next))
|
|
|
1383 ((dt dd)
|
|
|
1384 nil
|
|
|
1385 ;; Push <DD> before data characters or block
|
|
|
1386 ;; items.
|
|
|
1387 ;; Non-SGML.
|
|
|
1388 (((%text %block) dd *same error))
|
|
|
1389 nil)]))
|
|
|
1390 ((dt)
|
|
|
1391 (content-model . [((%text)
|
|
|
1392 include-space
|
|
|
1393 (((dd dt) *close)
|
|
|
1394 (%in-text-ignore))
|
|
|
1395 nil)])
|
|
|
1396 (end-tag-omissible . t))
|
|
|
1397 ;; DD is just like LI, but we treat it separately because it can be
|
|
|
1398 ;; followed by a different set of elements.
|
|
|
1399 ((dd)
|
|
|
1400 (content-model . [((%block)
|
|
|
1401 nil
|
|
|
1402 (((dt dd) *close)
|
|
|
1403 ;; Push <P> before data characters. Non-SGML.
|
|
|
1404 ((%text) p))
|
|
|
1405 nil)])
|
|
|
1406 (end-tag-omissible . t)
|
|
|
1407 ;; See comment with LI.
|
|
|
1408 (exclusions . (*discard "not allowed here" %heading)))
|
|
|
1409 ((pre)
|
|
|
1410 (content-model . [((%text hr)
|
|
|
1411 include-space
|
|
|
1412 ((%in-text-ignore))
|
|
|
1413 nil)])
|
|
|
1414 (exclusions . (%pre.exclusion)))
|
|
|
1415 ;; BLOCKQUOTE deprecated, BQ okay
|
|
|
1416 ((bq)
|
|
|
1417 (content-model . %bq-content-model))
|
|
|
1418 ((blockquote)
|
|
|
1419 (content-model . %bq-content-model)
|
|
|
1420 ;; BLOCKQUOTE is deprecated in favor of BQ in the HTML 3.0 DTD.
|
|
|
1421 ;; However, BQ is not even mentioned in the HTML 2.0 DTD. So I
|
|
|
1422 ;; don't think we can enable this yet:
|
|
|
1423 ;;(deprecated . t)
|
|
|
1424 )
|
|
|
1425 ((fn note)
|
|
|
1426 (content-model . [((%body.content)
|
|
|
1427 nil
|
|
|
1428 ;; Push <P> before data characters. Non-SGML.
|
|
|
1429 (((%text) p))
|
|
|
1430 nil)]))
|
|
|
1431 ((fig)
|
|
|
1432 (content-model . [((overlay) nil nil (*retry *next))
|
|
|
1433 (nil
|
|
|
1434 nil
|
|
|
1435 (((caption) *include *next))
|
|
|
1436 (*retry *next))
|
|
|
1437 (nil
|
|
|
1438 nil
|
|
|
1439 (((figtext) *include *next)
|
|
|
1440 ((credit) *retry *next))
|
|
|
1441 ;; *** Should only do this for elements that
|
|
|
1442 ;; can be in FIGTEXT.
|
|
|
1443 (figtext *next))
|
|
|
1444 (nil nil (((credit) *include *next)) nil)
|
|
|
1445 (nil nil nil nil)]))
|
|
|
1446 ((caption credit)
|
|
|
1447 (content-model . [((%text)
|
|
|
1448 nil
|
|
|
1449 ((%in-text-ignore))
|
|
|
1450 nil)]))
|
|
|
1451 ((figtext)
|
|
|
1452 (content-model . [((%body.content)
|
|
|
1453 nil
|
|
|
1454 ;; Push <P> before data characters. Very non-SGML.
|
|
|
1455 (((%text) p)
|
|
|
1456 ((credit) *close))
|
|
|
1457 nil)])
|
|
|
1458 (end-tag-omissible . t))
|
|
|
1459 ((%emacsw3-crud)
|
|
|
1460 (content-model . EMPTY))
|
|
|
1461 ;; FORM - - %body.content -(FORM) +(INPUT|KEYGEN|SELECT|TEXTAREA)
|
|
|
1462 ((form)
|
|
|
1463 ;; Same as BODY. Ugh!
|
|
|
1464 (content-model . [((%body.content)
|
|
|
1465 nil
|
|
|
1466 ;; Push <P> before data characters. Non-SGML.
|
|
|
1467 (((%text) p))
|
|
|
1468 nil)])
|
|
|
1469 (exclusions . (form))
|
|
|
1470 (inclusions . (input select textarea keygen label)))
|
|
|
1471 ;; *** Where is the URL describing this?
|
|
|
1472 ((label)
|
|
|
1473 (content-model . [((%text)
|
|
|
1474 include-space
|
|
|
1475 nil
|
|
|
1476 nil)])
|
|
|
1477 ;; *** These are already included, no need to repeat.
|
|
|
1478 ;;(inclusions . (input select textarea))
|
|
|
1479 ;; *** Is a LABEL allowed inside a LABEL? I assume no.
|
|
|
1480 (exclusions . (label))
|
|
|
1481 ;; The next line just does the default so is unneeded:
|
|
|
1482 ;;(end-tag-omissible . nil)
|
|
|
1483 )
|
|
|
1484 ;; SELECT - - (OPTION+) -(INPUT|KEYGEN|TEXTAREA|SELECT)>
|
|
|
1485 ;; *** This should be -(everything).
|
|
|
1486 ((select)
|
|
|
1487 (content-model . [((option) nil nil nil)])
|
|
|
1488 (exclusions . (input label select keygen textarea)))
|
|
|
1489 ;; option - O (#PCDATA)
|
|
|
1490 ;; needs to be #PCDATA to allow omitted end tag.
|
|
|
1491 ((option)
|
|
|
1492 ;; I'd like to make this RCDATA to avoid problems with inclusions
|
|
|
1493 ;; like SPOT, but that would conflict with the omitted end-tag, I
|
|
|
1494 ;; think.
|
|
|
1495 (content-model . [((*data)
|
|
|
1496 include-space
|
|
|
1497 (((option) *close))
|
|
|
1498 nil)])
|
|
|
1499 (end-tag-omissible . t))
|
|
|
1500 ;; TEXTAREA - - (#PCDATA) -(INPUT|TEXTAREA|KEYGEN|SELECT)
|
|
|
1501 ((textarea)
|
|
|
1502 ;; Same comment as for OPTION about RCDATA.
|
|
|
1503 (content-model . [((*data) include-space nil nil)])
|
|
|
1504 (exclusions . (input select label keygen textarea)))
|
|
|
1505 ((hr br img isindex input keygen overlay wbr spot tab
|
|
|
1506 %headempty %mathdelims)
|
|
|
1507 (content-model . EMPTY))
|
|
|
1508 ((nextid)
|
|
|
1509 (content-model . EMPTY)
|
|
|
1510 (deprecated . t))
|
|
|
1511 ((a)
|
|
|
1512 (content-model . [((%text)
|
|
|
1513 include-space
|
|
|
1514 (((%heading)
|
|
|
1515 *include *same "deprecated inside A")
|
|
|
1516 ;; *** I haven't made up my mind whether this
|
|
|
1517 ;; is a good idea. It can result in a lot of
|
|
|
1518 ;; bad formatting if the A is *never* closed.
|
|
|
1519 ;;((p) *discard *same error)
|
|
|
1520 )
|
|
|
1521 nil)])
|
|
|
1522 (exclusions . (a)))
|
|
2
|
1523 ((b font %font %phrase %misc nobr)
|
|
0
|
1524 (content-model . [((%text)
|
|
|
1525 include-space
|
|
|
1526 ((%in-text-ignore))
|
|
|
1527 nil)]))
|
|
|
1528 ((plaintext)
|
|
|
1529 (content-model . XXCDATA)
|
|
|
1530 (end-tag-omissible . t)
|
|
|
1531 (deprecated . obsolete))
|
|
|
1532 ((xmp listing)
|
|
|
1533 (content-model . XCDATA)
|
|
|
1534 (deprecated . obsolete))
|
|
|
1535 ;; Latest table spec (as of Nov. 13 1995) is at:
|
|
|
1536 ;; <URL:ftp://ds.internic.net/internet-drafts/draft-ietf-html-tables-03.txt>
|
|
|
1537 ((table)
|
|
|
1538 (content-model . [(nil
|
|
|
1539 nil
|
|
|
1540 (((caption) *include *next)
|
|
|
1541 ((col colgroup thead tfoot tbody tr) *retry *next))
|
|
|
1542 (*retry *next)) ;error handling
|
|
|
1543 ((col colgroup)
|
|
|
1544 nil
|
|
|
1545 (((thead tfoot tbody tr) *retry *next))
|
|
|
1546 (*retry *next)) ;error handling
|
|
|
1547 (nil
|
|
|
1548 nil
|
|
|
1549 (((thead) *include *next)
|
|
|
1550 ((tfoot tbody tr) *retry *next))
|
|
|
1551 (*retry *next)) ;error handling
|
|
|
1552 (nil
|
|
|
1553 nil
|
|
|
1554 (((tfoot) *include *next)
|
|
|
1555 ((tbody tr) *retry *next))
|
|
|
1556 (*retry *next)) ;error handling
|
|
|
1557 ((tbody)
|
|
|
1558 nil
|
|
|
1559 (((tr) tbody *same)
|
|
|
1560 ;; error handling
|
|
|
1561 ((%body.content) tbody *same error))
|
|
|
1562 nil)]))
|
|
|
1563 ((colgroup)
|
|
|
1564 (content-model . [((col)
|
|
|
1565 nil
|
|
|
1566 (((colgroup thead tfoot tbody tr) *close))
|
|
|
1567 nil)])
|
|
|
1568 (end-tag-omissible . t))
|
|
|
1569 ((col)
|
|
|
1570 (content-model . EMPTY))
|
|
|
1571 ((thead)
|
|
|
1572 (content-model . [((tr)
|
|
|
1573 nil
|
|
|
1574 (((tfoot tbody) *close)
|
|
|
1575 ;; error handling
|
|
|
1576 ((%body.content) tr *same error))
|
|
|
1577 nil)])
|
|
|
1578 (end-tag-omissible . t))
|
|
|
1579 ((tfoot tbody)
|
|
|
1580 (content-model . [((tr)
|
|
|
1581 nil
|
|
|
1582 (((tbody) *close)
|
|
|
1583 ;; error handling
|
|
|
1584 ((%body.content) tr *same error))
|
|
|
1585 nil)])
|
|
|
1586 (end-tag-omissible . t))
|
|
|
1587 ((tr)
|
|
|
1588 (content-model . [((td th)
|
|
|
1589 nil
|
|
|
1590 (((tr tfoot tbody) *close)
|
|
|
1591 ;; error handling
|
|
|
1592 ((%body.content) td *same error))
|
|
|
1593 nil)])
|
|
|
1594 (end-tag-omissible . t))
|
|
|
1595 ((td th)
|
|
|
1596 ;; Arrgh! Another %body.content!!! Stupid!!!
|
|
|
1597 (content-model . [((%body.content)
|
|
|
1598 nil
|
|
|
1599 (((td th tr tfoot tbody) *close)
|
|
|
1600 ;; Push <P> before data characters. Non-SGML.
|
|
|
1601 ((%text) p))
|
|
|
1602 nil)])
|
|
|
1603 (end-tag-omissible . t))
|
|
|
1604 ((math)
|
|
|
1605 (content-model . [((*data) include-space nil nil)])
|
|
|
1606 (overrides .
|
|
|
1607 ((w3-p-d-shortref-chars t . "\{_^")
|
|
|
1608 (w3-p-d-shortrefs t . (("\\^" . "<sup>")
|
|
|
1609 ("_" . "<sub>")
|
|
|
1610 ("{" . "<box>")))))
|
|
|
1611 (inclusions . (%math))
|
|
|
1612 (exclusions . (%notmath)))
|
|
|
1613 ((sup)
|
|
|
1614 (content-model . [((%text)
|
|
|
1615 include-space
|
|
|
1616 ((%in-text-ignore))
|
|
|
1617 nil)])
|
|
|
1618 (overrides .
|
|
|
1619 ((w3-p-d-shortref-chars t . "\{_^")
|
|
|
1620 (w3-p-d-shortrefs t . (("\\^" . "</sup>")
|
|
|
1621 ("_" . "<sub>")
|
|
|
1622 ("{" . "<box>"))))))
|
|
|
1623 ((sub)
|
|
|
1624 (content-model . [((%text)
|
|
|
1625 include-space
|
|
|
1626 ((%in-text-ignore))
|
|
|
1627 nil)])
|
|
|
1628 (overrides .
|
|
|
1629 ((w3-p-d-shortref-chars t . "\{_^")
|
|
|
1630 (w3-p-d-shortrefs t . (("\\^" . "<sup>")
|
|
|
1631 ("_" . "</sub>")
|
|
|
1632 ("{" . "<box>"))))))
|
|
|
1633 ((box)
|
|
|
1634 (content-model . [((%formula)
|
|
|
1635 include-space
|
|
|
1636 (((left) *include 1)
|
|
|
1637 ((over atop choose) *include 2)
|
|
|
1638 ((right) *include 3))
|
|
|
1639 nil)
|
|
|
1640 ((%formula)
|
|
|
1641 include-space
|
|
|
1642 (((over atop choose) *include 2)
|
|
|
1643 ((right) *include 3))
|
|
|
1644 nil)
|
|
|
1645 ((%formula)
|
|
|
1646 include-space
|
|
|
1647 (((right) *include 3))
|
|
|
1648 nil)
|
|
|
1649 ((%formula) include-space nil nil)])
|
|
|
1650 (overrides .
|
|
|
1651 ((w3-p-d-shortref-chars t . "{}_^")
|
|
|
1652 (w3-p-d-shortrefs t . (("\\^" . "<sup>")
|
|
|
1653 ("_" . "<sub>")
|
|
|
1654 ("{" . "<box>")
|
|
|
1655 ("}" . "</box>"))))))
|
|
|
1656 ((above below %mathvec t bt sqrt)
|
|
|
1657 (content-model . [((%formula) include-space nil nil)]))
|
|
|
1658 ;; ROOT has a badly-specified content-model in HTML 3.0.
|
|
|
1659 ((root)
|
|
|
1660 (content-model . [((%formula)
|
|
|
1661 include-space
|
|
|
1662 (((of) *include *next))
|
|
|
1663 nil)
|
|
|
1664 ((%formula) include-space nil nil)]))
|
|
|
1665 ((of)
|
|
|
1666 (content-model . [((%formula) include-space nil nil)])
|
|
|
1667 ;; There is no valid way to infer a missing end-tag for OF. This
|
|
|
1668 ;; is bizarre.
|
|
|
1669 (end-tag-omissible . t))
|
|
|
1670 ((array)
|
|
|
1671 (content-model . [((row) nil nil nil)]))
|
|
|
1672 ((row)
|
|
|
1673 (content-model . [((item) nil (((row) *close)) nil)])
|
|
|
1674 (end-tag-omissible . t))
|
|
|
1675 ((item)
|
|
|
1676 (content-model . [((%formula)
|
|
|
1677 include-space
|
|
|
1678 (((row item) *close))
|
|
|
1679 nil)])
|
|
|
1680 (end-tag-omissible . t))
|
|
|
1681 ;; The old parser would look for the </EMBED> end-tag and include
|
|
|
1682 ;; the contents between <EMBED> and </EMBED> as the DATA attribute
|
|
|
1683 ;; of the EMBED start-tag. However, it did not require the
|
|
|
1684 ;; </EMBED> end-tag and did nothing if it was missing. This is
|
|
|
1685 ;; completely impossible to specify in SGML.
|
|
|
1686 ;;
|
|
|
1687 ;; See
|
|
|
1688 ;; <URL:http://www.eit.com/goodies/lists/www.lists/www-html.1995q3/0603.html>
|
|
|
1689 ;;
|
|
|
1690 ;; Questions: Does EMBED require the end-tag? How does NOEMBED fit
|
|
|
1691 ;; into this? Where can EMBED appear?
|
|
|
1692 ;;
|
|
|
1693 ;; Nov. 25 1995: a new spec for EMBED (also an I-D):
|
|
|
1694 ;; <URL:http://www.cs.princeton.edu/~burchard/www/interactive/>
|
|
|
1695 ;;
|
|
|
1696 ;; Here is my guess how to code EMBED:
|
|
|
1697 ((embed)
|
|
|
1698 (content-model . [((noembed) nil nil (*close))]))
|
|
|
1699 ((noembed)
|
|
|
1700 (content-model . [((%body.content) ; hack hack hack
|
|
|
1701 nil
|
|
|
1702 (((%text) p))
|
|
|
1703 nil)]))
|
|
|
1704 ;;
|
|
|
1705 ;; FRAMESET is a Netscape thing.
|
|
|
1706 ;; <URL:http://www.eit.com/goodies/lists/www.lists/www-html.1995q3/0588.html>
|
|
|
1707 ((frameset)
|
|
|
1708 (content-model . [((noframes frame frameset) nil nil nil)]))
|
|
|
1709 ((noframes)
|
|
|
1710 (content-model . [((%body.content)
|
|
|
1711 nil
|
|
|
1712 ;; Push <P> before data characters. Non-SGML.
|
|
|
1713 (((%text) p))
|
|
|
1714 nil)]))
|
|
|
1715 ((frame)
|
|
|
1716 (content-model . EMPTY))
|
|
|
1717 ;;
|
|
|
1718 ;; APPLET is a Java thing.
|
|
|
1719 ;; <URL:http://java.sun.com/JDK-beta/filesinkit/README>
|
|
|
1720 ((applet)
|
|
|
1721 ;; I really don't want to add another ANY content-model.
|
|
|
1722 (content-model . XINHERIT)
|
|
|
1723 (inclusions . (param)))
|
|
|
1724 ((param)
|
|
|
1725 (content-model . EMPTY))
|
|
|
1726 ;; backward compatibility with old Java.
|
|
|
1727 ((app)
|
|
|
1728 (content-model . EMPTY))
|
|
|
1729 ;; Client-side image maps.
|
|
|
1730 ;; <URL:ftp://ds.internic.net/internet-drafts/draft-seidman-clientsideimagemap-01.txt>
|
|
|
1731 ;; *** The only problem is that I don't know in what elements MAP
|
|
|
1732 ;; can appear, so none of this is reachable yet.
|
|
|
1733 ((map)
|
|
|
1734 (content-model . [((area) nil nil nil)]))
|
|
|
1735 ((area)
|
|
|
1736 (content-model . EMPTY))
|
|
|
1737 )))))
|
|
|
1738
|
|
|
1739
|
|
|
1740 ;;;
|
|
|
1741 ;;; Omitted tag inference using state transition tables.
|
|
|
1742 ;;;
|
|
|
1743
|
|
|
1744 (eval-when-compile
|
|
|
1745
|
|
|
1746 (w3-p-s-var-def w3-p-s-includep)
|
|
|
1747 (w3-p-s-var-def w3-p-s-state-transitions)
|
|
|
1748 (w3-p-s-var-def w3-p-s-transition)
|
|
|
1749 (w3-p-s-var-def w3-p-s-tran-list)
|
|
|
1750 (w3-p-s-var-def w3-p-s-content-model)
|
|
|
1751 (w3-p-s-var-def w3-p-s-except)
|
|
|
1752 ;; Uses free variables:
|
|
|
1753 ;; w3-p-d-current-element, w3-p-d-exceptions
|
|
|
1754 ;; Destroys free variables:
|
|
|
1755 ;; w3-p-s-includep, w3-p-s-state-transitions, w3-p-s-transition,
|
|
|
1756 ;; w3-p-s-tran-list, w3-p-s-content-model, w3-p-s-except
|
|
|
1757 ;; Returns t if the element or data characters should be included.
|
|
|
1758 ;; Returns nil if the element or data characters should be discarded.
|
|
|
1759 (defsubst w3-grok-tag-or-data (tag-name)
|
|
|
1760 (while
|
|
|
1761 (cond
|
|
|
1762 ((symbolp (setq w3-p-s-content-model
|
|
|
1763 (w3-element-content-model w3-p-d-current-element)))
|
|
|
1764 (or (and (memq w3-p-s-content-model
|
|
|
1765 '(CDATA RCDATA XCDATA XXCDATA))
|
|
|
1766 (memq tag-name '(*data *space)))
|
|
|
1767 ;; *** Implement ANY.
|
|
|
1768 (error "impossible"))
|
|
|
1769 (setq w3-p-s-includep t)
|
|
|
1770 ;; Exit loop.
|
|
|
1771 nil)
|
|
|
1772 (t
|
|
|
1773 ;; We have a complex content model.
|
|
|
1774 ;; Cache some data from the element info structure. Format is:
|
|
|
1775 ;; (INCLUDES INCSPACEP (((TAG ...) . TRANSITION) ...) DEFAULT)
|
|
|
1776 (setq w3-p-s-state-transitions
|
|
|
1777 (aref w3-p-s-content-model
|
|
|
1778 (w3-element-state w3-p-d-current-element)))
|
|
|
1779
|
|
|
1780 ;; Optimize the common cases.
|
|
|
1781 (cond
|
|
|
1782 ((eq '*space tag-name)
|
|
|
1783 ;; Optimizing the (*space *discard *same nil) transition.
|
|
|
1784 (setq w3-p-s-includep (car (cdr w3-p-s-state-transitions)))
|
|
|
1785 ;; Don't loop.
|
|
|
1786 nil)
|
|
|
1787 ((and (not (setq w3-p-s-except
|
|
|
1788 (assq tag-name w3-p-d-exceptions)))
|
|
|
1789 (memq tag-name (car w3-p-s-state-transitions)))
|
|
|
1790 ;; Equivalent to a transition of (TAG *include *same nil).
|
|
|
1791 ;; So we are done, return t to caller.
|
|
|
1792 (setq w3-p-s-includep t)
|
|
|
1793 ;; Exit loop.
|
|
|
1794 nil)
|
|
|
1795 (t
|
|
|
1796 ;; The general case.
|
|
|
1797 (cond
|
|
|
1798 ;; Handle inclusions and exclusions.
|
|
|
1799 (w3-p-s-except
|
|
|
1800 (setq w3-p-s-transition (cdr w3-p-s-except)))
|
|
|
1801 ;; See if the transition is in the complex transitions
|
|
|
1802 ;; component.
|
|
|
1803 ((progn
|
|
|
1804 (setq w3-p-s-tran-list
|
|
|
1805 (car (cdr (cdr w3-p-s-state-transitions))))
|
|
|
1806 (setq w3-p-s-transition nil)
|
|
|
1807 (while w3-p-s-tran-list
|
|
|
1808 (cond ((memq tag-name (car (car w3-p-s-tran-list)))
|
|
|
1809 ;; We've found a transition.
|
|
|
1810 (setq w3-p-s-transition
|
|
|
1811 (cdr (car w3-p-s-tran-list)))
|
|
|
1812 (setq w3-p-s-tran-list nil))
|
|
|
1813 (t
|
|
|
1814 (setq w3-p-s-tran-list (cdr w3-p-s-tran-list)))))
|
|
|
1815 ;; Check if we found it.
|
|
|
1816 w3-p-s-transition)
|
|
|
1817 ;; body of cond clause empty
|
|
|
1818 )
|
|
|
1819 ;; Try finding the transition in the DEFAULT component of the
|
|
|
1820 ;; transition table, but avoid doing this for unknown elements,
|
|
|
1821 ;; always use the default-default for them.
|
|
|
1822 ((and (or (eq '*data tag-name)
|
|
|
1823 (w3-known-element-p tag-name))
|
|
|
1824 (setq w3-p-s-transition
|
|
|
1825 (nth 3 w3-p-s-state-transitions)))
|
|
|
1826 ;; body of cond clause empty
|
|
|
1827 )
|
|
|
1828 (t
|
|
|
1829 ;; Supply a default-default transition.
|
|
|
1830 (if (not (or (eq '*data tag-name)
|
|
|
1831 (w3-known-element-p tag-name)))
|
|
|
1832 (setq w3-p-s-transition
|
|
|
1833 '(*discard *same "unknown element"))
|
|
|
1834
|
|
|
1835 ;; Decide whether to *close or *discard
|
|
|
1836 ;; based on whether this element would be
|
|
|
1837 ;; accepted as valid in an open ancestor.
|
|
|
1838 (let ((open-list w3-p-d-open-element-stack)
|
|
|
1839 (all-end-tags-omissible
|
|
|
1840 (w3-element-end-tag-omissible w3-p-d-current-element))
|
|
|
1841 state-transitions tran-list)
|
|
|
1842 (if (catch 'found
|
|
|
1843 (while open-list
|
|
|
1844 (setq state-transitions
|
|
|
1845 (aref (w3-element-content-model
|
|
|
1846 (car open-list))
|
|
|
1847 (w3-element-state (car open-list))))
|
|
|
1848 (if (memq tag-name (car state-transitions))
|
|
|
1849 (throw 'found t))
|
|
|
1850 (setq tran-list (nth 2 state-transitions))
|
|
|
1851 (while tran-list
|
|
|
1852 (cond ((memq tag-name (car (car tran-list)))
|
|
|
1853 (if (not (nth 3 (car tran-list)))
|
|
|
1854 ;; Not an error transition.
|
|
|
1855 (throw 'found t))
|
|
|
1856 (setq tran-list nil))
|
|
|
1857 (t
|
|
|
1858 (setq tran-list (cdr tran-list)))))
|
|
|
1859 ;; The input item is not accepted in this
|
|
|
1860 ;; ancestor. Try again in next ancestor.
|
|
|
1861 (or (w3-element-end-tag-omissible (car open-list))
|
|
|
1862 (setq all-end-tags-omissible nil))
|
|
|
1863 (setq open-list (cdr open-list)))
|
|
|
1864 nil)
|
|
|
1865 (setq w3-p-s-transition
|
|
|
1866 (if (w3-element-end-tag-omissible
|
|
|
1867 w3-p-d-current-element)
|
|
|
1868 (if all-end-tags-omissible
|
|
|
1869 ;; Probably indicates a need to debug
|
|
|
1870 ;; the DTD state-transition tables.
|
|
|
1871 '(*close *same
|
|
|
1872 "missing transition in DTD?")
|
|
|
1873 ;; Error will be reported later.
|
|
|
1874 '(*close *same))
|
|
|
1875 '(*close *same "not allowed here")))
|
|
|
1876 (setq w3-p-s-transition
|
|
|
1877 '(*discard *same "not allowed here")))))))
|
|
|
1878
|
|
|
1879 ;; We have found a transition to take. The transition is of
|
|
|
1880 ;; the format (ACTION NEW-STATE ERRORP) where the latter two
|
|
|
1881 ;; items are optional.
|
|
|
1882
|
|
|
1883 ;; First, handle any state-change.
|
|
|
1884 (or (memq (car-safe (cdr w3-p-s-transition)) '(nil *same))
|
|
|
1885 (w3-set-element-state
|
|
|
1886 w3-p-d-current-element
|
|
|
1887 (if (eq '*next (car-safe (cdr w3-p-s-transition)))
|
|
|
1888 (1+ (w3-element-state w3-p-d-current-element))
|
|
|
1889 (car-safe (cdr w3-p-s-transition)))))
|
|
|
1890
|
|
|
1891 ;; Handle any error message.
|
|
|
1892 (if (car-safe (cdr-safe (cdr w3-p-s-transition)))
|
|
|
1893 (w3-debug-html
|
|
|
1894 :mandatory-if (and (eq '*data tag-name)
|
|
|
1895 (eq '*discard (car w3-p-s-transition)))
|
|
|
1896 (format "Bad %s [%s], %s"
|
|
|
1897 (if (eq '*data tag-name)
|
|
|
1898 "data characters"
|
|
|
1899 (concat "start-tag "
|
|
|
1900 (w3-sgml-name-to-string tag-name)))
|
|
|
1901 (if (stringp (car (cdr (cdr w3-p-s-transition))))
|
|
|
1902 (car (cdr (cdr w3-p-s-transition)))
|
|
|
1903 "not allowed here")
|
|
|
1904 (let ((action (car w3-p-s-transition)))
|
|
|
1905 (cond ((eq '*discard action)
|
|
|
1906 "discarding bad item")
|
|
|
1907 ((eq '*close action)
|
|
|
1908 (concat "inferring </"
|
|
|
1909 (w3-sgml-name-to-string
|
|
|
1910 (w3-element-name
|
|
|
1911 w3-p-d-current-element))
|
|
|
1912 ">"))
|
|
|
1913 ((eq '*include action)
|
|
|
1914 "including bad item anyway")
|
|
|
1915 ((eq '*retry action)
|
|
|
1916 "*retry ??? you shouldn't see this")
|
|
|
1917 (t
|
|
|
1918 (concat "inferring <"
|
|
|
1919 (w3-sgml-name-to-string action)
|
|
|
1920 ">")))))))
|
|
|
1921
|
|
|
1922 ;; Handle the action.
|
|
|
1923 (cond
|
|
|
1924 ((eq '*include (car w3-p-s-transition))
|
|
|
1925 (setq w3-p-s-includep t)
|
|
|
1926 ;; Exit loop.
|
|
|
1927 nil)
|
|
|
1928 ((eq '*close (car w3-p-s-transition))
|
|
|
1929 ;; Perform end-tag inference.
|
|
|
1930 (w3-close-element) ; don't pass parameter
|
|
|
1931 ;; Loop and try again in parent element's content-model.
|
|
|
1932 t)
|
|
|
1933 ((eq '*discard (car w3-p-s-transition))
|
|
|
1934 (setq w3-p-s-includep nil)
|
|
|
1935 ;; Exit loop.
|
|
|
1936 nil)
|
|
|
1937 ((eq '*retry (car w3-p-s-transition))
|
|
|
1938 ;; Loop and try again after state change.
|
|
|
1939 t)
|
|
|
1940 ((symbolp (car w3-p-s-transition))
|
|
|
1941 ;; We need to open another element to contain the text,
|
|
|
1942 ;; probably a <P> (look in the state table).
|
|
|
1943 (w3-open-element (car w3-p-s-transition) nil)
|
|
|
1944 ;; Now we loop and try again in the new element's
|
|
|
1945 ;; content-model.
|
|
|
1946 t)
|
|
|
1947 (t
|
|
|
1948 (error "impossible")))))))
|
|
|
1949
|
|
|
1950 ;; Empty while loop body.
|
|
|
1951 )
|
|
|
1952
|
|
|
1953 ;; Return value to user indicating whether to include or discard item:
|
|
|
1954 ;; t ==> include
|
|
|
1955 ;; nil ==> discard
|
|
|
1956 w3-p-s-includep)
|
|
|
1957
|
|
|
1958 )
|
|
|
1959
|
|
|
1960
|
|
|
1961 ;;;
|
|
|
1962 ;;; Main parser.
|
|
|
1963 ;;;
|
|
|
1964
|
|
|
1965 (defvar w3-last-parse-tree nil
|
|
|
1966 "Used for debugging only. Stores the most recently computed parse tree
|
|
|
1967 \(a tree, not a parse tag stream\).")
|
|
|
1968
|
|
|
1969 (defun w3-display-parse-tree (&optional ptree)
|
|
|
1970 (interactive)
|
|
|
1971 (with-output-to-temp-buffer "W3 HTML Parse Tree"
|
|
|
1972 (set-buffer standard-output)
|
|
|
1973 (emacs-lisp-mode)
|
|
|
1974 (require 'pp)
|
|
|
1975 (pp (or ptree w3-last-parse-tree))))
|
|
|
1976
|
|
|
1977 (defalias 'w3-display-last-parse-tree 'w3-display-parse-tree)
|
|
|
1978
|
|
|
1979 ;; For compatibility with the old parser interface.
|
|
|
1980 (defalias 'w3-preparse-buffer 'w3-parse-buffer)
|
|
|
1981
|
|
|
1982 ;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
|
1983 ;; % %
|
|
|
1984 ;; % This is the *ONLY* valid entry point in this file! %
|
|
|
1985 ;; % DO NOT call any of the other functions! %
|
|
|
1986 ;; % %
|
|
|
1987 ;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
|
1988 (defun w3-parse-buffer (&optional buff nodraw)
|
|
|
1989 "Parse contents of BUFF as HTML.
|
|
|
1990 BUFF defaults to the value of url-working-buffer.
|
|
|
1991 Destructively alters contents of BUFF.
|
|
|
1992 Unless optional second argument NODRAW is non-nil, calls the display
|
|
|
1993 engine on the parsed HTML.
|
|
|
1994 Returns a data structure containing the parsed information."
|
|
|
1995
|
|
|
1996 (set-buffer (or buff url-working-buffer))
|
|
|
1997 (setq buff (current-buffer))
|
|
|
1998 (set-syntax-table w3-sgml-md-syntax-table)
|
|
|
1999 (buffer-disable-undo (current-buffer))
|
|
|
2000 (widen) ; sanity checking
|
|
|
2001 (goto-char (point-min))
|
|
|
2002 (setq case-fold-search t) ; allows smaller regexp patterns
|
|
|
2003
|
|
|
2004 ;; Some unknown pre-parse buffer munging.
|
|
|
2005 (if (fboundp 'sera-to-fidel-marker)
|
|
|
2006 (let ((sera-being-called-by-w3 t))
|
|
|
2007 ;; eval stops the compiler from complaining.
|
|
|
2008 (eval '(sera-to-fidel-marker))))
|
|
|
2009 (goto-char (point-min))
|
|
|
2010
|
|
|
2011 ;; *** Should premunge line boundaries.
|
|
|
2012 ;; ********************
|
|
|
2013
|
|
|
2014 ;; Prepare another buffer to draw in unless told not to.
|
|
|
2015 (if (not nodraw)
|
|
|
2016 (w3-prepare-draw-buffer-for-parse-buffer))
|
|
|
2017
|
|
|
2018 (let* (
|
|
|
2019 ;; Speed hack, see the variable doc string.
|
|
|
2020 (gc-cons-threshold (if (> w3-gc-cons-threshold-multiplier 0)
|
|
|
2021 (* w3-gc-cons-threshold-multiplier
|
|
|
2022 gc-cons-threshold)
|
|
|
2023 gc-cons-threshold))
|
|
|
2024
|
|
|
2025 ;; Used to determine if we made any progress since the last loop.
|
|
|
2026 (last-loop-start (point-min))
|
|
|
2027
|
|
|
2028 ;; How many iterations of the main loop have occurred. Used only
|
|
|
2029 ;; to send messages to the user periodically, since this function
|
|
|
2030 ;; can take some time.
|
|
|
2031 (loop-count 0)
|
|
|
2032
|
|
|
2033 ;; Precomputing the loop-invariant parts of this for speed.
|
|
|
2034 (status-message-format
|
|
|
2035 (if url-show-status
|
|
|
2036 (format "Parsed %%3d%%%% of %d..." (- (point-max) (point-min)))))
|
|
|
2037
|
|
|
2038 ;; Use a float value for 100 if possible, otherwise integer.
|
|
|
2039 ;; Determine which we can use outside of the loop for speed.
|
|
|
2040 (one-hundred (funcall (if (fboundp 'float) 'float 'identity) 100))
|
|
|
2041
|
|
|
2042 ;; Speed up checking whether to do incremental display.
|
|
|
2043 (w3-do-incremental-display (if nodraw nil w3-do-incremental-display))
|
|
|
2044
|
|
|
2045 ;; Used to convert parse tree to tag stream that old display
|
|
|
2046 ;; engine expects. Will change when display engine is rewritten.
|
|
|
2047 (parse-tag-stream '(*dummy))
|
|
|
2048
|
|
|
2049 ;; See doc string.
|
|
|
2050 (w3-p-d-parse-tag-stream-tail-pointer parse-tag-stream)
|
|
|
2051
|
|
|
2052 ;; Points to cons cell in parse-tag-stream whose car is the last
|
|
|
2053 ;; item that has been sent to display engine.
|
|
|
2054 (parse-tag-stream-last-displayed-item parse-tag-stream)
|
|
|
2055
|
|
|
2056 ;; The buffer which contains the HTML we are parsing. This
|
|
|
2057 ;; variable is used to avoid using the more expensive
|
|
|
2058 ;; save-excursion.
|
|
|
2059 (parse-buffer (current-buffer))
|
|
|
2060
|
|
|
2061 ;; Points to start of region of text since the previous tag.
|
|
|
2062 (between-tags-start (point-min))
|
|
|
2063
|
|
|
2064 ;; Points past end of region of text since the previous tag. Only
|
|
|
2065 ;; non-nil when the region has been completely determined and is
|
|
|
2066 ;; ready to be processed.
|
|
|
2067 between-tags-end
|
|
|
2068
|
|
|
2069 ;; See doc string.
|
|
|
2070 w3-p-d-tag-name
|
|
|
2071
|
|
|
2072 ;; See doc string.
|
|
|
2073 w3-p-d-end-tag-p
|
|
|
2074
|
|
|
2075 ;; Is the tag we are looking at a null-end-tag-enabling
|
|
|
2076 ;; start-tag?
|
|
|
2077 net-tag-p
|
|
|
2078
|
|
|
2079 ;; Attributes of the tag we are looking at. An alist whose items
|
|
|
2080 ;; are pairs of the form (SYMBOL . STRING).
|
|
|
2081 tag-attributes
|
|
|
2082
|
|
|
2083 ;; Points past end of attribute value we are looking at. Points
|
|
|
2084 ;; past the syntactic construct, not the value of the attribute,
|
|
|
2085 ;; which may be at (1- attribute-value-end).
|
|
|
2086 attribute-value-end
|
|
|
2087
|
|
|
2088 ;; Points past end of tag we are looking at.
|
|
|
2089 tag-end
|
|
|
2090
|
|
|
2091 ;; See doc string.
|
|
|
2092 (w3-p-d-current-element (w3-fresh-element-for-tag '*document))
|
|
|
2093
|
|
|
2094 ;; See doc string.
|
|
|
2095 (w3-p-d-open-element-stack (list (w3-fresh-element-for-tag '*holder)))
|
|
|
2096
|
|
|
2097 ;; ***not implemented yet***
|
|
|
2098 (marked-section-undo-stack nil)
|
|
|
2099
|
|
|
2100 ;; See doc string.
|
|
|
2101 (w3-p-d-debug-url t)
|
|
|
2102
|
|
|
2103 ;; Any of the following variables with the comment ";*NESTED*"
|
|
|
2104 ;; are syntactic or semantic features that were introduced by
|
|
|
2105 ;; some containing element or marked section which will be undone
|
|
|
2106 ;; when we close that element or marked section.
|
|
|
2107
|
|
|
2108 ;; See doc string.
|
|
|
2109 (w3-p-d-non-markup-chars nil) ;*NESTED*
|
|
|
2110
|
|
|
2111 ;; See doc string.
|
|
|
2112 (w3-p-d-null-end-tag-enabled nil) ;*NESTED*
|
|
|
2113
|
|
|
2114 ;; See doc string.
|
|
|
2115 (w3-p-d-in-parsed-marked-section nil) ;*NESTED*
|
|
|
2116
|
|
|
2117 ;; See doc string.
|
|
|
2118 (w3-p-d-shortrefs nil) ;*NESTED*
|
|
|
2119
|
|
|
2120 ;; See doc string.
|
|
|
2121 (w3-p-d-shortref-chars nil) ;*NESTED*
|
|
|
2122
|
|
|
2123 ;; ******* maybe not needed.
|
|
|
2124 ;;
|
|
|
2125 ;; ;; Are we recognizing start-tags?
|
|
|
2126 ;; (recognizing-start-tags t) ;*NESTED*
|
|
|
2127 ;;
|
|
|
2128 ;; ;; Are we recognizing end-tags? If this is non-nil and not t,
|
|
|
2129 ;; ;; then only the end tag of the current open element is
|
|
|
2130 ;; ;; recognized.
|
|
|
2131 ;; (recognizing-end-tags t) ;*NESTED*
|
|
|
2132
|
|
|
2133 ;; See doc string.
|
|
|
2134 (w3-p-d-exceptions nil) ;*NESTED*
|
|
|
2135
|
|
|
2136 ;; Scratch variables used in this function
|
|
|
2137 ref attr-name attr-value content-model content open-list
|
|
|
2138 )
|
|
|
2139 ;; Scratch variables used by macros and defsubsts we call.
|
|
|
2140 (w3-p-s-let-bindings
|
|
|
2141
|
|
|
2142 (w3-update-non-markup-chars)
|
|
|
2143
|
|
|
2144 ;; Main loop. Handle markup as follows:
|
|
|
2145 ;;
|
|
|
2146 ;; non-empty tag: Handle the region since the previous tag as PCDATA,
|
|
|
2147 ;; RCDATA, CDATA, if allowed by syntax. Then handle the tag.
|
|
|
2148 ;;
|
|
|
2149 ;; general entity (&name;): expand it and parse the result.
|
|
|
2150 ;;
|
|
|
2151 ;; shortref (_, {, }, and ^ in math stuff): Expand it and parse the
|
|
|
2152 ;; result.
|
|
|
2153 ;;
|
|
|
2154 ;; SGML marked section (<![ keywords [ conditional-text ]]>): Either
|
|
|
2155 ;; strip the delimiters and parse the result or delete.
|
|
|
2156 ;;
|
|
|
2157 ;; comment: Delete.
|
|
|
2158 ;;
|
|
|
2159 ;; empty tag (<>, </>): Handle as the appropriate tag.
|
|
|
2160 ;;
|
|
|
2161 ;; markup declaration (e.g. <!DOCTYPE ...>): Delete.
|
|
|
2162 ;;
|
|
|
2163 ;; SGML processing instruction (<?name>): Delete.
|
|
|
2164 ;;
|
|
|
2165 (while
|
|
|
2166 ;; Continue as long as we processed something last time and we
|
|
|
2167 ;; have more to process.
|
|
|
2168 (prog1
|
|
|
2169 (not (and (= last-loop-start (point))
|
|
|
2170 (eobp)))
|
|
|
2171 (setq last-loop-start (point)))
|
|
|
2172
|
|
|
2173 ;; Display progress messages if asked and/or do incremental display
|
|
|
2174 ;; of results
|
|
|
2175 (cond ((= 0 (% (setq loop-count (1+ loop-count)) 40))
|
|
|
2176 (if w3-do-incremental-display
|
|
|
2177 (w3-pause))
|
|
|
2178 (if status-message-format
|
|
|
2179 (message status-message-format
|
|
|
2180 ;; Percentage of buffer processed.
|
|
|
2181 (/ (* (point) one-hundred) (point-max))))))
|
|
|
2182
|
|
|
2183 ;; Go to next interesting thing in the buffer.
|
|
|
2184 (skip-chars-forward w3-p-d-non-markup-chars)
|
|
|
2185
|
|
|
2186 ;; We are looking at a markup-starting character, and invalid
|
|
|
2187 ;; character, or end of buffer.
|
|
|
2188 (cond
|
|
|
2189
|
|
|
2190 ((= ?< (following-char))
|
|
|
2191
|
|
|
2192 ;; We are looking at a tag, comment, markup declaration, SGML marked
|
|
|
2193 ;; section, SGML processing instruction, or non-markup "<".
|
|
|
2194 (forward-char)
|
|
|
2195 (cond
|
|
|
2196
|
|
|
2197 ((looking-at "/?\\([a-z][-a-z0-9.]*\\)")
|
|
|
2198 ;; We are looking at a non-empty tag.
|
|
|
2199
|
|
|
2200 (setq w3-p-d-tag-name
|
|
|
2201 (intern (downcase (buffer-substring (match-beginning 1)
|
|
|
2202 (match-end 1)))))
|
|
|
2203 (setq w3-p-d-end-tag-p (= ?/ (following-char)))
|
|
|
2204 (setq between-tags-end (1- (point)))
|
|
|
2205 (goto-char (match-end 0))
|
|
|
2206
|
|
|
2207 ;; Read the attributes from a start-tag.
|
|
|
2208 (or
|
|
|
2209 w3-p-d-end-tag-p
|
|
|
2210
|
|
|
2211 ;; Attribute values can be:
|
|
|
2212 ;; "STRING" where STRING does not contain the double quote
|
|
|
2213 ;; 'STRING' where STRING does not contain the single quote
|
|
|
2214 ;; name-start character, *name character
|
|
|
2215 ;; *name character
|
|
|
2216 ;; Digit, +name character
|
|
|
2217 ;; +Digit
|
|
|
2218 ;; or a SPACE-separated list of one of the last four
|
|
|
2219 ;; possibilities (there is a comment somewhere that this is a
|
|
|
2220 ;; misinterpretation of the grammar, so we ignore this
|
|
|
2221 ;; possibility).
|
|
|
2222 (while
|
|
|
2223 (looking-at
|
|
|
2224 (eval-when-compile
|
|
|
2225 (concat
|
|
|
2226 ;; Leading whitespace.
|
|
|
2227 "[ \n\r\t]*"
|
|
|
2228 ;; The attribute name, possibly with a bad syntax
|
|
|
2229 ;; component.
|
|
|
2230 "\\([a-z][-a-z0-9.]*\\(\\([_][-a-z0-9._]*\\)?\\)\\)"
|
|
|
2231 ;; Trailing whitespace and perhaps an "=".
|
|
|
2232 "[ \n\r\t]*\\(\\(=[ \n\r\t]*\\)?\\)")))
|
|
|
2233
|
|
|
2234 (cond ((/= (match-beginning 2) (match-end 2))
|
|
|
2235 (w3-debug-html
|
|
|
2236 :nocontext
|
|
|
2237 (format "Bad attribute name syntax: %s"
|
|
|
2238 (buffer-substring (match-beginning 1)
|
|
|
2239 (match-end 1))))))
|
|
|
2240
|
|
|
2241 (setq attr-name
|
|
|
2242 (intern (downcase (buffer-substring (match-beginning 1)
|
|
|
2243 (match-end 1)))))
|
|
|
2244 (goto-char (match-end 0))
|
|
|
2245 (cond
|
|
|
2246 ((< (match-beginning 4) (match-end 4))
|
|
|
2247 ;; A value was specified (e.g. ATTRIBUTE=VALUE).
|
|
|
2248 (cond
|
|
|
2249 ((looking-at
|
|
|
2250 (eval-when-compile
|
|
|
2251 (concat
|
|
|
2252 ;; Literal with double quotes.
|
|
|
2253 "\"\\([^\"]*\\)\""
|
|
|
2254 "\\|"
|
|
|
2255 ;; Literal with single quotes.
|
|
|
2256 "'\\([^']\\)*'"
|
|
|
2257 "\\|"
|
|
|
2258 ;; Handle bad HTML conflicting with NET-enabling
|
|
|
2259 ;; start-tags.
|
|
|
2260 "\\([-a-z0-9.]+/[-a-z0-9._/#]+\\)[ \t\n\r>]"
|
|
|
2261 "\\|"
|
|
|
2262 ;; SGML NAME-syntax attribute value.
|
|
|
2263 "\\([-a-z0-9.]+\\)[ \t\n\r></]"
|
|
|
2264 )))
|
|
|
2265 (cond
|
|
|
2266 ((or (match-beginning 1)
|
|
|
2267 (match-beginning 2))
|
|
|
2268 ;; We have an attribute value literal.
|
|
|
2269 (narrow-to-region (1+ (match-beginning 0))
|
|
|
2270 (1- (match-end 0)))
|
|
|
2271
|
|
|
2272 ;; In attribute value literals, EE and RS are ignored
|
|
|
2273 ;; and RE and SEPCHAR characters sequences are
|
|
|
2274 ;; replaced by SPACEs.
|
|
|
2275 ;;
|
|
|
2276 ;; (There is no way right now to get RS into one of
|
|
|
2277 ;; these so that it can be ignored. This is due to
|
|
|
2278 ;; our using Unix line-handling conventions.)
|
|
|
2279 (skip-chars-forward "^&\t\n\r")
|
|
|
2280 (if (eobp)
|
|
|
2281 nil
|
|
|
2282 ;; We must expand entities and replace RS, RE,
|
|
|
2283 ;; and SEPCHAR.
|
|
|
2284 (goto-char (point-min))
|
|
|
2285 (while (progn
|
|
|
2286 (skip-chars-forward "^&")
|
|
|
2287 (not (eobp)))
|
|
|
2288 (w3-expand-entity-at-point-maybe))
|
|
|
2289 (subst-char-in-region (point-min) (point-max) ?\t 32)
|
|
|
2290 (subst-char-in-region (point-min) (point-max) ?\n 32))
|
|
|
2291 ;; Set this after we have changed the size of the
|
|
|
2292 ;; attribute.
|
|
|
2293 (setq attribute-value-end (1+ (point-max))))
|
|
|
2294 ((match-beginning 4)
|
|
|
2295 (setq attribute-value-end (match-end 4))
|
|
|
2296 (narrow-to-region (point) attribute-value-end))
|
|
|
2297 ((match-beginning 3)
|
|
|
2298 (setq attribute-value-end (match-end 3))
|
|
|
2299 (narrow-to-region (point) attribute-value-end)
|
|
|
2300 ;; Horribly illegal non-SGML handling of bad
|
|
|
2301 ;; HTML on the net. This can break valid HTML.
|
|
|
2302 (setq attr-value (buffer-substring (point)
|
|
|
2303 (match-end 3)))
|
|
|
2304 (w3-debug-html :nocontext
|
|
|
2305 (format "Evil attribute value syntax: %s"
|
|
|
2306 (buffer-substring (point-min) (point-max)))))
|
|
|
2307 (t
|
|
|
2308 (error "impossible"))))
|
|
|
2309 ((memq (following-char) '(?\" ?'))
|
|
|
2310 ;; Missing terminating quote character.
|
|
|
2311 (narrow-to-region (point)
|
|
|
2312 (progn
|
|
|
2313 (forward-char 1)
|
|
|
2314 (skip-chars-forward "^ \t\n\r'\"=<>")
|
|
|
2315 (setq attribute-value-end (point))))
|
|
|
2316 (w3-debug-html :nocontext
|
|
|
2317 (format "Attribute value missing end quote: %s"
|
|
|
2318 (buffer-substring (point-min) (point-max))))
|
|
|
2319 (narrow-to-region (1+ (point-min)) (point-max)))
|
|
|
2320 (t
|
|
|
2321 ;; We have a syntactically invalid attribute value. Let's
|
|
|
2322 ;; make a best guess as to what the author intended.
|
|
|
2323 (narrow-to-region (point)
|
|
|
2324 (progn
|
|
|
2325 (skip-chars-forward "^ \t\n\r'\"=<>")
|
|
|
2326 (setq attribute-value-end (point))))
|
|
|
2327 (w3-debug-html :nocontext
|
|
|
2328 (format "Bad attribute value syntax: %s"
|
|
|
2329 (buffer-substring (point-min) (point-max))))))
|
|
|
2330 ;; Now we have isolated the attribute value. We need to
|
|
|
2331 ;; munge the value depending on the syntax of the
|
|
|
2332 ;; attribute.
|
|
|
2333 ;; *** Right now, we only implement the necessary munging
|
|
|
2334 ;; for CDATA attributes, which is none. I'm not sure why
|
|
|
2335 ;; this happens to work for other attributes right now.
|
|
|
2336 ;; For any other kind of attribute, we are supposed to
|
|
|
2337 ;; * smash case
|
|
|
2338 ;; * remove leading/trailing whitespace
|
|
|
2339 ;; * smash multiple space sequences into single spaces
|
|
|
2340 ;; * verify the syntax of each token
|
|
|
2341 (setq attr-value (buffer-substring (point-min) (point-max)))
|
|
|
2342 (widen)
|
|
|
2343 (goto-char attribute-value-end))
|
|
|
2344 (t
|
|
|
2345 ;; No value was specified, in which case NAME should be
|
|
|
2346 ;; taken as ATTRIBUTE=NAME where NAME is one of the
|
|
|
2347 ;; enumerated values for ATTRIBUTE.
|
|
|
2348 ;; We assume here that ATTRIBUTE is the same as NAME.
|
|
|
2349 ;; *** Another piece of code will fix the attribute name if it
|
|
|
2350 ;; is wrong.
|
|
|
2351 (setq attr-value (symbol-name attr-name))))
|
|
|
2352
|
|
|
2353 ;; Accumulate the attributes.
|
|
|
2354 (setq tag-attributes (cons (cons attr-name attr-value)
|
|
|
2355 tag-attributes))))
|
|
|
2356
|
|
|
2357 ;; Process the end of the tag.
|
|
|
2358 (skip-chars-forward " \t\n\r")
|
|
|
2359 (cond ((= ?> (following-char))
|
|
|
2360 ;; Ordinary tag end.
|
|
|
2361 (forward-char 1))
|
|
|
2362 ((and (= ?/ (following-char))
|
|
|
2363 (not w3-p-d-end-tag-p))
|
|
|
2364 ;; This is a NET-enabling start-tag.
|
|
|
2365 (setq net-tag-p t)
|
|
|
2366 (forward-char 1))
|
|
|
2367 ((= ?< (following-char))
|
|
|
2368 ;; *** Strictly speaking, the following text has to
|
|
|
2369 ;; lexically be STAGO or ETAGO, which means that it
|
|
|
2370 ;; can't match some other lexical unit.
|
|
|
2371 ;; Unclosed tag.
|
|
|
2372 nil)
|
|
|
2373 (t
|
|
|
2374 ;; Syntax error.
|
|
|
2375 (w3-debug-html
|
|
|
2376 (format "Bad unclosed %s%s tag"
|
|
|
2377 (if w3-p-d-end-tag-p "/" "")
|
|
|
2378 (w3-sgml-name-to-string w3-p-d-tag-name)))))
|
|
|
2379
|
|
|
2380 (setq tag-end (point)))
|
|
|
2381
|
|
|
2382 ((looking-at "/?>")
|
|
|
2383 ;; We are looking at an empty tag (<>, </>).
|
|
|
2384 (setq w3-p-d-end-tag-p (= ?/ (following-char)))
|
|
|
2385 (setq w3-p-d-tag-name (if w3-p-d-end-tag-p
|
|
|
2386 (w3-element-name w3-p-d-current-element)
|
|
|
2387 ;; *** Strictly speaking, if OMITTAG NO, then
|
|
|
2388 ;; we should use the most recently closed tag.
|
|
|
2389 ;; But OMITTAG YES in HTML and I'm lazy.
|
|
|
2390 (w3-element-name w3-p-d-current-element)))
|
|
|
2391 (setq tag-attributes nil)
|
|
|
2392 ;; *** Make sure this is not at top level.
|
|
|
2393 (setq between-tags-end (1- (point)))
|
|
|
2394 (setq tag-end (match-end 0)))
|
|
|
2395
|
|
|
2396 ;; *** In SGML, <(doctype)element> is valid tag syntax. This
|
|
|
2397 ;; cannot occur in HTML because the CONCUR option is off in the
|
|
|
2398 ;; SGML declaration.
|
|
|
2399
|
|
|
2400 ((looking-at "!--")
|
|
|
2401 ;; We found a comment, delete to end of comment.
|
|
|
2402 (delete-region
|
|
|
2403 (1- (point))
|
|
|
2404 (progn
|
|
|
2405 (forward-char 1)
|
|
|
2406 ;; Skip over pairs of -- ... --.
|
|
|
2407 (if (looking-at "\\(--[^-]*\\(-[^-]+\\)*--[ \t\r\n]*\\)+>")
|
|
|
2408 (goto-char (match-end 0))
|
|
|
2409 ;; Syntax error!
|
|
|
2410 (w3-debug-html
|
|
|
2411 "Bad comment (unterminated or unbalanced \"--\" pairs)")
|
|
|
2412 (forward-char 2)
|
|
|
2413 (or (re-search-forward "--[ \t\r\n]*>" nil t)
|
|
|
2414 (search-forward ">" nil t)))
|
|
|
2415 (point))))
|
|
|
2416
|
|
|
2417 ((looking-at "!>\\|\\?[^>]*>")
|
|
|
2418 ;; We are looking at an empty comment or a processing
|
|
|
2419 ;; instruction. Delete it.
|
|
|
2420 (replace-match "")
|
|
|
2421 (delete-char -1))
|
|
|
2422
|
|
|
2423 ((looking-at "![a-z]")
|
|
|
2424 ;; We are looking at a markup declaration. Delete it.
|
|
|
2425 ;; *** Technically speaking, to handle valid HTML I think we
|
|
|
2426 ;; need to handle "<!USEMAP ... >" declarations. In the future,
|
|
|
2427 ;; to handle general SGML, we should parse "<!DOCTYPE ... >"
|
|
|
2428 ;; declarations as well (which can contain other declarations).
|
|
|
2429 ;; In the very distant future, perhaps we will handle "<!SGML
|
|
|
2430 ;; ... >" declarations.
|
|
|
2431 ;; *** Should warn if it's not SGML, DOCTYPE, or USEMAP.
|
|
|
2432 (backward-char 1)
|
|
|
2433 (delete-region
|
|
|
2434 (point)
|
|
|
2435 (progn
|
|
|
2436 (condition-case nil
|
|
|
2437 (forward-sexp 1)
|
|
|
2438 (error
|
|
|
2439 ;; *** This might not actually be bad syntax, but might
|
|
|
2440 ;; instead be a -- ... -- comment with unbalanced
|
|
|
2441 ;; parentheses somewhere inside the declaration. Handling
|
|
|
2442 ;; this properly would require full parsing of markup
|
|
|
2443 ;; declarations, a goal for the future.
|
|
|
2444 (w3-debug-html "Bad <! syntax.")
|
|
|
2445 (skip-chars-forward "^>")
|
|
|
2446 (if (= ?> (following-char))
|
|
|
2447 (forward-char))))
|
|
|
2448 (point))))
|
|
|
2449
|
|
|
2450 ((looking-at "!\\\[\\(\\([ \t\n\r]*[a-z]+\\)+[ \t\n\r]*\\)\\\[")
|
|
|
2451 ;; We are looking at a marked section.
|
|
|
2452 ;; *** Strictly speaking, we should issue a warning if the
|
|
|
2453 ;; keywords are invalid or missing or if the "[" does not follow.
|
|
|
2454 ;; We must look at the keywords to understand how to parse it.
|
|
|
2455 ;; *** Strictly speaking, we should perform parameter entity
|
|
|
2456 ;; substitution on the keywords first.
|
|
|
2457 (goto-char (match-beginning 1))
|
|
|
2458 (insert ?\))
|
|
|
2459 (goto-char (1- (match-beginning 0)))
|
|
|
2460 (delete-char 3)
|
|
|
2461 (insert ?\()
|
|
|
2462 (backward-char 1)
|
|
|
2463 (let* ((keywords (read (current-buffer)))
|
|
|
2464 ;; Multiple keywords may appear, but only the most
|
|
|
2465 ;; significant takes effect. Rank order is IGNORE, CDATA,
|
|
|
2466 ;; RCDATA, INCLUDE, and TEMP. INCLUDE and TEMP have the
|
|
|
2467 ;; same effect.
|
|
|
2468 (keyword (car-safe (cond ((memq 'IGNORE keywords))
|
|
|
2469 ((memq 'CDATA keywords))
|
|
|
2470 ((memq 'RCDATA keywords))
|
|
|
2471 ((memq 'INCLUDE keywords))
|
|
|
2472 ((memq 'TEMP keywords))))))
|
|
|
2473 (or (= ?\[ (following-char))
|
|
|
2474 ;; I probably shouldn't even check this, since it is so
|
|
|
2475 ;; impossible.
|
|
|
2476 (error "impossible"))
|
|
|
2477 (forward-char 1)
|
|
|
2478 (delete-region (1- (match-beginning 0)) (point))
|
|
|
2479 (cond ((eq 'IGNORE keyword)
|
|
|
2480 ;; Scan forward skipping over matching <![ ... ]]>
|
|
|
2481 ;; until we find an unmatched "]]>".
|
|
|
2482 (let ((ignore-nesting 1)
|
|
|
2483 (start-pos (point)))
|
|
|
2484 (while (> ignore-nesting 0)
|
|
|
2485 (if (re-search-forward "<!\\\\\[\\|\]\]>" nil t)
|
|
|
2486 (setq ignore-nesting
|
|
|
2487 (if (eq ?> (preceding-char))
|
|
|
2488 (1- ignore-nesting)
|
|
|
2489 (1+ ignore-nesting)))
|
|
|
2490 (w3-debug-html
|
|
|
2491 "Unterminated IGNORE marked section.")
|
|
|
2492 (setq ignore-nesting 0)
|
|
|
2493 (goto-char start-pos)))
|
|
|
2494 (delete-region start-pos (point))))
|
|
|
2495 ((eq 'CDATA keyword)
|
|
|
2496 (error "***unimplemented***"))
|
|
|
2497 ((eq 'RCDATA keyword)
|
|
|
2498 (error "***unimplemented***"))
|
|
|
2499 ((memq keyword '(INCLUDE TEMP))
|
|
|
2500 (error "***unimplemented***")))))
|
|
|
2501 ((and (looking-at "!")
|
|
|
2502 w3-netscape-compatible-comments)
|
|
|
2503 ;; Horribly illegal non-SGML handling of bad HTML on the net.
|
|
|
2504 ;; This can break valid HTML.
|
|
|
2505 ;; This arises because Netscape discards anything looking like
|
|
|
2506 ;; "<!...>". So people expect they can use this construct as
|
|
|
2507 ;; a comment.
|
|
|
2508 (w3-debug-html "Evil <! comment syntax.")
|
|
|
2509 (backward-char 1)
|
|
|
2510 (delete-region
|
|
|
2511 (point)
|
|
|
2512 (progn
|
|
|
2513 (skip-chars-forward "^>")
|
|
|
2514 (if (= ?> (following-char))
|
|
|
2515 (forward-char))
|
|
|
2516 (point))))
|
|
|
2517 (t
|
|
|
2518 ;; This < is not a markup character. Pretend we didn't notice
|
|
|
2519 ;; it at all. We have skipped over the < already, so just loop
|
|
|
2520 ;; again.
|
|
|
2521 )))
|
|
|
2522
|
|
|
2523 ((= ?& (following-char))
|
|
|
2524 (w3-expand-entity-at-point-maybe))
|
|
|
2525
|
|
|
2526 ((and (= ?\] (following-char))
|
|
|
2527 w3-p-d-in-parsed-marked-section
|
|
|
2528 (looking-at "]]>"))
|
|
|
2529 ;; *** handle the end of a parsed marked section.
|
|
|
2530 (error "***unimplemented***"))
|
|
|
2531
|
|
|
2532 ((and (= ?/ (following-char))
|
|
|
2533 w3-p-d-null-end-tag-enabled)
|
|
|
2534 ;; We are looking at a null end tag.
|
|
|
2535 (setq w3-p-d-end-tag-p t)
|
|
|
2536 (setq between-tags-end (point))
|
|
|
2537 (setq tag-end (1+ (point)))
|
|
|
2538 (setq w3-p-d-tag-name (w3-element-name w3-p-d-current-element)))
|
|
|
2539
|
|
|
2540 ;; This can be slow, since we'll hardly ever get here.
|
|
|
2541 ;; *** Strictly speaking, I think we're supposed to handle
|
|
|
2542 ;; shortrefs that begin with the same characters as other markup,
|
|
|
2543 ;; preferring the longest match.
|
|
|
2544 ;; I will assume that shortrefs never begin with <, &, \], /.
|
|
|
2545 ((setq ref (catch 'found-shortref
|
|
|
2546 (let ((refs w3-p-d-shortrefs))
|
|
|
2547 (while refs
|
|
|
2548 (if (looking-at (car (car refs)))
|
|
|
2549 (throw 'found-shortref (cdr (car refs))))
|
|
|
2550 (setq refs (cdr refs))))))
|
|
|
2551 ;; We are looking at a shortref for which there is an
|
|
|
2552 ;; expansion defined in the current syntax. Replace with the
|
|
|
2553 ;; expansion, leaving point at the beginning so it will be parsed
|
|
|
2554 ;; on the next loop.
|
|
|
2555 ;; *** eek. This is wrong if the shortref is for an entity with
|
|
|
2556 ;; CDATA syntax which should not be reparsed for tags.
|
|
|
2557 (replace-match "")
|
|
|
2558 (let ((pt (point)))
|
|
|
2559 (insert ref)
|
|
|
2560 (goto-char pt)))
|
|
|
2561
|
|
|
2562 ((looking-at (eval-when-compile
|
|
|
2563 (concat "[" (w3-invalid-sgml-chars) "]")))
|
|
|
2564 (w3-debug-html
|
|
|
2565 (format "Invalid SGML character: %c" (following-char)))
|
|
|
2566 (insert (or (cdr-safe (assq (following-char)
|
|
|
2567 ;; These characters are apparently
|
|
|
2568 ;; from a Windows character set.
|
|
|
2569 '((146 . "'")
|
|
|
2570 (153 . "TM"))))
|
|
|
2571 ""))
|
|
|
2572 (delete-char 1))
|
|
|
2573
|
|
|
2574 ((eobp)
|
|
|
2575 ;; We have finished the buffer. Make sure we process the last
|
|
|
2576 ;; piece of text, if any.
|
|
|
2577 (setq between-tags-end (point))
|
|
|
2578 ;; We have to test what's on the element stack because this
|
|
|
2579 ;; piece of code gets executed twice.
|
|
|
2580 (cond ((not (eq '*holder (w3-element-name w3-p-d-current-element)))
|
|
|
2581 ;; This forces the calculation of implied omitted end tags.
|
|
|
2582 (setq w3-p-d-tag-name '*document)
|
|
|
2583 (setq w3-p-d-end-tag-p t)
|
|
|
2584 (setq tag-end (point)))))
|
|
|
2585
|
|
|
2586 (t
|
|
|
2587 (error "unreachable code, this can't happen")))
|
|
|
2588
|
|
|
2589 ;; If we have determined the boundaries of a non-empty between-tags
|
|
|
2590 ;; region of text, then handle it.
|
|
|
2591 (cond
|
|
|
2592 (between-tags-end
|
|
|
2593 (cond
|
|
|
2594 ((< between-tags-start between-tags-end)
|
|
|
2595 ;; We have a non-empty between-tags region.
|
|
|
2596
|
|
|
2597 ;; We check if it's entirely whitespace, because we record the
|
|
|
2598 ;; transitions for whitespace separately from those for
|
|
|
2599 ;; data with non-whitespace characters.
|
|
|
2600 (goto-char between-tags-start)
|
|
|
2601 (skip-chars-forward " \t\n\r" between-tags-end)
|
|
|
2602 (cond
|
|
|
2603 ((w3-grok-tag-or-data (prog1
|
|
|
2604 (if (= between-tags-end (point))
|
|
|
2605 '*space
|
|
|
2606 '*data)
|
|
|
2607 (goto-char between-tags-end)))
|
|
|
2608 ;; We have to include the text in the current element's
|
|
|
2609 ;; contents. If this is the first item in the current
|
|
|
2610 ;; element's contents, don't include a leading newline if
|
|
|
2611 ;; there is one. Add a trailing newline as a separate text
|
|
|
2612 ;; item so that it can be removed later if it turns out to
|
|
|
2613 ;; be the last item in the current element's contents when
|
|
|
2614 ;; the current element is closed.
|
|
|
2615 ;; *** We could perform this test before calling
|
|
|
2616 ;; w3-grok-tag-or-data, but it's not clear which will be
|
|
|
2617 ;; faster in practice.
|
|
|
2618 (or (setq content (w3-element-content w3-p-d-current-element))
|
|
|
2619 ;; *** Strictly speaking, in SGML the record end is
|
|
|
2620 ;; carriage return, not line feed.
|
|
|
2621 (if (= ?\n (char-after between-tags-start))
|
|
|
2622 (setq between-tags-start (1+ between-tags-start))))
|
|
|
2623 (if (= between-tags-start (point))
|
|
|
2624 ;; Do nothing.
|
|
|
2625 nil
|
|
|
2626 ;; We are definitely going to add data characters to the
|
|
|
2627 ;; content.
|
|
|
2628 ;; Protocol is that all but last data character item
|
|
|
2629 ;; must have been sent to display engine.
|
|
|
2630 (and content
|
|
|
2631 (stringp (car content))
|
|
|
2632 ;; Gross, disgusting hack to deal with old interface
|
|
|
2633 ;; to display engine. Remove as soon as possible.
|
|
|
2634 (not (memq (w3-element-name w3-p-d-current-element)
|
|
|
2635 '(plaintext style xmp textarea)))
|
|
|
2636 (w3-add-display-item 'text (car content)))
|
|
|
2637 (cond
|
|
|
2638 ((and (= ?\n (preceding-char))
|
|
|
2639 (/= between-tags-start (1- (point))))
|
|
|
2640 (setq content (cons (buffer-substring between-tags-start
|
|
|
2641 (1- (point)))
|
|
|
2642 content))
|
|
|
2643 ;; Gross, disgusting hack to deal with old interface
|
|
|
2644 ;; to display engine. Remove as soon as possible.
|
|
|
2645 (or (memq (w3-element-name w3-p-d-current-element)
|
|
|
2646 '(plaintext style xmp textarea))
|
|
|
2647 (w3-add-display-item 'text (car content)))
|
|
|
2648 (setq content (cons "\n" content)))
|
|
|
2649 (t
|
|
|
2650 (setq content (cons (buffer-substring between-tags-start
|
|
|
2651 (point))
|
|
|
2652 content))))
|
|
|
2653 (w3-set-element-content w3-p-d-current-element content))))))
|
|
|
2654
|
|
|
2655 (setq between-tags-end nil)))
|
|
|
2656
|
|
|
2657 ;; If the previous expression modified (point), then it went to
|
|
|
2658 ;; the value of between-tags-end.
|
|
|
2659
|
|
|
2660 ;; If we found a start or end-tag, we need to handle it.
|
|
|
2661 (cond
|
|
|
2662 (w3-p-d-tag-name
|
|
|
2663
|
|
|
2664 ;; Move past the tag and prepare for next between-tags region.
|
|
|
2665 (goto-char tag-end)
|
|
|
2666 (setq between-tags-start (point))
|
|
|
2667
|
|
|
2668 (cond
|
|
|
2669 (w3-p-d-end-tag-p
|
|
|
2670 ;; Handle an end-tag.
|
|
|
2671 (if (eq w3-p-d-tag-name (w3-element-name w3-p-d-current-element))
|
|
|
2672 (w3-close-element)
|
|
|
2673 ;; Handle the complex version. We have to search up (down?)
|
|
|
2674 ;; the open element stack to find the element that matches (if
|
|
|
2675 ;; any). Then we close all of the elements. On a conforming
|
|
|
2676 ;; SGML document this can do no wrong and it's not
|
|
|
2677 ;; unreasonable on a non-conforming document.
|
|
|
2678
|
|
|
2679 ;; Can't safely modify stack until we know the element we want
|
|
|
2680 ;; to find is in there, so work with a copy.
|
|
|
2681 (setq open-list w3-p-d-open-element-stack)
|
|
|
2682 (while (and open-list
|
|
|
2683 (not (eq w3-p-d-tag-name
|
|
|
2684 (w3-element-name (car open-list)))))
|
|
|
2685 (setq open-list (cdr open-list)))
|
|
|
2686 (cond (open-list
|
|
|
2687 ;; We found a match. Pop elements.
|
|
|
2688 ;; We will use the following value as a sentinel.
|
|
|
2689 (setq open-list (cdr open-list))
|
|
|
2690 (while (not (eq open-list w3-p-d-open-element-stack))
|
|
|
2691 (w3-close-element t))
|
|
|
2692 (w3-close-element))
|
|
|
2693 (t
|
|
|
2694 ;; Bogus end tag.
|
|
|
2695 (w3-debug-html
|
|
|
2696 (format "Unmatched end-tag </%s>"
|
|
|
2697 (w3-sgml-name-to-string w3-p-d-tag-name)))))))
|
|
|
2698 (t
|
|
|
2699 ;; Handle a start-tag.
|
|
|
2700 (cond
|
|
|
2701 ;; Check if the new element is allowed in the current element's
|
|
|
2702 ;; content model.
|
|
|
2703 ((w3-grok-tag-or-data w3-p-d-tag-name)
|
|
|
2704 (w3-open-element w3-p-d-tag-name tag-attributes)
|
|
|
2705
|
|
|
2706 ;; Handle NET-enabling start tags.
|
|
|
2707 (cond ((and net-tag-p
|
|
|
2708 (not w3-p-d-null-end-tag-enabled))
|
|
|
2709 ;; Save old values.
|
|
|
2710 (w3-set-element-undo-list
|
|
|
2711 w3-p-d-current-element
|
|
|
2712 (cons (cons 'w3-p-d-non-markup-chars
|
|
|
2713 w3-p-d-non-markup-chars)
|
|
|
2714 (cons '(w3-p-d-null-end-tag-enabled . nil)
|
|
|
2715 (w3-element-undo-list w3-p-d-current-element))))
|
|
|
2716 ;; Alter syntax.
|
|
|
2717 (setq w3-p-d-null-end-tag-enabled t)
|
|
|
2718 (w3-update-non-markup-chars)))
|
|
|
2719
|
|
|
2720 (setq content-model
|
|
|
2721 (w3-element-content-model w3-p-d-current-element))
|
|
|
2722
|
|
|
2723 ;; If the element does not have parsed contents, then we
|
|
|
2724 ;; can find its contents immediately.
|
|
|
2725 (cond
|
|
|
2726 ((memq content-model '(EMPTY CDATA XCDATA XXCDATA RCDATA))
|
|
|
2727 (cond
|
|
|
2728 ((eq 'EMPTY content-model)
|
|
|
2729 (w3-close-element))
|
|
|
2730 ((eq 'CDATA content-model)
|
|
|
2731 ;; CDATA: all data characters until an end-tag. We'll
|
|
|
2732 ;; process the end-tag on the next loop.
|
|
|
2733 (if (re-search-forward (if w3-p-d-null-end-tag-enabled
|
|
|
2734 "</[a-z>]\\|/"
|
|
|
2735 "</[a-z>]")
|
|
|
2736 nil 'move)
|
|
|
2737 (goto-char (match-beginning 0))))
|
|
|
2738 ((eq 'XCDATA content-model)
|
|
|
2739 ;; XCDATA: special non-SGML-standard mode which includes
|
|
|
2740 ;; all data characters until "</foo" is seen where "foo"
|
|
|
2741 ;; is the name of this element (for XMP and LISTING).
|
|
|
2742 (if (search-forward
|
|
|
2743 (concat "</" (symbol-name
|
|
|
2744 (w3-element-name w3-p-d-current-element)))
|
|
|
2745 nil 'move)
|
|
|
2746 (goto-char (match-beginning 0))))
|
|
|
2747 ((eq 'XXCDATA content-model)
|
|
|
2748 ;; XXCDATA: special non-SGML-standard mode which includes
|
|
|
2749 ;; all data until end-of-entity (end-of-buffer for us)
|
|
|
2750 ;; (for PLAINTEXT).
|
|
|
2751 (goto-char (point-max)))
|
|
|
2752 ((eq 'RCDATA content-model)
|
|
|
2753 ;; RCDATA: all data characters until end-tag is seen,
|
|
|
2754 ;; except that entities are expanded first, although the
|
|
|
2755 ;; expansions are _not_ scanned for end-tags, although the
|
|
|
2756 ;; expansions _are_ scanned for further entity
|
|
|
2757 ;; references.
|
|
|
2758 (while (progn
|
|
|
2759 (if (re-search-forward (if w3-p-d-null-end-tag-enabled
|
|
|
2760 "</[a-z>]\\|[/&]"
|
|
|
2761 "</[a-z>]\\|&")
|
|
|
2762 nil 'move)
|
|
|
2763 (goto-char (match-beginning 0)))
|
|
|
2764 (= ?& (following-char)))
|
|
|
2765 (w3-expand-entity-at-point-maybe)))))))
|
|
|
2766 (t
|
|
|
2767 ;; The element is illegal here. We'll just discard the start
|
|
|
2768 ;; tag as though we never saw it.
|
|
|
2769 ))))
|
|
|
2770
|
|
|
2771 (setq w3-p-d-tag-name nil)
|
|
|
2772 (setq w3-p-d-end-tag-p nil)
|
|
|
2773 (setq net-tag-p nil)
|
|
|
2774 (setq tag-attributes nil)
|
|
|
2775 (setq tag-end nil)))
|
|
|
2776
|
|
|
2777 ;; Hand items to the display engine.
|
|
|
2778 (cond ((not nodraw)
|
|
|
2779 (set-buffer w3-draw-buffer)
|
|
|
2780 (while (not (eq parse-tag-stream-last-displayed-item
|
|
|
2781 w3-p-d-parse-tag-stream-tail-pointer))
|
|
|
2782 (setq parse-tag-stream-last-displayed-item
|
|
|
2783 (cdr parse-tag-stream-last-displayed-item))
|
|
|
2784 ;; We call w3-handle-single-tag from only one spot so that it
|
|
|
2785 ;; is reasonable to inline it, since it is a big function.
|
|
|
2786 (w3-handle-single-tag
|
|
|
2787 (car (car parse-tag-stream-last-displayed-item))
|
|
|
2788 (cdr (car parse-tag-stream-last-displayed-item))))
|
|
|
2789 (set-buffer parse-buffer)))
|
|
|
2790
|
|
|
2791 ;; End of main while loop.
|
|
|
2792 )
|
|
|
2793
|
|
|
2794 ;; We have finished parsing the buffer!
|
|
|
2795 (if status-message-format
|
|
|
2796 (message "%sdone" (format status-message-format 100)))
|
|
|
2797 ;; Do this now so the user can see the full results before Emacs
|
|
|
2798 ;; goes off and garbage-collects for an hour. :-(
|
|
|
2799 (if w3-do-incremental-display
|
|
|
2800 (w3-pause))
|
|
|
2801
|
|
|
2802 ;; *** For debugging, save the true parse tree.
|
|
|
2803 ;; *** Make this look inside *DOCUMENT.
|
|
|
2804 (setq w3-last-parse-tree
|
|
|
2805 (w3-element-content w3-p-d-current-element))
|
|
|
2806
|
|
|
2807 ;; Return the parse in the format expected, a stream of tags
|
|
|
2808 ;; possibly with a buffer at the front.
|
|
|
2809 (if nodraw
|
|
|
2810 ;; Discard the *dummy item at start of list.
|
|
|
2811 (cdr parse-tag-stream)
|
|
|
2812 (cons w3-draw-buffer (cdr parse-tag-stream)))
|
|
|
2813
|
|
|
2814 )))
|
|
|
2815
|
|
|
2816
|
|
|
2817 ;;;
|
|
|
2818 ;;; Initialization of display engine to accept parser output.
|
|
|
2819 ;;;
|
|
|
2820
|
|
|
2821 (defun w3-prepare-draw-buffer-for-parse-buffer ()
|
|
|
2822 (setq list-buffers-directory nil)
|
|
|
2823 (let ((buf (get-buffer-create (url-generate-new-buffer-name
|
|
|
2824 "Untitled")))
|
|
|
2825 (info (mapcar (function (lambda (x) (cons x (symbol-value x))))
|
|
|
2826 w3-persistent-variables)))
|
|
|
2827 (setq w3-draw-buffer buf)
|
|
|
2828 (save-excursion
|
|
|
2829 (set-window-buffer (selected-window) buf)
|
|
|
2830 (set-buffer buf)
|
|
|
2831 (setq w3-draw-buffer (current-buffer))
|
|
|
2832 (erase-buffer)
|
|
|
2833 (buffer-disable-undo (current-buffer))
|
|
|
2834 (mapcar (function (lambda (x) (set (car x) (cdr x)))) info)
|
|
|
2835 (setq w3-last-fill-pos (point))
|
|
|
2836 (setq fill-column (min (- (or w3-strict-width (window-width))
|
|
|
2837 w3-right-border)
|
|
|
2838 (or w3-maximum-line-length (window-width))))
|
|
|
2839 (setq fill-prefix "")
|
|
|
2840 (w3-init-state))))
|
|
|
2841
|
|
|
2842
|
|
|
2843
|
|
|
2844 (provide 'w3-parse)
|
|
|
2845
|
|
|
2846 ;; Local variables:
|
|
|
2847 ;; indent-tabs-mode: nil
|
|
|
2848 ;; end:
|
