1 ;;; nxml-outln.el --- outline support for nXML mode
3 ;; Copyright (C) 2004, 2007, 2008 Free Software Foundation, Inc.
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
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.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
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
29 ;; 2. display just the title specially; child sections are not displayed
30 ;; regardless of their state; anything not part of child sections is
32 ;; 3. display the title specially and display child sections
33 ;; according to their state; anything not part of the child section is
35 ;; The state of a section is determined by the value of the
36 ;; nxml-outline-state text property of the < character that starts
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.
46 ;; For a section to be recognized as such, the following conditions must
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
55 ;; XXX What happens if an nxml-outline-state property is attached to a
56 ;; character that doesn't start a section element?
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]
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.
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:
88 - its local name (that is, the name without the prefix) matches
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
95 - its start-tag occurs at the beginning of a line (possibly indented)."
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."
107 (defcustom nxml-outline-child-indent
2
108 "*Indentation in an outline for child element relative to parent element."
112 (defface nxml-heading
113 '((t (:weight bold
)))
114 "Face used for the contents of abbreviated heading elements."
117 (defface nxml-outline-indicator
118 '((t (:inherit default
)))
119 "Face used for `+' or `-' before element names in outlines."
122 (defface nxml-outline-active-indicator
123 '((t (:box t
:inherit nxml-outline-indicator
)))
124 "Face used for clickable `+' or `-' before element names in outlines."
127 (defface nxml-outline-ellipsis
128 '((t (:bold t
:inherit default
)))
129 "Face used for `...' in outlines."
132 (defvar nxml-heading-scan-distance
1000
133 "Maximum distance from section to scan for heading.")
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
)
150 ;;; Commands for changing visibility
152 (defun nxml-show-all ()
153 "Show all elements in the buffer normally."
155 (nxml-with-unmodifying-text-property-changes
156 (remove-text-properties (point-min)
158 '(nxml-outline-state nil
)))
159 (nxml-outline-set-overlay nil
(point-min) (point-max)))
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.
164 The visibility of headings at any level will not be changed. See the
165 variable `nxml-section-element-name-regexp' for more details on how to
166 customize which elements are recognized as sections and headings."
168 (nxml-transform-buffer-outline '((nil . t
))))
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
173 will not be changed. The section containing point is the innermost
174 section that contains the character following point. See the variable
175 `nxml-section-element-name-regexp' for more details on how to
176 customize which elements are recognized as sections and headings."
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))
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
186 the character following point. See the variable
187 `nxml-section-element-name-regexp' for more details on how to
188 customize which elements are recognized as sections and headings."
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))
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
200 innermost section that contains the character following point. See the
201 variable `nxml-section-element-name-regexp' for more details on how to
202 customize which elements are recognized as sections and headings."
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))
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]
215 would show only the heading of the subsections. The section containing
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
221 (nxml-transform-subtree-outline '((nil . hide-children
)
222 (t . hide-children
))))
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."
232 (nxml-transform-subtree-outline '((hide-children . nil
)
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
238 the character following point. See the variable
239 `nxml-section-element-name-regexp' for more details on how to
240 customize which elements are recognized as sections and headings."
242 (nxml-transform-subtree-outline '((nil . t
))))
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
248 contains the character following point. See the variable
249 `nxml-section-element-name-regexp' for more details on how to
250 customize which elements are recognized as sections and headings."
252 (nxml-transform-subtree-outline '((hide-children . t
))))
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
258 section that contains the character following point. See the variable
259 `nxml-section-element-name-regexp' for more details on how to
260 customize which elements are recognized as sections and headings."
262 (let ((nxml-outline-state-transform-exceptions nil
))
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"
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
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
)))))
281 ;; These variables are dynamically bound. They are use to pass information to
282 ;; nxml-section-tag-transform-outline-state.
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
)
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))
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))
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
))))
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
322 (goto-char (previous-single-char-property-change (1- (point))
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))
329 ((and (< (point) (point-max))
330 (get-char-property (point) 'invisible
))
331 (goto-char (next-single-char-property-change (point)
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)
344 (defun nxml-transform-outline-state (section-start-pos)
346 (nxml-get-outline-state section-start-pos
))
347 (change (assq old-state
348 nxml-outline-state-transform-alist
)))
350 (nxml-set-outline-state section-start-pos
353 (defun nxml-section-tag-transform-outline-state (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
))))
372 (defun nxml-get-outline-state (pos)
373 (get-text-property pos
'nxml-outline-state
))
375 (defun nxml-set-outline-state (pos state
)
376 (nxml-with-unmodifying-text-property-changes
378 (put-text-property pos
(1+ pos
) 'nxml-outline-state state
)
379 (remove-text-properties pos
(1+ pos
) '(nxml-outline-state nil
)))))
383 (defun nxml-mouse-show-direct-text-content (event)
384 "Do the same as \\[nxml-show-direct-text-content] from a mouse click."
386 (and (nxml-mouse-set-point event
)
387 (nxml-show-direct-text-content)))
389 (defun nxml-mouse-hide-direct-text-content (event)
390 "Do the same as \\[nxml-hide-direct-text-content] from a mouse click."
392 (and (nxml-mouse-set-point event
)
393 (nxml-hide-direct-text-content)))
395 (defun nxml-mouse-hide-subheadings (event)
396 "Do the same as \\[nxml-hide-subheadings] from a mouse click."
398 (and (nxml-mouse-set-point event
)
399 (nxml-hide-subheadings)))
401 (defun nxml-mouse-show-direct-subheadings (event)
402 "Do the same as \\[nxml-show-direct-subheadings] from a mouse click."
404 (and (nxml-mouse-set-point event
)
405 (nxml-show-direct-subheadings)))
407 (defun nxml-mouse-set-point (event)
408 (mouse-set-point event
)
409 (and nxml-prolog-end t
))
413 (defsubst nxml-token-start-tag-p
()
414 (or (eq xmltok-type
'start-tag
)
415 (eq xmltok-type
'partial-start-tag
)))
417 (defsubst nxml-token-end-tag-p
()
418 (or (eq xmltok-type
'end-tag
)
419 (eq xmltok-type
'partial-end-tag
)))
421 (defun nxml-refresh-outline ()
422 "Refresh the outline to correspond to the current XML element structure."
425 (goto-char (point-min))
426 (kill-local-variable 'line-move-ignore-invisible
)
427 (make-local-variable 'line-move-ignore-invisible
)
429 (nxml-outline-display-rest nil nil nil
)
431 (nxml-report-outline-error "Cannot display outline: %s" err
)))))
433 (defvar nxml-outline-display-section-tag-function nil
)
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.
441 Leave point after the closing end-tag Return t if we had a
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
)))
448 (cond ((not (nxml-section-tag-forward))
449 (if (null tag-qnames
)
451 (nxml-outline-error "missing end-tag %s"
454 ((nxml-token-end-tag-p)
455 (when nxml-outline-display-section-tag-function
456 (funcall nxml-outline-display-section-tag-function
459 (let ((qname (xmltok-end-tag-qname)))
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"
466 (cond ((> transparent-depth
0)
467 (setq transparent-depth
(1- transparent-depth
))
468 (setq tag-qnames
(cdr tag-qnames
))
471 (nxml-outline-set-overlay nil last-pos
(point))
473 ((or (not had-children
)
474 (eq outline-state
'hide-children
))
475 (nxml-outline-display-single-line-end-tag last-pos
)
478 (nxml-outline-display-multi-line-end-tag last-pos
483 (let* ((qname (xmltok-start-tag-qname))
484 (section-start-pos xmltok-start
)
486 (and (or nxml-outline-display-section-tag-function
487 (not (eq outline-state
'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
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
508 (setq had-children t
)
509 (setq tag-qnames
(cdr tag-qnames
))
510 (setq last-pos
(point))))
514 (defconst nxml-highlighted-less-than
515 (propertize "<" 'face
'nxml-tag-delimiter
))
517 (defconst nxml-highlighted-greater-than
518 (propertize ">" 'face
'nxml-tag-delimiter
))
520 (defconst nxml-highlighted-colon
521 (propertize ":" 'face
'nxml-element-colon
))
523 (defconst nxml-highlighted-slash
524 (propertize "/" 'face
'nxml-tag-slash
))
526 (defconst nxml-highlighted-ellipsis
527 (propertize "..." 'face
'nxml-outline-ellipsis
))
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
))
535 (defconst nxml-highlighted-inactive-minus
536 (propertize "-" 'face
'nxml-outline-indicator
))
538 (defconst nxml-highlighted-active-minus
539 (propertize "-" 'face
'nxml-outline-active-indicator
))
541 (defconst nxml-highlighted-active-plus
542 (propertize "+" 'face
'nxml-outline-active-indicator
))
544 (defun nxml-display-section (last-pos
551 (let* ((section-start-pos-bol
553 (goto-char section-start-pos
)
554 (skip-chars-backward " \t")
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
)
562 (nxml-outline-set-overlay (and parent-outline-state
563 'nxml-outline-display-hide
)
565 (1- section-start-pos-bol
)
569 (let* ((indent (if parent-indent
570 (+ parent-indent nxml-outline-child-indent
)
572 (goto-char section-start-pos
)
575 (nxml-outline-set-overlay newline-before-section-start-category
576 (1- section-start-pos-bol
)
577 section-start-pos-bol
579 (nxml-outline-set-overlay 'nxml-outline-display-hide
580 section-start-pos-bol
582 (setq start-tag-overlay
583 (nxml-outline-set-overlay 'nxml-outline-display-show
585 (1+ section-start-pos
)
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
)
592 (goto-char heading-start-pos
)
593 (nxml-end-of-heading)
594 (nxml-outline-set-overlay 'nxml-outline-display-heading
598 (nxml-outline-display-rest outline-state
601 (overlay-put start-tag-overlay
605 (make-string indent ?\
)
607 nxml-highlighted-less-than
609 (cond ((not had-children
)
610 nxml-highlighted-inactive-minus
)
611 ((eq outline-state
'hide-children
)
612 (overlay-put start-tag-overlay
614 'nxml-outline-display-hiding-tag
)
615 nxml-highlighted-active-plus
)
617 (overlay-put start-tag-overlay
619 'nxml-outline-display-showing-tag
)
620 nxml-highlighted-active-minus
))
622 (nxml-highlighted-qname (car tag-qnames
))
624 nxml-highlighted-greater-than
))))
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
)
632 (nxml-outline-display-rest outline-state
635 nxml-outline-child-indent
))
638 (defun nxml-highlighted-qname (qname)
639 (let ((colon (string-match ":" qname
)))
641 (concat (propertize (substring qname
0 colon
)
643 'nxml-element-prefix
)
644 nxml-highlighted-colon
645 (propertize (substring qname
(1+ colon
))
647 'nxml-element-local-name
))
650 'nxml-element-local-name
))))
652 (defun nxml-outline-display-single-line-end-tag (last-pos)
653 (nxml-outline-set-overlay 'nxml-outline-display-hide
658 (overlay-put (nxml-outline-set-overlay 'nxml-outline-display-show
663 nxml-highlighted-empty-end-tag
))
665 (defun nxml-outline-display-multi-line-end-tag (last-pos start-tag-indent
)
666 (let ((indentp (save-excursion
668 (skip-chars-forward " \t")
669 (and (eq (char-after) ?
\n)
671 (goto-char (1+ (point)))
672 (nxml-outline-set-overlay nil last-pos
(point))
673 (setq last-pos
(point))
674 (goto-char xmltok-start
)
678 (nxml-outline-set-overlay 'nxml-outline-display-hide
683 (setq end-tag-overlay
684 (nxml-outline-set-overlay 'nxml-outline-display-showing-tag
688 (overlay-put end-tag-overlay
691 (make-string start-tag-indent ?\
)
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
))))
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
)
705 (defvar nxml-outline-show-help
"mouse-2: show")
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
)
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
)
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
)
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
)
728 (put 'nxml-outline-display-heading
'face
'nxml-heading
)
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
)
737 (defvar nxml-outline-hiding-tag-help
738 "mouse-1: show subheadings, mouse-2: show text content")
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
)
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
)
752 (defvar nxml-outline-showing-tag-help
753 "mouse-1: hide subheadings, mouse-2: show text content")
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
760 nxml-outline-showing-tag-help
)
762 (defun nxml-outline-set-overlay (category
768 "Replace any nxml-outline-display overlays between START and END.
769 Overlays are removed if they overlay the region between START and END,
770 and have a non-nil nxml-outline-display property (typically via their
771 category). If CATEGORY is non-nil, they will be replaced with a new overlay
772 with that category from START to END. If CATEGORY is nil, no new
773 overlay will be created."
775 (let ((overlays (overlays-in start end
))
778 (setq overlay
(car overlays
))
779 (setq overlays
(cdr overlays
))
780 (when (overlay-get overlay
'nxml-outline-display
)
781 (delete-overlay overlay
))))
783 (let ((overlay (make-overlay start
788 (overlay-put overlay
'category category
)
789 (setq line-move-ignore-invisible t
)
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
)
800 (skip-chars-backward " \t")
802 (setq pos
(nxml-token-before))
803 (when (eq xmltok-type
'end-tag
)
807 (skip-chars-backward " \t")
810 ;;; Navigating section structure
812 (defun nxml-token-starts-line-p ()
814 (goto-char xmltok-start
)
815 (skip-chars-backward " \t")
818 (defvar nxml-cached-section-tag-regexp nil
)
819 (defvar nxml-cached-section-element-name-regexp nil
)
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)))
827 (defun nxml-make-section-tag-regexp-1 ()
828 (setq nxml-cached-section-element-name-regexp nil
)
829 (setq nxml-cached-section-tag-regexp
831 "\\(" xmltok-ncname-regexp
":\\)?"
832 nxml-section-element-name-regexp
834 (setq nxml-cached-section-element-name-regexp
835 nxml-section-element-name-regexp
)
836 nxml-cached-section-tag-regexp
)
838 (defun nxml-section-tag-forward ()
839 "Move forward past the first tag that is a section start- or end-tag.
840 Return xmltok-type for tag.
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))
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
)
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))))
860 (and (memq xmltok-type
'(start-tag
864 ;; just in case wildcard matched non-name chars
865 (= xmltok-name-end
(1- match-end
))))
870 (defun nxml-section-tag-backward ()
871 "Move backward to the end of a tag that is a section start- or end-tag.
872 The position of the end of the tag must be <= point
873 Point is at the end of the tag. `xmltok-start' is the start."
874 (let ((case-fold-search nil
)
876 (tag-regexp (nxml-make-section-tag-regexp))
878 (if (< (point) nxml-prolog-end
)
880 (goto-char (point-min))
882 (while (cond ((not (re-search-backward tag-regexp
885 (setq xmltok-type nil
)
886 (goto-char (point-min))
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))))
898 (and (<= (point) start
)
899 (memq xmltok-type
'(start-tag
903 ;; just in case wildcard matched non-name chars
904 (= xmltok-name-end
(1- match-end
))))
906 (t (goto-char xmltok-start
)
910 (defun nxml-section-start-position ()
911 "Return the position of the start of the section containing point.
912 Signal an error on failure."
914 (save-excursion (if (nxml-back-to-section-start)
916 (error "Not in section")))
918 (nxml-report-outline-error "Couldn't determine containing section: %s"
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.
925 If found, return t. Otherwise move to point-min and return nil.
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)
936 (when (and (nxml-token-starts-line-p)
938 (not (get-char-property section-start-pos
940 (nxml-heading-start-position))
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
)
948 (nxml-section-tag-backward))))
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
))
959 (goto-char xmltok-start
)
960 (looking-at (nxml-make-section-tag-regexp))))
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."
970 (heading-regexp (concat "\\`\\("
971 nxml-heading-element-name-regexp
974 (section-regexp (concat "\\`\\("
975 nxml-section-element-name-regexp
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)))
985 (setq depth
(1- depth
))))
986 ;; XXX Not sure whether this is a good idea
987 ;;((eq xmltok-type 'empty-element)
989 ((not (memq xmltok-type
990 '(start-tag partial-start-tag
)))
992 ((string-match section-regexp
993 (xmltok-start-tag-local-name))
995 ((string-match heading-regexp
996 (xmltok-start-tag-local-name))
997 (skip-chars-forward " \t\r\n")
1001 (setq depth
(1+ depth
))
1003 (<= (- (point) start
) nxml-heading-scan-distance
))))
1008 (defun nxml-report-outline-error (msg err
)
1009 (error msg
(apply 'format
(cdr err
))))
1011 (defun nxml-outline-error (&rest args
)
1012 (signal 'nxml-outline-error args
))
1014 (put 'nxml-outline-error
1016 '(error nxml-error nxml-outline-error
))
1018 (put 'nxml-outline-error
1020 "Cannot create outline of buffer that is not well-formed")
1024 (defun nxml-debug-overlays ()
1026 (let ((overlays (nreverse (overlays-in (point-min) (point-max))))
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
))))))
1038 (provide 'nxml-outln
)
1040 ;; arch-tag: 1f1b7454-e573-4cd7-a505-d9dc64eef828
1041 ;;; nxml-outln.el ends here