parent
da28396e3c
commit
7a9bde00e7
|
@ -93,6 +93,8 @@
|
|||
define-record-types
|
||||
(subset primitives (record-ref record?))
|
||||
|
||||
dirlist-view-plugin
|
||||
fs-object
|
||||
plugin
|
||||
layout
|
||||
select-list
|
||||
|
@ -102,7 +104,8 @@
|
|||
|
||||
;;; file list view plugin
|
||||
|
||||
(define-structure dirlist-view-plugin (export)
|
||||
(define-structure dirlist-view-plugin (export make-browser-for-dir
|
||||
make-fsobjects-viewer)
|
||||
(open (modify nuit-eval (hide string-copy))
|
||||
srfi-1
|
||||
(subset srfi-13 (string-copy string-drop string-prefix-length))
|
||||
|
|
|
@ -1,22 +1,76 @@
|
|||
(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
|
||||
(user-info:name ui))
|
||||
(make-unmarked-element (user-info:uid ui)
|
||||
(string-append "Name: " (user-info:name ui)))
|
||||
(make-unmarked-element 'uid
|
||||
#t
|
||||
(number->string (user-info:uid ui)))
|
||||
(make-unmarked-element (user-info:gid ui)
|
||||
(string-append "UID: "
|
||||
(number->string (user-info:uid ui))))
|
||||
(make-unmarked-element 'gid
|
||||
#t
|
||||
(number->string (user-info:gid ui)))
|
||||
(make-unmarked-element (user-info:home-dir ui)
|
||||
(string-append "GID: "
|
||||
(number->string (user-info:gid ui))))
|
||||
(make-unmarked-element 'home-dir
|
||||
#t
|
||||
(user-info:home-dir ui))
|
||||
(make-unmarked-element (user-info:shell ui)
|
||||
(string-append "Home: "
|
||||
(user-info:home-dir ui)))
|
||||
(make-unmarked-element 'shell
|
||||
#t
|
||||
(user-info:shell ui)))
|
||||
(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)
|
||||
|
@ -30,10 +84,24 @@
|
|||
selection-list args)))
|
||||
((key-press)
|
||||
(lambda (self key control-x-pressed?)
|
||||
(set! selection-list
|
||||
(select-list-handle-key-press
|
||||
selection-list key))
|
||||
self))
|
||||
(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))))))
|
||||
|
||||
|
@ -50,4 +118,7 @@
|
|||
(eq? (record-ref x 0) group-info-type)))
|
||||
|
||||
(register-plugin!
|
||||
(make-view-plugin make-user-info-browser user-info?))
|
||||
(make-view-plugin make-user-info-browser user-info?))
|
||||
|
||||
(register-plugin!
|
||||
(make-view-plugin make-group-info-browser group-info?))
|
||||
|
|
Loading…
Reference in New Issue