Function: register-read-with-preview-fancy

register-read-with-preview-fancy is a byte-compiled function defined in register.el.gz.

Signature

(register-read-with-preview-fancy PROMPT &optional PRED)

Documentation

Read register name, prompting with PROMPT; possibly show existing registers.

This reads and returns the name of a register. PROMPT should be a string to prompt the user for the name. If help-char (or a member of help-event-list) is pressed, display preview window regardless.

This function is used as the value of register--read-with-preview-function when register-use-preview is set to any value other than traditional or never.

Source Code

;; Defined in /usr/src/emacs/lisp/register.el.gz
(defun register-read-with-preview-fancy (prompt &optional pred)
  "Read register name, prompting with PROMPT; possibly show existing registers.
This reads and returns the name of a register.  PROMPT should be a string
to prompt the user for the name.
If `help-char' (or a member of `help-event-list') is pressed,
display preview window regardless.

This function is used as the value of `register--read-with-preview-function'
when `register-use-preview' is set to any value other than `traditional'
or `never'."
  (let* ((buffer "*Register Preview*")
         (buffer1 "*Register quick preview*")
         (buf (if register-use-preview buffer buffer1))
         (pat "")
         (map (let ((m (make-sparse-keymap)))
                (set-keymap-parent m minibuffer-local-map)
                m))
         (enable-recursive-minibuffers t)
         result win
         (msg (if (string-match ":? *\\'" prompt)
                  (concat (substring prompt 0 (match-beginning 0))
                          " `%s'")
                "Using register `%s'"))
         (noconfirm (memq register-use-preview '(nil never)))
         (strs (mapcar (lambda (x)
                         (string (car x)))
                       (register-of-type-alist pred))))
    (when (and pred (not (funcall pred nil)) (null strs))
      (error "No suitable register"))
    (dolist (k (cons help-char help-event-list))
      (define-key map (vector k)
                  (lambda ()
                    (interactive)
                    ;; Do nothing when buffer1 is in use.
                    (unless (get-buffer-window buf)
                      (with-selected-window (minibuffer-selected-window)
                        (register-preview buffer 'show-empty pred))))))
    (define-key map (kbd "<down>") #'register-preview-next)
    (define-key map (kbd "<up>")   #'register-preview-previous)
    (define-key map (kbd "C-n")    #'register-preview-next)
    (define-key map (kbd "C-p")    #'register-preview-previous)
    (unless (or executing-kbd-macro (eq register-use-preview 'never))
      (register-preview buf nil pred))
    (unwind-protect
        (let ((setup ;; FIXME: Weird name for a `post-command-hook' function.
               (lambda ()
                 (with-selected-window (minibuffer-window)
                   (let ((input (minibuffer-contents)))
                     (when (> (length input) 1)
                       ;; Only keep the first of the new chars.
                       (let* ((new (substring input 1 2))
                              (old (substring input 0 1))
                              (newreg (aref new 0))
                              (regval (cdr (assq newreg register-alist))))
                         (setq input (if (or (null pred) (funcall pred regval))
                                         new old))
                         (delete-minibuffer-contents)
                         (insert input)
                         ;; Exit minibuffer on second hit
                         ;; when *-use-preview == insist.
                         (when (and (string= new old)
                                    (eq register-use-preview 'insist))
                           (setq noconfirm t))))
                     (when (and pred (not (string= input ""))
                                (let* ((reg (aref input 0))
                                       (regval (cdr (assq reg register-alist))))
                                  (not (funcall pred regval))))
                       (setq input "")
                       (delete-minibuffer-contents)
                       (minibuffer-message "Not matching"))
                     (when (not (string= input pat)) ;; FIXME: Why this test?
                       (setq pat input))))
                 (unless (or (string= pat "")
                          (get-text-property (minibuffer-prompt-end)
                           'display))
                   (put-text-property (minibuffer-prompt-end)
                                      (1+ (minibuffer-prompt-end))
                                      'display (key-description pat)))
                 (if (setq win (get-buffer-window buffer))
                     (with-selected-window win
                       (when (or (eq noconfirm t) ; Using insist
                                 ;; Don't exit when noconfirm == (never)
                                 ;; If we are here user has pressed C-h
                                 ;; calling `register-preview'.
                                 (memq nil noconfirm))
                         ;; Happen only when
                         ;; *-use-preview == insist.
                         (exit-minibuffer))
                       (let ((ov (make-overlay
                                  (point-min) (point-min)))
                             ;; Allow upper-case and lower-case letters
                             ;; to refer to different registers.
                             (case-fold-search nil))
                         (goto-char (point-min))
                         (remove-overlays)
                         (unless (string= pat "")
                           (if (register--find-preview (aref pat 0))
                               (progn (move-overlay ov (point) (pos-eol))
                                      (overlay-put ov 'face 'match)
                                      (when msg
                                        (with-selected-window
                                            (minibuffer-window)
                                          (minibuffer-message
                                           msg (key-description pat)))))
                             (with-selected-window (minibuffer-window)
                               (minibuffer-message
                                "Register `%s' is empty"
                                (key-description pat)))))))
                   (unless (string= pat "")
                     (with-selected-window (minibuffer-window)
                       (if (and (member pat strs)
                                (null noconfirm))
                           (with-selected-window (minibuffer-window)
                             (minibuffer-message
                              msg (key-description pat)))
                         ;; `noconfirm' is specified explicitly, don't ask for
                         ;; confirmation and exit immediately (bug#66394).
                         (setq result pat)
                         (exit-minibuffer))))))))
          (minibuffer-with-setup-hook
              (lambda () (add-hook 'post-command-hook setup nil 'local))
            (setq result (read-from-minibuffer
                          prompt nil map nil nil
                          (register--preview-get-defaults pred strs))))
          (cl-assert (and result (not (string= result "")))
                     nil "No register specified")
          (string-to-char result))
      (let ((w (get-buffer-window buf)))
        (and (window-live-p w) (delete-window w)))
      (and (get-buffer buf) (kill-buffer buf)))))