[bpt/emacs.git] / lisp / cedet / pulse.el

;;; pulse.el --- Pulsing Overlays

;;; Copyright (C) 2007-2012 Free Software Foundation, Inc.

;; Author: Eric M. Ludlam <eric@siege-engine.com>
;; Version: 1.0

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Manage temporary pulsing of faces and overlays.
;;
;; This is a temporal decoration technique where something is to be
;; highlighted briefly.  This adds a gentle pulsing style to the text
;; decorated this way.
;;
;; The following are useful entry points:
;;
;; `pulse' - Cause `pulse-highlight-face' to shift toward background color.
;;      Assumes you are using a version of Emacs that supports pulsing.
;;
;;
;; `pulse-momentary-highlight-one-line' - Pulse a single line at POINT.
;; `pulse-momentary-highlight-region' - Pulse a region.
;; `pulse-momentary-highlight-overlay' - Pulse an overlay.
;;      These three functions will just blink the specified area if
;;      the version of Emacs you are using doesn't support pulsing.
;;
;; `pulse-line-hook-function' - A simple function that can be used in a
;;      hook that will pulse whatever line the cursor is on.
;;
;;; History:
;;
;; The original pulse code was written for semantic tag highlighting.
;; It has been extracted, and adapted for general purpose pulsing.
;;
;; Pulse is a part of CEDET.  http://cedet.sf.net

(defun  pulse-available-p ()
  "Return non-nil if pulsing is available on the current frame."
  (condition-case nil
      (let ((v (color-values (face-background 'default))))
	(numberp (car-safe v)))
    (error nil)))

(defcustom pulse-flag (pulse-available-p)
  "Whether to use pulsing for momentary highlighting.
Pulsing involves a bright highlight that slowly shifts to the
background color.

If the value is nil, highlight with an unchanging color until a
key is pressed.
If the value is `never', do no coloring at all.
Any other value means to do the default pulsing behavior.

If `pulse-flag' is non-nil, but `pulse-available-p' is nil, then
this flag is ignored."
  :group 'pulse
  :type 'boolean)

(defface pulse-highlight-start-face
  '((((class color) (background dark))
     (:background "#AAAA33"))
    (((class color) (background light))
     (:background "#FFFFAA")))
  "*Face used at beginning of a highlight."
  :group 'pulse)

(defface pulse-highlight-face
  '((((class color) (background dark))
     (:background "#AAAA33"))
    (((class color) (background light))
     (:background "#FFFFAA")))
  "*Face used during a pulse for display.  *DO NOT CUSTOMIZE*
Face used for temporary highlighting of tags for effect."
  :group 'pulse)

;;; Code:
;;
(defun pulse-int-to-hex (int &optional nb-digits)
  "Convert integer argument INT to a #XXXXXXXXXXXX format hex string.
Each X in the output string is a hexadecimal digit.
NB-DIGITS is the number of hex digits.  If INT is too large to be
represented with NB-DIGITS, then the result is truncated from the
left.  So, for example, INT=256 and NB-DIGITS=2 returns \"00\", since
the hex equivalent of 256 decimal is 100, which is more than 2 digits.

This function was blindly copied from hexrgb.el by Drew Adams.
http://www.emacswiki.org/cgi-bin/wiki/hexrgb.el"
  (setq nb-digits (or nb-digits 4))
  (substring (format (concat "%0" (int-to-string nb-digits) "X") int) (- nb-digits)))

(defun pulse-color-values-to-hex (values)
  "Convert list of rgb color VALUES to a hex string, #XXXXXXXXXXXX.
Each X in the string is a hexadecimal digit.
Input VALUES is as for the output of `x-color-values'.

This function was blindly copied from hexrgb.el by Drew Adams.
http://www.emacswiki.org/cgi-bin/wiki/hexrgb.el"
  (concat "#"
          (pulse-int-to-hex (nth 0 values) 4) ; red
          (pulse-int-to-hex (nth 1 values) 4) ; green
          (pulse-int-to-hex (nth 2 values) 4))) ; blue

(defcustom pulse-iterations 10
  "Number of iterations in a pulse operation."
  :group 'pulse
  :type 'number)
(defcustom pulse-delay .03
  "Delay between face lightening iterations, as used by `sit-for'."
  :group 'pulse
  :type 'number)

(defun pulse-lighten-highlight ()
  "Lighten the face by 1/`pulse-iterations' toward the background color.
Return t if there is more drift to do, nil if completed."
  (if (>= (get 'pulse-highlight-face :iteration) pulse-iterations)
      nil
    (let* ((frame (color-values (face-background 'default)))
	   (start (color-values (face-background
				 (get 'pulse-highlight-face
				      :startface))))
	   (frac  (list (/ (- (nth 0 frame) (nth 0 start)) pulse-iterations)
			(/ (- (nth 1 frame) (nth 1 start)) pulse-iterations)
			(/ (- (nth 2 frame) (nth 2 start)) pulse-iterations)))
	   (it (get 'pulse-highlight-face :iteration))
	   )
      (set-face-background 'pulse-highlight-face
			   (pulse-color-values-to-hex
			    (list
			     (+ (nth 0 start) (* (nth 0 frac) it))
			     (+ (nth 1 start) (* (nth 1 frac) it))
			     (+ (nth 2 start) (* (nth 2 frac) it)))))
      (put 'pulse-highlight-face :iteration (1+ it))
      (if (>= (1+ it) pulse-iterations)
	  nil
	t))))

(defun pulse-reset-face (&optional face)
  "Reset the pulse highlighting FACE."
  (set-face-background 'pulse-highlight-face
		       (if face
			   (face-background face)
			 (face-background 'pulse-highlight-start-face)
			 ))
  (put 'pulse-highlight-face :startface (or face
					    'pulse-highlight-start-face))
  (put 'pulse-highlight-face :iteration 0))

(defun pulse (&optional face)
  "Pulse the colors on our highlight face.
If optional FACE is provided, reset the face to FACE color,
instead of `pulse-highlight-start-face'.
Be sure to call `pulse-reset-face' after calling pulse."
  (unwind-protect
      (progn
	(pulse-reset-face face)
	(while (and (pulse-lighten-highlight)
		    (sit-for pulse-delay))
	  nil))))

;;; Convenience Functions
;;
(defvar pulse-momentary-overlay nil
  "The current pulsing overlay.")

(defun pulse-momentary-highlight-overlay (o &optional face)
  "Pulse the overlay O, unhighlighting before next command.
Optional argument FACE specifies the fact to do the highlighting."
  (overlay-put o 'original-face (overlay-get o 'face))
  (add-to-list 'pulse-momentary-overlay o)
  (if (eq pulse-flag 'never)
      nil
    (if (or (not pulse-flag) (not (pulse-available-p)))
	;; Provide a face... clear on next command
	(progn
	  (overlay-put o 'face (or face 'pulse-highlight-start-face))
	  (add-hook 'pre-command-hook
		    'pulse-momentary-unhighlight))
      ;; pulse it.
      (unwind-protect
	  (progn
	    (overlay-put o 'face 'pulse-highlight-face)
	    ;; The pulse function puts FACE onto 'pulse-highlight-face.
	    ;; Thus above we put our face on the overlay, but pulse
	    ;; with a reference face needed for the color.
	    (pulse face))
	(pulse-momentary-unhighlight)))))

(defun pulse-momentary-unhighlight ()
  "Unhighlight a line recently highlighted."
  ;; If someone passes in an overlay, then pulse-momentary-overlay
  ;; will still be nil, and won't need modifying.
  (when pulse-momentary-overlay
    ;; clear the starting face
    (mapc
     (lambda (ol)
       (overlay-put ol 'face (overlay-get ol 'original-face))
       (overlay-put ol 'original-face nil)
       ;; Clear the overlay if it needs deleting.
       (when (overlay-get ol 'pulse-delete) (delete-overlay ol)))
     pulse-momentary-overlay)

    ;; Clear the variable.
    (setq pulse-momentary-overlay nil))

  ;; Reset the pulsing face.
  (pulse-reset-face)

  ;; Remove this hook.
  (remove-hook 'pre-command-hook 'pulse-momentary-unhighlight))

(defun pulse-momentary-highlight-one-line (point &optional face)
  "Highlight the line around POINT, unhighlighting before next command.
Optional argument FACE specifies the face to do the highlighting."
  (let ((start (point-at-bol))
	(end (save-excursion
	       (end-of-line)
	       (when (not (eobp))
		 (forward-char 1))
	       (point))))
    (pulse-momentary-highlight-region start end face)))

(defun pulse-momentary-highlight-region (start end &optional face)
  "Highlight between START and END, unhighlighting before next command.
Optional argument FACE specifies the fact to do the highlighting."
  (let ((o (make-overlay start end)))
    ;; Mark it for deletion
    (overlay-put o 'pulse-delete t)
    (pulse-momentary-highlight-overlay o face)))

;;; Random integration with other tools

(defvar pulse-command-advice-flag nil)

(defun pulse-line-hook-function ()
  "Function used in hooks to pulse the current line.
Only pulses the line if `pulse-command-advice-flag' is non-nil."
  (when pulse-command-advice-flag
    (pulse-momentary-highlight-one-line (point))))

(provide 'pulse)

;;; pulse.el ends here
Commit	Line	Data
666fd2cc CY	1	;;; pulse.el --- Pulsing Overlays
666fd2cc CY	2
acaf905b	3	;;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
666fd2cc CY	4
666fd2cc CY	5	;; Author: Eric M. Ludlam <eric@siege-engine.com>
b9749554	6	;; Version: 1.0
666fd2cc CY	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	;;
666fd2cc CY	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.
cd1181db	39	;; `pulse-momentary-highlight-overlay' - Pulse an overlay.
666fd2cc CY	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)
b9749554 EL	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.
cd1181db	68	Any other value means to do the default pulsing behavior.
666fd2cc CY	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")))
3ed8598c	80	"*Face used at beginning of a highlight."
666fd2cc CY	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.
cd1181db	166	If optional FACE is provided, reset the face to FACE color,
666fd2cc CY	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)
b9749554 EL	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
666fd2cc	190	(progn
b9749554 EL	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)))))
666fd2cc CY	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