Subject: Re: bug#1305: All code that currently beeps should use visual bell instead

From: Gregory Heytings <[email-masked]>
Date: Wed, 28 Apr 2021 13:12:59 +0000

>> So we'd change the default of the former to be a new visible bell 
>> function (for instance something that works the same as the visible 
>> bell on GNU/Linux systems, but across all systems (or one of the new 
>> proposed visible bell functions)), and deprecate `visible-bell'.  I 
>> think that should be a pretty un-annoying way forward.
>
> Fully agreed; it's an improvement over my proposal.
>
> This is currently handled in different ways on different platforms, so I 
> we might want to clean that up a bit while we're at it.
>

Yes, the idea would be to have new predefined values for 
ring-bell-function:

ring-bell-beep = the former visible-bell nil (when ring-bell-function was 
nil)

ring-bell-visible = the former visible-bell t (when ring-bell-function was 
nil), whose behavior differs depending on the platform

and a new prettier bell function, which would be the default.

>
> The main thing remaining, besides writing the actual patch, is to decide 
> what the visual bell should look like.  I am currently running with 
> Gregory's patch for testing; it would useful if others carried out 
> similar experiments with one or more variations mentioned in this thread
>

Thank you.  I recently improved the patch to handle the explicit 'ding' 
events more cleanly, see attached.  In that case, because 'ding' is 
usually followed by 'message', there is a short delay between the flash 
and the message, but that seems unavoidable (or at least I do not see how 
it could be avoided).  Note that the delay is already present with 
visible-bell t (and ring-bell-function nil).

From d3b6bd69cd5e9283fa0a4189ce7d01bcb76e6654 Mon Sep 17 00:00:00 2001
From: Gregory Heytings <[email-masked]>
Date: Wed, 28 Apr 2021 12:55:07 +0000
Subject: [PATCH] New default bell.

* lisp/simple.el (ring-bell-color): New default bell, which briefly flashes
the cursor and the echo area when an error occurs.
(ring-bell-color-echo-area-face, ring-bell-color-cursor-face): New faces.
(ring-bell-color-ignored-errors, ring-bell-color-duration): New user options.

* src/eval.c (last-error-symbol, last-error-data): New variables.
(signal_or_quit): Set the new variables.

* src/dispnew.c (ding): New variable.
(ding): Set the new variable.

* lisp/face-remap.el (face-remap-remove-relative, buffer-face-mode-face,
text-scale-mode-step): Autoload them.

* etc/NEWS: Document the change.
---
 etc/NEWS           | 10 ++++++
 lisp/face-remap.el |  3 ++
 lisp/simple.el     | 84 ++++++++++++++++++++++++++++++++++++++++++++++
 src/dispnew.c      |  8 +++++
 src/eval.c         | 11 ++++++
 5 files changed, 116 insertions(+)

diff --git a/etc/NEWS b/etc/NEWS
index 9bf232ac02..4f2a0fedb3 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -276,6 +276,16 @@ commands.  The new keystrokes are 'C-x x g' ('revert-buffer'),
 ** Commands 'set-frame-width' and 'set-frame-height' can now get their
 input using the minibuffer.
 
++++
+** The default value of 'ring-bell-function' is now non-nil.
+When an error occurs, Emacs will by default briefly flash the cursor
+and the echo area.  This effect can be customized with the user options
+ring-bell-color-duration, ring-bell-color-cursor-face,
+ring-bell-color-echo-area-face and ring-bell-color-ignored-errors.
+To restore the previous behavior, add the following to your init file:
+
+(setq ring-bell-function nil)
+
 
 * Editing Changes in Emacs 28.1
 
diff --git a/lisp/face-remap.el b/lisp/face-remap.el
index 5914ee4a20..df4c59913c 100644
--- a/lisp/face-remap.el
+++ b/lisp/face-remap.el
@@ -142,6 +142,7 @@ face-remap-add-relative
       (force-mode-line-update))
     (cons face specs)))
 
+;;;###autoload
 (defun face-remap-remove-relative (cookie)
   "Remove a face remapping previously added by `face-remap-add-relative'.
 COOKIE should be the return value from that function."
@@ -210,6 +211,7 @@ face-remap-set-base
 ;; ----------------------------------------------------------------
 ;; text-scale-mode
 
+;;;###autoload
 (defcustom text-scale-mode-step 1.2
   "Scale factor used by `text-scale-mode'.
 Each positive or negative step scales the default face height by this amount."
@@ -397,6 +399,7 @@ text-scale-adjust
 ;; ----------------------------------------------------------------
 ;; buffer-face-mode
 
+;;;###autoload
 (defcustom buffer-face-mode-face 'variable-pitch
   "The face specification used by `buffer-face-mode'.
 It may contain any value suitable for a `face' text property,
diff --git a/lisp/simple.el b/lisp/simple.el
index 26eb8cad7f..874593d957 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -8514,7 +8514,91 @@ play-sound-file
 	(plist-put sound :device device))
     (push 'sound sound)
     (play-sound sound)))
+
+(defface ring-bell-color-echo-area-face
+  `((((type tty)) (:inherit error :inverse-video t))
+    (t (:background "yellow1")))
+  "Face used by `ring-bell-color' to flash the echo area when an error happened."
+  :version "28.1")
+
+(defface ring-bell-color-cursor-face
+  `((t (:inherit error)))
+  "Face used by `ring-bell-color' to flash the cursor when an error happened.
+The cursor flashes with the foreground color of that face; it does not
+flash in terminals."
+  :version "28.1")
+
+(defcustom ring-bell-color-ignored-errors nil
+  "List of errors symbols ignored by `ring-bell-color'.
+Error symbols that are present in this list are ignored by `ring-bell-color',
+and their error messages are displayed without flashing the cursor and echo
+area.
+For example, the value '(quit beginning-of-buffer end-of-buffer) disables
+`ring-bell-color' on \\[keyboard-quit], and for beginning and end of buffer errors.
+To find the symbol of an error, type \\[eval-expression] last-error-symbol \
+\\[newline] immediately
+after the error happened, without using \\[indent-for-tab-command] for \
+completion."
+  :type 'list
+  :version "28.1")
+
+(defcustom ring-bell-color-duration 0.2
+  "Maximum duration of the `ring-bell-color' flash, in seconds.
+The flash stops after that duration, or when input is available, whichever
+comes first."
+  :type 'float
+  :version "28.1")
+
+(defvar ring-bell-color--cursor-background nil)
+(defvar ring-bell-color--face-remapping nil)
+
+(defun ring-bell-color ()
+  "Flash the cursor and echo area with colors when an error occurs.
+The flash is controlled by the variables `ring-bell-color-duration' and
+`ring-bell-color-ignored-errors', and by the faces
+`ring-bell-color-cursor-face' and `ring-bell-color-echo-area-face'.
+Inside the minibuffer, only the cursor flashes, during half the duration
+of `ring-bell-color-duration'."
+  (unless (memq last-error-symbol ring-bell-color-ignored-errors)
+    (if (not (eq (face-attribute 'cursor :background)
+                 ring-bell-color--cursor-background))
+        (setq ring-bell-color--cursor-background
+              (face-attribute 'cursor :background)))
+    (set-face-attribute 'cursor nil :background
+                        (face-attribute 'ring-bell-color-cursor-face
+                                        :foreground nil t))
+    (let* ((minibuffer (window-buffer (minibuffer-window)))
+           (inside-minibuffer (minibufferp (current-buffer)))
+           (active-minibuffer (> (minibuffer-depth) 0))
+           (buffer (if (and ding active-minibuffer)
+                       minibuffer
+                     (get-buffer " *Echo Area 0*"))))
+      (unless inside-minibuffer
+        (with-current-buffer buffer
+          (when ring-bell-color--face-remapping
+            (face-remap-remove-relative ring-bell-color--face-remapping))
+          (setq-local ring-bell-color--face-remapping
+                      (face-remap-add-relative
+                       'default
+                       'ring-bell-color-echo-area-face)))
+        (let ((set-message-function nil))
+          (message
+           (if ding ""
+             (error-message-string
+              (cons last-error-symbol last-error-data))))))
+      (sit-for (if inside-minibuffer
+                   (/ ring-bell-color-duration 2)
+                 ring-bell-color-duration))
+      (if ring-bell-color--cursor-background
+          (set-face-attribute 'cursor nil
+                              :background ring-bell-color--cursor-background))
+      (unless inside-minibuffer
+        (if (buffer-live-p buffer)
+            (with-current-buffer buffer
+              (face-remap-remove-relative ring-bell-color--face-remapping)
+              (setq ring-bell-color--face-remapping nil)))))))
 
+(setq ring-bell-function #'ring-bell-color)
 
 (defcustom read-mail-command 'rmail
   "Your preference for a mail reading package.
diff --git a/src/dispnew.c b/src/dispnew.c
index b3f7be67e0..38d82328b0 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -5995,6 +5995,8 @@ DEFUN ("ding", Fding, Sding, 0, 1, 0,
 terminate any keyboard macro currently executing.  */)
   (Lisp_Object arg)
 {
+  Vding = 1;
+
   if (!NILP (arg))
     {
       if (noninteractive)
@@ -6005,6 +6007,8 @@ DEFUN ("ding", Fding, Sding, 0, 1, 0,
   else
     bitch_at_user ();
 
+  Vding = 0;
+
   return Qnil;
 }
 
@@ -6620,6 +6624,10 @@ syms_of_display (void)
 
 See also `ring-bell-function'.  */);
 
+  DEFVAR_BOOL ("ding", Vding,
+	       doc: /* Whether `ding' is being executed.  */);
+  Vding = 0;
+
   DEFVAR_BOOL ("no-redraw-on-reenter", no_redraw_on_reenter,
 	       doc: /* Non-nil means no need to redraw entire frame after suspending.
 A non-nil value is useful if the terminal can automatically preserve
diff --git a/src/eval.c b/src/eval.c
index aeedcc50cc..12d4d4f9ad 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1809,6 +1809,9 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
 #endif
 #endif
 
+  Vlast_error_symbol = real_error_symbol;
+  Vlast_error_data = (NILP (error_symbol) ? Fcdr (data) : data);
+
   /* This hook is used by edebug.  */
   if (! NILP (Vsignal_hook_function)
       && ! NILP (error_symbol)
@@ -4430,6 +4433,14 @@ syms_of_eval (void)
 The Edebug package uses this to regain control.  */);
   Vsignal_hook_function = Qnil;
 
+  DEFVAR_LISP ("last-error-symbol", Vlast_error_symbol,
+	       doc: /* Symbol of the last error.  */);
+  Vlast_error_symbol = Qnil;
+
+  DEFVAR_LISP ("last-error-data", Vlast_error_data,
+	       doc: /* Data of the last error.  */);
+  Vlast_error_data = Qnil;
+
   DEFVAR_LISP ("debug-on-signal", Vdebug_on_signal,
 	       doc: /* Non-nil means call the debugger regardless of condition handlers.
 Note that `debug-on-error', `debug-on-quit' and friends
-- 
2.30.2