get-selection-as-text/ref for group-info

part of darcs patch Sat Sep 17 17:10:00 EEST 2005  Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>

scheme/user-group-info.scm

@@ -234,6 +234,51 @@
         (buffer buffer)
         (selection-list
          (make-gi-select-list gi (result-buffer-num-lines buffer))))
+
+    (define (group-info-element->value info)
+      (case info
+        ((gid)
+         (group-info:gid gi))
+        ((name)
+         (group-info:name gi))
+        (else                           ;members
+         (cdr info))))
+
+    (define (prepare-selection-for-command-mode infos)
+      (string-join
+       (map value->string
+            (map group-info-element->value infos))))
+    
+    (define (prepare-selection-for-scheme-mode infos)
+      (string-append 
+       "'" 
+       (exp->string
+        (map group-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 group-info-element->value infos))))
+         ")")))
+    
+
     (lambda (message)
       (case message
         ((paint)
@@ -255,6 +300,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-group-info-browser" message))))))