| 1 | ;;; pulse.el --- Pulsing Overlays |
| 2 | |
| 3 | ;;; Copyright (C) 2007-2012 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Eric M. Ludlam <eric@siege-engine.com> |
| 6 | ;; Version: 1.0 |
| 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 | ;; |
| 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. |
| 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. |
| 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) |
| 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. |
| 68 | Any other value means to do the default pulsing behavior. |
| 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 highlight." |
| 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 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)))) |
| 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 (eq pulse-flag 'never) |
| 187 | nil |
| 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))))) |
| 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 |