Skip to content

GitLab

Commit 93dea928 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

Merge branch 'no-ls-lisp-advice'

parents 843cbb9a ec898e94
Pipeline #27573 failed with stage
in 2 minutes and 24 seconds
Hide whitespace changes
Inline Side-by-side
Showing with 354 additions and 399 deletions
lisp/dired.el
View file @ 93dea928
......@@ -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.
......
lisp/files.el
View file @ 93dea928
......@@ -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.
......
lisp/ls-lisp.el
View file @ 93dea928
......@@ -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.
......
test/lisp/dired-tests.el
View file @ 93dea928
......@@ -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))
......
test/lisp/ls-lisp-tests.el
View file @ 93dea928
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment