lisp/cedet/pulse.el

   1 ;;; pulse.el --- Pulsing Overlays
   2
   3 ;;; Copyright (C) 2007-2015 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."
 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                                  nil t)))
 138            (frac  (list (/ (- (nth 0 frame) (nth 0 start)) pulse-iterations)
 139                         (/ (- (nth 1 frame) (nth 1 start)) pulse-iterations)
 140                         (/ (- (nth 2 frame) (nth 2 start)) pulse-iterations)))
 141            (it (get 'pulse-highlight-face :iteration))
 142            )
 143       (set-face-background 'pulse-highlight-face
 144                            (pulse-color-values-to-hex
 145                             (list
 146                              (+ (nth 0 start) (* (nth 0 frac) it))
 147                              (+ (nth 1 start) (* (nth 1 frac) it))
 148                              (+ (nth 2 start) (* (nth 2 frac) it)))))
 149       (put 'pulse-highlight-face :iteration (1+ it))
 150       (if (>= (1+ it) pulse-iterations)
 151           nil
 152         t))))
 153
 154 (defun pulse-reset-face (&optional face)
 155   "Reset the pulse highlighting FACE."
 156   (set-face-background 'pulse-highlight-face
 157                        (if face
 158                            (face-background face nil t)
 159                          (face-background 'pulse-highlight-start-face)
 160                          ))
 161   (put 'pulse-highlight-face :startface (or face
 162                                             'pulse-highlight-start-face))
 163   (put 'pulse-highlight-face :iteration 0))
 164
 165 (defun pulse (&optional face)
 166   "Pulse the colors on our highlight face.
 167 If optional FACE is provided, reset the face to FACE color,
 168 instead of `pulse-highlight-start-face'.
 169 Be sure to call `pulse-reset-face' after calling pulse."
 170   (unwind-protect
 171       (progn
 172         (pulse-reset-face face)
 173         (while (and (pulse-lighten-highlight)
 174                     (sit-for pulse-delay))
 175           nil))))
 176
 177 ;;; Convenience Functions
 178 ;;
 179 (defvar pulse-momentary-overlay nil
 180   "The current pulsing overlay.")
 181
 182 (defvar pulse-momentary-stop-time nil
 183   "The current stop time.")
 184
 185 (defun pulse-momentary-highlight-overlay (o &optional face)
 186   "Pulse the overlay O, unhighlighting before next command.
 187 Optional argument FACE specifies the face to do the highlighting."
 188   (overlay-put o 'original-face (overlay-get o 'face))
 189   (add-to-list 'pulse-momentary-overlay o)
 190   (if (eq pulse-flag 'never)
 191       nil
 192     (if (or (not pulse-flag) (not (pulse-available-p)))
 193         ;; Provide a face... clear on next command
 194         (progn
 195           (overlay-put o 'face (or face 'pulse-highlight-start-face))
 196           (add-hook 'pre-command-hook
 197                     'pulse-momentary-unhighlight))
 198       ;; Pulse it.
 199       (overlay-put o 'face 'pulse-highlight-face)
 200       ;; The pulse function puts FACE onto 'pulse-highlight-face.
 201       ;; Thus above we put our face on the overlay, but pulse
 202       ;; with a reference face needed for the color.
 203       (pulse-reset-face face)
 204       (setq pulse-momentary-stop-time (time-add (current-time)
 205                                                 (* pulse-delay
 206                                                    pulse-iterations)))
 207       (let ((timer (run-with-timer 0 pulse-delay #'ignore)))
 208         (timer-set-function timer #'pulse-tick
 209                             (list
 210                              timer))))))
 211
 212 (defun pulse-tick (timer)
 213   (if (time-less-p (current-time) pulse-momentary-stop-time)
 214       (pulse-lighten-highlight)
 215     (pulse-momentary-unhighlight)
 216     (cancel-timer timer)))
 217
 218 (defun pulse-momentary-unhighlight ()
 219   "Unhighlight a line recently highlighted."
 220   ;; If someone passes in an overlay, then pulse-momentary-overlay
 221   ;; will still be nil, and won't need modifying.
 222   (when pulse-momentary-overlay
 223     ;; clear the starting face
 224     (mapc
 225      (lambda (ol)
 226        (overlay-put ol 'face (overlay-get ol 'original-face))
 227        (overlay-put ol 'original-face nil)
 228        ;; Clear the overlay if it needs deleting.
 229        (when (overlay-get ol 'pulse-delete) (delete-overlay ol)))
 230      pulse-momentary-overlay)
 231
 232     ;; Clear the variable.
 233     (setq pulse-momentary-overlay nil))
 234
 235   ;; Reset the pulsing face.
 236   (pulse-reset-face)
 237
 238   ;; Signal the timer to cancel.
 239   (setq pulse-momentary-stop-time (current-time))
 240
 241   ;; Remove this hook.
 242   (remove-hook 'pre-command-hook 'pulse-momentary-unhighlight))
 243
 244 ;;;###autoload
 245 (defun pulse-momentary-highlight-one-line (point &optional face)
 246   "Highlight the line around POINT, unhighlighting before next command.
 247 Optional argument FACE specifies the face to do the highlighting."
 248   (save-excursion
 249     (goto-char point)
 250     (let ((start (point-at-bol))
 251           (end (save-excursion
 252                  (end-of-line)
 253                  (when (not (eobp))
 254                    (forward-char 1))
 255                  (point))))
 256       (pulse-momentary-highlight-region start end face))))
 257
 258 ;;;###autoload
 259 (defun pulse-momentary-highlight-region (start end &optional face)
 260   "Highlight between START and END, unhighlighting before next command.
 261 Optional argument FACE specifies the face to do the highlighting."
 262   (let ((o (make-overlay start end)))
 263     ;; Mark it for deletion
 264     (overlay-put o 'pulse-delete t)
 265     (pulse-momentary-highlight-overlay o face)))
 266
 267 ;;; Random integration with other tools
 268
 269 (defvar pulse-command-advice-flag nil)
 270
 271 (defun pulse-line-hook-function ()
 272   "Function used in hooks to pulse the current line.
 273 Only pulses the line if `pulse-command-advice-flag' is non-nil."
 274   (when pulse-command-advice-flag
 275     (pulse-momentary-highlight-one-line (point))))
 276
 277 (provide 'pulse)
 278
 279 ;;; pulse.el ends here