diff options
| author | Stefan Monnier | 2001-11-28 07:12:25 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2001-11-28 07:12:25 +0000 |
| commit | a0aa2a49ba78a6261bf8f0d77b55c178f2d82199 (patch) | |
| tree | 325319a57e338b485bb02631133d7595539a4b02 | |
| parent | 43a88bc1af9dae0140dda0dfb74054228cffb9bb (diff) | |
| download | emacs-a0aa2a49ba78a6261bf8f0d77b55c178f2d82199.tar.gz emacs-a0aa2a49ba78a6261bf8f0d77b55c178f2d82199.zip | |
Initial commit.
| -rw-r--r-- | lisp/reveal.el | 161 |
1 files changed, 161 insertions, 0 deletions
diff --git a/lisp/reveal.el b/lisp/reveal.el new file mode 100644 index 00000000000..d9754557475 --- /dev/null +++ b/lisp/reveal.el | |||
| @@ -0,0 +1,161 @@ | |||
| 1 | ;;; reveal.el --- Automatically reveal hidden text at point | ||
| 2 | |||
| 3 | ;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Stefan Monnier <monnier@cs.yale.edu> | ||
| 6 | ;; Keywords: outlines | ||
| 7 | |||
| 8 | ;; This file is free software; you can redistribute it and/or modify | ||
| 9 | ;; it under the terms of the GNU General Public License as published by | ||
| 10 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 11 | ;; any later version. | ||
| 12 | |||
| 13 | ;; This file is distributed in the hope that it will be useful, | ||
| 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 16 | ;; GNU General Public License for more details. | ||
| 17 | |||
| 18 | ;; You should have received a copy of the GNU General Public License | ||
| 19 | ;; along with GNU Emacs; see the file COPYING. If not, write to | ||
| 20 | ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | ||
| 21 | ;; Boston, MA 02111-1307, USA. | ||
| 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 | |||
| 45 | ;;; Code: | ||
| 46 | |||
| 47 | (require 'pcvs-util) | ||
| 48 | |||
| 49 | (defgroup reveal nil | ||
| 50 | "Reveal hidden text on the fly." | ||
| 51 | :group 'editing) | ||
| 52 | |||
| 53 | (defcustom reveal-around-mark t | ||
| 54 | "Reveal text around the mark, if active." | ||
| 55 | :type 'boolean) | ||
| 56 | |||
| 57 | (defvar reveal-open-spots nil) | ||
| 58 | (make-variable-buffer-local 'reveal-open-spots) | ||
| 59 | |||
| 60 | ;; Actual code | ||
| 61 | |||
| 62 | (defun reveal-post-command () | ||
| 63 | ;; Refresh the spots that might have changed. | ||
| 64 | ;; `Refreshing' here means to try and re-hide the corresponding text. | ||
| 65 | ;; We don't refresh everything correctly: | ||
| 66 | ;; - we only refresh spots in the current window. | ||
| 67 | ;; FIXME: do we actually know that (current-buffer) = (window-buffer) ? | ||
| 68 | (with-local-quit | ||
| 69 | (let* ((spots (cvs-partition | ||
| 70 | (lambda (x) | ||
| 71 | ;; We refresh any spot in the current window as well | ||
| 72 | ;; as any spots associated with a dead window or a window | ||
| 73 | ;; which does not show this buffer any more. | ||
| 74 | (or (eq (car x) (selected-window)) | ||
| 75 | (not (window-live-p (car x))) | ||
| 76 | (not (eq (window-buffer (car x)) | ||
| 77 | (current-buffer))))) | ||
| 78 | reveal-open-spots)) | ||
| 79 | (old-ols (mapcar 'cdr (car spots))) | ||
| 80 | (repeat t) | ||
| 81 | ;; `post-command-hook' binds it to t, but the user might want to | ||
| 82 | ;; interrupt our work if we somehow get stuck in an infinite loop. | ||
| 83 | (inhibit-quit nil) | ||
| 84 | inv open) | ||
| 85 | (setq reveal-open-spots (cdr spots)) | ||
| 86 | ;; Open new overlays. | ||
| 87 | (while repeat | ||
| 88 | (setq repeat nil) | ||
| 89 | (dolist (ol (nconc (when (and reveal-around-mark mark-active) | ||
| 90 | (overlays-at (mark))) | ||
| 91 | (overlays-at (point)))) | ||
| 92 | (push (cons (selected-window) ol) reveal-open-spots) | ||
| 93 | (setq old-ols (delq ol old-ols)) | ||
| 94 | (when (setq inv (overlay-get ol 'invisible)) | ||
| 95 | (when (or (overlay-get ol 'isearch-open-invisible) | ||
| 96 | (and (consp buffer-invisibility-spec) | ||
| 97 | (assq inv buffer-invisibility-spec))) | ||
| 98 | (overlay-put ol 'reveal-invisible inv) | ||
| 99 | (overlay-put ol 'invisible nil) | ||
| 100 | (when (setq open (get inv 'reveal-toggle-invisible)) | ||
| 101 | ;; Use the provided opening function and repeat (since the | ||
| 102 | ;; opening function might have hidden a subpart around point). | ||
| 103 | (setq repeat t) | ||
| 104 | (condition-case err | ||
| 105 | (funcall open ol t) | ||
| 106 | (error (message "!!Reveal-show: %s !!" err)))))))) | ||
| 107 | ;; Close old overlays. | ||
| 108 | (dolist (ol old-ols) | ||
| 109 | (when (and (setq inv (overlay-get ol 'reveal-invisible)) | ||
| 110 | (eq (current-buffer) (overlay-buffer ol)) | ||
| 111 | (not (rassq ol reveal-open-spots))) | ||
| 112 | (if (and (>= (point) (save-excursion | ||
| 113 | (goto-char (overlay-start ol)) | ||
| 114 | (line-beginning-position 1))) | ||
| 115 | (<= (point) (save-excursion | ||
| 116 | (goto-char (overlay-end ol)) | ||
| 117 | (line-beginning-position 2)))) | ||
| 118 | ;; Still near the overlay: keep it open. | ||
| 119 | (push (cons (selected-window) ol) reveal-open-spots) | ||
| 120 | ;; Really close it. | ||
| 121 | (overlay-put ol 'invisible inv) | ||
| 122 | (when (setq open (get inv 'reveal-toggle-invisible)) | ||
| 123 | (condition-case err | ||
| 124 | (funcall open ol nil) | ||
| 125 | (error (message "!!Reveal-hide: %s !!" err)))))))))) | ||
| 126 | |||
| 127 | ;;;###autoload | ||
| 128 | (define-minor-mode reveal-mode | ||
| 129 | "Toggle Reveal mode on or off. | ||
| 130 | Reveal mode renders invisible text around point visible again. | ||
| 131 | |||
| 132 | Interactively, with no prefix argument, toggle the mode. | ||
| 133 | With universal prefix ARG (or if ARG is nil) turn mode on. | ||
| 134 | With zero or negative ARG turn mode off." | ||
| 135 | :lighter "Reveal" | ||
| 136 | (if reveal-mode | ||
| 137 | (progn | ||
| 138 | (set (make-local-variable 'search-invisible) t) | ||
| 139 | (add-hook 'post-command-hook 'reveal-post-command nil t)) | ||
| 140 | (kill-local-variable 'search-invisible) | ||
| 141 | (remove-hook 'post-command-hook 'reveal-post-command t))) | ||
| 142 | |||
| 143 | ;;;###autoload | ||
| 144 | (define-minor-mode global-reveal-mode | ||
| 145 | "Toggle Reveal mode in all buffers on or off. | ||
| 146 | Reveal mode renders invisible text around point visible again. | ||
| 147 | |||
| 148 | Interactively, with no prefix argument, toggle the mode. | ||
| 149 | With universal prefix ARG (or if ARG is nil) turn mode on. | ||
| 150 | With zero or negative ARG turn mode off." | ||
| 151 | :global t | ||
| 152 | (setq-default reveal-mode global-reveal-mode) | ||
| 153 | (if global-reveal-mode | ||
| 154 | (progn | ||
| 155 | (setq search-invisible t) | ||
| 156 | (add-hook 'post-command-hook 'reveal-post-command)) | ||
| 157 | (setq search-invisible 'open) ;FIXME | ||
| 158 | (remove-hook 'post-command-hook 'reveal-post-command))) | ||
| 159 | |||
| 160 | (provide 'reveal) | ||
| 161 | ;;; reveal.el ends here | ||