[elpa] externals/consult 68cc5895f5 1/5: Add consult--source-project-roots

[ELPA Syncer]

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

    Add consult--source-project-roots
    
    - Introduce generalized consult-project-function
    - See https://github.com/Qkessler/consult-project/issues/1
---
 CHANGELOG.org    |  9 ++++++++
 README.org       | 31 +++++++------------------
 consult-imenu.el |  8 +++----
 consult.el       | 69 ++++++++++++++++++++++++++++++++++++++++++++------------
 4 files changed, 75 insertions(+), 42 deletions(-)

diff --git a/CHANGELOG.org b/CHANGELOG.org
index 1256275f25..3df6d23c94 100644
--- a/CHANGELOG.org
+++ b/CHANGELOG.org
@@ -2,6 +2,15 @@
 #+author: Daniel Mendler
 #+language: en
 
+* Development
+
+- Add =consult--source-project-root=, a =consult-buffer= source for root 
directories
+  of known projects.
+- Introduce generalized =consult-project-function=, deprecate
+  =consult-project-root-function=. The =consult-project-function= is used to
+  retrieve the project directories and is preconfigured with a default 
function,
+  which uses project.el.
+
 * Version 0.15 (2022-01-31)
 
 - Bugfixes
diff --git a/README.org b/README.org
index 5ea828e205..1722fb750c 100644
--- a/README.org
+++ b/README.org
@@ -100,8 +100,7 @@ their descriptions.
    - b Buffers
    - f Files (Requires =recentf-mode=)
    - m Bookmarks
-   - p Project (Requires configuration of the =consult-project-root-function=
-     as shown in the [[#use-package-example][example configuration]]).
+   - p Project
    - Arbitrary [[#multiple-sources][other sources]] configured in 
=consult-buffer-sources=.
  - =consult-bookmark=: Select or create bookmark. To select bookmarks you 
might use the
    =consult-buffer= as an alternative, which can include a bookmark virtual 
buffer
@@ -253,10 +252,10 @@ their descriptions.
    =filter-string= is passed to the /fast/ Emacs filtering to further narrow 
down
    the list of matches. This is particularly useful if you are using an 
advanced
    completion style like orderless. =consult-grep= supports preview. If the
-   =consult-project-root-function= is [[#use-package-example][configured]] and 
returns non-nil, =consult-grep=
-   searches the current project directory. Otherwise the =default-directory= is
-   searched. If =consult-grep= is invoked with prefix argument =C-u M-s g=, 
you can
-   specify the directory manually.
+   =consult-project-function= is [[#use-package-example][configured]] and 
returns a non-nil directory,
+   =consult-grep= searches the current project directory. Otherwise the
+   =default-directory= is searched. If =consult-grep= is invoked with prefix
+   argument =C-u M-s g=, you can specify the directory manually.
  - =consult-find=, =consult-locate=: Find file by
    matching the path against a regexp. Like for =consult-grep,= either the 
project
    root or the current directory is the root directory for the search. The 
input
@@ -444,7 +443,8 @@ their descriptions.
    (consult-customize
     consult-ripgrep consult-git-grep consult-grep
     consult-bookmark consult-recent-file consult-xref
-    consult--source-recent-file consult--source-project-recent-file 
consult--source-bookmark
+    consult--source-bookmark consult--source-project-root
+    consult--source-recent-file consult--source-project-recent-file
     :preview-key (kbd "M-."))
  #+end_src
 
@@ -882,21 +882,6 @@ configuration examples.
      ;; Optionally make narrowing help available in the minibuffer.
      ;; You may want to use `embark-prefix-help-command' or which-key instead.
      ;; (define-key consult-narrow-map (vconcat consult-narrow-key "?") 
#'consult-narrow-help)
-
-     ;; Optionally configure a function which returns the project root 
directory.
-     ;; There are multiple reasonable alternatives to chose from.
-     ;;;; 1. project.el (project-roots)
-     (setq consult-project-root-function
-           (lambda ()
-             (when-let (project (project-current))
-               (car (project-roots project)))))
-     ;;;; 2. projectile.el (projectile-project-root)
-     ;; (autoload 'projectile-project-root "projectile")
-     ;; (setq consult-project-root-function #'projectile-project-root)
-     ;;;; 3. vc.el (vc-root-dir)
-     ;; (setq consult-project-root-function #'vc-root-dir)
-     ;;;; 4. locate-dominating-file
-     ;; (setq consult-project-root-function (lambda () (locate-dominating-file 
"." ".git")))
    )
  #+end_src
 
@@ -945,7 +930,7 @@ configuration examples.
  | consult-preview-max-count        | Maximum number of files to keep open 
during preview   |
  | consult-preview-max-size         | Files larger than this size are not 
previewed         |
  | consult-preview-raw-size         | Files larger than this size are 
previewed in raw form |
- | consult-project-root-function    | Function which returns current project 
root           |
+ | consult-project-function         | Function which returns project 
directories            |
  | consult-recent-file-filter       | Filter for =consult-recent-file=         
               |
  | consult-register-narrow          | Narrowing configuration for 
=consult-register=          |
  | consult-ripgrep-args             | Command line arguments for ripgrep       
             |
diff --git a/consult-imenu.el b/consult-imenu.el
index 2ce241342f..4269030d7c 100644
--- a/consult-imenu.el
+++ b/consult-imenu.el
@@ -216,10 +216,10 @@ See also `consult-imenu-multi'."
   "Select item from the imenus of all buffers from the same project.
 
 In order to determine the buffers belonging to the same project, the
-`consult-project-root-function' is used. Only the buffers with the
-same major mode as the current buffer are used. See also
-`consult-imenu' for more details. In order to search a subset of buffers,
-QUERY can be set to a plist according to `consult--buffer-query'."
+`consult-project-function' is used. Only the buffers with the same major
+mode as the current buffer are used. See also `consult-imenu' for more
+details. In order to search a subset of buffers, QUERY can be set to a
+plist according to `consult--buffer-query'."
   (interactive "P")
   (unless (keywordp (car-safe query))
     (setq query (list :sort 'alpha :mode major-mode
diff --git a/consult.el b/consult.el
index 5c8aaa87d2..7eb4b4b218 100644
--- a/consult.el
+++ b/consult.el
@@ -78,10 +78,20 @@ The key must be either a string or a vector.
 This is the key representation accepted by `define-key'."
   :type '(choice key-sequence (const nil)))
 
-(defcustom consult-project-root-function nil
-  "Function which returns project root directory.
-
-The root directory is used by `consult-buffer' and `consult-grep'."
+(defvar consult-project-root-function nil)
+(make-obsolete-variable
+ 'consult-project-root-function
+ "The function has been generalized to the `consult-project-function'"
+ "0.15")
+
+(defcustom consult-project-function #'consult--default-project-function
+  "Function which takes a single symbol argument and returns project 
directories.
+
+The argument can be:
+- current-project: Return the current project directory.
+  The root directory is used by `consult-buffer' and `consult-grep'.
+- known-projects: Return the directories of known projects.
+  The list of known projects is used by `consult--source-project-root'."
   :type '(choice function (const nil)))
 
 (defcustom consult-async-refresh-delay 0.2
@@ -203,7 +213,8 @@ character, the *Completions* buffer and a few log buffers."
     consult--source-recent-file
     consult--source-bookmark
     consult--source-project-buffer
-    consult--source-project-recent-file)
+    consult--source-project-recent-file
+    consult--source-project-root)
   "Sources used by `consult-buffer'.
 
 See `consult--multi' for a description of the source values."
@@ -812,7 +823,7 @@ only the last two path components are shown.
 
 If DIR is a string, it is returned.
 If DIR is a true value, the user is asked.
-Then the `consult-project-root-function' is tried.
+Then the `consult-project-function' is tried.
 Otherwise the `default-directory' is returned."
   (let* ((dir
           (cond
@@ -836,9 +847,25 @@ Otherwise the `default-directory' is returned."
       (t (format "%s (%s): " prompt (consult--abbreviate-directory dir))))
      edir)))
 
+(defun consult--default-project-function (what)
+  "Return project directories depending on WHAT.
+If WHAT is current-project return the directory of the current project.
+If WHAT is known-projects return the list of known project directories."
+  (unless (fboundp 'project-current) (require 'project))
+  (pcase what
+    ('current-project
+     (when-let (proj (project-current))
+       (cond
+        ((fboundp 'project-root) (project-root proj))
+        ((fboundp 'project-roots) (project-roots proj)))))
+    ('known-projects
+     (and (fboundp 'project-known-project-roots)
+          (project-known-project-roots)))))
+
 (defun consult--project-root ()
   "Return project root as absolute path."
-  (when-let (root (and consult-project-root-function (funcall 
consult-project-root-function)))
+  (when-let (root (and consult-project-function
+                       (funcall consult-project-function 'current-project)))
     (expand-file-name root)))
 
 (defun consult--project-name (dir)
@@ -3965,7 +3992,7 @@ If NORECORD is non-nil, do not record the buffer switch 
in the buffer list."
     :face     consult-buffer
     :history  buffer-name-history
     :state    ,#'consult--buffer-state
-    :enabled  ,(lambda () consult-project-root-function)
+    :enabled  ,(lambda () consult-project-function)
     :items
     ,(lambda ()
        (consult--buffer-query :sort 'visibility
@@ -3973,6 +4000,19 @@ If NORECORD is non-nil, do not record the buffer switch 
in the buffer list."
                               :as #'buffer-name)))
   "Project buffer candidate source for `consult-buffer'.")
 
+(defvar consult--source-project-root
+  `(:name     "Project Root"
+    :narrow   (?p . "Project")
+    :hidden   t
+    :category file
+    :face     consult-file
+    :history  file-name-history
+    :state    ,#'consult--file-state
+    :enabled  ,(lambda () consult-project-function)
+    :items
+    ,(lambda () (funcall consult-project-function 'known-projects)))
+  "Project root directory source for `consult-buffer'.")
+
 (defvar consult--source-project-recent-file
   `(:name     "Project File"
     :narrow   (?p . "Project")
@@ -3981,8 +4021,7 @@ If NORECORD is non-nil, do not record the buffer switch 
in the buffer list."
     :face     consult-file
     :history  file-name-history
     :state    ,#'consult--file-state
-    :enabled  ,(lambda () (and consult-project-root-function
-                               recentf-mode))
+    :enabled  ,(lambda () (and consult-project-function recentf-mode))
     :items
     ,(lambda ()
       (when-let (root (consult--project-root))
@@ -4054,7 +4093,7 @@ The command supports recent files, bookmarks, views and 
project files as virtual
 buffers. Buffers are previewed. Furthermore narrowing to buffers (b), files 
(f),
 bookmarks (m) and project files (p) is supported via the corresponding keys. In
 order to determine the project-specific files and buffers, the
-`consult-project-root-function' is used. See `consult-buffer-sources' and
+`consult-project-unction' is used. See `consult-buffer-sources' and
 `consult--multi' for the configuration of the virtual buffer sources."
   (interactive)
   (when-let (buffer (consult--multi consult-buffer-sources
@@ -4305,10 +4344,10 @@ Here we give a few example inputs:
 #word -- -C3        : Search for word, include 3 lines as context
 #first#second       : Search for first, quick filter for second.
 
-The symbol at point is added to the future history. If `consult-grep'
-is called interactively with a prefix argument, the user can specify
-the directory to search in. By default the project directory is used
-if `consult-project-root-function' is defined and returns non-nil.
+The symbol at point is added to the future history. If `consult-grep' is
+called interactively with a prefix argument, the user can specify the
+directory to search in. By default the project directory is used if
+`consult-project-function' is defined and returns a non-nil directory.
 Otherwise the `default-directory' is searched."
   (interactive "P")
   (consult--grep "Grep" #'consult--grep-builder dir initial))