From d3b6bd69cd5e9283fa0a4189ce7d01bcb76e6654 Mon Sep 17 00:00:00 2001 From: Gregory Heytings 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