From: Juri Linkov Date: Mon, 27 Nov 2023 17:32:10 +0000 (+0200) Subject: New user option 'shell-command-guess-functions' (bug#18132) X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b8d4242e8bdbdb6ca364bf0760e50689f6a6e118;p=emacs.git 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'. --- 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))