[elpa] externals/consult 74c8ab5: Add consult-line-multi (#367)

[ELPA Syncer]

branch: externals/consult
commit 74c8ab56fd343a5a2f6dea7f2f9c4b1358a6c282
Author: Daniel Mendler <mail@daniel-mendler.de>
Commit: GitHub <noreply@github.com>

    Add consult-line-multi (#367)
---
 CHANGELOG.org    |   5 +-
 README.org       |  10 +++-
 consult-imenu.el |  28 +++++-----
 consult.el       | 162 +++++++++++++++++++++++++++++++++++++++----------------
 4 files changed, 143 insertions(+), 62 deletions(-)

diff --git a/CHANGELOG.org b/CHANGELOG.org
index 019201c..9b1afd0 100644
--- a/CHANGELOG.org
+++ b/CHANGELOG.org
@@ -4,9 +4,10 @@
 
 * Development
 
-- =consult-mark=, =consult-global-mark=: Added optional marker list argument
+- =consult-mark=, =consult-global-mark=: Add optional marker list argument
 - =consult-completing-read-multiple=: New function
-- Renamed =consult-project-imenu= to =consult-imenu-project=
+- Rename =consult-project-imenu= to =consult-imenu-project=
+- Add =consult-line-multi= to search multiple buffers
 
 * Version 0.9 (2021-06-22)
 
diff --git a/README.org b/README.org
index 6a1da00..cc2ea76 100644
--- a/README.org
+++ b/README.org
@@ -197,6 +197,7 @@ their descriptions.
  #+cindex: search
 
  #+findex: consult-line
+ #+findex: consult-line-multi
  #+findex: consult-multi-occur
  #+findex: consult-keep-lines
  #+findex: consult-focus-lines
@@ -206,6 +207,9 @@ their descriptions.
    recent Isearch string are added to the "future history" and can be accessed
    by pressing =M-n=. When =consult-line= is bound to the =isearch-mode-map= 
and
    is invoked during a running Isearch, it will use the current Isearch string.
+ - =consult-line-multi=: Search across multiple buffers. By default search 
across
+   project buffers. If invoked with a prefix argument search across all 
buffers.
+   Behaves like =consult-line=.
  - =consult-isearch=: During an Isearch session, this command picks a
    search string from history and continues the search with the newly selected
    string. Outside of Isearch, the command allows you to pick a string from the
@@ -800,11 +804,12 @@ configuration examples.
             ("M-g I" . consult-imenu-project)
             ;; M-s bindings (search-map)
             ("M-s f" . consult-find)
-            ("M-s L" . consult-locate)
+            ("M-s F" . consult-locate)
             ("M-s g" . consult-grep)
             ("M-s G" . consult-git-grep)
             ("M-s r" . consult-ripgrep)
             ("M-s l" . consult-line)
+            ("M-s L" . consult-line-multi)
             ("M-s m" . consult-multi-occur)
             ("M-s k" . consult-keep-lines)
             ("M-s u" . consult-focus-lines)
@@ -813,7 +818,8 @@ configuration examples.
             :map isearch-mode-map
             ("M-e" . consult-isearch)                 ;; orig. 
isearch-edit-string
             ("M-s e" . consult-isearch)               ;; orig. 
isearch-edit-string
-            ("M-s l" . consult-line))                 ;; needed by 
consult-line to detect isearch
+            ("M-s l" . consult-line)                  ;; needed by 
consult-line to detect isearch
+            ("M-s L" . consult-line-multi))           ;; needed by 
consult-line to detect isearch
 
      ;; Enable automatic preview at point in the *Completions* buffer.
      ;; This is relevant when you use the default completion UI,
diff --git a/consult-imenu.el b/consult-imenu.el
index 146b9d3..1b7138c 100644
--- a/consult-imenu.el
+++ b/consult-imenu.el
@@ -141,7 +141,7 @@ TYPES is the mode-specific types configuration."
 
 (defun consult-imenu--all-items (buffers)
   "Return all imenu items from each BUFFERS."
-  (seq-mapcat (lambda (buf) (with-current-buffer buf (consult-imenu--items))) 
buffers))
+  (apply #'append (consult--buffer-map buffers #'consult-imenu--items)))
 
 (defun consult-imenu--jump (item)
   "Jump to imenu ITEM via `consult--jump'.
@@ -153,10 +153,8 @@ this function can jump across buffers."
     (`(,_ . ,pos) (consult--jump pos))
     (_ (error "Unknown imenu item: %S" item))))
 
-(defun consult-imenu--select (items)
-  "Select from imenu ITEMS with preview.
-
-The symbol at point is added to the future history."
+(defun consult-imenu--select (prompt items)
+  "Select from imenu ITEMS given PROMPT string."
   (let ((narrow
          (mapcar (lambda (x) (cons (car x) (cadr x)))
                  (plist-get (cdr (seq-find (lambda (x) (derived-mode-p (car 
x)))
@@ -166,7 +164,7 @@ The symbol at point is added to the future history."
     (consult-imenu--jump
      (consult--read
       (or items (user-error "Imenu is empty"))
-      :prompt "Go to item: "
+      :prompt prompt
       :state
       (let ((preview (consult--jump-preview)))
         (lambda (cand restore)
@@ -199,10 +197,11 @@ The symbol at point is added to the future history."
 
 The command supports preview and narrowing. See the variable
 `consult-imenu-config', which configures the narrowing.
+The symbol at point is added to the future history.
 
 See also `consult-imenu-project'."
   (interactive)
-  (consult-imenu--select (consult-imenu--items)))
+  (consult-imenu--select "Go to item: " (consult-imenu--items)))
 
 ;;;###autoload
 (defun consult-imenu-project ()
@@ -213,12 +212,15 @@ In order to determine the buffers belonging to the same 
project, the
 same major mode as the current buffer are used. See also
 `consult-imenu' for more details."
   (interactive)
-  (consult-imenu--select
-   (consult-imenu--all-items
-    (or (consult--buffer-query :directory 'project
-                               :mode major-mode
-                               :sort 'alpha)
-        (list (current-buffer))))))
+  (if-let* ((project (consult--project-root))
+            (buffers (consult--buffer-query :directory project
+                                            :mode major-mode
+                                            :sort 'alpha)))
+      (consult-imenu--select
+       (format "Go to item (Project %s): "
+               (file-name-base (directory-file-name project)))
+       (consult-imenu--all-items buffers))
+    (consult-imenu)))
 
 (define-obsolete-function-alias
   'consult-project-imenu
diff --git a/consult.el b/consult.el
index b8c363a..1b56d9a 100644
--- a/consult.el
+++ b/consult.el
@@ -686,7 +686,7 @@ The line beginning/ending BEG/END is bound in BODY."
   "Create filter regexp from REGEXPS."
   (mapconcat (lambda (x) (concat "\\(?:" x "\\)")) regexps "\\|"))
 
-(defun consult--format-directory-prompt (prompt dir)
+(defun consult--directory-prompt-1 (prompt dir)
   "Format PROMPT, expand directory DIR and return them as a pair."
   (save-match-data
     (let ((edir (file-name-as-directory (expand-file-name dir)))
@@ -715,14 +715,13 @@ If DIR is a true value, the user is asked.
 Then the `consult-project-root-function' is tried.
 Otherwise the `default-directory' is returned."
   (cond
-   ((stringp dir) (consult--format-directory-prompt prompt dir))
-   (dir (consult--format-directory-prompt prompt (read-directory-name 
"Directory: " nil nil t)))
+   ((stringp dir) (consult--directory-prompt-1 prompt dir))
+   (dir (consult--directory-prompt-1 prompt (read-directory-name "Directory: " 
nil nil t)))
    ((when-let (root (consult--project-root))
-      (save-match-data
-        (if (string-match "/\\([^/]+\\)/\\'" root)
-            (cons (format "%s in project %s: " prompt (match-string 1 root)) 
root)
-          (consult--format-directory-prompt prompt root)))))
-   (t (consult--format-directory-prompt prompt default-directory))))
+      (cons (format "%s in project %s: " prompt
+                    (file-name-base (directory-file-name root)))
+            root)))
+   (t (consult--directory-prompt-1 prompt default-directory))))
 
 (defun consult--project-root ()
   "Return project root as absolute path."
@@ -850,6 +849,15 @@ Otherwise the `default-directory' is returned."
             (forward-char column))
           (point-marker))))))
 
+(defun consult--line-group (cand transform)
+  "Group function used by `consult-line-all' and `consult-line-project'.
+If TRANSFORM non-nil, return transformed CAND, otherwise return title."
+  (if transform
+      cand
+    (buffer-name
+     (marker-buffer
+      (car (get-text-property 0 'consult-location cand))))))
+
 (defun consult--line-prefix (&optional curr-line)
   "Annotate `consult-location' candidates with line numbers given the current 
line CURR-LINE."
   (setq curr-line (or curr-line -1))
@@ -2534,14 +2542,13 @@ CURR-LINE is the current line number."
           (when (and (not default-cand) (>= line curr-line))
             (setq default-cand candidates)))
         (setq line (1+ line))))
-    (unless candidates
-      (user-error "No lines"))
-    (nreverse
-     (if (or top (not default-cand))
-         candidates
-       (let ((before (cdr default-cand)))
-         (setcdr default-cand nil)
-         (nconc before candidates))))))
+    (when candidates
+      (nreverse
+       (if (or top (not default-cand))
+           candidates
+         (let ((before (cdr default-cand)))
+           (setcdr default-cand nil)
+           (nconc before candidates)))))))
 
 (defun consult--line-match (input candidates cand)
   "Lookup position of match.
@@ -2587,39 +2594,89 @@ CAND is the currently selected candidate."
                 (setq beg (+ beg step)))
               (setq step (/ step 2)))
             (setq end beg)))
-        ;; Marker can be dead
-        (ignore-errors (+ pos end))))))
+        ;; Marker can be dead, therefore ignore errors. Create a new marker 
instead of an integer,
+        ;; since the location may be in another buffer, e.g., for 
`consult-line-all'.
+        (ignore-errors
+          (if (or (not (markerp pos)) (eq (marker-buffer pos) 
(current-buffer)))
+              (+ pos end)
+            ;; Only create a new marker when jumping across buffers, to avoid
+            ;; creating unnecessary markers, when scrolling through candidates.
+            ;; Creating markers is not free.
+            (move-marker
+             (make-marker)
+             (+ pos end)
+             (marker-buffer pos))))))))
+
+(cl-defun consult--line (candidates &key curr-line prompt initial group)
+  "Select from from line CANDIDATES and jump to the match.
+CURR-LINE is the current line. See `consult--read' for the arguments PROMPT,
+INITIAL and GROUP."
+  (consult--read
+   candidates
+   :prompt prompt
+   :annotate (consult--line-prefix curr-line)
+   :group group
+   :category 'consult-location
+   :sort nil
+   :require-match t
+   ;; Always add last isearch string to future history
+   :add-history (list (thing-at-point 'symbol) isearch-string)
+   :history '(:input consult--line-history)
+   :lookup #'consult--line-match
+   :default (car candidates)
+   ;; Add isearch-string as initial input if starting from isearch
+   :initial (or initial
+                (and isearch-mode
+                     (prog1 isearch-string (isearch-done))))
+   :state (consult--jump-state)))
 
 ;;;###autoload
 (defun consult-line (&optional initial start)
-  "Search for a matching line and jump to the line beginning.
-
-The default candidate is the non-empty line next to point.
-This command obeys narrowing. Optional INITIAL input can be provided.
-The search starting point is changed if the START prefix argument is set.
-The symbol at point and the last `isearch-string' is added to the future 
history."
+  "Search for a matching line.
+
+Depending on the setting `consult-line-point-placement' the command jumps to
+the beginning or the end of the first match on the line or the line beginning.
+The default candidate is the non-empty line next to point. This command obeys
+narrowing. Optional INITIAL input can be provided. The search starting point is
+changed if the START prefix argument is set. The symbol at point and the last
+`isearch-string' is added to the future history."
   (interactive (list nil (not (not current-prefix-arg))))
-  (let* ((curr-line (line-number-at-pos (point) consult-line-numbers-widen))
-         (candidates (consult--with-increased-gc
-                      (consult--line-candidates
-                       (not (eq start consult-line-start-from-top))
-                       curr-line))))
-    (consult--read
-     candidates
-     :prompt "Go to line: "
-     :annotate (consult--line-prefix curr-line)
-     :category 'consult-location
-     :sort nil
-     :require-match t
-     ;; Always add last isearch string to future history
-     :add-history (list (thing-at-point 'symbol) isearch-string)
-     :history '(:input consult--line-history)
-     :lookup #'consult--line-match
-     :default (car candidates)
-     ;; Add isearch-string as initial input if starting from isearch
-     :initial (or initial
-                  (and isearch-mode (prog1 isearch-string (isearch-done))))
-     :state (consult--jump-state))))
+  (let ((curr-line (line-number-at-pos (point) consult-line-numbers-widen))
+        (top (not (eq start consult-line-start-from-top))))
+    (consult--line
+     (or (consult--with-increased-gc
+          (consult--line-candidates top curr-line))
+         (user-error "No lines"))
+     :curr-line (and (not top) curr-line)
+     :prompt (if top "Go to line from top: " "Go to line: ")
+     :initial initial)))
+
+(defun consult--line-multi-candidates (&rest query)
+  "Collect the line candidates from multiple buffers.
+QUERY is passed to `consult--buffer-query'."
+  (or (apply #'nconc
+             (consult--buffer-map
+              (apply #'consult--buffer-query query)
+              #'consult--line-candidates 'top most-positive-fixnum))
+      (user-error "No lines")))
+
+;;;###autoload
+(defun consult-line-multi (all &optional initial)
+  "Search for a matching line in multiple buffers.
+
+By default search across all project buffers. If the prefix argument ALL is
+non-nil, all buffers are searched. Optional INITIAL input can be provided. See
+`consult-line' for more information."
+  (interactive "P")
+  (let ((project (and (not all) (consult--project-root))))
+    (consult--line
+     (consult--line-multi-candidates :sort 'alpha :directory project)
+     :prompt (if project
+                 (format "Go to line (Project %s): "
+                         (file-name-base (directory-file-name project)))
+               "Go to line (All buffers): ")
+     :initial initial
+     :group #'consult--line-group)))
 
 ;;;;; Command: consult-keep-lines
 
@@ -3580,6 +3637,21 @@ AS is a conversion function."
              (if as (funcall as it) it)))))
       buffers)))
 
+(defun consult--buffer-map (buffer &rest app)
+  "Run function application APP for each BUFFER.
+Report progress and return a list of the results"
+  (consult--with-increased-gc
+   (let* ((count (length buffer))
+          (reporter (make-progress-reporter "Collecting" 0 count)))
+     (prog1
+         (seq-map-indexed (lambda (buf idx)
+                            (with-current-buffer buf
+                              (prog1 (apply app)
+                                (progress-reporter-update
+                                 reporter (1+ idx) (buffer-name)))))
+                 buffer)
+       (progress-reporter-done reporter)))))
+
 (defun consult--buffer-file-hash ()
   "Return hash table of all buffer file names."
   (consult--string-hash (consult--buffer-query :as #'buffer-file-name)))