From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Thierry Volpiatto Newsgroups: gmane.emacs.bugs Subject: bug#66394: 29.1; Make register-read-with-preview more useful Date: Tue, 19 Dec 2023 17:40:59 +0000 Message-ID: <8734vym6ok.fsf@posteo.net> References: <87il7ib6cu.fsf@posteo.net> <83plzp82mb.fsf@gnu.org> <87a5qhxf05.fsf@posteo.net> <83jzpkvs4z.fsf@gnu.org> <87v8947ulo.fsf@posteo.net> <871qbsk5le.fsf@posteo.net> <87v894hr2e.fsf@posteo.net> <87cyvbepi0.fsf@posteo.net> <87bkavk9nv.fsf@posteo.net> <8eebbb30-9366-e869-a39a-8100638cb99a@gutov.dev> <87o7etgxeb.fsf@posteo.net> <83v891qlcn.fsf@gnu.org> <87r0jn4j8i.fsf@posteo.net> <87jzpf48k5.fsf@posteo.net> <87plz6xp3m.fsf@posteo.net> Mime-Version: 1.0 Content-Type: multipart/signed; boundary="==-=-="; micalg=pgp-sha512; protocol="application/pgp-signature" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="1111"; mail-complaints-to="usenet@ciao.gmane.io" Cc: michael_heerdegen@web.de, dmitry@gutov.dev, Eli Zaretskii , Stefan Kangas , 66394@debbugs.gnu.org To: Stefan Monnier Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Tue Dec 19 18:42:29 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1rFe6u-000Abb-68 for geb-bug-gnu-emacs@m.gmane-mx.org; Tue, 19 Dec 2023 18:42:28 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rFe6b-0002PL-Cz; Tue, 19 Dec 2023 12:42:09 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rFe6S-0002OZ-IA for bug-gnu-emacs@gnu.org; Tue, 19 Dec 2023 12:42:01 -0500 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rFe6S-0002h0-A3 for bug-gnu-emacs@gnu.org; Tue, 19 Dec 2023 12:42:00 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rFe6U-0004mc-Jv for bug-gnu-emacs@gnu.org; Tue, 19 Dec 2023 12:42:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Thierry Volpiatto Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 19 Dec 2023 17:42:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 66394 X-GNU-PR-Package: emacs Original-Received: via spool by 66394-submit@debbugs.gnu.org id=B66394.170300768418342 (code B ref 66394); Tue, 19 Dec 2023 17:42:02 +0000 Original-Received: (at 66394) by debbugs.gnu.org; 19 Dec 2023 17:41:24 +0000 Original-Received: from localhost ([127.0.0.1]:37265 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rFe5r-0004ll-5N for submit@debbugs.gnu.org; Tue, 19 Dec 2023 12:41:24 -0500 Original-Received: from mout01.posteo.de ([185.67.36.65]:53729) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rFe5n-0004lT-IB for 66394@debbugs.gnu.org; Tue, 19 Dec 2023 12:41:21 -0500 Original-Received: from submission (posteo.de [185.67.36.169]) by mout01.posteo.de (Postfix) with ESMTPS id 9300C24002B for <66394@debbugs.gnu.org>; Tue, 19 Dec 2023 18:41:10 +0100 (CET) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=posteo.net; s=2017; t=1703007670; bh=5N5aLLDuH4Twm9ZZbFKXWT9aITtbruYpE3VqQwD3jzE=; h=From:To:Cc:Subject:Date:Message-ID:MIME-Version:Autocrypt:OpenPGP: From; b=bA3pRc3XpojAyIeB+zEBZ8uweziC1YM+JXAMkGs1SckqI+eNuy1l0UBjlX7eu5PHr +K4Gno5xzgsxGNBiwLQWT6UdXrMVkwDNX+bZ/gKI2/WaW48mphmVMVnbLBDoFifdK6 rbSBtrD90Ap4NA+3TYQmNLqCoOpzX8yx9LjGnF5407ZhIgekPSIuwtybrO8Dk6CUZA XjT1pWJTZeGNBvWWiqOjv6wTtY4s8SR4lBYLtOs1WoJ2CsDELXii8gVcrNGPRPAM60 mJPWCTuDcaogSm5IA56yCDTn3MJRXujUNrfIl3thY3g7E9fnBG/7bCQtJYjd5xAuvU 7eiAkDeCINFuA== Original-Received: from customer (localhost [127.0.0.1]) by submission (posteo.de) with ESMTPSA id 4SvkWQ72g1z6tvZ; Tue, 19 Dec 2023 18:41:06 +0100 (CET) In-Reply-To: (Stefan Monnier's message of "Sat, 16 Dec 2023 10:31:50 -0500 (3 days, 1 hour, 44 minutes ago)") Autocrypt: addr=thievol@posteo.net; prefer-encrypt=mutual; keydata=xsDNBF8ylcIBDADG+hy+zR6L4/vbdDDZuSaMmSrU3A5QZJpeBCvxTr7MpzzruZbhLPW1K3R6N2MA edi8Y+C8o27FVRIjpdbaKMGu9je7JV/TbUQYo3SOwCK1vM4LUn4V6ZLzSYkuiEt4eyMoiDdyvN0p kcK6P9x9DCetcEVszXzQg+yzCVrQ2hXWDXWT4M18EC3wtO7RHPouMqGiwBFhBAYErCqFWFxQHkfb tG/4yGyJ58rglb65O3qijjMWvYwcWZun9/7qm8Z4/4mHopmo2zgU+OrptnLSZfkZGz3Y7Uf452xQ GVq0Fv75NPvQru7y+DYVhuVXXyAmGxt+vf4rIiixMBbhKEPjcxEPAa2LTzex2IsTZR+QVG9uDnqC WcgaOEQ58fzXNvNhtwwF/Rgio2XWAJVdmFWS59/k9W58CIUSNKBMZh2XeGdEmtHvDtCxW3z6FJha 36RzOM3fMNNiAGdFZJA84gcdloJR+sHCDTTPT3784fjr+V8An7sI581NGFzkRQqPvEQCZbUAEQEA Ac0SdGhpZXZvbEBwb3N0ZW8ubmV0wsEOBBMBCgA4AhsDBQsJCAcCBhUKCQgLAgQWAgMBAh4BAheA FiEEI9twfRN7r3nig/xwDsVtFB0W75MFAmL3HCoACgkQDsVtFB0W75OVEAv/f6XxmtIFz08fUb8h Bp/zJP6IC4/rhhh+0GMRIRzLN8DK0jV8JCzYdFHiRJOy2lNIOpmrrCmjRRxferc2G42+ePFIsslx hU46VSz1Z83NwIG3mpdYNV5WUTUdgzxExHTNTFCd7NKv0nlHKQaA OpenPGP: url=https://posteo.de/keys/thievol@posteo.net.asc; preference=encrypt X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:276530 Archived-At: --==-=-= Content-Type: multipart/mixed; boundary="=-=-=" --=-=-= Content-Type: text/plain Content-Transfer-Encoding: quoted-printable Hello Stefan, Stefan Monnier writes: >> It should be possible to use post-command-hook, I didn't use it because >> it makes harder the communication between the minibuffer and the preview >> buffer. > > The patch below seems to work for my extremely limited testing. Could have some time to test register with your post-command-hook patch. I had to make on more little change to make it working in all conditions, here what I tried so far: 1) (customize-set-variable 'register-use-preview t) We have here confirmation with RET everywhere, works fine in all commands and test macro. 2) (customize-set-variable 'register-use-preview nil) We have here no confirmation (RET) at all, works fine in all commands and test macro. 3) (customize-set-variable 'register-use-preview nil) and modification with a defmethod so that we have no confirmation in insert/jump and confirmation with increment-register: (cl-defmethod register-command-info ((_command (eql increment-register)= )) (make-register-preview-info :types '(all) :msg "Increment to register `%s'" :act 'set :smatch t :noconfirm t)) Works fine everywhere and in test macro as well. 4) (customize-set-variable 'register-use-preview 'never) Same behavior as in 2) and 3) in same conditions. [The test macro was adding a number at beginning and end of each lines in a text and increment this number at every turn, this involve insert-register (twice) and increment-register (once).] So it seems we have now something working fine in all conditions :-) Here the serie of patches (the first 3 are unchanged).=20 =2D-=20 Thierry --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Don-t-confirm-with-RET-even-when-overwriting-in-regi.patch Content-Transfer-Encoding: quoted-printable From=20f28f38f51af62325213bdf7c9e85ee031b405f4c Mon Sep 17 00:00:00 2001 From: Thierry Volpiatto Date: Mon, 11 Dec 2023 07:02:40 +0100 Subject: [PATCH 1/4] Don't confirm with RET even when overwriting in regist= er commands This happen when register-use-preview is nil or never. This reproduce what we had previously in 29.1 but with filtering in the preview and default registers are provided for the commands of type 'set'. This is implemented with cl-defmethod to keep the code as much as possible configurable. * lisp/register.el (register-preview-info): New slot. (register-command-info): Add new methods for copy-to-register, point-to-register, number-to-register, window-configuration-to-register, frameset-to-register and copy-rectangle-to-register. (register-read-with-preview): Bind noconfirm. =2D-- lisp/register.el | 67 ++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 56 insertions(+), 11 deletions(-) diff --git a/lisp/register.el b/lisp/register.el index ef529cd67e5..cd6f2861315 100644 =2D-- a/lisp/register.el +++ b/lisp/register.el @@ -156,7 +156,7 @@ 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 regist= er." =2D types msg act smatch) + types msg act smatch noconfirm) =20 (cl-defgeneric register-command-info (command) "Returns a `register-preview-info' object storing data for COMMAND." @@ -179,24 +179,66 @@ SMATCH accept a boolean value to say if command accep= t non matching register." :types '(all) :msg "View register `%s'" :act 'view + :noconfirm (memq register-use-preview '(nil never)) :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 + :noconfirm (memq register-use-preview '(nil never)) :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 + :noconfirm (memq register-use-preview '(nil never)) :smatch t)) (cl-defmethod register-command-info ((_command (eql increment-register))) (make-register-preview-info :types '(string number) :msg "Increment register `%s'" :act 'modify + :noconfirm (memq register-use-preview '(nil never)) + :smatch t)) +(cl-defmethod register-command-info ((_command (eql copy-to-register))) + (make-register-preview-info + :types '(all) + :msg "Copy to register `%s'" + :act 'set + :noconfirm (memq register-use-preview '(nil never)))) +(cl-defmethod register-command-info ((_command (eql point-to-register))) + (make-register-preview-info + :types '(all) + :msg "Point to register `%s'" + :act 'set + :noconfirm (memq register-use-preview '(nil never)))) +(cl-defmethod register-command-info ((_command (eql number-to-register))) + (make-register-preview-info + :types '(all) + :msg "Number to register `%s'" + :act 'set + :noconfirm (memq register-use-preview '(nil never)))) +(cl-defmethod register-command-info + ((_command (eql window-configuration-to-register))) + (make-register-preview-info + :types '(all) + :msg "Window configuration to register `%s'" + :act 'set + :noconfirm (memq register-use-preview '(nil never)))) +(cl-defmethod register-command-info ((_command (eql frameset-to-register))) + (make-register-preview-info + :types '(all) + :msg "Frameset to register `%s'" + :act 'set + :noconfirm (memq register-use-preview '(nil never)))) +(cl-defmethod register-command-info ((_command (eql copy-rectangle-to-regi= ster))) + (make-register-preview-info + :types '(all) + :msg "Copy rectangle to register `%s'" + :act 'set + :noconfirm (memq register-use-preview '(nil never)) :smatch t)) =20 (defun register-preview-forward-line (arg) @@ -328,12 +370,13 @@ display such a window regardless." m)) (data (register-command-info this-command)) (enable-recursive-minibuffers t) =2D types msg result timer act win strs smatch) + types msg result timer act win strs smatch noconfirm) (if data =2D (setq types (register-preview-info-types data) =2D msg (register-preview-info-msg data) =2D act (register-preview-info-act data) =2D smatch (register-preview-info-smatch 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) + noconfirm (register-preview-info-noconfirm data)) (setq types '(all) msg "Overwrite register `%s'" act 'set)) @@ -405,13 +448,15 @@ display such a window regardless." "Register `%s' is empty" pat)))))) (unless (string=3D pat "") (with-selected-window (minibuffer-window) =2D (if (and (member pat strs) (memq act '(s= et modify))) + (if (and (member pat strs) + (memq act '(set modify)) + (null noconfirm)) (with-selected-window (minibuffer-wind= ow) (minibuffer-message msg pat)) =2D ;; An empty register or an existing =2D ;; one but the action is insert or =2D ;; jump, don't ask for confirmation =2D ;; and exit immediately (bug#66394). + ;; The action is insert or + ;; jump or noconfirm is specifed + ;; explicitely, don't ask for + ;; confirmation and exit immediately (bu= g#66394). (setq result pat) (exit-minibuffer))))))))) (setq result (read-from-minibuffer =2D-=20 2.34.1 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0002-Provide-emacs-29-behavior-for-register-preview.patch Content-Transfer-Encoding: quoted-printable From=2099cb6d4d1e85b85a60e26ddc22a54a0a9b029d43 Mon Sep 17 00:00:00 2001 From: Thierry Volpiatto Date: Tue, 12 Dec 2023 07:24:32 +0100 Subject: [PATCH 2/4] Provide emacs-29 behavior for register-preview It is now the default with a value of register-use-preview eq to basic. To change this one have now to customize register-use-preview to another value. * lisp/register.el (register-preview-delay): Remove obsolescence. (register--read-with-preview-function): New. (register-use-preview): New option basic, it is now the default. (register-preview-default-1): New the register-preview-default used by `register-read-with-preview-fancy`. (register-preview-default): Restored (same as Emacs-29). (register--preview-function): Generic fn that return the right function for register--preview-function. (register-preview): Restored (same behavior as Emacs-29). (register-preview-1): Used by `register-read-with-preview-fancy'. (register-read-with-preview-basic): The old register-read-with-preview. (register-read-with-preview-fancy): The new register-read-with-preview. =2D-- lisp/register.el | 156 +++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 132 insertions(+), 24 deletions(-) diff --git a/lisp/register.el b/lisp/register.el index cd6f2861315..8f0c6a7105d 100644 =2D-- a/lisp/register.el +++ b/lisp/register.el @@ -100,25 +100,55 @@ If nil, do not show register previews, unless `help-c= har' (or a member of :version "24.4" :type '(choice number (const :tag "No preview unless requested" nil)) :group 'register) =2D(make-obsolete-variable 'register-preview-delay "No longer used." "30.1") =20 (defcustom register-preview-default-keys (mapcar #'string (number-sequence= ?a ?z)) "Default keys for setting a new register." =2D :type '(repeat string)) =2D =2D(defcustom register-use-preview t =2D "Whether to show preview of registers. =2D =2DIf the value is t, show a preview buffer with navigation and highlightin= g. =2DIf the value is nil, show a basic preview buffer and exit minibuffer =2Dimmediately after the register name is inserted into minibuffer. =2DIf the value is \\=3D'never, behave as for nil, but with no preview buff= er =2Dat all." + :type '(repeat string) + :version 30.1) + +(defvar register--read-with-preview-function nil + "The register read preview function to use. +Two functions are provided, one that provide navigation and +highlighting of the register selected, filtering of register +according to command in use, defaults register to use when +setting a new register, confirmation and notification when you +are about to overwrite a register and generic functions to +configure how each existing commands behave. The other function +provided is the same as what was used in Emacs-29, no filtering, +no navigation, no defaults.") + +(defvar register-preview-function nil + "Function to format a register for previewing. +Called with one argument, a cons (NAME . CONTENTS) as found in `register-a= list'. +The function should return a string, the description of the argument. +It is set according to the value of `register--read-with-preview-function'= .") + +(defcustom register-use-preview 'basic + "Maybe show register preview. + +This has no effect when `register--read-with-preview-function' value +is `register-read-with-preview-basic'. + +When set to `t' show a preview buffer with navigation and highlighting. +When nil show a basic preview buffer and exit minibuffer +immediately after insertion in minibuffer. +When set to \\=3D'never behave as above but with no preview buffer at +all. +When set to \\=3D'basic provide a much more basic preview according to +`register-preview-delay', it has the exact same behavior as in Emacs-29." :type '(choice (const :tag "Use preview" t) (const :tag "Use quick preview" nil) =2D (const :tag "Never use preview" never)) =2D :version "30.1") + (const :tag "Never use preview" never) + (const :tag "Basic preview like Emacs-29" basic)) + :version 30.1 + :set (lambda (var val) + (set var val) + (setq register--read-with-preview-function + (if (eq val 'basic) + #'register-read-with-preview-basic + #'register-read-with-preview-fancy)) + (setq register-preview-function nil))) =20 (defun get-register (register) "Return contents of Emacs register named REGISTER, or nil if none." @@ -138,17 +168,28 @@ See the documentation of the variable `register-alist= ' for possible VALUEs." (substring d (match-end 0)) d))) =20 =2D(defun register-preview-default (r) +(defun register-preview-default-1 (r) "Function that is the default value of the variable `register-preview-fu= nction'." (format "%s: %s\n" (propertize (string (car r)) 'display (single-key-description (car r))) (register-describe-oneline (car r)))) =20 =2D(defvar register-preview-function #'register-preview-default =2D "Function to format a register for previewing. =2DCalled with one argument, a cons (NAME . CONTENTS) as found in `register= -alist'. =2DThe function should return a string, the description of the argument.") +(defun register-preview-default (r) + "Function that is the default value of the variable `register-preview-fu= nction'." + (format "%s: %s\n" + (single-key-description (car r)) + (register-describe-oneline (car r)))) + +(cl-defgeneric register--preview-function (read-preview-function) + "Returns a function to format a register for previewing. +This according to the value of READ-PREVIEW-FUNCTION.") +(cl-defmethod register--preview-function ((_read-preview-function + (eql register-read-with-preview= -basic))) + #'register-preview-default) +(cl-defmethod register--preview-function ((_read-preview-function + (eql register-read-with-preview= -fancy))) + #'register-preview-default-1) =20 (cl-defstruct register-preview-info "Store data for a specific register command. @@ -310,9 +351,9 @@ satisfy `cl-typep' otherwise the new type should be def= ined with (cl-defmethod register--type ((_regval string)) 'string) (cl-defmethod register--type ((_regval number)) 'number) (cl-defmethod register--type ((_regval marker)) 'marker) =2D(cl-defmethod register--type ((_regval (eql 'buffer))) 'buffer) =2D(cl-defmethod register--type ((_regval (eql 'file))) 'file) =2D(cl-defmethod register--type ((_regval (eql 'file-query))) 'file-query) +(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) @@ -327,12 +368,39 @@ satisfy `cl-typep' otherwise the new type should be d= efined with when (memq (register-type register) types) collect register))) =20 =2D(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. +Format of each entry is controlled by the variable `register-preview-funct= ion'." + (unless register-preview-function + (setq register-preview-function (register--preview-function + register--read-with-preview-function)= )) + (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-preview-1 (buffer &optional show-empty types) + "Pop up a window showing the registers preview in BUFFER. + +This is the preview function use with +`register-read-with-preview-fancy' function. +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 sh= ow all registers, see `register-type' for suitable types. Format of each entry is controlled by the variable `register-preview-funct= ion'." + (unless register-preview-function + (setq register-preview-function (register--preview-function + register--read-with-preview-function)= )) (let ((registers (register-of-type-alist (or types '(all))))) (when (or show-empty (consp registers)) (with-current-buffer-window @@ -360,6 +428,46 @@ Format of each entry is controlled by the variable `re= gister-preview-function'." "Read and return a register name, possibly showing existing registers. Prompt with the string PROMPT. If `help-char' (or a member of `help-event-list') is pressed, +display such a window regardless." + (funcall register--read-with-preview-function prompt)) + +(defun register-read-with-preview-basic (prompt) + "Read and return a register name, possibly showing existing registers. +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*") + (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 + (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))))) + +(defun register-read-with-preview-fancy (prompt) + "Read and return a register name, possibly showing existing registers. +Prompt with the string PROMPT. +If `help-char' (or a member of `help-event-list') is pressed, display such a window regardless." (let* ((buffer "*Register Preview*") (buffer1 "*Register quick preview*") @@ -392,13 +500,13 @@ display such a window regardless." ;; Do nothing when buffer1 is in use. (unless (get-buffer-window buf) (with-selected-window (minibuffer-selected-window) =2D (register-preview buffer 'show-empty types)))= ))) + (register-preview-1 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 (eq register-use-preview 'never)) =2D (register-preview buf nil types)) + (register-preview-1 buf nil types)) (unwind-protect (progn (minibuffer-with-setup-hook =2D-=20 2.34.1 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0003-Fix-issue-with-register-commands-in-kmacro.patch Content-Transfer-Encoding: quoted-printable From=200fe75f80172bb02a082e786264f21e69e09a96dd Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 18 Dec 2023 07:11:42 +0100 Subject: [PATCH 3/4] Fix issue with register commands in kmacro Using post-command-hook in minibuffer-setup-hook instead of a timer allow running exit-minibuffer without delay and ensure the serie of commands used in a kmacro run synchronously. * lisp/register.el (register-read-with-preview-fancy): Do it. =2D-- lisp/register.el | 114 +++++++++++++++++++++++------------------------ 1 file changed, 56 insertions(+), 58 deletions(-) diff --git a/lisp/register.el b/lisp/register.el index 8f0c6a7105d..19b207960d6 100644 =2D-- a/lisp/register.el +++ b/lisp/register.el @@ -478,7 +478,7 @@ display such a window regardless." m)) (data (register-command-info this-command)) (enable-recursive-minibuffers t) =2D types msg result timer act win strs smatch noconfirm) + types msg result act win strs smatch noconfirm) (if data (setq types (register-preview-info-types data) msg (register-preview-info-msg data) @@ -511,68 +511,66 @@ display such a window regardless." (progn (minibuffer-with-setup-hook (lambda () =2D (setq timer =2D (run-with-idle-timer =2D 0.01 'repeat =2D (lambda () =2D (with-selected-window (minibuffer-window) =2D (let ((input (minibuffer-contents))) =2D (when (> (length input) 1) =2D (let ((new (substring input 1)) =2D (old (substring input 0 1))) =2D (setq input (if (or (null smatch) =2D (member new strs)) =2D new old)) =2D (delete-minibuffer-contents) =2D (insert input))) =2D (when (and smatch (not (string=3D input ""= )) =2D (not (member input strs))) =2D (setq input "") =2D (delete-minibuffer-contents) =2D (minibuffer-message "Not matching")) =2D (when (not (string=3D input pat)) =2D (setq pat input)))) =2D (if (setq win (get-buffer-window buffer)) =2D (with-selected-window win =2D (let ((ov (make-overlay =2D (point-min) (point-min))) =2D ;; Allow upper-case and =2D ;; lower-case letters to refer =2D ;; to different registers. =2D (case-fold-search nil)) =2D (goto-char (point-min)) =2D (remove-overlays) =2D (unless (string=3D pat "") =2D (if (re-search-forward (concat "^" p= at) nil t) =2D (progn (move-overlay =2D ov =2D (match-beginning 0) (pos= -eol)) =2D (overlay-put ov 'face 'ma= tch) =2D (when msg =2D (with-selected-window (= minibuffer-window) =2D (minibuffer-message m= sg pat)))) =2D (with-selected-window (minibuffer-= window) =2D (minibuffer-message =2D "Register `%s' is empty" pat)))= ))) =2D (unless (string=3D pat "") =2D (with-selected-window (minibuffer-window) =2D (if (and (member pat strs) =2D (memq act '(set modify)) =2D (null noconfirm)) =2D (with-selected-window (minibuffer-wi= ndow) =2D (minibuffer-message msg pat)) =2D ;; The action is insert or =2D ;; jump or noconfirm is specifed =2D ;; explicitely, don't ask for =2D ;; confirmation and exit immediately (= bug#66394). =2D (setq result pat) =2D (exit-minibuffer))))))))) + (add-hook 'post-command-hook + (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=3D input "= ")) + (not (member input strs))) + (setq input "") + (delete-minibuffer-contents) + (minibuffer-message "Not matching")) + (when (not (string=3D input pat)) + (setq pat input)))) + (if (setq win (get-buffer-window buffer)) + (with-selected-window win + (let ((ov (make-overlay + (point-min) (point-min))) + ;; Allow upper-case and + ;; lower-case letters to refer + ;; to different registers. + (case-fold-search nil)) + (goto-char (point-min)) + (remove-overlays) + (unless (string=3D pat "") + (if (re-search-forward (concat "^" = pat) nil t) + (progn (move-overlay + ov + (match-beginning 0) (po= s-eol)) + (overlay-put ov 'face 'm= atch) + (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=3D pat "") + (with-selected-window (minibuffer-window) + (if (and (member pat strs) + (memq act '(set modify)) + (null noconfirm)) + (with-selected-window (minibuffer-w= indow) + (minibuffer-message msg pat)) + ;; The action is insert or + ;; jump or noconfirm is specifed + ;; explicitely, don't ask for + ;; confirmation and exit immediately = (bug#66394). + (setq result pat) + (exit-minibuffer)))))) + nil 'local)) (setq result (read-from-minibuffer prompt nil map nil nil (register-preview-get-de= faults act)))) (cl-assert (and result (not (string=3D result ""))) nil "No register specified") (string-to-char result)) =2D (when timer (cancel-timer timer)) (let ((w (get-buffer-window buf))) (and (window-live-p w) (delete-window w))) (and (get-buffer buf) (kill-buffer buf))))) =2D-=20 2.34.1 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0004-Fix-condition-in-register-read-with-preview-fancy.patch Content-Transfer-Encoding: quoted-printable From=20777c6c7e821d44faa970655c04e9eba8e5b11498 Mon Sep 17 00:00:00 2001 From: Thierry Volpiatto Date: Tue, 19 Dec 2023 17:45:22 +0100 Subject: [PATCH 4/4] Fix condition in register-read-with-preview-fancy Now with have :noconfirm no need to check for '(set modify) otherwise we fail as well in kmacros when register-use-preview is t. The conditions should not be hard coded in register-read-with-preview-fancy but in the cl-defmethod register-command-info for each command. * lisp/register.el (register-read-with-preview-fancy): Remove now unneeded condition. =2D-- lisp/register.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/register.el b/lisp/register.el index 19b207960d6..c2b10a91adb 100644 =2D-- a/lisp/register.el +++ b/lisp/register.el @@ -207,14 +207,16 @@ SMATCH accept a boolean value to say if command accep= t non matching register." :types '(string number) :msg "Insert register `%s'" :act 'insert =2D :smatch t)) + :smatch t + :noconfirm (memq register-use-preview '(nil never)))) (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 =2D :smatch t)) + :smatch t + :noconfirm (memq register-use-preview '(nil never)))) (cl-defmethod register-command-info ((_command (eql view-register))) (make-register-preview-info :types '(all) @@ -555,12 +557,10 @@ display such a window regardless." (unless (string=3D pat "") (with-selected-window (minibuffer-window) (if (and (member pat strs) =2D (memq act '(set modify)) (null noconfirm)) (with-selected-window (minibuffer-w= indow) (minibuffer-message msg pat)) =2D ;; The action is insert or =2D ;; jump or noconfirm is specifed + ;; :noconfirm is specifed ;; explicitely, don't ask for ;; confirmation and exit immediately = (bug#66394). (setq result pat) =2D-=20 2.34.1 --=-=-=-- --==-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQHHBAEBCgAxFiEEI9twfRN7r3nig/xwDsVtFB0W75MFAmWB1awTHHRoaWV2b2xA cG9zdGVvLm5ldAAKCRAOxW0UHRbvk3e/C/49hgG/pt+YTzaAHC1DA2d+9/Q+9zLf N2BhluynQytPJl4rw0O/eLls+khkVOaZlCfvFY+jFFRrcHnCxuE3Tp4CxhuUVRs4 YejvEBZfhlSxpx7RDS0AhG4eZVw2II282xypyCzca1ygPpQ5p7TpefCAb/ySGRgj GJpLZP4y71xLpigqjnDDfyXkbXkQjMSEhqJxPutow8Y1GcSDIeT7YkxKH1+Shqhf fvgULNkv9upImQ0OOn2pmmvX88/CpYocFtw2hZ2F6hknapmSs8+F8ZReesRn086g Cwg9HR2jl+syDg7LucLF4DZEbzf9emltTsPKVNccklRsCvzJNh0YewVJywI8o6lh mkoSnmCqEumVEM0dmssrjWJsYdz+IHEMQP2X86lCVuHArx+zAXWU67xvodfVTv4D EpuQnPfJ/gVw+1DCP9vPq8h92x3pEi0Y1bU1T+gbHFO0POxv2mAIkUwU1wK/+qV8 +Ujq/tXRZOksdtwBUb64CGvYIzcSd7aYNUU= =CYtm -----END PGP SIGNATURE----- --==-=-=--