From 220c600dd8b57de5ff44974ecfddd6f36dc9c3cd Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sun, 3 Dec 2023 20:02:42 +0100 Subject: [PATCH 1/2] Revert recent register preview changes This reverts commits cd6e66f955d20d31686a617ed8a5cd043585c71f, 408126b6d56a0cc36f621348212e16d0715fd671, 0fa70dad21d3475d3a5dae54a09d8a9e60b668ae, 3df81fb5dc5809cab7843e5358c17d0039b55eb1, 589e6ae1fb983bfba42f20906773555037246e45. --- doc/emacs/regs.texi | 5 +- etc/NEWS | 5 - lisp/emacs-lisp/cl-generic.el | 1 - lisp/register.el | 298 +++++----------------------------- test/lisp/register-tests.el | 43 +++++ 5 files changed, 84 insertions(+), 268 deletions(-) create mode 100644 test/lisp/register-tests.el diff --git a/doc/emacs/regs.texi b/doc/emacs/regs.texi index 5e5b7ae2b16..e52f68dd18e 100644 --- a/doc/emacs/regs.texi +++ b/doc/emacs/regs.texi @@ -16,8 +16,9 @@ Registers we will denote by @var{r}; @var{r} can be a letter (such as @samp{a}) or a number (such as @samp{1}); case matters, so register @samp{a} is not the same as register @samp{A}. You can also set a register in -non-alphanumeric characters, for instance @samp{C-d} by using for -example @key{C-q} @samp{C-d}. +non-alphanumeric characters, for instance @samp{*} or @samp{C-d}. +Note, it's not possible to set a register in @samp{C-g} or @samp{ESC}, +because these keys are reserved for quitting (@pxref{Quitting}). @findex view-register A register can store a position, a piece of text, a rectangle, a diff --git a/etc/NEWS b/etc/NEWS index 29f4e5c0b66..af8e1049483 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1154,11 +1154,6 @@ showcases all their customization options. * Incompatible Lisp Changes in Emacs 30.1 ---- -** 'register-preview-delay' is no longer used. -Register preview is no more delayed. If you want to disable it use -'register-use-preview' instead with a boolean value. - +++ ** 'M-TAB' now invokes 'completion-at-point' also in Text mode. Text mode no longer binds 'M-TAB' to 'ispell-complete-word', and diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 0ef0d1e192a..56eb83e6f75 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -1379,7 +1379,6 @@ cl-generic-generalizers (cl--generic-prefill-dispatchers 0 integer) (cl--generic-prefill-dispatchers 1 integer) (cl--generic-prefill-dispatchers 0 cl--generic-generalizer integer) -(cl--generic-prefill-dispatchers 0 (eql 'x) integer) ;;; Dispatch on major mode. diff --git a/lisp/register.el b/lisp/register.el index 46ec38821e5..ca6de450993 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -35,8 +35,6 @@ ;; FIXME: Clean up namespace usage! -(declare-function frameset-register-p "frameset") - (cl-defstruct (registerv (:constructor nil) (:constructor registerv--make (&optional data print-func @@ -100,15 +98,6 @@ register-preview-delay :version "24.4" :type '(choice number (const :tag "No preview unless requested" nil)) :group 'register) -(make-obsolete-variable 'register-preview-delay "No longer used." "30.1") - -(defcustom register-preview-default-keys (mapcar #'string (number-sequence ?a ?z)) - "Default keys for setting a new register." - :type '(repeat string)) - -(defcustom register-use-preview t - "Always show register preview when non nil." - :type 'boolean) (defun get-register (register) "Return contents of Emacs register named REGISTER, or nil if none." @@ -131,8 +120,7 @@ register-describe-oneline (defun register-preview-default (r) "Function that is the default value of the variable `register-preview-function'." (format "%s: %s\n" - (propertize (string (car r)) - 'display (single-key-description (car r))) + (single-key-description (car r)) (register-describe-oneline (car r)))) (defvar register-preview-function #'register-preview-default @@ -140,263 +128,53 @@ register-preview-function Called with one argument, a cons (NAME . CONTENTS) as found in `register-alist'. The function should return a string, the description of the argument.") -(cl-defstruct register-preview-info - "Store data for a specific register command. -TYPES are the types of register supported. -MSG is the minibuffer message to send when a register is selected. -ACT is the type of action the command is doing on register. -SMATCH accept a boolean value to say if command accept non matching register." - types msg act smatch) - -(cl-defgeneric register-command-info (command) - "Returns a `register-preview-info' object storing data for COMMAND." - (ignore command)) -(cl-defmethod register-command-info ((_command (eql insert-register))) - (make-register-preview-info - :types '(string number) - :msg "Insert register `%s'" - :act 'insert - :smatch t)) -(cl-defmethod register-command-info ((_command (eql jump-to-register))) - (make-register-preview-info - :types '(window frame marker kmacro - file buffer file-query) - :msg "Jump to register `%s'" - :act 'jump - :smatch t)) -(cl-defmethod register-command-info ((_command (eql view-register))) - (make-register-preview-info - :types '(all) - :msg "View register `%s'" - :act 'view - :smatch t)) -(cl-defmethod register-command-info ((_command (eql append-to-register))) - (make-register-preview-info - :types '(string number) - :msg "Append to register `%s'" - :act 'modify - :smatch t)) -(cl-defmethod register-command-info ((_command (eql prepend-to-register))) - (make-register-preview-info - :types '(string number) - :msg "Prepend to register `%s'" - :act 'modify - :smatch t)) -(cl-defmethod register-command-info ((_command (eql increment-register))) - (make-register-preview-info - :types '(string number) - :msg "Increment register `%s'" - :act 'modify - :smatch t)) - -(defun register-preview-forward-line (arg) - "Move to next or previous line in register preview buffer. -If ARG is positive goto next line, if negative to previous. -Do nothing when defining or executing kmacros." - ;; Ensure user enter manually key in minibuffer when recording a macro. - (unless (or defining-kbd-macro executing-kbd-macro - (not (get-buffer-window "*Register Preview*" 'visible))) - (let ((fn (if (> arg 0) #'eobp #'bobp)) - (posfn (if (> arg 0) - #'point-min - (lambda () (1- (point-max))))) - str) - (with-current-buffer "*Register Preview*" - (let ((ovs (overlays-in (point-min) (point-max))) - pos) - (goto-char (if ovs - (overlay-start (car ovs)) - (point-min))) - (setq pos (point)) - (and ovs (forward-line arg)) - (when (and (funcall fn) - (or (> arg 0) (eql pos (point)))) - (goto-char (funcall posfn))) - (setq str (buffer-substring-no-properties - (pos-bol) (1+ (pos-bol)))) - (remove-overlays) - (with-selected-window (minibuffer-window) - (delete-minibuffer-contents) - (insert str))))))) - -(defun register-preview-next () - "Goto next line in register preview buffer." - (interactive) - (register-preview-forward-line 1)) - -(defun register-preview-previous () - "Goto previous line in register preview buffer." - (interactive) - (register-preview-forward-line -1)) - -(defun register-type (register) - "Return REGISTER type. -Current register types actually returned are one of: -- string -- number -- marker -- buffer -- file -- file-query -- window -- frame -- kmacro - -One can add new types to a specific command by defining a new `cl-defmethod' -matching this command. Predicate for type in new `cl-defmethod' should -satisfy `cl-typep' otherwise the new type should be defined with -`cl-deftype'." - ;; Call register--type against the register value. - (register--type (if (consp (cdr register)) - (cadr register) - (cdr register)))) - -(cl-defgeneric register--type (regval) - "Returns type of register value REGVAL." - (ignore regval)) - -(cl-defmethod register--type ((_regval string)) 'string) -(cl-defmethod register--type ((_regval number)) 'number) -(cl-defmethod register--type ((_regval marker)) 'marker) -(cl-defmethod register--type ((_regval (eql 'buffer))) 'buffer) -(cl-defmethod register--type ((_regval (eql 'file))) 'file) -(cl-defmethod register--type ((_regval (eql 'file-query))) 'file-query) -(cl-defmethod register--type ((_regval window-configuration)) 'window) -(cl-deftype frame-register () '(satisfies frameset-register-p)) -(cl-defmethod register--type :extra "frame-register" (_regval) 'frame) -(cl-deftype kmacro-register () '(satisfies kmacro-register-p)) -(cl-defmethod register--type :extra "kmacro-register" (_regval) 'kmacro) - -(defun register-of-type-alist (types) - "Filter `register-alist' according to TYPES." - (if (memq 'all types) - register-alist - (cl-loop for register in register-alist - when (memq (register-type register) types) - collect register))) - -(defun register-preview (buffer &optional show-empty types) +(defun register-preview (buffer &optional show-empty) "Pop up a window showing the registers preview in BUFFER. If SHOW-EMPTY is non-nil, show the window even if no registers. -Argument TYPES (a list) specify the types of register to show, when nil show all -registers, see `register-type' for suitable types. Format of each entry is controlled by the variable `register-preview-function'." - (let ((registers (register-of-type-alist (or types '(all))))) - (when (or show-empty (consp registers)) - (with-current-buffer-window - buffer - (cons 'display-buffer-below-selected - '((window-height . fit-window-to-buffer) - (preserve-size . (nil . t)))) - nil - (with-current-buffer standard-output - (setq cursor-in-non-selected-windows nil) - (mapc (lambda (elem) - (when (get-register (car elem)) - (insert (funcall register-preview-function elem)))) - registers)))))) - -(cl-defgeneric register-preview-get-defaults (action) - "Returns default registers according to ACTION." - (ignore action)) -(cl-defmethod register-preview-get-defaults ((_action (eql set))) - (cl-loop for s in register-preview-default-keys - unless (assoc (string-to-char s) register-alist) - collect s)) + (when (or show-empty (consp register-alist)) + (with-current-buffer-window + buffer + (cons 'display-buffer-below-selected + '((window-height . fit-window-to-buffer) + (preserve-size . (nil . t)))) + nil + (with-current-buffer standard-output + (setq cursor-in-non-selected-windows nil) + (mapc (lambda (elem) + (when (get-register (car elem)) + (insert (funcall register-preview-function elem)))) + register-alist))))) (defun register-read-with-preview (prompt) "Read and return a register name, possibly showing existing registers. -Prompt with the string PROMPT. +Prompt with the string PROMPT. If `register-alist' and +`register-preview-delay' are both non-nil, display a window +listing existing registers after `register-preview-delay' seconds. If `help-char' (or a member of `help-event-list') is pressed, display such a window regardless." (let* ((buffer "*Register Preview*") - (pat "") - (map (let ((m (make-sparse-keymap))) - (set-keymap-parent m minibuffer-local-map) - m)) - (data (register-command-info this-command)) - types msg result timer act win strs smatch) - (if data - (setq types (register-preview-info-types data) - msg (register-preview-info-msg data) - act (register-preview-info-act data) - smatch (register-preview-info-smatch data)) - (setq types '(all) - msg "Overwrite register `%s'" - act 'set)) - (setq strs (mapcar (lambda (x) - (string (car x))) - (register-of-type-alist types))) - (when (and (memq act '(insert jump view)) (null strs)) - (error "No register suitable for `%s'" act)) - (dolist (k (cons help-char help-event-list)) - (define-key map - (vector k) (lambda () - (interactive) - (unless (get-buffer-window buffer) - (with-selected-window (minibuffer-selected-window) - (register-preview buffer 'show-empty types)))))) - (define-key map (kbd "") 'register-preview-next) - (define-key map (kbd "") 'register-preview-previous) - (define-key map (kbd "C-n") 'register-preview-next) - (define-key map (kbd "C-p") 'register-preview-previous) - (unless (or executing-kbd-macro (null register-use-preview)) - (register-preview buffer nil types)) + (timer (when (numberp register-preview-delay) + (run-with-timer register-preview-delay nil + (lambda () + (unless (get-buffer-window buffer) + (register-preview buffer)))))) + (help-chars (cl-loop for c in (cons help-char help-event-list) + when (not (get-register c)) + collect c))) (unwind-protect - (progn - (minibuffer-with-setup-hook - (lambda () - (setq timer - (run-with-idle-timer - 0.01 'repeat - (lambda () - (with-selected-window (minibuffer-window) - (let ((input (minibuffer-contents))) - (when (> (length input) 1) - (let ((new (substring input 1)) - (old (substring input 0 1))) - (setq input (if (or (null smatch) - (member new strs)) - new old)) - (delete-minibuffer-contents) - (insert input))) - (when (and smatch (not (string= input "")) - (not (member input strs))) - (setq input "") - (delete-minibuffer-contents) - (minibuffer-message "Not matching")) - (when (not (string= input pat)) - (setq pat input)))) - (if (setq win (get-buffer-window buffer)) - (with-selected-window win - (let ((ov (make-overlay (point-min) (point-min)))) - (goto-char (point-min)) - (remove-overlays) - (unless (string= pat "") - (if (re-search-forward (concat "^" pat) nil t) - (progn (move-overlay - ov - (match-beginning 0) (pos-eol)) - (overlay-put ov 'face 'match) - (when msg - (with-selected-window (minibuffer-window) - (minibuffer-message msg pat)))) - (with-selected-window (minibuffer-window) - (minibuffer-message - "Register `%s' is empty" pat)))))) - (unless (string= pat "") - (if (member pat strs) - (with-selected-window (minibuffer-window) - (minibuffer-message msg pat)) - (with-selected-window (minibuffer-window) - (minibuffer-message - "Register `%s' is empty" pat))))))))) - (setq result (read-from-minibuffer - prompt nil map nil nil (register-preview-get-defaults act)))) - (cl-assert (and result (not (string= result ""))) - nil "No register specified") - (string-to-char result)) - (when timer (cancel-timer timer)) + (progn + (while (memq (read-key (propertize prompt 'face 'minibuffer-prompt)) + help-chars) + (unless (get-buffer-window buffer) + (register-preview buffer 'show-empty))) + (when (or (eq ?\C-g last-input-event) + (eq 'escape last-input-event) + (eq ?\C-\[ last-input-event)) + (keyboard-quit)) + (if (characterp last-input-event) last-input-event + (error "Non-character input-event"))) + (and (timerp timer) (cancel-timer timer)) (let ((w (get-buffer-window buffer))) (and (window-live-p w) (delete-window w))) (and (get-buffer buffer) (kill-buffer buffer))))) diff --git a/test/lisp/register-tests.el b/test/lisp/register-tests.el new file mode 100644 index 00000000000..6283d1c31e0 --- /dev/null +++ b/test/lisp/register-tests.el @@ -0,0 +1,43 @@ +;;; register-tests.el --- tests for register.el -*- lexical-binding: t-*- + +;; Copyright (C) 2017-2023 Free Software Foundation, Inc. + +;; Author: Tino Calancha +;; Keywords: + +;; 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: + + +;;; Code: +(require 'ert) +(require 'cl-lib) + +(ert-deftest register-test-bug27634 () + "Test for https://debbugs.gnu.org/27634 ." + (dolist (event (list ?\C-g 'escape ?\C-\[)) + (cl-letf (((symbol-function 'read-key) #'ignore) + (last-input-event event) + (register-alist nil)) + (should (equal 'quit + (condition-case err + (call-interactively 'point-to-register) + (quit (car err))))) + (should-not register-alist)))) + +(provide 'register-tests) +;;; register-tests.el ends here -- 2.42.0