ui: Factorize command-line + env. var. option parsing.

* guix/ui.scm (%default-argument-handler, parse-command-line): New
  procedures.
  (environment-build-options): Make private.
* guix/scripts/archive.scm (guix-archive)[parse-options,
  parse-options-from]: Remove.  Use 'parse-command-line' instead.
* guix/scripts/build.scm (guix-build): Likewise.
* guix/scripts/environment.scm (guix-environment): Likewise.
* guix/scripts/package.scm (guix-package): Likewise.
* guix/scripts/system.scm (guix-system): Likewise.
* tests/ui.scm (with-environment-variable): New macro.
  ("parse-command-line"): New test.

1 files changed, 13 insertions, 21 deletions

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index b15bb8bb0d..1b64e6fb92 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -487,26 +487,15 @@ Build the operating system declared in FILE according to ACTION.\n"))
 ;;;
 
 (define (guix-system . args)
-  (define (parse-options)
-    ;; Return the alist of option values.
-    (append (parse-options-from args)
-            (parse-options-from (environment-build-options))))
-
-  (define (parse-options-from args)
-    ;; Actual parsing takes place here.
-    (args-fold* args %options
-                (lambda (opt name arg result)
-                  (leave (_ "~A: unrecognized option~%") name))
-                (lambda (arg result)
-                  (if (assoc-ref result 'action)
-                      (alist-cons 'argument arg result)
-                      (let ((action (string->symbol arg)))
-                        (case action
-                          ((build vm vm-image disk-image reconfigure init)
-                           (alist-cons 'action action result))
-                          (else (leave (_ "~a: unknown action~%")
-                                       action))))))
-                %default-options))
+  (define (parse-sub-command arg result)
+    ;; Parse sub-command ARG and augment RESULT accordingly.
+    (if (assoc-ref result 'action)
+        (alist-cons 'argument arg result)
+        (let ((action (string->symbol arg)))
+          (case action
+            ((build vm vm-image disk-image reconfigure init)
+             (alist-cons 'action action result))
+            (else (leave (_ "~a: unknown action~%") action))))))
 
   (define (match-pair car)
     ;; Return a procedure that matches a pair with CAR.
@@ -534,7 +523,10 @@ Build the operating system declared in FILE according to ACTION.\n"))
       args))
 
   (with-error-handling
-    (let* ((opts     (parse-options))
+    (let* ((opts     (parse-command-line args %options
+                                         (list %default-options)
+                                         #:argument-handler
+                                         parse-sub-command))
            (args     (option-arguments opts))
            (file     (first args))
            (action   (assoc-ref opts 'action))