* Re: master 19a3b499f84: ; * lisp/loadup.el: Don't prohibit advice when ls-lisp is loaded.
2023-12-06 20:50 ` Jens Schmidt
@ 2023-12-07 20:06 ` Stefan Monnier
2023-12-07 22:25 ` Jens Schmidt
0 siblings, 1 reply; 16+ messages in thread
From: Stefan Monnier @ 2023-12-07 20:06 UTC (permalink / raw)
To: Jens Schmidt; +Cc: emacs-devel, Eli Zaretskii
[-- Attachment #1: Type: text/plain, Size: 2677 bytes --]
>> 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 <ccalancha@suse.com>
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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: ls-lisp-advice.patch --]
[-- Type: text/x-diff, Size: 37054 bytes --]
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
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(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)
^ permalink raw reply related [flat|nested] 16+ messages in thread