code.delx.au - gnu-emacs/blob - lisp/textmodes/ooutline.el

   1 ;;; outline.el --- outline mode commands for Emacs
   2
   3 ;; Copyright (C) 1986, 1993 Free Software Foundation, Inc.
   4
   5 ;; 7-Feb-94     Kevin Broadey
   6 ;; Fix show-children so it doesn't try to narrow to (1+ (point-max)) when
   7 ;; exposing the last level-n header in the buffer.
   8 ;;
   9 ;; Maintainer: FSF
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  25 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; This package is a major mode for editing outline-format documents.
  30 ;; An outline can be `abstracted' to show headers at any given level,
  31 ;; with all stuff below hidden.  See the Emacs manual for details.
  32
  33 ;;; Code:
  34
  35 ;; Jan '86, Some new features added by Peter Desnoyers and rewritten by RMS.
  36
  37 (defvar outline-regexp nil
  38   "*Regular expression to match the beginning of a heading.
  39 Any line whose beginning matches this regexp is considered to start a heading.
  40 The recommended way to set this is with a Local Variables: list
  41 in the file it applies to.  See also outline-heading-end-regexp.")
  42
  43 ;; Can't initialize this in the defvar above -- some major modes have
  44 ;; already assigned a local value to it.
  45 (or (default-value 'outline-regexp)
  46     (setq-default outline-regexp "[*\^L]+"))
  47
  48 (defvar outline-heading-end-regexp "[\n\^M]"
  49   "*Regular expression to match the end of a heading line.
  50 You can assume that point is at the beginning of a heading when this
  51 regexp is searched for.  The heading ends at the end of the match.
  52 The recommended way to set this is with a \"Local Variables:\" list
  53 in the file it applies to.")
  54
  55 (defvar outline-mode-map nil "")
  56
  57 (if outline-mode-map
  58     nil
  59   (setq outline-mode-map (nconc (make-sparse-keymap) text-mode-map))
  60   (define-key outline-mode-map "\C-c\C-n" 'outline-next-visible-heading)
  61   (define-key outline-mode-map "\C-c\C-p" 'outline-previous-visible-heading)
  62   (define-key outline-mode-map "\C-c\C-i" 'show-children)
  63   (define-key outline-mode-map "\C-c\C-s" 'show-subtree)
  64   (define-key outline-mode-map "\C-c\C-d" 'hide-subtree)
  65   (define-key outline-mode-map "\C-c\C-u" 'outline-up-heading)
  66   (define-key outline-mode-map "\C-c\C-f" 'outline-forward-same-level)
  67   (define-key outline-mode-map "\C-c\C-b" 'outline-backward-same-level)
  68   (define-key outline-mode-map "\C-c\C-t" 'hide-body)
  69   (define-key outline-mode-map "\C-c\C-a" 'show-all)
  70   (define-key outline-mode-map "\C-c\C-c" 'hide-entry)
  71   (define-key outline-mode-map "\C-c\C-e" 'show-entry)
  72   (define-key outline-mode-map "\C-c\C-l" 'hide-leaves)
  73   (define-key outline-mode-map "\C-c\C-k" 'show-branches)
  74   (define-key outline-mode-map "\C-c\C-q" 'outline-hide-sublevels)
  75   (define-key outline-mode-map "\C-c\C-o" 'outline-hide-other)
  76
  77   (define-key outline-mode-map [menu-bar hide]
  78     (cons "Hide" (make-sparse-keymap "Hide")))
  79
  80   (define-key outline-mode-map [menu-bar hide hide-other]
  81     '("Hide Other" . outline-hide-other))
  82   (define-key outline-mode-map [menu-bar hide hide-sublevels]
  83     '("Hide Sublevels" . outline-hide-sublevels))
  84   (define-key outline-mode-map [menu-bar hide hide-subtree]
  85     '("Hide Subtree" . hide-subtree))
  86   (define-key outline-mode-map [menu-bar hide hide-entry]
  87     '("Hide Entry" . hide-entry))
  88   (define-key outline-mode-map [menu-bar hide hide-body]
  89     '("Hide Body" . hide-body))
  90   (define-key outline-mode-map [menu-bar hide hide-leaves]
  91     '("Hide Leaves" . hide-leaves))
  92
  93   (define-key outline-mode-map [menu-bar show]
  94     (cons "Show" (make-sparse-keymap "Show")))
  95
  96   (define-key outline-mode-map [menu-bar show show-subtree]
  97     '("Show Subtree" . show-subtree))
  98   (define-key outline-mode-map [menu-bar show show-children]
  99     '("Show Children" . show-children))
 100   (define-key outline-mode-map [menu-bar show show-branches]
 101     '("Show Branches" . show-branches))
 102   (define-key outline-mode-map [menu-bar show show-entry]
 103     '("Show Entry" . show-entry))
 104   (define-key outline-mode-map [menu-bar show show-all]
 105     '("Show All" . show-all))
 106
 107   (define-key outline-mode-map [menu-bar headings]
 108     (cons "Headings" (make-sparse-keymap "Headings")))
 109
 110   (define-key outline-mode-map [menu-bar headings outline-backward-same-level]
 111     '("Previous Same Level" . outline-backward-same-level))
 112   (define-key outline-mode-map [menu-bar headings outline-forward-same-level]
 113     '("Next Same Level" . outline-forward-same-level))
 114   (define-key outline-mode-map [menu-bar headings outline-previous-visible-heading]
 115     '("Previous" . outline-previous-visible-heading))
 116   (define-key outline-mode-map [menu-bar headings outline-next-visible-heading]
 117     '("Next" . outline-next-visible-heading))
 118   (define-key outline-mode-map [menu-bar headings outline-up-heading]
 119     '("Up" . outline-up-heading)))
 120
 121 (defvar outline-minor-mode nil
 122   "Non-nil if using Outline mode as a minor mode of some other mode.")
 123 (make-variable-buffer-local 'outline-minor-mode)
 124 (put 'outline-minor-mode 'permanent-local t)
 125 (or (assq 'outline-minor-mode minor-mode-alist)
 126     (setq minor-mode-alist (append minor-mode-alist
 127                                    (list '(outline-minor-mode " Outl")))))
 128
 129 ;;;###autoload
 130 (defun outline-mode ()
 131   "Set major mode for editing outlines with selective display.
 132 Headings are lines which start with asterisks: one for major headings,
 133 two for subheadings, etc.  Lines not starting with asterisks are body lines.
 134
 135 Body text or subheadings under a heading can be made temporarily
 136 invisible, or visible again.  Invisible lines are attached to the end
 137 of the heading, so they move with it, if the line is killed and yanked
 138 back.  A heading with text hidden under it is marked with an ellipsis (...).
 139
 140 Commands:\\<outline-mode-map>
 141 \\[outline-next-visible-heading]   outline-next-visible-heading      move by visible headings
 142 \\[outline-previous-visible-heading]   outline-previous-visible-heading
 143 \\[outline-forward-same-level]   outline-forward-same-level        similar but skip subheadings
 144 \\[outline-backward-same-level]   outline-backward-same-level
 145 \\[outline-up-heading]   outline-up-heading                 move from subheading to heading
 146
 147 M-x hide-body   make all text invisible (not headings).
 148 M-x show-all    make everything in buffer visible.
 149
 150 The remaining commands are used when point is on a heading line.
 151 They apply to some of the body or subheadings of that heading.
 152 \\[hide-subtree]   hide-subtree make body and subheadings invisible.
 153 \\[show-subtree]   show-subtree make body and subheadings visible.
 154 \\[show-children]   show-children       make direct subheadings visible.
 155                  No effect on body, or subheadings 2 or more levels down.
 156                  With arg N, affects subheadings N levels down.
 157 M-x hide-entry     make immediately following body invisible.
 158 M-x show-entry     make it visible.
 159 M-x hide-leaves    make body under heading and under its subheadings invisible.
 160                      The subheadings remain visible.
 161 M-x show-branches  make all subheadings at all levels visible.
 162
 163 The variable `outline-regexp' can be changed to control what is a heading.
 164 A line is a heading if `outline-regexp' matches something at the
 165 beginning of the line.  The longer the match, the deeper the level.
 166
 167 Turning on outline mode calls the value of `text-mode-hook' and then of
 168 `outline-mode-hook', if they are non-nil."
 169   (interactive)
 170   (kill-all-local-variables)
 171   (setq selective-display t)
 172   (use-local-map outline-mode-map)
 173   (setq mode-name "Outline")
 174   (setq major-mode 'outline-mode)
 175   (define-abbrev-table 'text-mode-abbrev-table ())
 176   (setq local-abbrev-table text-mode-abbrev-table)
 177   (set-syntax-table text-mode-syntax-table)
 178   (make-local-variable 'paragraph-start)
 179   (setq paragraph-start (concat paragraph-start "\\|^\\("
 180                                 outline-regexp "\\)"))
 181   ;; Inhibit auto-filling of header lines.
 182   (make-local-variable 'auto-fill-inhibit-regexp)
 183   (setq auto-fill-inhibit-regexp outline-regexp)
 184   (make-local-variable 'paragraph-separate)
 185   (setq paragraph-separate (concat paragraph-separate "\\|^\\("
 186                                    outline-regexp "\\)"))
 187   (add-hook 'change-major-mode-hook 'show-all)
 188   (run-hooks 'text-mode-hook 'outline-mode-hook))
 189
 190 (defvar outline-minor-mode-prefix "\C-c\C-o"
 191   "*Prefix key to use for Outline commands in Outline minor mode.")
 192
 193 (defvar outline-minor-mode-map nil)
 194 (if outline-minor-mode-map
 195     nil
 196   (setq outline-minor-mode-map (make-sparse-keymap))
 197   (define-key outline-minor-mode-map [menu-bar]
 198     (lookup-key outline-mode-map [menu-bar]))
 199   (define-key outline-minor-mode-map outline-minor-mode-prefix
 200     (lookup-key outline-mode-map "\C-c")))
 201
 202 (or (assq 'outline-minor-mode minor-mode-map-alist)
 203     (setq minor-mode-map-alist
 204           (cons (cons 'outline-minor-mode outline-minor-mode-map)
 205                 minor-mode-map-alist)))
 206
 207 ;;;###autoload
 208 (defun outline-minor-mode (&optional arg)
 209   "Toggle Outline minor mode.
 210 With arg, turn Outline minor mode on if arg is positive, off otherwise.
 211 See the command `outline-mode' for more information on this mode."
 212   (interactive "P")
 213   (setq outline-minor-mode
 214         (if (null arg) (not outline-minor-mode)
 215           (> (prefix-numeric-value arg) 0)))
 216   (if outline-minor-mode
 217       (progn
 218         (setq selective-display t)
 219         (run-hooks 'outline-minor-mode-hook))
 220     (setq selective-display nil))
 221   ;; When turning off outline mode, get rid of any ^M's.
 222   (or outline-minor-mode
 223       (outline-flag-region (point-min) (point-max) ?\n))
 224   (set-buffer-modified-p (buffer-modified-p)))
 225 \f
 226 (defvar outline-level 'outline-level
 227   "Function of no args to compute a header's nesting level in an outline.
 228 It can assume point is at the beginning of a header line.")
 229
 230 (defun outline-level ()
 231   "Return the depth to which a statement is nested in the outline.
 232 Point must be at the beginning of a header line.  This is actually
 233 the column number of the end of what `outline-regexp matches'."
 234   (save-excursion
 235     (looking-at outline-regexp)
 236     (save-excursion (goto-char (match-end 0)) (current-column))))
 237
 238 (defun outline-next-preface ()
 239   "Skip forward to just before the next heading line."
 240   (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)")
 241                          nil 'move)
 242       (progn
 243         (goto-char (match-beginning 0))
 244         (if (memq (preceding-char) '(?\n ?\^M))
 245             (forward-char -1)))))
 246
 247 (defun outline-next-heading ()
 248   "Move to the next (possibly invisible) heading line."
 249   (interactive)
 250   (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)")
 251                          nil 'move)
 252       (goto-char (1+ (match-beginning 0)))))
 253
 254 (defun outline-back-to-heading ()
 255   "Move to previous heading line, or beg of this line if it's a heading.
 256 Only visible heading lines are considered."
 257   (beginning-of-line)
 258   (or (outline-on-heading-p)
 259       (re-search-backward (concat "^\\(" outline-regexp "\\)") nil 'move)))
 260
 261 (defun outline-on-heading-p ()
 262   "Return T if point is on a (visible) heading line."
 263   (save-excursion
 264     (beginning-of-line)
 265     (and (bobp)
 266          (looking-at outline-regexp))))
 267
 268 (defun outline-end-of-heading ()
 269   (if (re-search-forward outline-heading-end-regexp nil 'move)
 270       (forward-char -1)))
 271
 272 (defun outline-next-visible-heading (arg)
 273   "Move to the next visible heading line.
 274 With argument, repeats or can move backward if negative.
 275 A heading line is one that starts with a `*' (or that
 276 `outline-regexp' matches)."
 277   (interactive "p")
 278   (if (< arg 0)
 279       (beginning-of-line)
 280     (end-of-line))
 281   (re-search-forward (concat "^\\(" outline-regexp "\\)") nil nil arg)
 282   (beginning-of-line))
 283
 284 (defun outline-previous-visible-heading (arg)
 285   "Move to the previous heading line.
 286 With argument, repeats or can move forward if negative.
 287 A heading line is one that starts with a `*' (or that
 288 `outline-regexp' matches)."
 289   (interactive "p")
 290   (outline-next-visible-heading (- arg)))
 291
 292 (defun outline-flag-region (from to flag)
 293   "Hides or shows lines from FROM to TO, according to FLAG.
 294 If FLAG is `\\n' (newline character) then text is shown,
 295 while if FLAG is `\\^M' (control-M) the text is hidden."
 296   (let (buffer-read-only)
 297     (subst-char-in-region from to
 298                           (if (= flag ?\n) ?\^M ?\n)
 299                           flag t)))
 300 \f
 301 (defun hide-entry ()
 302   "Hide the body directly following this heading."
 303   (interactive)
 304   (outline-back-to-heading)
 305   (outline-end-of-heading)
 306   (save-excursion
 307    (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\^M)))
 308
 309 (defun show-entry ()
 310   "Show the body directly following this heading."
 311   (interactive)
 312   (save-excursion
 313    (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\n)))
 314
 315 (defun hide-body ()
 316   "Hide all of buffer except headings."
 317   (interactive)
 318   (hide-region-body (point-min) (point-max)))
 319
 320 (defun hide-region-body (start end)
 321   "Hide all body lines in the region, but not headings."
 322   (save-excursion
 323     (save-restriction
 324       (narrow-to-region start end)
 325       (goto-char (point-min))
 326       (if (outline-on-heading-p)
 327           (outline-end-of-heading))
 328       (while (not (eobp))
 329         (outline-flag-region (point)
 330                              (progn (outline-next-preface) (point)) ?\^M)
 331         (if (not (eobp))
 332             (progn
 333               (forward-char
 334                (if (looking-at "[\n\^M][\n\^M]")
 335                    2 1))
 336               (outline-end-of-heading)))))))
 337
 338 (defun show-all ()
 339   "Show all of the text in the buffer."
 340   (interactive)
 341   (outline-flag-region (point-min) (point-max) ?\n))
 342
 343 (defun hide-subtree ()
 344   "Hide everything after this heading at deeper levels."
 345   (interactive)
 346   (outline-flag-subtree ?\^M))
 347
 348 (defun hide-leaves ()
 349   "Hide all body after this heading at deeper levels."
 350   (interactive)
 351   (outline-back-to-heading)
 352   (outline-end-of-heading)
 353   (hide-region-body (point) (progn (outline-end-of-subtree) (point))))
 354
 355 (defun show-subtree ()
 356   "Show everything after this heading at deeper levels."
 357   (interactive)
 358   (outline-flag-subtree ?\n))
 359
 360 (defun hide-sublevels (levels)
 361   "Hide everything except the top LEVELS levels of headers."
 362   (interactive "p")
 363   (if (< levels 1)
 364       (error "Must keep at least one level of headers"))
 365   (setq levels (1- levels))
 366   (save-excursion
 367     (goto-char (point-min))
 368     (hide-subtree)
 369     (show-children levels)
 370     (condition-case err
 371       (while (outline-get-next-sibling)
 372         (hide-subtree)
 373         (show-children levels))
 374       (error nil))))
 375
 376 (defun hide-other ()
 377   "Hide everything except for the current body and the parent headings."
 378   (interactive)
 379   (outline-hide-sublevels 1)
 380   (let ((last (point))
 381         (pos (point)))
 382     (while (save-excursion
 383              (and (re-search-backward "[\n\r]" nil t)
 384                   (eq (following-char) ?\r)))
 385       (save-excursion
 386         (beginning-of-line)
 387         (if (eq last (point))
 388             (progn
 389               (outline-next-heading)
 390               (outline-flag-region last (point) ?\n))
 391           (show-children)
 392           (setq last (point)))))))
 393
 394 (defun outline-flag-subtree (flag)
 395   (save-excursion
 396     (outline-back-to-heading)
 397     (outline-end-of-heading)
 398     (outline-flag-region (point)
 399                           (progn (outline-end-of-subtree) (point))
 400                           flag)))
 401
 402 (defun outline-end-of-subtree ()
 403   (outline-back-to-heading)
 404   (let ((opoint (point))
 405         (first t)
 406         (level (funcall outline-level)))
 407     (while (and (not (eobp))
 408                 (or first (> (funcall outline-level) level)))
 409       (setq first nil)
 410       (outline-next-heading))
 411     (if (eobp)
 412         nil
 413       ;; go to end of line before heading
 414       (forward-char -1)
 415       ;; skip preceding balnk line, if there is one
 416       (if (memq (preceding-char) '(?\n ?\^M))
 417           (forward-char -1)))))
 418 \f
 419 (defun show-branches ()
 420   "Show all subheadings of this heading, but not their bodies."
 421   (interactive)
 422   (show-children 1000))
 423
 424 (defun show-children (&optional level)
 425   "Show all direct subheadings of this heading.
 426 Prefix arg LEVEL is how many levels below the current level should be shown.
 427 Default is enough to cause the following heading to appear."
 428   (interactive "P")
 429   (setq level
 430         (if level (prefix-numeric-value level)
 431           (save-excursion
 432             (outline-back-to-heading)
 433             (let ((start-level (funcall outline-level)))
 434               (outline-next-heading)
 435               (if (eobp)
 436                   1
 437                 (max 1 (- (funcall outline-level) start-level)))))))
 438   (save-excursion
 439     (save-restriction
 440       (outline-back-to-heading)
 441       (setq level (+ level (funcall outline-level)))
 442       (narrow-to-region (point)
 443                         (progn (outline-end-of-subtree)
 444                                (if (eobp) (point-max) (1+ (point)))))
 445       (goto-char (point-min))
 446       (while (and (not (eobp))
 447                   (progn
 448                     (outline-next-heading)
 449                     (not (eobp))))
 450         (if (<= (funcall outline-level) level)
 451             (save-excursion
 452               (outline-flag-region (save-excursion
 453                                      (forward-char -1)
 454                                      (if (memq (preceding-char) '(?\n ?\^M))
 455                                          (forward-char -1))
 456                                      (point))
 457                                    (progn (outline-end-of-heading) (point))
 458                                    ?\n)))))))
 459 \f
 460 (defun outline-up-heading (arg)
 461   "Move to the heading line of which the present line is a subheading.
 462 With argument, move up ARG levels."
 463   (interactive "p")
 464   (outline-back-to-heading)
 465   (if (eq (funcall outline-level) 1)
 466       (error ""))
 467     (while (and (> (funcall outline-level) 1)
 468                 (> arg 0)
 469                 (not (bobp)))
 470       (let ((present-level (funcall outline-level)))
 471         (while (not (< (funcall outline-level) present-level))
 472           (outline-previous-visible-heading 1))
 473         (setq arg (- arg 1)))))
 474
 475 (defun outline-forward-same-level (arg)
 476   "Move forward to the ARG'th subheading from here of the same level as the
 477 present one. It stops at the first and last subheadings of a superior heading."
 478   (interactive "p")
 479   (outline-back-to-heading)
 480   (while (> arg 0)
 481     (let ((point-to-move-to (save-excursion
 482                               (outline-get-next-sibling))))
 483       (if point-to-move-to
 484           (progn
 485             (goto-char point-to-move-to)
 486             (setq arg (1- arg)))
 487         (progn
 488           (setq arg 0)
 489           (error ""))))))
 490
 491 (defun outline-get-next-sibling ()
 492   "Position the point at the next heading of the same level,
 493 and return that position or nil if it cannot be found."
 494   (let ((level (funcall outline-level)))
 495     (outline-next-visible-heading 1)
 496     (while (and (> (funcall outline-level) level)
 497                 (not (eobp)))
 498       (outline-next-visible-heading 1))
 499     (if (< (funcall outline-level) level)
 500         nil
 501       (point))))
 502
 503 (defun outline-backward-same-level (arg)
 504   "Move backward to the ARG'th subheading from here of the same level as the
 505 present one. It stops at the first and last subheadings of a superior heading."
 506   (interactive "p")
 507   (outline-back-to-heading)
 508   (while (> arg 0)
 509     (let ((point-to-move-to (save-excursion
 510                               (outline-get-last-sibling))))
 511       (if point-to-move-to
 512           (progn
 513             (goto-char point-to-move-to)
 514             (setq arg (1- arg)))
 515         (progn
 516           (setq arg 0)
 517           (error ""))))))
 518
 519 (defun outline-get-last-sibling ()
 520   "Position the point at the previous heading of the same level,
 521 and return that position or nil if it cannot be found."
 522   (let ((level (funcall outline-level)))
 523     (outline-previous-visible-heading 1)
 524     (while (and (> (funcall outline-level) level)
 525                 (not (bobp)))
 526       (outline-previous-visible-heading 1))
 527     (if (< (funcall outline-level) level)
 528         nil
 529         (point))))
 530
 531 (provide 'outline)
 532
 533 ;;; outline.el ends here