New command 'minibuffer-export'

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index e45c556465d15aeb7b84cf542e9ea6eafe36e61d..1c4a0e5ac6b6ae7071d750d58030ea662e2d363d 100644 (file)
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1160,15 +1160,17 @@ styles for specific categories, such as files, buffers, etc."
   :version "23.1")
 
 (defvar completion-category-defaults
-  '((buffer (styles . (basic substring)))
-    (unicode-name (styles . (basic substring)))
+  '((buffer (styles basic substring)
+            (export-function . minibuffer-export-list-buffers))
+    (file (export-function . minibuffer-export-dired))
+    (unicode-name (styles basic substring))
     ;; A new style that combines substring and pcm might be better,
     ;; e.g. one that does not anchor to bos.
-    (project-file (styles . (substring)))
-    (xref-location (styles . (substring)))
-    (info-menu (styles . (basic substring)))
-    (symbol-help (styles . (basic shorthand substring)))
-    (multiple-choice (styles . (basic substring)) (sort-function . identity))
+    (project-file (styles substring))
+    (xref-location (styles substring))
+    (info-menu (styles basic substring))
+    (symbol-help (styles basic shorthand substring))
+    (multiple-choice (styles basic substring) (sort-function . identity))
     (calendar-month (sort-function . identity))
     (keybinding (sort-function . minibuffer-sort-alphabetically))
     (function (sort-function . minibuffer-sort-alphabetically))
@@ -3480,6 +3482,7 @@ The completion method is determined by `completion-at-point-functions'."
   "C-x ~"     #'minibuffer-toggle-exceptional-candidates
   "C-x C-a"   #'minibuffer-toggle-completions-annotations
   "C-x C-."   #'minibuffer-auto-completion-mode
+  "C-x M-e"   #'minibuffer-export
   "C-p"       #'minibuffer-previous-line-or-completion
   "C-n"       #'minibuffer-next-line-or-completion
   "C-%"       #'minibuffer-query-apply)
@@ -6347,5 +6350,164 @@ interactions is customizable via `minibuffer-regexp-prompts'."
 
 (put 'minibuffer-kill-from-history 'minibuffer-action "delete")
 
+(defvar minibuffer-collect-completions nil)
+(defvar minibuffer-collect-base nil)
+(defvar minibuffer-collect-action nil)
+
+(defun minibuffer-collect-apply (&optional event)
+  "Apply minibuffer action to the candidate at mouse EVENT or at point."
+  (interactive (list last-nonmenu-event) minibuffer-collect-mode)
+  (with-current-buffer (window-buffer (posn-window (event-start event)))
+    (funcall (car minibuffer-collect-action)
+             (concat minibuffer-collect-base
+                     (get-text-property (posn-point (event-start event))
+                                        'completion--string)))))
+
+(defun minibuffer-collect-revert (&rest _)
+  (let ((inhibit-read-only t))
+        (erase-buffer)
+        (delete-all-overlays)
+        (completion--insert-one-column minibuffer-collect-completions nil))
+      (goto-char (point-min)))
+
+(defvar-keymap minibuffer-collect-mode-map
+  :doc "Keymap for Minibuffer Collect mode."
+  "n"   #'next-completion
+  "p"   #'previous-completion
+  "RET" #'minibuffer-collect-apply
+  "<mouse-2>" #'minibuffer-collect-apply
+  "<follow-link>" 'mouse-face)
+
+(define-derived-mode minibuffer-collect-mode special-mode "Minibuffer Collect"
+  "Major mode for minibuffer completion collection buffers."
+  :interactive nil
+  (cursor-face-highlight-mode)
+  (setq-local revert-buffer-function #'minibuffer-collect-revert))
+
+(defvar minibuffer-export-minibuffer nil)
+
+(defun minibuffer--export-data ()
+  (let* ((start (minibuffer-prompt-end))
+         (end (point-max))
+         (string (buffer-substring start end))
+         (md (completion--field-metadata start))
+         (completion-lazy-hilit t)
+         (completions (completion-all-completions
+                       string
+                       minibuffer-completion-table
+                       minibuffer-completion-predicate
+                       (- (point) start)
+                       md))
+         (last (last completions))
+         (base-size (or (cdr last) 0))
+         (full-base (substring string 0 base-size))
+         (base (funcall (or (alist-get 'adjust-base-function md) #'identity)
+                        full-base)))
+    (when last (setcdr last nil))
+    (list completions base md)))
+
+(defun minibuffer-collect (completions base md)
+  (let ((buffer (generate-new-buffer "*Collection*"))
+        (action (minibuffer-action))
+        (sort-fun (completion-metadata-get md 'sort-function))
+        (aff-fun (completion-metadata-get md 'affixation-function))
+        (ann-fun (completion-metadata-get md 'annotation-function)))
+    (setq completions
+          (cond
+           (minibuffer-completions-sort-function
+            (funcall minibuffer-completions-sort-function completions))
+           (sort-fun (funcall sort-fun completions))
+           (t
+            (pcase completions-sort
+              ('nil completions)
+              ('alphabetical (minibuffer-sort-alphabetically completions))
+              ('historical (minibuffer-sort-by-history completions))
+              (_ (funcall completions-sort completions))))))
+    (when minibuffer-completion-annotations
+      (cond
+       (aff-fun
+        (setq completions
+              (funcall aff-fun completions)))
+       (ann-fun
+        (setq completions
+              (mapcar (lambda (s)
+                        (let ((ann (funcall ann-fun s)))
+                          (if ann (list s ann) s)))
+                      completions)))))
+    (with-current-buffer buffer
+      (minibuffer-collect-mode)
+      (let ((inhibit-read-only t))
+        (erase-buffer)
+        (delete-all-overlays)
+        (completion--insert-one-column completions nil))
+      (goto-char (point-min))
+      (setq-local minibuffer-collect-completions completions
+                  minibuffer-collect-base        base
+                  minibuffer-collect-action      action))
+    buffer))
+
+(defvar minibuffer-default-export-function #'minibuffer-collect)
+
+(defun minibuffer-export-dired (files dir &optional _)
+  "Create a Dired buffer listing FILES in DIR."
+  (setq dir (file-name-as-directory (expand-file-name dir)))
+  (dired-noselect
+   (cons dir
+         (mapcar (compose (lambda (file) (file-relative-name file dir))
+                          #'directory-file-name)
+                 (seq-filter #'file-exists-p
+                             (mapcar (lambda (file) (expand-file-name file dir))
+                                     files))))))
+
+(defun minibuffer-export-list-buffers (buffer-names &rest _)
+  (list-buffers-noselect nil (mapcar #'get-buffer buffer-names)))
+
+(defvar minibuffer-export-history nil)
+
+;;;###autoload
+(defun minibuffer-export (&optional export-fn top-level-p)
+  "Create a category-specific export buffer with current completion candidates.
+
+Optional argument EXPORT-FN is a function that creates the export
+buffer.  It should take three arguments: the list of completion
+candidates, as strings; the common base part elided from all candidates,
+also a string; and the completion metadata.  If omitted or nil,
+EXPORT-FN defaults to the `export-function' entry in the completion
+metadata.  If that is also nil, `minibuffer-default-export-function' is
+used instead, which defaults to `minibuffer-collect'.  Interactively,
+without a prefix argument, EXPORT-FN is nil.  With a prefix argument,
+this command prompts for EXPORT-FN in a recursive minibuffer.
+
+If second optional argument TOP-LEVEL-P is non-nil, this function
+exports the current minibuffer.  Otherwise, it exports the minibuffer
+that is the value of `minibuffer-export-minibuffer'.  Interactively,
+TOP-LEVEL-P is non-nil."
+  (interactive (list
+                (when current-prefix-arg
+                  (let ((enable-recursive-minibuffers t)
+                        (minibuffer-export-minibuffer (current-buffer)))
+                    (completing-read
+                     (format-prompt "Export function" "minibuffer-collect")
+                     (completion-table-with-metadata
+                      obarray
+                      '((category . function)
+                        (affixation-function . minibuffer--set-action-affixation)))
+                     #'fboundp
+                     nil nil 'minibuffer-export-history "minibuffer-collect")))
+                t)
+               minibuffer-mode)
+  (when (stringp export-fn) (setq export-fn (read export-fn)))
+  (with-current-buffer
+      (if (or top-level-p (not minibuffer-export-minibuffer))
+          (current-buffer)
+        minibuffer-export-minibuffer)
+    (seq-let (completions base md) (minibuffer--export-data)
+      (display-buffer (funcall (or export-fn
+                                   (completion-metadata-get md 'export-function)
+                                   minibuffer-default-export-function)
+                               completions base md)))))
+
+(put 'minibuffer-export 'minibuffer-action "export")
+
 (provide 'minibuffer)
 ;;; minibuffer.el ends here