Add consult-ghostel-sources and ghostel-annotation-function

CHANGELOG.md

@@ -4,6 +4,13 @@ All notable changes to this project will be documented in this file.
 
 ## [Unreleased]
 
+### Added
+- `consult-ghostel-sources` and `consult-ghostel-project-sources` list the
+  sources of `consult-ghostel` and `consult-ghostel-project`, so other
+  packages can add one.
+- `ghostel-annotation-function` adds a buffer's own text to its
+  annotation in the buffer pickers.
+
 ### Fixed
 - A paste reaches `ghostel-pty-out-function` in one call.  Its brackets
   and text were separate calls, and over a slow link zsh ended the paste

README.md

@@ -80,7 +80,9 @@ Like normal Emacs `C-k'.  Kill to end of line and put content in kill-ring."
          ("M" . ghostel-project-list-buffers))
   :config
   (add-to-list 'project-switch-commands '(ghostel-project "Ghostel") t)
-  (add-to-list 'project-switch-commands '(ghostel-project-list-buffers "Ghostel buffers") t))
+  (add-to-list 'project-switch-commands '(ghostel-project-list-buffers "Ghostel buffers") t)
+  ;; Have `project-kill-buffers' (C-x p k) kill the project's terminals too
+  (add-to-list 'project-kill-buffer-conditions '(derived-mode . ghostel-mode)))
 ```
 
 Now you can `C-x m` to open a Ghostel buffer, or

README.org

@@ -66,7 +66,9 @@ Like normal Emacs `C-k'.  Kill to end of line and put content in kill-ring."
          ("M" . ghostel-project-list-buffers))
   :config
   (add-to-list 'project-switch-commands '(ghostel-project "Ghostel") t)
-  (add-to-list 'project-switch-commands '(ghostel-project-list-buffers "Ghostel buffers") t))
+  (add-to-list 'project-switch-commands '(ghostel-project-list-buffers "Ghostel buffers") t)
+  ;; Have `project-kill-buffers' (C-x p k) kill the project's terminals too
+  (add-to-list 'project-kill-buffer-conditions '(derived-mode . ghostel-mode)))
 
 (use-package ghostel-eshell
   :hook (eshell-load . ghostel-eshell-visual-command-mode))
@@ -2061,6 +2063,12 @@ narrow key (or any other source property) can be changed
 with =consult-customize=, e.g.
 ~(consult-customize consult-ghostel-source-hidden :narrow ?t)~.
 
+#+vindex: consult-ghostel-sources
+#+vindex: consult-ghostel-project-sources
+=consult-ghostel= itself picks from the sources in =consult-ghostel-sources=
+and =consult-ghostel-project= from those in =consult-ghostel-project-sources=,
+lists like =consult-buffer-sources= that other packages can add a source to.
+
 The mode also makes =consult-line= match across soft line wraps in Ghostel
 buffers: rows joined by wrap newlines become one search candidate, so a path or
 command that wrapped mid-word is still found.  It also adds a /Ghostel/ group
@@ -2270,6 +2278,10 @@ status ([[#notifications-and-progress][Notifications and Progress]]) comes first
 =ghostel-annotation-title-width= caps the title at 30 columns; set it to nil
 for the full title.
 
+#+vindex: ghostel-annotation-function
+A buffer's =ghostel-annotation-function= is called in that buffer without
+arguments; the string it returns goes between the status and the title.
+
 [[https://github.com/minad/marginalia][Marginalia]] replaces annotations for the whole =buffer= category with its own,
 which hides the title.  The [[#consult-integration][consult-ghostel]] package handles this
 automatically; without it, you can prepend the title to marginalia's annotator
@@ -2356,6 +2368,13 @@ project-prefixed buffer name.  To make it available from =project-switch-project
 (add-to-list 'project-switch-commands '(ghostel-project "Ghostel") t)
 #+end_src
 
+=project-kill-buffers= (=C-x p k=) leaves Ghostel buffers alone.  To have it
+kill a project's terminals too:
+
+#+begin_src emacs-lisp
+(add-to-list 'project-kill-buffer-conditions '(derived-mode . ghostel-mode))
+#+end_src
+
 * Running tests
 :properties:
 :custom_id: running-tests

extensions/consult-ghostel/consult-ghostel.el

@@ -69,6 +69,20 @@
 (declare-function ghostel-project "ghostel-project" (&optional arg))
 (declare-function ghostel-project-buffer-list "ghostel-project")
 
+(defcustom consult-ghostel-sources
+  '(consult-ghostel-source consult-ghostel-source-new)
+  "Sources of `consult-ghostel', as in `consult-buffer-sources'.
+A name that matches no candidate goes to the `:new' function of the
+narrowed-to source, else of the first source that is not hidden."
+  :type '(repeat symbol)
+  :group 'ghostel)
+
+(defcustom consult-ghostel-project-sources
+  '(consult-ghostel-project-source consult-ghostel-project-source-new)
+  "Sources of `consult-ghostel-project', as in `consult-ghostel-sources'."
+  :type '(repeat symbol)
+  :group 'ghostel)
+
 (defvar consult-ghostel--buffer-history nil
   "Minibuffer history for the buffer-picking `consult-ghostel' commands.")
 
@@ -203,8 +217,7 @@ one.  IDENTITY is passed through to `ghostel-create'."
 
 (defun consult-ghostel--switch (sources prompt)
   "Pick a ghostel buffer from SOURCES via `consult--multi' with PROMPT.
-Previews candidates; a non-matching name creates a new terminal via the
-first source's `:new' handler."
+Previews candidates; a non-matching name goes to a source's `:new' handler."
   (let ((consult--buffer-display #'consult-ghostel--display))
     (consult--multi sources
                     :require-match (confirm-nonexistent-file-or-buffer)
@@ -223,9 +236,7 @@ that numbered terminal)."
   (interactive "P")
   (if arg
       (ghostel arg)
-    (consult-ghostel--switch
-     '(consult-ghostel-source consult-ghostel-source-new)
-     "Ghostel buffer: ")))
+    (consult-ghostel--switch consult-ghostel-sources "Ghostel buffer: ")))
 
 ;;;###autoload
 (defun consult-ghostel-status ()
@@ -248,9 +259,8 @@ Project membership is determined by `ghostel-project-buffer-scope'."
     ;; submit, so refuse before entering the minibuffer.
     (unless (consult--project-root)
       (user-error "No current project"))
-    (consult-ghostel--switch
-     '(consult-ghostel-project-source consult-ghostel-project-source-new)
-     "Project ghostel buffer: ")))
+    (consult-ghostel--switch consult-ghostel-project-sources
+                             "Project ghostel buffer: ")))
 
 ;;; Shell command history
 

lisp/ghostel-project.el

@@ -11,6 +11,11 @@
 ;; `ghostel-project-buffer-scope'.
 ;;
 ;;   (add-to-list 'project-switch-commands '(ghostel-project "Ghostel") t)
+;;
+;; `project-kill-buffers' leaves ghostel buffers alone unless they are
+;; among its conditions:
+;;
+;;   (add-to-list 'project-kill-buffer-conditions '(derived-mode . ghostel-mode))
 
 ;;; Code:
 

lisp/ghostel.el

@@ -5637,21 +5637,33 @@ the first or last entry depending on DIRECTION."
                   "No ghostel buffers"
                   "Only one ghostel buffer"))
 
+(defvar-local ghostel-annotation-function nil
+  "Function adding text to this buffer's completion annotation.
+It is called in the buffer without arguments and returns a string or nil,
+which `ghostel-annotate-buffer' shows before the terminal title.")
+
 (defun ghostel-annotate-buffer (name)
   "Return a completion annotation for the ghostel buffer named NAME, or nil.
-The program status as in the buffer's mode line, then the terminal
-title capped at `ghostel-annotation-title-width' columns."
+The program status as in the buffer's mode line, the text of
+`ghostel-annotation-function', then the terminal title capped at
+`ghostel-annotation-title-width' columns."
   (when-let* ((buffer (get-buffer name)))
-    (let ((status (with-current-buffer buffer (ghostel-status--text)))
-          (title (buffer-local-value 'ghostel-title buffer)))
-      (when (or status title)
-        ;; The label quotes percents for the mode line.
-        (concat (and status (string-replace "%%" "%" status))
-                (when title
-                  (concat "  " (if ghostel-annotation-title-width
-                                   (truncate-string-to-width
-                                    title ghostel-annotation-title-width nil nil t)
-                                 title))))))))
+    (with-current-buffer buffer
+      (let ((status (ghostel-status--text))
+            (extra (and ghostel-annotation-function
+                        (condition-case-unless-debug nil
+                            (funcall ghostel-annotation-function)
+                          (error nil))))
+            (title ghostel-title))
+        (when (or status extra title)
+          ;; The label quotes percents for the mode line.
+          (concat (and status (string-replace "%%" "%" status))
+                  (and extra (concat "  " extra))
+                  (when title
+                    (concat "  " (if ghostel-annotation-title-width
+                                     (truncate-string-to-width
+                                      title ghostel-annotation-title-width nil nil t)
+                                   title)))))))))
 
 (defun ghostel--read-buffer (prompt bufs)
   "Prompt with PROMPT for one of BUFS via `read-buffer'.

test/consult-ghostel-test.el

@@ -233,6 +233,21 @@ empty picker and crashes on submit."
         (consult-ghostel-project))
       (should (memq 'consult-ghostel-project-source-new got)))))
 
+(ert-deftest consult-ghostel-test-sources ()
+  "The pickers pick from their source lists."
+  (let ((consult-ghostel-sources '(consult-ghostel-source my-source))
+        (consult-ghostel-project-sources
+         '(consult-ghostel-project-source my-project-source))
+        got)
+    (cl-letf (((symbol-function 'consult--multi)
+               (lambda (sources &rest _) (setq got sources) nil))
+              ((symbol-function 'consult--project-root)
+               (lambda (&optional _) "/tmp/")))
+      (consult-ghostel)
+      (should (equal got '(consult-ghostel-source my-source)))
+      (consult-ghostel-project)
+      (should (equal got '(consult-ghostel-project-source my-project-source))))))
+
 (ert-deftest consult-ghostel-test-project-new-identity ()
   "Project create-on-miss allocates in `ghostel-project's slot family.
 The identity carries no `name' key, so `ghostel-project' finds and

test/ghostel-buffers-test.el

@@ -230,6 +230,21 @@ Each BINDING is (VAR NAME [DIR [IDENTITY]])."
     (should-not (ghostel-annotate-buffer (buffer-name a))))
   (should-not (ghostel-annotate-buffer "*ghostel-no-such-buffer*")))
 
+(ert-deftest ghostel-test-annotate-buffer-function ()
+  "`ghostel-annotation-function' adds its text before the title.
+It runs in the annotated buffer; nil and errors add nothing."
+  (ghostel-buffers-test--with-bufs ((a "*ghostel-a*"))
+    (with-current-buffer a
+      (setq-local ghostel-annotation-function #'buffer-name))
+    (should (equal "  *ghostel-a*" (ghostel-annotate-buffer (buffer-name a))))
+    (with-current-buffer a (setq-local ghostel-title "make test"))
+    (should (equal "  *ghostel-a*  make test"
+                   (ghostel-annotate-buffer (buffer-name a))))
+    (dolist (fn (list #'ignore (lambda () (error "Boom"))))
+      (with-current-buffer a (setq-local ghostel-annotation-function fn))
+      (let ((debug-on-error nil))
+        (should (equal "  make test" (ghostel-annotate-buffer (buffer-name a))))))))
+
 (ert-deftest ghostel-test-read-buffer-annotates ()
   "`ghostel--read-buffer' exposes `ghostel-annotate-buffer' to completion."
   (ghostel-buffers-test--with-bufs ((a "*ghostel-a*"))