From 6f6639d6ed6c6314b2643f6c22498fc2e23d34c7 Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Sun, 30 Jul 2017 11:02:49 +0900 Subject: [PATCH] Dired: Handle posix wildcards in directory part 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 | 20 ++++-- etc/NEWS | 3 + lisp/dired.el | 63 ++++++++++------- lisp/eshell/em-ls.el | 53 +++++++++++--- lisp/files.el | 146 +++++++++++++++++++++++---------------- lisp/ls-lisp.el | 30 ++++++++ test/lisp/dired-tests.el | 38 ++++++++++ 7 files changed, 256 insertions(+), 97 deletions(-) diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index ddd7229b0c8..150ac8427ab 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -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. diff --git a/etc/NEWS b/etc/NEWS index a785c6a86b2..44f5ff5bded 100644 --- 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. diff --git a/lisp/dired.el b/lisp/dired.el index 3b29c7129d4..e09691b07c6 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -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) diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index 79799db30bc..948ac38b5f2 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -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: 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 diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 730ba26c6c8..56780daa09f 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -60,6 +60,9 @@ ;;; Code: + +(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) diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 43a21e1accb..cd58edaa3f8 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -277,5 +277,43 @@ (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 -- 2.39.2