Mercurial > emacs

changeset 41794:570eb21cf9d8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(insert-directory): If the df output does not look right, don't try to use it. Other cleanups in overall code structure.
author Richard M. Stallman <rms@gnu.org>
date Mon, 03 Dec 2001 00:02:52 +0000
parents 1adf81b0d0e4
children 48c74a2caa77
files lisp/files.el
diffstat 1 files changed, 92 insertions(+), 76 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/files.el	Sun Dec 02 21:03:42 2001 +0000
+++ b/lisp/files.el	Mon Dec 03 00:02:52 2001 +0000
@@ -3576,72 +3576,77 @@
   ;; 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
+    (if handler
 	(funcall handler 'insert-directory file switches
 		 wildcard full-directory-p)
       (if (eq system-type 'vax-vms)
 	  (vms-read-directory file switches (current-buffer))
-	(let* ((coding-system-for-read
-		(and enable-multibyte-characters
-		     (or file-name-coding-system
-			 default-file-name-coding-system)))
-	       ;; This is to control encoding the arguments in call-process.
-	       (coding-system-for-write coding-system-for-read)
-	       (result
-		(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)))
-		      (call-process
-		       shell-file-name nil t nil
-		       "-c" (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.
-		  (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 switches)))
-			  ;; Avoid lossage if FILE starts with `-'.
-			  '("--")
-			  (progn
-			    (if (string-match "\\`~" file)
-				(setq file (expand-file-name file)))
-			    (list
-			     (if full-directory-p
-				 (concat (file-name-as-directory file) ".")
-			       file))))))))
+	(let (result available)
+
+	  ;; Read the actual directory using `insert-directory-program'.
+	  ;; RESULT gets the status code.
+	  (let ((coding-system-for-read
+		 (and enable-multibyte-characters
+		      (or file-name-coding-system
+			  default-file-name-coding-system)))
+		;; This is to control encoding the arguments in call-process.
+		(coding-system-for-write coding-system-for-read))
+	    (setq result
+		  (if wildcard
+		      ;; Run ls in the directory part of the file pattern
+		      ;; using the last component as argument.
+		      (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)))
+			(call-process
+			 shell-file-name nil t nil
+			 "-c"
+			 (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.
+		    (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 switches)))
+			    ;; Avoid lossage if FILE starts with `-'.
+			    '("--")
+			    (progn
+			      (if (string-match "\\`~" file)
+				  (setq file (expand-file-name file)))
+			      (list
+			       (if full-directory-p
+				   (concat (file-name-as-directory file) ".")
+				 file))))))))
+
+	  ;; If `insert-directory-program' failed, signal an error.
 	  (if (/= result 0)
-	      ;; We get here if `insert-directory-program' failed.
 	      ;; 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 them
-	      ;; the `ls' command line and let them guess what went
-	      ;; wrong.
+	      ;; 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
@@ -3650,25 +3655,36 @@
 		   (if (listp switches) (concat switches) switches)
 		   file result)
 		;; Unix.  Access the file to get a suitable error.
-		(access-file file "Reading directory"))
-	    ;; Replace "total" with "used", to avoid confusion.
-	    ;; Add in the amount of free space.
-	    (save-excursion
-	      (goto-char (point-min))
-	      (when (re-search-forward "^total" nil t)
+		(access-file file "Reading directory")
+		(error "Listing directory failed but `access-file' worked")))
+
+	  ;; Try to insert the amount of free space.
+	  (save-excursion
+	    (goto-char (point-min))
+	    ;; First find the line to put it on.
+	    (when (re-search-forward "^total" nil t)
+	      ;; Try to find the number of free blocks.
+	      (save-match-data
+		(with-temp-buffer
+		  (call-process "df" nil t nil ".")
+		  ;; Usual format is a header line
+		  ;; followed by a line of numbers.
+		  (goto-char (point-min))
+		  (forward-line 1)
+		  (if (not (eobp))
+		      (progn
+			;; Move to the end of the "available blocks" number.
+			(skip-chars-forward "^ \t")
+			(forward-word 3)
+			;; Copy it into AVAILABLE.
+			(let ((end (point)))
+			  (forward-word -1)
+			  (setq available (buffer-substring (point) end)))))))
+	      (when available
+		;; Replace "total" with "used", to avoid confusion.
 		(replace-match "used")
 		(end-of-line)
-		(let (available)
-		  (with-temp-buffer
-		    (call-process "df" nil t nil ".")
-		    (goto-char (point-min))
-		    (forward-line 1)
-		    (skip-chars-forward "^ \t")
-		    (forward-word 3)
-		    (let ((end (point)))
-		      (forward-word -1)
-		      (setq available (buffer-substring (point) end))))
-		  (insert " available " available))))))))))
+		(insert " available " available)))))))))
 
 (defun insert-directory-safely (file switches
 				     &optional wildcard full-directory-p)