emacs-30 e1304e9b1bb: Fix 'chart-space-usage' on MS-Windows

[Eli Zaretskii]

branch: emacs-30
commit e1304e9b1bbb62ff3e3680c84bd1fad4922b41eb
Author: Eli Zaretskii <eliz@gnu.org>
Commit: Eli Zaretskii <eliz@gnu.org>

    Fix 'chart-space-usage' on MS-Windows
    
    * lisp/emacs-lisp/chart.el (chart--file-size)
    (chart--directory-size): New functions.
    (chart-space-usage): Invoke 'du' correctly on MS-Windows.  Provide
    alternative implementation in Lisp when 'du' is not installed,
    using 'chart--directory-size' and 'chart--file-size'.  (Bug#72919)
---
 lisp/emacs-lisp/chart.el | 71 ++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 56 insertions(+), 15 deletions(-)

diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el
index da61e45213d..2ca9b64be33 100644
--- a/lisp/emacs-lisp/chart.el
+++ b/lisp/emacs-lisp/chart.el
@@ -641,27 +641,68 @@ SORT-PRED if desired."
                       (lambda (a b) (> (cdr a) (cdr b))))
     ))
 
+;; This assumes 4KB blocks
+(defun chart--file-size (size)
+  (* (/ (+ size 4095) 4096) 4096))
+
+(defun chart--directory-size (dir)
+  "Compute total size of files in directory DIR and its subdirectories.
+DIR is assumed to be a directory, verified by the caller."
+  (let ((size 0))
+    (dolist (file (directory-files-recursively dir "." t))
+      (let ((fsize (nth 7 (file-attributes file))))
+        (if (> fsize 0)
+            (setq size
+                  (+ size (chart--file-size fsize))))))
+    size))
+
 (defun chart-space-usage (d)
   "Display a top usage chart for directory D."
   (interactive "DDirectory: ")
   (message "Collecting statistics...")
   (let ((nmlst nil)
        (cntlst nil)
-       (b (get-buffer-create " *du-tmp*")))
-    (set-buffer b)
-    (erase-buffer)
-    (insert "cd " d ";du -sk * \n")
-    (message "Running `cd %s;du -sk *'..." d)
-    (call-process-region (point-min) (point-max) shell-file-name t
-                        (current-buffer) nil)
-    (goto-char (point-min))
-    (message "Scanning output ...")
-    (while (re-search-forward "^\\([0-9]+\\)[ \t]+\\([^ \n]+\\)$" nil t)
-      (let* ((nam (buffer-substring (match-beginning 2) (match-end 2)))
-            (num (buffer-substring (match-beginning 1) (match-end 1))))
-       (setq nmlst (cons nam nmlst)
-             ;; * 1000 to put it into bytes
-             cntlst (cons (* (string-to-number num) 1000) cntlst))))
+        b)
+    (if (executable-find "du")
+        (progn
+         (setq b (get-buffer-create " *du-tmp*"))
+          (set-buffer b)
+          (erase-buffer)
+          (if (and (memq system-type '(windows-nt ms-dos))
+                   (fboundp 'w32-shell-dos-semantics)
+                   (w32-shell-dos-semantics))
+              (progn
+                ;; With Windows shells, 'cd' does not change the drive,
+                ;; and ';' is not reliable for running multiple
+                ;; commands, so use alternatives.  We quote the
+                ;; directory because otherwise pushd will barf on a
+                ;; directory with forward slashes.  Note that * will not
+                ;; skip dotfiles with Windows shells, unlike on Unix.
+                (insert "pushd \"" d "\" && du -sk * \n")
+                (message "Running `pushd \"%s\" && du -sk *'..." d))
+            (insert "cd " d ";du -sk * \n")
+            (message "Running `cd %s;du -sk *'..." d))
+          (call-process-region (point-min) (point-max) shell-file-name t
+                              (current-buffer) nil)
+          (goto-char (point-min))
+          (message "Scanning output ...")
+          (while (re-search-forward "^\\([0-9]+\\)[ \t]+\\([^ \n]+\\)$" nil t)
+            (let* ((nam (buffer-substring (match-beginning 2) (match-end 2)))
+                  (num (buffer-substring (match-beginning 1) (match-end 1))))
+             (setq nmlst (cons nam nmlst)
+                   ;; * 1000 to put it into bytes
+                   cntlst (cons (* (string-to-number num) 1000) cntlst)))))
+      (dolist (file (directory-files d t directory-files-no-dot-files-regexp))
+        (let ((fbase (file-name-nondirectory file)))
+          ;; Typical shells exclude files and subdirectories whose names
+          ;; begin with a period when it expands *, so we do the same.
+          (unless (string-match-p "\\`\\." fbase)
+            (setq nmlst (cons fbase nmlst))
+            (if (file-regular-p file)
+                (setq cntlst (cons (chart--file-size
+                                    (nth 7 (file-attributes file)))
+                                   cntlst))
+              (setq cntlst (cons (chart--directory-size file) cntlst)))))))
     (if (not nmlst)
        (error "No files found!"))
     (chart-bar-quickie 'vertical (format "Largest files in %s" d)