lisp/reveal.el

   1 ;;; reveal.el --- Automatically reveal hidden text at point
   2
   3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
   7 ;; Keywords: outlines
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 3, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; Reveal mode is a minor mode that makes sure that text around point
  29 ;; is always visible.  When point enters a region of hidden text,
  30 ;; `reveal-mode' temporarily makes it visible.
  31 ;;
  32 ;; This is normally used in conjunction with `outline-minor-mode',
  33 ;; `hs-minor-mode', `hide-ifdef-mode', ...
  34 ;;
  35 ;; It only works with packages that hide text using overlays.
  36 ;; Packages can provide special support for it by placing
  37 ;; a function in the `reveal-toggle-invisible' property on the symbol
  38 ;; used as the value of the `invisible' overlay property.
  39 ;; The function is called right after revealing (or re-hiding) the
  40 ;; text with two arguments: the overlay and a boolean that's non-nil
  41 ;; if we have just revealed the text.  When revealing, that function
  42 ;; may re-hide some of the text.
  43
  44 ;;; Todo:
  45
  46 ;; - find other hysteresis features.
  47 ;; - don't hide after a scroll command
  48 ;; - delay hiding by a couple seconds (i.e. hide in the background)
  49
  50 ;;; Code:
  51
  52 (defgroup reveal nil
  53   "Reveal hidden text on the fly."
  54   :group 'editing)
  55
  56 (defcustom reveal-around-mark t
  57   "Reveal text around the mark, if active."
  58   :type 'boolean
  59   :group 'reveal)
  60
  61 (defvar reveal-open-spots nil
  62   "List of spots in the buffer which are open.
  63 Each element has the form (WINDOW . OVERLAY).")
  64 (make-variable-buffer-local 'reveal-open-spots)
  65
  66 (defvar reveal-last-tick nil)
  67 (make-variable-buffer-local 'reveal-last-tick)
  68
  69 ;; Actual code
  70
  71 (defun reveal-post-command ()
  72   ;; Refresh the spots that might have changed.
  73   ;; `Refreshing' here means to try and re-hide the corresponding text.
  74   ;; We don't refresh everything correctly:
  75   ;; - we only refresh spots in the current window.
  76   ;; FIXME: do we actually know that (current-buffer) = (window-buffer) ?
  77   (with-local-quit
  78     (condition-case err
  79         (let ((old-ols
  80                (delq nil
  81                      (mapcar
  82                       (lambda (x)
  83                         ;; We refresh any spot in the current window as well
  84                         ;; as any spots associated with a dead window or
  85                         ;; a window which does not show this buffer any more.
  86                         (cond
  87                          ((eq (car x) (selected-window)) (cdr x))
  88                          ((not (and (window-live-p (car x))
  89                                     (eq (window-buffer (car x)) (current-buffer))))
  90                           ;; Adopt this since it's owned by a window that's
  91                           ;; either not live or at least not showing this
  92                           ;; buffer any more.
  93                           (setcar x (selected-window))
  94                           (cdr x))))
  95                       reveal-open-spots))))
  96           (setq old-ols (reveal-open-new-overlays old-ols))
  97           (reveal-close-old-overlays old-ols))
  98       (error (message "Reveal: %s" err)))))
  99
 100 (defun reveal-open-new-overlays (old-ols)
 101   (let ((repeat t))
 102     (while repeat
 103       (setq repeat nil)
 104       (dolist (ol (nconc (when (and reveal-around-mark mark-active)
 105                            (overlays-at (mark)))
 106                          (overlays-at (point))))
 107         (setq old-ols (delq ol old-ols))
 108         (when (overlay-start ol)        ;Check it's still live.
 109           (let ((inv (overlay-get ol 'invisible)) open)
 110             (when (and inv
 111                        ;; There's an `invisible' property.  Make sure it's
 112                        ;; actually invisible, and ellipsised.
 113                        (and (consp buffer-invisibility-spec)
 114                             (cdr (assq inv buffer-invisibility-spec)))
 115                        (or (setq open
 116                                  (or (overlay-get ol 'reveal-toggle-invisible)
 117                                      (and (symbolp inv)
 118                                           (get inv 'reveal-toggle-invisible))
 119                                      (overlay-get ol 'isearch-open-invisible-temporary)))
 120                            (overlay-get ol 'isearch-open-invisible)
 121                            (and (consp buffer-invisibility-spec)
 122                                 (cdr (assq inv buffer-invisibility-spec))))
 123                        (overlay-put ol 'reveal-invisible inv))
 124               (push (cons (selected-window) ol) reveal-open-spots)
 125               (if (null open)
 126                   (overlay-put ol 'invisible nil)
 127                 ;; Use the provided opening function and repeat (since the
 128                 ;; opening function might have hidden a subpart around point
 129                 ;; or moved/killed some of the overlays).
 130                 (setq repeat t)
 131                 (condition-case err
 132                     (funcall open ol nil)
 133                   (error (message "!!Reveal-show (funcall %s %s nil): %s !!"
 134                                   open ol err)
 135                          ;; Let's default to a meaningful behavior to avoid
 136                          ;; getting stuck in an infinite loop.
 137                          (setq repeat nil)
 138                          (overlay-put ol 'invisible nil))))))))))
 139   old-ols)
 140
 141 (defun reveal-close-old-overlays (old-ols)
 142   (if (not (eq reveal-last-tick
 143                (setq reveal-last-tick (buffer-modified-tick))))
 144       ;; The buffer was modified since last command: let's refrain from
 145       ;; closing any overlay because it tends to behave poorly when
 146       ;; inserting text at the end of an overlay (basically the overlay
 147       ;; should be rear-advance when it's open, but things like
 148       ;; outline-minor-mode make it non-rear-advance because it's
 149       ;; a better choice when it's closed).
 150       nil
 151     ;; The last command was only a point motion or some such
 152     ;; non-buffer-modifying command.  Let's close whatever can be closed.
 153     (dolist (ol old-ols)
 154       (if (and (overlay-start ol)       ;Check it's still live.
 155                (>= (point) (save-excursion
 156                              (goto-char (overlay-start ol))
 157                              (line-beginning-position 1)))
 158                (<= (point) (save-excursion
 159                              (goto-char (overlay-end ol))
 160                              (line-beginning-position 2)))
 161                ;; If the application has moved the overlay to some other
 162                ;; buffer, we'd better reset the buffer to its
 163                ;; original state.
 164                (eq (current-buffer) (overlay-buffer ol)))
 165           ;; Still near the overlay: keep it open.
 166           nil
 167         ;; Really close it.
 168         (let* ((inv (overlay-get ol 'reveal-invisible))
 169                (open (or (overlay-get ol 'reveal-toggle-invisible)
 170                          (get inv 'reveal-toggle-invisible)
 171                          (overlay-get ol 'isearch-open-invisible-temporary))))
 172           (if (and (overlay-start ol)   ;Check it's still live.
 173                    open)
 174               (condition-case err
 175                   (funcall open ol t)
 176                 (error (message "!!Reveal-hide (funcall %s %s t): %s !!"
 177                                 open ol err)))
 178             (overlay-put ol 'invisible inv))
 179           ;; Remove the overlay from the list of open spots.
 180           (overlay-put ol 'reveal-invisible nil)
 181           (setq reveal-open-spots
 182                 (delq (rassoc ol reveal-open-spots)
 183                       reveal-open-spots)))))))
 184
 185 (defvar reveal-mode-map
 186   (let ((map (make-sparse-keymap)))
 187     ;; Override the default move-beginning-of-line and move-end-of-line
 188     ;; which skips valuable invisible text.
 189     (define-key map [remap move-beginning-of-line] 'beginning-of-line)
 190     (define-key map [remap move-end-of-line] 'end-of-line)
 191     map))
 192
 193 ;;;###autoload
 194 (define-minor-mode reveal-mode
 195   "Toggle Reveal mode on or off.
 196 Reveal mode renders invisible text around point visible again.
 197
 198 Interactively, with no prefix argument, toggle the mode.
 199 With universal prefix ARG (or if ARG is nil) turn mode on.
 200 With zero or negative ARG turn mode off."
 201   :group 'reveal
 202   :lighter (global-reveal-mode nil " Reveal")
 203   :keymap reveal-mode-map
 204   (if reveal-mode
 205       (progn
 206         (set (make-local-variable 'search-invisible) t)
 207         (add-hook 'post-command-hook 'reveal-post-command nil t))
 208     (kill-local-variable 'search-invisible)
 209     (remove-hook 'post-command-hook 'reveal-post-command t)))
 210
 211 ;;;###autoload
 212 (define-minor-mode global-reveal-mode
 213   "Toggle Reveal mode in all buffers on or off.
 214 Reveal mode renders invisible text around point visible again.
 215
 216 Interactively, with no prefix argument, toggle the mode.
 217 With universal prefix ARG (or if ARG is nil) turn mode on.
 218 With zero or negative ARG turn mode off."
 219   :global t :group 'reveal
 220   (setq-default reveal-mode global-reveal-mode)
 221   (if global-reveal-mode
 222       (progn
 223         (setq search-invisible t)
 224         (add-hook 'post-command-hook 'reveal-post-command))
 225     (setq search-invisible 'open)       ;FIXME
 226     (remove-hook 'post-command-hook 'reveal-post-command)))
 227
 228 (provide 'reveal)
 229
 230 ;; arch-tag: 96ba0242-2274-4ed7-8e10-26bc0707b4d8
 231 ;;; reveal.el ends here