bug-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

bug#66394: [RE] Make register-read-with-preview more useful


From: Thierry Volpiatto
Subject: bug#66394: [RE] Make register-read-with-preview more useful
Date: Sun, 08 Oct 2023 06:45:11 +0000

Here a modified version of the patch that fix the face, send an error
when exiting with empty prompt and prevent adding more than one char in
prompt.
From this code, it is now easy to modify the behavior as needed (ideas welcome).

diff --git a/lisp/register.el b/lisp/register.el
index ca6de450993..47645098e6d 100644
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -154,27 +154,45 @@ 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)))
+         (pat "")
+         result timer)
+    (register-preview buffer)
     (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))
+         (progn
+           (minibuffer-with-setup-hook
+               (lambda ()
+                 (setq timer
+                       (run-with-idle-timer
+                        0.3 'repeat
+                        (lambda ()
+                          (with-selected-window (minibuffer-window)
+                            (setq minibuffer-scroll-window
+                                  (get-buffer-window buffer))
+                            (let ((input (minibuffer-contents)))
+                              (when (> (length input) 1)
+                                (setq input (substring input 0 1))
+                                (delete-minibuffer-contents)
+                                (insert input))
+                              (when (not (string= input pat))
+                                (setq pat input))))
+                          (with-current-buffer buffer
+                            (let ((ov (make-overlay (point-min) (point-min))))
+                              (goto-char (point-min))
+                              (if (string= pat "")
+                                  (remove-overlays)
+                                (if (re-search-forward (concat "^" pat) nil t)
+                                    (progn (move-overlay
+                                            ov
+                                            (match-beginning 0) (match-end 0))
+                                           (overlay-put ov 'face 'match))
+                                  (with-selected-window (minibuffer-window)
+                                    (minibuffer-message
+                                     "Register `%s' is available" pat))))))))))
+             (setq result (read-from-minibuffer prompt)))
+           (cl-assert (and result (not (string= result "")))
+                      nil "No register specified")
+           (string-to-char result))
+      (when 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)))))

-- 
Thierry

Attachment: signature.asc
Description: PGP signature


reply via email to

[Prev in Thread] Current Thread [Next in Thread]