From: Gregory Heytings <gregory@heytings.org>
To: Stefan Kangas <stefan@marxist.se>
Cc: Alan Third <alan@idiocy.org>,
1305@debbugs.gnu.org, Michael Welsh Duggan <mwd@md5i.com>,
jasonspiro4@gmail.com, Stefan Monnier <monnier@iro.umontreal.ca>,
Dmitry Gutov <dgutov@yandex.ru>,
Lars Ingebrigtsen <larsi@gnus.org>
Subject: bug#1305: All code that currently beeps should use visual bell instead
Date: Wed, 28 Apr 2021 13:12:59 +0000 [thread overview]
Message-ID: <b02650b49996941561fc@heytings.org> (raw)
In-Reply-To: <CADwFkmkdnocKL4crhCi5LaCPxqLwMHNG8NntpB9NHsNSF9+Vdw@mail.gmail.com>
[-- Attachment #1: Type: text/plain, Size: 1595 bytes --]
>> 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).
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-diff; name=New-default-bell.patch, Size: 9180 bytes --]
From d3b6bd69cd5e9283fa0a4189ce7d01bcb76e6654 Mon Sep 17 00:00:00 2001
From: Gregory Heytings <gregory@heytings.org>
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)
+
\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 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)))
+\f
+(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)
\f
(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
next prev parent reply other threads:[~2021-04-28 13:12 UTC|newest]
Thread overview: 176+ messages / expand[flat|nested] mbox.gz Atom feed top
2008-11-09 1:50 bug#1305: All code that currently beeps should use visual bell instead Jason Spiro
2008-11-09 2:00 ` Processed: " Emacs bug Tracking System
2008-11-09 3:57 ` bug#1305: All code that currently beeps should use visual bellinstead Drew Adams
2008-11-09 4:08 ` Jason Spiro
2008-11-09 19:17 ` Eli Zaretskii
2008-11-09 19:04 ` Eli Zaretskii
2008-11-09 19:19 ` Drew Adams
2008-11-09 20:00 ` Eli Zaretskii
2008-11-10 2:07 ` Stefan Monnier
2008-11-10 6:28 ` Drew Adams
2008-11-11 21:20 ` bug#1305: All code that currently beeps should usevisual bellinstead Drew Adams
2008-11-10 8:34 ` bug#1305: All code that currently beeps should use visual bellinstead Lennart Borgman
2008-11-10 15:22 ` Stefan Monnier
2008-11-10 16:58 ` Lennart Borgman
2008-11-11 18:38 ` Jason A. Spiro
2008-11-10 22:17 ` Richard M. Stallman
2008-11-11 18:50 ` Jason Spiro
2008-11-12 3:33 ` Richard M. Stallman
2008-11-13 7:41 ` Jason Spiro
2021-04-17 6:06 ` bug#1305: All code that currently beeps should use visual bell instead Stefan Kangas
2021-04-17 7:03 ` Eli Zaretskii
2021-04-17 11:54 ` Lars Ingebrigtsen
2021-04-17 12:31 ` Gregory Heytings
2021-04-17 12:39 ` Eli Zaretskii
2021-04-17 12:55 ` Lars Ingebrigtsen
2021-04-17 13:07 ` Stefan Kangas
2021-04-17 13:13 ` Lars Ingebrigtsen
2021-04-17 13:32 ` Stefan Kangas
2021-04-17 13:39 ` Lars Ingebrigtsen
2021-04-17 14:05 ` Eli Zaretskii
2021-04-17 14:08 ` Stefan Kangas
2021-04-18 10:41 ` Lars Ingebrigtsen
2021-04-18 12:22 ` Stefan Kangas
2021-04-18 13:32 ` Gregory Heytings
2021-04-18 15:23 ` Lars Ingebrigtsen
2021-04-18 15:42 ` Gregory Heytings
2021-04-17 19:17 ` Basil L. Contovounesios
2021-04-17 17:01 ` Dmitry Gutov
2021-04-17 20:59 ` Gregory Heytings
2021-04-17 21:09 ` Michael Welsh Duggan
2021-04-17 21:17 ` Gregory Heytings
2021-04-17 21:52 ` Michael Welsh Duggan
2021-04-17 22:04 ` Gregory Heytings
2021-04-17 23:30 ` bug#1305: [External] : " Drew Adams
2021-04-18 10:38 ` Lars Ingebrigtsen
2021-04-18 12:22 ` Stefan Kangas
2021-04-18 12:36 ` Lars Ingebrigtsen
2021-04-18 13:10 ` Stefan Kangas
2021-04-18 13:15 ` Stefan Kangas
2021-04-18 15:22 ` Lars Ingebrigtsen
2021-04-18 15:28 ` Stefan Monnier
2021-04-18 15:38 ` Lars Ingebrigtsen
2021-04-18 18:34 ` Stefan Monnier
2021-04-19 12:37 ` Lars Ingebrigtsen
2021-04-19 13:04 ` Dmitry Gutov
2021-04-19 13:26 ` Stefan Kangas
2021-04-25 18:06 ` Lars Ingebrigtsen
2021-04-25 20:06 ` Stefan Kangas
2021-04-19 13:30 ` Gregory Heytings
2021-04-18 17:02 ` Gregory Heytings
2021-04-18 17:13 ` Eli Zaretskii
2021-04-18 18:02 ` Gregory Heytings
2021-04-18 18:35 ` Stefan Kangas
2021-04-18 18:45 ` Gregory Heytings
2021-04-18 19:04 ` Stefan Kangas
2021-04-18 19:19 ` Gregory Heytings
2021-04-18 15:06 ` Eli Zaretskii
2021-04-18 15:11 ` Lars Ingebrigtsen
2021-04-18 15:23 ` Eli Zaretskii
2021-04-18 15:35 ` Eli Zaretskii
2021-04-19 12:56 ` Lars Ingebrigtsen
2021-04-19 13:12 ` Eli Zaretskii
2021-04-25 18:03 ` Lars Ingebrigtsen
2021-04-25 18:52 ` Andreas Schwab
2021-04-25 19:01 ` Lars Ingebrigtsen
2021-04-25 19:18 ` Andreas Schwab
2021-04-25 19:33 ` Lars Ingebrigtsen
2021-04-18 16:07 ` Andreas Schwab
2021-04-19 12:38 ` Lars Ingebrigtsen
2021-04-18 16:12 ` Stefan Kangas
2021-04-18 16:20 ` Andreas Schwab
2021-04-19 12:39 ` Lars Ingebrigtsen
2021-04-18 15:18 ` Dmitry Gutov
2021-04-18 15:26 ` Dmitry Gutov
2021-04-18 15:37 ` Gregory Heytings
2021-04-18 16:27 ` Stefan Kangas
2021-04-18 16:38 ` Gregory Heytings
2021-04-18 17:05 ` Dmitry Gutov
2021-04-18 17:14 ` Stefan Kangas
2021-04-19 12:33 ` Lars Ingebrigtsen
2021-04-19 12:40 ` Dmitry Gutov
2021-04-19 12:47 ` Gregory Heytings
2021-04-19 13:01 ` Dmitry Gutov
2021-04-19 13:16 ` Gregory Heytings
2021-04-19 13:26 ` Stefan Kangas
2021-04-19 13:37 ` Dmitry Gutov
2021-04-19 14:41 ` Alan Third
2021-04-20 14:21 ` Gregory Heytings
2021-04-20 18:27 ` Dmitry Gutov
2021-04-20 19:19 ` Gregory Heytings
2021-04-21 1:16 ` Dmitry Gutov
2021-04-21 6:47 ` Gregory Heytings
2021-04-21 13:11 ` Stefan Kangas
2021-04-21 14:05 ` Gregory Heytings
2021-04-21 14:12 ` Dmitry Gutov
2021-04-21 14:30 ` Stefan Kangas
2021-04-21 14:35 ` Gregory Heytings
2021-04-21 14:45 ` Stefan Kangas
2021-04-21 14:53 ` Gregory Heytings
2021-04-21 21:27 ` Stefan Kangas
2021-04-21 14:33 ` Stefan Monnier
2021-04-21 14:51 ` Dmitry Gutov
2021-04-21 15:14 ` Stefan Monnier
2021-04-25 18:12 ` Lars Ingebrigtsen
2021-04-25 21:03 ` Stefan Monnier
2021-04-27 1:07 ` Lars Ingebrigtsen
2021-04-27 9:54 ` Gregory Heytings
2021-04-27 15:15 ` bug#1305: [External] : " Drew Adams
2021-04-27 23:21 ` Lars Ingebrigtsen
2021-04-28 10:08 ` Stefan Kangas
2021-04-28 13:12 ` Gregory Heytings [this message]
2021-04-29 16:50 ` Dmitry Gutov
2021-04-29 19:48 ` Gregory Heytings
2021-04-29 20:17 ` Dmitry Gutov
2021-04-29 21:46 ` Gregory Heytings
2021-04-29 23:23 ` Dmitry Gutov
2021-04-29 23:35 ` bug#1305: [External] : " Drew Adams
2021-04-29 23:52 ` Dmitry Gutov
2021-05-01 7:50 ` Gregory Heytings
2021-05-01 14:13 ` Drew Adams
2021-05-01 16:55 ` Gregory Heytings
2021-05-01 14:28 ` Stefan Monnier
2021-05-01 16:48 ` Gregory Heytings
2021-05-02 10:44 ` Stefan Kangas
2021-04-30 7:09 ` Gregory Heytings
2021-04-30 22:22 ` Dmitry Gutov
2021-04-30 23:19 ` Gregory Heytings
2021-04-30 23:28 ` Dmitry Gutov
2021-05-01 0:00 ` Gregory Heytings
2021-05-01 0:57 ` Dmitry Gutov
2021-05-01 7:50 ` Gregory Heytings
2021-05-01 0:05 ` bug#1305: [External] : " Drew Adams
2021-05-01 1:08 ` Dmitry Gutov
2021-05-01 2:05 ` Drew Adams
2021-04-29 23:36 ` Stefan Monnier
2021-04-30 7:13 ` Gregory Heytings
2021-04-29 22:38 ` Stefan Kangas
2021-04-29 23:11 ` Dmitry Gutov
2021-04-30 6:58 ` Gregory Heytings
2021-04-30 13:08 ` Gregory Heytings
2021-04-30 5:05 ` Eli Zaretskii
2021-04-30 6:51 ` Gregory Heytings
2021-04-30 7:06 ` Eli Zaretskii
2021-04-30 7:27 ` Gregory Heytings
2021-04-30 8:03 ` Eli Zaretskii
2021-04-30 8:41 ` Gregory Heytings
2021-04-21 15:08 ` Dmitry Gutov
2021-04-21 15:18 ` Stefan Monnier
2021-04-21 16:14 ` Gregory Heytings
2021-04-21 17:27 ` Stefan Monnier
2021-04-21 20:26 ` Gregory Heytings
2021-04-21 22:03 ` bug#1305: [External] : " Drew Adams
2021-04-21 14:45 ` Dmitry Gutov
2021-04-21 16:01 ` Gregory Heytings
2021-04-21 17:34 ` Eli Zaretskii
2021-04-21 20:22 ` Gregory Heytings
2021-04-19 12:51 ` Lars Ingebrigtsen
2021-04-19 14:03 ` Stefan Monnier
2021-04-18 15:27 ` bug#1305: [External] : " Drew Adams
2021-04-18 6:30 ` Eli Zaretskii
2021-04-18 11:10 ` Gregory Heytings
2021-04-18 11:38 ` Eli Zaretskii
2021-04-18 15:14 ` bug#1305: [External] : " Drew Adams
2021-04-17 13:16 ` Drew Adams
2021-04-17 16:59 ` Dmitry Gutov
2008-11-10 21:25 ` Xavier Maillard
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=b02650b49996941561fc@heytings.org \
--to=gregory@heytings.org \
--cc=1305@debbugs.gnu.org \
--cc=alan@idiocy.org \
--cc=dgutov@yandex.ru \
--cc=jasonspiro4@gmail.com \
--cc=larsi@gnus.org \
--cc=monnier@iro.umontreal.ca \
--cc=mwd@md5i.com \
--cc=stefan@marxist.se \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).