Package: emacs;
Reported by: Reuben Thomas <rrt <at> sc3d.org>
Date: Mon, 28 Jul 2014 18:27:01 UTC
Severity: wishlist
Fixed in version 30.0.50
Done: Juri Linkov <juri <at> linkov.net>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Juri Linkov <juri <at> linkov.net> To: 18132 <at> debbugs.gnu.org Subject: bug#18132: Time for a smarter dired-guess-shell-alist-default? (dired-x.el) Date: Thu, 23 Nov 2023 19:49:44 +0200
[Message part 1 (text/plain, inline)]
> To add minimal complexity we could use as an example > the recent design of context-menu-functions that is a hook. > > Then we could create a new customizable hook that can contain > a list of functions that return the command candidates depending > on the argument with file names. > > Then its possible options for such hook could include: > > - xdg-open-function > - mailcap-function that adds mailcap candidates > - dired-x-guess that adds existing dired-guess-shell-alist-default > - Windows-specific candidates from w32-shell-execute > - etc. Here is the implementation:
[shell-command-guess.patch (text/x-diff, inline)]
diff --git a/lisp/simple.el b/lisp/simple.el
index 2e2d73e9bf4..25e0c1cca7f 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4273,8 +4273,63 @@ shell-command-default-error-buffer
is run interactively. A value of nil means that output to stderr and
stdout will be intermixed in the output stream.")
+(defcustom shell-command-guess-functions
+ '(shell-command-guess-mailcap
+ shell-command-guess-xdg
+ 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-xdg)
+ (function-item shell-command-guess-mailcap)
+ (function :tag "Custom function")))
+ :version "30.1")
+
+(defun shell-command-guess (files)
+ "Return a list of shell commands, appropriate for FILES."
+ (let ((commands nil))
+ (run-hook-wrapped 'shell-command-guess-functions
+ (lambda (fun)
+ (setq commands (funcall fun commands files))
+ nil))
+ commands))
+
(declare-function mailcap-file-default-commands "mailcap" (files))
+
+(defun shell-command-guess-mailcap (commands files)
+ (require 'mailcap)
+ (append (mailcap-file-default-commands files) commands))
+
(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
+(declare-function dired-guess-default "dired-aux" (files))
+
+(defun shell-command-guess-dired (commands files)
+ (require 'dired-aux)
+ (append (ensure-list (dired-guess-default 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)
+ (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)))
(defun minibuffer-default-add-shell-commands ()
"Return a list of all commands associated with the current file.
@@ -4284,8 +4339,7 @@ minibuffer-default-add-shell-commands
(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))
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 02194e6ff45..ba6685af7f3 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -763,22 +763,6 @@ dired-trample-file-versions
;;; 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 @@ dired-read-shell-command
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 @@ dired-guess-default
;;;###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
@@ -3856,9 +3835,6 @@ dired-vc-deduce-fileset
(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)
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.