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

[Gregory Heytings <gregory@heytings.org>]

[-- Attachment #1: Type: text/plain, Size: 2028 bytes --]


>>> And it turns the cursor red irreversibly in my config (but not in 
>>> 'emacs -Q').
>> 
>> That's rather strange, color-bell--cursor-background is saved only 
>> once, when visual-bell is called for the first time.  I'll try to 
>> reproduce the issue, but some more detailed information (e.g. with 
>> debug-on-variable-change) would be welcome.
>
> I'll try bisecting when I have the time. In any case, it's just an 
> implementation bug, not a blocker.
>

Does the attached patch fix the problem in your config?  It is probably 
safer to check the cursor color each time color-bell is entered.

>>> Is nobody bothered by having this kind of visual indication while 
>>> 'visible-bell' is nil, though?
>> 
>> It's easy to turn off, as indicated in NEWS: (setq ring-bell-function 
>> nil).
>
> I mean, like, semantically: this new proposal is also visual/visible.
>
> But 'visible-bell' is nil.
>

Yes, it's perhaps a bit unfortunate that "visible-bell" is nil in this 
case, but note that with visible-bell t and ring-bell-function ignore you 
also do not have what you could expect.  The semantics of visible-bell and 
ring-bell-function are a bit unclear, but they cannot be fixed anymore 
without introducing backward incompatible changes.

>> And IMO this is way better than the current situation, in which the 
>> default behavior depends on too many parameters that are outside the 
>> control of Emacs, in which the available options are different 
>> depending on the platform, and in which on certain platforms none of 
>> the available options are good.
>
> My #1 preference would be to make it all behave like (setq visible-bell 
> t) on GNU/Linux does. This way we both get a proven behavior with no 
> significant complaints, as well as consistency across platforms.
>

I understand that you're accustomed to what visible-bell t does on 
GNU/Linux, but frankly, its ugly.  Ask their opinion to non-Emacs users 
about that bell, I'd be surprised if they like it.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-diff; name=New-default-bell.patch, Size: 6776 bytes --]

From 21f2a9946c70d8973648fa3dfb30c82732ea682e Mon Sep 17 00:00:00 2001
From: Gregory Heytings <gregory@heytings.org>
Date: Wed, 21 Apr 2021 06:36:06 +0000
Subject: [PATCH] New default bell.

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

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

* 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     | 58 ++++++++++++++++++++++++++++++++++++++++++++++
 src/eval.c         | 11 +++++++++
 4 files changed, 82 insertions(+)

diff --git a/etc/NEWS b/etc/NEWS
index e39aa7b437..4203e0b40d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -272,6 +272,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
+color-bell-duration, color-bell-cursor-face, color-bell-echo-area-face
+and color-bell-ignored-errors.  To restore the previous behavior,
+add the following to your init file:
+
+(setq ring-bell-function nil)
+
 \f
 * 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 999755a642..c07296fef4 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -8511,7 +8511,65 @@ play-sound-file
 	(plist-put sound :device device))
     (push 'sound sound)
     (play-sound sound)))
+\f
+(defface color-bell-echo-area-face
+  `((((type tty)) (:inherit error :inverse-video t))
+    (t (:inherit match)))
+  "Face used by `color-bell' to flash the echo area when an error happened."
+  :version "28.1")
+
+(defface color-bell-cursor-face
+  `((t (:inherit error)))
+  "Face used by `color-bell' to flash the cursor when an error happened.
+The cursor is flashed with the foreground color of that face; it is not
+flashed in terminals."
+  :version "28.1")
+
+(defcustom color-bell-ignored-errors nil
+  "List of errors symbols ignored by `color-bell'.
+Error symbols that are present in this list are ignored by `color-bell', and
+are displayed without flashing the cursor and echo area.
+For example, the value '(quit beginning-of-buffer end-of-buffer) disables
+`color-bell' 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 color-bell-duration 0.25
+  "Maximum duration of the `color-bell' flash.
+The flash stops when input is available."
+  :type 'float
+  :version "28.1")
 
+(defvar color-bell--cursor-background nil)
+(defvar color-bell--face-remapping nil)
+
+(defun color-bell ()
+  (unless (memq last-error-symbol color-bell-ignored-errors)
+    (if (not (eq (face-attribute 'cursor :background)
+                 color-bell--cursor-background))
+        (setq color-bell--cursor-background
+            (face-attribute 'cursor :background)))
+    (set-face-attribute 'cursor nil :background
+                        (face-attribute 'color-bell-cursor-face :foreground
+                                        nil t))
+    (with-current-buffer " *Echo Area 0*"
+      (when color-bell--face-remapping
+        (face-remap-remove-relative color-bell--face-remapping))
+      (setq-local color-bell--face-remapping
+                  (face-remap-add-relative 'default
+                                           'color-bell-echo-area-face)))
+    (message (error-message-string (cons last-error-symbol nil)))
+    (sit-for color-bell-duration)
+    (set-face-attribute 'cursor nil :background color-bell--cursor-background)
+    (with-current-buffer " *Echo Area 0*"
+      (face-remap-remove-relative color-bell--face-remapping)
+      (setq color-bell--face-remapping nil))))
+
+(setq ring-bell-function #'color-bell)
 \f
 (defcustom read-mail-command 'rmail
   "Your preference for a mail reading package.
diff --git a/src/eval.c b/src/eval.c
index fd93f5b9e1..ea012eef77 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1716,6 +1716,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)
@@ -4321,6 +4324,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