From 7a9bde00e7ac28fd9bd9a4b16efe68c7339f25cd Mon Sep 17 00:00:00 2001
From: mainzelm <mainzelm>
Date: Tue, 31 May 2005 16:02:53 +0000
Subject: [PATCH] Browser for group-info Make entries browsable

---
 scheme/nuit-packages.scm   |  5 +-
 scheme/user-group-info.scm | 99 ++++++++++++++++++++++++++++++++------
 2 files changed, 89 insertions(+), 15 deletions(-)

diff --git a/scheme/nuit-packages.scm b/scheme/nuit-packages.scm
index 11e30a3..fad5459 100644
--- a/scheme/nuit-packages.scm
+++ b/scheme/nuit-packages.scm
@@ -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))
diff --git a/scheme/user-group-info.scm b/scheme/user-group-info.scm
index 4ff1103..1942965 100644
--- a/scheme/user-group-info.scm
+++ b/scheme/user-group-info.scm
@@ -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?))
\ No newline at end of file
+ (make-view-plugin make-user-info-browser user-info?))
+
+(register-plugin!
+ (make-view-plugin make-group-info-browser group-info?))