scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

More involved directory special-casing for ls 

(probably still wrong).
Proper handling of groups and users with id's but no names.
This commit is contained in:
sperber 2001-06-03 16:45:17 +00:00
parent a98905eaee
commit 62f6ae4084
2 changed files with 24 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
ls.scm
View File

@ -55,8 +55,10 @@
(define (ls-path path all? recursive? long? directory? flag? columns? port) (define (ls-path path all? recursive? long? directory? flag? columns? port)
(cond (cond
((and (file-directory? path #f) ((and (not directory?)
(not directory?)) (or (and (file-name-directory? path)
(file-directory? path #t))
(file-directory? path #f)))
(ls-directory path all? recursive? long? directory? flag? columns? port)) (ls-directory path all? recursive? long? directory? flag? columns? port))
(else (else
(ls-file path long? flag? port)))) (ls-file path long? flag? port))))
@ -157,9 +159,25 @@
(display-permissions info port) (display-permissions info port)
(display-decimal-justified (file-info:nlinks info) 4 port) (display-decimal-justified (file-info:nlinks info) 4 port)
(write-char #\space port) (write-char #\space port)
(let ((user-name (user-info:name (user-info (file-info:uid info))))) (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)) (display-padded user-name 9 port))
(let ((group-name (group-info:name (group-info (file-info:gid info))))) (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-padded group-name 9 port))
(display-decimal-justified (file-info:size info) 7 port) (display-decimal-justified (file-info:size info) 7 port)
(write-char #\space port) (write-char #\space port)
@ -172,7 +190,6 @@
(display (read-symlink file-name) port))) (display (read-symlink file-name) port)))
(newline port))) (newline port)))
(define *year-seconds* (* 365 24 60 60)) (define *year-seconds* (* 365 24 60 60))
(define (display-time the-time port) (define (display-time the-time port)

3
modules.scm
View File

@ -228,6 +228,7 @@
time->http-date-string time->http-date-string
begin-http-header begin-http-header
set-http-header-beginner!
send-http-error-reply send-http-error-reply
set-my-fqdn! set-my-fqdn!
@ -411,7 +412,7 @@
(define-structure ls (export ls (define-structure ls (export ls
arguments->ls-flags) arguments->ls-flags)
(open scheme (open scheme handle
big-scheme bitwise big-scheme bitwise
scsh) scsh)
(files ls)) (files ls))