125 lines
4.5 KiB
Scheme
125 lines
4.5 KiB
Scheme
(define key-return 10)
|
|
|
|
(define (make-gi-select-list gi num-lines)
|
|
(make-select-list
|
|
`(,(make-unmarked-element 'name
|
|
#t
|
|
(string-append "Name: " (group-info:name gi)))
|
|
,(make-unmarked-element 'gid
|
|
#t
|
|
(string-append "GID: " (number->string (group-info:gid gi))))
|
|
,(make-unmarked-element 'text
|
|
#f
|
|
"Members:")
|
|
,@(map (lambda (user)
|
|
(make-unmarked-element (cons 'member user)
|
|
#t
|
|
(string-append " " user)))
|
|
(group-info:members gi)))
|
|
num-lines))
|
|
|
|
(define (make-ui-select-list ui num-lines)
|
|
(make-select-list
|
|
(list (make-unmarked-element (user-info:name ui)
|
|
#t
|
|
(string-append "Name: " (user-info:name ui)))
|
|
(make-unmarked-element 'uid
|
|
#t
|
|
(string-append "UID: "
|
|
(number->string (user-info:uid ui))))
|
|
(make-unmarked-element 'gid
|
|
#t
|
|
(string-append "GID: "
|
|
(number->string (user-info:gid ui))))
|
|
(make-unmarked-element 'home-dir
|
|
#t
|
|
(string-append "Home: "
|
|
(user-info:home-dir ui)))
|
|
(make-unmarked-element 'shell
|
|
#t
|
|
(string-append "Shell: "
|
|
(user-info:shell ui))))
|
|
num-lines))
|
|
|
|
(define (make-group-info-browser gi buffer)
|
|
(let ((gi gi)
|
|
(buffer buffer)
|
|
(selection-list
|
|
(make-gi-select-list gi (result-buffer-num-lines buffer))))
|
|
(lambda (message)
|
|
(case message
|
|
((paint)
|
|
(lambda (self . args)
|
|
(apply paint-selection-list
|
|
selection-list args)))
|
|
((key-press)
|
|
(lambda (self key control-x-pressed?)
|
|
(cond
|
|
((= key key-return)
|
|
(let ((selected (select-list-selected-entry selection-list)))
|
|
(cond
|
|
((and (pair? selected)
|
|
(eq? (car selected) 'member))
|
|
(make-user-info-browser (user-info (cdr selected)) buffer))
|
|
(else self))))
|
|
(else
|
|
(set! selection-list
|
|
(select-list-handle-key-press
|
|
selection-list key))
|
|
self))))
|
|
(else
|
|
(error "unknown message in make-group-info-browser" message))))))
|
|
|
|
|
|
(define (make-user-info-browser ui buffer)
|
|
(let ((ui ui)
|
|
(buffer buffer)
|
|
(selection-list
|
|
(make-ui-select-list ui (result-buffer-num-lines buffer))))
|
|
(lambda (message)
|
|
(case message
|
|
((paint)
|
|
(lambda (self . args)
|
|
(apply paint-selection-list
|
|
selection-list args)))
|
|
((key-press)
|
|
(lambda (self key control-x-pressed?)
|
|
(cond
|
|
((= key key-return)
|
|
(let ((selected (select-list-selected-entry selection-list)))
|
|
(case selected
|
|
((gid)
|
|
(make-group-info-browser (group-info (user-info:gid ui)) buffer))
|
|
((home-dir)
|
|
(make-browser-for-dir (user-info:home-dir ui) buffer))
|
|
((shell)
|
|
(make-fsobjects-viewer
|
|
(list (file-name->fs-object (user-info:shell ui)))
|
|
buffer))
|
|
(else self))))
|
|
(else
|
|
(set! selection-list
|
|
(select-list-handle-key-press
|
|
selection-list key))
|
|
self))))
|
|
(else
|
|
(error "unknown message in make-user-info-browser" message))))))
|
|
|
|
|
|
;; scsh fails to export user-info? and group-info?...
|
|
(define user-info-type (record-ref (user-info 0) 0))
|
|
(define (user-info? x)
|
|
(and (record? x)
|
|
(eq? (record-ref x 0) user-info-type)))
|
|
|
|
(define group-info-type (record-ref (group-info 0) 0))
|
|
(define (group-info? x)
|
|
(and (record? x)
|
|
(eq? (record-ref x 0) group-info-type)))
|
|
|
|
(register-plugin!
|
|
(make-view-plugin make-user-info-browser user-info?))
|
|
|
|
(register-plugin!
|
|
(make-view-plugin make-group-info-browser group-info?))
|