+(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)))
+
+(defvar register-preview-functions nil)
+
+(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."
+ (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)
+ (mapc
+ (lambda (r)
+ (insert (or (run-hook-with-args-until-success
+ 'register-preview-functions r)
+ (format "%s %s\n"
+ (concat (single-key-description (car r)) ":")
+ (register-describe-oneline (car r))))))
+ register-alist)))))
+
+(defun register-read-with-preview (prompt)
+ "Read an event with register preview using PROMPT.
+Pop up a register preview window if the input is a help char but
+is not a register. Alternatively if `register-preview-delay' is a
+number the preview window is popped up after some delay."
+ (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)))
+ 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)))))
+