;;; pulse.el --- Pulsing Overlays
-;;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
+;;; 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.
;; highlighted briefly. This adds a gentle pulsing style to the text
;; decorated this way.
;;
-;; Useful user functions:
-;;
-;; `pulse-enable-integration-advice' - Turn on advice to make various
-;; Emacs commands pulse, such as `goto-line', or `find-tag'.
-;;
;; The following are useful entry points:
;;
;; `pulse' - Cause `pulse-highlight-face' to shift toward background color.
;;
;; `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
+;; `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 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
(error nil)))
(defcustom pulse-flag (pulse-available-p)
- "*Non-nil means to pulse the overlay face for momentary highlighting.
-Pulsing involves a bright highlight that slowly shifts to the background
-color. Non-nil just means to highlight with an unchanging color for a short
-time.
+ "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."
(:background "#AAAA33"))
(((class color) (background light))
(:background "#FFFFAA")))
- "*Face used at beginning of a highight."
+ "*Face used at beginning of a highlight."
:group 'pulse)
(defface pulse-highlight-face
Face used for temporary highlighting of tags for effect."
:group 'pulse)
-;;; Compatibility
-(defalias 'pulse-overlay-live-p 'overlay-buffer)
-(defalias 'pulse-overlay-put 'overlay-put)
-(defalias 'pulse-overlay-get 'overlay-get)
-(defalias 'pulse-overlay-delete 'delete-overlay)
-(defalias 'pulse-make-overlay 'make-overlay)
-
-(when (featurep 'xemacs)
- (defalias 'pulse-overlay-live-p
- (lambda (o)
- (and (extent-live-p o)
- (not (extent-detached-p o))
- (bufferp (extent-buffer o)))))
- (defalias 'pulse-overlay-put 'set-extent-property)
- (defalias 'pulse-overlay-get 'extent-property)
- (defalias 'pulse-overlay-delete 'delete-extent)
- (defalias 'pulse-make-overlay 'make-extent))
-
;;; Code:
;;
(defun pulse-int-to-hex (int &optional nb-digits)
(defun pulse (&optional face)
"Pulse the colors on our highlight face.
-If optional FACE is provide, reset the face to FACE color,
+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
(pulse-reset-face face)
(while (and (pulse-lighten-highlight)
(sit-for pulse-delay))
- nil))
- ))
-
-(defun pulse-test (&optional no-error)
- "Test the lightening function for pulsing a line.
-When optional NO-ERROR Don't throw an error if we can't run tests."
- (interactive)
- (if (or (not pulse-flag) (not (pulse-available-p)))
- (if no-error
- nil
- (error (concat "Pulse test only works on versions of Emacs"
- " that support pulsing")))
- ;; Run the tests
- (when (interactive-p)
- (message "<Press a key> Pulse one line.")
- (read-char))
- (pulse-momentary-highlight-one-line (point))
- (when (interactive-p)
- (message "<Press a key> Pulse a region.")
- (read-char))
- (pulse-momentary-highlight-region (point)
- (save-excursion
- (condition-case nil
- (forward-char 30)
- (error nil))
- (point)))
- (when (interactive-p)
- (message "<Press a key> Pulse line a specific color.")
- (read-char))
- (pulse-momentary-highlight-one-line (point) 'modeline)
- (when (interactive-p)
- (message "<Press a key> Pulse a pre-existing overlay.")
- (read-char))
- (let* ((start (point-at-bol))
- (end (save-excursion
- (end-of-line)
- (when (not (eobp))
- (forward-char 1))
- (point)))
- (o (pulse-make-overlay start end))
- )
- (pulse-momentary-highlight-overlay o)
- (if (pulse-overlay-live-p o)
- (pulse-overlay-delete o)
- (error "Non-temporary overlay was deleted!"))
- )
- (when (interactive-p)
- (message "Done!"))))
-
+ nil))))
;;; Convenience Functions
;;
(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."
- (pulse-overlay-put o 'original-face (pulse-overlay-get o 'face))
+ (overlay-put o 'original-face (overlay-get o 'face))
(add-to-list 'pulse-momentary-overlay o)
- (if (or (not pulse-flag) (not (pulse-available-p)))
- ;; Provide a face... clear on next command
- (progn
- (pulse-overlay-put o 'face (or face 'pulse-highlight-start-face))
- (add-hook 'pre-command-hook
- 'pulse-momentary-unhighlight)
- )
- ;; pulse it.
- (unwind-protect
+ (if (eq pulse-flag 'never)
+ nil
+ (if (or (not pulse-flag) (not (pulse-available-p)))
+ ;; Provide a face... clear on next command
(progn
- (pulse-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))
- )
- )
+ (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."
;; clear the starting face
(mapc
(lambda (ol)
- (pulse-overlay-put ol 'face (pulse-overlay-get ol 'original-face))
- (pulse-overlay-put ol 'original-face nil)
+ (overlay-put ol 'face (overlay-get ol 'original-face))
+ (overlay-put ol 'original-face nil)
;; Clear the overlay if it needs deleting.
- (when (pulse-overlay-get ol 'pulse-delete) (pulse-overlay-delete ol)))
+ (when (overlay-get ol 'pulse-delete) (delete-overlay ol)))
pulse-momentary-overlay)
;; Clear the variable.
(pulse-reset-face)
;; Remove this hook.
- (remove-hook 'pre-command-hook 'pulse-momentary-unhighlight)
- )
+ (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.
(when (not (eobp))
(forward-char 1))
(point))))
- (pulse-momentary-highlight-region start end face)
- ))
+ (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 (pulse-make-overlay start end)))
+ (let ((o (make-overlay start end)))
;; Mark it for deletion
- (pulse-overlay-put o 'pulse-delete t)
+ (overlay-put o 'pulse-delete t)
(pulse-momentary-highlight-overlay o face)))
;;; Random integration with other tools
-;;
-(defvar pulse-command-advice-flag nil
- "Non-nil means pulse advice is active.
-To active pulse advice, use `pulse-enable-integration-advice'.")
-
-(defun pulse-toggle-integration-advice (arg)
- "Toggle activation of advised functions that will now pulse.
-Wint no ARG, toggle the pulse advice.
-With a negative ARG, disable pulse advice.
-With a positive ARG, enable pulse advice.
-Currently advised functions include:
- `goto-line'
- `exchange-point-and-mark'
- `find-tag'
- `tags-search'
- `tags-loop-continue'
- `pop-tag-mark'
- `imenu-default-goto-function'
-Pulsing via `pulse-line-hook-function' has also been added to
-the following hook:
- `next-error-hook'"
- (interactive "P")
- (if (null arg)
- (setq pulse-command-advice-flag (not pulse-command-advice-flag))
- (if (< (prefix-numeric-value arg) 0)
- (setq pulse-command-advice-flag nil)
- (setq pulse-command-advice-flag t)
- )
- )
- (if pulse-command-advice-flag
- (message "Pulse advice enabled")
- (message "Pulse advice disabled"))
- )
-
-(defadvice goto-line (after pulse-advice activate)
- "Cause the line that is `goto'd to pulse when the cursor gets there."
- (when (and pulse-command-advice-flag (interactive-p))
- (pulse-momentary-highlight-one-line (point))))
-(defadvice exchange-point-and-mark (after pulse-advice activate)
- "Cause the line that is `goto'd to pulse when the cursor gets there."
- (when (and pulse-command-advice-flag (interactive-p)
- (> (abs (- (point) (mark))) 400))
- (pulse-momentary-highlight-one-line (point))))
-
-(defadvice find-tag (after pulse-advice activate)
- "After going to a tag, pulse the line the cursor lands on."
- (when (and pulse-command-advice-flag (interactive-p))
- (pulse-momentary-highlight-one-line (point))))
-
-(defadvice tags-search (after pulse-advice activate)
- "After going to a hit, pulse the line the cursor lands on."
- (when (and pulse-command-advice-flag (interactive-p))
- (pulse-momentary-highlight-one-line (point))))
-
-(defadvice tags-loop-continue (after pulse-advice activate)
- "After going to a hit, pulse the line the cursor lands on."
- (when (and pulse-command-advice-flag (interactive-p))
- (pulse-momentary-highlight-one-line (point))))
-
-(defadvice pop-tag-mark (after pulse-advice activate)
- "After going to a hit, pulse the line the cursor lands on."
- (when (and pulse-command-advice-flag (interactive-p))
- (pulse-momentary-highlight-one-line (point))))
-
-(defadvice imenu-default-goto-function (after pulse-advice activate)
- "After going to a tag, pulse the line the cursor lands on."
- (when pulse-command-advice-flag
- (pulse-momentary-highlight-one-line (point))))
+(defvar pulse-command-advice-flag nil)
(defun pulse-line-hook-function ()
"Function used in hooks to pulse the current line.
(when pulse-command-advice-flag
(pulse-momentary-highlight-one-line (point))))
-(add-hook 'next-error-hook 'pulse-line-hook-function)
-
(provide 'pulse)
;;; pulse.el ends here
HCoop / bpt / emacs.git / blobdiff