[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] origin/feature/dired-wildcard-in-dir-bug#27631 4644dbc: Di
|
From: |
Tino Calancha |
|
Subject: |
[Emacs-diffs] origin/feature/dired-wildcard-in-dir-bug#27631 4644dbc: Dired: Handle posix wildcards in directory part |
|
Date: |
Sat, 29 Jul 2017 08:13:42 -0400 (EDT) |
branch: origin/feature/dired-wildcard-in-dir-bug#27631
commit 4644dbc4dd5277694634c35b25afce387bcf696c
Author: Tino Calancha <address@hidden>
Commit: Tino Calancha <address@hidden>
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-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.
---
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 ddd7229..150ac84 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,
address@hidden 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,
+
address@hidden
+C-x d ~/foo/*.el @key{RET}
+C-x d ~/foo/*/*.el @key{RET}
address@hidden example
+
+The former lists all the files with extension @samp{.el} in directory
address@hidden 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 a785c6a..44f5ff5 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -609,6 +609,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 3b29c71..e09691b 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 79799db..948ac38 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 6ce2fe9..96647fb 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 730ba26..56780da 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 43a21e1..cd58eda 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