bug#15525: 24.3; register-read-with-preview

[Leo Liu]

On 2013-10-04 21:57 +0800, Stefan Monnier wrote:
[snipped 3 lines]
> I like the idea of displaying the available choices, but I'm not sure
> "0.5s delay" is a good enough trigger: it's probably a fine choice for
> some users, but usually Emacs doesn't like to use such time-dependent
> behavior too much.
>
> Could we offer, additionally to the delay, a different trigger
> (e.g. help-char and help-event-list)?
>
>
>         Stefan

Good idea. The attached patch implements this. i.e. if one sets
register-preview-delay to t it means forever, i.e. the timer is never
set. Users can customise register-read-help-char to nil if they don't
want any help-char to bring up the preview window.

BTW, the delay is so that if you can remember which register to choose
within some time (0.5s) you shall never see the preview window.

[snipped 10 lines]
>> PS: How does it compare to register-list?  Could they be
>> consolidated?
>
> I hope so.  The Org merge is higher on my todo-list, but working on
> register-list.el comes right after.

I leave a hook i.e. register-preview-functions for customising how the
preview should be presented. I am not sure other ways to have
integration with register-list. Comments welcome.

Best wishes,
Leo

=== modified file 'lisp/register.el'
--- lisp/register.el    2013-08-09 00:30:24 +0000
+++ lisp/register.el    2013-10-05 03:08:31 +0000
@@ -89,6 +89,16 @@
   :type '(choice (const :tag "None" nil)
                 (character :tag "Use register" :value ?+)))
 
+(defcustom register-preview-delay 0.5
+  "Delay in seconds before popping up the preview window."
+  :type '(choice number (const :tag "Indefinitely" t))
+  :group 'register)
+
+(defcustom register-read-help-char help-char
+  "Character to recognize as meaning help."
+  :type '(choice character (const :tag "Never" nil))
+  :group 'register)
+
 (defun get-register (register)
   "Return contents of Emacs register named REGISTER, or nil if none."
   (cdr (assq register register-alist)))
@@ -102,12 +112,60 @@
       (push (cons register value) register-alist))
     value))
 
+(defun register-describe-oneline (c)
+  (let ((d (replace-regexp-in-string
+            "\n[ \t]*" " "
+            (with-output-to-string (describe-register-1 c)))))
+    (if (string-match "Register.+? contains \\(?:an? \\|the \\)?" d)
+        (substring d (match-end 0))
+      d)))
+
+(defvar register-preview-functions nil)
+
+(defun register-preview (buffer)
+  "Pop up a window to show register preview in BUFFER."
+  (when (consp register-alist)
+    (let ((split-height-threshold 0))
+      (with-temp-buffer-window
+       buffer
+       (cons 'display-buffer-below-selected
+            '((window-height . fit-window-to-buffer)))
+       nil
+       (with-current-buffer standard-output
+        (setq cursor-in-non-selected-windows nil)
+        (mapc (lambda (r)
+                (insert
+                 (format
+                  "%s %s\n"
+                  (concat (single-key-description (car r)) ":")
+                  (or (run-hook-with-args 'register-preview-functions (cdr r))
+                      (register-describe-oneline (car r))))))
+              register-alist))))))
+
+(defun register-read-with-preview (prompt)
+  (let* ((buffer "*Register Preview*")
+        (timer (when (numberp register-preview-delay)
+                 (run-with-timer register-preview-delay nil
+                                 #'register-preview buffer))))
+    (unwind-protect
+       (progn
+         (while (eq (read-event (propertize prompt 'face 'minibuffer-prompt))
+                    register-read-help-char)
+           (unless (get-buffer-window buffer)
+             (register-preview buffer)))
+         last-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 point-to-register (register &optional arg)
   "Store current location of point in register REGISTER.
 With prefix argument, store current frame configuration.
 Use \\[jump-to-register] to go to that location or restore that configuration.
 Argument is a character, naming the register."
-  (interactive "cPoint to register: \nP")
+  (interactive (list (register-read-with-preview "Point to register: ")
+                    current-prefix-arg))
   ;; Turn the marker into a file-ref if the buffer is killed.
   (add-hook 'kill-buffer-hook 'register-swap-out nil t)
   (set-register register
@@ -118,7 +176,9 @@
   "Store the window configuration of the selected frame in register REGISTER.
 Use \\[jump-to-register] to restore the configuration.
 Argument is a character, naming the register."
-  (interactive "cWindow configuration to register: \nP")
+  (interactive (list (register-read-with-preview
+                     "Window configuration to register: ")
+                    current-prefix-arg))
   ;; current-window-configuration does not include the value
   ;; of point in the current buffer, so record that separately.
   (set-register register (list (current-window-configuration) (point-marker))))
@@ -127,7 +187,9 @@
   "Store the window configuration of all frames in register REGISTER.
 Use \\[jump-to-register] to restore the configuration.
 Argument is a character, naming the register."
-  (interactive "cFrame configuration to register: \nP")
+  (interactive (list (register-read-with-preview
+                     "Frame configuration to register: ")
+                    current-prefix-arg))
   ;; current-frame-configuration does not include the value
   ;; of point in the current buffer, so record that separately.
   (set-register register (list (current-frame-configuration) (point-marker))))
@@ -143,7 +205,8 @@
 Optional second arg non-nil (interactively, prefix argument) says to
 delete any existing frames that the frameset doesn't mention.
 \(Otherwise, these frames are iconified.)"
-  (interactive "cJump to register: \nP")
+  (interactive (list (register-read-with-preview "Jump to register: ")
+                    current-prefix-arg))
   (let ((val (get-register register)))
     (cond
      ((registerv-p val)
@@ -190,7 +253,8 @@
 If NUMBER is nil, a decimal number is read from the buffer starting
 at point, and point moves to the end of that number.
 Interactively, NUMBER is the prefix arg (none means nil)."
-  (interactive "P\ncNumber to register: ")
+  (interactive (list current-prefix-arg
+                    (register-read-with-preview "Number to register: ")))
   (set-register register
                (if number
                    (prefix-numeric-value number)
@@ -222,7 +286,7 @@
 (defun view-register (register)
   "Display what is contained in register named REGISTER.
 The Lisp value REGISTER is a character."
-  (interactive "cView register: ")
+  (interactive (list (register-read-with-preview "View register: ")))
   (let ((val (get-register register)))
     (if (null val)
        (message "Register %s is empty" (single-key-description register))
@@ -323,7 +387,10 @@
 Normally puts point before and mark after the inserted text.
 If optional second arg is non-nil, puts mark before and point after.
 Interactively, second arg is non-nil if prefix arg is supplied."
-  (interactive "*cInsert register: \nP")
+  (interactive (progn
+                (barf-if-buffer-read-only)
+                (register-read-with-preview "Insert register: ")
+                current-prefix-arg))
   (push-mark)
   (let ((val (get-register register)))
     (cond
@@ -349,7 +416,10 @@
 With prefix arg, delete as well.
 Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
 START and END are buffer positions indicating what to copy."
-  (interactive "cCopy to register: \nr\nP")
+  (interactive (list (register-read-with-preview "Copy to register: ")
+                    (region-beginning)
+                    (region-end)
+                    current-prefix-arg))
   (set-register register (filter-buffer-substring start end))
   (setq deactivate-mark t)
   (cond (delete-flag
@@ -362,7 +432,10 @@
 With prefix arg, delete as well.
 Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
 START and END are buffer positions indicating what to append."
-  (interactive "cAppend to register: \nr\nP")
+  (interactive (list (register-read-with-preview "Append to register: ")
+                    (region-beginning)
+                    (region-end)
+                    current-prefix-arg))
   (let ((reg (get-register register))
         (text (filter-buffer-substring start end))
        (separator (and register-separator (get-register register-separator))))
@@ -381,7 +454,10 @@
 With prefix arg, delete as well.
 Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
 START and END are buffer positions indicating what to prepend."
-  (interactive "cPrepend to register: \nr\nP")
+  (interactive (list (register-read-with-preview "Prepend to register: ")
+                    (region-beginning)
+                    (region-end)
+                    current-prefix-arg))
   (let ((reg (get-register register))
         (text (filter-buffer-substring start end))
        (separator (and register-separator (get-register register-separator))))
@@ -402,7 +478,11 @@
 
 Called from a program, takes four args: REGISTER, START, END and DELETE-FLAG.
 START and END are buffer positions giving two corners of rectangle."
-  (interactive "cCopy rectangle to register: \nr\nP")
+  (interactive (list (register-read-with-preview
+                     "Copy rectangle to register: ")
+                    (region-beginning)
+                    (region-end)
+                    current-prefix-arg))
   (let ((rectangle (if delete-flag
                       (delete-extract-rectangle start end)
                     (extract-rectangle start end))))
@@ -412,6 +492,5 @@
       (setq deactivate-mark t)
       (indicate-copied-region (length (car rectangle))))))
 
-
 (provide 'register)
 ;;; register.el ends here