lisp/reveal.el

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