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)

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)
  "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))
         (data (register-command-info this-command))
         (enable-recursive-minibuffers t)
         types msg result act win strs smatch noconfirm)
    (if data
        (setq types     (register-preview-info-types data)
              msg       (register-preview-info-msg   data)
              act       (register-preview-info-act   data)
              smatch    (register-preview-info-smatch data)
              noconfirm (register-preview-info-noconfirm data))
      (setq types '(all)
            msg   "Overwrite register `%s'"
            act   'set))
    (setq strs (mapcar (lambda (x)
                         (string (car x)))
                       (register-of-type-alist types)))
    (when (and (memq act '(insert jump view)) (null strs))
      (error "No register suitable for `%s'" act))
    (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-1 buffer 'show-empty types))))))
    (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-1 buf nil types))
    (unwind-protect
        (let ((setup
               (lambda ()
                 (with-selected-window (minibuffer-window)
                   (let ((input (minibuffer-contents)))
                     (when (> (length input) 1)
                       (let ((new (substring input 1))
                             (old (substring input 0 1)))
                         (setq input (if (or (null smatch)
                                             (member new strs))
                                         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 smatch (not (string= input ""))
                                (not (member input strs)))
                       (setq input "")
                       (delete-minibuffer-contents)
                       (minibuffer-message "Not matching"))
                     (when (not (string= input pat))
                       (setq pat input))))
                 (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-1'.
                                 (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 (re-search-forward (concat "^" pat) nil t)
                               (progn (move-overlay
                                       ov
                                       (match-beginning 0) (pos-eol))
                                      (overlay-put ov 'face 'match)
                                      (when msg
                                        (with-selected-window
                                            (minibuffer-window)
                                          (minibuffer-message msg pat))))
                             (with-selected-window (minibuffer-window)
                               (minibuffer-message
                                "Register `%s' is empty" pat))))))
                   (unless (string= pat "")
                     (with-selected-window (minibuffer-window)
                       (if (and (member pat strs)
                                (null noconfirm))
                           (with-selected-window (minibuffer-window)
                             (minibuffer-message msg 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 act))))
          (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)))))