unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
From: Stefan Monnier <monnier@iro.umontreal.ca>
To: Jens Schmidt <jschmidt4gnu@vodafonemail.de>
Cc: emacs-devel@gnu.org,  Eli Zaretskii <eliz@gnu.org>
Subject: Re: master 19a3b499f84: ; * lisp/loadup.el: Don't prohibit advice when ls-lisp is loaded.
Date: Thu, 07 Dec 2023 15:06:38 -0500	[thread overview]
Message-ID: <jwvv899g6e4.fsf-monnier+emacs@gnu.org> (raw)
In-Reply-To: <020ab182-0e3d-4e8d-9415-c93863b95638@vodafonemail.de> (Jens Schmidt's message of "Wed, 6 Dec 2023 21:50:38 +0100")

[-- 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)

  reply	other threads:[~2023-12-07 20:06 UTC|newest]

Thread overview: 16+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
     [not found] <170177277759.6083.12155719482709043212@vcs2.savannah.gnu.org>
     [not found] ` <20231205103937.E1D65C405A8@vcs2.savannah.gnu.org>
2023-12-05 23:20   ` master 19a3b499f84: ; * lisp/loadup.el: Don't prohibit advice when ls-lisp is loaded Stefan Monnier
2023-12-06  1:18     ` Po Lu
2023-12-06 12:14     ` Eli Zaretskii
2023-12-06 16:12       ` Stefan Monnier
2023-12-06 17:07         ` Eli Zaretskii
2023-12-06 21:32           ` Stefan Monnier
2023-12-07  6:19             ` Eli Zaretskii
2023-12-06 20:50     ` Jens Schmidt
2023-12-07 20:06       ` Stefan Monnier [this message]
2023-12-07 22:25         ` Jens Schmidt
2023-12-09 20:09           ` Stefan Monnier
2023-12-09 23:26           ` Stefan Monnier
2023-12-10  5:10           ` Stefan Monnier
2023-12-12 21:22             ` Jens Schmidt
2023-12-21 14:40               ` Stefan Monnier
2023-12-07  2:49     ` Richard Stallman

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=jwvv899g6e4.fsf-monnier+emacs@gnu.org \
    --to=monnier@iro.umontreal.ca \
    --cc=eliz@gnu.org \
    --cc=emacs-devel@gnu.org \
    --cc=jschmidt4gnu@vodafonemail.de \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).