(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?))