;;; reveal.el --- Automatically reveal hidden text at point
-;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
-;; Author: Stefan Monnier <monnier@cs.yale.edu>
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: outlines
;; This file is part of GNU Emacs.
;; 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.
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Todo:
;; - find other hysteresis features.
+;; - don't hide after a scroll command
+;; - delay hiding by a couple seconds (i.e. hide in the background)
;;; Code:
-(require 'pcvs-util)
-
(defgroup reveal nil
"Reveal hidden text on the fly."
:group 'editing)
(defcustom reveal-around-mark t
"Reveal text around the mark, if active."
- :type 'boolean)
+ :type 'boolean
+ :group 'reveal)
-(defvar reveal-open-spots nil)
+(defvar reveal-open-spots nil
+ "List of spots in the buffer which are open.
+Each element has the form (WINDOW . OVERLAY).")
(make-variable-buffer-local 'reveal-open-spots)
+(defvar reveal-last-tick nil)
+(make-variable-buffer-local 'reveal-last-tick)
+
;; Actual code
(defun reveal-post-command ()
;; - we only refresh spots in the current window.
;; FIXME: do we actually know that (current-buffer) = (window-buffer) ?
(with-local-quit
- (condition-case err
- (let* ((spots (cvs-partition
- (lambda (x)
- ;; We refresh any spot in the current window as well
- ;; as any spots associated with a dead window or a window
- ;; which does not show this buffer any more.
- (or (eq (car x) (selected-window))
- (not (window-live-p (car x)))
- (not (eq (window-buffer (car x))
- (current-buffer)))))
- reveal-open-spots))
- (old-ols (mapcar 'cdr (car spots)))
- (repeat t))
- (setq reveal-open-spots (cdr spots))
- ;; Open new overlays.
- (while repeat
- (setq repeat nil)
- (dolist (ol (nconc (when (and reveal-around-mark mark-active)
- (overlays-at (mark)))
- (overlays-at (point))))
- (push (cons (selected-window) ol) reveal-open-spots)
- (setq old-ols (delq ol old-ols))
- (let ((open (overlay-get ol 'reveal-toggle-invisible)))
- (when (or open
- (let ((inv (overlay-get ol 'invisible)))
- (and inv (symbolp inv)
- (or (setq open (or (get inv 'reveal-toggle-invisible)
- (get ol 'isearch-open-invisible-temporary)))
- (overlay-get ol 'isearch-open-invisible)
- (and (consp buffer-invisibility-spec)
- (assq inv buffer-invisibility-spec)))
- (overlay-put ol 'reveal-invisible inv))))
- (if (null open)
- (overlay-put ol 'invisible nil)
- ;; Use the provided opening function and repeat (since the
- ;; opening function might have hidden a subpart around point).
- (setq repeat t)
- (condition-case err
- (funcall open ol nil)
- (error (message "!!Reveal-show: %s !!" err))))))))
- ;; Close old overlays.
- (dolist (ol old-ols)
- (when (and (eq (current-buffer) (overlay-buffer ol))
- (not (rassq ol reveal-open-spots)))
- (if (and (>= (point) (save-excursion
- (goto-char (overlay-start ol))
- (line-beginning-position 1)))
- (<= (point) (save-excursion
- (goto-char (overlay-end ol))
- (line-beginning-position 2))))
- ;; Still near the overlay: keep it open.
- (push (cons (selected-window) ol) reveal-open-spots)
- ;; Really close it.
- (let ((open (overlay-get ol 'reveal-toggle-invisible)) inv)
- (if (or open
- (and (setq inv (overlay-get ol 'reveal-invisible))
- (setq open (or (get inv 'reveal-toggle-invisible)
- (get ol 'isearch-open-invisible-temporary)))))
- (condition-case err
- (funcall open ol t)
- (error (message "!!Reveal-hide: %s !!" err)))
- (overlay-put ol 'invisible inv)))))))
- (error (message "Reveal: %s" err)))))
+ (condition-case err
+ (let ((old-ols
+ (delq nil
+ (mapcar
+ (lambda (x)
+ ;; We refresh any spot in the current window as well
+ ;; as any spots associated with a dead window or
+ ;; a window which does not show this buffer any more.
+ (cond
+ ((eq (car x) (selected-window)) (cdr x))
+ ((not (and (window-live-p (car x))
+ (eq (window-buffer (car x)) (current-buffer))))
+ ;; Adopt this since it's owned by a window that's
+ ;; either not live or at least not showing this
+ ;; buffer any more.
+ (setcar x (selected-window))
+ (cdr x))))
+ reveal-open-spots))))
+ (setq old-ols (reveal-open-new-overlays old-ols))
+ (reveal-close-old-overlays old-ols))
+ (error (message "Reveal: %s" err)))))
+
+(defun reveal-open-new-overlays (old-ols)
+ (let ((repeat t))
+ (while repeat
+ (setq repeat nil)
+ (dolist (ol (nconc (when (and reveal-around-mark mark-active)
+ (overlays-at (mark)))
+ (overlays-at (point))))
+ (setq old-ols (delq ol old-ols))
+ (when (overlay-start ol) ;Check it's still live.
+ (let ((inv (overlay-get ol 'invisible)) open)
+ (when (and inv
+ ;; There's an `invisible' property. Make sure it's
+ ;; actually invisible, and ellipsised.
+ (and (consp buffer-invisibility-spec)
+ (cdr (assq inv buffer-invisibility-spec)))
+ (or (setq open
+ (or (overlay-get ol 'reveal-toggle-invisible)
+ (and (symbolp inv)
+ (get inv 'reveal-toggle-invisible))
+ (overlay-get ol 'isearch-open-invisible-temporary)))
+ (overlay-get ol 'isearch-open-invisible)
+ (and (consp buffer-invisibility-spec)
+ (cdr (assq inv buffer-invisibility-spec))))
+ (overlay-put ol 'reveal-invisible inv))
+ (push (cons (selected-window) ol) reveal-open-spots)
+ (if (null open)
+ (overlay-put ol 'invisible nil)
+ ;; Use the provided opening function and repeat (since the
+ ;; opening function might have hidden a subpart around point
+ ;; or moved/killed some of the overlays).
+ (setq repeat t)
+ (condition-case err
+ (funcall open ol nil)
+ (error (message "!!Reveal-show (funcall %s %s nil): %s !!"
+ open ol err)
+ ;; Let's default to a meaningful behavior to avoid
+ ;; getting stuck in an infinite loop.
+ (setq repeat nil)
+ (overlay-put ol 'invisible nil))))))))))
+ old-ols)
+
+(defun reveal-close-old-overlays (old-ols)
+ (if (not (eq reveal-last-tick
+ (setq reveal-last-tick (buffer-modified-tick))))
+ ;; The buffer was modified since last command: let's refrain from
+ ;; closing any overlay because it tends to behave poorly when
+ ;; inserting text at the end of an overlay (basically the overlay
+ ;; should be rear-advance when it's open, but things like
+ ;; outline-minor-mode make it non-rear-advance because it's
+ ;; a better choice when it's closed).
+ nil
+ ;; The last command was only a point motion or some such
+ ;; non-buffer-modifying command. Let's close whatever can be closed.
+ (dolist (ol old-ols)
+ (if (and (overlay-start ol) ;Check it's still live.
+ (>= (point) (save-excursion
+ (goto-char (overlay-start ol))
+ (line-beginning-position 1)))
+ (<= (point) (save-excursion
+ (goto-char (overlay-end ol))
+ (line-beginning-position 2)))
+ ;; If the application has moved the overlay to some other
+ ;; buffer, we'd better reset the buffer to its
+ ;; original state.
+ (eq (current-buffer) (overlay-buffer ol)))
+ ;; Still near the overlay: keep it open.
+ nil
+ ;; Really close it.
+ (let* ((inv (overlay-get ol 'reveal-invisible))
+ (open (or (overlay-get ol 'reveal-toggle-invisible)
+ (get inv 'reveal-toggle-invisible)
+ (overlay-get ol 'isearch-open-invisible-temporary))))
+ (if (and (overlay-start ol) ;Check it's still live.
+ open)
+ (condition-case err
+ (funcall open ol t)
+ (error (message "!!Reveal-hide (funcall %s %s t): %s !!"
+ open ol err)))
+ (overlay-put ol 'invisible inv))
+ ;; Remove the overlay from the list of open spots.
+ (overlay-put ol 'reveal-invisible nil)
+ (setq reveal-open-spots
+ (delq (rassoc ol reveal-open-spots)
+ reveal-open-spots)))))))
+
+(defvar reveal-mode-map
+ (let ((map (make-sparse-keymap)))
+ ;; Override the default move-beginning-of-line and move-end-of-line
+ ;; which skips valuable invisible text.
+ (define-key map [remap move-beginning-of-line] 'beginning-of-line)
+ (define-key map [remap move-end-of-line] 'end-of-line)
+ map))
;;;###autoload
(define-minor-mode reveal-mode
Interactively, with no prefix argument, toggle the mode.
With universal prefix ARG (or if ARG is nil) turn mode on.
With zero or negative ARG turn mode off."
+ :group 'reveal
:lighter (global-reveal-mode nil " Reveal")
+ :keymap reveal-mode-map
(if reveal-mode
(progn
(set (make-local-variable 'search-invisible) t)
Interactively, with no prefix argument, toggle the mode.
With universal prefix ARG (or if ARG is nil) turn mode on.
With zero or negative ARG turn mode off."
- :global t
+ :global t :group 'reveal
(setq-default reveal-mode global-reveal-mode)
(if global-reveal-mode
(progn
(remove-hook 'post-command-hook 'reveal-post-command)))
(provide 'reveal)
+
+;; arch-tag: 96ba0242-2274-4ed7-8e10-26bc0707b4d8
;;; reveal.el ends here