branch: externals/consult
commit 6eaf346b73c2a6f2898d1085e14b510902436ffe
Author: Daniel Mendler <[email protected]>
Commit: Daniel Mendler <[email protected]>
Use when-let*
---
consult-compile.el | 12 +--
consult-flymake.el | 2 +-
consult-imenu.el | 10 +--
consult-info.el | 8 +-
consult-org.el | 2 +-
consult-register.el | 8 +-
consult-xref.el | 18 ++--
consult.el | 240 ++++++++++++++++++++++++++--------------------------
8 files changed, 150 insertions(+), 150 deletions(-)
diff --git a/consult-compile.el b/consult-compile.el
index ca2a39e104..007d3ff7d3 100644
--- a/consult-compile.el
+++ b/consult-compile.el
@@ -43,8 +43,8 @@ If GREP is non-nil, the buffer is a Grep buffer."
(let ((pos (point-min)) candidates)
(save-excursion
(while (setq pos (compilation-next-single-property-change pos
'compilation-message))
- (when-let ((msg (get-text-property pos 'compilation-message))
- ((compilation--message->loc msg)))
+ (when-let* ((msg (get-text-property pos 'compilation-message))
+ ((compilation--message->loc msg)))
(goto-char pos)
(let ((str (consult--buffer-substring pos (pos-eol))))
(add-text-properties
@@ -58,7 +58,7 @@ If GREP is non-nil, the buffer is a Grep buffer."
(defun consult-compile--lookup (marker)
"Lookup error position given error MARKER."
- (when-let (buffer (and marker (marker-buffer marker)))
+ (when-let* ((buffer (and marker (marker-buffer marker))))
(with-current-buffer buffer
(let ((next-error-highlight nil)
(compilation-current-error marker)
@@ -84,9 +84,9 @@ If GREP is non-nil, search Grep buffers."
(let ((jump (consult--jump-state)))
(lambda (action marker)
(let ((pos (consult-compile--lookup marker)))
- (when-let (buffer (and (eq action 'return)
- marker
- (marker-buffer marker)))
+ (when-let* ((buffer (and (eq action 'return)
+ marker
+ (marker-buffer marker))))
(with-current-buffer buffer
(setq compilation-current-error marker
overlay-arrow-position marker)))
diff --git a/consult-flymake.el b/consult-flymake.el
index 3ec9cf6e7b..c01c486bc2 100644
--- a/consult-flymake.el
+++ b/consult-flymake.el
@@ -98,7 +98,7 @@ buffers in the current project instead of just the current
buffer."
(consult--forbid-minibuffer)
(consult--read
(consult-flymake--candidates
- (if-let ((project (and project (project-current))))
+ (if-let* ((project (and project (project-current))))
(flymake--project-diagnostics project)
(flymake-diagnostics)))
:prompt "Flymake diagnostic: "
diff --git a/consult-imenu.el b/consult-imenu.el
index 9761a55673..d0b67bb669 100644
--- a/consult-imenu.el
+++ b/consult-imenu.el
@@ -89,7 +89,7 @@ TYPES is the mode-specific types configuration."
'consult-imenu-prefix 'append name)
(if prefix
(setq next-prefix (concat prefix "/" name))
- (when-let (type (cdr (assoc name types)))
+ (when-let* ((type (cdr (assoc name types))))
(put-text-property 0 (length name) 'consult--type (car type)
name)
(setq next-face (cadr type))))
(consult-imenu--flatten next-prefix next-face (cdr item) types))
@@ -114,7 +114,7 @@ TYPES is the mode-specific types configuration."
(funcall imenu-create-index-function)))))
(config (cdr (seq-find (lambda (x) (derived-mode-p (car x)))
consult-imenu-config))))
;; Fix toplevel items, e.g., emacs-lisp-mode toplevel items are functions
- (when-let (toplevel (plist-get config :toplevel))
+ (when-let* ((toplevel (plist-get config :toplevel)))
(let ((tops (seq-remove (lambda (x) (listp (cdr x))) items))
(rest (seq-filter (lambda (x) (listp (cdr x))) items)))
(setq items (nconc rest (and tops (list (cons toplevel tops)))))))
@@ -129,7 +129,7 @@ TYPES is the mode-specific types configuration."
;; Some imenu backends generate duplicate items (e.g. for overloaded methods
in java)
(let ((ht (make-hash-table :test #'equal :size (length items))))
(dolist (item items)
- (if-let (count (gethash (car item) ht))
+ (if-let* ((count (gethash (car item) ht)))
(setcar item (format "%s (%s)" (car item)
(puthash (car item) (1+ count) ht)))
(puthash (car item) 0 ht)))))
@@ -184,7 +184,7 @@ this function can jump across buffers."
(defun consult-imenu--group ()
"Create a imenu group function for the current buffer."
- (when-let (narrow (consult-imenu--narrow))
+ (when-let* ((narrow (consult-imenu--narrow)))
(lambda (cand transform)
(let ((type (get-text-property 0 'consult--type cand)))
(cond
@@ -206,7 +206,7 @@ this function can jump across buffers."
;; in order to avoid any bad side effects.
(funcall preview action (and (markerp (cdr cand)) (cdr cand)))))
:narrow
- (when-let (narrow (consult-imenu--narrow))
+ (when-let* ((narrow (consult-imenu--narrow)))
(list :predicate
(lambda (cand)
(eq (get-text-property 0 'consult--type (car cand))
consult--narrow))
diff --git a/consult-info.el b/consult-info.el
index 45e05f1824..096f6f9ccf 100644
--- a/consult-info.el
+++ b/consult-info.el
@@ -52,7 +52,7 @@ CALLBACK receives the candidates."
(while (and (not (eobp)) (re-search-forward re nil t))
(if (match-end 1)
(progn
- (if-let ((node (match-string 2)))
+ (if-let* ((node (match-string 2)))
(unless (equal node last-node)
(setq full-node (concat consult-info--manual node)
last-node node))
@@ -86,9 +86,9 @@ CALLBACK receives the candidates."
(defun consult-info--position (cand)
"Return position information for CAND."
- (when-let ((pos (and cand (get-text-property 0 'consult--info cand)))
- (matches (consult--point-placement cand 0))
- (dest (+ (cadr pos) (car matches))))
+ (when-let* ((pos (and cand (get-text-property 0 'consult--info cand)))
+ (matches (consult--point-placement cand 0))
+ (dest (+ (cadr pos) (car matches))))
`( ,(cdr matches) ,dest . ,pos)))
(defun consult-info--action (cand &optional buf)
diff --git a/consult-org.el b/consult-org.el
index db1dfd92f8..c1a6bb173d 100644
--- a/consult-org.el
+++ b/consult-org.el
@@ -69,7 +69,7 @@ MATCH, SCOPE and SKIP are as in `org-map-entries'."
org-outline-path-cache nil))
(pcase-let* ((`(_ ,level ,todo ,prio ,_hl ,tags)
(org-heading-components))
(tags (if org-use-tag-inheritance
- (when-let ((tags (org-get-tags)))
+ (when-let* ((tags (org-get-tags)))
(concat ":" (string-join tags ":") ":"))
tags))
(cand (org-format-outline-path
diff --git a/consult-register.el b/consult-register.el
index 538690c79b..0111227560 100644
--- a/consult-register.el
+++ b/consult-register.el
@@ -177,7 +177,7 @@ Raise an error if the list is empty and NOERROR is nil."
;; Sometimes, registers are made without a `cdr' or with
;; invalid markers. Such registers don't do anything, and
;; can be ignored.
- if (when-let ((val (cdr reg)))
+ if (when-let* ((val (cdr reg)))
(and (or (not (markerp val)) (marker-buffer val))
(or (not pred) (funcall pred val))))
collect reg)
@@ -210,7 +210,7 @@ built-in register access functions. The command supports
narrowing, see
(lambda (action cand)
;; Preview only markers
(funcall preview action
- (when-let (reg (get-register cand))
+ (when-let* ((reg (get-register cand)))
(and (markerp reg) reg)))))
:group (consult--type-group consult-register--narrow)
:narrow (consult--type-narrow consult-register--narrow)
@@ -250,7 +250,7 @@ This function is derived from `register-read-with-preview'."
(lambda ()
(unless (get-buffer-window buffer)
(register-preview buffer 'show-empty)
- (when-let (win (get-buffer-window buffer))
+ (when-let* ((win (get-buffer-window buffer)))
(with-selected-window win
(let ((inhibit-read-only t))
(goto-char (point-max))
@@ -323,7 +323,7 @@ kmacro."
(t
`("Store"
(?p "point" "Point to register: " ,#'point-to-register)
- ,@(when-let ((file (or buffer-file-name default-directory)))
+ ,@(when-let* ((file (or buffer-file-name default-directory)))
`((?f "file" "File to register: " ,(lambda (r) (set-register r
`(file . ,file))))))
(?b "buffer" "Buffer to register: " ,(lambda (r) (set-register r
`(buffer . ,(buffer-name)))))
(?t "frameset" "Frameset to register: " ,#'frameset-to-register)
diff --git a/consult-xref.el b/consult-xref.el
index 11ed23931f..f44113a16b 100644
--- a/consult-xref.el
+++ b/consult-xref.el
@@ -65,11 +65,11 @@ The fetch is stored globally such that it can be accessed by
(funcall open))
(let ((consult--buffer-display display))
(funcall preview action
- (when-let ((loc (and cand (eq action 'preview)
- (xref-item-location cand)))
- (type (type-of loc))
- ;; Only preview xrefs listed in
consult-xref--preview
- ((memq type consult-xref--preview)))
+ (when-let* ((loc (and cand (eq action 'preview)
+ (xref-item-location cand)))
+ (type (type-of loc))
+ ;; Only preview xrefs listed in
consult-xref--preview
+ ((memq type consult-xref--preview)))
(pcase type
((or 'xref-file-location 'xref-etags-location)
(consult--marker-from-line-column
@@ -108,10 +108,10 @@ FETCHER and ALIST arguments."
:group #'consult--prefix-group
:state
;; do not preview other frame
- (when-let (fun (pcase-exhaustive display
- ('frame nil)
- ('window #'switch-to-buffer-other-window)
- ('nil #'switch-to-buffer)))
+ (when-let* ((fun (pcase-exhaustive display
+ ('frame nil)
+ ('window #'switch-to-buffer-other-window)
+ ('nil #'switch-to-buffer))))
(consult-xref--preview fun))
:lookup (apply-partially #'consult--lookup-prop 'consult-xref))
(get-text-property 0 'consult-xref (car candidates)))
diff --git a/consult.el b/consult.el
index 44bf77e6c5..1d085a7550 100644
--- a/consult.el
+++ b/consult.el
@@ -683,7 +683,7 @@ Turn ARG into a list, and for each element either:
`(let* ((,head (cons nil ,list))
(,prev ,head))
(while (cdr ,prev)
- (if-let (,result (let ((it (cadr ,prev))) ,form))
+ (if-let* ((,result (let ((it (cadr ,prev))) ,form)))
(progn
(pop ,prev)
(setcar ,prev ,result))
@@ -878,7 +878,7 @@ asked for the directories or files to search via
"Return project root directory.
When no project is found and MAY-PROMPT is non-nil ask the user."
(declare-function project-root "project")
- (when-let (proj (project-current may-prompt))
+ (when-let* ((proj (project-current may-prompt)))
(project-root proj)))
(defun consult--project-root (&optional may-prompt)
@@ -887,8 +887,8 @@ When no project is found and MAY-PROMPT is non-nil ask the
user."
;; Preserve this-command across project selection,
;; such that `consult-customize' continues to work.
(let ((this-command this-command))
- (when-let (root (and consult-project-function
- (funcall consult-project-function may-prompt)))
+ (when-let* ((root (and consult-project-function
+ (funcall consult-project-function may-prompt))))
(expand-file-name root))))
(defun consult--project-known-roots ()
@@ -1227,7 +1227,7 @@ if IGNORE-CASE is non-nil."
See `consult--compile-regexp' for INPUT, TYPE and IGNORE-CASE."
(setq input (consult--split-escaped input))
(cons (mapcar (lambda (x) (consult--convert-regexp x type)) input)
- (when-let (regexps (seq-filter #'consult--valid-regexp-p input))
+ (when-let* ((regexps (seq-filter #'consult--valid-regexp-p input)))
(apply-partially #'consult--highlight-regexps regexps ignore-case))))
(defun consult--compile-regexp (input type ignore-case)
@@ -1308,14 +1308,14 @@ ESC is the escaping string for choice and groups."
(defun consult--lookup-location (selected candidates &rest _)
"Lookup SELECTED in CANDIDATES list of `consult-location' category.
Return the location marker."
- (when-let (found (member selected candidates))
+ (when-let* ((found (member selected candidates)))
(setq found (car (consult--get-location (car found))))
;; Check that marker is alive
(and (or (not (markerp found)) (marker-buffer found)) found)))
(defun consult--lookup-prop (prop selected candidates &rest _)
"Lookup SELECTED in CANDIDATES list and return PROP value."
- (when-let (found (member selected candidates))
+ (when-let* ((found (member selected candidates)))
(get-text-property 0 prop (car found))))
(defun consult--lookup-candidate (selected candidates &rest _)
@@ -1344,16 +1344,16 @@ exceeds `consult-preview-max-count'."
(defun consult--preview-allowed-p (fun)
"Return non-nil if FUN is an allowed preview mode hook."
(or (memq fun consult-preview-allowed-hooks)
- (when-let (((symbolp fun))
- (name (symbol-name fun))
- ;; Global modes in Emacs 29 are activated via a
- ;; `find-file-hook' ending with `-check-buffers'. This has
been
- ;; changed in Emacs 30. Now a `change-major-mode-hook' is used
- ;; instead with the suffix `-check-buffers'.
- (suffix (static-if (>= emacs-major-version 30)
- "-enable-in-buffer"
- "-check-buffers"))
- ((string-suffix-p suffix name)))
+ (when-let* (((symbolp fun))
+ (name (symbol-name fun))
+ ;; Global modes in Emacs 29 are activated via a
+ ;; `find-file-hook' ending with `-check-buffers'. This has
been
+ ;; changed in Emacs 30. Now a `change-major-mode-hook' is
used
+ ;; instead with the suffix `-check-buffers'.
+ (suffix (static-if (>= emacs-major-version 30)
+ "-enable-in-buffer"
+ "-check-buffers"))
+ ((string-suffix-p suffix name)))
(memq (intern (string-remove-suffix suffix name))
consult-preview-allowed-hooks))))
@@ -1378,8 +1378,8 @@ ORIG is the original function, HOOKS the arguments."
(defun consult--find-file-temporarily-1 (name)
"Open file NAME, helper function for `consult--find-file-temporarily'."
;; file-attributes may throw permission denied error
- (when-let ((attrs (ignore-errors (file-attributes name)))
- (size (file-attribute-size attrs)))
+ (when-let* ((attrs (ignore-errors (file-attributes name)))
+ (size (file-attribute-size attrs)))
(let* ((partial (>= size consult-preview-partial-size))
(buffer (if partial
(generate-new-buffer (format
"consult-partial-preview-%s" name))
@@ -1455,8 +1455,8 @@ ORIG is the original function, HOOKS the arguments."
(unless (consult--completion-window-p)
(let (live-files)
(pcase-dolist (`(,file . ,buf) temporary-buffers)
- (when-let (wins (and (buffer-live-p buf)
- (get-buffer-window-list buf)))
+ (when-let* ((wins (and (buffer-live-p buf)
+ (get-buffer-window-list buf))))
(push (cons file (mapcar
(lambda (win)
(cons win (window-state-get win t)))
@@ -1466,7 +1466,7 @@ ORIG is the original function, HOOKS the arguments."
(kill-buffer buf))
(setq temporary-buffers nil)
(pcase-dolist (`(,file . ,wins) live-files)
- (when-let (buf (consult--file-action file))
+ (when-let* ((buf (consult--file-action file)))
(push buf orig-buffers)
(pcase-dolist (`(,win . ,state) wins)
(setf (car (alist-get 'buffer state)) buf)
@@ -1493,9 +1493,9 @@ ORIG is the original function, HOOKS the arguments."
;; initialized (hooks are delayed) in order to ensure fast
preview.
(cdr (assoc name temporary-buffers))
;; If no existing buffer has been found, open the file for
preview.
- (when-let (((not (seq-find (lambda (x) (string-match-p x name))
- consult-preview-excluded-files)))
- (buf (consult--find-file-temporarily name)))
+ (when-let* (((not (seq-find (lambda (x) (string-match-p x name))
+ consult-preview-excluded-files)))
+ (buf (consult--find-file-temporarily name)))
;; Only add new buffer if not already in the list
(unless (or (rassq buf temporary-buffers) (memq buf
orig-buffers))
(add-hook 'window-selection-change-functions hook)
@@ -1527,8 +1527,8 @@ ORIG is the original function, HOOKS the arguments."
"Open overlays which hide the current line.
See `isearch-open-necessary-overlays' and `isearch-open-overlay-temporary'."
(dolist (ov (overlays-in (pos-bol) (pos-eol)))
- (when-let ((fun (overlay-get ov 'isearch-open-invisible))
- ((invisible-p (overlay-get ov 'invisible))))
+ (when-let* ((fun (overlay-get ov 'isearch-open-invisible))
+ ((invisible-p (overlay-get ov 'invisible))))
(funcall fun ov))))
(defun consult--invisible-open-temporarily ()
@@ -1538,7 +1538,7 @@ See `isearch-open-necessary-overlays' and
`isearch-open-overlay-temporary'."
(dolist (ov (overlays-in (pos-bol) (pos-eol)))
(let ((inv (overlay-get ov 'invisible)))
(when (and (invisible-p inv) (overlay-get ov 'isearch-open-invisible))
- (push (if-let (fun (overlay-get ov
'isearch-open-invisible-temporary))
+ (push (if-let* ((fun (overlay-get ov
'isearch-open-invisible-temporary)))
(progn
(funcall fun ov nil)
(lambda () (funcall fun ov t)))
@@ -1551,9 +1551,9 @@ See `isearch-open-necessary-overlays' and
`isearch-open-overlay-temporary'."
"Ensure that buffer of marker POS is displayed, return t if successful."
(or (not (markerp pos))
;; Switch to buffer if it is not visible
- (when-let ((buf (marker-buffer pos)))
+ (when-let* ((buf (marker-buffer pos)))
(or (and (eq (current-buffer) buf) (eq (window-buffer) buf))
- (if-let ((win (get-buffer-window buf)))
+ (if-let* ((win (get-buffer-window buf)))
(select-window win 'norecord)
(consult--buffer-action buf 'norecord))
t))))
@@ -1593,14 +1593,14 @@ The function can be used as the `:state' argument of
`consult--read'."
;; 1. Use consult--buffer-preview instead of
consult--jump-ensure-buffer
;; 2. Remove function consult--jump-ensure-buffer
;; 3. Remove consult-buffer-other-* from consult-customize-alist
- (when-let ((pos (or (car-safe cand) cand)) ;; Candidate can be
previewed
- ((consult--jump-ensure-buffer pos)))
+ (when-let* ((pos (or (car-safe cand) cand)) ;; Candidate can be
previewed
+ ((consult--jump-ensure-buffer pos)))
(let ((saved-min (point-min-marker))
(saved-max (point-max-marker))
(saved-pos (point-marker)))
(set-marker-insertion-type saved-max t) ;; Grow when text is
inserted
(push (lambda ()
- (when-let ((buf (marker-buffer saved-pos)))
+ (when-let* ((buf (marker-buffer saved-pos)))
(with-current-buffer buf
(narrow-to-region saved-min saved-max)
(goto-char saved-pos)
@@ -1765,7 +1765,7 @@ The result can be passed as :state argument to
`consult--read'." type)
(funcall state 'setup nil))
(setq consult--preview-function
(lambda ()
- (when-let ((cand (funcall candidate)))
+ (when-let* ((cand (funcall candidate)))
;; Drop properties to prevent bugs regarding candidate
;; lookup, which must handle candidates without
;; properties. Otherwise the arguments passed to the
@@ -1778,8 +1778,8 @@ The result can be passed as :state argument to
`consult--read'." type)
(narrow consult--narrow)
(win (consult--original-window)))
(with-selected-window win
- (when-let ((transformed (funcall transform
narrow input cand))
- (debounce
(consult--preview-key-debounce preview-key transformed)))
+ (when-let* ((transformed (funcall transform
narrow input cand))
+ (debounce
(consult--preview-key-debounce preview-key transformed)))
(cancel-timer timer)
;; The transformed candidate may have text
;; properties, which change the preview
display.
@@ -1826,10 +1826,10 @@ The result can be passed as :state argument to
`consult--read'." type)
(setq mb-input (minibuffer-contents-no-properties)
mb-narrow consult--narrow)))))
(unwind-protect
- (setq selected (when-let (result (funcall body))
- (when-let ((save-input)
- (list (symbol-value save-input))
- ((equal (car list) result)))
+ (setq selected (when-let* ((result (funcall body)))
+ (when-let* ((save-input)
+ (list (symbol-value save-input))
+ ((equal (car list) result)))
(set save-input (cdr list)))
(funcall transform mb-narrow mb-input result)))
(when save-input
@@ -1925,7 +1925,7 @@ This command is used internally by the narrowing system
of `consult--read'."
last-command-event)))
(consult--require-minibuffer)
(setq consult--narrow key)
- (when-let ((pred (plist-get consult--narrow-config :predicate)))
+ (when-let* ((pred (plist-get consult--narrow-config :predicate)))
(setq minibuffer-completion-predicate (and consult--narrow pred)))
(when consult--narrow-overlay
(delete-overlay consult--narrow-overlay))
@@ -1951,9 +1951,9 @@ This command is used internally by the narrowing system
of `consult--read'."
`( menu-item "" nil :filter
,(lambda (&optional _)
(let ((str (minibuffer-contents-no-properties)))
- (when-let ((keys (plist-get consult--narrow-config :keys))
- (pair (or (and (length= str 1) (assoc (aref str 0) keys))
- (and (equal str "") (assoc ?\s keys)))))
+ (when-let* ((keys (plist-get consult--narrow-config :keys))
+ (pair (or (and (length= str 1) (assoc (aref str 0) keys))
+ (and (equal str "") (assoc ?\s keys)))))
(lambda ()
(interactive)
(delete-minibuffer-contents)
@@ -1980,12 +1980,12 @@ to make it available for commands with narrowing."
"Setup narrowing with CONFIG and keymap MAP."
(setq consult--narrow-config (if (memq :keys config)
config (list :keys config)))
- (when-let ((key consult-narrow-key))
+ (when-let* ((key consult-narrow-key))
(setq key (consult--key-parse key))
(dolist (pair (plist-get consult--narrow-config :keys))
(define-key map (vconcat key (vector (car pair)))
(cons (cdr pair) #'consult-narrow))))
- (when-let ((widen (consult--widen-key)))
+ (when-let* ((widen (consult--widen-key)))
(define-key map widen (cons "All" #'consult-narrow))))
;;;; Splitting completion style
@@ -2161,7 +2161,7 @@ ASYNC is the asynchronous function or completion table."
(funcall async 'setup)
(let* ((mb (current-buffer))
(fun (lambda ()
- (when-let (win (active-minibuffer-window))
+ (when-let* ((win (active-minibuffer-window)))
(when (eq (window-buffer win) mb)
(with-current-buffer mb
(let ((inhibit-modification-hooks t))
@@ -2205,7 +2205,7 @@ ASYNC is the asynchronous function or completion table."
('refresh
;; Refresh the UI when the current minibuffer window belongs
;; to the current asynchronous completion session.
- (when-let (win (active-minibuffer-window))
+ (when-let* ((win (active-minibuffer-window)))
(when (eq (window-buffer win) buffer)
(with-selected-window win
(run-hooks 'consult--completion-refresh-hook)
@@ -2314,7 +2314,7 @@ IDX is the index of the corresponding link in TAIL."
(funcall sink `[indicator ,state])))
('flush
;; Flush items if sub-list exists.
- (when-let ((tl (aref tail idx)) (pre t))
+ (when-let* ((tl (aref tail idx)) (pre t))
(let ((i idx)) (while (not (setq pre (aref tail (cl-decf i))))))
(setcdr pre (cdr tl))
(aset tail idx nil)
@@ -2404,7 +2404,7 @@ configured by `consult-async-split-style'."
('setup
(consult--split-setup (let ((fun (plist-get style :function)))
(lambda (str) (funcall fun str style))))
- (when-let ((initial (plist-get style :initial)))
+ (when-let* ((initial (plist-get style :initial)))
(save-excursion
(goto-char (minibuffer-prompt-end))
(unless (equal initial (char-after))
@@ -2556,8 +2556,8 @@ which highlights words."
(consult--compile-regexp input 'emacs completion-ignore-case))))
(consult--async-transform-by-input
(lambda (input)
- (when-let ((hl (funcall highlight input))
- (hl (if (functionp hl) hl (cdr hl))))
+ (when-let* ((hl (funcall highlight input))
+ (hl (if (functionp hl) hl (cdr hl))))
(lambda (cands)
(dolist (x cands cands)
(funcall hl (if (consp x) (car x) x))))))))
@@ -2988,7 +2988,7 @@ COMMAND is used for customization, defaulting to
`this-command.'"
(defsubst consult--multi-visible-p (src)
"Is SRC visible according to `consult--narrow'?"
- (if-let ((n consult--narrow))
+ (if-let* ((n consult--narrow))
(pcase (plist-get src :narrow)
((and ks `((,_ . ,_) . ,_)) (assq n ks))
((or `(,k . ,_) k) (eq n k)))
@@ -3003,10 +3003,10 @@ COMMAND is used for customization, defaulting to
`this-command.'"
(thread-last
sources
(mapcan (lambda (src)
- (when-let (narrow (plist-get src :narrow))
+ (when-let* ((narrow (plist-get src :narrow)))
(if (consp narrow)
(if (consp (car narrow)) (append narrow nil) (list narrow))
- (when-let (name (plist-get src :name))
+ (when-let* ((name (plist-get src :name)))
(list (cons narrow name)))))))
(delq nil)
(delete-dups)))
@@ -3016,7 +3016,7 @@ COMMAND is used for customization, defaulting to
`this-command.'"
(consult--annotate-align
cand
(let ((src (consult--multi-source sources cand)))
- (if-let ((fun (plist-get src :annotate)))
+ (if-let* ((fun (plist-get src :annotate)))
(funcall fun (cdr (get-text-property 0 'multi-category cand)))
(plist-get src :name)))))
@@ -3061,7 +3061,7 @@ COMMAND is used for customization, defaulting to
`this-command.'"
(if def
(cons (cdr (get-text-property 0 'multi-category def)) src)
`(,selected :match nil ,@src)))
- (if-let (found (member selected candidates))
+ (if-let* ((found (member selected candidates)))
;; Existing candidate submitted
(cons (cdr (get-text-property 0 'multi-category (car found)))
(consult--multi-source sources selected))
@@ -3096,7 +3096,7 @@ Attach source IDX and SRC properties to each item."
(let ((idx idx) (src src))
(consult--async-pipeline
(consult--async-predicate (apply-partially #'consult--multi-visible-p
src))
- (if-let ((async (plist-get src :async)))
+ (if-let* ((async (plist-get src :async)))
(consult--async-pipeline
async
(consult--async-transform
@@ -3116,10 +3116,10 @@ Attach source IDX and SRC properties to each item."
(defun consult--multi-state (sources)
"State function given SOURCES."
- (when-let (states (delq nil (mapcar (lambda (src)
- (when-let (fun (plist-get src :state))
- (cons src (funcall fun))))
- sources)))
+ (when-let* ((states (delq nil (mapcar (lambda (src)
+ (when-let* ((fun (plist-get src
:state)))
+ (cons src (funcall fun))))
+ sources))))
(let (last-fun)
(pcase-lambda (action `(,cand . ,src))
(pcase action
@@ -3219,13 +3219,13 @@ Optional source fields:
:preview-key (consult--multi-preview-key sources)
:narrow (consult--multi-narrow sources)
:state (consult--multi-state sources))))))
- (when-let (history (plist-get (cdr selected) :history))
+ (when-let* ((history (plist-get (cdr selected) :history)))
(add-to-history history (car selected)))
(if (plist-member (cdr selected) :match)
- (when-let (fun (plist-get (cdr selected) :new))
+ (when-let* ((fun (plist-get (cdr selected) :new)))
(funcall fun (car selected))
(plist-put (cdr selected) :match 'new))
- (when-let (fun (plist-get (cdr selected) :action))
+ (when-let* ((fun (plist-get (cdr selected) :action)))
(funcall fun (car selected)))
(setq selected `(,(car selected) :match t ,@(cdr selected))))
selected))
@@ -3323,7 +3323,7 @@ expected return value are as specified for
`completion-in-region'."
(length initial))
metadata)))
;; Normalize improper list
- (when-let ((last (last all)))
+ (when-let* ((last (last all)))
(setcdr last nil))
(if (or (eq threshold t) (length< all (1+ (or threshold 1)))
(and completion-cycling completion-all-sorted-completions))
@@ -3408,7 +3408,7 @@ a value for `completion-in-region-function'."
(save-excursion
(goto-char (point-min))
(while (save-excursion
- (if-let (fun (bound-and-true-p outline-search-function))
+ (if-let* ((fun (bound-and-true-p outline-search-function)))
(funcall fun)
(re-search-forward heading-regexp nil t)))
(cl-incf line (consult--count-lines (match-beginning 0)))
@@ -3469,9 +3469,9 @@ argument. The symbol at point is added to the future
history."
(fmt (format #("%%%dd %%s%%s" 0 6 (face consult-line-number-prefix))
width)))
(save-excursion
(dolist (marker markers)
- (when-let ((pos (marker-position marker))
- ((and (eq (marker-buffer marker) (current-buffer))
- (consult--in-range-p pos))))
+ (when-let* ((pos (marker-position marker))
+ ((and (eq (marker-buffer marker) (current-buffer))
+ (consult--in-range-p pos))))
(goto-char pos)
;; `line-number-at-pos' is a very slow function, which should be
;; replaced everywhere. However in this case the slow
@@ -3513,9 +3513,9 @@ The symbol at point is added to the future history."
(let ((candidates))
(save-excursion
(dolist (marker markers)
- (when-let ((pos (marker-position marker))
- (buf (marker-buffer marker))
- ((not (minibufferp buf))))
+ (when-let* ((pos (marker-position marker))
+ (buf (marker-buffer marker))
+ ((not (minibufferp buf))))
(with-current-buffer buf
(when (consult--in-range-p pos)
(goto-char pos)
@@ -3586,7 +3586,7 @@ SELECTED is the currently selected candidate.
CANDIDATES is the list of candidates.
HIGHLIGHTED is the highlighted string to determine the match position.
IGNORED-FACES are ignored when determining the match position."
- (when-let (pos (consult--lookup-location selected candidates))
+ (when-let* ((pos (consult--lookup-location selected candidates)))
(if highlighted
(let* ((matches (apply #'consult--point-placement highlighted 0
ignored-faces))
(dest (+ pos (car matches))))
@@ -3931,9 +3931,9 @@ INITIAL is the initial input."
;; Successfully terminated -> Remember invisible overlays
(cl-callf nconc consult--focus-lines-overlays overlays)
;; move point past invisible
- (goto-char (if-let (ov (and (invisible-p pt-orig)
- (seq-find (lambda (ov) (overlay-get ov
'invisible))
- (overlays-at pt-orig))))
+ (goto-char (if-let* ((ov (and (invisible-p pt-orig)
+ (seq-find (lambda (ov) (overlay-get ov
'invisible))
+ (overlays-at pt-orig)))))
(overlay-end ov)
pt-orig))))))))
@@ -4016,16 +4016,16 @@ command respects narrowing and the settings
(consult--forbid-minibuffer)
(consult--local-let ((display-line-numbers consult-goto-line-numbers)
(display-line-numbers-widen
consult-line-numbers-widen))
- (while (if-let (pos (consult--goto-line-position
- (consult--prompt
- :prompt "Go to line: "
- :history 'goto-line-history
- :state
- (let ((preview (consult--jump-preview)))
- (lambda (action str)
- (funcall preview action
- (consult--goto-line-position str
#'ignore)))))
- #'consult--minibuffer-message))
+ (while (if-let* ((pos (consult--goto-line-position
+ (consult--prompt
+ :prompt "Go to line: "
+ :history 'goto-line-history
+ :state
+ (let ((preview (consult--jump-preview)))
+ (lambda (action str)
+ (funcall preview action
+ (consult--goto-line-position str
#'ignore)))))
+ #'consult--minibuffer-message)))
(consult--jump pos)
t)))))
@@ -4112,7 +4112,7 @@ From these files, the commands are extracted."
(minor-global-name-regexp (regexp-opt (mapcar #'consult--mode-name
minor-global-modes)))
(commands))
(dolist (feature load-history commands)
- (when-let (name (alist-get 'provide feature))
+ (when-let* ((name (alist-get 'provide feature)))
(let* ((path (car feature))
(file (file-name-nondirectory path))
(key (cond
@@ -4221,7 +4221,7 @@ Consult version supports preview of the selected string."
(insert-for-yank string)
(setq this-command 'yank)
(when yank-from-kill-ring-rotate
- (if-let (pos (seq-position kill-ring string))
+ (if-let* ((pos (seq-position kill-ring string)))
(setq kill-ring-yank-pointer (nthcdr pos kill-ring))
(kill-new string)))
(when (consp arg)
@@ -4284,12 +4284,12 @@ Otherwise replace the just-yanked string with the
selected string."
(funcall
preview action
;; Only preview bookmarks with the default handler.
- (when-let ((bm (and cand (eq action 'preview) (assoc cand
bookmark-alist)))
- (handler (or (bookmark-get-handler bm)
#'bookmark-default-handler))
- ((eq handler #'bookmark-default-handler))
- (file (bookmark-get-filename bm))
- (pos (bookmark-get-position bm))
- (buf (funcall open file)))
+ (when-let* ((bm (and cand (eq action 'preview) (assoc cand
bookmark-alist)))
+ (handler (or (bookmark-get-handler bm)
#'bookmark-default-handler))
+ ((eq handler #'bookmark-default-handler))
+ (file (bookmark-get-filename bm))
+ (pos (bookmark-get-position bm))
+ (buf (funcall open file)))
(set-marker (make-marker) pos buf))))))
(defun consult--bookmark-action (bm)
@@ -4525,7 +4525,7 @@ starts a new Isearch session otherwise."
(alist-get (consult--tofu-get cand)
consult--isearch-history-narrow)))
:lookup
(lambda (selected candidates &rest _)
- (if-let (found (member selected candidates))
+ (if-let* ((found (member selected candidates)))
(substring (car found) 0 -1)
selected))
:state
@@ -4758,7 +4758,7 @@ AS is a conversion function."
(or (not include)
(not (not (string-match-p include-re (buffer-name
it)))))))))
(or (not root)
- (when-let (dir (buffer-local-value 'default-directory it))
+ (when-let* ((dir (buffer-local-value 'default-directory it)))
(string-prefix-p root
(if (and (/= 0 (length dir)) (eq (aref dir
0) ?/))
dir
@@ -4857,7 +4857,7 @@ If NORECORD is non-nil, do not record the buffer switch
in the buffer list."
:enabled ,(lambda () consult-project-function)
:items
,(lambda ()
- (when-let (root (consult--project-root))
+ (when-let* ((root (consult--project-root)))
(consult--buffer-query :sort 'visibility
:directory root
:as #'consult--buffer-pair))))
@@ -4880,7 +4880,7 @@ If NORECORD is non-nil, do not record the buffer switch
in the buffer list."
recentf-mode))
:items
,(lambda ()
- (when-let (root (consult--project-root))
+ (when-let* ((root (consult--project-root)))
(let ((len (length root))
(ht (consult--buffer-file-hash))
items)
@@ -5172,9 +5172,9 @@ FIND-FILE is the file open function, defaulting to
`find-file-noselect'."
(matches (consult--point-placement cand (1+ line-end)
'consult-grep-context))
(file (substring-no-properties cand 0 file-end))
(line (string-to-number (substring-no-properties cand (+ 1
file-end) line-end))))
- (when-let (pos (consult--marker-from-line-column
- (funcall (or find-file #'consult--file-action) file)
- line (or (car matches) 0)))
+ (when-let* ((pos (consult--marker-from-line-column
+ (funcall (or find-file #'consult--file-action) file)
+ line (or (car matches) 0))))
(cons pos (cdr matches))))))
(defun consult--grep-state ()
@@ -5536,7 +5536,7 @@ details regarding the asynchronous search."
(and cand
(eq action 'preview)
(or (cdr (assoc cand buffers))
- (when-let ((buf (consult--man-action cand t)))
+ (when-let* ((buf (consult--man-action cand t)))
(unless (memq buf orig)
(cl-callf consult--preview-add-buffer
buffers (cons cand buf)))
@@ -5594,9 +5594,9 @@ the asynchronous search."
(defun consult--default-completion-list-preview ()
"Preview candidate at point in *Completions* buffer."
- (when-let ((win (active-minibuffer-window))
- (buf (window-buffer win))
- (fun (buffer-local-value 'consult--preview-function buf)))
+ (when-let* ((win (active-minibuffer-window))
+ (buf (window-buffer win))
+ (fun (buffer-local-value 'consult--preview-function buf)))
(funcall fun)))
(defun consult--default-completion-list-preview-setup ()
@@ -5614,26 +5614,26 @@ the asynchronous search."
minibuffer-completion-predicate)
content
;; Return the full first candidate of the sorted completion list.
- (when-let ((completions (completion-all-sorted-completions)))
+ (when-let* ((completions (completion-all-sorted-completions)))
(concat
(substring content 0 (or (cdr (last completions)) 0))
(car completions)))))))
(defun consult--default-completion-list-candidate ()
"Return current candidate at point from completions buffer."
- (when-let ((buffer
- (if (derived-mode-p #'completion-list-mode)
- ;; Use current buffer if already inside *Completions* buffer
- (current-buffer)
- ;; Otherwise check if there is an active *Completions* buffer
- ;; which can be controlled remotely from the minibuffer. See
- ;; the setting `minibuffer-visible-completions'.
- (when-let ((bound-and-true-p minibuffer-visible-completions)
- (window (get-buffer-window "*Completions*"
'visible))
- (buffer (window-buffer window))
- ((eq (buffer-local-value
'completion-reference-buffer buffer)
- (window-buffer (active-minibuffer-window)))))
- buffer))))
+ (when-let* ((buffer
+ (if (derived-mode-p #'completion-list-mode)
+ ;; Use current buffer if already inside *Completions* buffer
+ (current-buffer)
+ ;; Otherwise check if there is an active *Completions* buffer
+ ;; which can be controlled remotely from the minibuffer. See
+ ;; the setting `minibuffer-visible-completions'.
+ (when-let* ((bound-and-true-p minibuffer-visible-completions)
+ (window (get-buffer-window "*Completions*"
'visible))
+ (buffer (window-buffer window))
+ ((eq (buffer-local-value
'completion-reference-buffer buffer)
+ (window-buffer (active-minibuffer-window)))))
+ buffer))))
(with-current-buffer buffer
;; TODO Use `completion-list-candidate-at-point' on Emacs 31
(let (beg)
