From fa8738ff2cf48886c9ef8fbacfa806f547f3c3c8 Mon Sep 17 00:00:00 2001
From: nebuli <nebu@kipple>
Date: Thu, 27 Nov 2014 23:36:29 +0100
Subject: [PATCH 2/2] guix: scripts: Add handling of options from GUIX_BUILD
 environmental variable.

* guix/scripts/archive.scm (parse-options): (append args (args-from-env ...))
* guix/scripts/build.scm: ditto
* guix/scripts/environment.scm: ditto
* guix/scripts/package.scm: ditto
* guix/scripts/system.scm: ditto
* guix/utils.scm (args-from-env): New common function.
---
 guix/scripts/archive.scm     |  8 +++++++-
 guix/scripts/build.scm       |  8 +++++++-
 guix/scripts/environment.scm |  9 ++++++++-
 guix/scripts/package.scm     |  8 +++++++-
 guix/scripts/system.scm      |  8 +++++++-
 guix/utils.scm               | 15 +++++++++++++++
 6 files changed, 51 insertions(+), 5 deletions(-)

diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm
index 84904e2..1ab4f86 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -293,7 +293,13 @@ the input port."
 (define (guix-archive . args)
   (define (parse-options)
     ;; Return the alist of option values.
-    (args-fold* args %options
+    (args-fold* (append args
+                        (args-from-env "GUIX_BUILD"
+                                       (lambda (var opts)
+                                         (format (current-error-port)
+                                                 (_ "guix archive: ~a: ~a~%")
+                                                 var opts))))
+                %options
                 (lambda (opt name arg result)
                   (leave (_ "~A: unrecognized option~%") name))
                 (lambda (arg result)
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 3fb7aa8..57b75ca 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -401,7 +401,13 @@ arguments with packages that use the specified source."
 (define (guix-build . args)
   (define (parse-options)
     ;; Return the alist of option values.
-    (args-fold* args %options
+    (args-fold* (append args
+                        (args-from-env "GUIX_BUILD"
+                                       (lambda (var opts)
+                                         (format (current-error-port)
+                                                 (_ "guix build: ~a: ~a~%")
+                                                 var opts))))
+                %options
                 (lambda (opt name arg result)
                   (leave (_ "~A: unrecognized option~%") name))
                 (lambda (arg result)
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 81bad96..dfc6df4 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -213,7 +213,14 @@ packages."
 ;; Entry point.
 (define (guix-environment . args)
   (define (parse-options)
-    (args-fold* args %options
+    (args-fold* (append args
+                        (args-from-env
+                         "GUIX_BUILD"
+                         (lambda (var opts)
+                           (format (current-error-port)
+                                   (_ "guix environment: ~a: ~a~%")
+                                   var opts))))
+                %options
                 (lambda (opt name arg result)
                   (leave (_ "~A: unrecognized option~%") name))
                 (lambda (arg result)
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 3a72053..70b37ec 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -668,7 +668,13 @@ removed from MANIFEST."
 (define (guix-package . args)
   (define (parse-options)
     ;; Return the alist of option values.
-    (args-fold* args %options
+    (args-fold* (append args
+                        (args-from-env "GUIX_BUILD"
+                                       (lambda (var opts)
+                                         (format (current-error-port)
+                                                 (_ "guix package: ~a: ~a~%")
+                                                 var opts))))
+                %options
                 (lambda (opt name arg result arg-handler)
                   (leave (_ "~A: unrecognized option~%") name))
                 (lambda (arg result arg-handler)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 398a5a3..fa00ae6 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -467,7 +467,13 @@ Build the operating system declared in FILE according to ACTION.\n"))
 (define (guix-system . args)
   (define (parse-options)
     ;; Return the alist of option values.
-    (args-fold* args %options
+    (args-fold* (append args
+                        (args-from-env "GUIX_BUILD"
+                                       (lambda (var opts)
+                                         (format (current-error-port)
+                                                 (_ "guix system: ~a: ~a~%")
+                                                 var opts))))
+                %options
                 (lambda (opt name arg result)
                   (leave (_ "~A: unrecognized option~%") name))
                 (lambda (arg result)
diff --git a/guix/utils.scm b/guix/utils.scm
index 9b802b6..89e593c 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -72,6 +72,7 @@
             package-name->name+version
             string-tokenize*
             string-replace-substring
+            args-from-env
             file-extension
             file-sans-extension
             call-with-temporary-output-file
@@ -627,6 +628,20 @@ REPLACEMENT."
                        (substring str start index)
                        pieces))))))))
 
+(define (args-from-env var . rest)
+  "Retrieve value of environment variable denoted by string VAR in the form
+of a list of strings ('char-set:graphic' tokens) suitable for consumption by
+the fold-arg family of functions.  If VAR is defined, call car of a non-null
+REST on the VAR and result, otherwise return an empty list."
+  (let ((env-opts (getenv variable)))
+    (if env-opts
+        (let ((opts (string-tokenize env-opts char-set:graphic)))
+          (and (not (null? rest))
+               (apply (car rest)
+                      (list variable opts)))
+          opts)
+        '())))
+
 (define (call-with-temporary-output-file proc)
   "Call PROC with a name of a temporary file and open output port to that
 file; close the file and delete it when leaving the dynamic extent of this
-- 
2.1.2

