[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#27631: dired a/*/b
From: |
Tino Calancha |
Subject: |
bug#27631: dired a/*/b |
Date: |
Thu, 13 Jul 2017 14:52:51 +0900 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/26.0.50 (gnu/linux) |
積丹尼 Dan Jacobson <jidanni@jidanni.org> writes:
> Maybe make dired and list-directory deal with wildcards in positions like
> ~/.config/chromium/Default/*/menkifleemblimdogmoihpfopnplikde/
Thank you for the report.
IMO, this is a nice thing to have.
It must be possible to extend the current code so that
dired might handle wildcards in the directory part.
Following is a crude patch as a proof of principle. Not heavily
tested yet, but for simple cases seems to work.
--8<-----------------------------cut here---------------start------------->8---
commit c172cd911229a02877dea2681f533c10e8e34b4f
Author: Tino Calancha <tino.calancha@gmail.com>
Date: Thu Jul 13 14:43:34 2017 +0900
dired: Handle wildcards in the directory part (Bug#27631)
diff --git a/lisp/dired.el b/lisp/dired.el
index 0c1f3e4af6..7fa3a47db5 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -913,11 +913,13 @@ 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))
+ (if (insert-directory-wildcard-in-dir-p dirname)
+ (car (insert-directory-process-wildcard 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))
@@ -1049,13 +1051,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.
@@ -1272,11 +1275,16 @@ 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 " " (if (insert-directory-wildcard-in-dir-p dir)
+ (car (insert-directory-process-wildcard 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 " (if (insert-directory-wildcard-in-dir-p dir)
+ (cdr (insert-directory-process-wildcard
dir))
+ (file-name-nondirectory dir))
+ "\n")))
(dired-insert-set-properties content-point (point)))))
(defun dired-insert-set-properties (beg end)
diff --git a/lisp/files.el b/lisp/files.el
index 2f3efa33c2..96d1b49d50 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -6552,6 +6552,23 @@ directory-listing-before-filename-regexp
(defvar insert-directory-ls-version 'unknown)
+(defun insert-directory-wildcard-in-dir-p (dir)
+ (string-match "\\`\\([^*]+\\)\\([*].*\\)"
+ (file-name-directory dir)))
+
+(defun insert-directory-process-wildcard (dir)
+ (let ((switches "")
+ (newdir "")
+ (regexp "\\`\\([^*]+/\\)\\([^*]*[*].*\\)"))
+ (cond ((string-match regexp (file-name-directory dir))
+ (string-match regexp dir)
+ (setq newdir (match-string 1 dir)
+ switches (match-string 2 dir)))
+ (t
+ (setq newdir (file-name-directory dir)
+ switches (file-name-nondirectory dir))))
+ (cons newdir switches)))
+
;; insert-directory
;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
;; FULL-DIRECTORY-P is nil.
@@ -6611,13 +6628,20 @@ 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 wildcars;
use
+ ;; the remaining of the file pattern as argument.
+ (let* ((dir-wildcard (and
(insert-directory-wildcard-in-dir-p file)
+
(insert-directory-process-wildcard 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.
--8<-----------------------------cut here---------------end--------------->8---
In GNU Emacs 26.0.50 (build 7, x86_64-pc-linux-gnu, GTK+ Version 3.22.11)
of 2017-07-12
Repository revision: dde7f2d48b53996bdf767a8cf91aafc2e10add23
- bug#27631: dired a/*/b, 積丹尼 Dan Jacobson, 2017/07/09
- bug#27631: dired a/*/b,
Tino Calancha <=
- bug#27631: dired a/*/b, 積丹尼 Dan Jacobson, 2017/07/13
- bug#27631: dired a/*/b, Tino Calancha, 2017/07/13
- bug#27631: dired a/*/b, Eli Zaretskii, 2017/07/14
- bug#27631: dired a/*/b, Tino Calancha, 2017/07/25
- bug#27631: dired a/*/b, Michael Albinus, 2017/07/26
- bug#27631: dired a/*/b, Tino Calancha, 2017/07/28
- bug#27631: dired a/*/b, Michael Albinus, 2017/07/28
- bug#27631: dired a/*/b, Tino Calancha, 2017/07/28
- bug#27631: dired a/*/b, Michael Albinus, 2017/07/28
- bug#27631: dired a/*/b, Michael Albinus, 2017/07/28