From b25139a5322ae809fe32d91d55e2212cc91b1b38 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?El=C3=ADas=20Gabriel=20P=C3=A9rez?= Date: Thu, 10 Apr 2025 11:38:21 -0600 Subject: [PATCH] New pulse functions for pulse faces and new file for ring bell fns These new pulse functions allow pulse any defined face briefly. The new file contains functions intended to be used in `ring-bell-function' as alternatives to `visible-bell'. * lisp/pulse.el (pulse-face-duration): New user option. (pulse-flash-face): New function. * lisp/ring-bell-fns.el (flash-face-attributes) (flash-face-faces): New user options. (flash-face-bell-function, flash-echo-area-bell-function): New functions. (bug#77715) * etc/NEWS: Announce changes --- etc/NEWS | 25 +++++++++++++ lisp/pulse.el | 42 ++++++++++++++++++++++ lisp/ring-bell-fns.el | 81 +++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 148 insertions(+) create mode 100644 lisp/ring-bell-fns.el diff --git a/etc/NEWS b/etc/NEWS index d4e97883322..5bb9324b9cc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1994,6 +1994,31 @@ change their face if the current line exceeds the 'fill-column'. The new face 'display-fill-column-indicator-warning-face' is used to highlight the fill-column indicators. By default, this is disabled. +--- +*** New function 'flash-face-bell-function'. +This function flashes a face briefly. +It is intended to be used in 'ring-bell-function'. + +--- +*** New function 'flash-echo-area-bell-function'. +This function flashes current echo area briefly. +It is intended to be used in 'ring-bell-function'. + +--- +*** New user option 'flash-face-duration'. +This option controls the flash duration for 'flash-face-bell-function' +and 'flash-echo-area-bell-function'. + +--- +*** New user option 'flash-face-faces'. +This option tells 'flash-face-bell-function' which faces should flash. + +--- +*** New user option 'flash-face-attributes' +This option tells 'flash-face-bell-function' and +'flash-echo-area-bell-function' which face attributes should be used +for flash. + --- ** Flymake diff --git a/lisp/pulse.el b/lisp/pulse.el index a2569338e11..3663c6cafdc 100644 --- a/lisp/pulse.el +++ b/lisp/pulse.el @@ -227,6 +227,48 @@ Only pulses the line if `pulse-command-advice-flag' is non-nil." (when pulse-command-advice-flag (pulse-momentary-highlight-one-line (point)))) +;;; Pulse faces +;; Functions for pulse any defined face. +(require 'face-remap) + +(defcustom pulse-face-duration pulse-delay + "Time (in seconds) used for pulse face duration." + :type 'number + :group 'pulse + :version "31.1") + +;; FIXME: The pulse smooth effect cannot be archieved here due +;; the face remaping will not work well for that. +(defun pulse-faces (faces &optional with-face) + "Pulse FACES with face WITH-FACE (if defined) briefly. +FACES must be a list of faces to pulse. +WITH-FACE is optional, it can be a defined face or a list of face +properties to apply." + (when-let* (((numberp pulse-face-duration)) ; Ensure time is a number + (with-face (or with-face 'pulse-highlight-face)) + (in-buffer (current-buffer)) + (cookies (mapcar (lambda (f) + (if (consp with-face) + (apply #'face-remap-add-relative f with-face) + (face-remap-add-relative f with-face))) + faces))) + ;; Use run-with-timer if the duration is very long for not blocking + ;; emacs, otherwise fallback to sleep-for. + (if (> pulse-face-duration 0.1) + (run-with-timer pulse-face-duration 0 + (lambda () + ;; Remove the face remaping in the buffer + ;; where `pulse-faces' was called. + (if (buffer-live-p in-buffer) + (with-current-buffer in-buffer + (mapc #'face-remap-remove-relative cookies))))) + (unwind-protect + (progn + ;; redisplay for apply the face remap + (redisplay) + (sleep-for pulse-face-duration)) + (mapc #'face-remap-remove-relative cookies))))) + (provide 'pulse) ;;; pulse.el ends here diff --git a/lisp/ring-bell-fns.el b/lisp/ring-bell-fns.el new file mode 100644 index 00000000000..1a985225bf3 --- /dev/null +++ b/lisp/ring-bell-fns.el @@ -0,0 +1,81 @@ +;;; ring-bell-fns.el --- Collection of functions for ring-bell -*- lexical-binding: t; -*- + +;; Copyright (C) 2025 Free Software Foundation, Inc. + +;; Author: Elijah Gabe Pérez +;; Keywords: faces + +;; 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: + +;; Collection of functions intended to be used with `ring-bell-function'. +;; as alternatives to `visible-bell' + +;;; Code: +(require 'pulse) + +(defgroup ring-bell nil + "Customization options for ring bell." + :version "31.1" + :group 'emacs) + +(defcustom flash-face-attributes + '(:background "red" :foreground "white") + "Face attributes to use in any function from `ring-bell-fns'. +This is intended to be used in any function from `ring-bell-fns' such as +`flash-face-bell-function' and `flash-echo-area-bell-function' to make +the flash face more noticeable." + :type 'plist + :version "31.1") + +(defcustom flash-face-faces + '(mode-line-active) + "A list of faces to be flashed by `flash-face-bell-function'." + :type '(repeat face) + :version "31.1") + +;;;###autoload +(defun flash-face-bell-function () + "Indicate ringing the bell by flashing some faces. +Intended to be used in `ring-bell-function'." + (pulse-faces flash-face-faces flash-face-attributes)) + +;;;###autoload +(defun flash-echo-area-bell-function () + "Indicate ringing the bell by flashing the echo area. +Intended to be used in `ring-bell-function'." + ;; pulse-faces uses run-with-timer if `pulse-face-duration' + ;; is long, which makes the flashing in the echo area not visible. + ;; for fix this then apply the flashing to *Echo Area 0* + ;; and minibuffer buffer for the `run-with-timer', + ;; and fallback to minibuffer buffer due performance. + (if (> pulse-face-duration 0.1) + (dolist (buf `(,(window-buffer (minibuffer-window)) + ;; get or create the echo area for flash it too. + ,(get-buffer-create" *Echo Area 0*"))) + (redisplay) + (with-current-buffer buf + (pulse-faces '(default) flash-face-attributes))) + (with-current-buffer (window-buffer (minibuffer-window)) + ;; For make the flash effect take effect in the + ;; minibuffer/echo area, insert a space only if it is empty. + (if (= (buffer-size) 0) + (insert ?\s)) + (pulse-faces '(default) flash-face-attributes)))) + +(provide 'ring-bell-fns) +;;; ring-bell-fns.el ends here