bug-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

bug#27631: dired a/*/b


From: Stefan Monnier
Subject: bug#27631: dired a/*/b
Date: Wed, 02 Aug 2017 13:30:40 -0400
User-agent: Gnus/5.13 (Gnus v5.13) Emacs/26.0.50 (gnu/linux)

>> 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 via email to

[Prev in Thread] Current Thread [Next in Thread]