Mercurial > emacs
comparison lisp/textmodes/xml-lite.el @ 44289:52b704431b5d
Remove redundant name-end attribute.
Simplify parsing by assuming we always start within text.
Make use of sgml-unclosed-tag-p.
author | Mike Williams <mdub@bigfoot.com> |
---|---|
date | Mon, 01 Apr 2002 12:10:53 +0000 |
parents | f259c3857fea |
children | cc29df7efbe8 |
comparison
equal
deleted
inserted
replaced
44288:2630d8a52e4a | 44289:52b704431b5d |
---|---|
51 (skip-chars-backward " \t") | 51 (skip-chars-backward " \t") |
52 (bolp))) | 52 (bolp))) |
53 | 53 |
54 | 54 |
55 ;; Parsing | 55 ;; Parsing |
56 | |
56 (defstruct (xml-lite-tag | 57 (defstruct (xml-lite-tag |
57 (:constructor xml-lite-make-tag (type start end name name-end))) | 58 (:constructor xml-lite-make-tag (type start end name))) |
58 type start end name name-end) | 59 type start end name) |
60 | |
59 (defsubst xml-lite-parse-tag-name () | 61 (defsubst xml-lite-parse-tag-name () |
60 "Skip past a tag-name, and return the name." | 62 "Skip past a tag-name, and return the name." |
61 (buffer-substring-no-properties | 63 (buffer-substring-no-properties |
62 (point) (progn (skip-syntax-forward "w_") (point)))) | 64 (point) (progn (skip-syntax-forward "w_") (point)))) |
63 | 65 |
68 (defsubst xml-lite-looking-at (s) | 70 (defsubst xml-lite-looking-at (s) |
69 (let ((limit (min (+ (point) (length s))))) | 71 (let ((limit (min (+ (point) (length s))))) |
70 (equal s (buffer-substring-no-properties (point) limit)))) | 72 (equal s (buffer-substring-no-properties (point) limit)))) |
71 | 73 |
72 (defun xml-lite-parse-tag-backward () | 74 (defun xml-lite-parse-tag-backward () |
73 "Get information about the parent tag." | 75 "Parse an SGML tag backward, and return information about the tag. |
74 (let ((limit (point)) | 76 Assume that parsing starts from within a textual context. |
75 tag-type tag-start tag-end name name-end) | 77 Leave point at the beginning of the tag." |
76 (with-syntax-table sgml-tag-syntax-table | 78 (let (tag-type tag-start tag-end name) |
77 (cond | 79 (search-backward ">") |
78 | 80 (setq tag-end (1+ (point))) |
79 ((null (re-search-backward "[<>]" nil t))) | 81 (cond |
80 | 82 ((xml-lite-looking-back-at "--") ; comment |
81 ((= ?> (char-after)) ;--- found tag-end --- | 83 (setq tag-type 'comment |
82 (setq tag-end (1+ (point))) | 84 tag-start (search-backward "<!--" nil t))) |
83 (goto-char tag-end) | 85 ((xml-lite-looking-back-at "]]") ; cdata |
84 (cond | 86 (setq tag-type 'cdata |
85 ((xml-lite-looking-back-at "--") ; comment | 87 tag-start (search-backward "<![CDATA[" nil t))) |
86 (setq tag-type 'comment | 88 (t |
87 tag-start (search-backward "<!--" nil t))) | 89 (setq tag-start |
88 ((xml-lite-looking-back-at "]]>") ; cdata | 90 (with-syntax-table sgml-tag-syntax-table |
89 (setq tag-type 'cdata | 91 (goto-char tag-end) |
90 tag-start (search-backward "![CDATA[" nil t))) | 92 (backward-sexp) |
91 (t | 93 (point))) |
92 (setq tag-start (ignore-errors (backward-sexp) (point)))))) | 94 (goto-char (1+ tag-start)) |
93 | 95 (case (char-after) |
94 ((= ?< (char-after)) ;--- found tag-start --- | 96 (?! ; declaration |
95 ;; !!! This should not happen because the caller should be careful | 97 (setq tag-type 'decl)) |
96 ;; that we do not start from within a tag !!! | 98 (?? ; processing-instruction |
97 (setq tag-start (point)) | 99 (setq tag-type 'pi)) |
98 (goto-char (1+ tag-start)) | 100 (?/ ; close-tag |
99 (cond | 101 (forward-char 1) |
100 ((xml-lite-looking-at "!--") ; comment | 102 (setq tag-type 'close |
101 (setq tag-type 'comment | 103 name (xml-lite-parse-tag-name))) |
102 tag-end (search-forward "-->" nil t))) | 104 ((?% ?#) ; JSP tags etc |
103 ((xml-lite-looking-at "![CDATA[") ; cdata | 105 (setq tag-type 'unknown)) |
104 (setq tag-type 'cdata | 106 (t ; open or empty tag |
105 tag-end (search-forward "]]>" nil t))) | 107 (setq tag-type 'open |
106 (t | 108 name (xml-lite-parse-tag-name)) |
107 (goto-char tag-start) | 109 (if (eq ?/ (char-before (- tag-end 1))) |
108 (setq tag-end (ignore-errors (forward-sexp) (point))))))) | 110 (setq tag-type 'empty)))))) |
109 | 111 (goto-char tag-start) |
110 (cond | 112 (xml-lite-make-tag tag-type tag-start tag-end name))) |
111 | |
112 ((or tag-type (null tag-start))) | |
113 | |
114 ((= ?! (char-after (1+ tag-start))) ; declaration | |
115 (setq tag-type 'decl)) | |
116 | |
117 ((= ?? (char-after (1+ tag-start))) ; processing-instruction | |
118 (setq tag-type 'pi)) | |
119 | |
120 ((= ?/ (char-after (1+ tag-start))) ; close-tag | |
121 (goto-char (+ 2 tag-start)) | |
122 (setq tag-type 'close | |
123 name (xml-lite-parse-tag-name) | |
124 name-end (point))) | |
125 | |
126 ((member ; JSP tags etc | |
127 (char-after (1+ tag-start)) | |
128 '(?% ?#)) | |
129 (setq tag-type 'unknown)) | |
130 | |
131 (t | |
132 (goto-char (1+ tag-start)) | |
133 (setq tag-type 'open | |
134 name (xml-lite-parse-tag-name) | |
135 name-end (point)) | |
136 ;; check whether it's an empty tag | |
137 (if (or (and tag-end (eq ?/ (char-before (- tag-end 1)))) | |
138 (and (not sgml-xml-mode) | |
139 (member-ignore-case name sgml-empty-tags))) | |
140 (setq tag-type 'empty)))) | |
141 | |
142 (cond | |
143 (tag-start | |
144 (goto-char tag-start) | |
145 (xml-lite-make-tag tag-type tag-start tag-end name name-end)))))) | |
146 | 113 |
147 (defsubst xml-lite-inside-tag-p (tag-info &optional point) | 114 (defsubst xml-lite-inside-tag-p (tag-info &optional point) |
148 "Return true if TAG-INFO contains the POINT." | 115 "Return true if TAG-INFO contains the POINT." |
149 (let ((end (xml-lite-tag-end tag-info)) | 116 (let ((end (xml-lite-tag-end tag-info)) |
150 (point (or point (point)))) | 117 (point (or point (point)))) |
171 (skip-chars-backward " \t\n") ; Make sure we're not at indentation. | 138 (skip-chars-backward " \t\n") ; Make sure we're not at indentation. |
172 (while | 139 (while |
173 (and (or ignore | 140 (and (or ignore |
174 (not (if full (eq full 'empty) context)) | 141 (not (if full (eq full 'empty) context)) |
175 (not (xml-lite-at-indentation-p)) | 142 (not (xml-lite-at-indentation-p)) |
176 (and (not sgml-xml-mode) context | 143 (and context |
177 (/= (point) (xml-lite-tag-start (car context))) | 144 (/= (point) (xml-lite-tag-start (car context))) |
178 (member-ignore-case (xml-lite-tag-name (car context)) | 145 (sgml-unclosed-tag-p (xml-lite-tag-name (car context))))) |
179 sgml-unclosed-tags))) | 146 (setq tag-info (ignore-errors (xml-lite-parse-tag-backward)))) |
180 (setq tag-info (xml-lite-parse-tag-backward))) | |
181 | 147 |
182 ;; This tag may enclose things we thought were tags. If so, | 148 ;; This tag may enclose things we thought were tags. If so, |
183 ;; discard them. | 149 ;; discard them. |
184 (while (and context | 150 (while (and context |
185 (> (xml-lite-tag-end tag-info) | 151 (> (xml-lite-tag-end tag-info) |
194 | 160 |
195 ;; start-tag | 161 ;; start-tag |
196 ((eq (xml-lite-tag-type tag-info) 'open) | 162 ((eq (xml-lite-tag-type tag-info) 'open) |
197 (cond | 163 (cond |
198 ((null ignore) | 164 ((null ignore) |
199 (if (and (not sgml-xml-mode) context | 165 (if (and context |
200 (member-ignore-case (xml-lite-tag-name tag-info) | 166 (sgml-unclosed-tag-p (xml-lite-tag-name tag-info)) |
201 sgml-unclosed-tags) | |
202 (eq t (compare-strings | 167 (eq t (compare-strings |
203 (xml-lite-tag-name tag-info) nil nil | 168 (xml-lite-tag-name tag-info) nil nil |
204 (xml-lite-tag-name (car context)) nil nil t))) | 169 (xml-lite-tag-name (car context)) nil nil t))) |
205 ;; There was an implicit end-tag. | 170 ;; There was an implicit end-tag. |
206 nil | 171 nil |
210 (setq ignore (cdr ignore))) | 175 (setq ignore (cdr ignore))) |
211 (t | 176 (t |
212 ;; The open and close tags don't match. | 177 ;; The open and close tags don't match. |
213 (if (not sgml-xml-mode) | 178 (if (not sgml-xml-mode) |
214 ;; Assume the open tag is simply not closed. | 179 ;; Assume the open tag is simply not closed. |
215 (unless (member-ignore-case (xml-lite-tag-name tag-info) | 180 (unless (sgml-unclosed-tag-p (xml-lite-tag-name tag-info)) |
216 sgml-unclosed-tags) | |
217 (message "Unclosed tag <%s>" (xml-lite-tag-name tag-info))) | 181 (message "Unclosed tag <%s>" (xml-lite-tag-name tag-info))) |
218 (message "Unmatched tags <%s> and </%s>" | 182 (message "Unmatched tags <%s> and </%s>" |
219 (xml-lite-tag-name tag-info) (pop ignore)))))) | 183 (xml-lite-tag-name tag-info) (pop ignore)))))) |
220 | 184 |
221 ;; end-tag | 185 ;; end-tag |
222 ((eq (xml-lite-tag-type tag-info) 'close) | 186 ((eq (xml-lite-tag-type tag-info) 'close) |
223 (if (and (not sgml-xml-mode) | 187 (if (sgml-empty-tag-p (xml-lite-tag-name tag-info)) |
224 (member-ignore-case (xml-lite-tag-name tag-info) | |
225 sgml-empty-tags)) | |
226 (message "Spurious </%s>: empty tag" (xml-lite-tag-name tag-info)) | 188 (message "Spurious </%s>: empty tag" (xml-lite-tag-name tag-info)) |
227 (push (xml-lite-tag-name tag-info) ignore))) | 189 (push (xml-lite-tag-name tag-info) ignore))) |
228 )) | 190 )) |
229 | 191 |
230 ;; return context | 192 ;; return context |