From: Boruch Baum <boruch_baum@gmx.com>
To: 48071@debbugs.gnu.org
Subject: bug#48071: 28.0.50: dired-guess-default: comply with docstring options [PATCH]
Date: Tue, 27 Apr 2021 14:53:40 -0400 [thread overview]
Message-ID: <20210427185340.e4zluvf3z5ywbpqn@E15-2016.optimum.net> (raw)
[-- Attachment #1: Type: text/plain, Size: 709 bytes --]
The docstring for dired-guess-default claims it should handle multiple
instances of COMMAND each of which could be a STRING or a FUNCTION which
evaluates to a STRING ...
The attached patch does that. It also weeds out strings that don't represent
valid programs on the host machine.
It turned out that function dired-guess-shell-command wasn't ready for
the multiple responses, so the patch corrects that as well.
My package diredc has an additional feature of an option for a universal
fall-back. My memory is that the emacs developers rejected the idea when
I originally proposed it, so it's not in this patch.
--
hkp://keys.gnupg.net
CA45 09B5 5351 7C11 A9D1 7286 0036 9E45 1595 8BC0
[-- Attachment #2: dired-guess-default.patch --]
[-- Type: text/x-diff, Size: 3800 bytes --]
diff --git a/dired-x.el b/dired-x.el
index 80a266f..d122027 100644
--- a/dired-x.el
+++ b/dired-x.el
@@ -1039,64 +1039,50 @@ REGEXP is matched case-sensitively."
(defun dired-guess-default (files)
"Return a shell command, or a list of commands, appropriate for FILES.
See `dired-guess-shell-alist-user'."
-
(let* ((case-fold-search dired-guess-shell-case-fold-search)
;; Prepend the user's alist to the default alist.
(alist (append dired-guess-shell-alist-user
dired-guess-shell-alist-default))
- (file (car files))
- (flist (cdr files))
elt regexp cmds)
-
- ;; Find the first match in the alist for first file in FILES.
- (while alist
- (setq elt (car alist)
- regexp (car elt)
- alist (cdr alist))
- (if (string-match-p regexp file)
- (setq cmds (cdr elt)
- alist nil)))
-
- ;; If more than one file, see if all of FILES match regular expression.
- (while (and flist
- (string-match-p regexp (car flist)))
- (setq flist (cdr flist)))
-
- ;; If flist is still non-nil, then do not guess since this means that not
- ;; all the files in FILES were matched by the regexp.
- (setq cmds (and (not flist) cmds))
-
- ;; Return commands or nil if flist is still non-nil.
- ;; Evaluate the commands in order that any logical testing will be done.
- (if (cdr cmds)
- (delete-dups (mapcar (lambda (cmd) (eval cmd `((file . ,file)))) cmds))
- (eval (car cmds) `((file . ,file)))))) ; single command
+ (cl-loop
+ for elt in alist
+ do (setq regexp (car elt))
+ (cl-loop
+ for file in files
+ always (string-match-p regexp file)
+ finally
+ (cl-loop
+ for cmd in (cdr elt) do
+ (unless (stringp cmd)
+ (setq cmd (condition-case nil
+ (funcall cmd `((file . ,file)))
+ (error nil))))
+ (and (stringp cmd)
+ (executable-find cmd)
+ (push cmd cmds)))))
+ (nreverse (delete-dups cmds))))
(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))
- default-list val)
+ val)
(if (null default)
;; Nothing to guess
(read-shell-command prompt nil 'dired-shell-command-history)
(setq prompt (replace-regexp-in-string ": $" " " prompt))
- (if (listp default)
+ (if (cdr default)
;; More than one guess
- (setq default-list default
- default (car default)
- prompt (concat
+ (setq prompt (concat
prompt
- (format "{%d guesses} " (length default-list))))
- ;; Just one guess
- (setq default-list (list default)))
+ (format "{%d guesses} " (length default-list)))))
;; Put the first guess in the prompt but not in the initial value.
- (setq prompt (concat prompt (format "[%s]: " default)))
+ (setq prompt (concat prompt (format "[%s]: " (car default))))
;; All guesses can be retrieved with M-n
(setq val (read-shell-command prompt nil
'dired-shell-command-history
- default-list))
+ default))
;; If we got a return, then return default.
- (if (equal val "") default val))))
+ (if (equal val "") (car default) val))))
\f
;;; RELATIVE SYMBOLIC LINKS.
next reply other threads:[~2021-04-27 18:53 UTC|newest]
Thread overview: 13+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-04-27 18:53 Boruch Baum [this message]
2021-07-20 14:17 ` bug#48071: 28.0.50: dired-guess-default: comply with docstring options [PATCH] Lars Ingebrigtsen
2021-07-21 1:53 ` Michael Heerdegen
2021-07-21 2:16 ` Michael Heerdegen
2021-07-21 11:04 ` Lars Ingebrigtsen
2021-07-21 23:28 ` Michael Heerdegen
2021-07-22 3:28 ` Michael Heerdegen
2021-07-22 12:18 ` Lars Ingebrigtsen
2021-07-22 23:21 ` Michael Heerdegen
2021-07-23 13:04 ` Lars Ingebrigtsen
2021-07-22 12:10 ` Lars Ingebrigtsen
2021-07-21 11:12 ` Lars Ingebrigtsen
2021-07-21 23:22 ` Michael Heerdegen
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
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20210427185340.e4zluvf3z5ywbpqn@E15-2016.optimum.net \
--to=boruch_baum@gmx.com \
--cc=48071@debbugs.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 public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).