Mercurial > emacs
annotate lisp/textmodes/xml-lite.el @ 44294:a87795faf65b
(xml-lite-parse-tag-backward): Fix for implicitly empty tags.
author | Mike Williams <mdub@bigfoot.com> |
---|---|
date | Mon, 01 Apr 2002 12:44:34 +0000 |
parents | cc29df7efbe8 |
children |
rev | line source |
---|---|
43687 | 1 ;;; xml-lite.el --- an indentation-engine for XML |
2 | |
44187
65437de0940f
Fix copyright notice.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44180
diff
changeset
|
3 ;; Copyright (C) 2002 Free Software Foundation, Inc. |
43687 | 4 |
5 ;; Author: Mike Williams <mdub@bigfoot.com> | |
6 ;; Created: February 2001 | |
7 ;; Keywords: xml | |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
11 ;; This program is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
13 ;; the Free Software Foundation; either version 2 of the License, or | |
14 ;; (at your option) any later version. | |
15 ;; | |
16 ;; This program is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 ;; | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
24 ;; Boston, MA 02111-1307, USA. | |
25 | |
26 ;;; Commentary: | |
27 ;; | |
28 ;; This package provides a simple indentation engine for XML. It is | |
29 ;; intended for use in situations where the full power of the popular PSGML | |
30 ;; package (DTD parsing, syntax checking) is not required. | |
31 ;; | |
32 ;; xml-lite is designed to be used in conjunction with the default GNU | |
33 ;; Emacs sgml-mode, to provide a lightweight XML-editing environment. | |
34 | |
35 ;;; Thanks: | |
36 ;; | |
37 ;; Jens Schmidt <Jens.Schmidt@oracle.com> | |
38 ;; for his feedback and suggestions | |
39 | |
44290 | 40 ;; PLEASE NOTE! |
41 ;; xml-lite is on it's way out, as functionality is merged into | |
42 ;; sgml-mode. | |
43 | |
43687 | 44 ;;; Code: |
45 | |
46 (eval-when-compile (require 'cl)) | |
47 (require 'sgml-mode) | |
48 | |
49 | |
44168
68fd324f9f0f
(xml-lite-at-indentation-p): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43687
diff
changeset
|
50 ;; Syntax analysis |
68fd324f9f0f
(xml-lite-at-indentation-p): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43687
diff
changeset
|
51 |
68fd324f9f0f
(xml-lite-at-indentation-p): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43687
diff
changeset
|
52 (defsubst xml-lite-at-indentation-p () |
68fd324f9f0f
(xml-lite-at-indentation-p): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43687
diff
changeset
|
53 "Return true if point is at the first non-whitespace character on the line." |
68fd324f9f0f
(xml-lite-at-indentation-p): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43687
diff
changeset
|
54 (save-excursion |
68fd324f9f0f
(xml-lite-at-indentation-p): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43687
diff
changeset
|
55 (skip-chars-backward " \t") |
68fd324f9f0f
(xml-lite-at-indentation-p): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43687
diff
changeset
|
56 (bolp))) |
68fd324f9f0f
(xml-lite-at-indentation-p): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43687
diff
changeset
|
57 |
68fd324f9f0f
(xml-lite-at-indentation-p): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43687
diff
changeset
|
58 |
43687 | 59 ;; Parsing |
44289
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
60 |
43687 | 61 (defstruct (xml-lite-tag |
44289
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
62 (:constructor xml-lite-make-tag (type start end name))) |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
63 type start end name) |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
64 |
43687 | 65 (defsubst xml-lite-parse-tag-name () |
66 "Skip past a tag-name, and return the name." | |
44180
e7a365c909ff
Don't require `custom'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44168
diff
changeset
|
67 (buffer-substring-no-properties |
e7a365c909ff
Don't require `custom'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44168
diff
changeset
|
68 (point) (progn (skip-syntax-forward "w_") (point)))) |
43687 | 69 |
44168
68fd324f9f0f
(xml-lite-at-indentation-p): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43687
diff
changeset
|
70 (defsubst xml-lite-looking-back-at (s) |
68fd324f9f0f
(xml-lite-at-indentation-p): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43687
diff
changeset
|
71 (let ((limit (max (- (point) (length s)) (point-min)))) |
68fd324f9f0f
(xml-lite-at-indentation-p): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43687
diff
changeset
|
72 (equal s (buffer-substring-no-properties limit (point))))) |
68fd324f9f0f
(xml-lite-at-indentation-p): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43687
diff
changeset
|
73 |
44187
65437de0940f
Fix copyright notice.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44180
diff
changeset
|
74 (defsubst xml-lite-looking-at (s) |
44168
68fd324f9f0f
(xml-lite-at-indentation-p): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43687
diff
changeset
|
75 (let ((limit (min (+ (point) (length s))))) |
68fd324f9f0f
(xml-lite-at-indentation-p): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43687
diff
changeset
|
76 (equal s (buffer-substring-no-properties (point) limit)))) |
68fd324f9f0f
(xml-lite-at-indentation-p): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43687
diff
changeset
|
77 |
43687 | 78 (defun xml-lite-parse-tag-backward () |
44289
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
79 "Parse an SGML tag backward, and return information about the tag. |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
80 Assume that parsing starts from within a textual context. |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
81 Leave point at the beginning of the tag." |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
82 (let (tag-type tag-start tag-end name) |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
83 (search-backward ">") |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
84 (setq tag-end (1+ (point))) |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
85 (cond |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
86 ((xml-lite-looking-back-at "--") ; comment |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
87 (setq tag-type 'comment |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
88 tag-start (search-backward "<!--" nil t))) |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
89 ((xml-lite-looking-back-at "]]") ; cdata |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
90 (setq tag-type 'cdata |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
91 tag-start (search-backward "<![CDATA[" nil t))) |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
92 (t |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
93 (setq tag-start |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
94 (with-syntax-table sgml-tag-syntax-table |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
95 (goto-char tag-end) |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
96 (backward-sexp) |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
97 (point))) |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
98 (goto-char (1+ tag-start)) |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
99 (case (char-after) |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
100 (?! ; declaration |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
101 (setq tag-type 'decl)) |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
102 (?? ; processing-instruction |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
103 (setq tag-type 'pi)) |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
104 (?/ ; close-tag |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
105 (forward-char 1) |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
106 (setq tag-type 'close |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
107 name (xml-lite-parse-tag-name))) |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
108 ((?% ?#) ; JSP tags etc |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
109 (setq tag-type 'unknown)) |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
110 (t ; open or empty tag |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
111 (setq tag-type 'open |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
112 name (xml-lite-parse-tag-name)) |
44294
a87795faf65b
(xml-lite-parse-tag-backward): Fix for implicitly empty tags.
Mike Williams <mdub@bigfoot.com>
parents:
44290
diff
changeset
|
113 (if (or (eq ?/ (char-before (- tag-end 1))) |
a87795faf65b
(xml-lite-parse-tag-backward): Fix for implicitly empty tags.
Mike Williams <mdub@bigfoot.com>
parents:
44290
diff
changeset
|
114 (sgml-empty-tag-p name)) |
44289
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
115 (setq tag-type 'empty)))))) |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
116 (goto-char tag-start) |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
117 (xml-lite-make-tag tag-type tag-start tag-end name))) |
43687 | 118 |
119 (defsubst xml-lite-inside-tag-p (tag-info &optional point) | |
120 "Return true if TAG-INFO contains the POINT." | |
121 (let ((end (xml-lite-tag-end tag-info)) | |
122 (point (or point (point)))) | |
123 (or (null end) | |
124 (> end point)))) | |
125 | |
126 (defun xml-lite-get-context (&optional full) | |
127 "Determine the context of the current position. | |
44242
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
128 If FULL is `empty', return even if the context is empty (i.e. |
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
129 we just skipped over some element and got to a beginning of line). |
43687 | 130 If FULL is non-nil, parse back to the beginning of the buffer, otherwise |
131 parse until we find a start-tag as the first thing on a line. | |
132 | |
133 The context is a list of tag-info structures. The last one is the tag | |
134 immediately enclosing the current position." | |
135 (let ((here (point)) | |
44242
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
136 (ignore nil) |
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
137 (context nil) |
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
138 tag-info) |
44168
68fd324f9f0f
(xml-lite-at-indentation-p): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43687
diff
changeset
|
139 ;; CONTEXT keeps track of the tag-stack |
44201
2eeb8d7f1161
(xml-lite-in-string-p): Use sgml-lexical-context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44189
diff
changeset
|
140 ;; IGNORE keeps track of the nesting level of point relative to the |
2eeb8d7f1161
(xml-lite-in-string-p): Use sgml-lexical-context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44189
diff
changeset
|
141 ;; first (outermost) tag on the context. This is the list of |
44168
68fd324f9f0f
(xml-lite-at-indentation-p): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43687
diff
changeset
|
142 ;; enclosing start-tags we'll have to ignore. |
44242
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
143 (skip-chars-backward " \t\n") ; Make sure we're not at indentation. |
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
144 (while |
44284
f259c3857fea
Remove redundant remains of xml-lite-mode.
Mike Williams <mdub@bigfoot.com>
parents:
44243
diff
changeset
|
145 (and (or ignore |
f259c3857fea
Remove redundant remains of xml-lite-mode.
Mike Williams <mdub@bigfoot.com>
parents:
44243
diff
changeset
|
146 (not (if full (eq full 'empty) context)) |
44243
c3ee131a3ab1
(xml-lite-get-context): Don't stop parsing
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44242
diff
changeset
|
147 (not (xml-lite-at-indentation-p)) |
44289
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
148 (and context |
44243
c3ee131a3ab1
(xml-lite-get-context): Don't stop parsing
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44242
diff
changeset
|
149 (/= (point) (xml-lite-tag-start (car context))) |
44289
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
150 (sgml-unclosed-tag-p (xml-lite-tag-name (car context))))) |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
151 (setq tag-info (ignore-errors (xml-lite-parse-tag-backward)))) |
44242
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
152 |
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
153 ;; This tag may enclose things we thought were tags. If so, |
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
154 ;; discard them. |
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
155 (while (and context |
44284
f259c3857fea
Remove redundant remains of xml-lite-mode.
Mike Williams <mdub@bigfoot.com>
parents:
44243
diff
changeset
|
156 (> (xml-lite-tag-end tag-info) |
f259c3857fea
Remove redundant remains of xml-lite-mode.
Mike Williams <mdub@bigfoot.com>
parents:
44243
diff
changeset
|
157 (xml-lite-tag-end (car context)))) |
f259c3857fea
Remove redundant remains of xml-lite-mode.
Mike Williams <mdub@bigfoot.com>
parents:
44243
diff
changeset
|
158 (setq context (cdr context))) |
44242
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
159 |
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
160 (cond |
43687 | 161 |
44242
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
162 ;; inside a tag ... |
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
163 ((xml-lite-inside-tag-p tag-info here) |
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
164 (push tag-info context)) |
43687 | 165 |
44242
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
166 ;; start-tag |
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
167 ((eq (xml-lite-tag-type tag-info) 'open) |
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
168 (cond |
44243
c3ee131a3ab1
(xml-lite-get-context): Don't stop parsing
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44242
diff
changeset
|
169 ((null ignore) |
44289
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
170 (if (and context |
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
171 (sgml-unclosed-tag-p (xml-lite-tag-name tag-info)) |
44243
c3ee131a3ab1
(xml-lite-get-context): Don't stop parsing
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44242
diff
changeset
|
172 (eq t (compare-strings |
c3ee131a3ab1
(xml-lite-get-context): Don't stop parsing
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44242
diff
changeset
|
173 (xml-lite-tag-name tag-info) nil nil |
c3ee131a3ab1
(xml-lite-get-context): Don't stop parsing
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44242
diff
changeset
|
174 (xml-lite-tag-name (car context)) nil nil t))) |
c3ee131a3ab1
(xml-lite-get-context): Don't stop parsing
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44242
diff
changeset
|
175 ;; There was an implicit end-tag. |
c3ee131a3ab1
(xml-lite-get-context): Don't stop parsing
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44242
diff
changeset
|
176 nil |
c3ee131a3ab1
(xml-lite-get-context): Don't stop parsing
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44242
diff
changeset
|
177 (push tag-info context))) |
44242
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
178 ((eq t (compare-strings (xml-lite-tag-name tag-info) nil nil |
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
179 (car ignore) nil nil t)) |
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
180 (setq ignore (cdr ignore))) |
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
181 (t |
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
182 ;; The open and close tags don't match. |
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
183 (if (not sgml-xml-mode) |
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
184 ;; Assume the open tag is simply not closed. |
44289
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
185 (unless (sgml-unclosed-tag-p (xml-lite-tag-name tag-info)) |
44242
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
186 (message "Unclosed tag <%s>" (xml-lite-tag-name tag-info))) |
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
187 (message "Unmatched tags <%s> and </%s>" |
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
188 (xml-lite-tag-name tag-info) (pop ignore)))))) |
43687 | 189 |
44242
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
190 ;; end-tag |
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
191 ((eq (xml-lite-tag-type tag-info) 'close) |
44289
52b704431b5d
Remove redundant name-end attribute.
Mike Williams <mdub@bigfoot.com>
parents:
44284
diff
changeset
|
192 (if (sgml-empty-tag-p (xml-lite-tag-name tag-info)) |
44242
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
193 (message "Spurious </%s>: empty tag" (xml-lite-tag-name tag-info)) |
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
194 (push (xml-lite-tag-name tag-info) ignore))) |
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
195 )) |
43687 | 196 |
197 ;; return context | |
44242
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
198 context)) |
43687 | 199 |
200 (defun xml-lite-show-context (&optional full) | |
201 "Display the current context. | |
202 If FULL is non-nil, parse back to the beginning of the buffer." | |
203 (interactive "P") | |
204 (with-output-to-temp-buffer "*XML Context*" | |
44242
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
205 (pp (save-excursion (xml-lite-get-context full))))) |
43687 | 206 |
207 | |
208 ;; Editing shortcuts | |
209 | |
210 (defun xml-lite-insert-end-tag () | |
211 "Insert an end-tag for the current element." | |
212 (interactive) | |
44242
84ff52bf6d2f
(xml-lite-get-context): Allow stopping even with an empty context.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44201
diff
changeset
|
213 (let* ((context (save-excursion (xml-lite-get-context))) |
43687 | 214 (tag-info (car (last context))) |
215 (type (and tag-info (xml-lite-tag-type tag-info)))) | |
216 | |
217 (cond | |
218 | |
219 ((null context) | |
220 (error "Nothing to close")) | |
221 | |
222 ;; inside a tag | |
223 ((xml-lite-inside-tag-p tag-info) | |
44187
65437de0940f
Fix copyright notice.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44180
diff
changeset
|
224 (insert (cond |
65437de0940f
Fix copyright notice.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44180
diff
changeset
|
225 ((eq type 'open) " />") |
65437de0940f
Fix copyright notice.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44180
diff
changeset
|
226 ((eq type 'comment) " -->") |
65437de0940f
Fix copyright notice.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44180
diff
changeset
|
227 ((eq type 'cdata) "]]>") |
65437de0940f
Fix copyright notice.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44180
diff
changeset
|
228 ((eq type 'jsp) "%>") |
65437de0940f
Fix copyright notice.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44180
diff
changeset
|
229 ((eq type 'pi) "?>") |
65437de0940f
Fix copyright notice.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44180
diff
changeset
|
230 (t ">")))) |
43687 | 231 |
232 ;; inside an element | |
233 ((eq type 'open) | |
234 (insert "</" (xml-lite-tag-name tag-info) ">") | |
44180
e7a365c909ff
Don't require `custom'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44168
diff
changeset
|
235 (indent-according-to-mode)) |
43687 | 236 |
237 (t | |
238 (error "Nothing to close"))))) | |
239 | |
240 (defun xml-lite-slash (arg) | |
241 "Insert ARG slash characters. | |
242 Behaves electrically if `xml-lite-electric-slash' is non-nil." | |
243 (interactive "p") | |
244 (cond | |
245 ((not (and (eq (char-before) ?<) (= arg 1))) | |
246 (insert-char ?/ arg)) | |
247 ((eq xml-lite-electric-slash 'indent) | |
248 (insert-char ?/ 1) | |
44180
e7a365c909ff
Don't require `custom'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44168
diff
changeset
|
249 (indent-according-to-mode)) |
43687 | 250 ((eq xml-lite-electric-slash 'close) |
251 (delete-backward-char 1) | |
252 (xml-lite-insert-end-tag)) | |
253 (t | |
254 (insert-char ?/ arg)))) | |
255 | |
256 (provide 'xml-lite) | |
257 | |
258 ;;; xml-lite.el ends here |