commander-s/scheme/user-group-info.scm

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