Commit | Line | Data |
---|---|---|
666fd2cc CY |
1 | ;;; pulse.el --- Pulsing Overlays |
2 | ||
3 | ;;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc. | |
4 | ||
5 | ;; Author: Eric M. Ludlam <eric@siege-engine.com> | |
6 | ||
7 | ;; This file is part of GNU Emacs. | |
8 | ||
9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
10 | ;; it under the terms of the GNU General Public License as published by | |
11 | ;; the Free Software Foundation, either version 3 of the License, or | |
12 | ;; (at your option) any later version. | |
13 | ||
14 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;; GNU General Public License for more details. | |
18 | ||
19 | ;; You should have received a copy of the GNU General Public License | |
20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
21 | ||
22 | ;;; Commentary: | |
23 | ;; | |
24 | ;; Manage temporary pulsing of faces and overlays. | |
25 | ;; | |
26 | ;; This is a temporal decoration technique where something is to be | |
27 | ;; highlighted briefly. This adds a gentle pulsing style to the text | |
28 | ;; decorated this way. | |
29 | ;; | |
30 | ;; Useful user functions: | |
31 | ;; | |
32 | ;; `pulse-enable-integration-advice' - Turn on advice to make various | |
33 | ;; Emacs commands pulse, such as `goto-line', or `find-tag'. | |
34 | ;; | |
35 | ;; The following are useful entry points: | |
36 | ;; | |
37 | ;; `pulse' - Cause `pulse-highlight-face' to shift toward background color. | |
38 | ;; Assumes you are using a version of Emacs that supports pulsing. | |
39 | ;; | |
40 | ;; | |
41 | ;; `pulse-momentary-highlight-one-line' - Pulse a single line at POINT. | |
42 | ;; `pulse-momentary-highlight-region' - Pulse a region. | |
43 | ;; `pulse-momentary-highlight-overlay' - Pulse an overlay | |
44 | ;; These three functions will just blink the specified area if | |
45 | ;; the version of Emacs you are using doesn't support pulsing. | |
46 | ;; | |
47 | ;; `pulse-line-hook-function' - A simple function that can be used in a | |
48 | ;; hook that will pulse whatever line the cursor is on. | |
49 | ;; | |
50 | ;;; History: | |
51 | ;; | |
52 | ;; The original pulse code was written for semantic tag highlighting. | |
53 | ;; It has been extracted, and adapted for general purpose pulsing. | |
54 | ;; | |
55 | ;; Pulse is a part of CEDET. http://cedet.sf.net | |
56 | ||
57 | (defun pulse-available-p () | |
58 | "Return non-nil if pulsing is available on the current frame." | |
59 | (condition-case nil | |
60 | (let ((v (color-values (face-background 'default)))) | |
61 | (numberp (car-safe v))) | |
62 | (error nil))) | |
63 | ||
64 | (defcustom pulse-flag (pulse-available-p) | |
65 | "*Non-nil means to pulse the overlay face for momentary highlighting. | |
66 | Pulsing involves a bright highlight that slowly shifts to the background | |
67 | color. Non-nil just means to highlight with an unchanging color for a short | |
68 | time. | |
69 | ||
70 | If `pulse-flag' is non-nil, but `pulse-available-p' is nil, then | |
71 | this flag is ignored." | |
72 | :group 'pulse | |
73 | :type 'boolean) | |
74 | ||
75 | (defface pulse-highlight-start-face | |
76 | '((((class color) (background dark)) | |
77 | (:background "#AAAA33")) | |
78 | (((class color) (background light)) | |
79 | (:background "#FFFFAA"))) | |
80 | "*Face used at beginning of a highight." | |
81 | :group 'pulse) | |
82 | ||
83 | (defface pulse-highlight-face | |
84 | '((((class color) (background dark)) | |
85 | (:background "#AAAA33")) | |
86 | (((class color) (background light)) | |
87 | (:background "#FFFFAA"))) | |
88 | "*Face used during a pulse for display. *DO NOT CUSTOMIZE* | |
89 | Face used for temporary highlighting of tags for effect." | |
90 | :group 'pulse) | |
91 | ||
92 | ;;; Code: | |
93 | ;; | |
94 | (defun pulse-int-to-hex (int &optional nb-digits) | |
95 | "Convert integer argument INT to a #XXXXXXXXXXXX format hex string. | |
96 | Each X in the output string is a hexadecimal digit. | |
97 | NB-DIGITS is the number of hex digits. If INT is too large to be | |
98 | represented with NB-DIGITS, then the result is truncated from the | |
99 | left. So, for example, INT=256 and NB-DIGITS=2 returns \"00\", since | |
100 | the hex equivalent of 256 decimal is 100, which is more than 2 digits. | |
101 | ||
102 | This function was blindly copied from hexrgb.el by Drew Adams. | |
103 | http://www.emacswiki.org/cgi-bin/wiki/hexrgb.el" | |
104 | (setq nb-digits (or nb-digits 4)) | |
105 | (substring (format (concat "%0" (int-to-string nb-digits) "X") int) (- nb-digits))) | |
106 | ||
107 | (defun pulse-color-values-to-hex (values) | |
108 | "Convert list of rgb color VALUES to a hex string, #XXXXXXXXXXXX. | |
109 | Each X in the string is a hexadecimal digit. | |
110 | Input VALUES is as for the output of `x-color-values'. | |
111 | ||
112 | This function was blindly copied from hexrgb.el by Drew Adams. | |
113 | http://www.emacswiki.org/cgi-bin/wiki/hexrgb.el" | |
114 | (concat "#" | |
115 | (pulse-int-to-hex (nth 0 values) 4) ; red | |
116 | (pulse-int-to-hex (nth 1 values) 4) ; green | |
117 | (pulse-int-to-hex (nth 2 values) 4))) ; blue | |
118 | ||
119 | (defcustom pulse-iterations 10 | |
120 | "Number of iterations in a pulse operation." | |
121 | :group 'pulse | |
122 | :type 'number) | |
123 | (defcustom pulse-delay .03 | |
124 | "Delay between face lightening iterations, as used by `sit-for'." | |
125 | :group 'pulse | |
126 | :type 'number) | |
127 | ||
128 | (defun pulse-lighten-highlight () | |
129 | "Lighten the face by 1/`pulse-iterations' toward the background color. | |
130 | Return t if there is more drift to do, nil if completed." | |
131 | (if (>= (get 'pulse-highlight-face :iteration) pulse-iterations) | |
132 | nil | |
133 | (let* ((frame (color-values (face-background 'default))) | |
134 | (start (color-values (face-background | |
135 | (get 'pulse-highlight-face | |
136 | :startface)))) | |
137 | (frac (list (/ (- (nth 0 frame) (nth 0 start)) pulse-iterations) | |
138 | (/ (- (nth 1 frame) (nth 1 start)) pulse-iterations) | |
139 | (/ (- (nth 2 frame) (nth 2 start)) pulse-iterations))) | |
140 | (it (get 'pulse-highlight-face :iteration)) | |
141 | ) | |
142 | (set-face-background 'pulse-highlight-face | |
143 | (pulse-color-values-to-hex | |
144 | (list | |
145 | (+ (nth 0 start) (* (nth 0 frac) it)) | |
146 | (+ (nth 1 start) (* (nth 1 frac) it)) | |
147 | (+ (nth 2 start) (* (nth 2 frac) it))))) | |
148 | (put 'pulse-highlight-face :iteration (1+ it)) | |
149 | (if (>= (1+ it) pulse-iterations) | |
150 | nil | |
151 | t)))) | |
152 | ||
153 | (defun pulse-reset-face (&optional face) | |
154 | "Reset the pulse highlighting FACE." | |
155 | (set-face-background 'pulse-highlight-face | |
156 | (if face | |
157 | (face-background face) | |
158 | (face-background 'pulse-highlight-start-face) | |
159 | )) | |
160 | (put 'pulse-highlight-face :startface (or face | |
161 | 'pulse-highlight-start-face)) | |
162 | (put 'pulse-highlight-face :iteration 0)) | |
163 | ||
164 | (defun pulse (&optional face) | |
165 | "Pulse the colors on our highlight face. | |
166 | If optional FACE is provide, reset the face to FACE color, | |
167 | instead of `pulse-highlight-start-face'. | |
168 | Be sure to call `pulse-reset-face' after calling pulse." | |
169 | (unwind-protect | |
170 | (progn | |
171 | (pulse-reset-face face) | |
172 | (while (and (pulse-lighten-highlight) | |
173 | (sit-for pulse-delay)) | |
174 | nil)))) | |
175 | ||
176 | ;;; Convenience Functions | |
177 | ;; | |
178 | (defvar pulse-momentary-overlay nil | |
179 | "The current pulsing overlay.") | |
180 | ||
181 | (defun pulse-momentary-highlight-overlay (o &optional face) | |
182 | "Pulse the overlay O, unhighlighting before next command. | |
183 | Optional argument FACE specifies the fact to do the highlighting." | |
184 | (overlay-put o 'original-face (overlay-get o 'face)) | |
185 | (add-to-list 'pulse-momentary-overlay o) | |
186 | (if (or (not pulse-flag) (not (pulse-available-p))) | |
187 | ;; Provide a face... clear on next command | |
188 | (progn | |
189 | (overlay-put o 'face (or face 'pulse-highlight-start-face)) | |
190 | (add-hook 'pre-command-hook | |
191 | 'pulse-momentary-unhighlight) | |
192 | ) | |
193 | ;; pulse it. | |
194 | (unwind-protect | |
195 | (progn | |
196 | (overlay-put o 'face 'pulse-highlight-face) | |
197 | ;; The pulse function puts FACE onto 'pulse-highlight-face. | |
198 | ;; Thus above we put our face on the overlay, but pulse | |
199 | ;; with a reference face needed for the color. | |
200 | (pulse face)) | |
201 | (pulse-momentary-unhighlight)))) | |
202 | ||
203 | (defun pulse-momentary-unhighlight () | |
204 | "Unhighlight a line recently highlighted." | |
205 | ;; If someone passes in an overlay, then pulse-momentary-overlay | |
206 | ;; will still be nil, and won't need modifying. | |
207 | (when pulse-momentary-overlay | |
208 | ;; clear the starting face | |
209 | (mapc | |
210 | (lambda (ol) | |
211 | (overlay-put ol 'face (overlay-get ol 'original-face)) | |
212 | (overlay-put ol 'original-face nil) | |
213 | ;; Clear the overlay if it needs deleting. | |
214 | (when (overlay-get ol 'pulse-delete) (delete-overlay ol))) | |
215 | pulse-momentary-overlay) | |
216 | ||
217 | ;; Clear the variable. | |
218 | (setq pulse-momentary-overlay nil)) | |
219 | ||
220 | ;; Reset the pulsing face. | |
221 | (pulse-reset-face) | |
222 | ||
223 | ;; Remove this hook. | |
224 | (remove-hook 'pre-command-hook 'pulse-momentary-unhighlight)) | |
225 | ||
226 | (defun pulse-momentary-highlight-one-line (point &optional face) | |
227 | "Highlight the line around POINT, unhighlighting before next command. | |
228 | Optional argument FACE specifies the face to do the highlighting." | |
229 | (let ((start (point-at-bol)) | |
230 | (end (save-excursion | |
231 | (end-of-line) | |
232 | (when (not (eobp)) | |
233 | (forward-char 1)) | |
234 | (point)))) | |
235 | (pulse-momentary-highlight-region start end face))) | |
236 | ||
237 | (defun pulse-momentary-highlight-region (start end &optional face) | |
238 | "Highlight between START and END, unhighlighting before next command. | |
239 | Optional argument FACE specifies the fact to do the highlighting." | |
240 | (let ((o (make-overlay start end))) | |
241 | ;; Mark it for deletion | |
242 | (overlay-put o 'pulse-delete t) | |
243 | (pulse-momentary-highlight-overlay o face))) | |
244 | ||
245 | ;;; Random integration with other tools | |
246 | ||
247 | (defvar pulse-command-advice-flag nil) | |
248 | ||
249 | (defun pulse-line-hook-function () | |
250 | "Function used in hooks to pulse the current line. | |
251 | Only pulses the line if `pulse-command-advice-flag' is non-nil." | |
252 | (when pulse-command-advice-flag | |
253 | (pulse-momentary-highlight-one-line (point)))) | |
254 | ||
255 | (provide 'pulse) | |
256 | ||
257 | ;;; pulse.el ends here |