53 lines
1.8 KiB
Scheme
53 lines
1.8 KiB
Scheme
|
(define (make-ui-select-list ui num-lines)
|
||
|
|
(make-select-list
|
||
|
|
(list (make-unmarked-element (user-info:name ui)
|
||
|
|
#t
|
||
|
|
(user-info:name ui))
|
||
|
|
(make-unmarked-element (user-info:uid ui)
|
||
|
|
#t
|
||
|
|
(number->string (user-info:uid ui)))
|
||
|
|
(make-unmarked-element (user-info:gid ui)
|
||
|
|
#t
|
||
|
|
(number->string (user-info:gid ui)))
|
||
|
|
(make-unmarked-element (user-info:home-dir ui)
|
||
|
|
#t
|
||
|
|
(user-info:home-dir ui))
|
||
|
|
(make-unmarked-element (user-info:shell ui)
|
||
|
|
#t
|
||
|
|
(user-info:shell ui)))
|
||
|
|
num-lines))
|
||
|
|
|
||
|
|
(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?)
|
||
|
|
(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?))
|