[elpa] externals/consult c369020eed 1/2: consult-buffer/consult-project-buffer: Add project root sources

[ELPA Syncer]

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

    consult-buffer/consult-project-buffer: Add project root sources
---
 CHANGELOG.org |  1 +
 README.org    |  1 +
 consult.el    | 58 ++++++++++++++++++++++++++++++++++++++++++----------------
 3 files changed, 44 insertions(+), 16 deletions(-)

diff --git a/CHANGELOG.org b/CHANGELOG.org
index 8b183aced5..4d2ecc4997 100644
--- a/CHANGELOG.org
+++ b/CHANGELOG.org
@@ -15,6 +15,7 @@
 - Remove special ~org-fold~ code. Set ~org-fold-core-style~ to ~overlays~ if 
unfolding
   in Org files does not work for you.
 - ~consult-info~: Support sub files.
+- ~consult-buffer~, ~consult-project-buffer~: Add sources for known project 
roots.
 - ~consult--multi~: Support multiple narrow keys per source. Used by the 
project
   buffer and project recent file source.
 - ~consult--async-sink~: The new action ~cancel~ was added to the async 
protocol.
diff --git a/README.org b/README.org
index dfdaa693c8..8484146a93 100644
--- a/README.org
+++ b/README.org
@@ -103,6 +103,7 @@ their descriptions.
   - p Project
   - B Project buffers
   - F Project files
+  - R Project roots
   - Custom [[#multiple-sources][other sources]] configured in 
=consult-buffer-sources=.
 - =consult-buffer-other-window=, =consult-buffer-other-frame=,
   =consult-buffer-other-tab=: Variants of =consult-buffer=.
diff --git a/consult.el b/consult.el
index 724dea96ec..02bf2a44ae 100644
--- a/consult.el
+++ b/consult.el
@@ -225,7 +225,8 @@ buffers.  The regular expressions are matched case 
sensitively."
     consult--source-file-register
     consult--source-bookmark
     consult--source-project-buffer-hidden
-    consult--source-project-recent-file-hidden)
+    consult--source-project-recent-file-hidden
+    consult--source-project-root-hidden)
   "Sources used by `consult-buffer'.
 See also `consult-project-buffer-sources'.
 See `consult--multi' for a description of the source data structure."
@@ -233,7 +234,8 @@ See `consult--multi' for a description of the source data 
structure."
 
 (defcustom consult-project-buffer-sources
   '(consult--source-project-buffer
-    consult--source-project-recent-file)
+    consult--source-project-recent-file
+    consult--source-project-root)
   "Sources used by `consult-project-buffer'.
 See also `consult-buffer-sources'.
 See `consult--multi' for a description of the source data structure."
@@ -826,12 +828,10 @@ asked for the directories or files to search via
      (or paths '("."))
      edir)))
 
-(declare-function project-current "project")
-(declare-function project-root "project")
-
 (defun consult--default-project-function (may-prompt)
   "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))
     (project-root proj)))
 
@@ -845,6 +845,15 @@ When no project is found and MAY-PROMPT is non-nil ask the 
user."
                          (funcall consult-project-function may-prompt)))
       (expand-file-name root))))
 
+(defun consult--project-known-roots ()
+  "Return list of known project roots."
+  (let ((root (consult--project-root))
+        (dirs (sort (project-known-project-roots) #'string<)))
+    (when root
+      (setq root (abbreviate-file-name root)
+            dirs (cons root (delete root dirs))))
+    dirs))
+
 (defun consult--project-name (dir)
   "Return the project name for DIR."
   (if (string-match "/\\([^/]+\\)/\\'" dir)
@@ -4478,7 +4487,7 @@ If NORECORD is non-nil, do not record the buffer switch 
in the buffer list."
      :history  bookmark-history
      :items    ,#'bookmark-all-names
      :state    ,#'consult--bookmark-state)
-  "Bookmark candidate source for `consult-buffer'.")
+  "Bookmark source for `consult-buffer'.")
 
 (defvar consult--source-project-buffer
   `( :name     "Project Buffer"
@@ -4494,7 +4503,7 @@ If NORECORD is non-nil, do not record the buffer switch 
in the buffer list."
           (consult--buffer-query :sort 'visibility
                                  :directory root
                                  :as #'consult--buffer-pair))))
-  "Project buffer candidate source for `consult-buffer'.")
+  "Project buffer source for `consult-buffer'.")
 
 (defvar consult--source-project-recent-file
   `( :name     "Project File"
@@ -4529,18 +4538,35 @@ If NORECORD is non-nil, do not record the buffer switch 
in the buffer list."
                   (when (equal part "") (setq part "./"))
                   (put-text-property 0 1 'multi-category `(file . ,file) part)
                   (push part items))))))))
-  "Project file candidate source for `consult-buffer'.")
+  "Project file source for `consult-buffer'.")
+
+(defvar consult--source-project-root
+  `( :name     "Project Root"
+     :narrow   ?r
+     :category file
+     :face     consult-file
+     :history  file-name-history
+     :action   ,(lambda (root)
+                  (let ((default-directory root))
+                    (call-interactively #'find-file)))
+     :items    ,#'consult--project-known-roots)
+  "Known project root source.")
 
 (defvar consult--source-project-buffer-hidden
-  `(:hidden t :narrow ((?p . "Project") (?B . "Project Buffer"))
-            ,@consult--source-project-buffer)
+  `( :hidden t :narrow ((?p . "Project") (?B . "Project Buffer"))
+     ,@consult--source-project-buffer)
   "Like `consult--source-project-buffer' but hidden by default.")
 
 (defvar consult--source-project-recent-file-hidden
-  `(:hidden t :narrow ((?p . "Project") (?F . "Project File"))
-            ,@consult--source-project-recent-file)
+  `( :hidden t :narrow ((?p . "Project") (?F . "Project File"))
+     ,@consult--source-project-recent-file)
   "Like `consult--source-project-recent-file' but hidden by default.")
 
+(defvar consult--source-project-root-hidden
+  `( :hidden t :narrow ((?p . "Project") (?R . "Project Root"))
+     ,@consult--source-project-root)
+  "Like `consult--source-project-root' but hidden by default.")
+
 (defvar consult--source-hidden-buffer
   `( :name     "Hidden Buffer"
      :narrow   ?\s
@@ -4553,7 +4579,7 @@ If NORECORD is non-nil, do not record the buffer switch 
in the buffer list."
      ,(lambda () (consult--buffer-query :sort 'visibility
                                         :filter 'invert
                                         :as #'consult--buffer-pair)))
-  "Hidden buffer candidate source for `consult-buffer'.")
+  "Hidden buffer source for `consult-buffer'.")
 
 (defvar consult--source-modified-buffer
   `( :name     "Modified Buffer"
@@ -4570,7 +4596,7 @@ If NORECORD is non-nil, do not record the buffer switch 
in the buffer list."
                                         (lambda (buf)
                                           (and (buffer-modified-p buf)
                                                (buffer-file-name buf))))))
-  "Modified buffer candidate source for `consult-buffer'.")
+  "Modified buffer source for `consult-buffer'.")
 
 (defvar consult--source-buffer
   `( :name     "Buffer"
@@ -4583,7 +4609,7 @@ If NORECORD is non-nil, do not record the buffer switch 
in the buffer list."
      :items
      ,(lambda () (consult--buffer-query :sort 'visibility
                                         :as #'consult--buffer-pair)))
-  "Buffer candidate source for `consult-buffer'.")
+  "Buffer source for `consult-buffer'.")
 
 (defun consult--file-register-p (reg)
   "Return non-nil if REG is a file register."
@@ -4621,7 +4647,7 @@ If NORECORD is non-nil, do not record the buffer switch 
in the buffer list."
                 (setq file (expand-file-name file))))
             (unless (gethash file ht)
               (push (consult--fast-abbreviate-file-name file) items))))))
-  "Recent file candidate source for `consult-buffer'.")
+  "Recent file source for `consult-buffer'.")
 
 ;;;###autoload
 (defun consult-buffer (&optional sources)