lisp/textmodes/ooutline.el

   1 ;;; outline.el --- outline mode commands for Emacs
   2
   3 ;; Copyright (C) 1986 Free Software Foundation, Inc.
   4
   5 ;; This file is part of GNU Emacs.
   6
   7 ;; GNU Emacs is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation; either version 1, or (at your option)
  10 ;; any later version.
  11
  12 ;; GNU Emacs is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  19 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  20
  21 ;; Jan '86, Some new features added by Peter Desnoyers and rewritten by RMS.
  22
  23 (defvar outline-regexp "[*\^l]+"
  24   "*Regular expression to match the beginning of a heading.
  25 Any line whose beginning matches this regexp is considered to start a heading.
  26 The recommended way to set this is with a Local Variables: list
  27 in the file it applies to.  See also outline-heading-end-regexp.")
  28
  29 (defvar outline-heading-end-regexp "[\n^M]"
  30   "*Regular expression to match the end of a heading line.
  31 You can assume that point is at the beginning of a heading when this
  32 regexp is searched for.  The heading ends at the end of the match.
  33 The recommended way to set this is with a \"Local Variables:\" list
  34 in the file it applies to.")
  35
  36 (defvar outline-mode-map nil "")
  37
  38 (if outline-mode-map
  39     nil
  40   (setq outline-mode-map (nconc (make-sparse-keymap) text-mode-map))
  41   (define-key outline-mode-map "\C-c\C-n" 'outline-next-visible-heading)
  42   (define-key outline-mode-map "\C-c\C-p" 'outline-previous-visible-heading)
  43   (define-key outline-mode-map "\C-c\C-i" 'show-children)
  44   (define-key outline-mode-map "\C-c\C-s" 'show-subtree)
  45   (define-key outline-mode-map "\C-c\C-h" 'hide-subtree)
  46   (define-key outline-mode-map "\C-c\C-u" 'outline-up-heading)
  47   (define-key outline-mode-map "\C-c\C-f" 'outline-forward-same-level)
  48   (define-key outline-mode-map "\C-c\C-b" 'outline-backward-same-level))
  49
  50 (defvar outline-minor-mode nil
  51   "Non-nil if using Outline mode as a minor mode of some other mode.")
  52 (setq minor-mode-alist (append minor-mode-alist
  53                                (list '(outline-minor-mode " Outl"))))
  54
  55 ;;;###autoload
  56 (defun outline-mode ()
  57   "Set major mode for editing outlines with selective display.
  58 Headings are lines which start with asterisks: one for major headings,
  59 two for subheadings, etc.  Lines not starting with asterisks are body lines.
  60
  61 Body text or subheadings under a heading can be made temporarily
  62 invisible, or visible again.  Invisible lines are attached to the end
  63 of the heading, so they move with it, if the line is killed and yanked
  64 back.  A heading with text hidden under it is marked with an ellipsis (...).
  65
  66 Commands:\\<outline-mode-map>
  67 \\[outline-next-visible-heading]   outline-next-visible-heading      move by visible headings
  68 \\[outline-previous-visible-heading]   outline-previous-visible-heading
  69 \\[outline-forward-same-level]   outline-forward-same-level        similar but skip subheadings
  70 \\[outline-backward-same-level]   outline-backward-same-level
  71 \\[outline-up-heading]   outline-up-heading                 move from subheading to heading
  72
  73 M-x hide-body   make all text invisible (not headings).
  74 M-x show-all    make everything in buffer visible.
  75
  76 The remaining commands are used when point is on a heading line.
  77 They apply to some of the body or subheadings of that heading.
  78 \\[hide-subtree]   hide-subtree make body and subheadings invisible.
  79 \\[show-subtree]   show-subtree make body and subheadings visible.
  80 \\[show-children]   show-children       make direct subheadings visible.
  81                  No effect on body, or subheadings 2 or more levels down.
  82                  With arg N, affects subheadings N levels down.
  83 M-x hide-entry     make immediately following body invisible.
  84 M-x show-entry     make it visible.
  85 M-x hide-leaves    make body under heading and under its subheadings invisible.
  86                      The subheadings remain visible.
  87 M-x show-branches  make all subheadings at all levels visible.
  88
  89 The variable `outline-regexp' can be changed to control what is a heading.
  90 A line is a heading if `outline-regexp' matches something at the
  91 beginning of the line.  The longer the match, the deeper the level.
  92
  93 Turning on outline mode calls the value of `text-mode-hook' and then of
  94 `outline-mode-hook', if they are non-nil."
  95   (interactive)
  96   (kill-all-local-variables)
  97   (setq selective-display t)
  98   (use-local-map outline-mode-map)
  99   (setq mode-name "Outline")
 100   (setq major-mode 'outline-mode)
 101   (define-abbrev-table 'text-mode-abbrev-table ())
 102   (setq local-abbrev-table text-mode-abbrev-table)
 103   (set-syntax-table text-mode-syntax-table)
 104   (make-local-variable 'paragraph-start)
 105   (setq paragraph-start (concat paragraph-start "\\|^\\("
 106                                 outline-regexp "\\)"))
 107   ;; Inhibit auto-filling of header lines.
 108   (make-local-variable 'auto-fill-inhibit-regexp)
 109   (setq auto-fill-inhibit-regexp outline-regexp)
 110   (make-local-variable 'paragraph-separate)
 111   (setq paragraph-separate (concat paragraph-separate "\\|^\\("
 112                                    outline-regexp "\\)"))
 113   (run-hooks 'text-mode-hook 'outline-mode-hook))
 114
 115 (defun outline-minor-mode (arg)
 116   (interactive "P")
 117   (setq outline-minor-mode
 118         (if (null arg) (not outline-minor-mode)
 119           (> (prefix-numeric-value arg) 0)))
 120   (if outline-minor-mode
 121       (progn
 122         (setq selective-display t)
 123         (make-local-variable 'outline-old-map)
 124         (setq outline-old-map (current-local-map))
 125         (let ((new-map (copy-keymap outline-old-map)))
 126           (define-key new-map "\C-c"
 127             (lookup-key outline-mode-map "\C-c"))
 128           (use-local-map new-map))
 129         (make-local-variable 'outline-regexp)
 130         (setq outline-regexp "[ \t]*/\\*")
 131         (make-local-variable 'outline-heading-end-regexp)
 132         (setq outline-heading-end-regexp "\\*/[^\n\^M]*[\n\^M]")
 133         (run-hooks 'outline-minor-mode-hook))
 134     (progn
 135       (setq selective-display nil)
 136       (use-local-map outline-old-map))))
 137 \f
 138 (defun outline-level ()
 139   "Return the depth to which a statement is nested in the outline.
 140 Point must be at the beginning of a header line.  This is actually
 141 the column number of the end of what `outline-regexp matches'."
 142   (save-excursion
 143     (looking-at outline-regexp)
 144     (save-excursion (goto-char (match-end 0)) (current-column))))
 145
 146 (defun outline-next-preface ()
 147   "Skip forward to just before the next heading line."
 148   (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)")
 149                          nil 'move)
 150       (goto-char (match-beginning 0)))
 151   (if (memq (preceding-char) '(?\n ?\^M))
 152       (forward-char -1)))
 153
 154 (defun outline-next-heading ()
 155   "Move to the next (possibly invisible) heading line."
 156   (interactive)
 157   (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)")
 158                          nil 'move)
 159       (goto-char (1+ (match-beginning 0)))))
 160
 161 (defun outline-back-to-heading ()
 162   "Move to previous (possibly invisible) heading line,
 163 or to the beginning of this line if it is a heading line."
 164   (beginning-of-line)
 165   (or (outline-on-heading-p)
 166       (re-search-backward (concat "^\\(" outline-regexp "\\)") nil 'move)))
 167
 168 (defun outline-on-heading-p ()
 169   "Return T if point is on a header line."
 170   (save-excursion
 171     (beginning-of-line)
 172     (and (eq (preceding-char) ?\n)
 173          (looking-at outline-regexp))))
 174
 175 (defun outline-end-of-heading ()
 176   (if (re-search-forward outline-heading-end-regexp nil 'move)
 177       (forward-char -1)))
 178
 179 (defun outline-next-visible-heading (arg)
 180   "Move to the next visible heading line.
 181 With argument, repeats or can move backward if negative.
 182 A heading line is one that starts with a `*' (or that
 183 `outline-regexp' matches)."
 184   (interactive "p")
 185   (if (< arg 0)
 186       (beginning-of-line)
 187     (end-of-line))
 188   (re-search-forward (concat "^\\(" outline-regexp "\\)") nil nil arg)
 189   (beginning-of-line))
 190
 191 (defun outline-previous-visible-heading (arg)
 192   "Move to the previous heading line.
 193 With argument, repeats or can move forward if negative.
 194 A heading line is one that starts with a `*' (or that
 195 `outline-regexp' matches)."
 196   (interactive "p")
 197   (outline-next-visible-heading (- arg)))
 198
 199 (defun outline-flag-region (from to flag)
 200   "Hides or shows lines from FROM to TO, according to FLAG.
 201 If FLAG is `\\n' (newline character) then text is shown,
 202 while if FLAG is `\\^M' (control-M) the text is hidden."
 203   (let ((modp (buffer-modified-p)))
 204     (unwind-protect
 205         (subst-char-in-region from to
 206                               (if (= flag ?\n) ?\^M ?\n)
 207                               flag)
 208      (set-buffer-modified-p modp))))
 209 \f
 210 (defun hide-entry ()
 211   "Hide the body directly following this heading."
 212   (interactive)
 213   (outline-back-to-heading)
 214   (outline-end-of-heading)
 215   (save-excursion
 216    (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\^M)))
 217
 218 (defun show-entry ()
 219   "Show the body directly following this heading."
 220   (interactive)
 221   (save-excursion
 222    (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\n)))
 223
 224 (defun hide-body ()
 225   "Hide all of buffer except headings."
 226   (interactive)
 227   (hide-region-body (point-min) (point-max)))
 228
 229 (defun hide-region-body (start end)
 230   "Hide all body lines in the region, but not headings."
 231   (save-excursion
 232     (save-restriction
 233       (narrow-to-region start end)
 234       (goto-char (point-min))
 235       (if (outline-on-heading-p)
 236           (outline-end-of-heading))
 237       (while (not (eobp))
 238         (outline-flag-region (point)
 239                              (progn (outline-next-preface) (point)) ?\^M)
 240         (if (not (eobp))
 241             (progn
 242               (forward-char
 243                (if (looking-at "[\n\^M][\n\^M]")
 244                    2 1))
 245               (outline-end-of-heading)))))))
 246
 247 (defun show-all ()
 248   "Show all of the text in the buffer."
 249   (interactive)
 250   (outline-flag-region (point-min) (point-max) ?\n))
 251
 252 (defun hide-subtree ()
 253   "Hide everything after this heading at deeper levels."
 254   (interactive)
 255   (outline-flag-subtree ?\^M))
 256
 257 (defun hide-leaves ()
 258   "Hide all body after this heading at deeper levels."
 259   (interactive)
 260   (outline-back-to-heading)
 261   (outline-end-of-heading)
 262   (hide-region-body (point) (progn (outline-end-of-subtree) (point))))
 263
 264 (defun show-subtree ()
 265   "Show everything after this heading at deeper levels."
 266   (interactive)
 267   (outline-flag-subtree ?\n))
 268
 269 (defun outline-flag-subtree (flag)
 270   (save-excursion
 271     (outline-back-to-heading)
 272     (outline-end-of-heading)
 273     (outline-flag-region (point)
 274                           (progn (outline-end-of-subtree) (point))
 275                           flag)))
 276
 277 (defun outline-end-of-subtree ()
 278   (outline-back-to-heading)
 279   (let ((opoint (point))
 280         (first t)
 281         (level (outline-level)))
 282     (while (and (not (eobp))
 283                 (or first (> (outline-level) level)))
 284       (setq first nil)
 285       (outline-next-heading))
 286     (forward-char -1)
 287     (if (memq (preceding-char) '(?\n ?\^M))
 288         (forward-char -1))))
 289 \f
 290 (defun show-branches ()
 291   "Show all subheadings of this heading, but not their bodies."
 292   (interactive)
 293   (show-children 1000))
 294
 295 (defun show-children (&optional level)
 296   "Show all direct subheadings of this heading.
 297 Prefix arg LEVEL is how many levels below the current level should be shown.
 298 Default is enough to cause the following heading to appear."
 299   (interactive "P")
 300   (setq level
 301         (if level (prefix-numeric-value level)
 302           (save-excursion
 303             (beginning-of-line)
 304             (let ((start-level (outline-level)))
 305               (outline-next-heading)
 306               (max 1 (- (outline-level) start-level))))))
 307   (save-excursion
 308    (save-restriction
 309     (beginning-of-line)
 310     (setq level (+ level (outline-level)))
 311     (narrow-to-region (point)
 312                       (progn (outline-end-of-subtree) (1+ (point))))
 313     (goto-char (point-min))
 314     (while (and (not (eobp))
 315                 (progn
 316                  (outline-next-heading)
 317                  (not (eobp))))
 318       (if (<= (outline-level) level)
 319           (save-excursion
 320             (outline-flag-region (save-excursion
 321                                    (forward-char -1)
 322                                    (if (memq (preceding-char) '(?\n ?\^M))
 323                                        (forward-char -1))
 324                                    (point))
 325                                  (progn (outline-end-of-heading) (point))
 326                                  ?\n)))))))
 327 \f
 328 (defun outline-up-heading (arg)
 329   "Move to the heading line of which the present line is a subheading.
 330 With argument, move up ARG levels."
 331   (interactive "p")
 332   (outline-back-to-heading)
 333   (if (eq (outline-level) 1)
 334       (error ""))
 335     (while (and (> (outline-level) 1)
 336                 (> arg 0)
 337                 (not (bobp)))
 338       (let ((present-level (outline-level)))
 339         (while (not (< (outline-level) present-level))
 340           (outline-previous-visible-heading 1))
 341         (setq arg (- arg 1)))))
 342
 343 (defun outline-forward-same-level (arg)
 344   "Move forward to the ARG'th subheading from here of the same level as the
 345 present one. It stops at the first and last subheadings of a superior heading."
 346   (interactive "p")
 347   (outline-back-to-heading)
 348   (while (> arg 0)
 349     (let ((point-to-move-to (save-excursion
 350                               (outline-get-next-sibling))))
 351       (if point-to-move-to
 352           (progn
 353             (goto-char point-to-move-to)
 354             (setq arg (1- arg)))
 355         (progn
 356           (setq arg 0)
 357           (error ""))))))
 358
 359 (defun outline-get-next-sibling ()
 360   "Position the point at the next heading of the same level,
 361 and return that position or nil if it cannot be found."
 362   (let ((level (outline-level)))
 363     (outline-next-visible-heading 1)
 364     (while (and (> (outline-level) level)
 365                 (not (eobp)))
 366       (outline-next-visible-heading 1))
 367     (if (< (outline-level) level)
 368         nil
 369       (point))))
 370
 371 (defun outline-backward-same-level (arg)
 372   "Move backward to the ARG'th subheading from here of the same level as the
 373 present one. It stops at the first and last subheadings of a superior heading."
 374   (interactive "p")
 375   (outline-back-to-heading)
 376   (while (> arg 0)
 377     (let ((point-to-move-to (save-excursion
 378                               (outline-get-last-sibling))))
 379       (if point-to-move-to
 380           (progn
 381             (goto-char point-to-move-to)
 382             (setq arg (1- arg)))
 383         (progn
 384           (setq arg 0)
 385           (error ""))))))
 386
 387 (defun outline-get-last-sibling ()
 388   "Position the point at the previous heading of the same level,
 389 and return that position or nil if it cannot be found."
 390   (let ((level (outline-level)))
 391     (outline-previous-visible-heading 1)
 392     (while (and (> (outline-level) level)
 393                 (not (bobp)))
 394       (outline-previous-visible-heading 1))
 395     (if (< (outline-level) level)
 396         nil
 397         (point))))
 398
 399 ;;; outline.el ends here