Dired: Handle posix wildcards in directory partorigin/feature/dired-wildcard-in-dir-bug#27631

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-clean): New defun extracted from insert-directory.
(insert-directory)
* lisp/dired.el (dired-internal-noselect)
(dired-insert-directory): Use the new predicate; when it's true,
handle the directory wildcards with a shell call.
* 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.
* lisp/dired.el (dired-insert-directory): Expand dir wildcards here.
* /etc/NEWS: Announce it.
* doc/emacs/dired.texi (Dired Enter): Update manual.
* test/lisp/dired-tests.el (dired-test-bug27631): Add test.

1 files changed, 85 insertions, 61 deletions

diff --git a/lisp/files.el b/lisp/files.el
index 6ce2fe98b05..96647fb2626 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -6555,6 +6555,75 @@ regardless of the language.")
 
 (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))))))
+
+(defun insert-directory-clean (beg switches)
+  (when (if (stringp switches)
+	    (string-match "--dired\\>" switches)
+	  (member "--dired" switches))
+    ;; The following overshoots by one line for an empty
+    ;; directory listed with "--dired", but without "-a"
+    ;; switch, where the ls output contains a
+    ;; "//DIRED-OPTIONS//" line, but no "//DIRED//" line.
+    ;; We take care of that case later.
+    (forward-line -2)
+    (when (looking-at "//SUBDIRED//")
+      (delete-region (point) (progn (forward-line 1) (point)))
+      (forward-line -1))
+    (if (looking-at "//DIRED//")
+	(let ((end (line-end-position))
+	      (linebeg (point))
+	      error-lines)
+	  ;; Find all the lines that are error messages,
+	  ;; and record the bounds of each one.
+	  (goto-char beg)
+	  (while (< (point) linebeg)
+	    (or (eql (following-char) ?\s)
+		(push (list (point) (line-end-position)) error-lines))
+	    (forward-line 1))
+	  (setq error-lines (nreverse error-lines))
+	  ;; Now read the numeric positions of file names.
+	  (goto-char linebeg)
+	  (forward-word-strictly 1)
+	  (forward-char 3)
+	  (while (< (point) end)
+	    (let ((start (insert-directory-adj-pos
+			  (+ beg (read (current-buffer)))
+			  error-lines))
+		  (end (insert-directory-adj-pos
+			(+ beg (read (current-buffer)))
+			error-lines)))
+	      (if (memq (char-after end) '(?\n ?\s))
+		  ;; End is followed by \n or by " -> ".
+		  (put-text-property start end 'dired-filename t)
+		;; It seems that we can't trust ls's output as to
+		;; byte positions of filenames.
+		(put-text-property beg (point) 'dired-filename nil)
+		(end-of-line))))
+	  (goto-char end)
+	  (beginning-of-line)
+	  (delete-region (point) (progn (forward-line 1) (point))))
+      ;; Take care of the case where the ls output contains a
+      ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line
+      ;; and we went one line too far back (see above).
+      (forward-line 1))
+    (if (looking-at "//DIRED-OPTIONS//")
+	(delete-region (point) (progn (forward-line 1) (point))))))
+
 ;; insert-directory
 ;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
 ;;   FULL-DIRECTORY-P is nil.
@@ -6614,13 +6683,19 @@ normally equivalent short `-D' option is just passed on to
 			   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.
@@ -6668,7 +6743,8 @@ normally equivalent short `-D' option is just passed on to
 				  (setq file (expand-file-name file)))
 			      (list
 			       (if full-directory-p
-				   (concat (file-name-as-directory file) ".")
+				   ;; (concat (file-name-as-directory file) ".")
+                                   file
 				 file))))))))
 
 	  ;; If we got "//DIRED//" in the output, it means we got a real
@@ -6739,59 +6815,7 @@ normally equivalent short `-D' option is just passed on to
 	      ;; Unix.  Access the file to get a suitable error.
 	      (access-file file "Reading directory")
 	      (error "Listing directory failed but `access-file' worked")))
-
-	  (when (if (stringp switches)
-		    (string-match "--dired\\>" switches)
-		  (member "--dired" switches))
-	    ;; The following overshoots by one line for an empty
-	    ;; directory listed with "--dired", but without "-a"
-	    ;; switch, where the ls output contains a
-	    ;; "//DIRED-OPTIONS//" line, but no "//DIRED//" line.
-	    ;; We take care of that case later.
-	    (forward-line -2)
-            (when (looking-at "//SUBDIRED//")
-              (delete-region (point) (progn (forward-line 1) (point)))
-              (forward-line -1))
-	    (if (looking-at "//DIRED//")
-		(let ((end (line-end-position))
-		      (linebeg (point))
-		      error-lines)
-		  ;; Find all the lines that are error messages,
-		  ;; and record the bounds of each one.
-		  (goto-char beg)
-		  (while (< (point) linebeg)
-		    (or (eql (following-char) ?\s)
-			(push (list (point) (line-end-position)) error-lines))
-		    (forward-line 1))
-		  (setq error-lines (nreverse error-lines))
-		  ;; Now read the numeric positions of file names.
-		  (goto-char linebeg)
-		  (forward-word-strictly 1)
-		  (forward-char 3)
-		  (while (< (point) end)
-		    (let ((start (insert-directory-adj-pos
-				  (+ beg (read (current-buffer)))
-				  error-lines))
-			  (end (insert-directory-adj-pos
-				(+ beg (read (current-buffer)))
-				error-lines)))
-		      (if (memq (char-after end) '(?\n ?\s))
-			  ;; End is followed by \n or by " -> ".
-			  (put-text-property start end 'dired-filename t)
-			;; It seems that we can't trust ls's output as to
-			;; byte positions of filenames.
-			(put-text-property beg (point) 'dired-filename nil)
-			(end-of-line))))
-		  (goto-char end)
-		  (beginning-of-line)
-		  (delete-region (point) (progn (forward-line 1) (point))))
-	      ;; Take care of the case where the ls output contains a
-	      ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line
-	      ;; and we went one line too far back (see above).
-	      (forward-line 1))
-	    (if (looking-at "//DIRED-OPTIONS//")
-		(delete-region (point) (progn (forward-line 1) (point)))))
-
+          (insert-directory-clean beg switches)
 	  ;; Now decode what read if necessary.
 	  (let ((coding (or coding-system-for-read
 			    file-name-coding-system