From 3c200d4db991513ad6e2af8b925c42262bd25e2e Mon Sep 17 00:00:00 2001 From: interp Date: Fri, 7 Sep 2001 16:38:38 +0000 Subject: [PATCH] even less STAT-calls (removed STAT-calls when called with RECURSIVE) --- ls.scm | 147 +++++++++++++++++++++++++++++++-------------------------- 1 file changed, 81 insertions(+), 66 deletions(-) diff --git a/ls.scm b/ls.scm index f0b4c66..d173d7c 100644 --- a/ls.scm +++ b/ls.scm @@ -61,31 +61,43 @@ (file-directory? path #f))) ;; or not (ls-directory path all? recursive? long? directory? flag? columns? port)) (else - (ls-file path long? flag? port)))) + (ls-file (cons path (file-info path #f)) long? flag? port)))) (define (ls-directory directory all? recursive? long? directory? flag? columns? port) -; (display (list "starting ls-directory:" directory)) (newline) +; terminology: a FILE-NAME is the name of a file +; a FILE is a pair whose car is a file-name and whose cdr is +; either its file-info-object or #f (if not needed) +; a INFO is a file-info-object (let* ((directory (file-name-as-directory directory)) (substantial-directory (string-append directory ".")) - (files (directory-files substantial-directory all?))) + (file-names (directory-files substantial-directory all?))) (with-cwd* substantial-directory (lambda () - (if (and (not long?) - columns?) - (ls-files-columns files flag? port) - (ls-files-column files long? flag? port)) + (let ((files (if (or recursive? long? flag?) ; these are the flags for which we need the file-info + (map (lambda (file-name) + (cons file-name (file-info file-name #f))) + file-names) + (map (lambda (file-name) (cons file-name #f)) + file-names)))) + + (if (and (not long?) + columns?) + (ls-files-columns files flag? port) + (ls-files-column files long? flag? port)) - (if recursive? - (let ((directories - (filter (lambda (file) (file-directory? file #f)) - files))) - (if (not (null? directories)) - (begin - (newline port) - (real-ls directories directory - all? recursive? long? directory? flag? columns? - port))))))))) + (if recursive? + (let ((directories + (map (lambda (file) (car file)) + (filter (lambda (file) + (eq? (file-info:type (cdr file)) 'directory)) + files)))) + (if (not (null? directories)) + (begin + (newline port) + (real-ls directories directory + all? recursive? long? directory? flag? columns? + port)))))))))) (define *width* 79) @@ -93,7 +105,7 @@ (let* ((max-file-name-width (if (null? files) 0 - (apply max (map string-length files)))) + (apply max (map (lambda (file) (string-length (car file))) files)))) (max-file-name-width (if flag? (+ 1 max-file-name-width) @@ -125,8 +137,8 @@ ((= column columns)) (let ((tail (vector-ref tails column))) (if (not (null? tail)) - (let* ((file-name (car tail)) - (width (display-file file-name (file-info file-name) flag? port))) + (let* ((file (car tail)) + (width (display-file file flag? port))) (display-spaces (- column-width width) port) (vector-set! tails column (cdr tail)))))) (newline port)))) @@ -144,50 +156,50 @@ (ls-file file long? flag? port)) files)) -(define (ls-file file-name long? flag? port) - (let ((info (file-info file-name #f))) - (if long? - (ls-file-long file-name info flag? port) - (ls-file-short file-name info flag? port)))) +(define (ls-file file long? flag? port) + (if long? + (ls-file-long file flag? port) + (ls-file-short file flag? port))) -(define (ls-file-short file-name info flag? port) - (display-file file-name info flag? port) +(define (ls-file-short file flag? port) + (display-file file flag? port) (newline port)) -(define (ls-file-long file-name info flag? port) - (display-permissions info port) - (display-decimal-justified (file-info:nlinks info) 4 port) - (write-char #\space port) - (let* ((uid (file-info:uid info)) - (user-name - (call-with-current-continuation - (lambda (escape) - (with-handler - (lambda (condition more) - (escape (number->string uid))) - (lambda () - (user-info:name (user-info uid)))))))) - (display-padded user-name 9 port)) - (let* ((gid (file-info:gid info)) - (group-name - (call-with-current-continuation - (lambda (escape) - (with-handler - (lambda (condition more) - (escape (number->string gid))) - (lambda () - (group-info:name (group-info gid)))))))) - (display-padded group-name 9 port)) - (display-decimal-justified (file-info:size info) 7 port) - (write-char #\space port) - (display-time (file-info:mtime info) port) - (write-char #\space port) - (display-file file-name info flag? port) - (if (eq? (file-info:type info) 'symlink) - (begin - (display " -> " port) - (display (read-symlink file-name) port))) - (newline port)) +(define (ls-file-long file flag? port) + (let ((info (cdr file))) + (display-permissions info port) + (display-decimal-justified (file-info:nlinks info) 4 port) + (write-char #\space port) + (let* ((uid (file-info:uid info)) + (user-name + (call-with-current-continuation + (lambda (escape) + (with-handler + (lambda (condition more) + (escape (number->string uid))) + (lambda () + (user-info:name (user-info uid)))))))) + (display-padded user-name 9 port)) + (let* ((gid (file-info:gid info)) + (group-name + (call-with-current-continuation + (lambda (escape) + (with-handler + (lambda (condition more) + (escape (number->string gid))) + (lambda () + (group-info:name (group-info gid)))))))) + (display-padded group-name 9 port)) + (display-decimal-justified (file-info:size info) 7 port) + (write-char #\space port) + (display-time (file-info:mtime info) port) + (write-char #\space port) + (display-file file flag? port) + (if (eq? (file-info:type info) 'symlink) + (begin + (display " -> " port) + (display (read-symlink (car file) port)))) + (newline port))) (define *year-seconds* (* 365 24 60 60)) @@ -198,11 +210,12 @@ (display (format-date "~b ~d ~H:~M" date) port) (display (format-date "~b ~d ~Y " date) port)))) -(define (display-file file-name info flag? port) - (display file-name port) - (if (maybe-display-flag info flag? port) - (+ 1 (string-length file-name)) - (string-length file-name))) +(define (display-file file flag? port) + (let ((file-name (car file))) + (display file-name port) + (if (maybe-display-flag (cdr file) flag? port) + (+ 1 (string-length file-name)) + (string-length file-name)))) (define (maybe-display-flag info flag? port) (and flag? @@ -230,6 +243,8 @@ (write-char #\d port)) ((symlink) (write-char #\l port)) + ((fifo) + (write-char #\p port)) (else (write-char #\- port))) (let ((mode (file-info:mode info))