From: Juri Linkov <juri@linkov.net>
To: Eli Zaretskii <eliz@gnu.org>
Cc: 18132@debbugs.gnu.org
Subject: bug#18132: Time for a smarter dired-guess-shell-alist-default? (dired-x.el)
Date: Sat, 25 Nov 2023 20:10:40 +0200 [thread overview]
Message-ID: <86h6l9zorh.fsf@mail.linkov.net> (raw)
In-Reply-To: <83zfz3dyae.fsf@gnu.org> (Eli Zaretskii's message of "Fri, 24 Nov 2023 16:24:41 +0200")
[-- Attachment #1: Type: text/plain, Size: 1383 bytes --]
>> >> > 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:
>> >
>> > Thanks, but please don't put this stuff in simple.el. There's no
>> > reason to have this preloaded in Emacs.
>>
>> I can't find other place to put these 50 lines. I added to simple.el
>> near read-shell-command because it's used by read-shell-command.
>
> IMO, read-shell-command should not by default call these helpers.
It doesn't call them by default.
> If we cannot find a suitable non-preloaded file to put this stuff (is
> subr-x.el okay, for example?), it's okay to start a new file.
Ok, then let's add this to dired-aux.el since it's used in dired.
>> Also shell-command-guess is used by dired-read-shell-command
>> ('!' and '&' on a file in dired).
>
> Likewise here: users should by default be able to invoke these Dired
> commands without automatically loading those helpers, which come with
> quite tangible ballast. For Dired, this is perhaps less important,
> since Dired itself is an optional package, but still: I think it's
> wrong to do this by default.
Ok, I removed mailcap and xdg from defaults:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: shell-command-guess.patch --]
[-- Type: text/x-diff, Size: 5988 bytes --]
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 02194e6ff45..0c01b24c2db 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -763,22 +763,6 @@ dired-trample-file-versions
\f
;;; 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
@@ -1340,6 +1319,64 @@ dired-guess-shell-command
;; 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-xdg)
+ (function-item shell-command-guess-mailcap)
+ (function :tag "Custom function")))
+ :group 'dired
+ :version "30.1")
+
+;;;###autoload
+(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)))
+
\f
;;; Commands that delete or redisplay part of the dired buffer
@@ -3856,9 +3893,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")
-
\f
(provide 'dired-aux)
diff --git a/lisp/simple.el b/lisp/simple.el
index 02c68912dba..f27c3042d9a 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4273,7 +4273,6 @@ 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.")
-(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 ()
@@ -4284,8 +4283,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))
next prev parent reply other threads:[~2023-11-25 18:10 UTC|newest]
Thread overview: 61+ messages / expand[flat|nested] mbox.gz Atom feed top
2014-07-28 18:26 bug#18132: Time for a smarter dired-guess-shell-alist-default? (dired-x.el) Reuben Thomas
2014-07-28 18:44 ` bug#18132: Sample code Reuben Thomas
2014-07-29 23:49 ` bug#18132: Time for a smarter dired-guess-shell-alist-default? (dired-x.el) Juri Linkov
2014-07-30 9:12 ` Reuben Thomas
2014-07-30 16:32 ` Juri Linkov
2014-07-30 16:44 ` Reuben Thomas
2014-08-04 23:45 ` Juri Linkov
2014-08-05 9:41 ` Reuben Thomas
2021-10-23 5:25 ` Stefan Kangas
2021-10-23 7:44 ` Eli Zaretskii
2021-10-23 8:16 ` Stefan Kangas
2021-10-23 8:34 ` Eli Zaretskii
2021-10-23 9:48 ` Stefan Kangas
2021-10-23 11:48 ` Eli Zaretskii
2021-10-23 13:06 ` Reuben Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-10-23 13:20 ` Eli Zaretskii
2021-10-23 13:01 ` Reuben Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-10-23 13:56 ` Stefan Kangas
2021-10-23 14:03 ` Reuben Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-10-23 15:45 ` Stefan Kangas
2021-10-23 17:17 ` Gregory Heytings
2021-10-23 20:53 ` Reuben Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-10-24 6:02 ` Eli Zaretskii
2021-10-24 7:56 ` Juri Linkov
2023-11-23 17:49 ` Juri Linkov
2023-11-23 19:40 ` Eli Zaretskii
2023-11-24 7:51 ` Juri Linkov
2023-11-24 14:24 ` Eli Zaretskii
2023-11-25 18:10 ` Juri Linkov [this message]
2023-11-26 10:37 ` Eli Zaretskii
2023-11-27 17:32 ` Juri Linkov
2023-11-28 17:05 ` Juri Linkov
2023-11-28 17:35 ` Eli Zaretskii
2023-11-29 7:09 ` Juri Linkov
2023-11-29 13:07 ` Eli Zaretskii
2023-12-02 17:44 ` Juri Linkov
2023-12-02 18:37 ` Drew Adams
2023-12-03 17:04 ` Juri Linkov
2023-12-03 21:16 ` Drew Adams
2023-12-06 17:28 ` Juri Linkov
2023-12-07 17:33 ` Juri Linkov
2023-12-07 17:48 ` Eli Zaretskii
2023-12-08 7:37 ` Juri Linkov
2023-12-08 8:08 ` Eli Zaretskii
2023-12-09 17:13 ` Juri Linkov
2024-05-22 6:16 ` Juri Linkov
2024-05-22 12:42 ` Eli Zaretskii
2024-05-23 6:19 ` Juri Linkov
2024-05-23 7:16 ` Eli Zaretskii
2024-05-23 17:31 ` Juri Linkov
2024-05-23 18:15 ` Eli Zaretskii
2024-05-24 6:44 ` Juri Linkov
2024-05-24 7:31 ` Eli Zaretskii
2024-05-24 17:56 ` Juri Linkov
2021-10-23 17:57 ` Howard Melman
2021-10-23 18:29 ` Juri Linkov
2021-10-23 19:22 ` bug#18132: [External] : " Drew Adams
2021-10-24 16:35 ` Howard Melman
2021-10-24 19:08 ` Juri Linkov
2021-10-24 5:10 ` Thierry Volpiatto
2014-07-30 3:56 ` Eli Zaretskii
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=86h6l9zorh.fsf@mail.linkov.net \
--to=juri@linkov.net \
--cc=18132@debbugs.gnu.org \
--cc=eliz@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.