mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-21 18:23:59 +00:00
Code Issues Releases Activity

(insert-directory): If ls fails, get an error.

Browse Source
This commit is contained in:
Richard M. Stallman 1996-09-01 21:38:48 +00:00
parent e3678b6433
commit b7fa904ccb
1 changed files with 53 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

102
lisp/files.el
View File

@ -2631,55 +2631,59 @@ If WILDCARD, it also runs the shell specified by `shell-file-name'."
wildcard full-directory-p)
(if (eq system-type 'vax-vms)
(vms-read-directory file switches (current-buffer))
(if wildcard
;; Run ls in the directory of the file pattern we asked for.
(let ((default-directory
(if (file-name-absolute-p file)
(file-name-directory file)
(file-name-directory (expand-file-name file))))
(pattern (file-name-nondirectory file))
(beg 0))
;; 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.
(while (string-match "[ \t\n;<>&|()#$]" pattern beg)
(setq pattern
(concat (substring pattern 0 (match-beginning 0))
"\\"
(substring pattern (match-beginning 0)))
beg (1+ (match-end 0))))
(call-process shell-file-name nil t nil
"-c" (concat "\\" ;; Disregard shell aliases!
insert-directory-program
" -d "
(if (stringp switches)
switches
(mapconcat 'identity switches " "))
" "
pattern)))
;; SunOS 4.1.3, SVr4 and others need the "." to list the
;; directory if FILE is a symbolic link.
(apply 'call-process
insert-directory-program nil t nil
(let (list)
(if (listp switches)
(setq list switches)
(if (not (equal switches ""))
(progn
;; Split the switches at any spaces
;; so we can pass separate options as separate args.
(while (string-match " " switches)
(setq list (cons (substring switches 0 (match-beginning 0))
list)
switches (substring switches (match-end 0))))
(setq list (nreverse (cons switches list))))))
(append list
(list
(if full-directory-p
(concat (file-name-as-directory file) ".")
file))))))))))
(or (= 0
(if wildcard
;; Run ls in the directory of the file pattern we asked for.
(let ((default-directory
(if (file-name-absolute-p file)
(file-name-directory file)
(file-name-directory (expand-file-name file))))
(pattern (file-name-nondirectory file))
(beg 0))
;; 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.
(while (string-match "[ \t\n;<>&|()#$]" pattern beg)
(setq pattern
(concat (substring pattern 0 (match-beginning 0))
"\\"
(substring pattern (match-beginning 0)))
beg (1+ (match-end 0))))
(call-process shell-file-name nil t nil
"-c" (concat "\\" ;; Disregard shell aliases!
insert-directory-program
" -d "
(if (stringp switches)
switches
(mapconcat 'identity switches " "))
" "
pattern)))
;; SunOS 4.1.3, SVr4 and others need the "." to list the
;; directory if FILE is a symbolic link.
(apply 'call-process
insert-directory-program nil t nil
(let (list)
(if (listp switches)
(setq list switches)
(if (not (equal switches ""))
(progn
;; Split the switches at any spaces
;; so we can pass separate options as separate args.
(while (string-match " " switches)
(setq list (cons (substring switches 0 (match-beginning 0))
list)
switches (substring switches (match-end 0))))
(setq list (nreverse (cons switches list))))))
(append list
(list
(if full-directory-p
(concat (file-name-as-directory file) ".")
file)))))))
;; We get here if ls failed.
;; Access the file to get a suitable error.
(access-file file "Reading directory"))))))
(defvar kill-emacs-query-functions nil
"Functions to call with no arguments to query about killing Emacs.