branch: elpa/projectile
commit a4a91e08d49d280c9c5c2b0820bb04da198d61db
Author: Bozhidar Batsov <[email protected]>
Commit: Bozhidar Batsov <[email protected]>
Add an optional Embark/Marginalia integration
Built on the completion categories Projectile already advertises, wired
via with-eval-after-load so Embark and Marginalia stay soft dependencies.
- projectile--embark-project-file-target + ...-transform: an Embark
`project-file' transformer that AUGMENTS Embark's own rather than
replacing it. It resolves a candidate against the Projectile root only
when the file actually lives there (existence guard), and otherwise
defers to whatever transformer Embark already had. So Embark's file
actions hit the right file even when default-directory is a
subdirectory, and non-Projectile `project-file' completions are
provably unaffected.
- projectile-embark-project-map: an action keymap for the new
`projectile-project' category (switch/vc/dired/remove). This category
is Projectile-only, so it can't collide with anything. Project-switch
completions move from `file' to `projectile-project', with a Marginalia
annotator reusing the built-in file annotator so annotations are
unchanged.
The wiring lives in projectile--embark-setup and
projectile--marginalia-setup so it can be tested without either package
installed - which is how the annotator registry turned out to be
`marginalia-annotators' these days, not the `marginalia-annotator-registry'
of older releases. Both names are handled.
---
CHANGELOG.md | 4 +
.../assets/images/projectile-embark-project.gif | Bin 0 -> 369153 bytes
doc/modules/ROOT/pages/configuration.adoc | 50 +++++++++
projectile.el | 115 +++++++++++++++++++--
test/projectile-core-test.el | 95 +++++++++++++++++
5 files changed, 257 insertions(+), 7 deletions(-)
diff --git a/CHANGELOG.md b/CHANGELOG.md
index b96b60a36e..f34832bf3b 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -6,6 +6,10 @@
## master (unreleased)
+### New features
+
+- Add an optional Embark/Marginalia integration, wired via
`with-eval-after-load` so neither package becomes a dependency. `embark-act` on
a project file now targets the right file even when `default-directory` is a
subdirectory, via a transformer that *augments* (never replaces) Embark's own
`project-file` handling - it resolves a candidate against the Projectile root
only when the file actually lives there, and otherwise defers to Embark,
leaving non-Projectile completions untouched. A [...]
+
### Changes
- Drop the standalone package headers (`Version`, `Package-Requires`) from
`projectile-consult.el`. It's an optional module shipped inside the Projectile
package, not a package of its own, and the phantom `Package-Requires` made
build tooling treat it as one (e.g. it broke `eldev`-based test runs on Emacs
28.x by enforcing Consult's Emacs 29.1 floor on the whole project). Its runtime
needs (Consult 2.0+, hence Emacs 29.1+) are unchanged and documented in the
file and the manual.
diff --git a/doc/modules/ROOT/assets/images/projectile-embark-project.gif
b/doc/modules/ROOT/assets/images/projectile-embark-project.gif
new file mode 100644
index 0000000000..0569b4a7c3
Binary files /dev/null and
b/doc/modules/ROOT/assets/images/projectile-embark-project.gif differ
diff --git a/doc/modules/ROOT/pages/configuration.adoc
b/doc/modules/ROOT/pages/configuration.adoc
index dcab133bac..fa64ebf778 100644
--- a/doc/modules/ROOT/pages/configuration.adoc
+++ b/doc/modules/ROOT/pages/configuration.adoc
@@ -198,6 +198,56 @@ in particular should read the
xref:upgrading_to_projectile_3.adoc#ido-users[upgrade guide], which covers
`ido-completing-read+`.
+=== Embark and Marginalia
+
+Projectile ships a small integration layer for
+https://github.com/oantolin/embark[Embark] and
+https://github.com/minad/marginalia[Marginalia]. It's wired with
+`with-eval-after-load`, so neither package becomes a dependency - if you don't
+have them installed, nothing happens; if you do, it activates on its own with
no
+configuration.
+
+Two things come out of it. First, `embark-act` on a file candidate targets the
+right file. Projectile presents its file candidates relative to the project
+root, so acting on one from a buffer whose `default-directory` is a
+subdirectory would otherwise resolve against the wrong place. The integration
+adds an Embark transformer that expands the candidate against the project root
+- but only when the file really does live there, otherwise it defers to
+whatever Embark was already doing, so `project-file` completions that aren't
+Projectile's behave exactly as before.
+
+Second, acting on a *project* candidate offers project operations rather than
+generic file ones. Project prompts (`projectile-switch-project` and friends)
use
+a `projectile-project` completion category bound to
+`projectile-embark-project-map`:
+
+|===
+| Key | Action
+
+| kbd:[s] | switch to the project
+| kbd:[v] | open the project's VC interface
+| kbd:[d] | open the project root in Dired
+| kbd:[D] | remove it from the known projects
+|===
+
+Acting on a project from the switch prompt, then opening it in Dired:
+
+image::projectile-embark-project.gif[embark-act on a project candidate,
showing the project action keymap]
+
+The keymap inherits from `embark-general-map`, so Embark's generic actions
+(collect, export, insert, and so on) are available too. Rebind or extend it
like
+any other keymap:
+
+[source,elisp]
+----
+(with-eval-after-load 'embark
+ (define-key projectile-embark-project-map (kbd "b") #'projectile-ibuffer))
+----
+
+Marginalia annotates the project candidates with its built-in file annotator,
+since they're just directory paths - so they look the same as they did before
+the category change.
+
=== Custom completion function
You can also set `projectile-completion-system` to a function that accepts a
diff --git a/projectile.el b/projectile.el
index 42db26436a..6962a4ecee 100644
--- a/projectile.el
+++ b/projectile.el
@@ -2739,7 +2739,7 @@ See also `projectile-acquire-root'."
(cond
((eq projectile-require-project-root 'prompt) (projectile-completing-read
"Switch to project: "
projectile-known-projects
- :category 'file
+ :category
'projectile-project
:caller
'projectile-read-project))
(projectile-require-project-root (user-error "Projectile cannot find a
project definition in %s" default-directory))
(t default-directory))))
@@ -9829,7 +9829,7 @@ prompt for a known project to open instead of the current
one."
(if arg
(projectile-completing-read
"Dired in project: " (projectile-relevant-known-projects)
- :category 'file
+ :category 'projectile-project
:caller 'projectile-read-project)
(projectile-acquire-root))))
@@ -9863,7 +9863,7 @@ directory to open."
(projectile-completing-read
"Open project VC in: "
projectile-known-projects
- :category 'file
+ :category 'projectile-project
:caller 'projectile-read-project))))
(unless project-root
(setq project-root (projectile-acquire-root)))
@@ -11037,7 +11037,7 @@ of `projectile-switch-project-action'."
"Switch to project: " projects
:action (lambda (project)
(projectile-switch-project-by-name project arg))
- :category 'file
+ :category 'projectile-project
:caller 'projectile-read-project)
(user-error "There are no known projects"))))
@@ -11054,7 +11054,7 @@ of `projectile-switch-project-action'."
"Switch to open project: " projects
:action (lambda (project)
(projectile-switch-project-by-name project arg))
- :category 'file
+ :category 'projectile-project
:caller 'projectile-read-project)
(user-error "There are no open projects"))))
@@ -11332,7 +11332,7 @@ projects removed."
(interactive (list (projectile-completing-read
"Remove from known projects: " projectile-known-projects
:action 'projectile-remove-known-project
- :category 'file
+ :category 'projectile-project
:caller 'projectile-read-project)))
(unless (called-interactively-p 'any)
(setq projectile-known-projects
@@ -11463,7 +11463,7 @@ Let user choose another project when PROMPT-FOR-PROJECT
is supplied."
(projectile-completing-read
"Project name: "
(projectile-relevant-known-projects)
- :category 'file
+ :category 'projectile-project
:caller 'projectile-read-project)
(projectile-acquire-root))))
(projectile-ibuffer-by-project project-root)))
@@ -13115,6 +13115,107 @@ existing tabs untouched."
(remove-hook 'tab-bar-tab-pre-close-functions
#'projectile-session--on-tab-close))))
+
+;;; Optional Embark / Marginalia integration
+;;
+;; Gated behind `with-eval-after-load' so Embark and Marginalia stay soft,
+;; opt-in enhancements rather than dependencies. Two Embark wins on top of the
+;; completion categories Projectile already advertises:
+;;
+;; 1. A transformer that expands a `project-file' candidate (which Projectile
+;; presents project-relative) to an absolute path against the Projectile
+;; root, so Embark's file actions hit the right file regardless of
+;; `default-directory'.
+;; 2. A `projectile-project' action keymap, so acting on a project candidate
+;; offers project operations (switch, vc, dired, remove) instead of only
+;; generic file actions. Marginalia keeps annotating those candidates via
+;; the built-in file annotator (they are directory paths).
+
+(defun projectile--embark-project-file-target (target)
+ "Resolve a `project-file' TARGET to an absolute path under the Projectile
root.
+Return (file . ABSOLUTE) only when TARGET actually exists under the
+current Projectile project root, otherwise nil so the caller can defer to
+Embark's own `project-file' handling. The existence guard keeps the
+integration from ever misresolving a `project-file' candidate that is not
+Projectile's - worst case it does nothing and Embark behaves as before."
+ (when-let* ((root (projectile-project-root))
+ (full (expand-file-name target root))
+ ((file-exists-p full)))
+ (cons 'file full)))
+
+(defun projectile-embark-switch-project (project)
+ "Switch to PROJECT. An Embark action for a project candidate."
+ (interactive "sProject: ")
+ (projectile-switch-project-by-name project))
+
+(defun projectile-embark-vc (project)
+ "Open the VC interface for PROJECT. An Embark action for a project
candidate."
+ (interactive "sProject: ")
+ (projectile-vc project))
+
+(defvar projectile--embark-project-file-prev-transform nil
+ "The `project-file' transformer Embark had before Projectile augmented it.
+Preserved so `projectile--embark-project-file-transform' can defer to it
+for candidates that don't belong to the current Projectile project.")
+
+(defun projectile--embark-project-file-transform (type target)
+ "Embark `project-file' transformer augmenting Embark's own with Projectile.
+Resolves TARGET against the Projectile root when it lives there,
+otherwise defers to the transformer Embark had before (or leaves
+TYPE/TARGET unchanged), so non-Projectile completions are unaffected."
+ (or (projectile--embark-project-file-target target)
+ (and projectile--embark-project-file-prev-transform
+ (funcall projectile--embark-project-file-prev-transform type
target))
+ (cons type target)))
+
+(defvar projectile-embark-project-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "s") #'projectile-embark-switch-project)
+ (define-key map (kbd "v") #'projectile-embark-vc)
+ (define-key map (kbd "d") #'dired)
+ (define-key map (kbd "D") #'projectile-remove-known-project)
+ map)
+ "Embark action keymap for Projectile `projectile-project' candidates.")
+
+(defvar embark-transformer-alist)
+(defvar embark-keymap-alist)
+(defvar embark-general-map)
+
+(defun projectile--embark-setup ()
+ "Wire Projectile's transformer and action keymap into Embark.
+Run from a `with-eval-after-load' on Embark, and idempotent so loading
+Projectile again doesn't stack wrappers."
+ ;; inherit Embark's generic actions (collect, export, ...)
+ (set-keymap-parent projectile-embark-project-map embark-general-map)
+ ;; Augment - never replace - Embark's `project-file' handling. Our
+ ;; transformer only claims a candidate that actually lives under the
+ ;; Projectile root; anything else defers to whatever transformer Embark
+ ;; already had, so non-Projectile `project-file' completions are unaffected.
+ ;; The `eq' guard keeps re-loading Projectile from wrapping our own wrapper.
+ (let ((prev (alist-get 'project-file embark-transformer-alist)))
+ (unless (eq prev #'projectile--embark-project-file-transform)
+ (setq projectile--embark-project-file-prev-transform prev)
+ (setf (alist-get 'project-file embark-transformer-alist)
+ #'projectile--embark-project-file-transform)))
+ (add-to-list 'embark-keymap-alist
+ '(projectile-project . projectile-embark-project-map)))
+
+(with-eval-after-load 'embark (projectile--embark-setup))
+
+(defun projectile--marginalia-setup ()
+ "Teach Marginalia how to annotate `projectile-project' candidates.
+They are directory paths, so the built-in file annotator fits and the
+candidates look exactly like they did under the `file' category. The
+registry is `marginalia-annotators' these days and was
+`marginalia-annotator-registry' in older releases, so register with
+whichever one the installed Marginalia has."
+ (dolist (registry '(marginalia-annotators marginalia-annotator-registry))
+ (when (boundp registry)
+ (add-to-list registry
+ '(projectile-project marginalia-annotate-file builtin
none)))))
+
+(with-eval-after-load 'marginalia (projectile--marginalia-setup))
+
(provide 'projectile)
;;; projectile.el ends here
diff --git a/test/projectile-core-test.el b/test/projectile-core-test.el
index c849046558..098dc842a5 100644
--- a/test/projectile-core-test.el
+++ b/test/projectile-core-test.el
@@ -27,6 +27,15 @@
(require 'projectile-test-helpers)
+;; Embark and Marginalia aren't dependencies, so their registries are usually
+;; unbound here. Declare them special so the integration specs can `let'-bind
+;; them dynamically and watch the setup functions write to them.
+(defvar embark-transformer-alist)
+(defvar embark-keymap-alist)
+(defvar embark-general-map)
+(defvar marginalia-annotators)
+(defvar marginalia-annotator-registry)
+
(describe "projectile-dispatch"
(it "is defined as a command when transient is available"
(assume (require 'transient nil t) "transient is not available")
@@ -316,6 +325,92 @@
(expect (alist-get 'category (cdr (funcall table "" nil 'metadata)))
:to-be 'buffer))))
+(describe "Embark integration"
+ (it "resolves a project-file target that exists under the root"
+ (spy-on 'projectile-project-root :and-return-value "/proj/")
+ (spy-on 'file-exists-p :and-return-value t)
+ (expect (projectile--embark-project-file-target "src/foo.el")
+ :to-equal '(file . "/proj/src/foo.el")))
+
+ (it "declines (returns nil) outside a project, so Embark's own handling wins"
+ (spy-on 'projectile-project-root :and-return-value nil)
+ (expect (projectile--embark-project-file-target "src/foo.el") :to-be nil))
+
+ (it "declines when the target does not live under the project root"
+ (spy-on 'projectile-project-root :and-return-value "/proj/")
+ (spy-on 'file-exists-p :and-return-value nil)
+ (expect (projectile--embark-project-file-target "src/foo.el") :to-be nil))
+
+ (it "defers to Embark's previous transformer when Projectile declines"
+ ;; augment, never replace: a non-Projectile project-file target must reach
+ ;; whatever transformer Embark already had
+ (spy-on 'projectile-project-root :and-return-value nil)
+ (let ((projectile--embark-project-file-prev-transform
+ (lambda (_type target) (cons 'file (concat "/other/" target)))))
+ (expect (projectile--embark-project-file-transform 'project-file "x")
+ :to-equal '(file . "/other/x"))))
+
+ (it "leaves the target unchanged when neither Projectile nor a prior
transformer resolves it"
+ (spy-on 'projectile-project-root :and-return-value nil)
+ (let ((projectile--embark-project-file-prev-transform nil))
+ (expect (projectile--embark-project-file-transform 'project-file "x")
+ :to-equal '(project-file . "x"))))
+
+ (it "binds project actions in the project action keymap"
+ (expect (keymapp projectile-embark-project-map) :to-be-truthy)
+ (expect (lookup-key projectile-embark-project-map "s")
+ :to-be 'projectile-embark-switch-project)
+ (expect (lookup-key projectile-embark-project-map "D")
+ :to-be 'projectile-remove-known-project))
+
+ (it "the switch action delegates to projectile-switch-project-by-name"
+ (spy-on 'projectile-switch-project-by-name)
+ (projectile-embark-switch-project "/proj/")
+ (expect 'projectile-switch-project-by-name :to-have-been-called-with
"/proj/"))
+
+ (it "registers the transformer and the keymap, preserving Embark's own
transformer"
+ (let* ((prev (lambda (type target) (cons type target)))
+ (embark-general-map (make-sparse-keymap))
+ (embark-transformer-alist (list (cons 'project-file prev)))
+ (embark-keymap-alist nil)
+ (projectile--embark-project-file-prev-transform nil))
+ (projectile--embark-setup)
+ (expect (alist-get 'project-file embark-transformer-alist)
+ :to-be #'projectile--embark-project-file-transform)
+ (expect projectile--embark-project-file-prev-transform :to-be prev)
+ (expect (alist-get 'projectile-project embark-keymap-alist)
+ :to-be 'projectile-embark-project-map)
+ (expect (keymap-parent projectile-embark-project-map)
+ :to-be embark-general-map)))
+
+ (it "is idempotent, so re-loading Projectile doesn't wrap its own wrapper"
+ (let* ((prev (lambda (type target) (cons type target)))
+ (embark-general-map (make-sparse-keymap))
+ (embark-transformer-alist (list (cons 'project-file prev)))
+ (embark-keymap-alist nil)
+ (projectile--embark-project-file-prev-transform nil))
+ (projectile--embark-setup)
+ (projectile--embark-setup)
+ (expect projectile--embark-project-file-prev-transform :to-be prev)
+ (expect (length embark-keymap-alist) :to-equal 1))))
+
+(describe "Marginalia integration"
+ (it "registers the file annotator for project candidates"
+ ;; the registry Marginalia actually ships today
+ (let ((marginalia-annotators '((file marginalia-annotate-file builtin
none))))
+ (projectile--marginalia-setup)
+ (expect (alist-get 'projectile-project marginalia-annotators)
+ :to-equal '(marginalia-annotate-file builtin none))))
+
+ (it "also registers with the registry name older Marginalia releases used"
+ (let ((marginalia-annotator-registry '((file marginalia-annotate-file
builtin none))))
+ (projectile--marginalia-setup)
+ (expect (alist-get 'projectile-project marginalia-annotator-registry)
+ :to-equal '(marginalia-annotate-file builtin none))))
+
+ (it "does nothing when neither registry exists, instead of erroring"
+ (expect (projectile--marginalia-setup) :not :to-throw)))
+
(describe "projectile-sort-files"
(it "returns the files unchanged for the default sort order"
(let ((projectile-sort-order 'default))
