code.delx.au - gnu-emacs/blob - lisp/reveal.el

   1 ;;; reveal.el --- Automatically reveal hidden text at point
   2
   3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005 Free Software Foundation, Inc.
   5
   6 ;; Author: Stefan Monnier <monnier@cs.yale.edu>
   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 2, 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
  48 ;;; Code:
  49
  50 (require 'pcvs-util)
  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 (make-variable-buffer-local 'reveal-open-spots)
  63
  64 (defvar reveal-last-tick nil)
  65 (make-variable-buffer-local 'reveal-last-tick)
  66
  67 ;; Actual code
  68
  69 (defun reveal-post-command ()
  70   ;; Refresh the spots that might have changed.
  71   ;; `Refreshing' here means to try and re-hide the corresponding text.
  72   ;; We don't refresh everything correctly:
  73   ;; - we only refresh spots in the current window.
  74   ;; FIXME: do we actually know that (current-buffer) = (window-buffer) ?
  75   (with-local-quit
  76   (condition-case err
  77    (let* ((spots (cvs-partition
  78                   (lambda (x)
  79                     ;; We refresh any spot in the current window as well
  80                     ;; as any spots associated with a dead window or a window
  81                     ;; which does not show this buffer any more.
  82                     (or (eq (car x) (selected-window))
  83                         (not (window-live-p (car x)))
  84                         (not (eq (window-buffer (car x))
  85                                  (current-buffer)))))
  86                   reveal-open-spots))
  87           (old-ols (mapcar 'cdr (car spots)))
  88           (repeat t))
  89      (setq reveal-open-spots (cdr spots))
  90      ;; Open new overlays.
  91      (while repeat
  92        (setq repeat nil)
  93        (dolist (ol (nconc (when (and reveal-around-mark mark-active)
  94                             (overlays-at (mark)))
  95                           (overlays-at (point))))
  96          (push (cons (selected-window) ol) reveal-open-spots)
  97          (setq old-ols (delq ol old-ols))
  98          (let ((inv (overlay-get ol 'invisible)) open)
  99            (when (and inv
 100                       ;; There's an `invisible' property.  Make sure it's
 101                       ;; actually invisible.
 102                       (or (not (listp buffer-invisibility-spec))
 103                           (memq inv buffer-invisibility-spec)
 104                           (assq inv buffer-invisibility-spec))
 105                       (or (setq open
 106                                 (or (overlay-get ol 'reveal-toggle-invisible)
 107                                     (and (symbolp inv)
 108                                          (get inv 'reveal-toggle-invisible))
 109                                     (overlay-get ol 'isearch-open-invisible-temporary)))
 110                           (overlay-get ol 'isearch-open-invisible)
 111                           (and (consp buffer-invisibility-spec)
 112                                (cdr (assq inv buffer-invisibility-spec))))
 113                       (overlay-put ol 'reveal-invisible inv))
 114              (if (null open)
 115                  (overlay-put ol 'invisible nil)
 116                ;; Use the provided opening function and repeat (since the
 117                ;; opening function might have hidden a subpart around point).
 118                (setq repeat t)
 119                (condition-case err
 120                    (funcall open ol nil)
 121                  (error (message "!!Reveal-show (funcall %s %s nil): %s !!"
 122                                  open ol err)
 123                         ;; Let's default to a meaningful behavior to avoid
 124                         ;; getting stuck in an infinite loop.
 125                         (setq repeat nil)
 126                         (overlay-put ol 'invisible nil))))))))
 127      ;; Close old overlays.
 128      (if (not (eq reveal-last-tick
 129                   (setq reveal-last-tick (buffer-modified-tick))))
 130          ;; The buffer was modified since last command: let's refrain from
 131          ;; closing any overlay because it tends to behave poorly when
 132          ;; inserting text at the end of an overlay (basically the overlay
 133          ;; should be rear-advance when it's open, but things like
 134          ;; outline-minor-mode make it non-rear-advance because it's
 135          ;; a better choice when it's closed).
 136          (dolist (ol old-ols)
 137            (push (cons (selected-window) ol) reveal-open-spots))
 138        ;; The last command was only a point motion or some such
 139        ;; non-buffer-modifying command.  Let's close whatever can be closed.
 140        (dolist (ol old-ols)
 141          (when (and (eq (current-buffer) (overlay-buffer ol))
 142                     (not (rassq ol reveal-open-spots)))
 143            (if (and (>= (point) (save-excursion
 144                                   (goto-char (overlay-start ol))
 145                                   (line-beginning-position 1)))
 146                     (<= (point) (save-excursion
 147                                   (goto-char (overlay-end ol))
 148                                   (line-beginning-position 2))))
 149                ;; Still near the overlay: keep it open.
 150                (push (cons (selected-window) ol) reveal-open-spots)
 151              ;; Really close it.
 152              (let ((open (overlay-get ol 'reveal-toggle-invisible)) inv)
 153                (if (or open
 154                        (and (setq inv (overlay-get ol 'reveal-invisible))
 155                             (setq open (or (get inv 'reveal-toggle-invisible)
 156                                            (overlay-get ol 'isearch-open-invisible-temporary)))))
 157                    (condition-case err
 158                        (funcall open ol t)
 159                      (error (message "!!Reveal-hide (funcall %s %s t): %s !!"
 160                                      open ol err)))
 161                  (overlay-put ol 'invisible inv))))))))
 162    (error (message "Reveal: %s" err)))))
 163
 164 (defvar reveal-mode-map
 165   (let ((map (make-sparse-keymap)))
 166     ;; Override the default move-beginning-of-line and move-end-of-line
 167     ;; which skips valuable invisible text.
 168     (define-key map [remap move-beginning-of-line] 'beginning-of-line)
 169     (define-key map [remap move-end-of-line] 'end-of-line)
 170     map))
 171
 172 ;;;###autoload
 173 (define-minor-mode reveal-mode
 174   "Toggle Reveal mode on or off.
 175 Reveal mode renders invisible text around point visible again.
 176
 177 Interactively, with no prefix argument, toggle the mode.
 178 With universal prefix ARG (or if ARG is nil) turn mode on.
 179 With zero or negative ARG turn mode off."
 180   :group 'reveal
 181   :lighter (global-reveal-mode nil " Reveal")
 182   :keymap reveal-mode-map
 183   (if reveal-mode
 184       (progn
 185         (set (make-local-variable 'search-invisible) t)
 186         (add-hook 'post-command-hook 'reveal-post-command nil t))
 187     (kill-local-variable 'search-invisible)
 188     (remove-hook 'post-command-hook 'reveal-post-command t)))
 189
 190 ;;;###autoload
 191 (define-minor-mode global-reveal-mode
 192   "Toggle Reveal mode in all buffers on or off.
 193 Reveal mode renders invisible text around point visible again.
 194
 195 Interactively, with no prefix argument, toggle the mode.
 196 With universal prefix ARG (or if ARG is nil) turn mode on.
 197 With zero or negative ARG turn mode off."
 198   :global t :group 'reveal
 199   (setq-default reveal-mode global-reveal-mode)
 200   (if global-reveal-mode
 201       (progn
 202         (setq search-invisible t)
 203         (add-hook 'post-command-hook 'reveal-post-command))
 204     (setq search-invisible 'open)       ;FIXME
 205     (remove-hook 'post-command-hook 'reveal-post-command)))
 206
 207 (provide 'reveal)
 208
 209 ;; arch-tag: 96ba0242-2274-4ed7-8e10-26bc0707b4d8
 210 ;;; reveal.el ends here