get-selection-as-text/ref for user-info records

part of darcs patch Fri Sep 16 23:55:48 EEST 2005  Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>

scheme/user-group-info.scm

@@ -257,13 +257,67 @@
              self))))
         (else
          (error "unknown message in make-group-info-browser" message))))))
-         
+
+(define (value->string val)
+  (cond ((string? val) val)
+        ((number? val) (number->string val))
+        ((boolean? val) (if val "#t" "#f"))
+        (else
+         (error "unknwon value in value->string" val))))
 
 (define (make-user-info-browser ui buffer)
   (let ((ui ui)
         (buffer buffer)
         (selection-list 
          (make-ui-select-list ui (result-buffer-num-lines buffer))))
+
+    (define (user-info-element->value info)
+      (case info
+        ((gid)
+         (user-info:gid ui))
+        ((uid)
+         (user-info:uid ui))
+        ((home-dir)
+         (user-info:home-dir ui))
+        ((shell)
+         (user-info:shell ui))
+        (else                           ;user name
+         info)))
+ 
+    (define (prepare-selection-for-command-mode infos)
+      (string-join
+       (map value->string
+            (map user-info-element->value infos))))
+    
+    (define (prepare-selection-for-scheme-mode infos)
+      (string-append 
+       "'" 
+       (exp->string
+        (map user-info-element->value infos))))
+
+    (define (get-selection-as-text self for-scheme-mode?
+                                   focus-object-table)
+      (let ((infos
+             (select-list-get-selection selection-list)))
+        ((if for-scheme-mode?
+             prepare-selection-for-scheme-mode
+             prepare-selection-for-command-mode)
+         infos)))
+    
+    (define (get-selection-as-ref self focus-object-table)
+      (let ((infos
+             (select-list-get-selection selection-list))
+            (make-reference (lambda (obj)
+				(make-focus-object-reference 
+				 focus-object-table obj))))
+        (string-append 
+         "(list "
+         (string-join
+          (map exp->string
+               (map make-reference
+                    (map user-info-element->value infos))))
+         ")")))
+
     (lambda (message)
       (case message
         ((paint)
@@ -278,6 +332,8 @@
                (case selected
                  ((gid)
                   (make-group-info-browser (group-info (user-info:gid ui)) buffer))
+                 ((uid)
+                  self)
                  ((home-dir)
                   (make-browser-for-dir (user-info:home-dir ui) buffer))
                  ((shell)
@@ -290,6 +346,10 @@
                    (select-list-handle-key-press
                     selection-list key))
              self))))
+        ((get-selection-as-text)
+         get-selection-as-text)
+        ((get-selection-as-ref)
+         get-selection-as-ref)
         (else
          (error "unknown message in make-user-info-browser" message))))))