Commit | Line | Data |
---|---|---|
666fd2cc CY |
1 | ;;; pulse.el --- Pulsing Overlays |
2 | ||
acaf905b | 3 | ;;; Copyright (C) 2007-2012 Free Software Foundation, Inc. |
666fd2cc CY |
4 | |
5 | ;; Author: Eric M. Ludlam <eric@siege-engine.com> | |
b9749554 | 6 | ;; Version: 1.0 |
666fd2cc CY |
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 <http://www.gnu.org/licenses/>. | |
22 | ||
23 | ;;; Commentary: | |
24 | ;; | |
25 | ;; Manage temporary pulsing of faces and overlays. | |
26 | ;; | |
27 | ;; This is a temporal decoration technique where something is to be | |
28 | ;; highlighted briefly. This adds a gentle pulsing style to the text | |
29 | ;; decorated this way. | |
30 | ;; | |
666fd2cc CY |
31 | ;; The following are useful entry points: |
32 | ;; | |
33 | ;; `pulse' - Cause `pulse-highlight-face' to shift toward background color. | |
34 | ;; Assumes you are using a version of Emacs that supports pulsing. | |
35 | ;; | |
36 | ;; | |
37 | ;; `pulse-momentary-highlight-one-line' - Pulse a single line at POINT. | |
38 | ;; `pulse-momentary-highlight-region' - Pulse a region. | |
cd1181db | 39 | ;; `pulse-momentary-highlight-overlay' - Pulse an overlay. |
666fd2cc CY |
40 | ;; These three functions will just blink the specified area if |
41 | ;; the version of Emacs you are using doesn't support pulsing. | |
42 | ;; | |
43 | ;; `pulse-line-hook-function' - A simple function that can be used in a | |
44 | ;; hook that will pulse whatever line the cursor is on. | |
45 | ;; | |
46 | ;;; History: | |
47 | ;; | |
48 | ;; The original pulse code was written for semantic tag highlighting. | |
49 | ;; It has been extracted, and adapted for general purpose pulsing. | |
50 | ;; | |
51 | ;; Pulse is a part of CEDET. http://cedet.sf.net | |
52 | ||
53 | (defun pulse-available-p () | |
54 | "Return non-nil if pulsing is available on the current frame." | |
55 | (condition-case nil | |
56 | (let ((v (color-values (face-background 'default)))) | |
57 | (numberp (car-safe v))) | |
58 | (error nil))) | |
59 | ||
60 | (defcustom pulse-flag (pulse-available-p) | |
b9749554 EL |
61 | "Whether to use pulsing for momentary highlighting. |
62 | Pulsing involves a bright highlight that slowly shifts to the | |
63 | background color. | |
64 | ||
65 | If the value is nil, highlight with an unchanging color until a | |
66 | key is pressed. | |
67 | If the value is `never', do no coloring at all. | |
cd1181db | 68 | Any other value means to do the default pulsing behavior. |
666fd2cc CY |
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"))) | |
3ed8598c | 80 | "*Face used at beginning of a highlight." |
666fd2cc CY |
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. | |
cd1181db | 166 | If optional FACE is provided, reset the face to FACE color, |
666fd2cc CY |
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) | |
b9749554 EL |
186 | (if (eq pulse-flag 'never) |
187 | nil | |
188 | (if (or (not pulse-flag) (not (pulse-available-p))) | |
189 | ;; Provide a face... clear on next command | |
666fd2cc | 190 | (progn |
b9749554 EL |
191 | (overlay-put o 'face (or face 'pulse-highlight-start-face)) |
192 | (add-hook 'pre-command-hook | |
193 | 'pulse-momentary-unhighlight)) | |
194 | ;; pulse it. | |
195 | (unwind-protect | |
196 | (progn | |
197 | (overlay-put o 'face 'pulse-highlight-face) | |
198 | ;; The pulse function puts FACE onto 'pulse-highlight-face. | |
199 | ;; Thus above we put our face on the overlay, but pulse | |
200 | ;; with a reference face needed for the color. | |
201 | (pulse face)) | |
202 | (pulse-momentary-unhighlight))))) | |
666fd2cc CY |
203 | |
204 | (defun pulse-momentary-unhighlight () | |
205 | "Unhighlight a line recently highlighted." | |
206 | ;; If someone passes in an overlay, then pulse-momentary-overlay | |
207 | ;; will still be nil, and won't need modifying. | |
208 | (when pulse-momentary-overlay | |
209 | ;; clear the starting face | |
210 | (mapc | |
211 | (lambda (ol) | |
212 | (overlay-put ol 'face (overlay-get ol 'original-face)) | |
213 | (overlay-put ol 'original-face nil) | |
214 | ;; Clear the overlay if it needs deleting. | |
215 | (when (overlay-get ol 'pulse-delete) (delete-overlay ol))) | |
216 | pulse-momentary-overlay) | |
217 | ||
218 | ;; Clear the variable. | |
219 | (setq pulse-momentary-overlay nil)) | |
220 | ||
221 | ;; Reset the pulsing face. | |
222 | (pulse-reset-face) | |
223 | ||
224 | ;; Remove this hook. | |
225 | (remove-hook 'pre-command-hook 'pulse-momentary-unhighlight)) | |
226 | ||
227 | (defun pulse-momentary-highlight-one-line (point &optional face) | |
228 | "Highlight the line around POINT, unhighlighting before next command. | |
229 | Optional argument FACE specifies the face to do the highlighting." | |
230 | (let ((start (point-at-bol)) | |
231 | (end (save-excursion | |
232 | (end-of-line) | |
233 | (when (not (eobp)) | |
234 | (forward-char 1)) | |
235 | (point)))) | |
236 | (pulse-momentary-highlight-region start end face))) | |
237 | ||
238 | (defun pulse-momentary-highlight-region (start end &optional face) | |
239 | "Highlight between START and END, unhighlighting before next command. | |
240 | Optional argument FACE specifies the fact to do the highlighting." | |
241 | (let ((o (make-overlay start end))) | |
242 | ;; Mark it for deletion | |
243 | (overlay-put o 'pulse-delete t) | |
244 | (pulse-momentary-highlight-overlay o face))) | |
245 | ||
246 | ;;; Random integration with other tools | |
247 | ||
248 | (defvar pulse-command-advice-flag nil) | |
249 | ||
250 | (defun pulse-line-hook-function () | |
251 | "Function used in hooks to pulse the current line. | |
252 | Only pulses the line if `pulse-command-advice-flag' is non-nil." | |
253 | (when pulse-command-advice-flag | |
254 | (pulse-momentary-highlight-one-line (point)))) | |
255 | ||
256 | (provide 'pulse) | |
257 | ||
258 | ;;; pulse.el ends here |