mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-06-14 04:21:24 +00:00
Implement new Dired handling of errors from 'ls'
The error messages are now displayed in a popped up buffer instead of being output in the Dired buffer and signalling an error. The file name bounds in Dired entries are now determined solely by the offsets calculated by 'ls' with the --dired option and consequently Dired now reliably recognizes file names that contain a newline (bug#80499). * etc/NEWS: Announce new Dired handling of errors from 'ls'. * lisp/dired.el (dired-internal-noselect): Check Dired buffer for file entries and if there are none kill the buffer to prevent displaying a Dired buffer with no file entries. (dired--ls-error-buffer): New variable. (dired--display-ls-error): New function. (dired, dired-other-window, dired-other-frame, dired-other-tab): Use it to pop up buffer with error message emitted by 'ls'. * lisp/files.el (insert-directory-clean): Remove the code that treats lines beginning at column 0 in a Dired buffer as error lines and consequently also remove the code using these lines to adjust the offsets specifying the bounds of the file name in the Dired entries. If the buffer contains a //DIRED-OPTIONS// line output by --dired, delete this line even when it is at BOB. (insert-directory): Remove the code that checks the return value of 'ls' and signals an error based on that value. Write any error message emitted by 'ls' to a temporary file and insert its content into a buffer, which will be popped when invoking a Dired command results in the 'ls' error. Adjust the comment above this function to accommodate file names containing a newline in Dired entries. (insert-directory-adj-pos): Remove this now unused function. * test/lisp/dired-tests.el (dired-test-filename-with-newline-1) (dired-test-filename-with-newline-2) (dired-test-ls-error-message): New tests. * test/lisp/files-tests.el (files-tests-file-name-non-special-insert-directory): Adjust test to use of 'ls' error buffer instead of signaling an error.
This commit is contained in:
Stephen Berman
parent
de381366ea
commit
3b7d9e37ce
5 changed files with 225 additions and 187 deletions
6
etc/NEWS
6
etc/NEWS
|
|
@ -2540,6 +2540,12 @@ of a literal newline. This prevents executing many Dired operations on
|
|||
such a file from failing and signaling an error. The default value of
|
||||
this user option is nil.
|
||||
|
||||
---
|
||||
*** New Dired handling of errors from 'ls'.
|
||||
When invoking a Dired command causes 'ls' to emit an error message,
|
||||
Emacs now displays the message in a popped up buffer instead of
|
||||
outputting it in the Dired buffer and signalling an error.
|
||||
|
||||
** Grep
|
||||
|
||||
+++
|
||||
|
|
|
|||
|
|
@ -649,6 +649,10 @@ The match starts at the beginning of the line and ends after the end
|
|||
of the line.
|
||||
Subexpression 2 must end right before the \\n.")
|
||||
|
||||
(defvar dired--ls-error-buffer nil
|
||||
"Non-nil if the current dired invocation yields an `ls' error.
|
||||
The non-nil value is the buffer containing the error message.")
|
||||
|
||||
|
||||
;;; Faces
|
||||
|
||||
|
|
@ -1230,7 +1234,8 @@ Type \\[describe-mode] after entering Dired for more info.
|
|||
If DIRNAME is already in a Dired buffer, that buffer is used without refresh."
|
||||
;; Cannot use (interactive "D") because of wildcards.
|
||||
(interactive (dired-read-dir-and-switches ""))
|
||||
(pop-to-buffer-same-window (dired-noselect dirname switches)))
|
||||
(prog1 (pop-to-buffer-same-window (dired-noselect dirname switches))
|
||||
(dired--display-ls-error)))
|
||||
|
||||
;; This is needed to let clicks on the menu bar invoke Dired even if
|
||||
;; some feature remaps the Dired command to another command.
|
||||
|
|
@ -1248,21 +1253,24 @@ If this command needs to split the current window, it by default obeys
|
|||
the user options `split-height-threshold' and `split-width-threshold',
|
||||
when it decides whether to split the window horizontally or vertically."
|
||||
(interactive (dired-read-dir-and-switches "in other window "))
|
||||
(switch-to-buffer-other-window (dired-noselect dirname switches)))
|
||||
(prog1 (switch-to-buffer-other-window (dired-noselect dirname switches))
|
||||
(dired--display-ls-error)))
|
||||
|
||||
;;;###autoload (keymap-set ctl-x-5-map "d" #'dired-other-frame)
|
||||
;;;###autoload
|
||||
(defun dired-other-frame (dirname &optional switches)
|
||||
"\"Edit\" directory DIRNAME. Like `dired' but make a new frame."
|
||||
(interactive (dired-read-dir-and-switches "in other frame "))
|
||||
(switch-to-buffer-other-frame (dired-noselect dirname switches)))
|
||||
(prog1 (switch-to-buffer-other-frame (dired-noselect dirname switches))
|
||||
(dired--display-ls-error)))
|
||||
|
||||
;;;###autoload (keymap-set tab-prefix-map "d" #'dired-other-tab)
|
||||
;;;###autoload
|
||||
(defun dired-other-tab (dirname &optional switches)
|
||||
"\"Edit\" directory DIRNAME. Like `dired' but make a new tab."
|
||||
(interactive (dired-read-dir-and-switches "in other tab "))
|
||||
(switch-to-buffer-other-tab (dired-noselect dirname switches)))
|
||||
(prog1 (switch-to-buffer-other-tab (dired-noselect dirname switches))
|
||||
(dired--display-ls-error)))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-noselect (dir-or-list &optional switches)
|
||||
|
|
@ -1447,10 +1455,19 @@ The return value is the target column for the file names."
|
|||
(let ((failed t))
|
||||
(unwind-protect
|
||||
(progn (dired-readin)
|
||||
(setq failed nil))
|
||||
;; dired-readin can fail if parent directories are inaccessible.
|
||||
;; Don't leave an empty buffer around in that case.
|
||||
(if failed (kill-buffer buffer))))
|
||||
;; Check for file entries (they are listed below the
|
||||
;; directory name and (if present) wildcard lines).
|
||||
(while (and (skip-syntax-forward "\s")
|
||||
(looking-at "\\(.+:$\\|wildcard\\)"))
|
||||
(forward-line))
|
||||
(unless (eobp)
|
||||
(setq failed nil)))
|
||||
;; No file entries indicates an `ls' error, and `dired-readin'
|
||||
;; can fail if parent directories are inaccessible. In either
|
||||
;; case don't leave the Dired buffer around.
|
||||
(when failed
|
||||
(kill-buffer buffer)
|
||||
(setq buffer nil))))
|
||||
(goto-char (point-min))
|
||||
(dired-initial-position dirname))
|
||||
(when (consp dired-directory)
|
||||
|
|
@ -4093,6 +4110,13 @@ See `%s' for other alternatives and more information."))
|
|||
(set-window-point (get-buffer-window)
|
||||
(search-backward "Warning (dired)")))))
|
||||
|
||||
(defun dired--display-ls-error ()
|
||||
"Pop up a buffer displaying the current `ls' error, if any."
|
||||
(when dired--ls-error-buffer
|
||||
(let* ((errwin (display-buffer dired--ls-error-buffer)))
|
||||
(fit-window-to-buffer errwin))
|
||||
(setq dired--ls-error-buffer nil)))
|
||||
|
||||
|
||||
;;; Deleting files
|
||||
|
||||
|
|
|
|||
272
lisp/files.el
272
lisp/files.el
|
|
@ -8320,41 +8320,24 @@ Valid wildcards are `*', `?', `[abc]' and `[a-z]'."
|
|||
(forward-line -1))
|
||||
(if (let ((case-fold-search nil)) (looking-at "//DIRED//"))
|
||||
(let ((end (line-end-position))
|
||||
(linebeg (point))
|
||||
error-lines)
|
||||
;; Find all the lines that are error messages,
|
||||
;; and record the bounds of each one.
|
||||
(goto-char beg)
|
||||
(while (< (point) linebeg)
|
||||
(or (eql (following-char) ?\s)
|
||||
(push (list (point) (line-end-position)) error-lines))
|
||||
(forward-line 1))
|
||||
(setq error-lines (nreverse error-lines))
|
||||
;; Now read the numeric positions of file names.
|
||||
(linebeg (point)))
|
||||
;; Read the numeric positions of file names.
|
||||
(goto-char linebeg)
|
||||
(forward-word-strictly 1)
|
||||
(forward-char 3)
|
||||
(while (< (point) end)
|
||||
(let ((start (insert-directory-adj-pos
|
||||
(+ beg (read (current-buffer)))
|
||||
error-lines))
|
||||
(end (insert-directory-adj-pos
|
||||
(+ beg (read (current-buffer)))
|
||||
error-lines)))
|
||||
(if (memq (char-after end) '(?\n ?\s ?/ ?* ?@ ?% ?= ?|))
|
||||
;; End is followed by \n or by output of -F.
|
||||
(put-text-property start end 'dired-filename t)
|
||||
;; It seems that we can't trust ls's output as to
|
||||
;; byte positions of filenames.
|
||||
(put-text-property beg (point) 'dired-filename nil)
|
||||
(end-of-line))))
|
||||
(let ((start (+ beg (read (current-buffer))))
|
||||
(end (+ beg (read (current-buffer)))))
|
||||
(when (memq (char-after end) '(?\n ?\s ?/ ?* ?@ ?% ?= ?|))
|
||||
;; End is followed by \n or by output of -F.
|
||||
(put-text-property start end 'dired-filename t))))
|
||||
(goto-char end)
|
||||
(beginning-of-line)
|
||||
(delete-region (point) (progn (forward-line 1) (point))))
|
||||
;; Take care of the case where the ls output contains a
|
||||
;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line
|
||||
;; and we went one line too far back (see above).
|
||||
(forward-line 1))
|
||||
(unless (bobp) (forward-line 1)))
|
||||
(if (let ((case-fold-search nil)) (looking-at "//DIRED-OPTIONS//"))
|
||||
(delete-region (point) (progn (forward-line 1) (point))))))
|
||||
|
||||
|
|
@ -8363,12 +8346,12 @@ Valid wildcards are `*', `?', `[abc]' and `[a-z]'."
|
|||
;; FULL-DIRECTORY-P is nil.
|
||||
;; The single line of output must display FILE's name as it was
|
||||
;; given, namely, an absolute path name.
|
||||
;; - must insert exactly one line for each file if WILDCARD or
|
||||
;; - must insert exactly one entry for each file if WILDCARD or
|
||||
;; FULL-DIRECTORY-P is t, plus one optional "total" line
|
||||
;; before the file lines, plus optional text after the file lines.
|
||||
;; Lines are delimited by "\n", so filenames containing "\n" are not
|
||||
;; allowed.
|
||||
;; File lines should display the basename.
|
||||
;; Entries are delimited by "\n", but file names containing "\n" are
|
||||
;; allowed and by default the "\n" is displayed as a literal newline.
|
||||
;; File entries should display the basename.
|
||||
;; - must be consistent with
|
||||
;; - functions dired-move-to-filename, (these two define what a file line is)
|
||||
;; dired-move-to-end-of-filename,
|
||||
|
|
@ -8410,10 +8393,10 @@ normally equivalent short `-D' option is just passed on to
|
|||
(declare-function ls-lisp--insert-directory "ls-lisp")
|
||||
(ls-lisp--insert-directory file switches wildcard full-directory-p))
|
||||
(t
|
||||
(let (result (beg (point)))
|
||||
(let ((beg (point))
|
||||
(errfile (make-temp-file "lserr")))
|
||||
|
||||
;; 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.
|
||||
|
|
@ -8423,143 +8406,88 @@ normally equivalent short `-D' option is just passed on to
|
|||
(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 "
|
||||
;; Quote switches that require quoting
|
||||
;; such as "--block-size='1". But don't
|
||||
;; quote switches that use patterns
|
||||
;; such as "--ignore=PATTERN" (bug#71935).
|
||||
(mapconcat #'shell-quote-wildcard-pattern
|
||||
(if (stringp switches)
|
||||
(split-string-and-unquote switches)
|
||||
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 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 (list t errfile) nil
|
||||
shell-command-switch
|
||||
(concat (if (memq system-type '(ms-dos windows-nt))
|
||||
""
|
||||
"\\") ; Disregard Unix shell aliases!
|
||||
insert-directory-program
|
||||
" -d "
|
||||
;; Quote switches that require quoting
|
||||
;; such as "--block-size='1". But don't
|
||||
;; quote switches that use patterns
|
||||
;; such as "--ignore=PATTERN" (bug#71935).
|
||||
(mapconcat #'shell-quote-wildcard-pattern
|
||||
(if (stringp switches)
|
||||
(split-string-and-unquote switches)
|
||||
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 (list t errfile) 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
|
||||
(let ((case-fold-search nil))
|
||||
(forward-line -2)
|
||||
(when (looking-at "//SUBDIRED//")
|
||||
(forward-line -1))
|
||||
(if (looking-at "//DIRED//")
|
||||
(setq result 0)))))
|
||||
;; If `ls' emits an error message, copy it to a buffer that will
|
||||
;; be displayed when a Dired invocation results in the `ls'
|
||||
;; error.
|
||||
(when (> (file-attribute-size (file-attributes errfile)) 0)
|
||||
(defvar dired--ls-error-buffer) ; Pacify byte-compiler.
|
||||
(let ((errbuf (get-buffer-create "*ls error*")))
|
||||
(with-current-buffer errbuf
|
||||
(erase-buffer)
|
||||
(insert-file-contents errfile))
|
||||
(setq dired--ls-error-buffer errbuf)))
|
||||
(delete-file errfile)
|
||||
|
||||
(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
|
||||
|
|
@ -8594,18 +8522,6 @@ normally equivalent short `-D' option is just passed on to
|
|||
(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.
|
||||
File name position values returned in ls --dired output
|
||||
count only stdout; they don't count the error messages sent to stderr.
|
||||
So this function converts to them to real buffer positions.
|
||||
ERROR-LINES is a list of buffer positions of error message lines,
|
||||
of the form (START END)."
|
||||
(while (and error-lines (< (caar error-lines) pos))
|
||||
(setq pos (+ pos (- (nth 1 (car error-lines)) (nth 0 (car error-lines)))))
|
||||
(pop error-lines))
|
||||
pos)
|
||||
|
||||
(defun insert-directory-safely (file switches
|
||||
&optional wildcard full-directory-p)
|
||||
"Insert directory listing for FILE, formatted according to SWITCHES.
|
||||
|
|
|
|||
|
|
@ -658,6 +658,88 @@ The current directory at call time should not affect the result (Bug#50630)."
|
|||
(let ((default-directory test-dir-other))
|
||||
(files-tests--insert-directory-shows-given-free test-dir)))))
|
||||
|
||||
(ert-deftest dired-test-filename-with-newline-1 () ; bug#79528, bug#80499
|
||||
"Test handling of file name with literal embedded newline."
|
||||
(with-current-buffer "*Messages*"
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer)))
|
||||
(let* ((dired-auto-toggle-b-switch nil)
|
||||
(dir (ert-resource-file
|
||||
(file-name-as-directory "filename-with-newline")))
|
||||
(file (concat dir "filename\nwith newline"))
|
||||
(buf (progn (make-empty-file file t)
|
||||
(dired (file-name-directory file))))
|
||||
(warnbuf (get-buffer "*Warnings*")))
|
||||
(should (dired--filename-with-newline-p))
|
||||
(let ((beg (point)) ; beginning of file name
|
||||
(end (dired-move-to-end-of-filename)))
|
||||
(should (search-backward "with newline")) ; literal space in file name
|
||||
(should (search-backward "\n" beg))) ; literal newline in file name
|
||||
(if noninteractive
|
||||
(with-current-buffer "*Messages*"
|
||||
(goto-char (point-min))
|
||||
(should (search-forward
|
||||
"Warning (dired): Literal newline in file name.")))
|
||||
(should (get-buffer-window warnbuf))
|
||||
(with-current-buffer warnbuf
|
||||
(goto-char (point-min))
|
||||
(should (string-match
|
||||
(regexp-quote "Warning (dired): Literal newline in file name.")
|
||||
(buffer-substring (pos-bol) (pos-eol))))))
|
||||
(kill-buffer buf)
|
||||
(kill-buffer warnbuf)
|
||||
(delete-directory dir t)))
|
||||
|
||||
(ert-deftest dired-test-filename-with-newline-2 () ; bug#79528, bug#80499
|
||||
"Test handling of file name with embedded newline using `b' switch."
|
||||
(with-current-buffer "*Messages*"
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer)))
|
||||
(let* ((dired-auto-toggle-b-switch t)
|
||||
(dir (ert-resource-file
|
||||
(file-name-as-directory "filename-with-newline")))
|
||||
(file (concat dir "filename\nwith newline"))
|
||||
(buf (progn (make-empty-file file t)
|
||||
(dired-noselect (file-name-directory file))))
|
||||
(warnbuf (get-buffer "*Warnings*")))
|
||||
(with-current-buffer buf
|
||||
(should (dired--filename-with-newline-p))
|
||||
(dired--toggle-b-switch)
|
||||
(let ((beg (point)) ; beginning of file name
|
||||
(end (dired-move-to-end-of-filename)))
|
||||
(should (search-backward "with\\ newline")) ; result of ls -b switch
|
||||
(should (search-backward "\\n" beg)))) ; result of ls -b switch
|
||||
(if noninteractive
|
||||
(with-current-buffer "*Messages*"
|
||||
(goto-char (point-min))
|
||||
(should-error (search-forward
|
||||
"Warning (dired): Literal newline in file name.")))
|
||||
(should-not (get-buffer "*Warnings*")))
|
||||
(kill-buffer buf)
|
||||
(kill-buffer warnbuf)
|
||||
(delete-directory dir t)))
|
||||
|
||||
(ert-deftest dired-test-ls-error-message () ; bug#80499
|
||||
"Test invoking `dired' on a nonexisting file.
|
||||
A buffer should pop up containing the error emitted by ls. The buffer
|
||||
visiting the nonexisting file should killed before `dired' returns,
|
||||
hence another buffer should be returned."
|
||||
(let* ((dir (ert-resource-file (file-name-as-directory "empty-dir")))
|
||||
(name (concat dir "bla"))
|
||||
(buf (progn (make-directory dir)
|
||||
(dired name))))
|
||||
(let ((errbuf (get-buffer "*ls error*")))
|
||||
(should (get-buffer-window errbuf))
|
||||
(should-not (equal (buffer-name buf) (file-name-nondirectory name)))
|
||||
(with-current-buffer errbuf
|
||||
(should (equal (buffer-string)
|
||||
(concat "ls: cannot access '"
|
||||
(file-name-nondirectory name)
|
||||
"': No such file or directory\n"))))
|
||||
(kill-buffer errbuf))
|
||||
(delete-directory dir t)))
|
||||
|
||||
|
||||
(defun dired-test--filename-with-backslash-n ()
|
||||
"Core of test `dired-test-filename-with-backslash-n'."
|
||||
(let* ((dir (ert-resource-file
|
||||
|
|
|
|||
|
|
@ -1027,7 +1027,17 @@ unquoted file names."
|
|||
(buffer-string)))))
|
||||
(files-tests--with-temp-non-special-and-file-name-handler
|
||||
(tmpdir nospecial-dir t)
|
||||
(should-error (with-temp-buffer (insert-directory nospecial-dir "")))))
|
||||
(with-temp-buffer (insert-directory nospecial-dir ""))
|
||||
(let ((errbuf (get-buffer "*ls error*"))
|
||||
;; By the time `ls' is called in `insert-directory', the
|
||||
;; handler prefix has been removed.
|
||||
(nospecial-dir (string-remove-prefix "/:" nospecial-dir)))
|
||||
(should errbuf)
|
||||
(with-current-buffer errbuf
|
||||
(should (equal (buffer-string)
|
||||
(concat "ls: cannot access '" nospecial-dir
|
||||
"': No such file or directory\n"))))
|
||||
(kill-buffer errbuf))))
|
||||
|
||||
(ert-deftest files-tests-file-name-non-special-insert-file-contents ()
|
||||
(files-tests--with-temp-non-special (tmpfile nospecial)
|
||||
|
|
|
|||
Loading…
Reference in a new issue