X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/0b6db30be256ae75dcfe13058d18fe0780dff984..6b04bd6eec639d158e3dbb4de3d77b2b8dde3e6a:/lisp/foldout.el diff --git a/lisp/foldout.el b/lisp/foldout.el index c43c295e25..7666ee48bc 100644 --- a/lisp/foldout.el +++ b/lisp/foldout.el @@ -1,11 +1,13 @@ -;;; foldout.el --- Folding extensions for outline-mode and outline-minor-mode. +;;; foldout.el --- folding extensions for outline-mode and outline-minor-mode -;; Copyright (C) 1994 Free Software Foundation, Inc. +;; Copyright (C) 1994, 2002, 2003, 2004, 2005, +;; 2006 Free Software Foundation, Inc. ;; Author: Kevin Broadey +;; Maintainer: FSF ;; Created: 27 Jan 1994 -;; Version: foldout.el 1.8 dated 94/03/15 at 13:30:59 -;; Keywords: folding, outline +;; Version: foldout.el 1.10 dated 94/05/19 at 17:09:12 +;; Keywords: folding, outlines ;; This file is part of GNU Emacs. @@ -20,8 +22,9 @@ ;; 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. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -120,7 +123,19 @@ ;;; ChangeLog: -;; 1.8 15-Mar-94 +;; 1.10 21-Mar-94 +;; foldout.el is now part of the GNU Emacs distribution!! +;; Put in changes made by RMS to version 1.8 to keep the diffs to a minimum. +;; bugfix: numeric arg to foldout-exit-fold wasn't working - looks like I don't +;; know how to use the Common LISP `loop' macro after all, so use `while' +;; instead. + +;; 1.9 15-Mar-94 +;; Didn't test that very well, did I? The change to foldout-zoom-subtree +;; affected foldout-mouse-zoom: if the heading under the `level n' one clicked +;; on was at `level n+2' then it didn't get exposed. Sorry about that! + +;; 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 @@ -201,12 +216,12 @@ (if (not (boundp 'outline-minor-mode)) (error "Can't find outline-minor-mode")) -(defconst foldout-fold-list nil +(defvar 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).") +An end marker of nil means the fold ends after (point-max).") (make-variable-buffer-local 'foldout-fold-list) -(defconst foldout-modeline-string nil +(defvar foldout-modeline-string nil "Modeline string announcing that we are in an outline fold.") (make-variable-buffer-local 'foldout-modeline-string) @@ -223,6 +238,15 @@ An end marker of NIL means the fold ends after (point-max).") ;; slip our fold announcement into the list (setcdr outl-entry (nconc foldout-entry (cdr outl-entry))) )) + +;; outline-flag-region has different `flag' values in outline.el and +;; noutline.el for hiding and showing text. + +(defconst foldout-hide-flag + (if (featurep 'noutline) t ?\^M)) + +(defconst foldout-show-flag + (if (featurep 'noutline) nil ?\n)) (defun foldout-zoom-subtree (&optional exposure) @@ -247,7 +271,7 @@ optional arg EXPOSURE \(interactively with prefix arg\) changes this:- ;; 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 + ;; 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)))) ) @@ -286,7 +310,8 @@ optional arg EXPOSURE \(interactively with prefix arg\) changes this:- 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)) + (let ((hide-fold t) start-marker end-marker + beginning-of-heading end-of-subtree) ;; check there are some folds to leave (if (null foldout-fold-list) @@ -296,7 +321,7 @@ exited and text is left visible." ;; 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 @@ -308,59 +333,53 @@ exited and text is left visible." ;; 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)) + (while (not (zerop num-folds)) + ;; 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. + (when (zerop num-folds) + (if end-marker + (setq beginning-of-heading (point) + end-of-subtree (progn (forward-char -1) + (if (memq (preceding-char) + '(?\n ?\^M)) + (forward-char -1)) + (point)))) + ;; hide the subtree + (when hide-fold + (goto-char start-marker) + (hide-subtree)) + + ;; make sure the next heading is exposed + (if end-marker + (outline-flag-region end-of-subtree beginning-of-heading + foldout-show-flag))) + + ;; zap the markers so they don't slow down editing + (set-marker start-marker nil) + (if end-marker (set-marker end-marker nil)) + ) ;; narrow to the enclosing fold if there is one (if foldout-fold-list @@ -420,7 +439,7 @@ How much is exposed by the zoom depends on the number of mouse clicks:- (let ((nclicks (event-click-count event))) (cond ((= nclicks 1) -1) ; body only - ((= nclicks 2) +1) ; subheadings only + ((= nclicks 2) '(1)) ; subheadings only ((= nclicks 3) nil) ; body and subheadings (t 0))))) ; entire subtree @@ -498,7 +517,7 @@ if the event didn't occur on a heading." ;;; Keymaps: (defvar foldout-inhibit-key-bindings nil - "Set non-NIL before loading foldout to inhibit key bindings.") + "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. @@ -512,11 +531,12 @@ Valid modifiers are shift, control, meta, alt, hyper and super.") () (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 ((map (lookup-key outline-minor-mode-map outline-minor-mode-prefix))) + (unless map + (setq map (make-sparse-keymap)) + (define-key outline-minor-mode-map outline-minor-mode-prefix map)) + (define-key map "\C-z" 'foldout-zoom-subtree) + (define-key map "\C-x" 'foldout-exit-fold)) (let* ((modifiers (apply 'concat (mapcar (function (lambda (modifier) @@ -547,4 +567,5 @@ Valid modifiers are shift, control, meta, alt, hyper and super.") (provide 'foldout) +;;; arch-tag: 19d095a2-1f09-42a7-a5ac-e2a3078cfe95 ;;; foldout.el ends here