diff lisp/nxml/nxml-outln.el @ 86361:38f93f3d00a2

Initial merge of nxml

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/nxml/nxml-outln.el	Fri Nov 23 06:58:00 2007 +0000
@@ -0,0 +1,1040 @@
+;;; nxml-outln.el --- outline support for nXML mode
+
+;; Copyright (C) 2004 Free Software Foundation, Inc.
+
+;; Author: James Clark
+;; Keywords: XML
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be
+;; useful, but WITHOUT ANY WARRANTY; without even the implied
+;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+;; PURPOSE.  See the GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public
+;; License along with this program; if not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
+;; MA 02111-1307 USA
+
+;;; Commentary:
+
+;; A section can be in one of three states
+;; 1. display normally; this displays each child section
+;; according to its state; anything not part of child sections is also
+;; displayed normally
+;; 2. display just the title specially; child sections are not displayed
+;; regardless of their state; anything not part of child sections is
+;; not displayed
+;; 3. display the title specially and display child sections
+;; according to their state; anything not part of the child section is
+;; not displayed
+;; The state of a section is determined by the value of the
+;; nxml-outline-state text property of the < character that starts
+;; the section.
+;; For state 1 the value is nil or absent.
+;; For state 2 it is the symbol hide-children.
+;; For state 3 it is t.
+;; The special display is achieved by using overlays.  The overlays
+;; are computed from the nxml-outline-state property by
+;; `nxml-refresh-outline'. There overlays all have a category property
+;; with an nxml-outline-display property with value t.
+;;
+;; For a section to be recognized as such, the following conditions must
+;; be satisfied:
+;; - its start-tag must occur at the start of a line (possibly indented)
+;; - its local name must match `nxml-section-element-name-regexp'
+;; - it must have a heading element; a heading element is an
+;; element whose name matches `nxml-heading-element-name-regexp',
+;; and that occurs as, or as a descendant of, the first child element
+;; of the section
+;;
+;; XXX What happens if an nxml-outline-state property is attached to a
+;; character that doesn't start a section element?
+;;
+;; An outlined section (an section with a non-nil nxml-outline-state
+;; property) can be displayed in either single-line or multi-line
+;; form.  Single-line form is used when the outline state is hide-children
+;; or there are no child sections; multi-line form is used otherwise.
+;; There are two flavors of single-line form: with children and without.
+;; The with-childen flavor is used when there are child sections.
+;; Single line with children looks like
+;;    <+section>A section title...</>
+;; Single line without children looks like
+;;    <-section>A section title...</>
+;; Multi line looks likes
+;;    <-section>A section title...
+;;    [child sections displayed here]
+;;    </-section>
+;; The indent of an outlined section is computed relative to the
+;; outermost containing outlined element.  The indent of the
+;; outermost containing element comes from the non-outlined
+;; indent of the section start-tag.
+
+;;; Code:
+
+(require 'xmltok)
+(require 'nxml-util)
+(require 'nxml-rap)
+
+(defcustom nxml-section-element-name-regexp
+  "article\\|\\(sub\\)*section\\|chapter\\|div\\|appendix\\|part\\|preface\\|reference\\|simplesect\\|bibliography\\|bibliodiv\\|glossary\\|glossdiv"
+  "*Regular expression matching the name of elements used as sections.
+An XML element is treated as a section if:
+
+- its local name (that is, the name without the prefix) matches
+this regexp;
+
+- either its first child element or a descendant of that first child
+element has a local name matching the variable
+`nxml-heading-element-name-regexp'; and
+
+- its start-tag occurs at the beginning of a line (possibly indented)."
+  :group 'nxml
+  :type 'regexp)
+
+(defcustom nxml-heading-element-name-regexp "title\\|head"
+  "*Regular expression matching the name of elements used as headings.
+An XML element is only recognized as a heading if it occurs as or
+within the first child of an element that is recognized as a section.
+See the variable `nxml-section-element-name-regexp' for more details."
+  :group 'nxml
+  :type 'regexp)
+
+(defcustom nxml-outline-child-indent 2
+  "*Indentation in an outline for child element relative to parent element."
+  :group 'nxml
+  :type 'integer)
+
+(defface nxml-heading-face
+  '((t (:weight bold)))
+  "Face used for the contents of abbreviated heading elements."
+  :group 'nxml-highlighting-faces)
+
+(defface nxml-outline-indicator-face
+  '((t (:inherit default)))
+  "Face used for `+' or `-' before element names in outlines."
+  :group 'nxml-highlighting-faces)
+
+(defface nxml-outline-active-indicator-face
+  '((t (:box t :inherit nxml-outline-indicator-face)))
+  "Face used for clickable `+' or `-' before element names in outlines."
+  :group 'nxml-highlighting-faces)
+
+(defface nxml-outline-ellipsis-face
+  '((t (:bold t :inherit default)))
+  "Face used for `...' in outlines."
+  :group 'nxml-highlighting-faces)
+
+(defvar nxml-heading-scan-distance 1000
+  "Maximum distance from section to scan for heading.")
+
+(defvar nxml-outline-prefix-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map "\C-a" 'nxml-show-all)
+    (define-key map "\C-t" 'nxml-hide-all-text-content)
+    (define-key map "\C-r" 'nxml-refresh-outline)
+    (define-key map "\C-c" 'nxml-hide-direct-text-content)
+    (define-key map "\C-e" 'nxml-show-direct-text-content)
+    (define-key map "\C-d" 'nxml-hide-subheadings)
+    (define-key map "\C-s" 'nxml-show)
+    (define-key map "\C-k" 'nxml-show-subheadings)
+    (define-key map "\C-l" 'nxml-hide-text-content)
+    (define-key map "\C-i" 'nxml-show-direct-subheadings)
+    (define-key map "\C-o" 'nxml-hide-other)
+    map))
+
+;;; Commands for changing visibility
+
+(defun nxml-show-all ()
+  "Show all elements in the buffer normally."
+  (interactive)
+  (nxml-with-unmodifying-text-property-changes
+    (remove-text-properties (point-min)
+			    (point-max)
+			    '(nxml-outline-state nil)))
+  (nxml-outline-set-overlay nil (point-min) (point-max)))
+
+(defun nxml-hide-all-text-content ()
+  "Hide all text content in the buffer.
+Anything that is in a section but is not a heading will be hidden.
+The visibility of headings at any level will not be changed. See the
+variable `nxml-section-element-name-regexp' for more details on how to
+customize which elements are recognized as sections and headings."
+  (interactive)
+  (nxml-transform-buffer-outline '((nil . t))))
+
+(defun nxml-show-direct-text-content ()
+  "Show the text content that is directly part of the section containing point.
+Each subsection will be shown according to its individual state, which
+will not be changed. The section containing point is the innermost
+section that contains the character following point. See the variable
+`nxml-section-element-name-regexp' for more details on how to
+customize which elements are recognized as sections and headings."
+  (interactive)
+  (nxml-outline-pre-adjust-point)
+  (nxml-set-outline-state (nxml-section-start-position) nil)
+  (nxml-refresh-outline)
+  (nxml-outline-adjust-point))
+
+(defun nxml-show-direct-subheadings ()
+  "Show the immediate subheadings of the section containing point.
+The section containing point is the innermost section that contains
+the character following point. See the variable
+`nxml-section-element-name-regexp' for more details on how to
+customize which elements are recognized as sections and headings."
+  (interactive)
+  (let ((pos (nxml-section-start-position)))
+    (when (eq (nxml-get-outline-state pos) 'hide-children)
+      (nxml-set-outline-state pos t)))
+  (nxml-refresh-outline)
+  (nxml-outline-adjust-point))
+
+(defun nxml-hide-direct-text-content ()
+  "Hide the text content that is directly part of the section containing point.
+The heading of the section will remain visible.  The state of
+subsections will not be changed.  The section containing point is the
+innermost section that contains the character following point. See the
+variable `nxml-section-element-name-regexp' for more details on how to
+customize which elements are recognized as sections and headings."
+  (interactive)
+  (let ((pos (nxml-section-start-position)))
+    (when (null (nxml-get-outline-state pos))
+      (nxml-set-outline-state pos t)))
+  (nxml-refresh-outline)
+  (nxml-outline-adjust-point))
+
+(defun nxml-hide-subheadings ()
+  "Hide the subheadings that are part of the section containing point.
+The text content will also be hidden, leaving only the heading of the
+section itself visible.  The state of the subsections will also be
+changed to hide their headings, so that \\[nxml-show-direct-text-content]
+would show only the heading of the subsections. The section containing
+point is the innermost section that contains the character following
+point.  See the variable `nxml-section-element-name-regexp' for more
+details on how to customize which elements are recognized as sections
+and headings."
+  (interactive)
+  (nxml-transform-subtree-outline '((nil . hide-children)
+				    (t . hide-children))))
+
+(defun nxml-show ()
+  "Show the section containing point normally, without hiding anything.
+This includes everything in the section at any level.  The section
+containing point is the innermost section that contains the character
+following point.  See the variable `nxml-section-element-name-regexp'
+for more details on how to customize which elements are recognized as
+sections and headings."
+  (interactive)
+  (nxml-transform-subtree-outline '((hide-children . nil)
+				    (t . nil))))
+
+(defun nxml-hide-text-content ()
+  "Hide text content at all levels in the section containing point.
+The section containing point is the innermost section that contains
+the character following point. See the variable
+`nxml-section-element-name-regexp' for more details on how to
+customize which elements are recognized as sections and headings."
+  (interactive)
+  (nxml-transform-subtree-outline '((nil . t))))
+
+(defun nxml-show-subheadings ()
+  "Show the subheadings at all levels of the section containing point.
+The visibility of the text content at all levels in the section is not
+changed.  The section containing point is the innermost section that
+contains the character following point. See the variable
+`nxml-section-element-name-regexp' for more details on how to
+customize which elements are recognized as sections and headings."
+  (interactive)
+  (nxml-transform-subtree-outline '((hide-children . t))))
+
+(defun nxml-hide-other ()
+  "Hide text content other than that directly in the section containing point.
+Hide headings other than those of ancestors of that section and their
+immediate subheadings.  The section containing point is the innermost
+section that contains the character following point. See the variable
+`nxml-section-element-name-regexp' for more details on how to
+customize which elements are recognized as sections and headings."
+  (interactive)
+  (let ((nxml-outline-state-transform-exceptions nil))
+    (save-excursion
+      (while (and (condition-case err
+		      (nxml-back-to-section-start)
+		    (nxml-outline-error (nxml-report-outline-error
+					 "Couldn't find containing section: %s"
+					 err)))
+		  (progn
+		    (when (and nxml-outline-state-transform-exceptions
+			       (null (nxml-get-outline-state (point))))
+		      (nxml-set-outline-state (point) t))
+		    (setq nxml-outline-state-transform-exceptions
+			  (cons (point)
+				nxml-outline-state-transform-exceptions))
+		    (< nxml-prolog-end (point))))
+	(goto-char (1- (point)))))
+    (nxml-transform-buffer-outline '((nil . hide-children)
+				     (t . hide-children)))))
+
+;; These variables are dynamically bound.  They are use to pass information to
+;; nxml-section-tag-transform-outline-state.
+
+(defvar nxml-outline-state-transform-exceptions nil)
+(defvar nxml-target-section-pos nil)
+(defvar nxml-depth-in-target-section nil)
+(defvar nxml-outline-state-transform-alist nil)
+
+(defun nxml-transform-buffer-outline (alist)
+  (let ((nxml-target-section-pos nil)
+	(nxml-depth-in-target-section 0)
+	(nxml-outline-state-transform-alist alist)
+	(nxml-outline-display-section-tag-function
+	 'nxml-section-tag-transform-outline-state))
+    (nxml-refresh-outline))
+  (nxml-outline-adjust-point))
+
+(defun nxml-transform-subtree-outline (alist)
+  (let ((nxml-target-section-pos (nxml-section-start-position))
+	(nxml-depth-in-target-section nil)
+	(nxml-outline-state-transform-alist alist)
+	(nxml-outline-display-section-tag-function
+	 'nxml-section-tag-transform-outline-state))
+    (nxml-refresh-outline))
+  (nxml-outline-adjust-point))
+
+(defun nxml-outline-pre-adjust-point ()
+  (cond ((and (< (point-min) (point))
+	      (get-char-property (1- (point)) 'invisible)
+	      (not (get-char-property (point) 'invisible))
+	      (let ((str (or (get-char-property (point) 'before-string)
+			     (get-char-property (point) 'display))))
+		(and (stringp str)
+		     (>= (length str) 3)
+		     (string= (substring str 0 3) "..."))))
+	 ;; The ellipsis is a display property on a visible character
+	 ;; following an invisible region. The position of the event
+	 ;; will be the position before that character. We want to
+	 ;; move point to the other side of the invisible region, i.e.
+	 ;; following the last visible character before that invisible
+	 ;; region.
+	 (goto-char (previous-single-char-property-change (1- (point))
+							  'invisible)))
+	((and (< (point) (point-max))
+	      (get-char-property (point) 'display)
+	      (get-char-property (1+ (point)) 'invisible))
+	 (goto-char (next-single-char-property-change (1+ (point))
+						      'invisible)))
+	((and (< (point) (point-max))
+	      (get-char-property (point) 'invisible))
+	 (goto-char (next-single-char-property-change (point)
+						      'invisible)))))
+
+(defun nxml-outline-adjust-point ()
+  "Adjust point after showing or hiding elements."
+  (when (and (get-char-property (point) 'invisible)
+	     (< (point-min) (point))
+	     (get-char-property (1- (point)) 'invisible))
+    (goto-char (previous-single-char-property-change (point)
+						     'invisible
+						     nil
+						     nxml-prolog-end))))
+
+(defun nxml-transform-outline-state (section-start-pos)
+  (let* ((old-state
+	  (nxml-get-outline-state section-start-pos))
+	 (change (assq old-state
+		       nxml-outline-state-transform-alist)))
+    (when change
+      (nxml-set-outline-state section-start-pos
+			      (cdr change)))))
+  
+(defun nxml-section-tag-transform-outline-state (startp
+						 section-start-pos
+						 &optional
+						 heading-start-pos)
+  (if (not startp)
+      (setq nxml-depth-in-target-section
+	    (and nxml-depth-in-target-section
+		 (> nxml-depth-in-target-section 0)
+		 (1- nxml-depth-in-target-section)))
+    (cond (nxml-depth-in-target-section
+	   (setq nxml-depth-in-target-section
+		 (1+ nxml-depth-in-target-section)))
+	  ((= section-start-pos nxml-target-section-pos)
+	   (setq nxml-depth-in-target-section 0)))
+    (when (and nxml-depth-in-target-section
+	       (not (member section-start-pos
+			    nxml-outline-state-transform-exceptions)))
+      (nxml-transform-outline-state section-start-pos))))
+
+(defun nxml-get-outline-state (pos)
+  (get-text-property pos 'nxml-outline-state))
+
+(defun nxml-set-outline-state (pos state)
+  (nxml-with-unmodifying-text-property-changes
+    (if state
+	(put-text-property pos (1+ pos) 'nxml-outline-state state)
+      (remove-text-properties pos (1+ pos) '(nxml-outline-state nil)))))
+
+;;; Mouse interface
+
+(defun nxml-mouse-show-direct-text-content (event)
+  "Do the same as \\[nxml-show-direct-text-content] from a mouse click."
+  (interactive "e")
+  (and (nxml-mouse-set-point event)
+       (nxml-show-direct-text-content)))
+
+(defun nxml-mouse-hide-direct-text-content (event)
+  "Do the same as \\[nxml-hide-direct-text-content] from a mouse click."
+  (interactive "e")
+  (and (nxml-mouse-set-point event)
+       (nxml-hide-direct-text-content)))
+
+(defun nxml-mouse-hide-subheadings (event)
+  "Do the same as \\[nxml-hide-subheadings] from a mouse click."
+  (interactive "e")
+  (and (nxml-mouse-set-point event)
+       (nxml-hide-subheadings)))
+
+(defun nxml-mouse-show-direct-subheadings (event)
+  "Do the same as \\[nxml-show-direct-subheadings] from a mouse click."
+  (interactive "e")
+  (and (nxml-mouse-set-point event)
+       (nxml-show-direct-subheadings)))
+
+(defun nxml-mouse-set-point (event)
+  (mouse-set-point event)
+  (and nxml-prolog-end t))
+
+;; Display
+
+(defun nxml-refresh-outline () 
+  "Refresh the outline to correspond to the current XML element structure."
+  (interactive)
+  (save-excursion
+    (goto-char (point-min))
+    (kill-local-variable 'line-move-ignore-invisible)
+    (make-local-variable 'line-move-ignore-invisible)
+    (condition-case err
+	(nxml-outline-display-rest nil nil nil)
+      (nxml-outline-error
+       (nxml-report-outline-error "Cannot display outline: %s" err)))))
+
+(defvar nxml-outline-display-section-tag-function nil)
+
+(defun nxml-outline-display-rest (outline-state start-tag-indent tag-qnames)
+  "Display up to and including the end of the current element.
+OUTLINE-STATE can be nil, t, hide-children.  START-TAG-INDENT is the
+indent of the start-tag of the current element, or nil if no
+containing element has a non-nil OUTLINE-STATE.  TAG-QNAMES is a list
+of the qnames of the open elements.  Point is after the title content.
+Leave point after the closing end-tag Return t if we had a
+non-transparent child section."
+  (let ((last-pos (point))
+	(transparent-depth 0)
+	;; don't want ellipsis before root element
+	(had-children (not tag-qnames)))
+    (while
+	(cond ((not (nxml-section-tag-forward))
+	       (if (null tag-qnames)
+		   nil
+		 (nxml-outline-error "missing end-tag %s"
+				     (car tag-qnames))))
+	      ;; section end-tag
+	      ((nxml-token-end-tag-p)
+	       (when nxml-outline-display-section-tag-function
+		 (funcall nxml-outline-display-section-tag-function
+			  nil
+			  xmltok-start))
+	       (let ((qname (xmltok-end-tag-qname)))
+		 (unless tag-qnames
+		   (nxml-outline-error "extra end-tag %s" qname))
+		 (unless (string= (car tag-qnames) qname)
+		   (nxml-outline-error "mismatched end-tag; expected %s, got %s"
+				       (car tag-qnames)
+				       qname)))
+	       (cond ((> transparent-depth 0)
+		      (setq transparent-depth (1- transparent-depth))
+		      (setq tag-qnames (cdr tag-qnames))
+		      t)
+		     ((not outline-state)
+		      (nxml-outline-set-overlay nil last-pos (point))
+		      nil)
+		     ((or (not had-children)
+			  (eq outline-state 'hide-children))
+		      (nxml-outline-display-single-line-end-tag last-pos)
+		      nil)
+		     (t
+		      (nxml-outline-display-multi-line-end-tag last-pos
+							       start-tag-indent)
+		      nil)))
+	      ;; section start-tag
+	      (t
+	       (let* ((qname (xmltok-start-tag-qname))
+		      (section-start-pos xmltok-start)
+		      (heading-start-pos
+		       (and (or nxml-outline-display-section-tag-function
+				(not (eq outline-state 'had-children))
+				(not had-children))
+			    (nxml-token-starts-line-p)
+			    (nxml-heading-start-position))))
+		 (when nxml-outline-display-section-tag-function
+		   (funcall nxml-outline-display-section-tag-function
+			    t
+			    section-start-pos
+			    heading-start-pos))
+		 (setq tag-qnames (cons qname tag-qnames))
+		 (if (or (not heading-start-pos)
+			 (and (eq outline-state 'hide-children)
+			      (setq had-children t)))
+		     (setq transparent-depth (1+ transparent-depth))
+		   (nxml-display-section last-pos
+					 section-start-pos
+					 heading-start-pos
+					 start-tag-indent
+					 outline-state
+					 had-children
+					 tag-qnames)
+		   (setq had-children t)
+		   (setq tag-qnames (cdr tag-qnames))
+		   (setq last-pos (point))))
+	       t)))
+    had-children))
+
+(defconst nxml-highlighted-less-than
+  (propertize "<" 'face 'nxml-tag-delimiter-face))
+
+(defconst nxml-highlighted-greater-than
+  (propertize ">" 'face 'nxml-tag-delimiter-face))
+
+(defconst nxml-highlighted-colon
+  (propertize ":" 'face 'nxml-element-colon-face))
+
+(defconst nxml-highlighted-slash
+  (propertize "/" 'face 'nxml-tag-slash-face))
+
+(defconst nxml-highlighted-ellipsis
+  (propertize "..." 'face 'nxml-outline-ellipsis-face))
+
+(defconst nxml-highlighted-empty-end-tag
+  (concat nxml-highlighted-ellipsis
+	  nxml-highlighted-less-than
+	  nxml-highlighted-slash
+	  nxml-highlighted-greater-than))
+
+(defconst nxml-highlighted-inactive-minus
+  (propertize "-" 'face 'nxml-outline-indicator-face))
+
+(defconst nxml-highlighted-active-minus
+  (propertize "-" 'face 'nxml-outline-active-indicator-face))
+
+(defconst nxml-highlighted-active-plus
+  (propertize "+" 'face 'nxml-outline-active-indicator-face))
+
+(defun nxml-display-section (last-pos
+			     section-start-pos
+			     heading-start-pos
+			     parent-indent
+			     parent-outline-state
+			     had-children
+			     tag-qnames)
+  (let* ((section-start-pos-bol
+	  (save-excursion
+	    (goto-char section-start-pos)
+	    (skip-chars-backward " \t")
+	    (point)))
+	 (outline-state (nxml-get-outline-state section-start-pos))
+	 (newline-before-section-start-category
+	  (cond ((and (not had-children) parent-outline-state)
+		 'nxml-outline-display-ellipsis)
+		 (outline-state 'nxml-outline-display-show)
+		 (t nil))))
+    (nxml-outline-set-overlay (and parent-outline-state
+				   'nxml-outline-display-hide)
+			      last-pos
+			      (1- section-start-pos-bol)
+			      nil
+			      t)
+    (if outline-state
+      (let* ((indent (if parent-indent
+			 (+ parent-indent nxml-outline-child-indent)
+		       (save-excursion
+			 (goto-char section-start-pos)
+			 (current-column))))
+	     start-tag-overlay)
+	(nxml-outline-set-overlay newline-before-section-start-category
+				  (1- section-start-pos-bol)
+				  section-start-pos-bol
+				  t)
+	(nxml-outline-set-overlay 'nxml-outline-display-hide
+				  section-start-pos-bol
+				  section-start-pos)
+	(setq start-tag-overlay
+	    (nxml-outline-set-overlay 'nxml-outline-display-show
+				      section-start-pos
+				      (1+ section-start-pos)
+				      t))
+	;; line motion commands don't work right if start-tag-overlay
+	;; covers multiple lines
+	(nxml-outline-set-overlay 'nxml-outline-display-hide
+				  (1+ section-start-pos)
+				  heading-start-pos)
+	(goto-char heading-start-pos)
+	(nxml-end-of-heading)
+	(nxml-outline-set-overlay 'nxml-outline-display-heading
+				  heading-start-pos
+				  (point))
+	(let* ((had-children
+		(nxml-outline-display-rest outline-state
+					   indent
+					   tag-qnames)))
+	  (overlay-put start-tag-overlay
+		       'display
+		       (concat
+			;; indent
+			(make-string indent ?\ )
+			;; <
+			nxml-highlighted-less-than
+			;; + or - indicator
+			(cond ((not had-children)
+			       nxml-highlighted-inactive-minus)
+			      ((eq outline-state 'hide-children)
+			       (overlay-put start-tag-overlay
+					    'category
+					    'nxml-outline-display-hiding-tag)
+			       nxml-highlighted-active-plus)
+			      (t
+			       (overlay-put start-tag-overlay
+					    'category
+					    'nxml-outline-display-showing-tag)
+			       nxml-highlighted-active-minus))
+			;; qname
+			(nxml-highlighted-qname (car tag-qnames))
+			;; >
+			nxml-highlighted-greater-than))))
+      ;; outline-state nil
+      (goto-char heading-start-pos)
+      (nxml-end-of-heading)
+      (nxml-outline-set-overlay newline-before-section-start-category
+				(1- section-start-pos-bol)
+				(point)
+				t)
+      (nxml-outline-display-rest outline-state
+				 (and parent-indent
+				      (+ parent-indent
+					 nxml-outline-child-indent))
+				 tag-qnames))))
+
+(defun nxml-highlighted-qname (qname)
+  (let ((colon (string-match ":" qname)))
+    (if colon
+	(concat (propertize (substring qname 0 colon)
+			    'face
+			    'nxml-element-prefix-face)
+		nxml-highlighted-colon
+		(propertize (substring qname (1+ colon))
+			    'face
+			    'nxml-element-local-name-face))
+      (propertize qname
+		  'face
+		  'nxml-element-local-name-face))))
+
+(defun nxml-outline-display-single-line-end-tag (last-pos)
+  (nxml-outline-set-overlay 'nxml-outline-display-hide
+			    last-pos
+			    xmltok-start
+			    nil
+			    t)
+  (overlay-put (nxml-outline-set-overlay 'nxml-outline-display-show
+					 xmltok-start
+					 (point)
+					 t)
+	       'display
+	       nxml-highlighted-empty-end-tag))
+    
+(defun nxml-outline-display-multi-line-end-tag (last-pos start-tag-indent)
+  (let ((indentp (save-excursion
+		   (goto-char last-pos)
+		   (skip-chars-forward " \t")
+		   (and (eq (char-after) ?\n)
+			(progn
+			  (goto-char (1+ (point)))
+			  (nxml-outline-set-overlay nil last-pos (point))
+			  (setq last-pos (point))
+			  (goto-char xmltok-start)
+			  (beginning-of-line)
+			  t))))
+	end-tag-overlay)
+    (nxml-outline-set-overlay 'nxml-outline-display-hide
+			      last-pos
+			      xmltok-start
+			      nil
+			      t)
+    (setq end-tag-overlay
+	  (nxml-outline-set-overlay 'nxml-outline-display-showing-tag
+				    xmltok-start
+				    (point)
+				    t))
+    (overlay-put end-tag-overlay
+		 'display
+		 (concat (if indentp
+			     (make-string start-tag-indent ?\ )
+			   "")
+			 nxml-highlighted-less-than
+			 nxml-highlighted-slash
+			 nxml-highlighted-active-minus
+			 (nxml-highlighted-qname (xmltok-end-tag-qname))
+			 nxml-highlighted-greater-than))))
+
+(defvar nxml-outline-show-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map "\C-m" 'nxml-show-direct-text-content)
+    (define-key map [mouse-2] 'nxml-mouse-show-direct-text-content)
+    map))
+
+(defvar nxml-outline-show-help "mouse-2: show")
+
+(put 'nxml-outline-display-show 'nxml-outline-display t)
+(put 'nxml-outline-display-show 'evaporate t)
+(put 'nxml-outline-display-show 'keymap nxml-outline-show-map)
+(put 'nxml-outline-display-show 'help-echo nxml-outline-show-help)
+
+(put 'nxml-outline-display-hide 'nxml-outline-display t)
+(put 'nxml-outline-display-hide 'evaporate t)
+(put 'nxml-outline-display-hide 'invisible t)
+(put 'nxml-outline-display-hide 'keymap nxml-outline-show-map)
+(put 'nxml-outline-display-hide 'help-echo nxml-outline-show-help)
+
+(put 'nxml-outline-display-ellipsis 'nxml-outline-display t)
+(put 'nxml-outline-display-ellipsis 'evaporate t)
+(put 'nxml-outline-display-ellipsis 'keymap nxml-outline-show-map)
+(put 'nxml-outline-display-ellipsis 'help-echo nxml-outline-show-help)
+(put 'nxml-outline-display-ellipsis 'before-string nxml-highlighted-ellipsis)
+
+(put 'nxml-outline-display-heading 'keymap nxml-outline-show-map)
+(put 'nxml-outline-display-heading 'help-echo nxml-outline-show-help)
+(put 'nxml-outline-display-heading 'nxml-outline-display t)
+(put 'nxml-outline-display-heading 'evaporate t)
+(put 'nxml-outline-display-heading 'face 'nxml-heading-face)
+
+(defvar nxml-outline-hiding-tag-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map [mouse-1] 'nxml-mouse-show-direct-subheadings)
+    (define-key map [mouse-2] 'nxml-mouse-show-direct-text-content)
+    (define-key map "\C-m" 'nxml-show-direct-text-content)
+    map))
+
+(defvar nxml-outline-hiding-tag-help
+  "mouse-1: show subheadings, mouse-2: show text content")
+
+(put 'nxml-outline-display-hiding-tag 'nxml-outline-display t)
+(put 'nxml-outline-display-hiding-tag 'evaporate t)
+(put 'nxml-outline-display-hiding-tag 'keymap nxml-outline-hiding-tag-map)
+(put 'nxml-outline-display-hiding-tag 'help-echo nxml-outline-hiding-tag-help)
+
+(defvar nxml-outline-showing-tag-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map [mouse-1] 'nxml-mouse-hide-subheadings)
+    (define-key map [mouse-2] 'nxml-mouse-show-direct-text-content)
+    (define-key map "\C-m" 'nxml-show-direct-text-content)
+    map))
+
+(defvar nxml-outline-showing-tag-help
+  "mouse-1: hide subheadings, mouse-2: show text content")
+
+(put 'nxml-outline-display-showing-tag 'nxml-outline-display t)
+(put 'nxml-outline-display-showing-tag 'evaporate t)
+(put 'nxml-outline-display-showing-tag 'keymap nxml-outline-showing-tag-map)
+(put 'nxml-outline-display-showing-tag
+     'help-echo
+     nxml-outline-showing-tag-help)
+
+(defun nxml-outline-set-overlay (category
+				 start
+				 end
+				 &optional
+				 front-advance
+				 rear-advance)
+  "Replace any nxml-outline-display overlays between START and END.
+Overlays are removed if they overlay the region between START and END,
+and have a non-nil nxml-outline-display property (typically via their
+category). If CATEGORY is non-nil, they will be replaced with a new overlay
+with that category from START to END. If CATEGORY is nil, no new
+overlay will be created."
+  (when (< start end)
+    (let ((overlays (overlays-in start end))
+	  overlay)
+      (while overlays
+	(setq overlay (car overlays))
+	(setq overlays (cdr overlays))
+	(when (overlay-get overlay 'nxml-outline-display)
+	  (delete-overlay overlay))))
+    (and category
+	 (let ((overlay (make-overlay start
+				      end
+				      nil
+				      front-advance
+				      rear-advance)))
+	   (overlay-put overlay 'category category)
+	   (setq line-move-ignore-invisible t)
+	   overlay))))
+
+(defun nxml-end-of-heading ()
+  "Move from the start of the content of the heading to the end.
+Do not move past the end of the line."
+  (let ((pos (condition-case err
+		 (and (nxml-scan-element-forward (point) t)
+		      xmltok-start)
+	       nil)))
+    (end-of-line)
+    (skip-chars-backward " \t")
+    (cond ((not pos)
+	   (setq pos (nxml-token-before))
+	   (when (eq xmltok-type 'end-tag)
+	     (goto-char pos)))
+	  ((< pos (point))
+	   (goto-char pos)))
+    (skip-chars-backward " \t")
+    (point)))
+
+;;; Navigating section structure
+
+(defsubst nxml-token-start-tag-p ()
+  (or (eq xmltok-type 'start-tag)
+      (eq xmltok-type 'partial-start-tag)))
+
+(defsubst nxml-token-end-tag-p ()
+  (or (eq xmltok-type 'end-tag)
+      (eq xmltok-type 'partial-end-tag)))
+
+(defun nxml-token-starts-line-p ()
+  (save-excursion
+    (goto-char xmltok-start)
+    (skip-chars-backward " \t")
+    (bolp)))
+
+(defvar nxml-cached-section-tag-regexp nil)
+(defvar nxml-cached-section-element-name-regexp nil)
+
+(defsubst nxml-make-section-tag-regexp ()
+  (if (eq nxml-cached-section-element-name-regexp
+	  nxml-section-element-name-regexp)
+      nxml-cached-section-tag-regexp
+    (nxml-make-section-tag-regexp-1)))
+
+(defun nxml-make-section-tag-regexp-1 ()
+  (setq nxml-cached-section-element-name-regexp nil)
+  (setq nxml-cached-section-tag-regexp
+	(concat "</?\\("
+		"\\(" xmltok-ncname-regexp ":\\)?"
+		nxml-section-element-name-regexp
+		"\\)[ \t\r\n>]"))
+  (setq nxml-cached-section-element-name-regexp
+	nxml-section-element-name-regexp)
+  nxml-cached-section-tag-regexp)
+
+(defun nxml-section-tag-forward ()
+  "Move forward past the first tag that is a section start- or end-tag.
+Return xmltok-type for tag.
+If no tag found, return nil and move to the end of the buffer."
+  (let ((case-fold-search nil)
+	(tag-regexp (nxml-make-section-tag-regexp))
+	match-end)
+    (when (< (point) nxml-prolog-end)
+      (goto-char nxml-prolog-end))
+    (while (cond ((not (re-search-forward tag-regexp nil 'move))
+		  (setq xmltok-type nil)
+		  nil)
+		 ((progn
+		    (goto-char (match-beginning 0))
+		    (setq match-end (match-end 0))
+		    (nxml-ensure-scan-up-to-date)
+		    (let ((end (nxml-inside-end (point))))
+		      (when end
+			(goto-char end)
+			t))))
+		 ((progn
+		    (xmltok-forward)
+		    (and (memq xmltok-type '(start-tag
+					     partial-start-tag
+					     end-tag
+					     partial-end-tag))
+			 ;; just in case wildcard matched non-name chars
+			 (= xmltok-name-end (1- match-end))))
+		  nil)
+		 (t))))
+    xmltok-type)
+	 
+(defun nxml-section-tag-backward ()
+  "Move backward to the end of a tag that is a section start- or end-tag.
+The position of the end of the tag must be <= point
+Point is at the end of the tag.  `xmltok-start' is the start."
+  (let ((case-fold-search nil)
+	(start (point))
+	(tag-regexp (nxml-make-section-tag-regexp))
+	match-end)
+    (if (< (point) nxml-prolog-end)
+	(progn
+	  (goto-char (point-min))
+	  nil)
+      (while (cond ((not (re-search-backward tag-regexp
+					     nxml-prolog-end
+					     'move))
+		    (setq xmltok-type nil)
+		    (goto-char (point-min))
+		    nil)
+		   ((progn
+		      (goto-char (match-beginning 0))
+		      (setq match-end (match-end 0))
+		      (nxml-ensure-scan-up-to-date)
+		      (let ((pos (nxml-inside-start (point))))
+			(when pos
+			  (goto-char (1- pos))
+			  t))))
+		   ((progn
+		      (xmltok-forward)
+		      (and (<= (point) start)
+			   (memq xmltok-type '(start-tag
+					       partial-start-tag
+					       end-tag
+					       partial-end-tag))
+			   ;; just in case wildcard matched non-name chars
+			   (= xmltok-name-end (1- match-end))))
+		    nil)
+		   (t (goto-char xmltok-start)
+		      t)))
+      xmltok-type)))
+
+(defun nxml-section-start-position ()
+  "Return the position of the start of the section containing point.
+Signal an error on failure."
+  (condition-case err
+      (save-excursion (if (nxml-back-to-section-start)
+			  (point)
+			(error "Not in section")))
+    (nxml-outline-error
+     (nxml-report-outline-error "Couldn't determine containing section: %s"
+				err))))
+
+(defun nxml-back-to-section-start (&optional invisible-ok)
+  "Try to move back to the start of the section containing point.
+The start of the section must be <= point.
+Only visible sections are included unless INVISIBLE-OK is non-nil.
+If found, return t.  Otherwise move to point-min and return nil.
+If unbalanced section tags are found, signal an `nxml-outline-error'."
+  (when (or (nxml-after-section-start-tag)
+	    (nxml-section-tag-backward))
+    (let (open-tags found)
+      (while (let (section-start-pos)
+	       (setq section-start-pos xmltok-start)
+	       (if (nxml-token-end-tag-p)
+		   (setq open-tags (cons (xmltok-end-tag-qname)
+					 open-tags))
+		 (if (not open-tags)
+		     (when (and (nxml-token-starts-line-p)
+				(or invisible-ok
+				    (not (get-char-property section-start-pos
+							    'invisible)))
+				(nxml-heading-start-position))
+		       (setq found t))
+		   (let ((qname (xmltok-start-tag-qname)))
+		     (unless (string= (car open-tags) qname)
+		       (nxml-outline-error "mismatched end-tag"))
+		     (setq open-tags (cdr open-tags)))))
+	       (goto-char section-start-pos)
+	       (and (not found)
+		    (nxml-section-tag-backward))))
+      found)))
+
+(defun nxml-after-section-start-tag ()
+  "If the character after point is in a section start-tag, move after it.
+Return the token type.  Otherwise return nil.
+Set up variables like `xmltok-forward'."
+  (let ((pos (nxml-token-after))
+	(case-fold-search nil))
+   (when (and (memq xmltok-type '(start-tag partial-start-tag))
+	      (save-excursion
+		(goto-char xmltok-start)
+		(looking-at (nxml-make-section-tag-regexp))))
+     (goto-char pos)
+     xmltok-type)))
+
+(defun nxml-heading-start-position ()
+  "Return the position of the start of the content of a heading element.
+Adjust the position to be after initial leading whitespace.
+Return nil if no heading element is found.  Requires point to be
+immediately after the section's start-tag."
+  (let ((depth 0)
+	(heading-regexp (concat "\\`\\("
+				nxml-heading-element-name-regexp
+				"\\)\\'"))
+	
+	(section-regexp (concat "\\`\\("
+				nxml-section-element-name-regexp
+				"\\)\\'"))
+	(start (point))
+	found)
+    (save-excursion
+      (while (and (xmltok-forward)
+		  (cond ((memq xmltok-type '(end-tag partial-end-tag))
+			 (and (not (string-match section-regexp
+						 (xmltok-end-tag-local-name)))
+			      (> depth 0)
+			      (setq depth (1- depth))))
+			;; XXX Not sure whether this is a good idea
+			;;((eq xmltok-type 'empty-element)
+			;; nil)
+			((not (memq xmltok-type
+				    '(start-tag partial-start-tag)))
+			 t)
+			((string-match section-regexp
+				       (xmltok-start-tag-local-name))
+			 nil)
+			((string-match heading-regexp
+				       (xmltok-start-tag-local-name))
+			 (skip-chars-forward " \t\r\n")
+			 (setq found (point))
+			 nil)
+			(t
+			 (setq depth (1+ depth))
+			 t))
+		  (<= (- (point) start) nxml-heading-scan-distance))))
+    found))
+
+;;; Error handling
+
+(defun nxml-report-outline-error (msg err)
+  (error msg (apply 'format (cdr err))))
+
+(defun nxml-outline-error (&rest args)
+  (signal 'nxml-outline-error args))
+
+(put 'nxml-outline-error
+     'error-conditions
+     '(error nxml-error nxml-outline-error))
+
+(put 'nxml-outline-error
+     'error-message
+     "Cannot create outline of buffer that is not well-formed")
+
+;;; Debugging
+
+(defun nxml-debug-overlays ()
+  (interactive)
+  (let ((overlays (nreverse (overlays-in (point-min) (point-max))))
+	overlay)
+    (while overlays
+      (setq overlay (car overlays))
+      (setq overlays (cdr overlays))
+      (when (overlay-get overlay 'nxml-outline-display)
+	(message "overlay %s: %s...%s (%s)"
+		 (overlay-get overlay 'category)
+		 (overlay-start overlay)
+		 (overlay-end overlay)
+		 (overlay-get overlay 'display))))))
+
+(provide 'nxml-outln)
+
+;;; nxml-outln.el ends here