lisp/reveal.el

   1 ;;; reveal.el --- Automatically reveal hidden text at point -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2000-2018 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 <https://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))
  87                                       (current-buffer))))
  88                         ;; Adopt this since it's owned by a window that's
  89                         ;; either not live or at least not showing this
  90                         ;; buffer any more.
  91                         (setcar x (selected-window))
  92                         (cdr x))))
  93                     reveal-open-spots))))
  94         (setq old-ols (reveal-open-new-overlays old-ols))
  95         (reveal-close-old-overlays old-ols)))))
  96
  97 (defun reveal-open-new-overlays (old-ols)
  98   (let ((repeat t))
  99     (while repeat
 100       (setq repeat nil)
 101       (dolist (ol (nconc (when (and reveal-around-mark mark-active)
 102                            (overlays-at (mark)))
 103                          (overlays-at (point))))
 104         (setq old-ols (delq ol old-ols))
 105         (when (overlay-start ol)        ;Check it's still live.
 106           (let ((inv (overlay-get ol 'invisible)) open)
 107             (when (and inv
 108                        ;; There's an `invisible' property.  Make sure it's
 109                        ;; actually invisible, and ellipsized.
 110                        (and (consp buffer-invisibility-spec)
 111                             (cdr (assq inv buffer-invisibility-spec)))
 112                        (or (setq open
 113                                  (or (overlay-get ol 'reveal-toggle-invisible)
 114                                      (and (symbolp inv)
 115                                           (get inv 'reveal-toggle-invisible))
 116                                      (overlay-get ol 'isearch-open-invisible-temporary)))
 117                            (overlay-get ol 'isearch-open-invisible)
 118                            (and (consp buffer-invisibility-spec)
 119                                 (cdr (assq inv buffer-invisibility-spec))))
 120                        (overlay-put ol 'reveal-invisible inv))
 121               (push (cons (selected-window) ol) reveal-open-spots)
 122               (if (null open)
 123                   (overlay-put ol 'invisible nil)
 124                 ;; Use the provided opening function and repeat (since the
 125                 ;; opening function might have hidden a subpart around point
 126                 ;; or moved/killed some of the overlays).
 127                 (setq repeat t)
 128                 (condition-case err
 129                     (funcall open ol nil)
 130                   (error (message "!!Reveal-show (funcall %s %s nil): %s !!"
 131                                   open ol err)
 132                          ;; Let's default to a meaningful behavior to avoid
 133                          ;; getting stuck in an infinite loop.
 134                          (setq repeat nil)
 135                          (overlay-put ol 'invisible nil))))))))))
 136   old-ols)
 137
 138 (defun reveal-close-old-overlays (old-ols)
 139   (if (or track-mouse                   ;Don't close in the middle of a click.
 140           (not (eq reveal-last-tick
 141                    (setq reveal-last-tick (buffer-modified-tick)))))
 142       ;; The buffer was modified since last command: let's refrain from
 143       ;; closing any overlay because it tends to behave poorly when
 144       ;; inserting text at the end of an overlay (basically the overlay
 145       ;; should be rear-advance when it's open, but things like
 146       ;; outline-minor-mode make it non-rear-advance because it's
 147       ;; a better choice when it's closed).
 148       nil
 149     ;; The last command was only a point motion or some such
 150     ;; non-buffer-modifying command.  Let's close whatever can be closed.
 151     (dolist (ol old-ols)
 152       (if (and (overlay-start ol)       ;Check it's still live.
 153                (>= (point) (save-excursion
 154                              (goto-char (overlay-start ol))
 155                              (line-beginning-position 1)))
 156                (<= (point) (save-excursion
 157                              (goto-char (overlay-end ol))
 158                              (line-beginning-position 2)))
 159                ;; If the application has moved the overlay to some other
 160                ;; buffer, we'd better reset the buffer to its
 161                ;; original state.
 162                (eq (current-buffer) (overlay-buffer ol)))
 163           ;; Still near the overlay: keep it open.
 164           nil
 165         ;; Really close it.
 166         (let* ((inv (overlay-get ol 'reveal-invisible))
 167                (open (or (overlay-get ol 'reveal-toggle-invisible)
 168                          (get inv 'reveal-toggle-invisible)
 169                          (overlay-get ol 'isearch-open-invisible-temporary))))
 170           (if (and (overlay-start ol)   ;Check it's still live.
 171                    open)
 172               (condition-case err
 173                   (funcall open ol t)
 174                 (error (message "!!Reveal-hide (funcall %s %s t): %s !!"
 175                                 open ol err)))
 176             (overlay-put ol 'invisible inv))
 177           ;; Remove the overlay from the list of open spots.
 178           (overlay-put ol 'reveal-invisible nil)
 179           (setq reveal-open-spots
 180                 (delq (rassoc ol reveal-open-spots)
 181                       reveal-open-spots)))))))
 182
 183 (defvar reveal-mode-map
 184   (let ((map (make-sparse-keymap)))
 185     ;; Override the default move-beginning-of-line and move-end-of-line
 186     ;; which skips valuable invisible text.
 187     (define-key map [remap move-beginning-of-line] 'beginning-of-line)
 188     (define-key map [remap move-end-of-line] 'end-of-line)
 189     map))
 190
 191 ;;;###autoload
 192 (define-minor-mode reveal-mode
 193   "Toggle uncloaking of invisible text near point (Reveal mode).
 194
 195 Reveal mode is a buffer-local minor mode.  When enabled, it
 196 reveals invisible text around point."
 197   :group 'reveal
 198   :lighter (global-reveal-mode nil " Reveal")
 199   :keymap reveal-mode-map
 200   (if reveal-mode
 201       (progn
 202         (set (make-local-variable 'search-invisible) t)
 203         (add-hook 'post-command-hook 'reveal-post-command nil t))
 204     (kill-local-variable 'search-invisible)
 205     (remove-hook 'post-command-hook 'reveal-post-command t)))
 206
 207 ;;;###autoload
 208 (define-minor-mode global-reveal-mode
 209   "Toggle Reveal mode in all buffers (Global Reveal mode).
 210 Reveal mode renders invisible text around point visible again."
 211   :global t :group 'reveal
 212   (setq-default reveal-mode global-reveal-mode)
 213   (if global-reveal-mode
 214       (progn
 215         (setq search-invisible t)
 216         (add-hook 'post-command-hook 'reveal-post-command))
 217     (setq search-invisible 'open)       ;FIXME
 218     (remove-hook 'post-command-hook 'reveal-post-command)))
 219
 220 (provide 'reveal)
 221
 222 ;;; reveal.el ends here