lisp/cedet/pulse.el

   1 ;;; pulse.el --- Pulsing Overlays
   2
   3 ;;; Copyright (C) 2007, 2008, 2009, 2010 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 ;;
  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
 252 ;; arch-tag: 6e2f78c1-65b3-4164-a141-872cb1552959
 253 ;;; pulse.el ends here