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