[elpa] externals/consult 4be224fb1c: consult-info and consult-line-multi: Disambiguate candidates properly

[ELPA Syncer]

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

    consult-info and consult-line-multi: Disambiguate candidates properly
---
 consult-info.el | 86 +++++++++++++++++++++++++++++----------------------------
 consult.el      | 76 +++++++++++++++++++++++++++-----------------------
 2 files changed, 85 insertions(+), 77 deletions(-)

diff --git a/consult-info.el b/consult-info.el
index 004e18eda4..f89e524057 100644
--- a/consult-info.el
+++ b/consult-info.el
@@ -34,50 +34,52 @@
   "Dynamically find lines in MANUALS matching INPUT."
   (pcase-let ((`(,regexps . ,hl)
                (funcall consult--regexp-compiler input 'emacs t))
-              (candidates nil))
-    (pcase-dolist (`(,manual . ,buffer) manuals)
-      (with-current-buffer buffer
+              (candidates nil)
+              (buf-idx 0))
+    (pcase-dolist (`(,manual . ,buf) manuals)
+      (with-current-buffer buf
         (widen)
         (goto-char (point-min))
         ;; TODO subfile support?!
         (while (and (not (eobp)) (re-search-forward (car regexps) nil t))
           (let ((bol (pos-bol))
-                (eol (pos-eol))
-                node cand)
-            (when (save-excursion
-                    (goto-char bol)
-                    (and
-                     (not (looking-at "^\\s-*$"))
-                     ;; Information separator character
-                     (>= (- (point) 2) (point-min))
-                     (not (eq (char-after (- (point) 2)) ?\^_))
-                     ;; Only printable characters on the line, [:cntrl:] does
-                     ;; not work?!
-                     (not (re-search-forward "[^[:print:]]" eol t))
-                     ;; Matches all regexps
-                     (seq-every-p (lambda (r)
-                                    (goto-char bol)
-                                    (re-search-forward r eol t))
-                                  (cdr regexps))
-                     ;; Find node beginning
-                     (goto-char bol)
-                     (if (search-backward "\n\^_" nil 'move)
-                         (forward-line 2)
-                       (when (looking-at "\^_")
-                         (forward-line 1)))
-                     ;; Node name
-                     (re-search-forward "Node:[ \t]*" nil t)
-                     (setq node
-                           (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 1 'consult--info
-                                 (list (format "(%s)%s" manual node) bol 
buffer) cand)
-              (push cand candidates))
-            (goto-char (1+ eol))))))
+                (eol (pos-eol)))
+            (goto-char bol)
+            (when (and
+                   (not (looking-at "^\\s-*$"))
+                   ;; Information separator character
+                   (>= (- (point) 2) (point-min))
+                   (not (eq (char-after (- (point) 2)) ?\^_))
+                   ;; Only printable characters on the line, [:cntrl:] does
+                   ;; not work?!
+                   (not (re-search-forward "[^[:print:]]" eol t))
+                   ;; Matches all regexps
+                   (seq-every-p (lambda (r)
+                                  (goto-char bol)
+                                  (re-search-forward r eol t))
+                                (cdr regexps))
+                   ;; Find node beginning
+                   (goto-char bol)
+                   (if (search-backward "\n\^_" nil 'move)
+                       (forward-line 2)
+                     (when (looking-at "\^_")
+                       (forward-line 1)))
+                   ;; Node name
+                   (re-search-forward "Node:[ \t]*" nil t))
+              (let ((node (buffer-substring-no-properties
+                           (point)
+                           (progn
+                             (skip-chars-forward "^,\t\n")
+                             (point))))
+                    (cand (concat
+                           (funcall hl (buffer-substring-no-properties bol 
eol))
+                           ;; Buffer index and bol for disambiguation
+                           (consult--tofu-encode (logior (ash bol 8) 
buf-idx)))))
+                (put-text-property 0 1 'consult--info
+                                   (list (format "(%s)%s" manual node) bol 
buf) cand)
+                (push cand candidates)))
+            (goto-char (1+ eol)))))
+      (cl-incf buf-idx))
     (nreverse candidates)))
 
 (defun consult-info--position (cand)
@@ -90,7 +92,7 @@
 (defun consult-info--action (cand)
   "Jump to info CAND."
   (pcase (consult-info--position cand)
-    (`( ,_matches ,pos ,node ,_bol ,_buffer)
+    (`( ,_matches ,pos ,node ,_bol ,_buf)
      (info node)
      (widen)
      (goto-char pos)
@@ -106,8 +108,8 @@
          (setq cand (consult-info--position cand))
          (funcall preview 'preview
                   (pcase cand
-                    (`(,matches ,pos ,_node ,_bol ,buffer)
-                     (cons (set-marker (make-marker) pos buffer) matches))))
+                    (`(,matches ,pos ,_node ,_bol ,buf)
+                     (cons (set-marker (make-marker) pos buf) matches))))
          (let (Info-history Info-history-list Info-history-forward)
            (when cand (ignore-errors (Info-select-node)))))
         ('return
diff --git a/consult.el b/consult.el
index 9397c125f2..4cac150b7d 100644
--- a/consult.el
+++ b/consult.el
@@ -1155,12 +1155,11 @@ CURR-LINE is the current line number."
       (let ((line (cdr (get-text-property 0 'consult-location cand))))
         (list cand (format (if (< line curr-line) before after) line) "")))))
 
-(defun consult--location-candidate (cand marker line &rest props)
-  "Add MARKER and LINE as \\='consult-location text property to CAND.
+(defsubst consult--location-candidate (cand marker line tofu &rest props)
+  "Add MARKER and LINE as `consult-location' text property to CAND.
 Furthermore add the additional text properties PROPS, and append
-tofu-encoded MARKER suffix for disambiguation."
-  ;; Handle cheap marker
-  (setq cand (concat cand (consult--tofu-encode (if (consp marker) (cdr 
marker) marker))))
+TOFU suffix for disambiguation."
+  (setq cand (concat cand (consult--tofu-encode tofu)))
   (add-text-properties 0 1 `(consult-location (,marker . ,line) ,@props) cand)
   cand)
 
@@ -2901,7 +2900,7 @@ These configuration options are supported:
         (cl-incf line (consult--count-lines (match-beginning 0)))
         (push (consult--location-candidate
                (consult--buffer-substring (pos-bol) (pos-eol) 'fontify)
-               (cons buffer (point)) (1- line)
+               (cons buffer (point)) (1- line) (point)
                'consult--outline-level (funcall level-fun))
               candidates)
         (goto-char (1+ (pos-eol)))))
@@ -2954,12 +2953,14 @@ The symbol at point is added to the future history."
           (when (and (eq buf current-buf)
                      (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 line-number-at-pos does not hurt 
much, since
-            ;; the mark ring is usually small since it is limited by 
`mark-ring-max'.
+            ;; `line-number-at-pos' is a very slow function, which should be
+            ;; replaced everywhere.  However in this case the slow
+            ;; line-number-at-pos does not hurt much, since the mark ring is
+            ;; usually small since it is limited by `mark-ring-max'.
             (push (consult--location-candidate
                    (consult--line-with-cursor marker) marker
-                   (line-number-at-pos pos consult-line-numbers-widen))
+                   (line-number-at-pos pos consult-line-numbers-widen)
+                   marker)
                   candidates)))))
     (unless candidates
       (user-error "No marks"))
@@ -3047,8 +3048,9 @@ CURR-LINE is the current line number."
          default-cand candidates)
     (consult--each-line beg end
       (unless (looking-at "^\\s-*$")
-        (push (consult--location-candidate (consult--buffer-substring beg end)
-                                           (cons buffer beg) line)
+        (push (consult--location-candidate
+               (consult--buffer-substring beg end)
+               (cons buffer beg) line beg)
               candidates)
         (when (and (not default-cand) (>= line curr-line))
           (setq default-cand candidates)))
@@ -3154,29 +3156,33 @@ BUFFERS is the list of buffers."
   (pcase-let ((`(,regexps . ,hl)
                (funcall consult--regexp-compiler
                         input 'emacs completion-ignore-case))
-              (candidates nil))
-    (dolist (buf buffers (nreverse candidates))
-     (with-current-buffer buf
-       (save-excursion
-         (save-match-data
-           (let ((line (line-number-at-pos (point-min) 
consult-line-numbers-widen)))
-             (goto-char (point-min))
-             (while (and (not (eobp))
-                         (save-excursion (re-search-forward (car regexps) nil 
t)))
-               (cl-incf line (consult--count-lines (match-beginning 0)))
-               (let ((bol (pos-bol))
-                     (eol (pos-eol)))
-                 (goto-char bol)
-                 (when (and (not (looking-at "^\\s-*$"))
-                            (seq-every-p (lambda (r)
-                                           (goto-char bol)
-                                           (re-search-forward r eol t))
-                                         (cdr regexps)))
-                   (push (consult--location-candidate
-                          (funcall hl (buffer-substring-no-properties bol eol))
-                          (cons buf bol) (1- line))
-                         candidates))
-                 (goto-char (1+ eol)))))))))))
+              (candidates nil)
+              (buf-idx 0))
+    (save-match-data
+      (dolist (buf buffers (nreverse candidates))
+        (with-current-buffer buf
+          (save-excursion
+            (let ((line (line-number-at-pos (point-min) 
consult-line-numbers-widen)))
+              (goto-char (point-min))
+              (while (and (not (eobp))
+                          (save-excursion (re-search-forward (car regexps) nil 
t)))
+                (cl-incf line (consult--count-lines (match-beginning 0)))
+                (let ((bol (pos-bol))
+                      (eol (pos-eol)))
+                  (goto-char bol)
+                  (when (and (not (looking-at "^\\s-*$"))
+                             (seq-every-p (lambda (r)
+                                            (goto-char bol)
+                                            (re-search-forward r eol t))
+                                          (cdr regexps)))
+                    (push (consult--location-candidate
+                           (funcall hl (buffer-substring-no-properties bol 
eol))
+                           (cons buf bol) (1- line)
+                           ;; Buffer index and bol for disambiguation
+                           (logior (ash bol 8) buf-idx))
+                          candidates))
+                  (goto-char (1+ eol))))
+              (cl-incf buf-idx))))))))
 
 ;;;###autoload
 (defun consult-line-multi (query &optional initial)