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