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