]> git.eshelyaron.com Git - emacs.git/commitdiff
Dired: Handle posix wildcards in directory part
authorTino Calancha <tino.calancha@gmail.com>
Sun, 30 Jul 2017 02:02:49 +0000 (11:02 +0900)
committerTino Calancha <tino.calancha@gmail.com>
Sun, 30 Jul 2017 02:11:04 +0000 (11:11 +0900)
Allow Dired to handle calls like
\(dired \"~/foo/*/*.el\"), that is, with wildcards within
the directory part of the file argument (Bug#27631).
* 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
eshell-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.

doc/emacs/dired.texi
etc/NEWS
lisp/dired.el
lisp/eshell/em-ls.el
lisp/files.el
lisp/ls-lisp.el
test/lisp/dired-tests.el

index ddd7229b0c8cef2bbac753ff280963aef57aa21d..150ac8427ab129a73cf1f71e66070873c865e61e 100644 (file)
@@ -64,10 +64,22 @@ you to operate on the listed files.  @xref{Directories}.
 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.
index a785c6a86b28a42cf21e16ac5ab4a643f1bff87a..44f5ff5bded72c4e0c574a0bed0c8e5b33c336d2 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -608,6 +608,9 @@ paragraphs, for the purposes of bidirectional display.
 
 ** Dired
 
++++
+*** Dired supports wildcards in the directory part of the file names.
+
 +++
 *** You can now use '`?`' in 'dired-do-shell-command'; as ' ? ', it gets replaced
 by the current file name.
index 3b29c7129d424d6e7da3bc5fc92b2f3cea503a8c..e09691b07c6a76a8e7fd0ae3e3cee4f50a05d018 100644 (file)
@@ -920,11 +920,12 @@ periodically reverts at specified time intervals."
                           "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 @@ wildcards, erases the buffer, and builds the subdir-alist anew
             (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.
@@ -1221,16 +1223,26 @@ see `dired-use-ls-dired' for more details.")
               dired-use-ls-dired)
             (file-remote-p dir)))
        (setq switches (concat "--dired " switches)))
-    ;; 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)))
+    ;; 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))
+             (let ((default-directory (car dir-wildcard))
+                   (script (format "ls %s %s" switches (cdr dir-wildcard))))
+               (unless (zerop (process-file "/bin/sh" nil (current-buffer) nil "-c" 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))))))
     ;; Quote certain characters, unless ls quoted them for us.
     (if (not (dired-switches-escape-p dired-actual-switches))
        (save-excursion
@@ -1280,11 +1292,14 @@ see `dired-use-ls-dired' for more details.")
          ;; 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)
index 79799db30bc05869f714bae1cf3faf732e334be4..948ac38b5f282ea52da870cc2219593a00da71ef 100644 (file)
@@ -65,17 +65,19 @@ This is useful for enabling human-readable format (-h), for example."
   "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 @@ instead."
                 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
+                         (expand-file-name dir-or-list))))
+      (if (not dir-wildcard)
+          (funcall orig-fun dir-or-list switches)
+        (let* ((default-directory (car dir-wildcard))
+               (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 @@ to use, and each member of which is the width of that column
                                 (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:
index 6ce2fe98b05b66e685c7b8ff66055205b347f1fd..96647fb2626f70a871216b0331322e555804d4e0 100644 (file)
@@ -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
index 730ba26c6c85f5532fd1ccca37b50d04a44f5e33..56780daa09f7206adc9748dd2f0ce7f85dfee815 100644 (file)
@@ -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 @@ not contain `d', so that a full listing is expected."
        (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
+                         (expand-file-name dir-or-list))))
+      (if (not dir-wildcard)
+          (funcall orig-fun dir-or-list switches)
+        (let* ((default-directory (car dir-wildcard))
+               (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 @@ All ls time options, namely c, t and u, are handled."
 (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)
 
index 43a21e1accb2543f37f23893c3285037e111e6c6..cd58edaa3f83a8021bcc9aaf1d90222c43959af7 100644 (file)
       (customize-set-variable 'eshell-ls-use-in-dired orig)
       (and (buffer-live-p buf) (kill-buffer)))))
 
+(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