From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.devel Subject: Re: master 19a3b499f84: ; * lisp/loadup.el: Don't prohibit advice when ls-lisp is loaded. Date: Thu, 07 Dec 2023 15:06:38 -0500 Message-ID: References: <170177277759.6083.12155719482709043212@vcs2.savannah.gnu.org> <20231205103937.E1D65C405A8@vcs2.savannah.gnu.org> <020ab182-0e3d-4e8d-9415-c93863b95638@vodafonemail.de> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="11669"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: emacs-devel@gnu.org, Eli Zaretskii To: Jens Schmidt Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Thu Dec 07 21:07:37 2023 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1rBKen-0002p9-Gt for ged-emacs-devel@m.gmane-mx.org; Thu, 07 Dec 2023 21:07:37 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rBKe5-0008Fp-0C; Thu, 07 Dec 2023 15:06:53 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rBKe1-0008FI-0l for emacs-devel@gnu.org; Thu, 07 Dec 2023 15:06:49 -0500 Original-Received: from mailscanner.iro.umontreal.ca ([132.204.25.50]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rBKdw-0002RX-R7; Thu, 07 Dec 2023 15:06:48 -0500 Original-Received: from pmg1.iro.umontreal.ca (localhost.localdomain [127.0.0.1]) by pmg1.iro.umontreal.ca (Proxmox) with ESMTP id 8524510019F; Thu, 7 Dec 2023 15:06:42 -0500 (EST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=iro.umontreal.ca; s=mail; t=1701979599; bh=dVoGo+b/ATwJgtFUrL4uBMXYrIDrVNux1bBMorUWLN8=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=IyxetWEjG3/Pncyp6eWKTMRJLNsB+1+afuCn5oFcjpKvhdBG0EMH2beHbsZKzcSyv 8tSWJxMh+e/gx3u3myPzIK6ZcsJwiz5BVx5RwbevkgiolfQ+OxCLUIHYVBN7D+h8Hk cquFhb/yd7I7nJlYIFJgklzZgE72Ug3ICEq7JrLDdEZSzJEdx/ShURIrZYpJWCKDMT VgAmIP06dGajupfclWpD+DqpSf4H+zcSojKzLZHHaX+qk9VIG9y5ULylMoU70b0DIU p79mYNoZUOBwDG2Mq2a8lX4LK6UKkQ2ejgJd0n/Z7zJmGwAjRDmu0QDl8vA4TSG5aW CPzVBTjdps39w== Original-Received: from mail01.iro.umontreal.ca (unknown [172.31.2.1]) by pmg1.iro.umontreal.ca (Proxmox) with ESMTP id E0A43100189; Thu, 7 Dec 2023 15:06:39 -0500 (EST) Original-Received: from alfajor (modemcable005.21-80-70.mc.videotron.ca [70.80.21.5]) by mail01.iro.umontreal.ca (Postfix) with ESMTPSA id A4C4712044B; Thu, 7 Dec 2023 15:06:39 -0500 (EST) In-Reply-To: <020ab182-0e3d-4e8d-9415-c93863b95638@vodafonemail.de> (Jens Schmidt's message of "Wed, 6 Dec 2023 21:50:38 +0100") Received-SPF: pass client-ip=132.204.25.50; envelope-from=monnier@iro.umontreal.ca; helo=mailscanner.iro.umontreal.ca X-Spam_score_int: -42 X-Spam_score: -4.3 X-Spam_bar: ---- X-Spam_report: (-4.3 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, RCVD_IN_DNSWL_MED=-2.3, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.devel:313596 Archived-At: --=-=-= Content-Type: text/plain >> How 'bout we fix this as well? > I'd be glad if you can sort this out. However, there is a second > advice to be considered in ls-lisp.el, which you have not mentioned > yet: > (advice-add 'dired :around #'ls-lisp--dired) Indeed, that's because this advice is not active during preload (the `advice-add` already took place, but the function is not yet loaded, so the advice-object doesn't yet wrap it), but thanks for mentioning it. > AFAIU it fixes a special case where a file name contains wildcards > and ends in a slash: > > ;; When the wildcard ends in a slash, file-expand-wildcards > ;; returns nil; fix that by treating the wildcards as > ;; specifying only directories whose names match the > ;; widlcard. That's one part of its existence (for bug#60819). > I'm too lazy to check the history of this advice (and of > `file-expand-wildcards') right now, but this seems to be like a > stray bug fix that got implemented as an advice. Mostly agreed. I just sent a better(?) patch to bug#60819 which fixes `file-expand-wildcards' instead of changing the `ls-lisp--dired` advice. As for why we had this advice in the first place, it was introduced by: commit 6f6639d6ed6c6314b2643f6c22498fc2e23d34c7 Author: Tino Calancha Date: Sun Jul 30 11:02:49 2017 +0900 Dired: Handle posix wildcards in directory part Allow Dired to handle calls like \(dired \"~/foo/*/*.el\"), that is, with wildcards within the directory part of the file argument (Bug#27631). * 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 eshell-ls and ls-lisp. * etc/NEWS: Announce it. * doc/emacs/dired.texi (Dired Enter): Update manual. * test/lisp/dired-tests.el (dired-test-bug27631): Add test. Which "broke" `dired-insert-directory` by making it obey `ls-lisp-insert-directory-program` only when it comes to getting the listing but it still uses `insert-directory-program` (i.e. `ls`) in order to perform wildcard expansion. My WiP patch is attached. Stefan --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=ls-lisp-advice.patch diff --git a/lisp/dired.el b/lisp/dired.el index 7f4b96353ee..8407049b5f6 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -119,12 +119,11 @@ dired-chown-program (defcustom dired-use-ls-dired 'unspecified "Non-nil means Dired should pass the \"--dired\" option to \"ls\". If nil, don't pass \"--dired\" to \"ls\". -The special value of `unspecified' means to check whether \"ls\" -supports the \"--dired\" option, and save the result in this -variable. This is performed the first time `dired-insert-directory' -is invoked. (If `ls-lisp' is used by default, the test is performed -only if `ls-lisp-use-insert-directory-program' is non-nil, i.e., if -Dired actually uses \"ls\".) +The special value of `unspecified' means to check whether +`insert-directory-program' supports the \"--dired\" option, and save +the result in this variable. +This is performed the first time `dired-insert-directory' +invokes `insert-directory-program'. Note that if you set this option to nil, either through choice or because your \"ls\" program does not support \"--dired\", Dired @@ -1640,9 +1639,6 @@ dired-align-file (skip-chars-forward "^ ") (skip-chars-forward " ")) (set-marker file nil))))) - -(defvar ls-lisp-use-insert-directory-program) - (defun dired-check-switches (switches short &optional long) "Return non-nil if the string SWITCHES matches LONG or SHORT format." (let (case-fold-search) @@ -1673,11 +1669,8 @@ dired-insert-directory (remotep (file-remote-p dir)) end) (if (and - ;; Don't try to invoke `ls' if we are on DOS/Windows where - ;; ls-lisp emulation is used, except if they want to use `ls' - ;; as indicated by `ls-lisp-use-insert-directory-program'. - (not (and (featurep 'ls-lisp) - (null ls-lisp-use-insert-directory-program))) + ;; Don't try to invoke `ls' if ls-lisp emulation should be used. + (files--insert-directory-program) ;; FIXME: Big ugly hack for Eshell's eshell-ls-use-in-dired. (not (bound-and-true-p eshell-ls-use-in-dired)) (or remotep @@ -1698,8 +1691,9 @@ dired-insert-directory (unless remotep (setq switches (concat "--dired -N " switches)))) ;; Expand directory wildcards and fill file-list. - (let ((dir-wildcard (insert-directory-wildcard-in-dir-p dir))) - (cond (dir-wildcard + (let ((dir-wildcard (and (null file-list) wildcard + (insert-directory-wildcard-in-dir-p dir)))) + (cond ((and dir-wildcard (files--insert-directory-program)) (setq switches (concat "-d " switches)) (let* ((default-directory (car dir-wildcard)) (script (format "%s %s %s" @@ -1722,78 +1716,81 @@ dired-insert-directory (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)) + ;; 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'. + ((or file-list dir-wildcard) + (let ((default-directory + (or (car dir-wildcard) default-directory))) + (dolist (f (or file-list + (file-expand-wildcards (cdr dir-wildcard)))) + (let ((beg (point))) + (insert-directory f switches nil nil) + ;; Re-align fields, if necessary. + (dired-align-file beg (point)))))) + (t + (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 + (setq end (point-marker)) + (goto-char opoint) + (while (search-forward "\\" end t) + (replace-match (apply #'propertize + "\\\\" + (text-properties-at (match-beginning 0))) + nil t)) + (goto-char opoint) + (while (search-forward "\^m" end t) + (replace-match (apply #'propertize + "\\015" + (text-properties-at (match-beginning 0))) + nil t)) + (set-marker end nil)) + ;; Replace any newlines in DIR with literal "\n"s, for the sake + ;; of the header line. To disambiguate a literal "\n" in the + ;; actual dirname, we also replace "\" with "\\". + ;; Personally, I think this should always be done, irrespective + ;; of the value of dired-actual-switches, because: + ;; i) Dired simply does not work with an unescaped newline in + ;; the directory name used in the header (bug=10469#28), and + ;; ii) "\" is always replaced with "\\" in the listing, so doing + ;; it in the header as well makes things consistent. + ;; But at present it is only done if "-b" is in ls-switches, + ;; because newlines in dirnames are uncommon, and people may + ;; have gotten used to seeing unescaped "\" in the headers. + ;; Note: adjust dired-build-subdir-alist if you change this. + (setq dir (string-replace "\\" "\\\\" dir) + dir (string-replace "\n" "\\n" dir))) + ;; If we used --dired and it worked, the lines are already indented. + ;; Otherwise, indent them. + (unless (save-excursion + (goto-char opoint) + (looking-at-p " ")) + (let ((indent-tabs-mode nil)) + (indent-rigidly opoint (point) 2))) + ;; Insert text at the beginning to standardize things. + (let ((content-point opoint)) (save-excursion - (setq end (point-marker)) (goto-char opoint) - (while (search-forward "\\" end t) - (replace-match (apply #'propertize - "\\\\" - (text-properties-at (match-beginning 0))) - nil t)) - (goto-char opoint) - (while (search-forward "\^m" end t) - (replace-match (apply #'propertize - "\\015" - (text-properties-at (match-beginning 0))) - nil t)) - (set-marker end nil)) - ;; Replace any newlines in DIR with literal "\n"s, for the sake - ;; of the header line. To disambiguate a literal "\n" in the - ;; actual dirname, we also replace "\" with "\\". - ;; Personally, I think this should always be done, irrespective - ;; of the value of dired-actual-switches, because: - ;; i) Dired simply does not work with an unescaped newline in - ;; the directory name used in the header (bug=10469#28), and - ;; ii) "\" is always replaced with "\\" in the listing, so doing - ;; it in the header as well makes things consistent. - ;; But at present it is only done if "-b" is in ls-switches, - ;; because newlines in dirnames are uncommon, and people may - ;; have gotten used to seeing unescaped "\" in the headers. - ;; Note: adjust dired-build-subdir-alist if you change this. - (setq dir (string-replace "\\" "\\\\" dir) - dir (string-replace "\n" "\\n" dir))) - ;; If we used --dired and it worked, the lines are already indented. - ;; Otherwise, indent them. - (unless (save-excursion - (goto-char opoint) - (looking-at-p " ")) - (let ((indent-tabs-mode nil)) - (indent-rigidly opoint (point) 2))) - ;; Insert text at the beginning to standardize things. - (let ((content-point opoint)) - (save-excursion - (goto-char opoint) - (when (and (or hdr wildcard) - (not (and (looking-at "^ \\(.*\\):$") - (file-name-absolute-p (match-string 1))))) - ;; 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 " " (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 " (or (cdr-safe (insert-directory-wildcard-in-dir-p dir)) - (file-name-nondirectory dir)) - "\n")) - (setq content-point (dired--insert-disk-space opoint dir))) - (dired-insert-set-properties content-point (point))))) + (when (and (or hdr wildcard) + (not (and (looking-at "^ \\(.*\\):$") + (file-name-absolute-p (match-string 1))))) + ;; 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 " " (or (car-safe dir-wildcard) + (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 " (or (cdr-safe (insert-directory-wildcard-in-dir-p dir)) + (file-name-nondirectory dir)) + "\n")) + (setq content-point (dired--insert-disk-space opoint dir))) + (dired-insert-set-properties content-point (point)))))) (defun dired--insert-disk-space (beg file) ;; Try to insert the amount of free space. diff --git a/lisp/files.el b/lisp/files.el index 1cdcec23b11..5576e8927f2 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -7539,35 +7539,38 @@ file-expand-wildcards ;; if DIRPART contains wildcards. (dirs (if (and dirpart (string-match "[[*?]" (file-local-name dirpart))) - (mapcar 'file-name-as-directory + (mapcar #'file-name-as-directory (file-expand-wildcards (directory-file-name dirpart) nil regexp)) (list dirpart))) contents) (dolist (dir dirs) - (when (or (null dir) ; Possible if DIRPART is not wild. + (when (or (null dir) ; Possible if DIRPART is not wild. (file-accessible-directory-p dir)) - (let ((this-dir-contents - ;; Filter out "." and ".." - (delq nil - (mapcar (lambda (name) - (unless (string-match "\\`\\.\\.?\\'" - (file-name-nondirectory name)) - name)) - (directory-files - (or dir ".") full - (if regexp - ;; We're matching each file name - ;; element separately. - (concat "\\`" nondir "\\'") - (wildcard-to-regexp nondir))))))) - (setq contents - (nconc - (if (and dir (not full)) - (mapcar (lambda (name) (concat dir name)) - this-dir-contents) - this-dir-contents) - contents))))) + (if (equal "" nondir) + (push (or dir nondir) contents) + (let ((this-dir-contents + ;; Filter out "." and ".." + (delq nil + (mapcar (lambda (name) + (unless (string-match "\\`\\.\\.?\\'" + (file-name-nondirectory + name)) + name)) + (directory-files + (or dir ".") full + (if regexp + ;; We're matching each file name + ;; element separately. + (concat "\\`" nondir "\\'") + (wildcard-to-regexp nondir))))))) + (setq contents + (nconc + (if (and dir (not full)) + (mapcar (lambda (name) (concat dir name)) + this-dir-contents) + this-dir-contents) + contents)))))) contents))) (defcustom find-sibling-rules nil @@ -7757,7 +7760,7 @@ insert-directory-program (purecopy "ls")) "Absolute or relative name of the `ls'-like program. This is used by `insert-directory' and `dired-insert-directory' -(thus, also by `dired'). For Dired, this should ideally point to +\(thus, also by `dired'). For Dired, this should ideally point to GNU ls, or another version of ls that supports the \"--dired\" flag. See `dired-use-ls-dired'. @@ -7773,6 +7776,13 @@ insert-directory-program :initialize #'custom-initialize-delay :version "30.1") +(defun files--insert-directory-program () + ;; FIXME: Should we also check `file-accessible-directory-p' so we + ;; automatically redirect to ls-lisp when operating on magic file names? + (and (or (not (boundp 'ls-lisp-use-insert-directory-program)) + ls-lisp-use-insert-directory-program) + insert-directory-program)) + (defcustom directory-free-space-program (purecopy "df") "Program to get the amount of free space on a file system. We assume the output has the format of `df'. @@ -7976,184 +7986,190 @@ insert-directory ;; We need the directory in order to find the right handler. (let ((handler (find-file-name-handler (expand-file-name file) 'insert-directory))) - (if handler - (funcall handler 'insert-directory file switches - wildcard full-directory-p) - (let (result (beg (point))) - - ;; Read the actual directory using `insert-directory-program'. - ;; RESULT gets the status code. - (let* (;; We at first read by no-conversion, then after - ;; putting text property `dired-filename, decode one - ;; bunch by one to preserve that property. - (coding-system-for-read 'no-conversion) - ;; This is to control encoding the arguments in call-process. - (coding-system-for-write - (and enable-multibyte-characters - (or file-name-coding-system - 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)))) - ;; NB since switches is passed to the shell, be - ;; careful of malicious values, eg "-l;reboot". - ;; See eg dired-safe-switches-p. - (call-process - shell-file-name nil t nil - shell-command-switch - (concat (if (memq system-type '(ms-dos windows-nt)) - "" - "\\") ; Disregard Unix shell aliases! - insert-directory-program - " -d " - (if (stringp switches) - switches - (mapconcat 'identity switches " ")) - " -- " - ;; Quote some characters that have - ;; special meanings in shells; but - ;; don't quote the wildcards--we want - ;; them to be special. We also - ;; currently don't quote the quoting - ;; characters in case people want to - ;; use them explicitly to quote - ;; wildcard characters. - (shell-quote-wildcard-pattern pattern)))) - ;; SunOS 4.1.3, SVr4 and others need the "." to list the - ;; directory if FILE is a symbolic link. - (unless full-directory-p - (setq switches - (cond - ((stringp switches) (concat switches " -d")) - ((member "-d" switches) switches) - (t (append switches '("-d")))))) - (if (string-match "\\`~" file) - (setq file (expand-file-name file))) - (apply 'call-process - insert-directory-program nil t nil - (append - (if (listp switches) switches - (unless (equal switches "") - ;; Split the switches at any spaces so we can - ;; pass separate options as separate args. - (split-string-and-unquote switches))) - ;; Avoid lossage if FILE starts with `-'. - '("--") - (list file)))))) - - ;; If we got "//DIRED//" in the output, it means we got a real - ;; directory listing, even if `ls' returned nonzero. - ;; So ignore any errors. - (when (if (stringp switches) - (string-match "--dired\\>" switches) - (member "--dired" switches)) - (save-excursion - (forward-line -2) - (when (looking-at "//SUBDIRED//") - (forward-line -1)) - (if (looking-at "//DIRED//") - (setq result 0)))) - - (when (and (not (eq 0 result)) - (eq insert-directory-ls-version 'unknown)) - ;; The first time ls returns an error, - ;; find the version numbers of ls, - ;; and set insert-directory-ls-version - ;; to > if it is more than 5.2.1, < if it is less, nil if it - ;; is equal or if the info cannot be obtained. - ;; (That can mean it isn't GNU ls.) - (let ((version-out - (with-temp-buffer - (call-process "ls" nil t nil "--version") - (buffer-string)))) - (if (string-match "ls (.*utils) \\([0-9.]*\\)$" version-out) - (let* ((version (match-string 1 version-out)) - (split (split-string version "[.]")) - (numbers (mapcar 'string-to-number split)) - (min '(5 2 1)) - comparison) - (while (and (not comparison) (or numbers min)) - (cond ((null min) - (setq comparison '>)) - ((null numbers) - (setq comparison '<)) - ((> (car numbers) (car min)) - (setq comparison '>)) - ((< (car numbers) (car min)) - (setq comparison '<)) - (t - (setq numbers (cdr numbers) - min (cdr min))))) - (setq insert-directory-ls-version (or comparison '=))) - (setq insert-directory-ls-version nil)))) - - ;; For GNU ls versions 5.2.2 and up, ignore minor errors. - (when (and (eq 1 result) (eq insert-directory-ls-version '>)) - (setq result 0)) - - ;; If `insert-directory-program' failed, signal an error. - (unless (eq 0 result) - ;; Delete the error message it may have output. - (delete-region beg (point)) - ;; On non-Posix systems, we cannot open a directory, so - ;; don't even try, because that will always result in - ;; the ubiquitous "Access denied". Instead, show the - ;; command line so the user can try to guess what went wrong. - (if (and (file-directory-p file) - (memq system-type '(ms-dos windows-nt))) - (error - "Reading directory: \"%s %s -- %s\" exited with status %s" - insert-directory-program - (if (listp switches) (concat switches) switches) - file result) - ;; Unix. Access the file to get a suitable error. - (access-file file "Reading directory") - (error "Listing directory failed but `access-file' worked"))) - (insert-directory-clean beg switches) - ;; Now decode what read if necessary. - (let ((coding (or coding-system-for-read - file-name-coding-system - default-file-name-coding-system - 'undecided)) - coding-no-eol - val pos) - (when (and enable-multibyte-characters - (not (memq (coding-system-base coding) - '(raw-text no-conversion)))) - ;; If no coding system is specified or detection is - ;; requested, detect the coding. - (if (eq (coding-system-base coding) 'undecided) - (setq coding (detect-coding-region beg (point) t))) - (if (not (eq (coding-system-base coding) 'undecided)) - (save-restriction - (setq coding-no-eol - (coding-system-change-eol-conversion coding 'unix)) - (narrow-to-region beg (point)) - (goto-char (point-min)) - (while (not (eobp)) - (setq pos (point) - val (get-text-property (point) 'dired-filename)) - (goto-char (next-single-property-change - (point) 'dired-filename nil (point-max))) - ;; Force no eol conversion on a file name, so - ;; that CR is preserved. - (decode-coding-region pos (point) - (if val coding-no-eol coding)) - (if val - (put-text-property pos (point) - 'dired-filename t))))))))))) + (cond + (handler + (funcall handler 'insert-directory file switches + wildcard full-directory-p)) + ((not (files--insert-directory-program)) + (require 'ls-lisp) + (declare-function ls-lisp--insert-directory "ls-lisp") + (ls-lisp--insert-directory file switches wildcard full-directory-p)) + (t + (let (result (beg (point))) + + ;; Read the actual directory using `insert-directory-program'. + ;; RESULT gets the status code. + (let* (;; We at first read by no-conversion, then after + ;; putting text property `dired-filename, decode one + ;; bunch by one to preserve that property. + (coding-system-for-read 'no-conversion) + ;; This is to control encoding the arguments in call-process. + (coding-system-for-write + (and enable-multibyte-characters + (or file-name-coding-system + 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)))) + ;; NB since switches is passed to the shell, be + ;; careful of malicious values, eg "-l;reboot". + ;; See eg dired-safe-switches-p. + (call-process + shell-file-name nil t nil + shell-command-switch + (concat (if (memq system-type '(ms-dos windows-nt)) + "" + "\\") ; Disregard Unix shell aliases! + insert-directory-program + " -d " + (if (stringp switches) + switches + (mapconcat 'identity switches " ")) + " -- " + ;; Quote some characters that have + ;; special meanings in shells; but + ;; don't quote the wildcards--we want + ;; them to be special. We also + ;; currently don't quote the quoting + ;; characters in case people want to + ;; use them explicitly to quote + ;; wildcard characters. + (shell-quote-wildcard-pattern pattern)))) + ;; SunOS 4.1.3, SVr4 and others need the "." to list the + ;; directory if FILE is a symbolic link. + (unless full-directory-p + (setq switches + (cond + ((stringp switches) (concat switches " -d")) + ((member "-d" switches) switches) + (t (append switches '("-d")))))) + (if (string-match "\\`~" file) + (setq file (expand-file-name file))) + (apply #'call-process + insert-directory-program nil t nil + (append + (if (listp switches) switches + (unless (equal switches "") + ;; Split the switches at any spaces so we can + ;; pass separate options as separate args. + (split-string-and-unquote switches))) + ;; Avoid lossage if FILE starts with `-'. + '("--") + (list file)))))) + + ;; If we got "//DIRED//" in the output, it means we got a real + ;; directory listing, even if `ls' returned nonzero. + ;; So ignore any errors. + (when (if (stringp switches) + (string-match "--dired\\>" switches) + (member "--dired" switches)) + (save-excursion + (forward-line -2) + (when (looking-at "//SUBDIRED//") + (forward-line -1)) + (if (looking-at "//DIRED//") + (setq result 0)))) + + (when (and (not (eq 0 result)) + (eq insert-directory-ls-version 'unknown)) + ;; The first time ls returns an error, + ;; find the version numbers of ls, + ;; and set insert-directory-ls-version + ;; to > if it is more than 5.2.1, < if it is less, nil if it + ;; is equal or if the info cannot be obtained. + ;; (That can mean it isn't GNU ls.) + (let ((version-out + (with-temp-buffer + (call-process "ls" nil t nil "--version") + (buffer-string)))) + (if (string-match "ls (.*utils) \\([0-9.]*\\)$" version-out) + (let* ((version (match-string 1 version-out)) + (split (split-string version "[.]")) + (numbers (mapcar 'string-to-number split)) + (min '(5 2 1)) + comparison) + (while (and (not comparison) (or numbers min)) + (cond ((null min) + (setq comparison '>)) + ((null numbers) + (setq comparison '<)) + ((> (car numbers) (car min)) + (setq comparison '>)) + ((< (car numbers) (car min)) + (setq comparison '<)) + (t + (setq numbers (cdr numbers) + min (cdr min))))) + (setq insert-directory-ls-version (or comparison '=))) + (setq insert-directory-ls-version nil)))) + + ;; For GNU ls versions 5.2.2 and up, ignore minor errors. + (when (and (eq 1 result) (eq insert-directory-ls-version '>)) + (setq result 0)) + + ;; If `insert-directory-program' failed, signal an error. + (unless (eq 0 result) + ;; Delete the error message it may have output. + (delete-region beg (point)) + ;; On non-Posix systems, we cannot open a directory, so + ;; don't even try, because that will always result in + ;; the ubiquitous "Access denied". Instead, show the + ;; command line so the user can try to guess what went wrong. + (if (and (file-directory-p file) + (memq system-type '(ms-dos windows-nt))) + (error + "Reading directory: \"%s %s -- %s\" exited with status %s" + insert-directory-program + (if (listp switches) (concat switches) switches) + file result) + ;; Unix. Access the file to get a suitable error. + (access-file file "Reading directory") + (error "Listing directory failed but `access-file' worked"))) + (insert-directory-clean beg switches) + ;; Now decode what read if necessary. + (let ((coding (or coding-system-for-read + file-name-coding-system + default-file-name-coding-system + 'undecided)) + coding-no-eol + val pos) + (when (and enable-multibyte-characters + (not (memq (coding-system-base coding) + '(raw-text no-conversion)))) + ;; If no coding system is specified or detection is + ;; requested, detect the coding. + (if (eq (coding-system-base coding) 'undecided) + (setq coding (detect-coding-region beg (point) t))) + (if (not (eq (coding-system-base coding) 'undecided)) + (save-restriction + (setq coding-no-eol + (coding-system-change-eol-conversion coding 'unix)) + (narrow-to-region beg (point)) + (goto-char (point-min)) + (while (not (eobp)) + (setq pos (point) + val (get-text-property (point) 'dired-filename)) + (goto-char (next-single-property-change + (point) 'dired-filename nil (point-max))) + ;; Force no eol conversion on a file name, so + ;; that CR is preserved. + (decode-coding-region pos (point) + (if val coding-no-eol coding)) + (if val + (put-text-property pos (point) + 'dired-filename t)))))))))))) (defun insert-directory-adj-pos (pos error-lines) "Convert `ls --dired' file name position value POS to a buffer position. diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index c576819c5d0..e3466680739 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -249,7 +249,7 @@ ls-lisp-filesize-b-fmt ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun ls-lisp--insert-directory (orig-fun file switches &optional wildcard full-directory-p) +(defun ls-lisp--insert-directory (file switches wildcard full-directory-p) "Insert directory listing for FILE, formatted according to SWITCHES. Leaves point after the inserted text. SWITCHES may be a string of options, or a list of strings. @@ -272,66 +272,56 @@ ls-lisp--insert-directory is assumed to be always present and cannot be turned off. Long variants of the above switches, as documented for GNU `ls', are also supported; unsupported long options are silently ignored." - (if ls-lisp-use-insert-directory-program - (funcall orig-fun - file switches wildcard full-directory-p) - ;; We need the directory in order to find the right handler. - (setq switches (or switches "")) - (let ((handler (find-file-name-handler (expand-file-name file) - 'insert-directory)) - (orig-file file) - wildcard-regexp - (ls-lisp-dirs-first - (or ls-lisp-dirs-first - (string-match "--group-directories-first" switches)))) - (if handler - (funcall handler 'insert-directory file switches - wildcard full-directory-p) - (when (string-match "--group-directories-first" switches) - ;; if ls-lisp-dirs-first is nil, dirs are grouped but come out in - ;; reverse order: - (setq ls-lisp-dirs-first t) - (setq switches (replace-match "" nil nil switches))) - ;; Remove unrecognized long options, and convert the - ;; recognized ones to their short variants. - (setq switches (ls-lisp--sanitize-switches switches)) - ;; Convert SWITCHES to a list of characters. - (setq switches (delete ?\ (delete ?- (append switches nil)))) - ;; Sometimes we get ".../foo*/" as FILE. While the shell and - ;; `ls' don't mind, we certainly do, because it makes us think - ;; there is no wildcard, only a directory name. - (if (and ls-lisp-support-shell-wildcards - (string-match "[[?*]" file) - ;; Prefer an existing file to wildcards, like - ;; dired-noselect does. - (not (file-exists-p file))) - (progn - (or (not (eq (aref file (1- (length file))) ?/)) - (setq file (substring file 0 (1- (length file))))) - (setq wildcard t))) - (if wildcard - (setq wildcard-regexp - (if ls-lisp-support-shell-wildcards - (wildcard-to-regexp (file-name-nondirectory file)) - (file-name-nondirectory file)) - file (file-name-directory file)) - (if (memq ?B switches) (setq wildcard-regexp "[^~]\\'"))) - (condition-case err - (ls-lisp-insert-directory - file switches (ls-lisp-time-index switches) - wildcard-regexp full-directory-p) - (invalid-regexp - ;; Maybe they wanted a literal file that just happens to - ;; use characters special to shell wildcards. - (if (equal (cadr err) "Unmatched [ or [^") - (progn - (setq wildcard-regexp (if (memq ?B switches) "[^~]\\'") - file (file-relative-name orig-file)) - (ls-lisp-insert-directory - file switches (ls-lisp-time-index switches) - nil full-directory-p)) - (signal (car err) (cdr err))))))))) -(advice-add 'insert-directory :around #'ls-lisp--insert-directory) + (setq switches (or switches "")) + (let ((orig-file file) + wildcard-regexp + (ls-lisp-dirs-first + (or ls-lisp-dirs-first + (string-match "--group-directories-first" switches)))) + (when (string-match "--group-directories-first" switches) + ;; if ls-lisp-dirs-first is nil, dirs are grouped but come out in + ;; reverse order: + (setq ls-lisp-dirs-first t) + (setq switches (replace-match "" nil nil switches))) + ;; Remove unrecognized long options, and convert the + ;; recognized ones to their short variants. + (setq switches (ls-lisp--sanitize-switches switches)) + ;; Convert SWITCHES to a list of characters. + (setq switches (delete ?\ (delete ?- (append switches nil)))) + ;; Sometimes we get ".../foo*/" as FILE. While the shell and + ;; `ls' don't mind, we certainly do, because it makes us think + ;; there is no wildcard, only a directory name. + (if (and ls-lisp-support-shell-wildcards + (string-match "[[?*]" file) + ;; Prefer an existing file to wildcards, like + ;; dired-noselect does. + (not (file-exists-p file))) + (progn + (or (not (eq (aref file (1- (length file))) ?/)) + (setq file (substring file 0 (1- (length file))))) + (setq wildcard t))) + (if wildcard + (setq wildcard-regexp + (if ls-lisp-support-shell-wildcards + (wildcard-to-regexp (file-name-nondirectory file)) + (file-name-nondirectory file)) + file (file-name-directory file)) + (if (memq ?B switches) (setq wildcard-regexp "[^~]\\'"))) + (condition-case err + (ls-lisp-insert-directory + file switches (ls-lisp-time-index switches) + wildcard-regexp full-directory-p) + (invalid-regexp + ;; Maybe they wanted a literal file that just happens to + ;; use characters special to shell wildcards. + (if (equal (cadr err) "Unmatched [ or [^") + (progn + (setq wildcard-regexp (if (memq ?B switches) "[^~]\\'") + file (file-relative-name orig-file)) + (ls-lisp-insert-directory + file switches (ls-lisp-time-index switches) + nil full-directory-p)) + (signal (car err) (cdr err))))))) (defun ls-lisp-insert-directory (file switches time-index wildcard-regexp full-directory-p) @@ -469,50 +459,6 @@ ls-lisp-insert-directory "Directory doesn't exist or is inaccessible" file)))))) -(declare-function dired-read-dir-and-switches "dired" (str)) -(declare-function dired-goto-next-file "dired" ()) - -(defun ls-lisp--dired (orig-fun dir-or-list &optional switches) - (interactive (dired-read-dir-and-switches "")) - (unless dir-or-list - (setq dir-or-list default-directory)) - (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)) - (wildcard (cdr dir-wildcard)) - (files (file-expand-wildcards wildcard)) - (dir (car dir-wildcard))) - ;; When the wildcard ends in a slash, file-expand-wildcards - ;; returns nil; fix that by treating the wildcards as - ;; specifying only directories whose names match the - ;; widlcard. - (if (and (null files) - (directory-name-p wildcard)) - (setq files - (delq nil - (mapcar (lambda (fname) - (if (file-accessible-directory-p fname) - fname)) - (file-expand-wildcards - (directory-file-name 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 wildcard"))))))) - -(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 @@ -902,7 +848,6 @@ ls-lisp-format-file-size (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) --=-=-=--