From b3f213893b67620840597213b8f46af1ddfb4934 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 25 Feb 2015 23:31:51 +0100
Subject: 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.
---
 guix/scripts/package.scm | 24 +++++++-----------------
 1 file changed, 7 insertions(+), 17 deletions(-)

(limited to 'guix/scripts/package.scm')

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index fc116d8f6c..c27207f29a 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -692,22 +692,11 @@ doesn't need it."
 ;;;
 
 (define (guix-package . 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 arg-handler)
-                  (leave (_ "~A: unrecognized option~%") name))
-                (lambda (arg result arg-handler)
-                  (if arg-handler
-                      (arg-handler arg result)
-                      (leave (_ "~A: extraneous argument~%") arg)))
-                %default-options
-                #f))
+  (define (handle-argument arg result arg-handler)
+    ;; Process non-option argument ARG by calling back ARG-HANDLER.
+    (if arg-handler
+        (arg-handler arg result)
+        (leave (_ "~A: extraneous argument~%") arg)))
 
   (define (ensure-default-profile)
     ;; Ensure the default profile symlink and directory exist and are
@@ -987,7 +976,8 @@ more information.~%"))
 
         (_ #f))))
 
-  (let ((opts (parse-options)))
+  (let ((opts (parse-command-line args %options (list %default-options #f)
+                                  #:argument-handler handle-argument)))
     (with-error-handling
       (or (process-query opts)
           (parameterize ((%store (open-connection)))
-- 
cgit v1.2.3