diff --git a/lisp/foldout.el b/lisp/foldout.el new file mode 100644 index 00000000000..b6ff0a02a18 --- /dev/null +++ b/lisp/foldout.el @@ -0,0 +1,556 @@ +;;; foldout.el --- Folding extensions for outline-mode and outline-minor-mode. + +;; Copyright (C) 1994 Kevin Broadey. + +;; Author: Kevin Broadey +;; Created: 27 Jan 1994 +;; Version: foldout.el 1.8 dated 94/03/15 at 13:30:59 +;; Keywords: folding, outline + +;; LCD Archive Entry: +;; foldout|Kevin Broadey|KevinB@bartley.demon.co.uk| +;; Folding editor extensions for outline-mode and outline-minor-mode| +;; Date: 94/03/15|Version: 1.8|~/misc/foldout.el.Z| + +;; This file is not part of GNU Emacs, but it is distributed under the same +;; conditions. + +;; 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. + +;;; Commentary: + +;; This file provides folding editor extensions for outline-mode and +;; outline-minor-mode buffers. What's a "folding editor"? Read on... +;; +;; Imagine you're in an outline-mode buffer and you've hidden all the text and +;; subheadings under your level-1 headings. You now want to look at the stuff +;; hidden under one of these headings. Normally you'd do C-c C-e (show-entry) +;; to expose the body or C-c C-i to expose the child (level-2) headings. +;; +;; With foldout, you do C-c C-z (foldout-zoom-subtree). This exposes the body +;; and child subheadings and narrows the buffer so that only the level-1 +;; heading, the body and the level-2 headings are visible. If you now want to +;; look under one of the level-2 headings, position the cursor on it and do C-c +;; C-z again. This exposes the level-2 body and its level-3 child subheadings +;; and narrows the buffer again. You can keep on zooming in on successive +;; subheadings as much as you like. A string in the modeline tells you how +;; deep you've gone. +;; +;; When zooming in on a heading you might only want to see the child +;; subheadings. You do this by specifying a numeric argument: C-u C-c C-z. +;; You can specify the number of levels of children too (c.f. show-children): +;; e.g. M-2 C-c C-z exposes two levels of child subheadings. Alternatively, +;; you might only be interested in the body. You do this by specifying a +;; negative argument: M-- C-c C-z. You can also cause the whole subtree to be +;; expanded, similar to C-c C-s (show-subtree), by specifying a zero argument: +;; M-0 C-c C-z. +;; +;; While you're zoomed in you can still use outline-mode's exposure and hiding +;; functions. It won't upset foldout at all. Also, since the buffer is +;; narrowed, "global" editing actions will only affect the stuff under the +;; zoomed-in heading. This is useful for restricting changes to a particular +;; chapter or section of your document. +;; +;; You unzoom (exit) a fold by doing C-c C-x (foldout-exit-fold). This hides +;; all the text and subheadings under the top-level heading and returns you to +;; the previous view of the buffer. Specifying a numeric argument exits that +;; many folds. Specifying a zero argument exits *all* folds. +;; +;; You might want to exit a fold *without* hiding the text and subheadings. +;; You do this by specifying a negative argument. For example, M--2 C-c C-x +;; exits two folds and leaves the text and subheadings exposed. +;; +;; Foldout also provides mouse bindings for entering and exiting folds and for +;; showing and hiding text. Hold down Meta and Control, then click a mouse +;; button as follows:- +;; +;; mouse-1 (foldout-mouse-zoom) zooms in on the heading clicked on:- +;; +;; single click expose body +;; double click expose subheadings +;; triple click expose body and subheadings +;; quad click expose entire subtree +;; +;; mouse-2 (foldout-mouse-show) exposes text under the heading clicked on:- +;; +;; single click expose body +;; double click expose subheadings +;; triple click expose body and subheadings +;; quad click expose entire subtree +;; +;; mouse-3 (foldout-mouse-hide-or-exit) hides text under the heading clicked +;; on or exits the fold:- +;; +;; single click hide subtree +;; double click exit fold and hide text +;; triple click exit fold without hiding text +;; quad click exit all folds and hide text +;; +;; You can change the modifier keys used by setting `foldout-mouse-modifiers'. + +;;; Installation: + +;; To use foldout, put this in your .emacs:- +;; +;; (require 'foldout) +;; +;; If you don't want it loaded until you need it, try this instead:- +;; +;; (eval-after-load "outline" '(require 'foldout)) + +;;; Advertisements: + +;; Get out-xtra.el by Per Abrahamsen for more +;; outline-mode goodies. In particular, `outline-hide-sublevels' makes +;; setup a lot easier. +;; +;; folding.el by Jamie Lokier supports folding by +;; recognising special marker text in you file. +;; +;; c-outline.el (by me) provides outline-mode support to recognise `C' +;; statements as outline headings, so with foldout you can have a folding `C' +;; code editor without having to put in start- and end-of-fold markers. This +;; is a real winner! + +;;; ChangeLog: + +;; 1.8 15-Mar-94 +;; Changed meaning of prefix arg to foldout-zoom-subtree. arg > 0 now means +;; "expose that many children" instead of just "expose children" so it is more +;; like `show-children' (C-c C-i). Arg of C-u on its own only shows one level +;; of children, though, so you can still zoom by doing C-u C-c C-z. +;; +;; I can't think of a good meaning for the value of a negative prefix. Any +;; suggestions? +;; +;; Added advertisement for my c-outline.el package. Now you can have a folding +;; editor for c-mode without any effort! + +;; 1.7 7-Mar-94 +;; I got fed up trying to work out how many blank lines there were outside the +;; narrowed region when inside a fold. Now *all* newlines before the following +;; heading are *in* the narrowed region. Thus, if the cursor is at point-max, +;; the number of blank lines above it is the number you'll get above the next +;; heading. +;; +;; Since all newlines are now inside the narrowed region, when exiting a fold +;; add a newline at the end of the region if there isn't one so that the +;; following heading doesn't accidentally get joined to the body text. +;; +;; Bugfix: `foldout-mouse-modifiers' should be `defvar', not `defconst'. +;; +;; Use "cond" instead of "case" so that lemacs-19.9 users can use the mouse. +;; +;; Improve "Commentary" entry on using the mouse. +;; +;; Add "Installation" keyword. + +;; 1.6 3-Mar-94 +;; Add mouse support functions foldout-mouse-zoom, foldout-mouse-show, +;; foldout-mouse-hide-or-exit. + +;; 1.5 11-Feb-94 +;; Rename `foldout-enter-subtree' to `foldout-zoom-subtree' and change +;; keystroke from C-g to C-z. This is more mnemonic and leaves C-g alone, as +;; users expect this to cancel the current key sequence. +;; +;; Added better commentary at the request of RMS. Added stuff to comply with +;; the lisp-mnt.el conventions. Added instructions on how best to load the +;; package. + +;; 1.4 2-Feb-94 +;; Bugfix: end-of-fold marking was wrong:- +;; +;; End of narrowed region should be one character on from +;; (outline-end-of-subtree) so it includes the end-of-line at the end of the +;; last line of the subtree. +;; +;; End-of-fold marker should be outside the narrowed region so text inserted +;; at the end of the region goes before the marker. Need to make a special +;; case for end-of-buffer because it is impossible to set a marker that will +;; follow eob. Bummer. + +;; 1.3 28-Jan-94 +;; Changed `foldout-zoom-subtree'. A zero arg now makes it expose the entire +;; subtree on entering the fold. As before, < 0 shows only the body and > 0 +;; shows only the subheadings. + +;; 1.2 28-Jan-94 +;; Fixed a dumb bug - didn't make `foldout-modeline-string' buffer-local :-( +;; +;; Changed `foldout-exit-fold' to use prefix arg to say how many folds to exit. +;; Negative arg means exit but don't hide text. Zero arg means exit all folds. +;; +;; Added `foldout-inhibit-key-bindings' to inhibit key bindings. + +;; 1.1 27-Jan-94 +;; Released to the net. Inspired by a question in gnu.emacs.help from +;; Jason D Lohn . + +;;; Code: + +(require 'outline) + +;; something has gone very wrong if outline-minor-mode isn't bound now. +(if (not (boundp 'outline-minor-mode)) + (error "Can't find outline-minor-mode")) + +(defconst foldout-fold-list nil + "List of start and end markers for the folds currently entered. +An end marker of NIL means the fold ends after (point-max).") +(make-variable-buffer-local 'foldout-fold-list) + +(defconst foldout-modeline-string nil + "Modeline string announcing that we are in an outline fold.") +(make-variable-buffer-local 'foldout-modeline-string) + +;; put our minor mode string immediately following outline-minor-mode's +(or (assq 'foldout-modeline-string minor-mode-alist) + (let ((outl-entry (memq (assq 'outline-minor-mode minor-mode-alist) + minor-mode-alist)) + (foldout-entry '((foldout-modeline-string foldout-modeline-string)))) + + ;; something's wrong with outline if we can't find it + (if (null outl-entry) + (error "Can't find outline-minor-mode in minor-mode-alist")) + + ;; slip our fold announcement into the list + (setcdr outl-entry (nconc foldout-entry (cdr outl-entry))) + )) + + +(defun foldout-zoom-subtree (&optional exposure) + "Open the subtree under the current heading and narrow to it. + +Normally the body and the immediate subheadings are exposed, but +optional arg EXPOSURE \(interactively with prefix arg\) changes this:- + + EXPOSURE > 0 exposes n levels of subheadings (c.f. show-children) + EXPOSURE < 0 exposes only the body + EXPOSURE = 0 exposes the entire subtree" + (interactive "P") + (save-excursion + (widen) + (outline-back-to-heading) + (let* ((exposure-value (prefix-numeric-value exposure)) + (start (point)) + (start-marker (point-marker)) + (end (progn (outline-end-of-subtree) + (skip-chars-forward "\n\^M") + (point))) + ;; I need a marker that will follow the end of the region even when + ;; text is inserted right at the end. Text gets inserted *after* + ;; markers, so I need it at end+1. Unfortunately I can't set a + ;; marker at (point-max)+1, so I use NIL to mean the region ends at + ;; (point-max). + (end-marker (if (eobp) nil (set-marker (make-marker) (1+ end)))) + ) + + ;; narrow to this subtree + (narrow-to-region start end) + + ;; show the body and/or subheadings for this heading + (goto-char start) + (cond + ((null exposure) + (show-entry) + (show-children)) + ((< exposure-value 0) + (show-entry)) + ((consp exposure) + (show-children)) + ((> exposure-value 0) + (show-children exposure-value)) + (t + (show-subtree)) + ) + + ;; save the location of the fold we are entering + (setq foldout-fold-list (cons (cons start-marker end-marker) + foldout-fold-list)) + + ;; update the modeline + (foldout-update-modeline) + ))) + + +(defun foldout-exit-fold (&optional num-folds) + "Return to the ARG'th enclosing fold view. With ARG = 0 exit all folds. + +Normally causes exited folds to be hidden, but with ARG < 0, -ARG folds are +exited and text is left visible." + (interactive "p") + (let (start-marker end-marker (hide-fold t)) + + ;; check there are some folds to leave + (if (null foldout-fold-list) + (error "Not in a fold!")) + + (cond + ;; catch a request to leave all folds + ((zerop num-folds) + (setq num-folds (length foldout-fold-list))) + + ;; have we been told not to hide the fold? + ((< num-folds 0) + (setq hide-fold nil + num-folds (- num-folds))) + ) + + ;; limit the number of folds if we've been told to exit too many + (setq num-folds (min num-folds (length foldout-fold-list))) + + ;; exit the folds + (widen) + (loop + always (progn + ;; get the fold at the top of the stack + (setq start-marker (car (car foldout-fold-list)) + end-marker (cdr (car foldout-fold-list)) + foldout-fold-list (cdr foldout-fold-list) + num-folds (1- num-folds)) + + ;; Make sure there is a newline at the end of this fold, + ;; otherwise the following heading will get joined to the body + ;; text. + (if end-marker + (progn + (goto-char end-marker) + (forward-char -1) + (or (memq (preceding-char) '(?\n ?\^M)) + (insert ?\n)))) + + ;; If this is the last fold to exit, hide the text unless we've + ;; been told not to. Note that at the moment point is at the + ;; beginning of the following heading if there is one. + + ;; Also, make sure that the newline before the following heading + ;; is \n otherwise it will be hidden. If there is a newline + ;; before this one, make it visible too so we do the same as + ;; outline.el and leave a blank line before the heading. + (if (zerop num-folds) + (let ((beginning-of-heading (point)) + (end-of-subtree (if end-marker + (progn + (forward-char -1) + (if (memq (preceding-char) + '(?\n ?\^M)) + (forward-char -1)) + (point)) + (point-max)))) + ;; hide the subtree + (if hide-fold + (outline-flag-region start-marker end-of-subtree ?\^M)) + + ;; make sure the next heading is exposed + (if end-marker + (outline-flag-region end-of-subtree + beginning-of-heading ?\n)) + )) + + ;; zap the markers so they don't slow down editing + (set-marker start-marker nil) + (if end-marker (set-marker end-marker nil)) + ) + + ;; have we exited enough folds? + until (zerop num-folds)) + + ;; narrow to the enclosing fold if there is one + (if foldout-fold-list + (progn + (setq start-marker (car (car foldout-fold-list)) + end-marker (cdr (car foldout-fold-list))) + (narrow-to-region start-marker + (if end-marker + (1- (marker-position end-marker)) + (point-max))) + )) + (recenter) + + ;; update the modeline + (foldout-update-modeline) + )) + + +(defun foldout-update-modeline () + "Set the modeline string to indicate our fold depth." + (let ((depth (length foldout-fold-list))) + (setq foldout-modeline-string + (cond + ;; if we're not in a fold, keep quiet + ((zerop depth) + nil) + ;; in outline-minor-mode we're after "Outl:xx" in the modeline + (outline-minor-mode + (format ":%d" depth)) + ;; otherwise just announce the depth (I guess we're in outline-mode) + ((= depth 1) + " Inside 1 fold") + (t + (format " Inside %d folds" depth)) + )))) + + +(defun foldout-mouse-zoom (event) + "Zoom in on the heading clicked on. + +How much is exposed by the zoom depends on the number of mouse clicks:- + + 1 expose body + 2 expose subheadings + 3 expose body and subheadings + 4 expose entire subtree" + (interactive "@e") + + ;; swallow intervening mouse events so we only get the final click-count. + (setq event (foldout-mouse-swallow-events event)) + + ;; go to the heading clicked on + (foldout-mouse-goto-heading event) + + ;; zoom away + (foldout-zoom-subtree + (let ((nclicks (event-click-count event))) + (cond + ((= nclicks 1) -1) ; body only + ((= nclicks 2) +1) ; subheadings only + ((= nclicks 3) nil) ; body and subheadings + (t 0))))) ; entire subtree + +(defun foldout-mouse-show (event) + "Show what is hidden under the heading clicked on. + +What gets exposed depends on the number of mouse clicks:- + + 1 expose body + 2 expose subheadings + 3 expose body and subheadings + 4 expose entire subtree" + (interactive "@e") + + ;; swallow intervening mouse events so we only get the final click-count. + (setq event (foldout-mouse-swallow-events event)) + + ;; expose the text + (foldout-mouse-goto-heading event) + (let ((nclicks (event-click-count event))) + (cond + ((= nclicks 1) (show-entry)) + ((= nclicks 2) (show-children)) + ((= nclicks 3) (show-entry) (show-children)) + (t (show-subtree))))) + +(defun foldout-mouse-hide-or-exit (event) + "Hide the subtree under the heading clicked on, or exit a fold. + +What happens depends on the number of mouse clicks:- + + 1 hide subtree + 2 exit fold and hide text + 3 exit fold without hiding text + 4 exit all folds and hide text" + (interactive "@e") + + ;; swallow intervening mouse events so we only get the final click-count. + (setq event (foldout-mouse-swallow-events event)) + + ;; hide or exit + (let ((nclicks (event-click-count event))) + (if (= nclicks 1) + (progn + (foldout-mouse-goto-heading event) + (hide-subtree)) + (foldout-exit-fold + (cond + ((= nclicks 2) 1) ; exit and hide + ((= nclicks 3) -1) ; exit don't hide + (t 0)))))) ; exit all + + +(defun foldout-mouse-swallow-events (event) + "Swallow intervening mouse events so we only get the final click-count. +Signal an error if the final event isn't the same type as the first one." + (let ((initial-event-type (event-basic-type event))) + (while (null (sit-for 0 double-click-time 'nodisplay)) + (setq event (read-event))) + (or (eq initial-event-type (event-basic-type event)) + (error ""))) + event) + +(defun foldout-mouse-goto-heading (event) + "Go to the heading where the mouse event started. Signal an error +if the event didn't occur on a heading." + (goto-char (posn-point (event-start event))) + (or (outline-on-heading-p) + ;; outline.el sometimes treats beginning-of-buffer as a heading + ;; even though outline-on-heading returns nil. + (save-excursion (beginning-of-line) (bobp)) + (error "Not a heading line"))) + + +;;; Keymaps: + +(defvar foldout-inhibit-key-bindings nil + "Set non-NIL before loading foldout to inhibit key bindings.") + +(defvar foldout-mouse-modifiers '(meta control) + "List of modifier keys to apply to foldout's mouse events. + +The default (meta control) makes foldout bind its functions to +M-C-down-mouse-{1,2,3}. + +Valid modifiers are shift, control, meta, alt, hyper and super.") + +(if foldout-inhibit-key-bindings + () + (define-key outline-mode-map "\C-c\C-z" 'foldout-zoom-subtree) + (define-key outline-mode-map "\C-c\C-x" 'foldout-exit-fold) + (define-key outline-minor-mode-map + (concat outline-minor-mode-prefix "\C-z") 'foldout-zoom-subtree) + (define-key outline-minor-mode-map + (concat outline-minor-mode-prefix "\C-x") 'foldout-exit-fold) + + (let* ((modifiers (apply 'concat + (mapcar (function + (lambda (modifier) + (vector + (cond + ((eq modifier 'shift) ?S) + ((eq modifier 'control) ?C) + ((eq modifier 'meta) ?M) + ((eq modifier 'alt) ?A) + ((eq modifier 'hyper) ?H) + ((eq modifier 'super) ?s) + (t (error "invalid mouse modifier %s" + modifier))) + ?-))) + foldout-mouse-modifiers))) + (mouse-1 (vector (intern (concat modifiers "down-mouse-1")))) + (mouse-2 (vector (intern (concat modifiers "down-mouse-2")))) + (mouse-3 (vector (intern (concat modifiers "down-mouse-3"))))) + + (define-key outline-mode-map mouse-1 'foldout-mouse-zoom) + (define-key outline-mode-map mouse-2 'foldout-mouse-show) + (define-key outline-mode-map mouse-3 'foldout-mouse-hide-or-exit) + + (define-key outline-minor-mode-map mouse-1 'foldout-mouse-zoom) + (define-key outline-minor-mode-map mouse-2 'foldout-mouse-show) + (define-key outline-minor-mode-map mouse-3 'foldout-mouse-hide-or-exit) + )) + +(provide 'foldout) + +;;; foldout.el ends here