Initial revision

1 files changed, 396 insertions, 0 deletions

diff --git a/lisp/textmodes/ooutline.el b/lisp/textmodes/ooutline.el
new file mode 100644
index 00000000000..c56a3eb10c6
--- /dev/null
+++ b/lisp/textmodes/ooutline.el
@@ -0,0 +1,396 @@
+;; Outline mode commands for Emacs
+;; Copyright (C) 1986 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs 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 GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;; Jan '86, Some new features added by Peter Desnoyers and rewritten by RMS.
+  
+(defvar outline-regexp "[*\^l]+"
+  "*Regular expression to match the beginning of a heading.
+Any line whose beginning matches this regexp is considered to start a heading.
+The recommended way to set this is with a Local Variables: list
+in the file it applies to.  See also outline-heading-end-regexp.")
+  
+(defvar outline-heading-end-regexp "[\n^M]"
+  "*Regular expression to match the end of a heading line.
+You can assume that point is at the beginning of a heading when this
+regexp is searched for.  The heading ends at the end of the match.
+The recommended way to set this is with a \"Local Variables:\" list
+in the file it applies to.")
+
+(defvar outline-mode-map nil "")
+
+(if outline-mode-map
+    nil
+  (setq outline-mode-map (nconc (make-sparse-keymap) text-mode-map))
+  (define-key outline-mode-map "\C-c\C-n" 'outline-next-visible-heading)
+  (define-key outline-mode-map "\C-c\C-p" 'outline-previous-visible-heading)
+  (define-key outline-mode-map "\C-c\C-i" 'show-children)
+  (define-key outline-mode-map "\C-c\C-s" 'show-subtree)
+  (define-key outline-mode-map "\C-c\C-h" 'hide-subtree)
+  (define-key outline-mode-map "\C-c\C-u" 'outline-up-heading)
+  (define-key outline-mode-map "\C-c\C-f" 'outline-forward-same-level)
+  (define-key outline-mode-map "\C-c\C-b" 'outline-backward-same-level))
+
+(defvar outline-minor-mode nil
+  "Non-nil if using Outline mode as a minor mode of some other mode.")
+(setq minor-mode-alist (append minor-mode-alist
+			       (list '(outline-minor-mode " Outl"))))
+
+(defun outline-mode ()
+  "Set major mode for editing outlines with selective display.
+Headings are lines which start with asterisks: one for major headings,
+two for subheadings, etc.  Lines not starting with asterisks are body lines. 
+
+Body text or subheadings under a heading can be made temporarily
+invisible, or visible again.  Invisible lines are attached to the end 
+of the heading, so they move with it, if the line is killed and yanked
+back.  A heading with text hidden under it is marked with an ellipsis (...).
+
+Commands:\\<outline-mode-map>
+\\[outline-next-visible-heading]   outline-next-visible-heading      move by visible headings
+\\[outline-previous-visible-heading]   outline-previous-visible-heading
+\\[outline-forward-same-level]   outline-forward-same-level        similar but skip subheadings
+\\[outline-backward-same-level]   outline-backward-same-level
+\\[outline-up-heading]   outline-up-heading		    move from subheading to heading
+
+M-x hide-body	make all text invisible (not headings).
+M-x show-all	make everything in buffer visible.
+
+The remaining commands are used when point is on a heading line.
+They apply to some of the body or subheadings of that heading.
+\\[hide-subtree]   hide-subtree	make body and subheadings invisible.
+\\[show-subtree]   show-subtree	make body and subheadings visible.
+\\[show-children]   show-children	make direct subheadings visible.
+		 No effect on body, or subheadings 2 or more levels down.
+		 With arg N, affects subheadings N levels down.
+M-x hide-entry	   make immediately following body invisible.
+M-x show-entry	   make it visible.
+M-x hide-leaves	   make body under heading and under its subheadings invisible.
+		     The subheadings remain visible.
+M-x show-branches  make all subheadings at all levels visible.
+
+The variable `outline-regexp' can be changed to control what is a heading.
+A line is a heading if `outline-regexp' matches something at the
+beginning of the line.  The longer the match, the deeper the level.
+
+Turning on outline mode calls the value of `text-mode-hook' and then of
+`outline-mode-hook', if they are non-nil."
+  (interactive)
+  (kill-all-local-variables)
+  (setq selective-display t)
+  (use-local-map outline-mode-map)
+  (setq mode-name "Outline")
+  (setq major-mode 'outline-mode)
+  (define-abbrev-table 'text-mode-abbrev-table ())
+  (setq local-abbrev-table text-mode-abbrev-table)
+  (set-syntax-table text-mode-syntax-table)
+  (make-local-variable 'paragraph-start)
+  (setq paragraph-start (concat paragraph-start "\\|^\\("
+				outline-regexp "\\)"))
+  ;; Inhibit auto-filling of header lines.
+  (make-local-variable 'auto-fill-inhibit-regexp)
+  (setq auto-fill-inhibit-regexp outline-regexp)
+  (make-local-variable 'paragraph-separate)
+  (setq paragraph-separate (concat paragraph-separate "\\|^\\("
+				   outline-regexp "\\)"))
+  (run-hooks 'text-mode-hook 'outline-mode-hook))
+
+(defun outline-minor-mode (arg)
+  (interactive "P")
+  (setq outline-minor-mode
+	(if (null arg) (not outline-minor-mode)
+	  (> (prefix-numeric-value arg) 0)))
+  (if outline-minor-mode
+      (progn
+	(setq selective-display t)
+	(make-local-variable 'outline-old-map)
+	(setq outline-old-map (current-local-map))
+	(let ((new-map (copy-keymap outline-old-map)))
+	  (define-key new-map "\C-c"
+	    (lookup-key outline-mode-map "\C-c"))
+	  (use-local-map new-map))
+	(make-local-variable 'outline-regexp)
+	(setq outline-regexp "[ \t]*/\\*")
+	(make-local-variable 'outline-heading-end-regexp)
+	(setq outline-heading-end-regexp "\\*/[^\n\^M]*[\n\^M]")
+	(run-hooks 'outline-minor-mode-hook))
+    (progn
+      (setq selective-display nil)
+      (use-local-map outline-old-map))))
+
+(defun outline-level ()
+  "Return the depth to which a statement is nested in the outline.
+Point must be at the beginning of a header line.  This is actually
+the column number of the end of what `outline-regexp matches'."
+  (save-excursion
+    (looking-at outline-regexp)
+    (save-excursion (goto-char (match-end 0)) (current-column))))
+
+(defun outline-next-preface ()
+  "Skip forward to just before the next heading line."
+  (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)")
+			 nil 'move)
+      (goto-char (match-beginning 0)))
+  (if (memq (preceding-char) '(?\n ?\^M))
+      (forward-char -1)))
+
+(defun outline-next-heading ()
+  "Move to the next (possibly invisible) heading line."
+  (interactive)
+  (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)")
+			 nil 'move)
+      (goto-char (1+ (match-beginning 0)))))
+
+(defun outline-back-to-heading ()
+  "Move to previous (possibly invisible) heading line,
+or to the beginning of this line if it is a heading line."
+  (beginning-of-line)
+  (or (outline-on-heading-p)
+      (re-search-backward (concat "^\\(" outline-regexp "\\)") nil 'move)))
+
+(defun outline-on-heading-p ()
+  "Return T if point is on a header line."
+  (save-excursion
+    (beginning-of-line)
+    (and (eq (preceding-char) ?\n)
+	 (looking-at outline-regexp))))
+
+(defun outline-end-of-heading ()
+  (if (re-search-forward outline-heading-end-regexp nil 'move)
+      (forward-char -1)))
+
+(defun outline-next-visible-heading (arg)
+  "Move to the next visible heading line.
+With argument, repeats or can move backward if negative.
+A heading line is one that starts with a `*' (or that
+`outline-regexp' matches)."
+  (interactive "p")
+  (if (< arg 0)
+      (beginning-of-line)
+    (end-of-line))
+  (re-search-forward (concat "^\\(" outline-regexp "\\)") nil nil arg)
+  (beginning-of-line))
+
+(defun outline-previous-visible-heading (arg)
+  "Move to the previous heading line.
+With argument, repeats or can move forward if negative.
+A heading line is one that starts with a `*' (or that
+`outline-regexp' matches)."
+  (interactive "p")
+  (outline-next-visible-heading (- arg)))
+
+(defun outline-flag-region (from to flag)
+  "Hides or shows lines from FROM to TO, according to FLAG.
+If FLAG is `\\n' (newline character) then text is shown,
+while if FLAG is `\\^M' (control-M) the text is hidden."
+  (let ((modp (buffer-modified-p)))
+    (unwind-protect
+        (subst-char-in-region from to
+			      (if (= flag ?\n) ?\^M ?\n)
+			      flag)
+     (set-buffer-modified-p modp))))
+
+(defun hide-entry ()
+  "Hide the body directly following this heading."
+  (interactive)
+  (outline-back-to-heading)
+  (outline-end-of-heading)
+  (save-excursion
+   (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\^M)))
+
+(defun show-entry ()
+  "Show the body directly following this heading."
+  (interactive)
+  (save-excursion
+   (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\n)))
+
+(defun hide-body ()
+  "Hide all of buffer except headings."
+  (interactive)
+  (hide-region-body (point-min) (point-max)))
+
+(defun hide-region-body (start end)
+  "Hide all body lines in the region, but not headings."
+  (save-excursion
+    (save-restriction
+      (narrow-to-region start end)
+      (goto-char (point-min))
+      (if (outline-on-heading-p)
+	  (outline-end-of-heading))
+      (while (not (eobp))
+	(outline-flag-region (point)
+			     (progn (outline-next-preface) (point)) ?\^M)
+	(if (not (eobp))
+	    (progn
+	      (forward-char
+	       (if (looking-at "[\n\^M][\n\^M]")
+		   2 1))
+	      (outline-end-of-heading)))))))
+
+(defun show-all ()
+  "Show all of the text in the buffer."
+  (interactive)
+  (outline-flag-region (point-min) (point-max) ?\n))
+
+(defun hide-subtree ()
+  "Hide everything after this heading at deeper levels."
+  (interactive)
+  (outline-flag-subtree ?\^M))
+
+(defun hide-leaves ()
+  "Hide all body after this heading at deeper levels."
+  (interactive)
+  (outline-back-to-heading)
+  (outline-end-of-heading)
+  (hide-region-body (point) (progn (outline-end-of-subtree) (point))))
+
+(defun show-subtree ()
+  "Show everything after this heading at deeper levels."
+  (interactive)
+  (outline-flag-subtree ?\n))
+
+(defun outline-flag-subtree (flag)
+  (save-excursion
+    (outline-back-to-heading)
+    (outline-end-of-heading)
+    (outline-flag-region (point)
+			  (progn (outline-end-of-subtree) (point))
+			  flag)))
+
+(defun outline-end-of-subtree ()
+  (outline-back-to-heading)
+  (let ((opoint (point))
+	(first t)
+	(level (outline-level)))
+    (while (and (not (eobp))
+		(or first (> (outline-level) level)))
+      (setq first nil)
+      (outline-next-heading))
+    (forward-char -1)
+    (if (memq (preceding-char) '(?\n ?\^M))
+	(forward-char -1))))
+
+(defun show-branches ()
+  "Show all subheadings of this heading, but not their bodies."
+  (interactive)
+  (show-children 1000))
+
+(defun show-children (&optional level)
+  "Show all direct subheadings of this heading.
+Prefix arg LEVEL is how many levels below the current level should be shown.
+Default is enough to cause the following heading to appear."
+  (interactive "P")
+  (setq level
+	(if level (prefix-numeric-value level)
+	  (save-excursion
+	    (beginning-of-line)
+	    (let ((start-level (outline-level)))
+	      (outline-next-heading)
+	      (max 1 (- (outline-level) start-level))))))
+  (save-excursion
+   (save-restriction
+    (beginning-of-line)
+    (setq level (+ level (outline-level)))
+    (narrow-to-region (point)
+		      (progn (outline-end-of-subtree) (1+ (point))))
+    (goto-char (point-min))
+    (while (and (not (eobp))
+		(progn
+		 (outline-next-heading)
+		 (not (eobp))))
+      (if (<= (outline-level) level)
+	  (save-excursion
+	    (outline-flag-region (save-excursion
+				   (forward-char -1)
+				   (if (memq (preceding-char) '(?\n ?\^M))
+				       (forward-char -1))
+				   (point))
+				 (progn (outline-end-of-heading) (point))
+				 ?\n)))))))
+
+(defun outline-up-heading (arg)
+  "Move to the heading line of which the present line is a subheading.
+With argument, move up ARG levels."
+  (interactive "p")
+  (outline-back-to-heading)
+  (if (eq (outline-level) 1)
+      (error ""))
+    (while (and (> (outline-level) 1)
+		(> arg 0)
+		(not (bobp)))
+      (let ((present-level (outline-level)))
+	(while (not (< (outline-level) present-level))
+	  (outline-previous-visible-heading 1))
+	(setq arg (- arg 1)))))
+
+(defun outline-forward-same-level (arg)
+  "Move forward to the ARG'th subheading from here of the same level as the
+present one. It stops at the first and last subheadings of a superior heading."
+  (interactive "p")
+  (outline-back-to-heading)
+  (while (> arg 0)
+    (let ((point-to-move-to (save-excursion
+			      (outline-get-next-sibling))))  
+      (if point-to-move-to
+	  (progn
+	    (goto-char point-to-move-to)
+	    (setq arg (1- arg)))
+	(progn
+	  (setq arg 0)
+	  (error ""))))))
+
+(defun outline-get-next-sibling ()
+  "Position the point at the next heading of the same level, 
+and return that position or nil if it cannot be found."
+  (let ((level (outline-level)))
+    (outline-next-visible-heading 1)
+    (while (and (> (outline-level) level)
+		(not (eobp)))
+      (outline-next-visible-heading 1))
+    (if (< (outline-level) level)
+	nil
+      (point))))
+	
+(defun outline-backward-same-level (arg)
+  "Move backward to the ARG'th subheading from here of the same level as the
+present one. It stops at the first and last subheadings of a superior heading."
+  (interactive "p")
+  (outline-back-to-heading)
+  (while (> arg 0)
+    (let ((point-to-move-to (save-excursion
+			      (outline-get-last-sibling))))
+      (if point-to-move-to
+	  (progn
+	    (goto-char point-to-move-to)
+	    (setq arg (1- arg)))
+	(progn
+	  (setq arg 0)
+	  (error ""))))))
+
+(defun outline-get-last-sibling ()
+  "Position the point at the previous heading of the same level, 
+and return that position or nil if it cannot be found."
+  (let ((level (outline-level)))
+    (outline-previous-visible-heading 1)
+    (while (and (> (outline-level) level)
+		(not (bobp)))
+      (outline-previous-visible-heading 1))
+    (if (< (outline-level) level)
+	nil
+        (point))))
+