aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2006-01-09 22:56:08 +0000
committerStefan Monnier2006-01-09 22:56:08 +0000
commitffb5fc37ba982e3e0ae8bc0007cf0e38d1dd1676 (patch)
tree9fa359fa6a6b3a932ca6e6f139646e91580902c3
parentb6d8f74380acd1c98974dda9f546c4d83b7c3038 (diff)
downloademacs-ffb5fc37ba982e3e0ae8bc0007cf0e38d1dd1676.tar.gz
emacs-ffb5fc37ba982e3e0ae8bc0007cf0e38d1dd1676.zip
(reveal-open-new-overlays): New extracted fun.
(reveal-close-old-overlays): Idem. Check overlays's liveness before using them. Simplify the code. (reveal-post-command): Use them. Fix up obsolete windows in reveal-open-spots.
-rw-r--r--lisp/ChangeLog6
-rw-r--r--lisp/reveal.el198
2 files changed, 110 insertions, 94 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 6eb27f1749d..ed7e28326f9 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,11 @@
12006-01-09 Stefan Monnier <monnier@iro.umontreal.ca> 12006-01-09 Stefan Monnier <monnier@iro.umontreal.ca>
2 2
3 * reveal.el (reveal-open-new-overlays): New extracted fun.
4 (reveal-close-old-overlays): Idem. Check overlays's liveness before
5 using them. Simplify the code.
6 (reveal-post-command): Use them. Fix up obsolete windows in
7 reveal-open-spots.
8
3 * progmodes/flymake.el: Use `require' rather than autoload for 9 * progmodes/flymake.el: Use `require' rather than autoload for
4 XEmacs's overlays. 10 XEmacs's overlays.
5 (flymake-get-common-file-prefix, flymake-build-relative-filename): 11 (flymake-get-common-file-prefix, flymake-build-relative-filename):
diff --git a/lisp/reveal.el b/lisp/reveal.el
index 06f8940eddc..3c76c2a2e8b 100644
--- a/lisp/reveal.el
+++ b/lisp/reveal.el
@@ -1,7 +1,7 @@
1;;; reveal.el --- Automatically reveal hidden text at point 1;;; reveal.el --- Automatically reveal hidden text at point
2 2
3;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 3;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
4;; 2005 Free Software Foundation, Inc. 4;; 2005, 2006 Free Software Foundation, Inc.
5 5
6;; Author: Stefan Monnier <monnier@cs.yale.edu> 6;; Author: Stefan Monnier <monnier@cs.yale.edu>
7;; Keywords: outlines 7;; Keywords: outlines
@@ -75,99 +75,109 @@ Each element has the form (WINDOW . OVERLAY).")
75 ;; - we only refresh spots in the current window. 75 ;; - we only refresh spots in the current window.
76 ;; FIXME: do we actually know that (current-buffer) = (window-buffer) ? 76 ;; FIXME: do we actually know that (current-buffer) = (window-buffer) ?
77 (with-local-quit 77 (with-local-quit
78 (condition-case err 78 (condition-case err
79 (let ((old-ols (delq nil 79 (let ((old-ols
80 (mapcar 80 (delq nil
81 (lambda (x) 81 (mapcar
82 ;; We refresh any spot in the current window as 82 (lambda (x)
83 ;; well as any spots associated with a dead 83 ;; We refresh any spot in the current window as well
84 ;; window or a window which does not show this 84 ;; as any spots associated with a dead window or
85 ;; buffer any more. 85 ;; a window which does not show this buffer any more.
86 (if (or (eq (car x) (selected-window)) 86 (cond
87 (not (window-live-p (car x))) 87 ((eq (car x) (selected-window)) (cdr x))
88 (not (eq (window-buffer (car x)) 88 ((not (eq (window-buffer (car x)) (current-buffer)))
89 (current-buffer)))) 89 ;; Adopt this since it's owned by a window that's
90 (cdr x))) 90 ;; either not live or at least not showing this
91 reveal-open-spots))) 91 ;; buffer any more.
92 (repeat t)) 92 (setcar x (selected-window))
93 ;; Open new overlays. 93 (cdr x))))
94 (while repeat 94 reveal-open-spots))))
95 (setq repeat nil) 95 (setq old-ols (reveal-open-new-overlays old-ols))
96 (dolist (ol (nconc (when (and reveal-around-mark mark-active) 96 (reveal-close-old-overlays old-ols))
97 (overlays-at (mark))) 97 (error (message "Reveal: %s" err)))))
98 (overlays-at (point)))) 98
99 (setq old-ols (delq ol old-ols)) 99(defun reveal-open-new-overlays (old-ols)
100 (let ((inv (overlay-get ol 'invisible)) open) 100 (let ((repeat t))
101 (when (and inv 101 (while repeat
102 ;; There's an `invisible' property. Make sure it's 102 (setq repeat nil)
103 ;; actually invisible, and ellipsised. 103 (dolist (ol (nconc (when (and reveal-around-mark mark-active)
104 (and (consp buffer-invisibility-spec) 104 (overlays-at (mark)))
105 (cdr (assq inv buffer-invisibility-spec))) 105 (overlays-at (point))))
106 (or (setq open 106 (setq old-ols (delq ol old-ols))
107 (or (overlay-get ol 'reveal-toggle-invisible) 107 (let ((inv (overlay-get ol 'invisible)) open)
108 (and (symbolp inv) 108 (when (and inv
109 (get inv 'reveal-toggle-invisible)) 109 ;; There's an `invisible' property. Make sure it's
110 (overlay-get ol 'isearch-open-invisible-temporary))) 110 ;; actually invisible, and ellipsised.
111 (overlay-get ol 'isearch-open-invisible) 111 (and (consp buffer-invisibility-spec)
112 (and (consp buffer-invisibility-spec) 112 (cdr (assq inv buffer-invisibility-spec)))
113 (cdr (assq inv buffer-invisibility-spec)))) 113 (or (setq open
114 (overlay-put ol 'reveal-invisible inv)) 114 (or (overlay-get ol 'reveal-toggle-invisible)
115 (push (cons (selected-window) ol) reveal-open-spots) 115 (and (symbolp inv)
116 (if (null open) 116 (get inv 'reveal-toggle-invisible))
117 (progn ;; (debug) 117 (overlay-get ol 'isearch-open-invisible-temporary)))
118 (overlay-put ol 'invisible nil)) 118 (overlay-get ol 'isearch-open-invisible)
119 ;; Use the provided opening function and repeat (since the 119 (and (consp buffer-invisibility-spec)
120 ;; opening function might have hidden a subpart around point). 120 (cdr (assq inv buffer-invisibility-spec))))
121 (setq repeat t) 121 (overlay-put ol 'reveal-invisible inv))
122 (condition-case err 122 (push (cons (selected-window) ol) reveal-open-spots)
123 (funcall open ol nil) 123 (if (null open)
124 (error (message "!!Reveal-show (funcall %s %s nil): %s !!" 124 (overlay-put ol 'invisible nil)
125 open ol err) 125 ;; Use the provided opening function and repeat (since the
126 ;; Let's default to a meaningful behavior to avoid 126 ;; opening function might have hidden a subpart around point).
127 ;; getting stuck in an infinite loop. 127 (setq repeat t)
128 (setq repeat nil) 128 (condition-case err
129 (overlay-put ol 'invisible nil)))))))) 129 (funcall open ol nil)
130 ;; Close old overlays. 130 (error (message "!!Reveal-show (funcall %s %s nil): %s !!"
131 (if (not (eq reveal-last-tick 131 open ol err)
132 (setq reveal-last-tick (buffer-modified-tick)))) 132 ;; Let's default to a meaningful behavior to avoid
133 ;; The buffer was modified since last command: let's refrain from 133 ;; getting stuck in an infinite loop.
134 ;; closing any overlay because it tends to behave poorly when 134 (setq repeat nil)
135 ;; inserting text at the end of an overlay (basically the overlay 135 (overlay-put ol 'invisible nil)))))))))
136 ;; should be rear-advance when it's open, but things like 136 old-ols)
137 ;; outline-minor-mode make it non-rear-advance because it's 137
138 ;; a better choice when it's closed). 138(defun reveal-close-old-overlays (old-ols)
139 nil 139 (if (not (eq reveal-last-tick
140 ;; The last command was only a point motion or some such 140 (setq reveal-last-tick (buffer-modified-tick))))
141 ;; non-buffer-modifying command. Let's close whatever can be closed. 141 ;; The buffer was modified since last command: let's refrain from
142 (dolist (ol old-ols) 142 ;; closing any overlay because it tends to behave poorly when
143 (if (and (>= (point) (save-excursion 143 ;; inserting text at the end of an overlay (basically the overlay
144 (goto-char (overlay-start ol)) 144 ;; should be rear-advance when it's open, but things like
145 (line-beginning-position 1))) 145 ;; outline-minor-mode make it non-rear-advance because it's
146 (<= (point) (save-excursion 146 ;; a better choice when it's closed).
147 (goto-char (overlay-end ol)) 147 nil
148 (line-beginning-position 2))) 148 ;; The last command was only a point motion or some such
149 ;; If the application has moved the overlay to some other 149 ;; non-buffer-modifying command. Let's close whatever can be closed.
150 ;; buffer, we'd better reset the buffer to its 150 (dolist (ol old-ols)
151 ;; original state. 151 (if (and (overlay-start ol) ;Check it's still live.
152 (eq (current-buffer) (overlay-buffer ol))) 152 (>= (point) (save-excursion
153 ;; Still near the overlay: keep it open. 153 (goto-char (overlay-start ol))
154 nil 154 (line-beginning-position 1)))
155 ;; Really close it. 155 (<= (point) (save-excursion
156 (let ((open (overlay-get ol 'reveal-toggle-invisible)) inv) 156 (goto-char (overlay-end ol))
157 (if (or open 157 (line-beginning-position 2)))
158 (and (setq inv (overlay-get ol 'reveal-invisible)) 158 ;; If the application has moved the overlay to some other
159 (setq open (or (get inv 'reveal-toggle-invisible) 159 ;; buffer, we'd better reset the buffer to its
160 (overlay-get ol 'isearch-open-invisible-temporary))))) 160 ;; original state.
161 (condition-case err 161 (eq (current-buffer) (overlay-buffer ol)))
162 (funcall open ol t) 162 ;; Still near the overlay: keep it open.
163 (error (message "!!Reveal-hide (funcall %s %s t): %s !!" 163 nil
164 open ol err))) 164 ;; Really close it.
165 (overlay-put ol 'invisible inv)) 165 (let* ((inv (overlay-get ol 'reveal-invisible))
166 ;; Remove the olverlay from the list of open spots. 166 (open (or (overlay-get ol 'reveal-toggle-invisible)
167 (setq reveal-open-spots 167 (get inv 'reveal-toggle-invisible)
168 (delq (rassoc ol reveal-open-spots) 168 (overlay-get ol 'isearch-open-invisible-temporary))))
169 reveal-open-spots))))))) 169 (if (and (overlay-start ol) ;Check it's still live.
170 (error (message "Reveal: %s" err))))) 170 open)
171 (condition-case err
172 (funcall open ol t)
173 (error (message "!!Reveal-hide (funcall %s %s t): %s !!"
174 open ol err)))
175 (overlay-put ol 'invisible inv))
176 ;; Remove the overlay from the list of open spots.
177 (overlay-put ol 'reveal-invisible nil)
178 (setq reveal-open-spots
179 (delq (rassoc ol reveal-open-spots)
180 reveal-open-spots)))))))
171 181
172(defvar reveal-mode-map 182(defvar reveal-mode-map
173 (let ((map (make-sparse-keymap))) 183 (let ((map (make-sparse-keymap)))