/[emacs]/emacs/lisp/files.el
ViewVC logotype

Diff of /emacs/lisp/files.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.544 by rms, Tue Dec 18 19:35:09 2001 UTC revision 1.545 by eliz, Fri Dec 21 15:20:42 2001 UTC
# Line 3561  We assume the output has the format of ` Line 3561  We assume the output has the format of `
3561  The value of this variable must be just a command name or file name;  The value of this variable must be just a command name or file name;
3562  if you want to specify options, use `directory-free-space-args'.  if you want to specify options, use `directory-free-space-args'.
3563    
3564  A value of nil disables this feature."  A value of nil disables this feature.
3565    
3566    If the function `file-system-info' is defined, it is always used in
3567    preference to the program given by this variable."
3568    :type '(choice (string :tag "Program") (const :tag "None" nil))    :type '(choice (string :tag "Program") (const :tag "None" nil))
3569    :group 'dired)    :group 'dired)
3570    
# Line 3570  A value of nil disables this feature." Line 3573  A value of nil disables this feature."
3573    :type 'string    :type 'string
3574    :group 'dired)    :group 'dired)
3575    
3576    (defun get-free-disk-space (dir)
3577      "Return the mount of free space on directory DIR's file system.
3578    The result is a string that gives the number of free 1KB blocks,
3579    or nil if the system call or the program which retrieve the infornmation
3580    fail.
3581    
3582    This function calls `file-system-info' if it is available, or invokes the
3583    program specified by `directory-free-space-program' if that is non-nil."
3584      ;; Try to find the number of free blocks.  Non-Posix systems don't
3585      ;; always have df, but might have an equivalent system call.
3586      (if (fboundp 'file-system-info)
3587          (let ((fsinfo (file-system-info dir)))
3588            (if fsinfo
3589                (format "%.0f" (/ (nth 2 fsinfo) 1024))))
3590        (save-match-data
3591          (with-temp-buffer
3592            (when (and directory-free-space-program
3593                       (zerop (call-process directory-free-space-program
3594                                            nil t nil
3595                                            directory-free-space-args
3596                                            dir)))
3597              ;; Usual format is a header line followed by a line of
3598              ;; numbers.
3599              (goto-char (point-min))
3600              (forward-line 1)
3601              (if (not (eobp))
3602                  (progn
3603                    ;; Move to the end of the "available blocks" number.
3604                    (skip-chars-forward "^ \t")
3605                    (forward-word 3)
3606                    ;; Copy it into AVAILABLE.
3607                    (let ((end (point)))
3608                      (forward-word -1)
3609                      (buffer-substring (point) end)))))))))
3610    
3611    
3612  ;; insert-directory  ;; insert-directory
3613  ;; - must insert _exactly_one_line_ describing FILE if WILDCARD and  ;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
3614  ;;   FULL-DIRECTORY-P is nil.  ;;   FULL-DIRECTORY-P is nil.
# Line 3689  If WILDCARD, it also runs the shell spec Line 3728  If WILDCARD, it also runs the shell spec
3728              (goto-char (point-min))              (goto-char (point-min))
3729              ;; First find the line to put it on.              ;; First find the line to put it on.
3730              (when (re-search-forward "^total" nil t)              (when (re-search-forward "^total" nil t)
3731                ;; Try to find the number of free blocks.                (let ((available (get-free-disk-space ".")))
3732                ;; Non-Posix systems don't always have df,                  (when available
3733                ;; but might have an equivalent system call.                    ;; Replace "total" with "used", to avoid confusion.
3734                (if (fboundp 'file-system-info)                    (replace-match "used")
3735                    (let ((fsinfo (file-system-info ".")))                    (end-of-line)
3736                      (if fsinfo                    (insert " available " available))))))))))
                         (setq available (format "%.0f" (/ (nth 2 fsinfo) 1024)))))  
                 (save-match-data  
                   (with-temp-buffer  
                     (when (and directory-free-space-program  
                                (zerop (call-process directory-free-space-program  
                                                     nil t nil  
                                                     directory-free-space-args  
                                                     ".")))  
                       ;; 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)  
                 (insert " available " available)))))))))  
3737    
3738  (defun insert-directory-safely (file switches  (defun insert-directory-safely (file switches
3739                                       &optional wildcard full-directory-p)                                       &optional wildcard full-directory-p)

Legend:
Removed from v.1.544  
changed lines
  Added in v.1.545

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26