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

Browser for group-info 

Make entries browsable
This commit is contained in:
mainzelm 2005-05-31 16:02:53 +00:00
parent da28396e3c
commit 7a9bde00e7
2 changed files with 89 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
scheme/nuit-packages.scm
View File

@ -93,6 +93,8 @@
define-record-types define-record-types
(subset primitives (record-ref record?)) (subset primitives (record-ref record?))
dirlist-view-plugin
fs-object
plugin plugin
layout layout
select-list select-list
@ -102,7 +104,8 @@
;;; file list view plugin ;;; 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)) (open (modify nuit-eval (hide string-copy))
srfi-1 srfi-1
(subset srfi-13 (string-copy string-drop string-prefix-length)) (subset srfi-13 (string-copy string-drop string-prefix-length))

99
scheme/user-group-info.scm
View File

@ -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) (define (make-ui-select-list ui num-lines)
(make-select-list (make-select-list
(list (make-unmarked-element (user-info:name ui) (list (make-unmarked-element (user-info:name ui)
#t #t
(user-info:name ui)) (string-append "Name: " (user-info:name ui)))
(make-unmarked-element (user-info:uid ui) (make-unmarked-element 'uid
#t #t
(number->string (user-info:uid ui))) (string-append "UID: "
(make-unmarked-element (user-info:gid ui) (number->string (user-info:uid ui))))
(make-unmarked-element 'gid
#t #t
(number->string (user-info:gid ui))) (string-append "GID: "
(make-unmarked-element (user-info:home-dir ui) (number->string (user-info:gid ui))))
(make-unmarked-element 'home-dir
#t #t
(user-info:home-dir ui)) (string-append "Home: "
(make-unmarked-element (user-info:shell ui) (user-info:home-dir ui)))
(make-unmarked-element 'shell
#t #t
(user-info:shell ui))) (string-append "Shell: "
(user-info:shell ui))))
num-lines)) 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) (define (make-user-info-browser ui buffer)
(let ((ui ui) (let ((ui ui)
(buffer buffer) (buffer buffer)
@ -30,10 +84,24 @@
selection-list args))) selection-list args)))
((key-press) ((key-press)
(lambda (self key control-x-pressed?) (lambda (self key control-x-pressed?)
(set! selection-list (cond
(select-list-handle-key-press ((= key key-return)
selection-list key)) (let ((selected (select-list-selected-entry selection-list)))
self)) (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 (else
(error "unknown message in make-user-info-browser" message)))))) (error "unknown message in make-user-info-browser" message))))))
@ -50,4 +118,7 @@
(eq? (record-ref x 0) group-info-type))) (eq? (record-ref x 0) group-info-type)))
(register-plugin! (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?))