Commit | Line | Data |
---|---|---|
8cd39fb3 MH |
1 | ;;; nxml-outln.el --- outline support for nXML mode |
2 | ||
73b0cd50 | 3 | ;; Copyright (C) 2004, 2007-2011 |
e9bffc61 | 4 | ;; Free Software Foundation, Inc. |
8cd39fb3 MH |
5 | |
6 | ;; Author: James Clark | |
7 | ;; Keywords: XML | |
8 | ||
c276c74b | 9 | ;; This file is part of GNU Emacs. |
8cd39fb3 | 10 | |
4936186e | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
c276c74b | 12 | ;; it under the terms of the GNU General Public License as published by |
4936186e GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
8cd39fb3 | 15 | |
c276c74b GM |
16 | ;; GNU Emacs 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 | |
4936186e | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
8cd39fb3 MH |
23 | |
24 | ;;; Commentary: | |
25 | ||
26 | ;; A section can be in one of three states | |
27 | ;; 1. display normally; this displays each child section | |
28 | ;; according to its state; anything not part of child sections is also | |
29 | ;; displayed normally | |
30 | ;; 2. display just the title specially; child sections are not displayed | |
31 | ;; regardless of their state; anything not part of child sections is | |
32 | ;; not displayed | |
33 | ;; 3. display the title specially and display child sections | |
34 | ;; according to their state; anything not part of the child section is | |
35 | ;; not displayed | |
36 | ;; The state of a section is determined by the value of the | |
37 | ;; nxml-outline-state text property of the < character that starts | |
38 | ;; the section. | |
39 | ;; For state 1 the value is nil or absent. | |
40 | ;; For state 2 it is the symbol hide-children. | |
41 | ;; For state 3 it is t. | |
42 | ;; The special display is achieved by using overlays. The overlays | |
43 | ;; are computed from the nxml-outline-state property by | |
44 | ;; `nxml-refresh-outline'. There overlays all have a category property | |
45 | ;; with an nxml-outline-display property with value t. | |
46 | ;; | |
47 | ;; For a section to be recognized as such, the following conditions must | |
48 | ;; be satisfied: | |
49 | ;; - its start-tag must occur at the start of a line (possibly indented) | |
50 | ;; - its local name must match `nxml-section-element-name-regexp' | |
51 | ;; - it must have a heading element; a heading element is an | |
52 | ;; element whose name matches `nxml-heading-element-name-regexp', | |
53 | ;; and that occurs as, or as a descendant of, the first child element | |
54 | ;; of the section | |
55 | ;; | |
56 | ;; XXX What happens if an nxml-outline-state property is attached to a | |
57 | ;; character that doesn't start a section element? | |
58 | ;; | |
59 | ;; An outlined section (an section with a non-nil nxml-outline-state | |
60 | ;; property) can be displayed in either single-line or multi-line | |
61 | ;; form. Single-line form is used when the outline state is hide-children | |
62 | ;; or there are no child sections; multi-line form is used otherwise. | |
63 | ;; There are two flavors of single-line form: with children and without. | |
64 | ;; The with-childen flavor is used when there are child sections. | |
65 | ;; Single line with children looks like | |
66 | ;; <+section>A section title...</> | |
67 | ;; Single line without children looks like | |
68 | ;; <-section>A section title...</> | |
69 | ;; Multi line looks likes | |
70 | ;; <-section>A section title... | |
71 | ;; [child sections displayed here] | |
72 | ;; </-section> | |
73 | ;; The indent of an outlined section is computed relative to the | |
74 | ;; outermost containing outlined element. The indent of the | |
75 | ;; outermost containing element comes from the non-outlined | |
76 | ;; indent of the section start-tag. | |
77 | ||
78 | ;;; Code: | |
79 | ||
80 | (require 'xmltok) | |
81 | (require 'nxml-util) | |
82 | (require 'nxml-rap) | |
83 | ||
84 | (defcustom nxml-section-element-name-regexp | |
85 | "article\\|\\(sub\\)*section\\|chapter\\|div\\|appendix\\|part\\|preface\\|reference\\|simplesect\\|bibliography\\|bibliodiv\\|glossary\\|glossdiv" | |
65beee52 | 86 | "Regular expression matching the name of elements used as sections. |
8cd39fb3 MH |
87 | An XML element is treated as a section if: |
88 | ||
89 | - its local name (that is, the name without the prefix) matches | |
90 | this regexp; | |
91 | ||
92 | - either its first child element or a descendant of that first child | |
93 | element has a local name matching the variable | |
94 | `nxml-heading-element-name-regexp'; and | |
95 | ||
96 | - its start-tag occurs at the beginning of a line (possibly indented)." | |
97 | :group 'nxml | |
98 | :type 'regexp) | |
99 | ||
100 | (defcustom nxml-heading-element-name-regexp "title\\|head" | |
65beee52 | 101 | "Regular expression matching the name of elements used as headings. |
8cd39fb3 MH |
102 | An XML element is only recognized as a heading if it occurs as or |
103 | within the first child of an element that is recognized as a section. | |
104 | See the variable `nxml-section-element-name-regexp' for more details." | |
105 | :group 'nxml | |
106 | :type 'regexp) | |
107 | ||
108 | (defcustom nxml-outline-child-indent 2 | |
65beee52 | 109 | "Indentation in an outline for child element relative to parent element." |
8cd39fb3 MH |
110 | :group 'nxml |
111 | :type 'integer) | |
112 | ||
0526b9d0 | 113 | (defface nxml-heading |
8cd39fb3 MH |
114 | '((t (:weight bold))) |
115 | "Face used for the contents of abbreviated heading elements." | |
0526b9d0 | 116 | :group 'nxml-faces) |
8cd39fb3 | 117 | |
0526b9d0 | 118 | (defface nxml-outline-indicator |
8cd39fb3 MH |
119 | '((t (:inherit default))) |
120 | "Face used for `+' or `-' before element names in outlines." | |
0526b9d0 | 121 | :group 'nxml-faces) |
8cd39fb3 | 122 | |
0526b9d0 JR |
123 | (defface nxml-outline-active-indicator |
124 | '((t (:box t :inherit nxml-outline-indicator))) | |
8cd39fb3 | 125 | "Face used for clickable `+' or `-' before element names in outlines." |
0526b9d0 | 126 | :group 'nxml-faces) |
8cd39fb3 | 127 | |
0526b9d0 | 128 | (defface nxml-outline-ellipsis |
8cd39fb3 MH |
129 | '((t (:bold t :inherit default))) |
130 | "Face used for `...' in outlines." | |
0526b9d0 | 131 | :group 'nxml-faces) |
8cd39fb3 MH |
132 | |
133 | (defvar nxml-heading-scan-distance 1000 | |
134 | "Maximum distance from section to scan for heading.") | |
135 | ||
136 | (defvar nxml-outline-prefix-map | |
137 | (let ((map (make-sparse-keymap))) | |
138 | (define-key map "\C-a" 'nxml-show-all) | |
139 | (define-key map "\C-t" 'nxml-hide-all-text-content) | |
140 | (define-key map "\C-r" 'nxml-refresh-outline) | |
141 | (define-key map "\C-c" 'nxml-hide-direct-text-content) | |
142 | (define-key map "\C-e" 'nxml-show-direct-text-content) | |
143 | (define-key map "\C-d" 'nxml-hide-subheadings) | |
144 | (define-key map "\C-s" 'nxml-show) | |
145 | (define-key map "\C-k" 'nxml-show-subheadings) | |
146 | (define-key map "\C-l" 'nxml-hide-text-content) | |
147 | (define-key map "\C-i" 'nxml-show-direct-subheadings) | |
148 | (define-key map "\C-o" 'nxml-hide-other) | |
149 | map)) | |
150 | ||
151 | ;;; Commands for changing visibility | |
152 | ||
153 | (defun nxml-show-all () | |
154 | "Show all elements in the buffer normally." | |
155 | (interactive) | |
156 | (nxml-with-unmodifying-text-property-changes | |
157 | (remove-text-properties (point-min) | |
158 | (point-max) | |
159 | '(nxml-outline-state nil))) | |
160 | (nxml-outline-set-overlay nil (point-min) (point-max))) | |
161 | ||
162 | (defun nxml-hide-all-text-content () | |
163 | "Hide all text content in the buffer. | |
164 | Anything that is in a section but is not a heading will be hidden. | |
10545bd8 | 165 | The visibility of headings at any level will not be changed. See the |
8cd39fb3 MH |
166 | variable `nxml-section-element-name-regexp' for more details on how to |
167 | customize which elements are recognized as sections and headings." | |
168 | (interactive) | |
169 | (nxml-transform-buffer-outline '((nil . t)))) | |
170 | ||
171 | (defun nxml-show-direct-text-content () | |
172 | "Show the text content that is directly part of the section containing point. | |
173 | Each subsection will be shown according to its individual state, which | |
10545bd8 JB |
174 | will not be changed. The section containing point is the innermost |
175 | section that contains the character following point. See the variable | |
8cd39fb3 MH |
176 | `nxml-section-element-name-regexp' for more details on how to |
177 | customize which elements are recognized as sections and headings." | |
178 | (interactive) | |
179 | (nxml-outline-pre-adjust-point) | |
180 | (nxml-set-outline-state (nxml-section-start-position) nil) | |
181 | (nxml-refresh-outline) | |
182 | (nxml-outline-adjust-point)) | |
183 | ||
184 | (defun nxml-show-direct-subheadings () | |
185 | "Show the immediate subheadings of the section containing point. | |
186 | The section containing point is the innermost section that contains | |
10545bd8 | 187 | the character following point. See the variable |
8cd39fb3 MH |
188 | `nxml-section-element-name-regexp' for more details on how to |
189 | customize which elements are recognized as sections and headings." | |
190 | (interactive) | |
191 | (let ((pos (nxml-section-start-position))) | |
192 | (when (eq (nxml-get-outline-state pos) 'hide-children) | |
193 | (nxml-set-outline-state pos t))) | |
194 | (nxml-refresh-outline) | |
195 | (nxml-outline-adjust-point)) | |
196 | ||
197 | (defun nxml-hide-direct-text-content () | |
198 | "Hide the text content that is directly part of the section containing point. | |
199 | The heading of the section will remain visible. The state of | |
200 | subsections will not be changed. The section containing point is the | |
10545bd8 | 201 | innermost section that contains the character following point. See the |
8cd39fb3 MH |
202 | variable `nxml-section-element-name-regexp' for more details on how to |
203 | customize which elements are recognized as sections and headings." | |
204 | (interactive) | |
205 | (let ((pos (nxml-section-start-position))) | |
206 | (when (null (nxml-get-outline-state pos)) | |
207 | (nxml-set-outline-state pos t))) | |
208 | (nxml-refresh-outline) | |
209 | (nxml-outline-adjust-point)) | |
210 | ||
211 | (defun nxml-hide-subheadings () | |
212 | "Hide the subheadings that are part of the section containing point. | |
213 | The text content will also be hidden, leaving only the heading of the | |
214 | section itself visible. The state of the subsections will also be | |
215 | changed to hide their headings, so that \\[nxml-show-direct-text-content] | |
10545bd8 | 216 | would show only the heading of the subsections. The section containing |
8cd39fb3 MH |
217 | point is the innermost section that contains the character following |
218 | point. See the variable `nxml-section-element-name-regexp' for more | |
219 | details on how to customize which elements are recognized as sections | |
220 | and headings." | |
221 | (interactive) | |
222 | (nxml-transform-subtree-outline '((nil . hide-children) | |
223 | (t . hide-children)))) | |
224 | ||
225 | (defun nxml-show () | |
226 | "Show the section containing point normally, without hiding anything. | |
227 | This includes everything in the section at any level. The section | |
228 | containing point is the innermost section that contains the character | |
229 | following point. See the variable `nxml-section-element-name-regexp' | |
230 | for more details on how to customize which elements are recognized as | |
231 | sections and headings." | |
232 | (interactive) | |
233 | (nxml-transform-subtree-outline '((hide-children . nil) | |
234 | (t . nil)))) | |
235 | ||
236 | (defun nxml-hide-text-content () | |
237 | "Hide text content at all levels in the section containing point. | |
238 | The section containing point is the innermost section that contains | |
10545bd8 | 239 | the character following point. See the variable |
8cd39fb3 MH |
240 | `nxml-section-element-name-regexp' for more details on how to |
241 | customize which elements are recognized as sections and headings." | |
242 | (interactive) | |
243 | (nxml-transform-subtree-outline '((nil . t)))) | |
244 | ||
245 | (defun nxml-show-subheadings () | |
246 | "Show the subheadings at all levels of the section containing point. | |
247 | The visibility of the text content at all levels in the section is not | |
248 | changed. The section containing point is the innermost section that | |
10545bd8 | 249 | contains the character following point. See the variable |
8cd39fb3 MH |
250 | `nxml-section-element-name-regexp' for more details on how to |
251 | customize which elements are recognized as sections and headings." | |
252 | (interactive) | |
253 | (nxml-transform-subtree-outline '((hide-children . t)))) | |
254 | ||
255 | (defun nxml-hide-other () | |
256 | "Hide text content other than that directly in the section containing point. | |
257 | Hide headings other than those of ancestors of that section and their | |
258 | immediate subheadings. The section containing point is the innermost | |
10545bd8 | 259 | section that contains the character following point. See the variable |
8cd39fb3 MH |
260 | `nxml-section-element-name-regexp' for more details on how to |
261 | customize which elements are recognized as sections and headings." | |
262 | (interactive) | |
263 | (let ((nxml-outline-state-transform-exceptions nil)) | |
264 | (save-excursion | |
265 | (while (and (condition-case err | |
266 | (nxml-back-to-section-start) | |
267 | (nxml-outline-error (nxml-report-outline-error | |
268 | "Couldn't find containing section: %s" | |
269 | err))) | |
270 | (progn | |
271 | (when (and nxml-outline-state-transform-exceptions | |
272 | (null (nxml-get-outline-state (point)))) | |
273 | (nxml-set-outline-state (point) t)) | |
274 | (setq nxml-outline-state-transform-exceptions | |
275 | (cons (point) | |
276 | nxml-outline-state-transform-exceptions)) | |
277 | (< nxml-prolog-end (point)))) | |
278 | (goto-char (1- (point))))) | |
279 | (nxml-transform-buffer-outline '((nil . hide-children) | |
280 | (t . hide-children))))) | |
281 | ||
282 | ;; These variables are dynamically bound. They are use to pass information to | |
283 | ;; nxml-section-tag-transform-outline-state. | |
284 | ||
285 | (defvar nxml-outline-state-transform-exceptions nil) | |
286 | (defvar nxml-target-section-pos nil) | |
287 | (defvar nxml-depth-in-target-section nil) | |
288 | (defvar nxml-outline-state-transform-alist nil) | |
289 | ||
290 | (defun nxml-transform-buffer-outline (alist) | |
291 | (let ((nxml-target-section-pos nil) | |
292 | (nxml-depth-in-target-section 0) | |
293 | (nxml-outline-state-transform-alist alist) | |
294 | (nxml-outline-display-section-tag-function | |
295 | 'nxml-section-tag-transform-outline-state)) | |
296 | (nxml-refresh-outline)) | |
297 | (nxml-outline-adjust-point)) | |
298 | ||
299 | (defun nxml-transform-subtree-outline (alist) | |
300 | (let ((nxml-target-section-pos (nxml-section-start-position)) | |
301 | (nxml-depth-in-target-section nil) | |
302 | (nxml-outline-state-transform-alist alist) | |
303 | (nxml-outline-display-section-tag-function | |
304 | 'nxml-section-tag-transform-outline-state)) | |
305 | (nxml-refresh-outline)) | |
306 | (nxml-outline-adjust-point)) | |
307 | ||
308 | (defun nxml-outline-pre-adjust-point () | |
309 | (cond ((and (< (point-min) (point)) | |
310 | (get-char-property (1- (point)) 'invisible) | |
311 | (not (get-char-property (point) 'invisible)) | |
312 | (let ((str (or (get-char-property (point) 'before-string) | |
313 | (get-char-property (point) 'display)))) | |
314 | (and (stringp str) | |
315 | (>= (length str) 3) | |
316 | (string= (substring str 0 3) "...")))) | |
317 | ;; The ellipsis is a display property on a visible character | |
318 | ;; following an invisible region. The position of the event | |
319 | ;; will be the position before that character. We want to | |
320 | ;; move point to the other side of the invisible region, i.e. | |
321 | ;; following the last visible character before that invisible | |
322 | ;; region. | |
323 | (goto-char (previous-single-char-property-change (1- (point)) | |
324 | 'invisible))) | |
325 | ((and (< (point) (point-max)) | |
326 | (get-char-property (point) 'display) | |
327 | (get-char-property (1+ (point)) 'invisible)) | |
328 | (goto-char (next-single-char-property-change (1+ (point)) | |
329 | 'invisible))) | |
330 | ((and (< (point) (point-max)) | |
331 | (get-char-property (point) 'invisible)) | |
332 | (goto-char (next-single-char-property-change (point) | |
333 | 'invisible))))) | |
334 | ||
335 | (defun nxml-outline-adjust-point () | |
336 | "Adjust point after showing or hiding elements." | |
337 | (when (and (get-char-property (point) 'invisible) | |
338 | (< (point-min) (point)) | |
339 | (get-char-property (1- (point)) 'invisible)) | |
340 | (goto-char (previous-single-char-property-change (point) | |
341 | 'invisible | |
342 | nil | |
343 | nxml-prolog-end)))) | |
344 | ||
345 | (defun nxml-transform-outline-state (section-start-pos) | |
346 | (let* ((old-state | |
347 | (nxml-get-outline-state section-start-pos)) | |
348 | (change (assq old-state | |
349 | nxml-outline-state-transform-alist))) | |
350 | (when change | |
351 | (nxml-set-outline-state section-start-pos | |
352 | (cdr change))))) | |
10545bd8 | 353 | |
8cd39fb3 MH |
354 | (defun nxml-section-tag-transform-outline-state (startp |
355 | section-start-pos | |
356 | &optional | |
357 | heading-start-pos) | |
358 | (if (not startp) | |
359 | (setq nxml-depth-in-target-section | |
360 | (and nxml-depth-in-target-section | |
361 | (> nxml-depth-in-target-section 0) | |
362 | (1- nxml-depth-in-target-section))) | |
363 | (cond (nxml-depth-in-target-section | |
364 | (setq nxml-depth-in-target-section | |
365 | (1+ nxml-depth-in-target-section))) | |
366 | ((= section-start-pos nxml-target-section-pos) | |
367 | (setq nxml-depth-in-target-section 0))) | |
368 | (when (and nxml-depth-in-target-section | |
369 | (not (member section-start-pos | |
370 | nxml-outline-state-transform-exceptions))) | |
371 | (nxml-transform-outline-state section-start-pos)))) | |
372 | ||
373 | (defun nxml-get-outline-state (pos) | |
374 | (get-text-property pos 'nxml-outline-state)) | |
375 | ||
376 | (defun nxml-set-outline-state (pos state) | |
377 | (nxml-with-unmodifying-text-property-changes | |
378 | (if state | |
379 | (put-text-property pos (1+ pos) 'nxml-outline-state state) | |
380 | (remove-text-properties pos (1+ pos) '(nxml-outline-state nil))))) | |
381 | ||
382 | ;;; Mouse interface | |
383 | ||
384 | (defun nxml-mouse-show-direct-text-content (event) | |
385 | "Do the same as \\[nxml-show-direct-text-content] from a mouse click." | |
386 | (interactive "e") | |
387 | (and (nxml-mouse-set-point event) | |
388 | (nxml-show-direct-text-content))) | |
389 | ||
390 | (defun nxml-mouse-hide-direct-text-content (event) | |
391 | "Do the same as \\[nxml-hide-direct-text-content] from a mouse click." | |
392 | (interactive "e") | |
393 | (and (nxml-mouse-set-point event) | |
394 | (nxml-hide-direct-text-content))) | |
395 | ||
396 | (defun nxml-mouse-hide-subheadings (event) | |
397 | "Do the same as \\[nxml-hide-subheadings] from a mouse click." | |
398 | (interactive "e") | |
399 | (and (nxml-mouse-set-point event) | |
400 | (nxml-hide-subheadings))) | |
401 | ||
402 | (defun nxml-mouse-show-direct-subheadings (event) | |
403 | "Do the same as \\[nxml-show-direct-subheadings] from a mouse click." | |
404 | (interactive "e") | |
405 | (and (nxml-mouse-set-point event) | |
406 | (nxml-show-direct-subheadings))) | |
407 | ||
408 | (defun nxml-mouse-set-point (event) | |
409 | (mouse-set-point event) | |
410 | (and nxml-prolog-end t)) | |
411 | ||
412 | ;; Display | |
413 | ||
c276c74b GM |
414 | (defsubst nxml-token-start-tag-p () |
415 | (or (eq xmltok-type 'start-tag) | |
416 | (eq xmltok-type 'partial-start-tag))) | |
417 | ||
418 | (defsubst nxml-token-end-tag-p () | |
419 | (or (eq xmltok-type 'end-tag) | |
420 | (eq xmltok-type 'partial-end-tag))) | |
421 | ||
10545bd8 | 422 | (defun nxml-refresh-outline () |
8cd39fb3 MH |
423 | "Refresh the outline to correspond to the current XML element structure." |
424 | (interactive) | |
425 | (save-excursion | |
426 | (goto-char (point-min)) | |
427 | (kill-local-variable 'line-move-ignore-invisible) | |
428 | (make-local-variable 'line-move-ignore-invisible) | |
429 | (condition-case err | |
430 | (nxml-outline-display-rest nil nil nil) | |
431 | (nxml-outline-error | |
432 | (nxml-report-outline-error "Cannot display outline: %s" err))))) | |
433 | ||
434 | (defvar nxml-outline-display-section-tag-function nil) | |
435 | ||
436 | (defun nxml-outline-display-rest (outline-state start-tag-indent tag-qnames) | |
437 | "Display up to and including the end of the current element. | |
438 | OUTLINE-STATE can be nil, t, hide-children. START-TAG-INDENT is the | |
439 | indent of the start-tag of the current element, or nil if no | |
440 | containing element has a non-nil OUTLINE-STATE. TAG-QNAMES is a list | |
441 | of the qnames of the open elements. Point is after the title content. | |
10545bd8 | 442 | Leave point after the closing end-tag. Return t if we had a |
8cd39fb3 MH |
443 | non-transparent child section." |
444 | (let ((last-pos (point)) | |
445 | (transparent-depth 0) | |
446 | ;; don't want ellipsis before root element | |
447 | (had-children (not tag-qnames))) | |
448 | (while | |
449 | (cond ((not (nxml-section-tag-forward)) | |
450 | (if (null tag-qnames) | |
451 | nil | |
452 | (nxml-outline-error "missing end-tag %s" | |
453 | (car tag-qnames)))) | |
454 | ;; section end-tag | |
455 | ((nxml-token-end-tag-p) | |
456 | (when nxml-outline-display-section-tag-function | |
457 | (funcall nxml-outline-display-section-tag-function | |
458 | nil | |
459 | xmltok-start)) | |
460 | (let ((qname (xmltok-end-tag-qname))) | |
461 | (unless tag-qnames | |
462 | (nxml-outline-error "extra end-tag %s" qname)) | |
463 | (unless (string= (car tag-qnames) qname) | |
464 | (nxml-outline-error "mismatched end-tag; expected %s, got %s" | |
465 | (car tag-qnames) | |
466 | qname))) | |
467 | (cond ((> transparent-depth 0) | |
468 | (setq transparent-depth (1- transparent-depth)) | |
469 | (setq tag-qnames (cdr tag-qnames)) | |
470 | t) | |
471 | ((not outline-state) | |
472 | (nxml-outline-set-overlay nil last-pos (point)) | |
473 | nil) | |
474 | ((or (not had-children) | |
475 | (eq outline-state 'hide-children)) | |
476 | (nxml-outline-display-single-line-end-tag last-pos) | |
477 | nil) | |
478 | (t | |
479 | (nxml-outline-display-multi-line-end-tag last-pos | |
480 | start-tag-indent) | |
481 | nil))) | |
482 | ;; section start-tag | |
483 | (t | |
484 | (let* ((qname (xmltok-start-tag-qname)) | |
485 | (section-start-pos xmltok-start) | |
486 | (heading-start-pos | |
487 | (and (or nxml-outline-display-section-tag-function | |
488 | (not (eq outline-state 'had-children)) | |
489 | (not had-children)) | |
490 | (nxml-token-starts-line-p) | |
491 | (nxml-heading-start-position)))) | |
492 | (when nxml-outline-display-section-tag-function | |
493 | (funcall nxml-outline-display-section-tag-function | |
494 | t | |
495 | section-start-pos | |
496 | heading-start-pos)) | |
497 | (setq tag-qnames (cons qname tag-qnames)) | |
498 | (if (or (not heading-start-pos) | |
499 | (and (eq outline-state 'hide-children) | |
500 | (setq had-children t))) | |
501 | (setq transparent-depth (1+ transparent-depth)) | |
502 | (nxml-display-section last-pos | |
503 | section-start-pos | |
504 | heading-start-pos | |
505 | start-tag-indent | |
506 | outline-state | |
507 | had-children | |
508 | tag-qnames) | |
509 | (setq had-children t) | |
510 | (setq tag-qnames (cdr tag-qnames)) | |
511 | (setq last-pos (point)))) | |
512 | t))) | |
513 | had-children)) | |
514 | ||
515 | (defconst nxml-highlighted-less-than | |
0526b9d0 | 516 | (propertize "<" 'face 'nxml-tag-delimiter)) |
8cd39fb3 MH |
517 | |
518 | (defconst nxml-highlighted-greater-than | |
0526b9d0 | 519 | (propertize ">" 'face 'nxml-tag-delimiter)) |
8cd39fb3 MH |
520 | |
521 | (defconst nxml-highlighted-colon | |
0526b9d0 | 522 | (propertize ":" 'face 'nxml-element-colon)) |
8cd39fb3 MH |
523 | |
524 | (defconst nxml-highlighted-slash | |
0526b9d0 | 525 | (propertize "/" 'face 'nxml-tag-slash)) |
8cd39fb3 MH |
526 | |
527 | (defconst nxml-highlighted-ellipsis | |
0526b9d0 | 528 | (propertize "..." 'face 'nxml-outline-ellipsis)) |
8cd39fb3 MH |
529 | |
530 | (defconst nxml-highlighted-empty-end-tag | |
531 | (concat nxml-highlighted-ellipsis | |
532 | nxml-highlighted-less-than | |
533 | nxml-highlighted-slash | |
534 | nxml-highlighted-greater-than)) | |
535 | ||
536 | (defconst nxml-highlighted-inactive-minus | |
0526b9d0 | 537 | (propertize "-" 'face 'nxml-outline-indicator)) |
8cd39fb3 MH |
538 | |
539 | (defconst nxml-highlighted-active-minus | |
0526b9d0 | 540 | (propertize "-" 'face 'nxml-outline-active-indicator)) |
8cd39fb3 MH |
541 | |
542 | (defconst nxml-highlighted-active-plus | |
0526b9d0 | 543 | (propertize "+" 'face 'nxml-outline-active-indicator)) |
8cd39fb3 MH |
544 | |
545 | (defun nxml-display-section (last-pos | |
546 | section-start-pos | |
547 | heading-start-pos | |
548 | parent-indent | |
549 | parent-outline-state | |
550 | had-children | |
551 | tag-qnames) | |
552 | (let* ((section-start-pos-bol | |
553 | (save-excursion | |
554 | (goto-char section-start-pos) | |
555 | (skip-chars-backward " \t") | |
556 | (point))) | |
557 | (outline-state (nxml-get-outline-state section-start-pos)) | |
558 | (newline-before-section-start-category | |
559 | (cond ((and (not had-children) parent-outline-state) | |
560 | 'nxml-outline-display-ellipsis) | |
561 | (outline-state 'nxml-outline-display-show) | |
562 | (t nil)))) | |
563 | (nxml-outline-set-overlay (and parent-outline-state | |
564 | 'nxml-outline-display-hide) | |
565 | last-pos | |
566 | (1- section-start-pos-bol) | |
567 | nil | |
568 | t) | |
569 | (if outline-state | |
570 | (let* ((indent (if parent-indent | |
571 | (+ parent-indent nxml-outline-child-indent) | |
572 | (save-excursion | |
573 | (goto-char section-start-pos) | |
574 | (current-column)))) | |
575 | start-tag-overlay) | |
576 | (nxml-outline-set-overlay newline-before-section-start-category | |
577 | (1- section-start-pos-bol) | |
578 | section-start-pos-bol | |
579 | t) | |
580 | (nxml-outline-set-overlay 'nxml-outline-display-hide | |
581 | section-start-pos-bol | |
582 | section-start-pos) | |
583 | (setq start-tag-overlay | |
584 | (nxml-outline-set-overlay 'nxml-outline-display-show | |
585 | section-start-pos | |
586 | (1+ section-start-pos) | |
587 | t)) | |
588 | ;; line motion commands don't work right if start-tag-overlay | |
589 | ;; covers multiple lines | |
590 | (nxml-outline-set-overlay 'nxml-outline-display-hide | |
591 | (1+ section-start-pos) | |
592 | heading-start-pos) | |
593 | (goto-char heading-start-pos) | |
594 | (nxml-end-of-heading) | |
595 | (nxml-outline-set-overlay 'nxml-outline-display-heading | |
596 | heading-start-pos | |
597 | (point)) | |
598 | (let* ((had-children | |
599 | (nxml-outline-display-rest outline-state | |
600 | indent | |
601 | tag-qnames))) | |
602 | (overlay-put start-tag-overlay | |
603 | 'display | |
604 | (concat | |
605 | ;; indent | |
606 | (make-string indent ?\ ) | |
607 | ;; < | |
608 | nxml-highlighted-less-than | |
609 | ;; + or - indicator | |
610 | (cond ((not had-children) | |
611 | nxml-highlighted-inactive-minus) | |
612 | ((eq outline-state 'hide-children) | |
613 | (overlay-put start-tag-overlay | |
614 | 'category | |
615 | 'nxml-outline-display-hiding-tag) | |
616 | nxml-highlighted-active-plus) | |
617 | (t | |
618 | (overlay-put start-tag-overlay | |
619 | 'category | |
620 | 'nxml-outline-display-showing-tag) | |
621 | nxml-highlighted-active-minus)) | |
622 | ;; qname | |
623 | (nxml-highlighted-qname (car tag-qnames)) | |
624 | ;; > | |
625 | nxml-highlighted-greater-than)))) | |
626 | ;; outline-state nil | |
627 | (goto-char heading-start-pos) | |
628 | (nxml-end-of-heading) | |
629 | (nxml-outline-set-overlay newline-before-section-start-category | |
630 | (1- section-start-pos-bol) | |
631 | (point) | |
632 | t) | |
633 | (nxml-outline-display-rest outline-state | |
634 | (and parent-indent | |
635 | (+ parent-indent | |
636 | nxml-outline-child-indent)) | |
637 | tag-qnames)))) | |
638 | ||
639 | (defun nxml-highlighted-qname (qname) | |
640 | (let ((colon (string-match ":" qname))) | |
641 | (if colon | |
642 | (concat (propertize (substring qname 0 colon) | |
643 | 'face | |
0526b9d0 | 644 | 'nxml-element-prefix) |
8cd39fb3 MH |
645 | nxml-highlighted-colon |
646 | (propertize (substring qname (1+ colon)) | |
647 | 'face | |
0526b9d0 | 648 | 'nxml-element-local-name)) |
8cd39fb3 MH |
649 | (propertize qname |
650 | 'face | |
0526b9d0 | 651 | 'nxml-element-local-name)))) |
8cd39fb3 MH |
652 | |
653 | (defun nxml-outline-display-single-line-end-tag (last-pos) | |
654 | (nxml-outline-set-overlay 'nxml-outline-display-hide | |
655 | last-pos | |
656 | xmltok-start | |
657 | nil | |
658 | t) | |
659 | (overlay-put (nxml-outline-set-overlay 'nxml-outline-display-show | |
660 | xmltok-start | |
661 | (point) | |
662 | t) | |
663 | 'display | |
664 | nxml-highlighted-empty-end-tag)) | |
10545bd8 | 665 | |
8cd39fb3 MH |
666 | (defun nxml-outline-display-multi-line-end-tag (last-pos start-tag-indent) |
667 | (let ((indentp (save-excursion | |
668 | (goto-char last-pos) | |
669 | (skip-chars-forward " \t") | |
670 | (and (eq (char-after) ?\n) | |
671 | (progn | |
672 | (goto-char (1+ (point))) | |
673 | (nxml-outline-set-overlay nil last-pos (point)) | |
674 | (setq last-pos (point)) | |
675 | (goto-char xmltok-start) | |
676 | (beginning-of-line) | |
677 | t)))) | |
678 | end-tag-overlay) | |
679 | (nxml-outline-set-overlay 'nxml-outline-display-hide | |
680 | last-pos | |
681 | xmltok-start | |
682 | nil | |
683 | t) | |
684 | (setq end-tag-overlay | |
685 | (nxml-outline-set-overlay 'nxml-outline-display-showing-tag | |
686 | xmltok-start | |
687 | (point) | |
688 | t)) | |
689 | (overlay-put end-tag-overlay | |
690 | 'display | |
691 | (concat (if indentp | |
692 | (make-string start-tag-indent ?\ ) | |
693 | "") | |
694 | nxml-highlighted-less-than | |
695 | nxml-highlighted-slash | |
696 | nxml-highlighted-active-minus | |
697 | (nxml-highlighted-qname (xmltok-end-tag-qname)) | |
698 | nxml-highlighted-greater-than)))) | |
699 | ||
700 | (defvar nxml-outline-show-map | |
701 | (let ((map (make-sparse-keymap))) | |
702 | (define-key map "\C-m" 'nxml-show-direct-text-content) | |
703 | (define-key map [mouse-2] 'nxml-mouse-show-direct-text-content) | |
704 | map)) | |
705 | ||
706 | (defvar nxml-outline-show-help "mouse-2: show") | |
707 | ||
708 | (put 'nxml-outline-display-show 'nxml-outline-display t) | |
709 | (put 'nxml-outline-display-show 'evaporate t) | |
710 | (put 'nxml-outline-display-show 'keymap nxml-outline-show-map) | |
711 | (put 'nxml-outline-display-show 'help-echo nxml-outline-show-help) | |
712 | ||
713 | (put 'nxml-outline-display-hide 'nxml-outline-display t) | |
714 | (put 'nxml-outline-display-hide 'evaporate t) | |
715 | (put 'nxml-outline-display-hide 'invisible t) | |
716 | (put 'nxml-outline-display-hide 'keymap nxml-outline-show-map) | |
717 | (put 'nxml-outline-display-hide 'help-echo nxml-outline-show-help) | |
718 | ||
719 | (put 'nxml-outline-display-ellipsis 'nxml-outline-display t) | |
720 | (put 'nxml-outline-display-ellipsis 'evaporate t) | |
721 | (put 'nxml-outline-display-ellipsis 'keymap nxml-outline-show-map) | |
722 | (put 'nxml-outline-display-ellipsis 'help-echo nxml-outline-show-help) | |
723 | (put 'nxml-outline-display-ellipsis 'before-string nxml-highlighted-ellipsis) | |
724 | ||
725 | (put 'nxml-outline-display-heading 'keymap nxml-outline-show-map) | |
726 | (put 'nxml-outline-display-heading 'help-echo nxml-outline-show-help) | |
727 | (put 'nxml-outline-display-heading 'nxml-outline-display t) | |
728 | (put 'nxml-outline-display-heading 'evaporate t) | |
0526b9d0 | 729 | (put 'nxml-outline-display-heading 'face 'nxml-heading) |
8cd39fb3 MH |
730 | |
731 | (defvar nxml-outline-hiding-tag-map | |
732 | (let ((map (make-sparse-keymap))) | |
733 | (define-key map [mouse-1] 'nxml-mouse-show-direct-subheadings) | |
734 | (define-key map [mouse-2] 'nxml-mouse-show-direct-text-content) | |
735 | (define-key map "\C-m" 'nxml-show-direct-text-content) | |
736 | map)) | |
737 | ||
738 | (defvar nxml-outline-hiding-tag-help | |
739 | "mouse-1: show subheadings, mouse-2: show text content") | |
740 | ||
741 | (put 'nxml-outline-display-hiding-tag 'nxml-outline-display t) | |
742 | (put 'nxml-outline-display-hiding-tag 'evaporate t) | |
743 | (put 'nxml-outline-display-hiding-tag 'keymap nxml-outline-hiding-tag-map) | |
744 | (put 'nxml-outline-display-hiding-tag 'help-echo nxml-outline-hiding-tag-help) | |
745 | ||
746 | (defvar nxml-outline-showing-tag-map | |
747 | (let ((map (make-sparse-keymap))) | |
748 | (define-key map [mouse-1] 'nxml-mouse-hide-subheadings) | |
749 | (define-key map [mouse-2] 'nxml-mouse-show-direct-text-content) | |
750 | (define-key map "\C-m" 'nxml-show-direct-text-content) | |
751 | map)) | |
752 | ||
753 | (defvar nxml-outline-showing-tag-help | |
754 | "mouse-1: hide subheadings, mouse-2: show text content") | |
755 | ||
756 | (put 'nxml-outline-display-showing-tag 'nxml-outline-display t) | |
757 | (put 'nxml-outline-display-showing-tag 'evaporate t) | |
758 | (put 'nxml-outline-display-showing-tag 'keymap nxml-outline-showing-tag-map) | |
759 | (put 'nxml-outline-display-showing-tag | |
760 | 'help-echo | |
761 | nxml-outline-showing-tag-help) | |
762 | ||
763 | (defun nxml-outline-set-overlay (category | |
764 | start | |
765 | end | |
766 | &optional | |
767 | front-advance | |
768 | rear-advance) | |
10545bd8 | 769 | "Replace any `nxml-outline-display' overlays between START and END. |
8cd39fb3 | 770 | Overlays are removed if they overlay the region between START and END, |
10545bd8 JB |
771 | and have a non-nil `nxml-outline-display' property (typically via their |
772 | category). If CATEGORY is non-nil, they will be replaced with a new | |
773 | overlay with that category from START to END. If CATEGORY is nil, | |
774 | no new overlay will be created." | |
8cd39fb3 MH |
775 | (when (< start end) |
776 | (let ((overlays (overlays-in start end)) | |
777 | overlay) | |
778 | (while overlays | |
779 | (setq overlay (car overlays)) | |
780 | (setq overlays (cdr overlays)) | |
781 | (when (overlay-get overlay 'nxml-outline-display) | |
782 | (delete-overlay overlay)))) | |
783 | (and category | |
784 | (let ((overlay (make-overlay start | |
785 | end | |
786 | nil | |
787 | front-advance | |
788 | rear-advance))) | |
789 | (overlay-put overlay 'category category) | |
790 | (setq line-move-ignore-invisible t) | |
791 | overlay)))) | |
792 | ||
793 | (defun nxml-end-of-heading () | |
794 | "Move from the start of the content of the heading to the end. | |
795 | Do not move past the end of the line." | |
796 | (let ((pos (condition-case err | |
797 | (and (nxml-scan-element-forward (point) t) | |
798 | xmltok-start) | |
770af4b4 | 799 | (nxml-scan-error nil)))) |
8cd39fb3 MH |
800 | (end-of-line) |
801 | (skip-chars-backward " \t") | |
802 | (cond ((not pos) | |
803 | (setq pos (nxml-token-before)) | |
804 | (when (eq xmltok-type 'end-tag) | |
805 | (goto-char pos))) | |
806 | ((< pos (point)) | |
807 | (goto-char pos))) | |
808 | (skip-chars-backward " \t") | |
809 | (point))) | |
810 | ||
811 | ;;; Navigating section structure | |
812 | ||
8cd39fb3 MH |
813 | (defun nxml-token-starts-line-p () |
814 | (save-excursion | |
815 | (goto-char xmltok-start) | |
816 | (skip-chars-backward " \t") | |
817 | (bolp))) | |
818 | ||
819 | (defvar nxml-cached-section-tag-regexp nil) | |
820 | (defvar nxml-cached-section-element-name-regexp nil) | |
821 | ||
822 | (defsubst nxml-make-section-tag-regexp () | |
823 | (if (eq nxml-cached-section-element-name-regexp | |
824 | nxml-section-element-name-regexp) | |
825 | nxml-cached-section-tag-regexp | |
826 | (nxml-make-section-tag-regexp-1))) | |
827 | ||
828 | (defun nxml-make-section-tag-regexp-1 () | |
829 | (setq nxml-cached-section-element-name-regexp nil) | |
830 | (setq nxml-cached-section-tag-regexp | |
831 | (concat "</?\\(" | |
832 | "\\(" xmltok-ncname-regexp ":\\)?" | |
833 | nxml-section-element-name-regexp | |
834 | "\\)[ \t\r\n>]")) | |
835 | (setq nxml-cached-section-element-name-regexp | |
836 | nxml-section-element-name-regexp) | |
837 | nxml-cached-section-tag-regexp) | |
838 | ||
839 | (defun nxml-section-tag-forward () | |
840 | "Move forward past the first tag that is a section start- or end-tag. | |
10545bd8 | 841 | Return `xmltok-type' for tag. |
8cd39fb3 MH |
842 | If no tag found, return nil and move to the end of the buffer." |
843 | (let ((case-fold-search nil) | |
844 | (tag-regexp (nxml-make-section-tag-regexp)) | |
845 | match-end) | |
846 | (when (< (point) nxml-prolog-end) | |
847 | (goto-char nxml-prolog-end)) | |
848 | (while (cond ((not (re-search-forward tag-regexp nil 'move)) | |
849 | (setq xmltok-type nil) | |
850 | nil) | |
851 | ((progn | |
852 | (goto-char (match-beginning 0)) | |
853 | (setq match-end (match-end 0)) | |
854 | (nxml-ensure-scan-up-to-date) | |
855 | (let ((end (nxml-inside-end (point)))) | |
856 | (when end | |
857 | (goto-char end) | |
858 | t)))) | |
859 | ((progn | |
860 | (xmltok-forward) | |
861 | (and (memq xmltok-type '(start-tag | |
862 | partial-start-tag | |
863 | end-tag | |
864 | partial-end-tag)) | |
865 | ;; just in case wildcard matched non-name chars | |
866 | (= xmltok-name-end (1- match-end)))) | |
867 | nil) | |
868 | (t)))) | |
869 | xmltok-type) | |
10545bd8 | 870 | |
8cd39fb3 MH |
871 | (defun nxml-section-tag-backward () |
872 | "Move backward to the end of a tag that is a section start- or end-tag. | |
10545bd8 | 873 | The position of the end of the tag must be <= point. |
8cd39fb3 MH |
874 | Point is at the end of the tag. `xmltok-start' is the start." |
875 | (let ((case-fold-search nil) | |
876 | (start (point)) | |
877 | (tag-regexp (nxml-make-section-tag-regexp)) | |
878 | match-end) | |
879 | (if (< (point) nxml-prolog-end) | |
880 | (progn | |
881 | (goto-char (point-min)) | |
882 | nil) | |
883 | (while (cond ((not (re-search-backward tag-regexp | |
884 | nxml-prolog-end | |
885 | 'move)) | |
886 | (setq xmltok-type nil) | |
887 | (goto-char (point-min)) | |
888 | nil) | |
889 | ((progn | |
890 | (goto-char (match-beginning 0)) | |
891 | (setq match-end (match-end 0)) | |
892 | (nxml-ensure-scan-up-to-date) | |
893 | (let ((pos (nxml-inside-start (point)))) | |
894 | (when pos | |
895 | (goto-char (1- pos)) | |
896 | t)))) | |
897 | ((progn | |
898 | (xmltok-forward) | |
899 | (and (<= (point) start) | |
900 | (memq xmltok-type '(start-tag | |
901 | partial-start-tag | |
902 | end-tag | |
903 | partial-end-tag)) | |
904 | ;; just in case wildcard matched non-name chars | |
905 | (= xmltok-name-end (1- match-end)))) | |
906 | nil) | |
907 | (t (goto-char xmltok-start) | |
908 | t))) | |
909 | xmltok-type))) | |
910 | ||
911 | (defun nxml-section-start-position () | |
912 | "Return the position of the start of the section containing point. | |
913 | Signal an error on failure." | |
914 | (condition-case err | |
915 | (save-excursion (if (nxml-back-to-section-start) | |
916 | (point) | |
917 | (error "Not in section"))) | |
918 | (nxml-outline-error | |
919 | (nxml-report-outline-error "Couldn't determine containing section: %s" | |
920 | err)))) | |
921 | ||
922 | (defun nxml-back-to-section-start (&optional invisible-ok) | |
923 | "Try to move back to the start of the section containing point. | |
924 | The start of the section must be <= point. | |
925 | Only visible sections are included unless INVISIBLE-OK is non-nil. | |
10545bd8 | 926 | If found, return t. Otherwise move to `point-min' and return nil. |
8cd39fb3 MH |
927 | If unbalanced section tags are found, signal an `nxml-outline-error'." |
928 | (when (or (nxml-after-section-start-tag) | |
929 | (nxml-section-tag-backward)) | |
930 | (let (open-tags found) | |
931 | (while (let (section-start-pos) | |
932 | (setq section-start-pos xmltok-start) | |
933 | (if (nxml-token-end-tag-p) | |
934 | (setq open-tags (cons (xmltok-end-tag-qname) | |
935 | open-tags)) | |
936 | (if (not open-tags) | |
937 | (when (and (nxml-token-starts-line-p) | |
938 | (or invisible-ok | |
939 | (not (get-char-property section-start-pos | |
940 | 'invisible))) | |
941 | (nxml-heading-start-position)) | |
942 | (setq found t)) | |
943 | (let ((qname (xmltok-start-tag-qname))) | |
944 | (unless (string= (car open-tags) qname) | |
945 | (nxml-outline-error "mismatched end-tag")) | |
946 | (setq open-tags (cdr open-tags))))) | |
947 | (goto-char section-start-pos) | |
948 | (and (not found) | |
949 | (nxml-section-tag-backward)))) | |
950 | found))) | |
951 | ||
952 | (defun nxml-after-section-start-tag () | |
953 | "If the character after point is in a section start-tag, move after it. | |
954 | Return the token type. Otherwise return nil. | |
955 | Set up variables like `xmltok-forward'." | |
956 | (let ((pos (nxml-token-after)) | |
957 | (case-fold-search nil)) | |
958 | (when (and (memq xmltok-type '(start-tag partial-start-tag)) | |
959 | (save-excursion | |
960 | (goto-char xmltok-start) | |
961 | (looking-at (nxml-make-section-tag-regexp)))) | |
962 | (goto-char pos) | |
963 | xmltok-type))) | |
964 | ||
965 | (defun nxml-heading-start-position () | |
966 | "Return the position of the start of the content of a heading element. | |
967 | Adjust the position to be after initial leading whitespace. | |
968 | Return nil if no heading element is found. Requires point to be | |
969 | immediately after the section's start-tag." | |
970 | (let ((depth 0) | |
971 | (heading-regexp (concat "\\`\\(" | |
972 | nxml-heading-element-name-regexp | |
973 | "\\)\\'")) | |
10545bd8 | 974 | |
8cd39fb3 MH |
975 | (section-regexp (concat "\\`\\(" |
976 | nxml-section-element-name-regexp | |
977 | "\\)\\'")) | |
978 | (start (point)) | |
979 | found) | |
980 | (save-excursion | |
981 | (while (and (xmltok-forward) | |
982 | (cond ((memq xmltok-type '(end-tag partial-end-tag)) | |
983 | (and (not (string-match section-regexp | |
984 | (xmltok-end-tag-local-name))) | |
985 | (> depth 0) | |
986 | (setq depth (1- depth)))) | |
987 | ;; XXX Not sure whether this is a good idea | |
988 | ;;((eq xmltok-type 'empty-element) | |
989 | ;; nil) | |
990 | ((not (memq xmltok-type | |
991 | '(start-tag partial-start-tag))) | |
992 | t) | |
993 | ((string-match section-regexp | |
994 | (xmltok-start-tag-local-name)) | |
995 | nil) | |
996 | ((string-match heading-regexp | |
997 | (xmltok-start-tag-local-name)) | |
998 | (skip-chars-forward " \t\r\n") | |
999 | (setq found (point)) | |
1000 | nil) | |
1001 | (t | |
1002 | (setq depth (1+ depth)) | |
1003 | t)) | |
1004 | (<= (- (point) start) nxml-heading-scan-distance)))) | |
1005 | found)) | |
1006 | ||
1007 | ;;; Error handling | |
1008 | ||
1009 | (defun nxml-report-outline-error (msg err) | |
1010 | (error msg (apply 'format (cdr err)))) | |
1011 | ||
1012 | (defun nxml-outline-error (&rest args) | |
1013 | (signal 'nxml-outline-error args)) | |
1014 | ||
1015 | (put 'nxml-outline-error | |
1016 | 'error-conditions | |
1017 | '(error nxml-error nxml-outline-error)) | |
1018 | ||
1019 | (put 'nxml-outline-error | |
1020 | 'error-message | |
1021 | "Cannot create outline of buffer that is not well-formed") | |
1022 | ||
1023 | ;;; Debugging | |
1024 | ||
1025 | (defun nxml-debug-overlays () | |
1026 | (interactive) | |
1027 | (let ((overlays (nreverse (overlays-in (point-min) (point-max)))) | |
1028 | overlay) | |
1029 | (while overlays | |
1030 | (setq overlay (car overlays)) | |
1031 | (setq overlays (cdr overlays)) | |
1032 | (when (overlay-get overlay 'nxml-outline-display) | |
1033 | (message "overlay %s: %s...%s (%s)" | |
1034 | (overlay-get overlay 'category) | |
1035 | (overlay-start overlay) | |
1036 | (overlay-end overlay) | |
1037 | (overlay-get overlay 'display)))))) | |
1038 | ||
1039 | (provide 'nxml-outln) | |
1040 | ||
1041 | ;;; nxml-outln.el ends here |