From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.bugs Subject: bug#27631: dired a/*/b Date: Wed, 02 Aug 2017 13:30:40 -0400 Message-ID: References: <87o9sth2oi.fsf@jidanni.org> <8737a0yjbg.fsf@calancha-pc> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: blaine.gmane.org 1501695180 25742 195.159.176.226 (2 Aug 2017 17:33:00 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Wed, 2 Aug 2017 17:33:00 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.0.50 (gnu/linux) Cc: 27631@debbugs.gnu.org, =?UTF-8?Q?=E7=A9=8D=E4=B8=B9=E5=B0=BC?= Dan Jacobson To: Tino Calancha Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Wed Aug 02 19:32:56 2017 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dcxVv-0006My-AW for geb-bug-gnu-emacs@m.gmane.org; Wed, 02 Aug 2017 19:32:55 +0200 Original-Received: from localhost ([::1]:48884 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dcxW1-0007ww-0V for geb-bug-gnu-emacs@m.gmane.org; Wed, 02 Aug 2017 13:33:01 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:40397) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dcxUA-0006rL-JK for bug-gnu-emacs@gnu.org; Wed, 02 Aug 2017 13:31:08 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dcxU6-0003DJ-L3 for bug-gnu-emacs@gnu.org; Wed, 02 Aug 2017 13:31:06 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:35978) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dcxU6-0003D7-H0 for bug-gnu-emacs@gnu.org; Wed, 02 Aug 2017 13:31:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dcxU6-0003gA-02 for bug-gnu-emacs@gnu.org; Wed, 02 Aug 2017 13:31:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Stefan Monnier Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 02 Aug 2017 17:31:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 27631 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 27631-submit@debbugs.gnu.org id=B27631.150169504713379 (code B ref 27631); Wed, 02 Aug 2017 17:31:01 +0000 Original-Received: (at 27631) by debbugs.gnu.org; 2 Aug 2017 17:30:47 +0000 Original-Received: from localhost ([127.0.0.1]:38655 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dcxTq-0003TD-VJ for submit@debbugs.gnu.org; Wed, 02 Aug 2017 13:30:47 -0400 Original-Received: from chene.dit.umontreal.ca ([132.204.246.20]:54143) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dcxTn-0003PQ-TC for 27631@debbugs.gnu.org; Wed, 02 Aug 2017 13:30:45 -0400 Original-Received: from ceviche.home (lechon.iro.umontreal.ca [132.204.27.242]) by chene.dit.umontreal.ca (8.14.7/8.14.1) with ESMTP id v72HUfRP018640; Wed, 2 Aug 2017 13:30:42 -0400 Original-Received: by ceviche.home (Postfix, from userid 20848) id BA21866142; Wed, 2 Aug 2017 13:30:40 -0400 (EDT) In-Reply-To: <8737a0yjbg.fsf@calancha-pc> (Tino Calancha's message of "Thu, 13 Jul 2017 14:52:51 +0900") X-NAI-Spam-Flag: NO X-NAI-Spam-Threshold: 5 X-NAI-Spam-Score: 0 X-NAI-Spam-Rules: 2 Rules triggered EDT_SA_DN_PASS=0, RV6085=0 X-NAI-Spam-Version: 2.3.0.9418 : core <6085> : inlines <6005> : streams <1756873> : uri <2475005> X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:135245 Archived-At: >> 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. I'm not sure the recent patch for this fix is the right approach. The old code already used the shell to do the wildcard expansion, so why not just adjust the old code. Here's some starting patch. Stefan diff --git a/lisp/dired.el b/lisp/dired.el index 24759c6c9b..29755712cf 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1089,25 +1038,31 @@ dired-readin (defun dired-readin-insert () ;; Insert listing for the specified dir (and maybe file list) ;; already in dired-directory, assuming a clean buffer. - (let (dir file-list) - (if (consp dired-directory) - (setq dir (car dired-directory) - file-list (cdr dired-directory)) - (setq dir dired-directory - file-list nil)) - (setq dir (expand-file-name dir)) + (let* ((dir (expand-file-name + (if (consp dired-directory) + (car dired-directory) + dired-directory))) + (file-list (cdr-safe dired-directory)) + (wildcard (not file-list))) + (unless (file-directory-p dir) + (unless file-list (setq file-list '(""))) + (while (not (file-directory-p dir)) + (setq dir (directory-file-name dir)) + (let ((n (file-name-nondirectory dir))) + (setq file-list (mapcar (lambda (f) (concat n "/" f)) file-list))) + (setq dir (file-name-directory dir))) + (setq default-directory dir)) (if (and (equal "" (file-name-nondirectory dir)) (not file-list)) ;; If we are reading a whole single directory... (dired-insert-directory dir dired-actual-switches nil nil 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)))) + (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 wildcard t))))) (defun dired-align-file (beg end) "Align the fields of a file to the ones of surrounding lines. @@ -1252,56 +1207,29 @@ dired-insert-directory ;; as indicated by `ls-lisp-use-insert-directory-program'. (not (and (featurep 'ls-lisp) (null ls-lisp-use-insert-directory-program))) - (not (and (featurep 'eshell) - (bound-and-true-p eshell-ls-use-in-dired))) - (or (file-remote-p dir) - (if (eq dired-use-ls-dired 'unspecified) + (or (if (eq dired-use-ls-dired 'unspecified) ;; Check whether "ls --dired" gives exit code 0, and ;; save the answer in `dired-use-ls-dired'. (or (setq dired-use-ls-dired (eq 0 (call-process insert-directory-program - nil nil nil "--dired"))) + nil nil nil "--dired"))) (progn (message "ls does not support --dired; \ see `dired-use-ls-dired' for more details.") nil)) - dired-use-ls-dired))) + dired-use-ls-dired) + (file-remote-p dir))) (setq switches (concat "--dired " switches))) - ;; 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)) - ;; We don't know whether the remote ls supports - ;; "--dired", so we cannot add it to the `process-file' - ;; call for wildcards. - (when (file-remote-p dir) - (setq switches (dired-replace-in-string "--dired" "" switches))) - (let* ((default-directory (car dir-wildcard)) - (script (format "ls %s %s" switches (cdr dir-wildcard))) - (remotep (file-remote-p dir)) - (sh (or (and remotep "/bin/sh") - (and (bound-and-true-p explicit-shell-file-name) - (executable-find explicit-shell-file-name)) - (executable-find "sh"))) - (switch (if remotep "-c" shell-command-switch))) - (unless - (zerop - (process-file sh nil (current-buffer) nil switch 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)))))) + ;; 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 wildcard 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 diff --git a/lisp/files.el b/lisp/files.el index 96647fb262..1f69391d51 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6683,19 +6608,15 @@ insert-directory default-file-name-coding-system)))) (setq result (if wildcard - ;; 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)))) + ;; 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) + default-directory)) + (pattern (if (file-name-absolute-p file) + (file-name-nondirectory file) + file))) ;; NB since switches is passed to the shell, be ;; careful of malicious values, eg "-l;reboot". ;; See eg dired-safe-switches-p.