From: Eshel Yaron <me@eshelyaron.com>
Date: Tue, 26 Dec 2023 15:14:58 +0000 (+0100)
Subject: Narrow buffer completions by major mode with 'C-x n m'
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=67701641de1eb4555d81634c8e6b9a8d0a86d6c0;p=emacs.git

Narrow buffer completions by major mode with 'C-x n m'

* lisp/minibuffer.el (buffers-except-current-if-switching): Doc fix.
(minibuffer-narrow-buffer-completions): New function.
* src/minibuf.c (Finternal_complete_buffer): Use it.
(syms_of_minibuf): Update.
---

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index f3cb3969091..4e3d4e316ad 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -3638,12 +3638,66 @@ See `read-file-name' for the meaning of the arguments."
                             (minibuffer-maybe-quote-filename val))))
 	val))))
 
+(defun minibuffer-narrow-buffer-completions ()
+  "Restrict buffer name completions by candidate major mode.
+
+Completion collection function `internal-complete-buffer' uses
+this function as its `narrow-completions-function'."
+  (let* ((names
+          (let* ((beg-end (minibuffer--completion-boundaries))
+                 (beg (car beg-end)) (end (cdr beg-end))
+                 (input (buffer-substring beg end))
+                 (all (completion-all-completions
+                       input
+                       minibuffer-completion-table
+                       minibuffer-completion-predicate
+                       (- (point) beg)
+                       (completion--field-metadata beg)))
+                 (last (last all)))
+            (setcdr last nil)
+            all))
+         (modes (delete-dups
+                 (mapcar
+                  (apply-partially #'string-replace "-mode" "")
+                  (mapcar
+                   #'symbol-name
+                   (mapcar
+                    (apply-partially #'buffer-local-value 'major-mode)
+                    (mapcar #'get-buffer names))))))
+         (max (seq-max (mapcar #'string-width modes)))
+         (name
+          (completing-read
+           "Restrict to mode: "
+           (lambda (string pred action)
+             (if (eq action 'metadata)
+                 (list 'metadata
+                       (cons
+                        'annotation-function
+                        (lambda (cand)
+                          (let* ((sym (intern (concat cand "-mode")))
+                                 (doc (ignore-errors (documentation sym))))
+                            (when doc
+                              (concat
+                               (propertize
+                                " "
+                                'display `(space :align-to ,(+ max 2)))
+                               (propertize
+                                (substring doc 0 (string-search "\n" doc))
+                                'face 'completions-annotations)))))))
+               (complete-with-action action modes string pred)))
+           nil t))
+         (mode (intern (concat name "-mode"))))
+    (cons
+     (lambda (cand)
+       (eq mode (buffer-local-value 'major-mode (cdr cand))))
+     (format "mode %s" (capitalize name)))))
+
 (defun buffers-except-current-if-switching (string pred action)
-  "Perform completion ACTION of STRING subject to PRED.
+  "Perform completion ACTION on STRING subject to PRED.
 
 This is similar to `internal-complete-buffer', except that this
-function excludes `read-buffer-to-switch-current-buffer' when it
-is not nil."
+function excludes `read-buffer-to-switch-current-buffer' when
+that variable is not nil."
   (let* ((except (when read-buffer-to-switch-current-buffer
                    (buffer-name read-buffer-to-switch-current-buffer)))
          (predicate
diff --git a/src/minibuf.c b/src/minibuf.c
index f9aef1bac85..2c8cca1e9c1 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -2186,9 +2186,11 @@ If FLAG is nil, invoke `try-completion'; if it is t, invoke
   else if (EQ (flag, Qlambda))
     return Ftest_completion (string, Vbuffer_alist, predicate);
   else if (EQ (flag, Qmetadata))
-    return list3 (Qmetadata,
+    return list4 (Qmetadata,
                   Fcons (Qcategory, Qbuffer),
-                  Fcons (Qcycle_sort_function, Qidentity));
+                  Fcons (Qcycle_sort_function, Qidentity),
+		  Fcons (Qnarrow_completions_function,
+			 Qminibuffer_narrow_buffer_completions));
   else
     return Qnil;
 }
@@ -2323,6 +2325,8 @@ syms_of_minibuf (void)
   DEFSYM (Qcase_fold_search, "case-fold-search");
   DEFSYM (Qmetadata, "metadata");
   DEFSYM (Qcycle_sort_function, "cycle-sort-function");
+  DEFSYM (Qnarrow_completions_function, "narrow-completions-function");
+  DEFSYM (Qminibuffer_narrow_buffer_completions, "minibuffer-narrow-buffer-completions");
 
   /* A frame parameter.  */
   DEFSYM (Qminibuffer_exit, "minibuffer-exit");