Handle all options of id

part of darcs patch Thu Sep 22 14:50:23 EEST 2005  Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>

scheme/nuit-packages.scm

@@ -181,7 +181,7 @@
         define-record-types
         (subset primitives (record-ref record?))
         (subset srfi-13 (string-join))
-        (subset srfi-1 (partition))
+        (subset srfi-1 (partition lset-difference))
         srfi-37
         
         dirlist-view-plugin

scheme/user-group-info.scm

@@ -70,7 +70,13 @@
       (receive (options args) (partition pair? given-args)
         (values (map car options) args)))))
 
-
+;;;usage: id [user]
+;;;       id -G [-n] [user]
+;;;       id -M
+;;;       id -P [user]
+;;;       id -g [-nr] [user]
+;;;       id -p [user]
+;;;       id -u [-nr] [user]
 (define (id command args)
   (receive (options others) (parse-id-arguments args)
     (let ((maybe-username (if (null? others)
@@ -83,14 +89,25 @@
        ((and (member 'passwd options)
              (= no-options 1))
         (run-passwd-id maybe-username))
-       ((member 'gid options)
-        "-g option not supported yet")
-       ((member 'human-readable options)
-        "-p option not supported yet")
-       ((member 'uid options)
-        "-u option not supported yet")
+       ((and (member 'gid options)
+             (null? (lset-difference 
+                     eq? 
+                     options
+                     '(gid real name-instead))))
+        (run-uid/gid-id options args))
+       ((and (member 'uid options)
+             (null? (lset-difference 
+                     eq? 
+                     options
+                     '(uid real name-instead))))
+        (run-uid/gid-id options args))
+       ((and (member 'human-readable options)
+             (= no-options 1))
+        (run-human-readable-id maybe-username))
        (else
-        "illegal aruments for id" args)))))
+        (string-append
+         "illegal arguments for id " (string-join args)))))))
+         
 
 (define (run-standard-id maybe-username)
   (let* ((out (run/string (id ,@ maybe-username)))
@@ -108,7 +125,14 @@
   (let* ((out (run/string (id -P ,@ maybe-username))))
     out))
          
-         
+(define (run-uid/gid-id options args)
+  (let ((out (run/strings (id ,@args))))
+    (if (member 'name-instead options)
+        (car out)
+        (string->number (car out)))))
+
+(define (run-human-readable-id maybe-username)
+  (run/string (id -p ,@ maybe-username)))
 
 (register-plugin!
  (make-command-plugin