From: Eshel Yaron Date: Sat, 8 Jun 2024 19:42:36 +0000 (+0200) Subject: Move pulse.el out of CEDET X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=4fcb2949c7548faf82e5efea447850d3f998962a;p=emacs.git Move pulse.el out of CEDET --- diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el deleted file mode 100644 index d9f6a40865a..00000000000 --- a/lisp/cedet/pulse.el +++ /dev/null @@ -1,232 +0,0 @@ -;;; pulse.el --- Pulsing Overlays -*- lexical-binding: t; -*- - -;; Copyright (C) 2007-2024 Free Software Foundation, Inc. - -;; Author: Eric M. Ludlam -;; 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 . - -;;; 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-tick' - 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. https://cedet.sourceforge.net - -(require 'color) - -(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 '(choice (const :tag "Highlight with unchanging color" nil) - (const :tag "No highlight" never) - (other :tag "Pulse" t))) - -(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: - -(defcustom pulse-iterations 10 - "Number of iterations in a pulse operation." - :group 'pulse - :type 'number) - -(defcustom pulse-delay .03 - "Delay between face lightening iterations." - :group 'pulse - :type 'number) - -;;; Convenience Functions -;; -(defvar pulse-momentary-overlay nil - "The current pulsing overlay.") - -(defvar pulse-momentary-timer nil - "The current pulsing timer.") - -(defvar pulse-momentary-iteration 0 - "The current pulsing iteration.") - -(defun pulse-reset-face (&optional face) - "Reset the pulse highlighting FACE." - (set-face-background 'pulse-highlight-face - (if face - (face-background face nil t) - (face-background 'pulse-highlight-start-face) - )) - (set-face-extend 'pulse-highlight-face - (face-extend-p (or face 'pulse-highlight-start-face) - nil t)) - (put 'pulse-highlight-face :startface (or face - 'pulse-highlight-start-face)) - (setq pulse-momentary-iteration 0)) - -(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)) - ;; Make this overlay take priority over the `transient-mark-mode' - ;; overlay. - (overlay-put o 'original-priority (overlay-get o 'priority)) - (overlay-put o 'priority 1) - (setq 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. - (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) - (let* ((start (color-name-to-rgb - (face-background 'pulse-highlight-face nil 'default))) - (stop (color-name-to-rgb (face-background 'default))) - (colors (mapcar (apply-partially 'apply 'color-rgb-to-hex) - (color-gradient start stop pulse-iterations)))) - (setq pulse-momentary-timer - (run-with-timer 0 pulse-delay #'pulse-tick - colors - (time-add nil - (* pulse-delay pulse-iterations)))))))) - -(defun pulse-tick (colors stop-time) - (if (time-less-p nil stop-time) - (when-let (color (elt colors pulse-momentary-iteration)) - (set-face-background 'pulse-highlight-face color) - (setq pulse-momentary-iteration (1+ pulse-momentary-iteration))) - (pulse-momentary-unhighlight))) - -(defun pulse-momentary-unhighlight () - "Unhighlight a line recently highlighted." - (when pulse-momentary-overlay - ;; clear the starting face - (let ((ol pulse-momentary-overlay)) - (overlay-put ol 'face (overlay-get ol 'original-face)) - (overlay-put ol 'original-face nil) - (overlay-put ol 'priority (overlay-get ol 'original-priority)) - ;; Clear the overlay if it needs deleting. - (when (overlay-get ol 'pulse-delete) (delete-overlay ol))) - - ;; Clear the variable. - (setq pulse-momentary-overlay nil) - - ;; 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 (&optional point face) - "Highlight the line around POINT, unhighlighting before next command. -If POINT is nil or missing, the current point is used instead. - -Optional argument FACE specifies the face to do the highlighting." - (save-excursion - (goto-char (or point (point))) - (let ((start (progn (vertical-motion 0) (point))) - (end (progn (vertical-motion 1) (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." - (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 diff --git a/lisp/pulse.el b/lisp/pulse.el new file mode 100644 index 00000000000..d9f6a40865a --- /dev/null +++ b/lisp/pulse.el @@ -0,0 +1,232 @@ +;;; pulse.el --- Pulsing Overlays -*- lexical-binding: t; -*- + +;; Copyright (C) 2007-2024 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam +;; 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 . + +;;; 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-tick' - 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. https://cedet.sourceforge.net + +(require 'color) + +(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 '(choice (const :tag "Highlight with unchanging color" nil) + (const :tag "No highlight" never) + (other :tag "Pulse" t))) + +(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: + +(defcustom pulse-iterations 10 + "Number of iterations in a pulse operation." + :group 'pulse + :type 'number) + +(defcustom pulse-delay .03 + "Delay between face lightening iterations." + :group 'pulse + :type 'number) + +;;; Convenience Functions +;; +(defvar pulse-momentary-overlay nil + "The current pulsing overlay.") + +(defvar pulse-momentary-timer nil + "The current pulsing timer.") + +(defvar pulse-momentary-iteration 0 + "The current pulsing iteration.") + +(defun pulse-reset-face (&optional face) + "Reset the pulse highlighting FACE." + (set-face-background 'pulse-highlight-face + (if face + (face-background face nil t) + (face-background 'pulse-highlight-start-face) + )) + (set-face-extend 'pulse-highlight-face + (face-extend-p (or face 'pulse-highlight-start-face) + nil t)) + (put 'pulse-highlight-face :startface (or face + 'pulse-highlight-start-face)) + (setq pulse-momentary-iteration 0)) + +(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)) + ;; Make this overlay take priority over the `transient-mark-mode' + ;; overlay. + (overlay-put o 'original-priority (overlay-get o 'priority)) + (overlay-put o 'priority 1) + (setq 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. + (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) + (let* ((start (color-name-to-rgb + (face-background 'pulse-highlight-face nil 'default))) + (stop (color-name-to-rgb (face-background 'default))) + (colors (mapcar (apply-partially 'apply 'color-rgb-to-hex) + (color-gradient start stop pulse-iterations)))) + (setq pulse-momentary-timer + (run-with-timer 0 pulse-delay #'pulse-tick + colors + (time-add nil + (* pulse-delay pulse-iterations)))))))) + +(defun pulse-tick (colors stop-time) + (if (time-less-p nil stop-time) + (when-let (color (elt colors pulse-momentary-iteration)) + (set-face-background 'pulse-highlight-face color) + (setq pulse-momentary-iteration (1+ pulse-momentary-iteration))) + (pulse-momentary-unhighlight))) + +(defun pulse-momentary-unhighlight () + "Unhighlight a line recently highlighted." + (when pulse-momentary-overlay + ;; clear the starting face + (let ((ol pulse-momentary-overlay)) + (overlay-put ol 'face (overlay-get ol 'original-face)) + (overlay-put ol 'original-face nil) + (overlay-put ol 'priority (overlay-get ol 'original-priority)) + ;; Clear the overlay if it needs deleting. + (when (overlay-get ol 'pulse-delete) (delete-overlay ol))) + + ;; Clear the variable. + (setq pulse-momentary-overlay nil) + + ;; 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 (&optional point face) + "Highlight the line around POINT, unhighlighting before next command. +If POINT is nil or missing, the current point is used instead. + +Optional argument FACE specifies the face to do the highlighting." + (save-excursion + (goto-char (or point (point))) + (let ((start (progn (vertical-motion 0) (point))) + (end (progn (vertical-motion 1) (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." + (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