all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: Stefan Monnier <monnier@IRO.UMontreal.CA>
To: Tino Calancha <tino.calancha@gmail.com>
Cc: 27631@debbugs.gnu.org, "積丹尼 Dan Jacobson" <jidanni@jidanni.org>
Subject: bug#27631: dired a/*/b
Date: Wed, 02 Aug 2017 13:30:40 -0400	[thread overview]
Message-ID: <jwvini5apbo.fsf-monnier+bug#27631@gnu.org> (raw)
In-Reply-To: <8737a0yjbg.fsf@calancha-pc> (Tino Calancha's message of "Thu, 13 Jul 2017 14:52:51 +0900")

>> Maybe make dired and list-directory deal with wildcards in positions like
>> ~/.config/chromium/Default/*/menkifleemblimdogmoihpfopnplikde/
> Thank you for the report.
> IMO, this is a nice thing to have.
> It must be possible to extend the current code so that
> dired might handle wildcards in the directory part.

I'm not sure the recent patch for this fix is the right approach.
The old code already used the shell to do the wildcard expansion, so why
not just adjust the old code.

Here's some starting patch.


        Stefan


diff --git a/lisp/dired.el b/lisp/dired.el
index 24759c6c9b..29755712cf 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1089,25 +1038,31 @@ dired-readin
 (defun dired-readin-insert ()
   ;; Insert listing for the specified dir (and maybe file list)
   ;; already in dired-directory, assuming a clean buffer.
-  (let (dir file-list)
-    (if (consp dired-directory)
-	(setq dir (car dired-directory)
-	      file-list (cdr dired-directory))
-      (setq dir dired-directory
-	    file-list nil))
-    (setq dir (expand-file-name dir))
+  (let* ((dir (expand-file-name
+               (if (consp dired-directory)
+                   (car dired-directory)
+                 dired-directory)))
+        (file-list (cdr-safe dired-directory))
+        (wildcard (not file-list)))
+    (unless (file-directory-p dir)
+      (unless file-list (setq file-list '("")))
+      (while (not (file-directory-p dir))
+        (setq dir (directory-file-name dir))
+        (let ((n (file-name-nondirectory dir)))
+          (setq file-list (mapcar (lambda (f) (concat n "/" f)) file-list)))
+        (setq dir (file-name-directory dir)))
+      (setq default-directory dir))
     (if (and (equal "" (file-name-nondirectory dir))
 	     (not file-list))
 	;; If we are reading a whole single directory...
 	(dired-insert-directory dir dired-actual-switches nil nil t)
-      (if (and (not (insert-directory-wildcard-in-dir-p dir))
-               (not (file-readable-p
-		     (directory-file-name (file-name-directory dir)))))
-	  (error "Directory %s inaccessible or nonexistent" dir))
-      ;; Else treat it as a wildcard spec
-      ;; unless we have an explicit list of files.
-      (dired-insert-directory dir dired-actual-switches
-			      file-list (not file-list) t))))
+      (if (not (file-readable-p
+		(directory-file-name (file-name-directory dir))))
+	  (error "Directory %s inaccessible or nonexistent" dir)
+	;; Else treat it as a wildcard spec
+	;; unless we have an explicit list of files.
+	(dired-insert-directory dir dired-actual-switches
+				file-list wildcard t)))))
 
 (defun dired-align-file (beg end)
   "Align the fields of a file to the ones of surrounding lines.
@@ -1252,56 +1207,29 @@ dired-insert-directory
 	 ;; as indicated by `ls-lisp-use-insert-directory-program'.
 	 (not (and (featurep 'ls-lisp)
 		   (null ls-lisp-use-insert-directory-program)))
-         (not (and (featurep 'eshell)
-                   (bound-and-true-p eshell-ls-use-in-dired)))
-	 (or (file-remote-p dir)
-             (if (eq dired-use-ls-dired 'unspecified)
+	 (or (if (eq dired-use-ls-dired 'unspecified)
 		 ;; Check whether "ls --dired" gives exit code 0, and
 		 ;; save the answer in `dired-use-ls-dired'.
 		 (or (setq dired-use-ls-dired
 			   (eq 0 (call-process insert-directory-program
-                                               nil nil nil "--dired")))
+					     nil nil nil "--dired")))
 		     (progn
 		       (message "ls does not support --dired; \
 see `dired-use-ls-dired' for more details.")
 		       nil))
-	       dired-use-ls-dired)))
+	       dired-use-ls-dired)
+	     (file-remote-p dir)))
 	(setq switches (concat "--dired " switches)))
-    ;; Expand directory wildcards and fill file-list.
-    (let ((dir-wildcard (insert-directory-wildcard-in-dir-p dir)))
-      (cond (dir-wildcard
-             (setq switches (concat "-d " switches))
-             ;; We don't know whether the remote ls supports
-             ;; "--dired", so we cannot add it to the `process-file'
-             ;; call for wildcards.
-             (when (file-remote-p dir)
-               (setq switches (dired-replace-in-string "--dired" "" switches)))
-             (let* ((default-directory (car dir-wildcard))
-                    (script (format "ls %s %s" switches (cdr dir-wildcard)))
-                    (remotep (file-remote-p dir))
-                    (sh (or (and remotep "/bin/sh")
-                            (and (bound-and-true-p explicit-shell-file-name)
-                                 (executable-find explicit-shell-file-name))
-                            (executable-find "sh")))
-                    (switch (if remotep "-c" shell-command-switch)))
-               (unless
-                   (zerop
-                    (process-file sh nil (current-buffer) nil switch script))
-                 (user-error
-                  "%s: No files matching wildcard" (cdr dir-wildcard)))
-               (insert-directory-clean (point) switches)))
-            (t
-             ;; We used to specify the C locale here, to force English
-             ;; month names; but this should not be necessary any
-             ;; more, with the new value of
-             ;; `directory-listing-before-filename-regexp'.
-             (if file-list
-	         (dolist (f file-list)
-	           (let ((beg (point)))
-	             (insert-directory f switches nil nil)
-	             ;; Re-align fields, if necessary.
-	             (dired-align-file beg (point))))
-               (insert-directory dir switches wildcard (not wildcard))))))
+    ;; We used to specify the C locale here, to force English month names;
+    ;; but this should not be necessary any more,
+    ;; with the new value of `directory-listing-before-filename-regexp'.
+    (if file-list
+	(dolist (f file-list)
+	  (let ((beg (point)))
+	    (insert-directory f switches wildcard nil)
+	    ;; Re-align fields, if necessary.
+	    (dired-align-file beg (point))))
+      (insert-directory dir switches wildcard (not wildcard)))
     ;; Quote certain characters, unless ls quoted them for us.
     (if (not (dired-switches-escape-p dired-actual-switches))
 	(save-excursion

diff --git a/lisp/files.el b/lisp/files.el
index 96647fb262..1f69391d51 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -6683,19 +6608,15 @@ insert-directory
 			   default-file-name-coding-system))))
 	    (setq result
 		  (if wildcard
-		      ;; If the wildcard is just in the file part, then run ls in
-                      ;; the directory part of the file pattern using the last
-                      ;; component as argument.  Otherwise, run ls in the longest
-                      ;; subdirectory of the directory part free of wildcards; use
-                      ;; the remaining of the file pattern as argument.
-		      (let* ((dir-wildcard (insert-directory-wildcard-in-dir-p file))
-                             (default-directory
-                               (cond (dir-wildcard (car dir-wildcard))
-                                     (t
-			              (if (file-name-absolute-p file)
-				          (file-name-directory file)
-				        (file-name-directory (expand-file-name file))))))
-			     (pattern (if dir-wildcard (cdr dir-wildcard) (file-name-nondirectory file))))
+		      ;; Run ls in the directory part of the file pattern
+		      ;; using the last component as argument.
+		      (let ((default-directory
+			      (if (file-name-absolute-p file)
+				  (file-name-directory file)
+                                default-directory))
+			    (pattern (if (file-name-absolute-p file)
+                                         (file-name-nondirectory file)
+                                       file)))
 			;; NB since switches is passed to the shell, be
 			;; careful of malicious values, eg "-l;reboot".
 			;; See eg dired-safe-switches-p.





  reply	other threads:[~2017-08-02 17:30 UTC|newest]

Thread overview: 25+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2017-07-09 18:42 bug#27631: dired a/*/b 積丹尼 Dan Jacobson
2017-07-13  5:52 ` Tino Calancha
2017-08-02 17:30   ` Stefan Monnier [this message]
2017-08-02 17:49     ` Eli Zaretskii
2017-08-03  1:25       ` Stefan Monnier
2017-08-03  4:38     ` Tino Calancha
2017-08-03 15:48       ` Stefan Monnier
2017-08-04  5:12         ` Tino Calancha
2017-07-13 13:15 ` 積丹尼 Dan Jacobson
2017-07-13 15:13 ` Tino Calancha
2017-07-14  8:40   ` Eli Zaretskii
2017-07-25 15:19     ` Tino Calancha
2017-07-26  7:36       ` Michael Albinus
2017-07-28  7:50         ` Tino Calancha
2017-07-28  9:23           ` Michael Albinus
2017-07-28  9:34             ` Tino Calancha
2017-07-28 11:23               ` Michael Albinus
2017-07-28 12:00           ` Michael Albinus
2017-07-29 12:20             ` Tino Calancha
2017-07-29 20:39               ` Michael Albinus
2017-07-30  2:20                 ` Tino Calancha
2017-07-30 11:13                 ` Michael Albinus
2017-07-29  8:30       ` Eli Zaretskii
2017-07-29 12:03         ` Tino Calancha
2017-07-14  9:30   ` Michael Albinus

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='jwvini5apbo.fsf-monnier+bug#27631@gnu.org' \
    --to=monnier@iro.umontreal.ca \
    --cc=27631@debbugs.gnu.org \
    --cc=jidanni@jidanni.org \
    --cc=tino.calancha@gmail.com \
    /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.