1 ;;; nxml-outln.el --- outline support for nXML mode
3 ;; Copyright (C) 2004, 2007, 2008, 2009, 2010
4 ;; Free Software Foundation, Inc.
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
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.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
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
30 ;; 2. display just the title specially; child sections are not displayed
31 ;; regardless of their state; anything not part of child sections is
33 ;; 3. display the title specially and display child sections
34 ;; according to their state; anything not part of the child section is
36 ;; The state of a section is determined by the value of the
37 ;; nxml-outline-state text property of the < character that starts
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.
47 ;; For a section to be recognized as such, the following conditions must
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
56 ;; XXX What happens if an nxml-outline-state property is attached to a
57 ;; character that doesn't start a section element?
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]
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.
84 (defcustom nxml-section-element-name-regexp
85 "article\\|\\(sub\\)*section\\|chapter\\|div\\|appendix\\|part\\|preface\\|reference\\|simplesect\\|bibliography\\|bibliodiv\\|glossary\\|glossdiv"
86 "Regular expression matching the name of elements used as sections.
87 An XML element is treated as a section if:
89 - its local name (that is, the name without the prefix) matches
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
96 - its start-tag occurs at the beginning of a line (possibly indented)."
100 (defcustom nxml-heading-element-name-regexp
"title\\|head"
101 "Regular expression matching the name of elements used as headings.
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."
108 (defcustom nxml-outline-child-indent
2
109 "Indentation in an outline for child element relative to parent element."
113 (defface nxml-heading
114 '((t (:weight bold
)))
115 "Face used for the contents of abbreviated heading elements."
118 (defface nxml-outline-indicator
119 '((t (:inherit default
)))
120 "Face used for `+' or `-' before element names in outlines."
123 (defface nxml-outline-active-indicator
124 '((t (:box t
:inherit nxml-outline-indicator
)))
125 "Face used for clickable `+' or `-' before element names in outlines."
128 (defface nxml-outline-ellipsis
129 '((t (:bold t
:inherit default
)))
130 "Face used for `...' in outlines."
133 (defvar nxml-heading-scan-distance
1000
134 "Maximum distance from section to scan for heading.")
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
)
151 ;;; Commands for changing visibility
153 (defun nxml-show-all ()
154 "Show all elements in the buffer normally."
156 (nxml-with-unmodifying-text-property-changes
157 (remove-text-properties (point-min)
159 '(nxml-outline-state nil
)))
160 (nxml-outline-set-overlay nil
(point-min) (point-max)))
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.
165 The visibility of headings at any level will not be changed. See the
166 variable `nxml-section-element-name-regexp' for more details on how to
167 customize which elements are recognized as sections and headings."
169 (nxml-transform-buffer-outline '((nil . t
))))
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
174 will not be changed. The section containing point is the innermost
175 section that contains the character following point. See the variable
176 `nxml-section-element-name-regexp' for more details on how to
177 customize which elements are recognized as sections and headings."
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))
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
187 the character following point. See the variable
188 `nxml-section-element-name-regexp' for more details on how to
189 customize which elements are recognized as sections and headings."
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))
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
201 innermost section that contains the character following point. See the
202 variable `nxml-section-element-name-regexp' for more details on how to
203 customize which elements are recognized as sections and headings."
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))
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]
216 would show only the heading of the subsections. The section containing
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
222 (nxml-transform-subtree-outline '((nil . hide-children
)
223 (t . hide-children
))))
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."
233 (nxml-transform-subtree-outline '((hide-children . nil
)
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
239 the character following point. See the variable
240 `nxml-section-element-name-regexp' for more details on how to
241 customize which elements are recognized as sections and headings."
243 (nxml-transform-subtree-outline '((nil . t
))))
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
249 contains the character following point. See the variable
250 `nxml-section-element-name-regexp' for more details on how to
251 customize which elements are recognized as sections and headings."
253 (nxml-transform-subtree-outline '((hide-children . t
))))
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
259 section that contains the character following point. See the variable
260 `nxml-section-element-name-regexp' for more details on how to
261 customize which elements are recognized as sections and headings."
263 (let ((nxml-outline-state-transform-exceptions nil
))
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"
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
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
)))))
282 ;; These variables are dynamically bound. They are use to pass information to
283 ;; nxml-section-tag-transform-outline-state.
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
)
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))
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))
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
))))
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
323 (goto-char (previous-single-char-property-change (1- (point))
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))
330 ((and (< (point) (point-max))
331 (get-char-property (point) 'invisible
))
332 (goto-char (next-single-char-property-change (point)
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)
345 (defun nxml-transform-outline-state (section-start-pos)
347 (nxml-get-outline-state section-start-pos
))
348 (change (assq old-state
349 nxml-outline-state-transform-alist
)))
351 (nxml-set-outline-state section-start-pos
354 (defun nxml-section-tag-transform-outline-state (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
))))
373 (defun nxml-get-outline-state (pos)
374 (get-text-property pos
'nxml-outline-state
))
376 (defun nxml-set-outline-state (pos state
)
377 (nxml-with-unmodifying-text-property-changes
379 (put-text-property pos
(1+ pos
) 'nxml-outline-state state
)
380 (remove-text-properties pos
(1+ pos
) '(nxml-outline-state nil
)))))
384 (defun nxml-mouse-show-direct-text-content (event)
385 "Do the same as \\[nxml-show-direct-text-content] from a mouse click."
387 (and (nxml-mouse-set-point event
)
388 (nxml-show-direct-text-content)))
390 (defun nxml-mouse-hide-direct-text-content (event)
391 "Do the same as \\[nxml-hide-direct-text-content] from a mouse click."
393 (and (nxml-mouse-set-point event
)
394 (nxml-hide-direct-text-content)))
396 (defun nxml-mouse-hide-subheadings (event)
397 "Do the same as \\[nxml-hide-subheadings] from a mouse click."
399 (and (nxml-mouse-set-point event
)
400 (nxml-hide-subheadings)))
402 (defun nxml-mouse-show-direct-subheadings (event)
403 "Do the same as \\[nxml-show-direct-subheadings] from a mouse click."
405 (and (nxml-mouse-set-point event
)
406 (nxml-show-direct-subheadings)))
408 (defun nxml-mouse-set-point (event)
409 (mouse-set-point event
)
410 (and nxml-prolog-end t
))
414 (defsubst nxml-token-start-tag-p
()
415 (or (eq xmltok-type
'start-tag
)
416 (eq xmltok-type
'partial-start-tag
)))
418 (defsubst nxml-token-end-tag-p
()
419 (or (eq xmltok-type
'end-tag
)
420 (eq xmltok-type
'partial-end-tag
)))
422 (defun nxml-refresh-outline ()
423 "Refresh the outline to correspond to the current XML element structure."
426 (goto-char (point-min))
427 (kill-local-variable 'line-move-ignore-invisible
)
428 (make-local-variable 'line-move-ignore-invisible
)
430 (nxml-outline-display-rest nil nil nil
)
432 (nxml-report-outline-error "Cannot display outline: %s" err
)))))
434 (defvar nxml-outline-display-section-tag-function nil
)
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.
442 Leave point after the closing end-tag. Return t if we had a
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
)))
449 (cond ((not (nxml-section-tag-forward))
450 (if (null tag-qnames
)
452 (nxml-outline-error "missing end-tag %s"
455 ((nxml-token-end-tag-p)
456 (when nxml-outline-display-section-tag-function
457 (funcall nxml-outline-display-section-tag-function
460 (let ((qname (xmltok-end-tag-qname)))
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"
467 (cond ((> transparent-depth
0)
468 (setq transparent-depth
(1- transparent-depth
))
469 (setq tag-qnames
(cdr tag-qnames
))
472 (nxml-outline-set-overlay nil last-pos
(point))
474 ((or (not had-children
)
475 (eq outline-state
'hide-children
))
476 (nxml-outline-display-single-line-end-tag last-pos
)
479 (nxml-outline-display-multi-line-end-tag last-pos
484 (let* ((qname (xmltok-start-tag-qname))
485 (section-start-pos xmltok-start
)
487 (and (or nxml-outline-display-section-tag-function
488 (not (eq outline-state
'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
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
509 (setq had-children t
)
510 (setq tag-qnames
(cdr tag-qnames
))
511 (setq last-pos
(point))))
515 (defconst nxml-highlighted-less-than
516 (propertize "<" 'face
'nxml-tag-delimiter
))
518 (defconst nxml-highlighted-greater-than
519 (propertize ">" 'face
'nxml-tag-delimiter
))
521 (defconst nxml-highlighted-colon
522 (propertize ":" 'face
'nxml-element-colon
))
524 (defconst nxml-highlighted-slash
525 (propertize "/" 'face
'nxml-tag-slash
))
527 (defconst nxml-highlighted-ellipsis
528 (propertize "..." 'face
'nxml-outline-ellipsis
))
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
))
536 (defconst nxml-highlighted-inactive-minus
537 (propertize "-" 'face
'nxml-outline-indicator
))
539 (defconst nxml-highlighted-active-minus
540 (propertize "-" 'face
'nxml-outline-active-indicator
))
542 (defconst nxml-highlighted-active-plus
543 (propertize "+" 'face
'nxml-outline-active-indicator
))
545 (defun nxml-display-section (last-pos
552 (let* ((section-start-pos-bol
554 (goto-char section-start-pos
)
555 (skip-chars-backward " \t")
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
)
563 (nxml-outline-set-overlay (and parent-outline-state
564 'nxml-outline-display-hide
)
566 (1- section-start-pos-bol
)
570 (let* ((indent (if parent-indent
571 (+ parent-indent nxml-outline-child-indent
)
573 (goto-char section-start-pos
)
576 (nxml-outline-set-overlay newline-before-section-start-category
577 (1- section-start-pos-bol
)
578 section-start-pos-bol
580 (nxml-outline-set-overlay 'nxml-outline-display-hide
581 section-start-pos-bol
583 (setq start-tag-overlay
584 (nxml-outline-set-overlay 'nxml-outline-display-show
586 (1+ section-start-pos
)
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
)
593 (goto-char heading-start-pos
)
594 (nxml-end-of-heading)
595 (nxml-outline-set-overlay 'nxml-outline-display-heading
599 (nxml-outline-display-rest outline-state
602 (overlay-put start-tag-overlay
606 (make-string indent ?\
)
608 nxml-highlighted-less-than
610 (cond ((not had-children
)
611 nxml-highlighted-inactive-minus
)
612 ((eq outline-state
'hide-children
)
613 (overlay-put start-tag-overlay
615 'nxml-outline-display-hiding-tag
)
616 nxml-highlighted-active-plus
)
618 (overlay-put start-tag-overlay
620 'nxml-outline-display-showing-tag
)
621 nxml-highlighted-active-minus
))
623 (nxml-highlighted-qname (car tag-qnames
))
625 nxml-highlighted-greater-than
))))
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
)
633 (nxml-outline-display-rest outline-state
636 nxml-outline-child-indent
))
639 (defun nxml-highlighted-qname (qname)
640 (let ((colon (string-match ":" qname
)))
642 (concat (propertize (substring qname
0 colon
)
644 'nxml-element-prefix
)
645 nxml-highlighted-colon
646 (propertize (substring qname
(1+ colon
))
648 'nxml-element-local-name
))
651 'nxml-element-local-name
))))
653 (defun nxml-outline-display-single-line-end-tag (last-pos)
654 (nxml-outline-set-overlay 'nxml-outline-display-hide
659 (overlay-put (nxml-outline-set-overlay 'nxml-outline-display-show
664 nxml-highlighted-empty-end-tag
))
666 (defun nxml-outline-display-multi-line-end-tag (last-pos start-tag-indent
)
667 (let ((indentp (save-excursion
669 (skip-chars-forward " \t")
670 (and (eq (char-after) ?
\n)
672 (goto-char (1+ (point)))
673 (nxml-outline-set-overlay nil last-pos
(point))
674 (setq last-pos
(point))
675 (goto-char xmltok-start
)
679 (nxml-outline-set-overlay 'nxml-outline-display-hide
684 (setq end-tag-overlay
685 (nxml-outline-set-overlay 'nxml-outline-display-showing-tag
689 (overlay-put end-tag-overlay
692 (make-string start-tag-indent ?\
)
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
))))
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
)
706 (defvar nxml-outline-show-help
"mouse-2: show")
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
)
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
)
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
)
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
)
729 (put 'nxml-outline-display-heading
'face
'nxml-heading
)
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
)
738 (defvar nxml-outline-hiding-tag-help
739 "mouse-1: show subheadings, mouse-2: show text content")
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
)
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
)
753 (defvar nxml-outline-showing-tag-help
754 "mouse-1: hide subheadings, mouse-2: show text content")
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
761 nxml-outline-showing-tag-help
)
763 (defun nxml-outline-set-overlay (category
769 "Replace any `nxml-outline-display' overlays between START and END.
770 Overlays are removed if they overlay the region between START and END,
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."
776 (let ((overlays (overlays-in start end
))
779 (setq overlay
(car overlays
))
780 (setq overlays
(cdr overlays
))
781 (when (overlay-get overlay
'nxml-outline-display
)
782 (delete-overlay overlay
))))
784 (let ((overlay (make-overlay start
789 (overlay-put overlay
'category category
)
790 (setq line-move-ignore-invisible t
)
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
)
799 (nxml-scan-error nil
))))
801 (skip-chars-backward " \t")
803 (setq pos
(nxml-token-before))
804 (when (eq xmltok-type
'end-tag
)
808 (skip-chars-backward " \t")
811 ;;; Navigating section structure
813 (defun nxml-token-starts-line-p ()
815 (goto-char xmltok-start
)
816 (skip-chars-backward " \t")
819 (defvar nxml-cached-section-tag-regexp nil
)
820 (defvar nxml-cached-section-element-name-regexp nil
)
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)))
828 (defun nxml-make-section-tag-regexp-1 ()
829 (setq nxml-cached-section-element-name-regexp nil
)
830 (setq nxml-cached-section-tag-regexp
832 "\\(" xmltok-ncname-regexp
":\\)?"
833 nxml-section-element-name-regexp
835 (setq nxml-cached-section-element-name-regexp
836 nxml-section-element-name-regexp
)
837 nxml-cached-section-tag-regexp
)
839 (defun nxml-section-tag-forward ()
840 "Move forward past the first tag that is a section start- or end-tag.
841 Return `xmltok-type' for tag.
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))
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
)
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))))
861 (and (memq xmltok-type
'(start-tag
865 ;; just in case wildcard matched non-name chars
866 (= xmltok-name-end
(1- match-end
))))
871 (defun nxml-section-tag-backward ()
872 "Move backward to the end of a tag that is a section start- or end-tag.
873 The position of the end of the tag must be <= point.
874 Point is at the end of the tag. `xmltok-start' is the start."
875 (let ((case-fold-search nil
)
877 (tag-regexp (nxml-make-section-tag-regexp))
879 (if (< (point) nxml-prolog-end
)
881 (goto-char (point-min))
883 (while (cond ((not (re-search-backward tag-regexp
886 (setq xmltok-type nil
)
887 (goto-char (point-min))
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))))
899 (and (<= (point) start
)
900 (memq xmltok-type
'(start-tag
904 ;; just in case wildcard matched non-name chars
905 (= xmltok-name-end
(1- match-end
))))
907 (t (goto-char xmltok-start
)
911 (defun nxml-section-start-position ()
912 "Return the position of the start of the section containing point.
913 Signal an error on failure."
915 (save-excursion (if (nxml-back-to-section-start)
917 (error "Not in section")))
919 (nxml-report-outline-error "Couldn't determine containing section: %s"
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.
926 If found, return t. Otherwise move to `point-min' and return nil.
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)
937 (when (and (nxml-token-starts-line-p)
939 (not (get-char-property section-start-pos
941 (nxml-heading-start-position))
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
)
949 (nxml-section-tag-backward))))
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
))
960 (goto-char xmltok-start
)
961 (looking-at (nxml-make-section-tag-regexp))))
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."
971 (heading-regexp (concat "\\`\\("
972 nxml-heading-element-name-regexp
975 (section-regexp (concat "\\`\\("
976 nxml-section-element-name-regexp
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)))
986 (setq depth
(1- depth
))))
987 ;; XXX Not sure whether this is a good idea
988 ;;((eq xmltok-type 'empty-element)
990 ((not (memq xmltok-type
991 '(start-tag partial-start-tag
)))
993 ((string-match section-regexp
994 (xmltok-start-tag-local-name))
996 ((string-match heading-regexp
997 (xmltok-start-tag-local-name))
998 (skip-chars-forward " \t\r\n")
1002 (setq depth
(1+ depth
))
1004 (<= (- (point) start
) nxml-heading-scan-distance
))))
1009 (defun nxml-report-outline-error (msg err
)
1010 (error msg
(apply 'format
(cdr err
))))
1012 (defun nxml-outline-error (&rest args
)
1013 (signal 'nxml-outline-error args
))
1015 (put 'nxml-outline-error
1017 '(error nxml-error nxml-outline-error
))
1019 (put 'nxml-outline-error
1021 "Cannot create outline of buffer that is not well-formed")
1025 (defun nxml-debug-overlays ()
1027 (let ((overlays (nreverse (overlays-in (point-min) (point-max))))
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
))))))
1039 (provide 'nxml-outln
)
1041 ;;; nxml-outln.el ends here