X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/d7a89815b6d69c3b1793d34bcad8bf0aa21d48c8..3698c4e475fb59730626af5d001599785ef5ef9e:/lisp/cedet/pulse.el

diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el
index 89d44c20a6..41b70d5980 100644
--- a/lisp/cedet/pulse.el
+++ b/lisp/cedet/pulse.el
@@ -1,6 +1,6 @@
 ;;; pulse.el --- Pulsing Overlays
 
-;;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
+;;; Copyright (C) 2007-2016 Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam <eric@siege-engine.com>
 ;; Version: 1.0
@@ -121,7 +121,7 @@ http://www.emacswiki.org/cgi-bin/wiki/hexrgb.el"
   :group 'pulse
   :type 'number)
 (defcustom pulse-delay .03
-  "Delay between face lightening iterations, as used by `sit-for'."
+  "Delay between face lightening iterations."
   :group 'pulse
   :type 'number)
 
@@ -131,58 +131,55 @@ 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))))
+	   (pulse-background (face-background
+			      (get 'pulse-highlight-face
+				   :startface)
+                              nil t)));; can be nil
+      (when pulse-background
+	(let* ((start (color-values pulse-background))
+	       (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 face nil t)
 			 (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.")
 
+(defvar pulse-momentary-timer nil
+  "The current pulsing timer.")
+
 (defun pulse-momentary-highlight-overlay (o &optional face)
   "Pulse the overlay O, unhighlighting before next command.
 Optional argument FACE specifies the face to do the highlighting."
+  ;; We don't support simultaneous highlightings.
+  (pulse-momentary-unhighlight)
   (overlay-put o 'original-face (overlay-get o 'face))
-  (add-to-list 'pulse-momentary-overlay o)
+  (setq pulse-momentary-overlay o)
   (if (eq pulse-flag 'never)
       nil
     (if (or (not pulse-flag) (not (pulse-available-p)))
@@ -191,39 +188,46 @@ Optional argument FACE specifies the face to do the highlighting."
 	  (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)))))
+      ;; Pulse it.
+      (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-reset-face face)
+      (setq pulse-momentary-timer
+            (run-with-timer 0 pulse-delay #'pulse-tick
+                            (time-add (current-time)
+                                      (* pulse-delay pulse-iterations)))))))
+
+(defun pulse-tick (stop-time)
+  (if (time-less-p (current-time) stop-time)
+      (pulse-lighten-highlight)
+    (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)
+    (let ((ol pulse-momentary-overlay))
+      (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)))
 
     ;; Clear the variable.
-    (setq pulse-momentary-overlay nil))
+    (setq pulse-momentary-overlay nil)
+
+    ;; Reset the pulsing face.
+    (pulse-reset-face))
 
-  ;; Reset the pulsing face.
-  (pulse-reset-face)
+  ;; Cancel the timer.
+  (when pulse-momentary-timer
+    (cancel-timer pulse-momentary-timer))
 
   ;; Remove this hook.
   (remove-hook 'pre-command-hook 'pulse-momentary-unhighlight))
 
+;;;###autoload
 (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."
@@ -237,6 +241,7 @@ Optional argument FACE specifies the face to do the highlighting."
                  (point))))
       (pulse-momentary-highlight-region start end face))))
 
+;;;###autoload
 (defun pulse-momentary-highlight-region (start end &optional face)
   "Highlight between START and END, unhighlighting before next command.
 Optional argument FACE specifies the face to do the highlighting."