unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Tino Calancha <tino.calancha@gmail.com>
To: Michael Albinus <michael.albinus@gmx.de>
Cc: 27631@debbugs.gnu.org
Subject: bug#27631: dired a/*/b
Date: Fri, 14 Jul 2017 00:13:28 +0900	[thread overview]
Message-ID: <877ezcxtd3.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/

Hi Michael,

i'd like to provide Tramp support for this new Dired feature.
The implementation is fairly straight: just adds a function
'insert-directory-wildcard-in-dir-p' in files.el, and use it in
'insert-directory' and Dired.

To get Tramp support i've added a handler
'tramp-sh-handle-insert-directory-wildcard-in-dir-p'.
Is this procedure OK or i am doing something weird?

Best regards,
Tino

--8<-----------------------------cut here---------------start------------->8---
commit e5d5bd9822c1c562a7feb16f035062fda603d4d9
Author: Tino Calancha <tino.calancha@gmail.com>
Date:   Thu Jul 13 23:56:43 2017 +0900

    Dired: Handle wildards in directory part
    
    Allow to Dired to handle calls like
    \(dired \"~/foo/*/*.el\"), that is, with wildcards withing
    the directory part of the file argument.
    * lisp/files.el (insert-directory-wildcard-in-dir-p): New predicate.
    (insert-directory)
    * lisp/dired.el(dired-internal-noselect)
    (dired-insert-directory): Use it.
    * /etc/NEWS: Announce it.
    * doc/emacs/dired.texi (Dired Enter): Update manual.

diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index 28cb51d88b..2113381e3a 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -64,10 +64,23 @@ Dired Enter
 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 @samp{foo} subdirectories; the sudirectories are 1 level 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 71a2da1b63..e16c4a7b76 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -559,9 +559,13 @@ properties as intact as possible.
 * Changes in Specialized Modes and Packages in Emacs 26.1
 
 ** Dired
-You can now use '`?`' in 'dired-do-shell-command'; as ' ? ', it gets replaced
++++
+*** You can now use '`?`' in 'dired-do-shell-command'; as ' ? ', it gets replaced
 by the current file name.
 
++++
+*** Now Dired support wildcards in the directory part of file names.
+
 *** html2text is now marked obsolete.
 
 *** smerge-refine-regions can refine regions in separate buffers
diff --git a/lisp/dired.el b/lisp/dired.el
index 0c1f3e4af6..50dd81dfdd 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -913,11 +913,12 @@ 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))
+            (or (car (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))
@@ -1049,13 +1050,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 +1274,14 @@ 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 "  " (or (car (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 (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/files.el b/lisp/files.el
index 2f3efa33c2..96c6357d92 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -6552,6 +6552,12 @@ directory-listing-before-filename-regexp
 
 (defvar insert-directory-ls-version 'unknown)
 
+(defun insert-directory-wildcard-in-dir-p (dir)
+  (when (string-match "[*]" (file-name-directory dir))
+    (let ((regexp "\\`\\([^*]+/\\)\\([^*]*[*].*\\)"))
+      (string-match regexp dir)
+      (cons (match-string 1 dir) (match-string 2 dir)))))
+
 ;; insert-directory
 ;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
 ;;   FULL-DIRECTORY-P is nil.
@@ -6611,13 +6617,19 @@ 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 (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.


commit 15eef43279e2d92ef1e20e66bb2a4ff23c22ead3
Author: Tino Calancha <tino.calancha@gmail.com>
Date:   Thu Jul 13 23:56:43 2017 +0900

    Dired: Tramp support for wildcards in directory part
    
    * lisp/net/tramp-sh.el (tramp-sh-handle-insert-directory-wildcard-in-dir-p):
    New handler for 'insert-directory-wildcard-in-dir-p'.
    (tramp-sh-file-name-handler-alist):
    Add it t the list.
    (tramp-sh-handle-insert-directory): Use it.

diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 4beb6fe521..3a0094d8f7 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1030,6 +1030,7 @@ tramp-sh-file-name-handler-alist
     ;; `find-file-noselect' performed by default handler.
     ;; `get-file-buffer' performed by default handler.
     (insert-directory . tramp-sh-handle-insert-directory)
+    (insert-directory-wildcard-in-dir-p . tramp-sh-handle-insert-directory-wildcard-in-dir-p)
     (insert-file-contents . tramp-handle-insert-file-contents)
     (load . tramp-handle-load)
     (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
@@ -2632,8 +2633,12 @@ tramp-sh-handle-insert-directory
 		 (not (tramp-get-ls-command-with-dired v)))
 	(setq switches (delete "--dired" switches)))
       (when wildcard
-        (setq wildcard (tramp-run-real-handler
-			'file-name-nondirectory (list localname)))
+        (setq wildcard  (or (cdr (tramp-run-real-handler
+                                  'insert-directory-wildcard-in-dir-p
+                                  (list localname)))
+                            (tramp-run-real-handler
+			     'file-name-nondirectory
+                             (list localname))))
         (setq localname (tramp-run-real-handler
 			 'file-name-directory (list localname))))
       (unless (or full-directory-p (member "-d" switches))
@@ -2654,13 +2659,19 @@ tramp-sh-handle-insert-directory
 		   (tramp-get-ls-command v)
 		   switches
 		   (if wildcard
-		       localname
+		       (or (car (tramp-run-real-handler
+                                 'insert-directory-wildcard-in-dir-p
+                                 (list localname))) localname)
 		     (tramp-shell-quote-argument (concat localname ".")))))
 	(tramp-barf-unless-okay
 	 v
 	 (format "cd %s" (tramp-shell-quote-argument
-			  (tramp-run-real-handler
-			   'file-name-directory (list localname))))
+                          (or (car (tramp-run-real-handler
+                               'insert-directory-wildcard-in-dir-p
+                               (list localname)))
+			      (tramp-run-real-handler
+			       'file-name-directory
+                               (list localname)))))
 	 "Couldn't `cd %s'"
 	 (tramp-shell-quote-argument
 	  (tramp-run-real-handler 'file-name-directory (list localname))))
@@ -2736,6 +2747,11 @@ tramp-sh-handle-insert-directory
 
 	  (goto-char (point-max)))))))
 
+(defun tramp-sh-handle-insert-directory-wildcard-in-dir-p (dir)
+  "Like `insert-directory-wildcard-in-dir-p' for Tramp files."
+  (with-parsed-tramp-file-name dir nil
+    (insert-directory-wildcard-in-dir-p localname)))
+
 ;; Canonicalization of file names.
 
 (defun tramp-sh-handle-expand-file-name (name &optional dir)

--8<-----------------------------cut here---------------end--------------->8---
In GNU Emacs 26.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.22.11)
 of 2017-07-13
Repository revision: 1f08279e1b20bd1e07132b6ee0a25a154811615a





  parent reply	other threads:[~2017-07-13 15:13 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
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 [this message]
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=877ezcxtd3.fsf@calancha-pc \
    --to=tino.calancha@gmail.com \
    --cc=27631@debbugs.gnu.org \
    --cc=michael.albinus@gmx.de \
    /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).