unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Tino Calancha <tino.calancha@gmail.com>
To: "積丹尼 Dan Jacobson" <jidanni@jidanni.org>
Cc: 27631@debbugs.gnu.org
Subject: bug#27631: dired a/*/b
Date: Thu, 13 Jul 2017 14:52:51 +0900	[thread overview]
Message-ID: <8737a0yjbg.fsf@calancha-pc> (raw)
In-Reply-To: <87o9sth2oi.fsf@jidanni.org> ("積丹尼 Dan Jacobson"'s message of "Mon, 10 Jul 2017 02:42:53 +0800")

積丹尼 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





  reply	other threads:[~2017-07-13  5:52 UTC|newest]

Thread overview: 25+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2017-07-09 18:42 bug#27631: dired a/*/b 積丹尼 Dan Jacobson
2017-07-13  5:52 ` Tino Calancha [this message]
2017-08-02 17:30   ` Stefan Monnier
2017-08-02 17:49     ` Eli Zaretskii
2017-08-03  1:25       ` Stefan Monnier
2017-08-03  4:38     ` Tino Calancha
2017-08-03 15:48       ` Stefan Monnier
2017-08-04  5:12         ` Tino Calancha
2017-07-13 13:15 ` 積丹尼 Dan Jacobson
2017-07-13 15:13 ` Tino Calancha
2017-07-14  8:40   ` Eli Zaretskii
2017-07-25 15:19     ` Tino Calancha
2017-07-26  7:36       ` Michael Albinus
2017-07-28  7:50         ` Tino Calancha
2017-07-28  9:23           ` Michael Albinus
2017-07-28  9:34             ` Tino Calancha
2017-07-28 11:23               ` Michael Albinus
2017-07-28 12:00           ` Michael Albinus
2017-07-29 12:20             ` Tino Calancha
2017-07-29 20:39               ` Michael Albinus
2017-07-30  2:20                 ` Tino Calancha
2017-07-30 11:13                 ` Michael Albinus
2017-07-29  8:30       ` Eli Zaretskii
2017-07-29 12:03         ` Tino Calancha
2017-07-14  9:30   ` Michael Albinus

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=8737a0yjbg.fsf@calancha-pc \
    --to=tino.calancha@gmail.com \
    --cc=27631@debbugs.gnu.org \
    --cc=jidanni@jidanni.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).