Cache dired file metadata

ober

eb9025fb7cf75189c5112823e198d75d0dabe707

diff --git a/src/jerboa-emacs/core.ss b/src/jerboa-emacs/core.ss
index 9e2d672..af4780b 100644
--- a/src/jerboa-emacs/core.ss
+++ b/src/jerboa-emacs/core.ss
@@ -1812,29 +1812,41 @@
                 (string-append (number->string (/ (round (* gb 10.0)) 10.0)) "G"))))))
     (string-append (make-string (max 0 (- 8 (string-length s))) #\space) s)))
 
-(def (dired-format-entry dir name)
-  "Format one dired line for a file/directory entry."
-  (let ((full (if (string=? name "..")
-                (strip-trailing-slash (path-directory dir))
-                (string-append dir "/" name))))
+(def (dired-entry-path dir name)
+  (if (string=? name "..")
+    (strip-trailing-slash (path-directory dir))
+    (string-append dir "/" name)))
+
+(def (dired-entry-metadata dir name)
+  (let ((full (dired-entry-path dir name)))
     (with-catch
-      (lambda (e)
-        (string-append "  ?????????? " (make-string 8 #\?) " " name))
+      (lambda (e) (list name full #f #f))
       (lambda ()
         (let* ((info (file-info full))
-               (type (file-info-type info))
-               (mode (file-info-mode info))
-               (size (file-info-size info))
-               (type-char (case type
-                            ((directory) #\d)
-                            ((symbolic-link) #\l)
-                            (else #\-)))
-               (perms (mode->permission-string mode))
-               (display-name (if (eq? type 'directory)
-                               (string-append name "/")
-                               name)))
-          (string-append "  " (string type-char) perms " "
-                         (format-size size) " " display-name))))))
+               (type (file-info-type info)))
+          (list name full info type))))))
+
+(def (dired-format-entry/info name info)
+  (if info
+    (let* ((type (file-info-type info))
+           (mode (file-info-mode info))
+           (size (file-info-size info))
+           (type-char (case type
+                        ((directory) #\d)
+                        ((symbolic-link) #\l)
+                        (else #\-)))
+           (perms (mode->permission-string mode))
+           (display-name (if (eq? type 'directory)
+                           (string-append name "/")
+                           name)))
+      (string-append "  " (string type-char) perms " "
+                     (format-size size) " " display-name))
+    (string-append "  ?????????? " (make-string 8 #\?) " " name)))
+
+(def (dired-format-entry dir name)
+  "Format one dired line for a file/directory entry."
+  (let ((meta (dired-entry-metadata dir name)))
+    (dired-format-entry/info (car meta) (caddr meta))))
 
 (def (dired-format-listing dir)
   "Format a directory listing.
@@ -1843,40 +1855,28 @@
   (let* ((raw-entries (filter (lambda (e) (not (member e '("." ".."))))
                               (directory-files dir)))
          (entries (sort raw-entries string<?))
+         ;; Compute file-info once per entry. On static/Linux builds this avoids
+         ;; a subprocess storm while opening large directories such as ~/.
+         (metas (map (lambda (name) (dired-entry-metadata dir name))
+                     entries))
          ;; Separate directories and files, dirs first
-         (dirs (filter (lambda (name)
-                         (with-catch
-                           (lambda (e) #f)
-                           (lambda ()
-                             (eq? 'directory
-                                  (file-info-type
-                                   (file-info (string-append dir "/" name)))))))
-                       entries))
-         (files (filter (lambda (name)
-                          (with-catch
-                            (lambda (e) #t)
-                            (lambda ()
-                              (not (eq? 'directory
-                                        (file-info-type
-                                         (file-info (string-append dir "/" name))))))))
-                        entries))
+         (dirs (filter (lambda (meta) (eq? (cadddr meta) 'directory))
+                       metas))
+         (files (filter (lambda (meta) (not (eq? (cadddr meta) 'directory)))
+                        metas))
          ;; ".." first, then dirs, then files
-         (ordered (append '("..") dirs files))
+         (ordered (append (list (dired-entry-metadata dir "..")) dirs files))
          ;; Format lines
          (header (string-append "  " dir ":"))
          (total-line (string-append "  " (number->string (length entries))
                                     " entries"))
-         (entry-lines (map (lambda (name) (dired-format-entry dir name))
+         (entry-lines (map (lambda (meta)
+                             (dired-format-entry/info (car meta) (caddr meta)))
                            ordered))
          (all-lines (append (list header total-line "") entry-lines))
          (text (string-join all-lines "\n"))
          ;; Build entries vector: index i → full path
-         (paths (list->vector
-                  (map (lambda (name)
-                         (if (string=? name "..")
-                           (strip-trailing-slash (path-directory dir))
-                           (string-append dir "/" name)))
-                       ordered))))
+         (paths (list->vector (map cadr ordered))))
     (values text paths)))
 
 ;;;============================================================================
diff --git a/tests/test-tier0.ss b/tests/test-tier0.ss
index ee11017..627f9da 100644
--- a/tests/test-tier0.ss
+++ b/tests/test-tier0.ss
@@ -12,6 +12,7 @@
         (jerboa-emacs pregexp-compat)
         (jerboa-emacs snippets)
         (jerboa-emacs vtscreen)
+        (jerboa-emacs core)
         (jerboa-emacs org-parse)
         (jerboa-emacs ipc))
 
@@ -146,6 +147,20 @@
     (check "vtscreen-content" (substring rendered 0 5) "Hello")))
 
 ;;; ========================================================================
+;;; core.sls
+;;; ========================================================================
+
+(display "--- core ---\n")
+
+(let* ((raw (filter (lambda (e) (not (member e '("." ".."))))
+                    (directory-files "tests")))
+       (expected-paths (+ 1 (length raw))))
+  (let-values (((text entries) (dired-format-listing "tests")))
+    (check-true "dired-listing-text" (> (string-length text) 0))
+    (check-true "dired-listing-vector" (vector? entries))
+    (check "dired-listing-path-count" (vector-length entries) expected-paths)))
+
+;;; ========================================================================
 ;;; org-parse.sls
 ;;; ========================================================================