even less STAT-calls
(removed STAT-calls when called with RECURSIVE)
This commit is contained in:
interp
parent
5973322619
commit
3c200d4db9
147
ls.scm
147
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))
|
||||
|
|
|
|||
Loading…
Reference in New Issue