Correct merge
[emacs.git] / lisp / cedet / pulse.el
blobe2a48a428a3b76ad6ca0c9b0daae7c05272593a3
1 ;;; pulse.el --- Pulsing Overlays
3 ;;; Copyright (C) 2007-2014 Free Software Foundation, Inc.
5 ;; Author: Eric M. Ludlam <eric@siege-engine.com>
6 ;; Version: 1.0
8 ;; This file is part of GNU Emacs.
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.
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.
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/>.
23 ;;; Commentary:
25 ;; Manage temporary pulsing of faces and overlays.
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.
31 ;; The following are useful entry points:
33 ;; `pulse' - Cause `pulse-highlight-face' to shift toward background color.
34 ;; Assumes you are using a version of Emacs that supports pulsing.
37 ;; `pulse-momentary-highlight-one-line' - Pulse a single line at POINT.
38 ;; `pulse-momentary-highlight-region' - Pulse a region.
39 ;; `pulse-momentary-highlight-overlay' - Pulse an overlay.
40 ;; These three functions will just blink the specified area if
41 ;; the version of Emacs you are using doesn't support pulsing.
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.
46 ;;; History:
48 ;; The original pulse code was written for semantic tag highlighting.
49 ;; It has been extracted, and adapted for general purpose pulsing.
51 ;; Pulse is a part of CEDET. http://cedet.sf.net
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)))
60 (defcustom pulse-flag (pulse-available-p)
61 "Whether to use pulsing for momentary highlighting.
62 Pulsing involves a bright highlight that slowly shifts to the
63 background color.
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.
68 Any other value means to do the default pulsing behavior.
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)
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 highlight."
81 :group 'pulse)
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)
92 ;;; Code:
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.
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)))
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'.
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
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)
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)
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))
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)
151 t))))
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)
160 (put 'pulse-highlight-face :startface (or face
161 'pulse-highlight-start-face))
162 (put 'pulse-highlight-face :iteration 0))
164 (defun pulse (&optional face)
165 "Pulse the colors on our highlight face.
166 If optional FACE is provided, 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))))
176 ;;; Convenience Functions
178 (defvar pulse-momentary-overlay nil
179 "The current pulsing overlay.")
181 (defun pulse-momentary-highlight-overlay (o &optional face)
182 "Pulse the overlay O, unhighlighting before next command.
183 Optional argument FACE specifies the face to do the highlighting."
184 (overlay-put o 'original-face (overlay-get o 'face))
185 (add-to-list 'pulse-momentary-overlay o)
186 (if (eq pulse-flag 'never)
188 (if (or (not pulse-flag) (not (pulse-available-p)))
189 ;; Provide a face... clear on next command
190 (progn
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)))))
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)
218 ;; Clear the variable.
219 (setq pulse-momentary-overlay nil))
221 ;; Reset the pulsing face.
222 (pulse-reset-face)
224 ;; Remove this hook.
225 (remove-hook 'pre-command-hook 'pulse-momentary-unhighlight))
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)))
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 face 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)))
246 ;;; Random integration with other tools
248 (defvar pulse-command-advice-flag nil)
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))))
256 (provide 'pulse)
258 ;;; pulse.el ends here