]> code.delx.au - gnu-emacs/blobdiff - lisp/foldout.el
(Abbrevs): A @node line without explicit Prev, Next, and Up links.
[gnu-emacs] / lisp / foldout.el
index b6ff0a02a1802c674243e4395d5b5eda4c35fbb5..7666ee48bc7a43ad7b88afdc28295cca2a2f08d6 100644 (file)
@@ -1,23 +1,19 @@
-;;; 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 Kevin Broadey.
+;; Copyright (C) 1994, 2002, 2003, 2004, 2005,
+;;   2006 Free Software Foundation, Inc.
 
 ;; Author: Kevin Broadey <KevinB@bartley.demon.co.uk>
+;; 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
 
-;; 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.
+;; 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)
+;; the Free Software Foundation; either version 2, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -26,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:
 
 
 ;;; 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
 (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)
 
@@ -229,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))
 \f
 
 (defun foldout-zoom-subtree (&optional exposure)
@@ -253,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))))
           )
@@ -292,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)
@@ -302,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
@@ -314,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
@@ -426,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
 
@@ -504,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.
@@ -518,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)
@@ -553,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