emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master 93dea9288a8: Merge branch 'no-ls-lisp-advice'


From: Stefan Monnier
Subject: master 93dea9288a8: Merge branch 'no-ls-lisp-advice'
Date: Thu, 21 Dec 2023 09:40:02 -0500 (EST)

branch: master
commit 93dea9288a82e00d6dfc97acd554a242b11d1501
Merge: 843cbb9a15a ec898e94b3d
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    Merge branch 'no-ls-lisp-advice'
---
 lisp/dired.el              | 192 +++++++++++------------
 lisp/files.el              | 381 ++++++++++++++++++++++++---------------------
 lisp/ls-lisp.el            | 169 +++++++-------------
 test/lisp/dired-tests.el   |   4 +-
 test/lisp/ls-lisp-tests.el |   7 -
 5 files changed, 354 insertions(+), 399 deletions(-)

diff --git a/lisp/dired.el b/lisp/dired.el
index 33e38ed2c1c..357787b6495 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -121,12 +121,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
@@ -1524,18 +1523,21 @@ wildcards, erases the buffer, and builds the 
subdir-alist anew
       (setq dir dired-directory
            file-list nil))
     (setq dir (expand-file-name dir))
-    (if (and (equal "" (file-name-nondirectory dir))
-            (not file-list))
-       ;; If we are reading a whole single directory...
-       (dired-insert-directory dir dired-actual-switches nil nil t)
-      (if (and (not (insert-directory-wildcard-in-dir-p dir))
-               (not (file-readable-p
-                    (directory-file-name (file-name-directory dir)))))
-         (error "Directory %s inaccessible or nonexistent" dir))
+    (cond
+     ((and (equal "" (file-name-nondirectory dir))
+           (not file-list))
+      ;; If we are reading a whole single directory...
+      (dired-insert-directory dir dired-actual-switches nil
+                              (not (file-directory-p dir)) t))
+     ((not (or (insert-directory-wildcard-in-dir-p dir)
+               (file-readable-p
+                (directory-file-name (file-name-directory dir)))))
+      (error "Directory %s inaccessible or nonexistent" dir))
+     (t
       ;; Else treat it as a wildcard spec
       ;; unless we have an explicit list of files.
       (dired-insert-directory dir dired-actual-switches
-                             file-list (not file-list) t))))
+       file-list (not file-list) t)))))
 
 (defun dired-align-file (beg end)
   "Align the fields of a file to the ones of surrounding lines.
@@ -1544,7 +1546,7 @@ BEG..END is the line where the file info is located."
   ;; hold the largest element ("largest" in the current invocation, of
   ;; course).  So when a single line is output, the size of each field is
   ;; just big enough for that one output.  Thus when dired refreshes one
-  ;; line, the alignment if this line w.r.t the rest is messed up because
+  ;; line, the alignment of this line w.r.t the rest is messed up because
   ;; the fields of that one line will generally be smaller.
   ;;
   ;; To work around this problem, we here add spaces to try and
@@ -1643,9 +1645,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 +1675,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
@@ -1701,8 +1697,9 @@ see `dired-use-ls-dired' for more details.")
         (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--use-insert-directory-program-p))
              (setq switches (concat "-d " switches))
              (let* ((default-directory (car dir-wildcard))
                     (script (format "%s %s %s"
@@ -1725,78 +1722,81 @@ see `dired-use-ls-dired' for more details.")
                  (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 cc15f50103f..5efd4309214 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -7788,6 +7788,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'.
@@ -7980,9 +7990,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
@@ -7991,184 +8003,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..c0a52d76a25 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)
@@ -469,36 +449,6 @@ not contain `d', so that a full listing is expected."
                       "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))
-               (files (file-expand-wildcards (cdr dir-wildcard)))
-               (dir (car dir-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
@@ -886,13 +836,6 @@ All ls time options, namely c, t and u, are handled."
              file-size)
     (format " %7s" (file-size-human-readable 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)
-
 (defun ls-lisp--sanitize-switches (switches)
   "Convert long options of GNU \"ls\" to their short form.
 Conversion is done only for flags supported by ls-lisp.
diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el
index 8f2b9af09c0..599cfa0ce77 100644
--- a/test/lisp/dired-tests.el
+++ b/test/lisp/dired-tests.el
@@ -270,8 +270,8 @@
   "Test for https://debbugs.gnu.org/27631 ."
   ;; For dired using 'ls' emulation we test for this bug in
   ;; ls-lisp-tests.el and em-ls-tests.el.
-  (skip-unless (and (not (featurep 'ls-lisp))
-                    (not (featurep 'eshell))))
+  (skip-unless (not (or (featurep 'ls-lisp)
+                        (featurep 'eshell))))
   (ert-with-temp-directory dir
     (let* ((dir1 (expand-file-name "dir1" dir))
            (dir2 (expand-file-name "dir2" dir))
diff --git a/test/lisp/ls-lisp-tests.el b/test/lisp/ls-lisp-tests.el
index 8c6262819c4..374028a3d16 100644
--- a/test/lisp/ls-lisp-tests.el
+++ b/test/lisp/ls-lisp-tests.el
@@ -29,13 +29,6 @@
 (require 'ls-lisp)
 (require 'dired)
 
-(ert-deftest ls-lisp-unload ()
-  "Test for https://debbugs.gnu.org/xxxxx ."
-  (should (advice-member-p 'ls-lisp--insert-directory 'insert-directory))
-  (unload-feature 'ls-lisp 'force)
-  (should-not (advice-member-p 'ls-lisp--insert-directory 'insert-directory))
-  (require 'ls-lisp))
-
 (ert-deftest ls-lisp-test-bug27762 ()
   "Test for https://debbugs.gnu.org/27762 ."
   (let* ((dir source-directory)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]