>From 7feaad5309282d985d25796545f115c8fe004a90 Mon Sep 17 00:00:00 2001 From: Evgenii Klimov 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