From: Stefan Monnier Date: Sun, 10 Dec 2023 04:45:56 +0000 (-0500) Subject: (insert-directory): Remove `ls-lisp` advice X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=29957969e5199bdab5612af68e33b3989e4bbbd2;p=emacs.git (insert-directory): Remove `ls-lisp` advice Rather than have `ls-lisp` advise `insert-directory`, make `insert-directory` call `ls-lisp.el` code directly when needed. * lisp/files.el (files--use-insert-directory-program-p): New function. (insert-directory): Use it to delegate to `ls-lisp--insert-directory` when applicable. * lisp/ls-lisp.el (ls-lisp--insert-directory): Remove `orig-fun` arg. Don't test `ls-lisp-use-insert-directory-program` or check for a magic file name handler; it is now the caller's responsibility. (insert-directory): Don't add advice any more. * lisp/dired.el (ls-lisp-use-insert-directory-program): Don't declare it. (dired-insert-directory): Use `files--use-insert-directory-program-p` instead. (dired-use-ls-dired): Adjust docstring to refer to `insert-directory-program` rather than "ls". --- diff --git a/lisp/dired.el b/lisp/dired.el index 9162dfbdf4b..c11b107213b 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -119,12 +119,11 @@ checks this alist to enable globstar in the shell subprocess.") (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 @@ -1643,9 +1642,6 @@ BEG..END is the line where the file info is located." (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) @@ -1676,11 +1672,8 @@ If HDR is non-nil, insert a header line with the directory name." (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--use-insert-directory-program-p) ;; FIXME: Big ugly hack for Eshell's eshell-ls-use-in-dired. (not (bound-and-true-p eshell-ls-use-in-dired)) (or remotep diff --git a/lisp/files.el b/lisp/files.el index 3c1d0c30e67..5e1987ec2ff 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -7780,6 +7780,16 @@ installing GNU coreutils using something like ports or Homebrew." :initialize #'custom-initialize-delay :version "30.1") +(defun files--use-insert-directory-program-p () + "Return non-nil if we should use `insert-directory-program'. +Return nil if we should prefer `ls-lisp' instead." + ;; FIXME: Should we also check `file-accessible-directory-p' so we + ;; automatically redirect to ls-lisp when operating on magic file names? + (and (if (boundp 'ls-lisp-use-insert-directory-program) + ls-lisp-use-insert-directory-program + t) + 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'. @@ -7972,9 +7982,11 @@ Optional third arg WILDCARD means treat FILE as shell wildcard. Optional fourth arg FULL-DIRECTORY-P means file is a directory and switches do not contain `d', so that a full listing is expected. -This works by running a directory listing program -whose name is in the variable `insert-directory-program'. -If WILDCARD, it also runs the shell specified by `shell-file-name'. +Depending on the value of `ls-lisp-use-insert-directory-program' +this works either using a Lisp emulation of the \"ls\" program +or by running a directory listing program +whose name is in the variable `insert-directory-program' +\(and if WILDCARD, it also runs the shell specified by `shell-file-name'). When SWITCHES contains the long `--dired' option, this function treats it specially, for the sake of dired. However, the @@ -7983,184 +7995,191 @@ normally equivalent short `-D' option is just passed on to ;; 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--use-insert-directory-program-p)) + (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)))) + (setq insert-directory-ls-version + (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))))) + (or comparison #'=)) + 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 1066f38c050..141d1f32c09 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -249,89 +249,69 @@ to fail to line up, e.g. if month names are not all of the same length." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(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. -Optional third arg WILDCARD means treat FILE as shell wildcard. -Optional fourth arg FULL-DIRECTORY-P means file is a directory and -switches do not contain `d', so that a full listing is expected. - -This version of the function comes from `ls-lisp.el'. -If the value of `ls-lisp-use-insert-directory-program' is non-nil then -this advice just delegates the work to ORIG-FUN (the normal `insert-directory' -function from `files.el'). -But if the value of `ls-lisp-use-insert-directory-program' is nil -then it runs a Lisp emulation. - -The Lisp emulation does not run any external programs or shells. It -supports ordinary shell wildcards if `ls-lisp-support-shell-wildcards' +This implementation of `insert-directory' works using Lisp functions rather +than `insert-directory-program'. + +This Lisp emulation does not run any external programs or shells. + It supports ordinary shell wildcards if `ls-lisp-support-shell-wildcards' is non-nil; otherwise, it interprets wildcards as regular expressions to match file names. It does not support all `ls' switches -- those that work are: A a B C c F G g h i n R r S s t U u v X. The l switch 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) @@ -888,7 +868,6 @@ All ls time options, namely c, t and u, are handled." (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)