+(defun register-describe-oneline (c)
+ "One-line description of register 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)))
+
+(defun register-preview-default (r)
+ "Default function for the variable `register-preview-function'."
+ (format "%s %s\n"
+ (concat (single-key-description (car r)) ":")
+ (register-describe-oneline (car r))))
+
+(defvar register-preview-function #'register-preview-default
+ "Function to format a register for previewing.
+Takes one argument, a cons (NAME . CONTENTS) as found in `register-alist'.
+Returns a string.")
+
+(defun register-preview (buffer &optional show-empty)
+ "Pop up a window to show register 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-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)
+ (insert (mapconcat register-preview-function register-alist ""))))))
+
+(defun register-read-with-preview (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-event (propertize prompt 'face 'minibuffer-prompt))
+ help-chars)
+ (unless (get-buffer-window buffer)
+ (register-preview buffer 'show-empty)))
+ (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)))))
+