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

also list size, owner & group, and permissions

This commit is contained in:
eknauel 2005-05-31 17:28:06 +00:00
parent 7a9bde00e7
commit df065fe14d
2 changed files with 85 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

90
scheme/browse-directory-list.scm
View File

@ -16,25 +16,98 @@
(else
(string-append " " file-name)))))
(define (have-permission? mode perm-mask)
(not (zero? (bitwise-and mode perm-mask))))
(define (format-permissions mode)
(apply string-append
(map (lambda (mask.symbol)
(if (have-permission? mode (car mask.symbol))
(cdr mask.symbol)
"-"))
'((#o0400 . "r") ;; owner read
(#o0200 . "w") ;; owner write
(#o0100 . "x") ;; owner exec
(#o0040 . "r") ;; group read
(#o0020 . "w") ;; group write
(#o0010 . "x") ;; group exec
(#o0004 . "r") ;; others read
(#o0002 . "w") ;; others write
(#o0001 . "x"))))) ;; others exec
(define (digits-left-of-comma-as-string float)
(string-drop-right
(number->string (truncate float)) 1))
(define (format-size/unit float unit)
(string-append (digits-left-of-comma-as-string float) " " unit))
(define (format-size bytes)
(let* ((kbyte 1024.0)
(mbyte (* 1024 kbyte))
(gbyte (* 1024 mbyte)))
(cond
((>= bytes gbyte)
(format-size/unit (/ bytes gbyte) "GB"))
((>= bytes mbyte)
(format-size/unit (/ bytes mbyte) "MB"))
((>= bytes kbyte)
(format-size/unit (/ bytes kbyte) "KB"))
(else
(number->string bytes)))))
(define (format-user/group fi)
(fill-up-string 17
(string-append
(cut-to-size 8 (->username (file-info:uid fi)))
":"
(cut-to-size 8 (group-info:name
(group-info (file-info:gid fi)))))))
(define (fill-up-string length string)
(if (> (string-length string) length)
(substring string 0 length)
(string-append
string (make-string (- length (string-length string))
#\space))))
(define (cut-to-size length string)
(if (> (string-length string) length)
(substring string 0 length)
string))
;; leave one line for the heading
(define (calculate-number-of-lines result-buffer)
(- (result-buffer-num-lines result-buffer)
1))
(define (layout-fsobject parent-dir-len fsobject)
(define (layout-fsobject parent-dir-len fsobject num-cols)
(let ((file-name (combine-path (string-drop
(fs-object-path fsobject)
parent-dir-len)
(fs-object-name fsobject))))
(add-marks-to-special-file file-name fsobject)))
(fs-object-name fsobject)))
(fi (fs-object-info fsobject)))
(cut-to-size num-cols
(string-append
(fill-up-string
30 (add-marks-to-special-file file-name fsobject))
" "
(fill-up-string
7 (format-size (file-info:size fi)))
" "
(format-user/group fi)
" "
(format-permissions
(file-info:mode fi))))))
(define (make-file-select-list fsobjects parent-dir num-lines)
(define (make-file-select-list fsobjects parent-dir num-lines num-cols)
(let ((parent-dir-len (string-length parent-dir)))
(make-select-list
(cons (make-unmarked-element 'parent-dir #f " ..")
(map (lambda (fs-object)
(make-unmarked-element
fs-object #t (layout-fsobject parent-dir-len fs-object)))
fs-object #t (layout-fsobject parent-dir-len
fs-object num-cols)))
fsobjects))
num-lines)))
@ -134,9 +207,10 @@
(let ((fs-objects fs-objects)
(buffer buffer)
(select-list
(make-file-select-list fs-objects
working-dir
(- (result-buffer-num-lines buffer) 2))))
(make-file-select-list
fs-objects working-dir
(- (result-buffer-num-lines buffer) 2)
(result-buffer-num-cols buffer))))
(lambda (message)
(cond

4
scheme/nuit-packages.scm
View File

@ -108,7 +108,9 @@
make-fsobjects-viewer)
(open (modify nuit-eval (hide string-copy))
srfi-1
(subset srfi-13 (string-copy string-drop string-prefix-length))
(subset srfi-13
(string-copy string-drop
string-drop-right string-prefix-length))
signals
let-opt