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 |