unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
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.

             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).