unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* [PATCH] Filter registers before preview
@ 2023-07-30 18:27 Evgenii Klimov
  2023-07-31  0:15 ` Michael Heerdegen
  2023-07-31 11:45 ` Eli Zaretskii
  0 siblings, 2 replies; 7+ messages in thread
From: Evgenii Klimov @ 2023-07-30 18:27 UTC (permalink / raw)
  To: emacs-devel

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

Hi, I find registers very useful (especially with elaborate
`register-preview-function'), but as they become more and more numerous,
it gets difficult to select the right one, because every command
(`jump-to-register', `insert-register', etc.) shows every register in
the preview buffer, even if the register is not applicable in this
context.

The following is my attempt to deal with this issue.  If you find this
idea interesting then I can rewrite this patch to conform with
the surrounding code (cl-defgeneric/cl-defmethod) and your remarks.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Filter-registers-before-preview.patch --]
[-- Type: text/x-diff, Size: 9214 bytes --]

From 7feaad5309282d985d25796545f115c8fe004a90 Mon Sep 17 00:00:00 2001
From: Evgenii Klimov <eugene.dev@lipklim.org>
Date: Sun, 30 Jul 2023 18:35:50 +0100
Subject: [PATCH] Filter registers before preview

* lisp/register.el (register--filter-candidate): Add function to
check if the current register should be previewed.
(register-preview, register-read-with-preview): Add optional
argument "types".
(jump-to-register, increment-register, insert-register,
append-to-register, prepend-to-register): Indicate which register
types should be previewed by each command.
---
 lisp/register.el | 110 ++++++++++++++++++++++++++++++++---------------
 1 file changed, 76 insertions(+), 34 deletions(-)

diff --git a/lisp/register.el b/lisp/register.el
index ca6de450993..d92daabec28 100644
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -128,25 +128,55 @@ See the documentation of the variable `register-alist' for possible VALUEs."
 Called with one argument, a cons (NAME . CONTENTS) as found in `register-alist'.
 The function should return a string, the description of the argument.")
 
-(defun register-preview (buffer &optional show-empty)
+(defun register--filter-candidate (reg-val types)
+  "Check if the register value REG-VAL is of any of the specified
+types in TYPES"
+  (cond ((numberp reg-val) (memq 'number types))
+        ((markerp reg-val) (memq 'marker types))
+        ((stringp reg-val) (memq 'string types))
+        ((and (registerv-p reg-val) (registerv-print-func reg-val)
+              (memq 'registerv-print types))
+         'registerv)
+        ((and (registerv-p reg-val) (registerv-jump-func reg-val)
+              (memq 'registerv-jump types))
+         'registerv)
+        ((and (registerv-p reg-val) (registerv-insert-func reg-val)
+              (memq 'registerv-insert types))
+         'registerv)
+        ((frameset-register-p reg-val) (memq 'frameset-register types))
+        ((consp reg-val)
+         (cond ((eq 'file (car reg-val)) (memq 'file types))
+               ((eq 'file-query (car reg-val)) (memq 'file-query types))
+               ((window-configuration-p (car reg-val))
+                (memq 'window-configuration types))
+               ((frame-configuration-p (car reg-val))
+                (memq 'frame-configuration types))
+               ((and (seqp reg-val) (seq-every-p (lambda (el) (stringp el)) reg-val))
+                (memq 'rectangle types))
+               (t (user-error "Unknown type of register"))))
+        (t (user-error "Unknown type of register"))))
+
+(defun register-preview (buffer &optional show-empty types)
   "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-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-read-with-preview (prompt)
+        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 (and (get-register (car elem))
+                           (or (null types) ; backward compatible
+                               (register--filter-candidate (cdr elem) types)))
+                  (insert (funcall register-preview-function elem))))
+              register-alist)))))
+
+(defun register-read-with-preview (prompt &optional types)
   "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
@@ -154,26 +184,26 @@ 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)))
+         (timer (when (numberp register-preview-delay)
+                  (run-with-timer register-preview-delay nil
+                                  (lambda ()
+                                    (unless (get-buffer-window buffer)
+                                      (register-preview buffer nil types))))))
+         (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)))
+        (progn
+          (while (memq (read-key (propertize prompt 'face 'minibuffer-prompt))
+                       help-chars)
+            (unless (get-buffer-window buffer)
+              (register-preview buffer 'show-empty types)))
           (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")))
+          (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)))
@@ -251,7 +281,13 @@ to delete any existing frames that the frameset doesn't mention.
 ignored if the register contains anything but a frameset.
 
 Interactively, prompt for REGISTER using `register-read-with-preview'."
-  (interactive (list (register-read-with-preview "Jump to register: ")
+  (interactive (list (register-read-with-preview "Jump to register: "
+                                                 '( registerv-jump
+                                                    marker window-configuration
+                                                    file file-query buffer
+                                                    frameset-register
+                                                    ;; obsolete, but exist
+                                                    frame-configuration))
 		     current-prefix-arg))
   (let ((val (get-register register)))
     (register-val-jump-to val delete)))
@@ -338,7 +374,8 @@ If REGISTER is empty or if it contains text, call
 
 Interactively, prompt for REGISTER using `register-read-with-preview'."
   (interactive (list current-prefix-arg
-		     (register-read-with-preview "Increment register: ")))
+		     (register-read-with-preview "Increment register: "
+                                                 '(number string))))
   (let ((register-val (get-register register)))
     (cond
      ((numberp register-val)
@@ -485,7 +522,10 @@ and t otherwise.
 Interactively, prompt for REGISTER using `register-read-with-preview'."
   (interactive (progn
 		 (barf-if-buffer-read-only)
-		 (list (register-read-with-preview "Insert register: ")
+		 (list (register-read-with-preview "Insert register: "
+                                                   '( registerv-insert
+                                                      rectangle string
+                                                      number marker))
 		       (not current-prefix-arg))))
   (push-mark)
   (let ((val (get-register register)))
@@ -550,7 +590,8 @@ START and END are buffer positions indicating what to append.
 
 Interactively, prompt for REGISTER using `register-read-with-preview',
 and use mark and point as START and END."
-  (interactive (list (register-read-with-preview "Append to register: ")
+  (interactive (list (register-read-with-preview "Append to register: "
+                                                 '(string))
 		     (region-beginning)
 		     (region-end)
 		     current-prefix-arg))
@@ -576,7 +617,8 @@ START and END are buffer positions indicating what to prepend.
 
 Interactively, prompt for REGISTER using `register-read-with-preview',
 and use mark and point as START and END."
-  (interactive (list (register-read-with-preview "Prepend to register: ")
+  (interactive (list (register-read-with-preview "Prepend to register: "
+                                                 '(string))
 		     (region-beginning)
 		     (region-end)
 		     current-prefix-arg))
-- 
2.34.1


^ permalink raw reply related	[flat|nested] 7+ messages in thread

end of thread, other threads:[~2023-08-01  3:58 UTC | newest]

Thread overview: 7+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2023-07-30 18:27 [PATCH] Filter registers before preview Evgenii Klimov
2023-07-31  0:15 ` Michael Heerdegen
2023-07-31 16:58   ` Evgenii Klimov
2023-08-01  3:58     ` Michael Heerdegen
2023-07-31 11:45 ` Eli Zaretskii
2023-07-31 12:45   ` Evgenii Klimov
2023-07-31 17:18     ` Eli Zaretskii

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).