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