Browser for user-info
This commit is contained in:
parent
243e746136
commit
0cb71508ef
|
@ -86,6 +86,20 @@
|
||||||
tty-debug)
|
tty-debug)
|
||||||
(files process))
|
(files process))
|
||||||
|
|
||||||
|
;;; user/group viewer plugin
|
||||||
|
|
||||||
|
(define-structure user-group-info-plugin (export)
|
||||||
|
(open scheme-with-scsh
|
||||||
|
define-record-types
|
||||||
|
(subset primitives (record-ref record?))
|
||||||
|
|
||||||
|
plugin
|
||||||
|
layout
|
||||||
|
select-list
|
||||||
|
tty-debug)
|
||||||
|
(files user-group-info))
|
||||||
|
|
||||||
|
|
||||||
;;; file list view plugin
|
;;; file list view plugin
|
||||||
|
|
||||||
(define-structure dirlist-view-plugin (export)
|
(define-structure dirlist-view-plugin (export)
|
||||||
|
@ -124,6 +138,7 @@
|
||||||
(export make-standard-viewer)
|
(export make-standard-viewer)
|
||||||
(open scheme
|
(open scheme
|
||||||
|
|
||||||
|
tty-debug
|
||||||
objects
|
objects
|
||||||
layout)
|
layout)
|
||||||
(files std-viewer))
|
(files std-viewer))
|
||||||
|
@ -326,6 +341,7 @@
|
||||||
select-list
|
select-list
|
||||||
;; the following modules are plugins
|
;; the following modules are plugins
|
||||||
dirlist-view-plugin
|
dirlist-view-plugin
|
||||||
|
user-group-info-plugin
|
||||||
process-viewer
|
process-viewer
|
||||||
standard-command-plugin
|
standard-command-plugin
|
||||||
standard-viewer
|
standard-viewer
|
||||||
|
|
|
@ -0,0 +1,53 @@
|
||||||
|
(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?))
|
Loading…
Reference in New Issue