99 |
(make-variable-buffer-local 'xml-lite-mode) |
(make-variable-buffer-local 'xml-lite-mode) |
100 |
|
|
101 |
|
|
102 |
|
;; Syntax analysis |
103 |
|
|
104 |
|
(defsubst xml-lite-at-indentation-p () |
105 |
|
"Return true if point is at the first non-whitespace character on the line." |
106 |
|
(save-excursion |
107 |
|
(skip-chars-backward " \t") |
108 |
|
(bolp))) |
109 |
|
|
110 |
|
(defun xml-lite-in-string-p (&optional limit) |
111 |
|
"Determine whether point is inside a string." |
112 |
|
(let (syntax-info) |
113 |
|
(or limit |
114 |
|
(setq limit (or (save-excursion |
115 |
|
(re-search-backward "^[ \t]*<" nil t)) |
116 |
|
(point-min)))) |
117 |
|
(setq syntax-info (parse-partial-sexp limit (point))) |
118 |
|
(if (nth 3 syntax-info) |
119 |
|
(list (nth 3 syntax-info) (nth 8 syntax-info))))) |
120 |
|
|
121 |
|
|
122 |
;; Parsing |
;; Parsing |
123 |
|
|
124 |
(defstruct (xml-lite-tag |
(defstruct (xml-lite-tag |
131 |
(if (> (skip-chars-forward "-._:A-Za-z0-9") 0) |
(if (> (skip-chars-forward "-._:A-Za-z0-9") 0) |
132 |
(buffer-substring-no-properties here (point))))) |
(buffer-substring-no-properties here (point))))) |
133 |
|
|
134 |
|
(defsubst xml-lite-looking-back-at (s) |
135 |
|
(let ((limit (max (- (point) (length s)) (point-min)))) |
136 |
|
(equal s (buffer-substring-no-properties limit (point))))) |
137 |
|
|
138 |
|
(defsubst xml-lite-looking-at (s) |
139 |
|
(let ((limit (min (+ (point) (length s))))) |
140 |
|
(equal s (buffer-substring-no-properties (point) limit)))) |
141 |
|
|
142 |
(defun xml-lite-parse-tag-backward () |
(defun xml-lite-parse-tag-backward () |
143 |
"Get information about the parent tag." |
"Get information about the parent tag." |
144 |
(let ((limit (point)) |
(let ((limit (point)) |
145 |
(tag-type 'open) |
tag-type tag-start tag-end name name-end) |
|
(tag-start (search-backward "<" nil t)) |
|
|
tag-end name name-end) |
|
146 |
|
|
147 |
(if (not tag-start) nil |
(cond |
|
(setq tag-end (search-forward ">" limit t)) |
|
148 |
|
|
149 |
;; determine tag type |
((null (re-search-backward "[<>]" nil t))) |
150 |
|
|
151 |
|
((= ?> (char-after)) ;--- found tag-end --- |
152 |
|
(setq tag-end (1+ (point))) |
153 |
|
(goto-char tag-end) |
154 |
|
(cond |
155 |
|
((xml-lite-looking-back-at "--") ; comment |
156 |
|
(setq tag-type 'comment |
157 |
|
tag-start (search-backward "<!--" nil t))) |
158 |
|
((xml-lite-looking-back-at "]]>") ; cdata |
159 |
|
(setq tag-type 'cdata |
160 |
|
tag-start (search-backward "![CDATA[" nil t))) |
161 |
|
(t |
162 |
|
(setq tag-start |
163 |
|
(ignore-errors (backward-sexp) (point)))))) |
164 |
|
|
165 |
|
((= ?< (char-after)) ;--- found tag-start --- |
166 |
|
(setq tag-start (point)) |
167 |
(goto-char (1+ tag-start)) |
(goto-char (1+ tag-start)) |
168 |
(cond |
(cond |
169 |
|
((xml-lite-looking-at "!--") ; comment |
170 |
((= ?? (char-after)) ; processing-instruction |
(setq tag-type 'comment |
171 |
(setq tag-type 'pi)) |
tag-end (search-forward "-->" nil t))) |
172 |
|
((xml-lite-looking-at "![CDATA[") ; cdata |
173 |
((= ?! (char-after)) ; declaration |
(setq tag-type 'cdata |
174 |
(setq tag-type 'decl) |
tag-end (search-forward "]]>" nil t))) |
|
(cond |
|
|
((looking-at "!--") ; comment |
|
|
(setq tag-type 'comment |
|
|
tag-end (search-forward "-->" nil t))) |
|
|
((looking-at "!\\[CDATA\\[") ; cdata |
|
|
(setq tag-type 'cdata |
|
|
tag-end (search-forward "]]>" nil t))) |
|
|
(t |
|
|
(ignore-errors |
|
|
(goto-char tag-start) |
|
|
(forward-sexp 1) |
|
|
(setq tag-end (point)))))) |
|
|
|
|
|
((= ?% (char-after)) ; JSP tag |
|
|
(setq tag-type 'jsp |
|
|
tag-end (search-forward "%>" nil t))) |
|
|
|
|
|
((= ?/ (char-after)) ; close-tag |
|
|
(goto-char (+ 2 tag-start)) |
|
|
(setq tag-type 'close |
|
|
name (xml-lite-parse-tag-name) |
|
|
name-end (point))) |
|
|
|
|
175 |
(t |
(t |
176 |
(setq tag-type 'open |
(goto-char tag-start) |
177 |
name (xml-lite-parse-tag-name) |
(setq tag-end |
178 |
name-end (point)) |
(ignore-errors (forward-sexp) (point)))))) |
179 |
;; check whether it's an empty tag |
|
180 |
(if (and tag-end (eq ?/ (char-before (- tag-end 1)))) |
) |
181 |
(setq tag-type 'empty)))) |
|
182 |
|
(cond |
183 |
|
|
184 |
|
((or tag-type (null tag-start))) |
185 |
|
|
186 |
|
((= ?! (char-after (1+ tag-start))) ; declaration |
187 |
|
(setq tag-type 'decl)) |
188 |
|
|
189 |
|
((= ?? (char-after (1+ tag-start))) ; processing-instruction |
190 |
|
(setq tag-type 'pi)) |
191 |
|
|
192 |
|
((= ?/ (char-after (1+ tag-start))) ; close-tag |
193 |
|
(goto-char (+ 2 tag-start)) |
194 |
|
(setq tag-type 'close |
195 |
|
name (xml-lite-parse-tag-name) |
196 |
|
name-end (point))) |
197 |
|
|
198 |
|
((member ; JSP tags etc |
199 |
|
(char-after (1+ tag-start)) |
200 |
|
'(?% ?#)) |
201 |
|
(setq tag-type 'unknown)) |
202 |
|
|
203 |
(goto-char tag-start) |
(t |
204 |
(xml-lite-make-tag tag-type tag-start tag-end name name-end)))) |
(goto-char (1+ tag-start)) |
205 |
|
(setq tag-type 'open |
206 |
|
name (xml-lite-parse-tag-name) |
207 |
|
name-end (point)) |
208 |
|
;; check whether it's an empty tag |
209 |
|
(if (and tag-end (eq ?/ (char-before (- tag-end 1)))) |
210 |
|
(setq tag-type 'empty)))) |
211 |
|
|
212 |
(defsubst xml-lite-at-indentation-p () |
(cond |
213 |
"Return true if point is at the first non-whitespace character on the line." |
(tag-start |
214 |
(save-excursion |
(goto-char tag-start) |
215 |
(skip-chars-backward " \t") |
(xml-lite-make-tag tag-type tag-start tag-end name name-end))))) |
|
(bolp))) |
|
216 |
|
|
217 |
(defsubst xml-lite-inside-tag-p (tag-info &optional point) |
(defsubst xml-lite-inside-tag-p (tag-info &optional point) |
218 |
"Return true if TAG-INFO contains the POINT." |
"Return true if TAG-INFO contains the POINT." |
229 |
The context is a list of tag-info structures. The last one is the tag |
The context is a list of tag-info structures. The last one is the tag |
230 |
immediately enclosing the current position." |
immediately enclosing the current position." |
231 |
(let ((here (point)) |
(let ((here (point)) |
232 |
(level 0) |
(ignore-depth 0) |
233 |
tag-info context) |
tag-info context) |
234 |
|
;; CONTEXT keeps track of the tag-stack |
235 |
|
;; IGNORE-DEPTH keeps track of the nesting level of point relative to the |
236 |
|
;; first (outermost) tag on the context. This is the number of |
237 |
|
;; enclosing start-tags we'll have to ignore. |
238 |
(save-excursion |
(save-excursion |
239 |
|
|
240 |
(while |
(while |
251 |
|
|
252 |
;; start-tag |
;; start-tag |
253 |
((eq (xml-lite-tag-type tag-info) 'open) |
((eq (xml-lite-tag-type tag-info) 'open) |
254 |
(setq level (1- level)) |
(setq ignore-depth (1- ignore-depth)) |
255 |
(when (= level -1) |
(when (= ignore-depth -1) |
256 |
(setq context (cons tag-info context)) |
(setq context (cons tag-info context)) |
257 |
(setq level 0))) |
(setq ignore-depth 0))) |
258 |
|
|
259 |
;; end-tag |
;; end-tag |
260 |
((eq (xml-lite-tag-type tag-info) 'close) |
((eq (xml-lite-tag-type tag-info) 'close) |
261 |
(setq level (1+ level))) |
(setq ignore-depth (1+ ignore-depth))) |
262 |
|
|
263 |
|
((eq (xml-lite-tag-type tag-info) 'comment) |
264 |
|
;; this comment may enclose things we thought were tags |
265 |
|
(while (and context |
266 |
|
(> (xml-lite-tag-end tag-info) |
267 |
|
(xml-lite-tag-end (car context)))) |
268 |
|
(setq context (cdr context)))) |
269 |
|
|
270 |
))) |
))) |
271 |
|
|
272 |
;; return context |
;; return context |
304 |
|
|
305 |
;; inside a tag |
;; inside a tag |
306 |
((xml-lite-inside-tag-p last-tag-info here) |
((xml-lite-inside-tag-p last-tag-info here) |
307 |
(let ((syntax-info |
|
308 |
(parse-partial-sexp (xml-lite-tag-start last-tag-info) |
(let ((in-string |
309 |
(point)))) |
(xml-lite-in-string-p (xml-lite-tag-start last-tag-info)))) |
310 |
(cond |
(cond |
311 |
;; inside a string |
;; inside a string |
312 |
((nth 3 syntax-info) |
(in-string |
313 |
(goto-char (nth 8 syntax-info)) |
(goto-char (nth 1 in-string)) |
314 |
(1+ (current-column))) |
(1+ (current-column))) |
315 |
;; if we have a tag-name, base indent on that |
;; if we have a tag-name, base indent on that |
316 |
((and (xml-lite-tag-name-end last-tag-info) |
((and (xml-lite-tag-name-end last-tag-info) |
417 |
(insert-char ?/ arg)))) |
(insert-char ?/ arg)))) |
418 |
|
|
419 |
|
|
|
;; Movement commands |
|
|
|
|
|
(defun forward-xml-tag (arg) |
|
|
"Move forward ARG XML-tags." |
|
|
(interactive "p") |
|
|
(cond |
|
|
((> arg 0) |
|
|
(search-forward ">" nil nil arg)) |
|
|
((< arg 0) |
|
|
(search-backward "<" nil nil (- arg))) |
|
|
)) |
|
|
|
|
|
(defun backward-xml-tag (arg) |
|
|
"Move backward ARG XML-tags." |
|
|
(interactive "p") |
|
|
(forward-xml-tag (- arg))) |
|
|
|
|
|
(defun beginning-of-xml-tag () |
|
|
"Move to the beginning of the current XML-tag." |
|
|
(interactive) |
|
|
(if (= ?< (char-after (point))) |
|
|
(point) |
|
|
(search-backward "<"))) |
|
|
|
|
|
(defun end-of-xml-tag () |
|
|
"Move to the end of the current XML-tag." |
|
|
(interactive) |
|
|
(forward-xml-tag 1)) |
|
|
|
|
|
|
|
420 |
;; Keymap |
;; Keymap |
421 |
|
|
422 |
(defvar xml-lite-mode-map |
(defvar xml-lite-mode-map |