Support choosing between multiple narrow-completions-functions

diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 25979bc3909f09436b375591b44eac1ee887e4df..faa0ab207465404eb8ea2b65e6a4bbbe5890f925 100644 (file)
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -222,13 +222,26 @@ type specifier when available."
               (get sym prop)))
           (format "with property %s" prop))))
 
+(defun help--symbol-narrow-by-file ()
+  (let ((file (completing-read "Symbol file: "
+                               (mapcar #'file-name-base (mapcar #'car load-history)))))
+    (cons (lambda (cand &rest _)
+            (let ((sym (if (symbolp cand) cand
+                         (intern (if (stringp cand) cand (car cand))))))
+              (when-let ((sf (symbol-file sym)))
+                (equal file (file-name-base sf)))))
+          (format "file=%s" file))))
+
 (defun help--symbol-completion-table (string pred action)
   (if (eq action 'metadata)
       `(metadata
         ,@(when completions-detailed
             '((affixation-function . help--symbol-completion-table-affixation)))
         (category . symbol-help)
-        (narrow-completions-function . help--symbol-narrow-by-property))
+        (sort-function . minibuffer-sort-alphabetically)
+        (narrow-completions-function
+         . ((?p "property" "Symbol property" help--symbol-narrow-by-property)
+            (?f "file" "Symbol file" help--symbol-narrow-by-file))))
     (when help-enable-completion-autoload
       (let ((prefixes (radix-tree-prefixes (help-definition-prefixes) string)))
         (help--load-prefixes prefixes)))

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 121994f1a18ce4e96c305ed95460ad3d506f6727..f337cda318302b262180a97c706603c3e5ffb843 100644 (file)
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -5702,10 +5702,14 @@ DESC is a string describing predicate PRED."
   (interactive "" minibuffer-mode)
   (let* ((enable-recursive-minibuffers t)
          (filter-desc
-          (funcall (or (completion-metadata-get
-                        (completion--field-metadata (minibuffer-prompt-end))
-                        'narrow-completions-function)
-                       minibuffer-narrow-completions-function))))
+          (funcall
+           (or (when-let ((fun (completion-metadata-get
+                                (completion--field-metadata
+                                 (minibuffer-prompt-end))
+                                'narrow-completions-function)))
+                 (if (functionp fun) fun
+                   (nth 3 (read-multiple-choice "Narrow completions by:" fun))))
+               minibuffer-narrow-completions-function))))
     (minibuffer--add-completions-predicate (car filter-desc) (cdr filter-desc))))
 
 (defun minibuffer-narrow-completions-by-regexp ()