master b8d4242e8bd 1/2: New user option 'shell-command-guess-functions' (bug#18132)

[Juri Linkov]

branch: master
commit b8d4242e8bdbdb6ca364bf0760e50689f6a6e118
Author: Juri Linkov <juri@linkov.net>
Commit: Juri Linkov <juri@linkov.net>

    New user option 'shell-command-guess-functions' (bug#18132)
    
    * lisp/dired-aux.el (dired-minibuffer-default-add-shell-commands):
    Remove function since now mailcap commands are available
    by shell-command-guess-mailcap for shell-command-guess
    used by dired-guess-shell-command.
    (dired-read-shell-command): Don't set minibuffer-default-add-function
    to dired-minibuffer-default-add-shell-commands.
    (dired-guess-shell-command): Replace dired-guess-default
    with shell-command-guess.
    (shell-command-guess-functions): New defcustom.
    (shell-command-guess, shell-command-guess-dired)
    (shell-command-guess-mailcap, shell-command-guess-xdg):
    New functions.
    
    * lisp/simple.el (minibuffer-default-add-shell-commands):
    Use 'shell-command-guess' instead of requiring 'mailcap'
    with 'mailcap-file-default-commands'.  Remove 'interactive'.
---
 etc/NEWS          |  6 ++++
 lisp/dired-aux.el | 93 ++++++++++++++++++++++++++++++++++++++-----------------
 lisp/simple.el    | 10 +++---
 3 files changed, 75 insertions(+), 34 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index fd633fad6fb..6661ac70e1b 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -503,6 +503,12 @@ hidden and an ellipsis is displayed instead.  A value of 
'window'
 means using the right edge of window as the display restriction.  The
 default is nil.
 
+*** New user option 'shell-command-guess-functions'.
+It defines how to populate a list of commands available
+for 'M-!', 'M-&', '!', '&' based on marked files in Dired.
+Possible backends are 'dired-guess-default', MIME types,
+XDG configuration.
+
 ** Ediff
 
 ---
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 02194e6ff45..47e97c96ce1 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -763,22 +763,6 @@ with a prefix argument."
 
 ;;; Shell commands
 
-(declare-function mailcap-file-default-commands "mailcap" (files))
-
-(defvar dired-aux-files)
-
-(defun dired-minibuffer-default-add-shell-commands ()
-  "Return a list of all commands associated with current Dired files.
-This function is used to add all related commands retrieved by `mailcap'
-to the end of the list of defaults just after the default value."
-  (interactive)
-  (let ((commands (and (boundp 'dired-aux-files)
-                      (require 'mailcap nil t)
-                      (mailcap-file-default-commands dired-aux-files))))
-    (if (listp minibuffer-default)
-       (append minibuffer-default commands)
-      (cons minibuffer-default commands))))
-
 ;; This is an extra function so that you can redefine it, e.g., to use gmhist.
 (defun dired-read-shell-command (prompt arg files)
   "Read a Dired shell command.
@@ -789,14 +773,9 @@ file names.  The result is used as the prompt.
 
 Use `dired-guess-shell-command' to offer a smarter default choice
 of shell command."
-  (minibuffer-with-setup-hook
-      (lambda ()
-       (setq-local dired-aux-files files)
-       (setq-local minibuffer-default-add-function
-                    #'dired-minibuffer-default-add-shell-commands))
-    (setq prompt (format prompt (dired-mark-prompt arg files)))
-    (dired-mark-pop-up nil 'shell files
-                       'dired-guess-shell-command prompt files)))
+  (setq prompt (format prompt (dired-mark-prompt arg files)))
+  (dired-mark-pop-up nil 'shell files
+                     'dired-guess-shell-command prompt files))
 
 ;;;###autoload
 (defcustom dired-confirm-shell-command t
@@ -1316,7 +1295,7 @@ See `dired-guess-shell-alist-user'."
 ;;;###autoload
 (defun dired-guess-shell-command (prompt files)
   "Ask user with PROMPT for a shell command, guessing a default from FILES."
-  (let ((default (dired-guess-default files))
+  (let ((default (shell-command-guess files))
         default-list val)
     (if (null default)
         ;; Nothing to guess
@@ -1340,6 +1319,67 @@ See `dired-guess-shell-alist-user'."
       ;; If we got a return, then return default.
       (if (equal val "") default val))))
 
+(defcustom shell-command-guess-functions
+  '(shell-command-guess-dired)
+  "List of functions that guess shell commands for files.
+Each function receives a list of commands and a list of file names
+and should return the same list of commands with changes
+such as added new commands."
+  :type '(repeat
+          (choice (function-item shell-command-guess-dired)
+                  (function-item shell-command-guess-mailcap)
+                  (function-item shell-command-guess-xdg)
+                  (function :tag "Custom function")))
+  :group 'dired
+  :version "30.1")
+
+;;;###autoload
+(defun shell-command-guess (files)
+  "Return a list of shell commands, appropriate for FILES.
+The list is populated by calling functions from
+`shell-command-guess-functions'.  Each function receives the list
+of commands and the list of file names and returns the same list
+after adding own commands to the composite list."
+  (let ((commands nil))
+    (run-hook-wrapped 'shell-command-guess-functions
+                      (lambda (fun)
+                        (setq commands (funcall fun commands files))
+                        nil))
+    commands))
+
+(defun shell-command-guess-dired (commands files)
+  "Populate COMMANDS using `dired-guess-default'."
+  (append (ensure-list (dired-guess-default files)) commands))
+
+(declare-function mailcap-file-default-commands "mailcap" (files))
+
+(defun shell-command-guess-mailcap (commands files)
+  "Populate COMMANDS by MIME types of FILES."
+  (require 'mailcap)
+  (append (mailcap-file-default-commands files) commands))
+
+(declare-function xdg-mime-apps "xdg" (mime))
+(declare-function xdg-desktop-read-file "xdg" (filename &optional group))
+
+(defun shell-command-guess-xdg (commands files)
+  "Populate COMMANDS by XDG configuration for FILES."
+  (require 'xdg)
+  (let* ((xdg-mime (when (executable-find "xdg-mime")
+                     (string-trim-right
+                      (shell-command-to-string
+                       (concat "xdg-mime query filetype " (car files))))))
+         (xdg-mime-apps (unless (string-empty-p xdg-mime)
+                          (xdg-mime-apps xdg-mime)))
+         (xdg-commands
+          (mapcar (lambda (desktop)
+                    (setq desktop (xdg-desktop-read-file desktop))
+                    (propertize
+                     (replace-regexp-in-string
+                      " .*" "" (gethash "Exec" desktop))
+                     'name (gethash "Name" desktop)))
+                  xdg-mime-apps)))
+    (append xdg-commands commands)))
+
 
 ;;; Commands that delete or redisplay part of the dired buffer
 
@@ -3856,9 +3896,6 @@ case, the VERBOSE argument is ignored."
         (setq model (vc-checkout-model backend only-files-list))))
     (list backend files only-files-list state model)))
 
-(define-obsolete-function-alias 'minibuffer-default-add-dired-shell-commands
-  #'dired-minibuffer-default-add-shell-commands "29.1")
-
 
 (provide 'dired-aux)
 
diff --git a/lisp/simple.el b/lisp/simple.el
index 02c68912dba..35bce6ab4b8 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4273,19 +4273,17 @@ This buffer is used when `shell-command' or 
`shell-command-on-region'
 is run interactively.  A value of nil means that output to stderr and
 stdout will be intermixed in the output stream.")
 
-(declare-function mailcap-file-default-commands "mailcap" (files))
 (declare-function dired-get-filename "dired" (&optional localp 
no-error-if-not-filep))
 
 (defun minibuffer-default-add-shell-commands ()
   "Return a list of all commands associated with the current file.
-This function is used to add all related commands retrieved by `mailcap'
-to the end of the list of defaults just after the default value."
-  (interactive)
+This function is used to add all related commands retrieved by
+`shell-command-guess' to the end of the list of defaults just
+after the default value."
   (let* ((filename (if (listp minibuffer-default)
                       (car minibuffer-default)
                     minibuffer-default))
-        (commands (and filename (require 'mailcap nil t)
-                       (mailcap-file-default-commands (list filename)))))
+        (commands (and filename (shell-command-guess (list filename)))))
     (setq commands (mapcar (lambda (command)
                             (concat command " " filename))
                           commands))