bug#27631: dired a/*/b

[Tino Calancha <tino.calancha@gmail.com>]

Eli Zaretskii <eliz@gnu.org> writes:

>> commit e5d5bd9822c1c562a7feb16f035062fda603d4d9
>> Author: Tino Calancha <tino.calancha@gmail.com>
>> Date:   Thu Jul 13 23:56:43 2017 +0900
>> 
>>     Dired: Handle wildards in directory part
>>     
>>     Allow to Dired to handle calls like
>>     \(dired \"~/foo/*/*.el\"), that is, with wildcards withing
>>     the directory part of the file argument.

> Thanks, but this doesn't seem to work with ls-lisp.el, so I guess it
> relies on some features of the 'ls' command.  (ls-lisp.el does support
> wildcards in the likes of "C-x d foo* RET".)  So if we are going to
> accept this, either it should be made to work with ls-lisp.el
> (preferred), or some kind of error message should be emitted in that
> case,
Added support for ls-lisp and em-ls.

>> +(defun insert-directory-wildcard-in-dir-p (dir)
>> +  (when (string-match "[*]" (file-name-directory dir))
>> +    (let ((regexp "\\`\\([^*]+/\\)\\([^*]*[*].*\\)"))
>> +      (string-match regexp dir)
>> +      (cons (match-string 1 dir) (match-string 2 dir)))))
>
> Any reason you only want to support '*'?  What about '?' or '[a-b]',
> for example?
Added support for (all?) posix globing.

> Also, what happens if the directory includes a literal '*' character?
> That's possible on Posix systems.
Fixed.  Then, we will visit that file if does exist.


I have something working pretty well.  I gave up with `find-lisp' lib
because it was really slow.  I changed to use 'em-glob' which is really
fast!
But current implementation doesn't work with (Donald) tramp :-(.  If we
want this in tramp, i am afraid i will need a tramp super-expert,
i.e. Michael.

Best smiles,
Tino

--8<-----------------------------cut here---------------start------------->8---
commit 92330e7e08a62f8731633d78a05b523b98025de2
Author: Tino Calancha <tino.calancha@gmail.com>
Date:   Wed Jul 26 00:10:15 2017 +0900

    Dired: Handle posix wildcards in directory part
    
    Allow to Dired to handle calls like
    \(dired \"~/foo/*/*.el\"), that is, with wildcards within
    the directory part of the file argument.
    * lisp/files.el (insert-directory-wildcard-in-dir-p): New predicate.
    (insert-directory)
    * lisp/dired.el (dired-internal-noselect)
    (dired-insert-directory): Use it.
    * lisp/eshell/em-ls.el (eshell-ls-use-in-dired): Add/remove both advices.
    (eshell-ls-unload-hook): New defun.  Use it in
    eshell-ls-unload-hook instead of an anonymous function.
    (eshell-ls--dired)
    * lisp/ls-lisp.el (ls-lisp--dired):
    Advice dired to handle wildcards in the directory part with both
    em-ls and ls-lisp.
    * /etc/NEWS: Announce it.
    * doc/emacs/dired.texi (Dired Enter): Update manual.
    * test/lisp/dired-tests.el (dired-test-bug27631): Add test.

diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index ddd7229b0c..150ac8427a 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -64,10 +64,22 @@ Dired Enter
 directory name using the minibuffer, and opens a @dfn{Dired buffer}
 listing the files in that directory.  You can also supply a wildcard
 file name pattern as the minibuffer argument, in which case the Dired
-buffer lists all files matching that pattern.  The usual history and
-completion commands can be used in the minibuffer; in particular,
-@kbd{M-n} puts the name of the visited file (if any) in the minibuffer
-(@pxref{Minibuffer History}).
+buffer lists all files matching that pattern.  A wildcard may appear
+in the directory part as well.
+For instance,
+
+@example
+C-x d  ~/foo/*.el  @key{RET}
+C-x d  ~/foo/*/*.el  @key{RET}
+@end example
+
+The former lists all the files with extension @samp{.el} in directory
+@samp{foo}.  The latter lists the files with extension @samp{.el}
+in subdirectories 2 levels of depth below @samp{foo}.
+
+The usual history and completion commands can be used in the minibuffer;
+in particular, @kbd{M-n} puts the name of the visited file (if any) in
+the minibuffer (@pxref{Minibuffer History}).
 
   You can also invoke Dired by giving @kbd{C-x C-f} (@code{find-file})
 a directory name.
diff --git a/etc/NEWS b/etc/NEWS
index f43491b630..af0f461d1f 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -604,6 +604,9 @@ paragraphs, for the purposes of bidirectional display.
 *** You can now use '`?`' in 'dired-do-shell-command'; as ' ? ', it gets replaced
 by the current file name.
 
++++
+*** Dired supports wildcards in the directory part of the file names.
+
 *** html2text is now marked obsolete.
 
 *** smerge-refine-regions can refine regions in separate buffers
diff --git a/lisp/dired.el b/lisp/dired.el
index 9d500a9f52..358e50d73c 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -920,11 +920,12 @@ dired-internal-noselect
 			   "Directory has changed on disk; type \\[revert-buffer] to update Dired")))))
       ;; Else a new buffer
       (setq default-directory
-	    ;; We can do this unconditionally
-	    ;; because dired-noselect ensures that the name
-	    ;; is passed in directory name syntax
-	    ;; if it was the name of a directory at all.
-	    (file-name-directory dirname))
+            (or (car-safe (insert-directory-wildcard-in-dir-p dirname))
+	        ;; We can do this unconditionally
+	        ;; because dired-noselect ensures that the name
+	        ;; is passed in directory name syntax
+	        ;; if it was the name of a directory at all.
+	        (file-name-directory dirname)))
       (or switches (setq switches dired-listing-switches))
       (if mode (funcall mode)
         (dired-mode dir-or-list switches))
@@ -1056,13 +1057,14 @@ dired-readin-insert
 	     (not file-list))
 	;; If we are reading a whole single directory...
 	(dired-insert-directory dir dired-actual-switches nil nil 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 (not file-list) 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))))
 
 (defun dired-align-file (beg end)
   "Align the fields of a file to the ones of surrounding lines.
@@ -1279,11 +1281,14 @@ dired-insert-directory
 	  ;; Note that dired-build-subdir-alist will replace the name
 	  ;; by its expansion, so it does not matter whether what we insert
 	  ;; here is fully expanded, but it should be absolute.
-	  (insert "  " (directory-file-name (file-name-directory dir)) ":\n")
+	  (insert "  " (or (car-safe (insert-directory-wildcard-in-dir-p dir))
+                           (directory-file-name (file-name-directory dir))) ":\n")
 	  (setq content-point (point)))
 	(when wildcard
 	  ;; Insert "wildcard" line where "total" line would be for a full dir.
-	  (insert "  wildcard " (file-name-nondirectory dir) "\n")))
+	  (insert "  wildcard " (or (cdr-safe (insert-directory-wildcard-in-dir-p dir))
+                                    (file-name-nondirectory dir))
+                  "\n")))
       (dired-insert-set-properties content-point (point)))))
 
 (defun dired-insert-set-properties (beg end)
diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el
index 79799db30b..14c83d072a 100644
--- a/lisp/eshell/em-ls.el
+++ b/lisp/eshell/em-ls.el
@@ -65,17 +65,19 @@ eshell-ls-use-in-dired
   "If non-nil, use `eshell-ls' to read directories in Dired.
 Changing this without using customize has no effect."
   :set (lambda (symbol value)
-	 (if value
-             (advice-add 'insert-directory :around
-                         #'eshell-ls--insert-directory)
-           (advice-remove 'insert-directory
-                          #'eshell-ls--insert-directory))
+	 (cond (value
+                (require 'dired)
+                (advice-add 'insert-directory :around
+                            #'eshell-ls--insert-directory)
+                (advice-add 'dired :around #'eshell-ls--dired))
+               (t
+                (advice-remove 'insert-directory
+                               #'eshell-ls--insert-directory)
+                (advice-remove 'dired #'eshell-ls--dired)))
          (set symbol value))
   :type 'boolean
   :require 'em-ls)
-(add-hook 'eshell-ls-unload-hook
-          (lambda () (advice-remove 'insert-directory
-                               #'eshell-ls--insert-directory)))
+(add-hook 'eshell-ls-unload-hook #'eshell-ls-unload-function)
 
 
 (defcustom eshell-ls-default-blocksize 1024
@@ -279,6 +281,36 @@ eshell-ls--insert-directory
                 eshell-ls-dired-initial-args)
             (eshell-do-ls (append switches (list file)))))))))
 
+(declare-function eshell-extended-glob "em-glob" (glob))
+(declare-function dired-read-dir-and-switches "dired" (str))
+(declare-function dired-goto-next-file "em-glob" ())
+
+(defun eshell-ls--dired (orig-fun dir-or-list &optional switches)
+  (interactive (dired-read-dir-and-switches ""))
+  (require 'em-glob)
+  (if (consp dir-or-list)
+      (funcall orig-fun dir-or-list switches)
+    (let* ((dir-wildcard (insert-directory-wildcard-in-dir-p
+                          (file-local-name (expand-file-name dir-or-list))))
+           (default-directory (car dir-wildcard)))
+      (if (not dir-wildcard)
+          (funcall orig-fun dir-or-list switches)
+        (let ((files (eshell-extended-glob (cdr dir-wildcard)))
+              (dir (car dir-wildcard)))
+          (if files
+              (let ((inhibit-read-only t)
+                    (buf
+                     (apply orig-fun
+                            (nconc (list dir) files)
+                            (and switches (list switches)))))
+                (with-current-buffer buf
+                  (save-excursion
+                    (goto-char (point-min))
+                    (dired-goto-next-file)
+                    (forward-line 0)
+                    (insert "  wildcard " (cdr dir-wildcard) "\n"))))
+            (user-error "No files matching regexp")))))))
+
 (defsubst eshell/ls (&rest args)
   "An alias version of `eshell-do-ls'."
   (let ((insert-func 'eshell-buffered-print)
@@ -909,6 +941,11 @@ eshell-ls-decorated-name
 				 (car file)))))
   (car file))
 
+(defun eshell-ls-unload-function ()
+  (advice-remove 'insert-directory #'eshell-ls--insert-directory)
+  (advice-remove 'dired #'eshell-ls--dired)
+  nil)
+
 (provide 'em-ls)
 
 ;; Local Variables:
diff --git a/lisp/files.el b/lisp/files.el
index 321a35b530..fa72dff58e 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -6552,6 +6552,22 @@ directory-listing-before-filename-regexp
 
 (defvar insert-directory-ls-version 'unknown)
 
+(defun insert-directory-wildcard-in-dir-p (dir)
+  "Return non-nil if DIR contents a shell wildcard in the directory part.
+The return value is a cons (DIR . WILDCARDS); DIR is the
+`default-directory' in the Dired buffer, and WILDCARDS are the wildcards.
+
+Valid wildcards are '*', '?', '[abc]' and '[a-z]'."
+  (let ((wildcards "[?*"))
+    (when (and (or (not (featurep 'ls-lisp))
+                   ls-lisp-support-shell-wildcards)
+               (string-match (concat "[" wildcards "]") (file-name-directory dir))
+               (not (file-exists-p dir))) ; Prefer an existing file to wildcards.
+      (let ((regexp (format "\\`\\([^%s]+/\\)\\([^%s]*[%s].*\\)"
+                            wildcards wildcards wildcards)))
+        (string-match regexp dir)
+        (cons (match-string 1 dir) (match-string 2 dir))))))
+
 ;; insert-directory
 ;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
 ;;   FULL-DIRECTORY-P is nil.
@@ -6611,13 +6627,19 @@ insert-directory
 			   default-file-name-coding-system))))
 	    (setq result
 		  (if wildcard
-		      ;; 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)
-				(file-name-directory (expand-file-name file))))
-			    (pattern (file-name-nondirectory file)))
+		      ;; 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))))
 			;; NB since switches is passed to the shell, be
 			;; careful of malicious values, eg "-l;reboot".
 			;; See eg dired-safe-switches-p.
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index 730ba26c6c..611350fbc1 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -60,6 +60,9 @@
 
 ;;; Code:
 
+\f
+(require 'em-glob)
+
 (defgroup ls-lisp nil
   "Emulate the ls program completely in Emacs Lisp."
   :version "21.1"
@@ -477,6 +480,32 @@ ls-lisp-insert-directory
 	(message "%s: doesn't exist or is inaccessible" file)
 	(ding) (sit-for 2)))))		; to show user the message!
 
+
+(defun ls-lisp--dired (orig-fun dir-or-list &optional switches)
+  (interactive (dired-read-dir-and-switches ""))
+  (if (consp dir-or-list)
+      (funcall orig-fun dir-or-list switches)
+    (let* ((dir-wildcard (insert-directory-wildcard-in-dir-p
+                          (file-local-name (expand-file-name dir-or-list))))
+           (default-directory (car dir-wildcard)))
+      (if (not dir-wildcard)
+          (funcall orig-fun dir-or-list switches)
+        (let ((files (eshell-extended-glob (cdr dir-wildcard)))
+              (dir (car dir-wildcard)))
+          (if files
+              (let ((inhibit-read-only t)
+                    (buf
+                     (apply orig-fun (nconc (list dir) files) (and switches (list switches)))))
+                (with-current-buffer buf
+                  (save-excursion
+                    (goto-char (point-min))
+                    (dired-goto-next-file)
+                    (forward-line 0)
+                    (insert "  wildcard " (cdr dir-wildcard) "\n"))))
+            (user-error "No files matching regexp")))))))
+
+(advice-add 'dired :around #'ls-lisp--dired)
+
 (defun ls-lisp-sanitize (file-alist)
   "Sanitize the elements in FILE-ALIST.
 Fixes any elements in the alist for directory entries whose file
@@ -869,6 +898,7 @@ ls-lisp-format-file-size
 (defun ls-lisp-unload-function ()
   "Unload ls-lisp library."
   (advice-remove 'insert-directory #'ls-lisp--insert-directory)
+  (advice-remove 'dired #'ls-lisp--dired)
   ;; Continue standard unloading.
   nil)
 
diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el
index 69331457c0..005a82031f 100644
--- a/test/lisp/dired-tests.el
+++ b/test/lisp/dired-tests.el
@@ -175,5 +175,43 @@
           (should (looking-at "src")))
       (when (buffer-live-p buf) (kill-buffer buf)))))
 
+(ert-deftest dired-test-bug27631 ()
+  "Test for http://debbugs.gnu.org/27631 ."
+  (let* ((dir (make-temp-file "bug27631" 'dir))
+         (dir1 (expand-file-name "dir1" dir))
+         (dir2 (expand-file-name "dir2" dir))
+         (default-directory dir)
+         buf)
+    (unwind-protect
+        (progn
+          (make-directory dir1)
+          (make-directory dir2)
+          (with-temp-file (expand-file-name "a.txt" dir1))
+          (with-temp-file (expand-file-name "b.txt" dir2))
+          (setq buf (dired (expand-file-name "dir*/*.txt" dir)))
+          (dired-toggle-marks)
+          (should (cdr (dired-get-marked-files)))
+          ;; Must work with ls-lisp ...
+	  (require 'ls-lisp)
+          (kill-buffer buf)
+	  (setq default-directory dir)
+	  (let (ls-lisp-use-insert-directory-program)
+            (setq buf (dired (expand-file-name "dir*/*.txt" dir)))
+            (dired-toggle-marks)
+            (should (cdr (dired-get-marked-files))))
+	  ;; ... And with em-ls as well.
+	  (kill-buffer buf)
+	  (setq default-directory dir)
+	  (unload-feature 'ls-lisp 'force)
+	  (require 'em-ls)
+	  (let ((orig eshell-ls-use-in-dired))
+	    (customize-set-value 'eshell-ls-use-in-dired t)
+	    (setq buf (dired (expand-file-name "dir*/*.txt" dir)))
+	    (dired-toggle-marks)
+	    (should (cdr (dired-get-marked-files)))))
+      (delete-directory dir 'recursive)
+      (when (buffer-live-p buf) (kill-buffer buf)))))
+
+
 (provide 'dired-tests)
 ;; dired-tests.el ends here

--8<-----------------------------cut here---------------end--------------->8---
In GNU Emacs 26.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.22.11)
 of 2017-07-25
Repository revision: 24b91584c214caadff0f2394cf1f021bf480b624