[elpa] externals/consult 4b55866a90 2/3: consult-info: Reduce allocations

[ELPA Syncer]

branch: externals/consult
commit 4b55866a901fd454590b342d394fe6f239d93b4e
Author: Daniel Mendler <mail@daniel-mendler.de>
Commit: Daniel Mendler <mail@daniel-mendler.de>

    consult-info: Reduce allocations
---
 consult-info.el | 59 +++++++++++++++++++++++++++++----------------------------
 consult.el      |  9 +++------
 2 files changed, 33 insertions(+), 35 deletions(-)

diff --git a/consult-info.el b/consult-info.el
index b602bd15c5..847c47e059 100644
--- a/consult-info.el
+++ b/consult-info.el
@@ -69,40 +69,33 @@
                      ;; Node name
                      (re-search-forward "Node:[ \t]*" nil t)
                      (setq node
-                           (format "(%s)%s" manual
-                                   (buffer-substring-no-properties
-                                    (point)
-                                    (progn
-                                      (skip-chars-forward "^,\t\n")
-                                      (point)))))))
-              (setq cand (concat node ":"
-                                 (funcall hl (buffer-substring-no-properties 
bol eol))))
-              (add-text-properties 0 (length node)
-                                   (list 'consult--info-position (cons buffer 
bol)
-                                         'face 'consult-file
-                                         'consult--prefix-group node)
-                                   cand)
+                           (buffer-substring-no-properties
+                            (point)
+                            (progn
+                              (skip-chars-forward "^,\t\n")
+                              (point))))))
+              (setq cand (funcall hl (buffer-substring-no-properties bol eol)))
+              (put-text-property 0 (length cand) 'consult--info
+                                 (list (format "(%s)%s" manual node) bol 
buffer) cand)
               (push cand candidates))))))
     (nreverse candidates)))
 
 (defun consult-info--position (cand)
   "Return position information for CAND."
-  (when-let ((pos (and cand (get-text-property 0 'consult--info-position 
cand)))
-             (node (get-text-property 0 'consult--prefix-group cand))
-             (matches (consult--point-placement cand (1+ (length node))))
-             (dest (+ (cdr pos) (car matches))))
-    (list node dest (cons
-                     (set-marker (make-marker) dest (car pos))
-                     (cdr 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)
   "Jump to info CAND."
-  (when-let ((pos (consult-info--position cand)))
-    (info (car pos))
-    (widen)
-    (goto-char (cadr pos))
-    (Info-select-node)
-    (run-hooks 'consult-after-jump-hook)))
+  (pcase (consult-info--position cand)
+    (`( ,_matches ,pos ,node ,_bol ,_buffer)
+     (info node)
+     (widen)
+     (goto-char pos)
+     (Info-select-node)
+     (run-hooks 'consult-after-jump-hook))))
 
 (defun consult-info--state ()
   "Info manual preview state."
@@ -110,13 +103,21 @@
     (lambda (action cand)
       (pcase action
         ('preview
-         (setq cand (caddr (consult-info--position cand)))
-         (funcall preview 'preview cand)
+         (setq cand (consult-info--position cand))
+         (funcall preview 'preview
+                  (pcase cand
+                    (`(,matches ,pos ,_node ,_bol ,buffer)
+                     (cons (set-marker (make-marker) pos buffer) matches))))
          (let (Info-history Info-history-list Info-history-forward)
            (when cand (ignore-errors (Info-select-node)))))
         ('return
          (consult-info--action cand))))))
 
+(defun consult-info--group (cand transform)
+  "Return title for CAND or TRANSFORM the candidate."
+  (if transform cand
+    (car (get-text-property 0 'consult--info cand))))
+
 ;;;###autoload
 (defun consult-info (&rest manuals)
   "Full text search through info MANUALS."
@@ -145,7 +146,7 @@
            :sort nil
            :category 'consult-info
            :history '(:input consult-info--history)
-           :group #'consult--prefix-group
+           :group #'consult-info--group
            :initial (consult--async-split-initial "")
            :lookup #'consult--lookup-member))
       (dolist (buf buffers)
diff --git a/consult.el b/consult.el
index 4d6e74064a..a70569ee64 100644
--- a/consult.el
+++ b/consult.el
@@ -1013,8 +1013,7 @@ The candidate must have a `consult--prefix-group' 
property."
 (defun consult--type-group (types)
   "Return group function for TYPES."
   (lambda (cand transform)
-    (if transform
-        cand
+    (if transform cand
       (alist-get (get-text-property 0 'consult--type cand) types))))
 
 (defun consult--type-narrow (types)
@@ -2502,8 +2501,7 @@ INHERIT-INPUT-METHOD, if non-nil the minibuffer inherits 
the input method."
 
 (defun consult--multi-group (sources cand transform)
   "Return title of candidate CAND or TRANSFORM the candidate given SOURCES."
-  (if transform
-      cand
+  (if transform cand
     (plist-get (consult--multi-source sources cand) :name)))
 
 (defun consult--multi-preview-key (sources)
@@ -3138,8 +3136,7 @@ CANDIDATES is the list of candidates."
 (defun consult--line-multi-group (cand transform)
   "Group function used by `consult-line-multi'.
 If TRANSFORM non-nil, return transformed CAND, otherwise return title."
-  (if transform
-      cand
+  (if transform cand
     (let ((marker (car (get-text-property 0 'consult-location cand))))
       (buffer-name
        ;; Handle cheap marker