X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/0ff9b955fe8d8032f5c139dcc86990f0177b646f..058f56d24f776bdc25bcac86fe1f8969a78374e9:/lisp/foldout.el diff --git a/lisp/foldout.el b/lisp/foldout.el index f1905b79a7..e0ca41acf0 100644 --- a/lisp/foldout.el +++ b/lisp/foldout.el @@ -1,18 +1,19 @@ ;;; foldout.el --- folding extensions for outline-mode and outline-minor-mode -;; Copyright (C) 1994 Free Software Foundation, Inc. +;; Copyright (C) 1994, 2001-2014 Free Software Foundation, Inc. ;; Author: Kevin Broadey +;; Maintainer: emacs-devel@gnu.org ;; Created: 27 Jan 1994 -;; Version: foldout.el 1.10 dated 94/05/19 at 17:09:12 +;; Version: 1.10 ;; Keywords: folding, outlines ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, 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 @@ -20,9 +21,7 @@ ;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -40,7 +39,7 @@ ;; 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 +;; subheadings as much as you like. A string in the mode line tells you how ;; deep you've gone. ;; ;; When zooming in on a heading you might only want to see the child @@ -112,9 +111,9 @@ ;; setup a lot easier. ;; ;; folding.el by Jamie Lokier supports folding by -;; recognising special marker text in you file. +;; recognizing special marker text in you file. ;; -;; c-outline.el (by me) provides outline-mode support to recognise `C' +;; c-outline.el (by me) provides outline-mode support to recognize `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! @@ -195,7 +194,7 @@ ;; shows only the subheadings. ;; 1.2 28-Jan-94 -;; Fixed a dumb bug - didn't make `foldout-modeline-string' buffer-local :-( +;; Fixed a dumb bug - didn't make `foldout-mode-line-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. @@ -214,20 +213,20 @@ (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).") (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) +(defvar foldout-mode-line-string nil + "Mode line string announcing that we are in an outline fold.") +(make-variable-buffer-local 'foldout-mode-line-string) ;; put our minor mode string immediately following outline-minor-mode's -(or (assq 'foldout-modeline-string minor-mode-alist) +(or (assq 'foldout-mode-line-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)))) + (foldout-entry '((foldout-mode-line-string foldout-mode-line-string)))) ;; something's wrong with outline if we can't find it (if (null outl-entry) @@ -297,8 +296,8 @@ optional arg EXPOSURE \(interactively with prefix arg\) changes this:- (setq foldout-fold-list (cons (cons start-marker end-marker) foldout-fold-list)) - ;; update the modeline - (foldout-update-modeline) + ;; update the mode line + (foldout-update-mode-line) ))) @@ -308,7 +307,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) @@ -318,7 +318,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 @@ -355,31 +355,27 @@ exited and text is left visible." ;; 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 - foldout-hide-flag)) - - ;; make sure the next heading is exposed - (if end-marker - (outline-flag-region end-of-subtree beginning-of-heading - foldout-show-flag)) - )) + (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)) - ) + (if end-marker (set-marker end-marker nil))) ;; narrow to the enclosing fold if there is one (if foldout-fold-list @@ -389,32 +385,29 @@ exited and text is left visible." (narrow-to-region start-marker (if end-marker (1- (marker-position end-marker)) - (point-max))) - )) + (point-max))))) (recenter) - ;; update the modeline - (foldout-update-modeline) - )) + ;; update the mode line + (foldout-update-mode-line))) -(defun foldout-update-modeline () - "Set the modeline string to indicate our fold depth." +(defun foldout-update-mode-line () + "Set the mode line to indicate our fold depth." (let ((depth (length foldout-fold-list))) - (setq foldout-modeline-string + (setq foldout-mode-line-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 + ;; in outline-minor-mode we're after "Outl:xx" in the mode line (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)) - )))) + (format " Inside %d folds" depth)))))) (defun foldout-mouse-zoom (event) @@ -497,7 +490,7 @@ What happens depends on the number of mouse clicks:- "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)) + (while (null (sit-for (/ double-click-time 1000.0) 'nodisplay)) (setq event (read-event))) (or (eq initial-event-type (event-basic-type event)) (error "")))