From b3f213893b67620840597213b8f46af1ddfb4934 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès 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/system.scm | 34 +++++++++++++--------------------- 1 file changed, 13 insertions(+), 21 deletions(-) (limited to 'guix/scripts/system.scm') 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 @@ (define %default-options ;;; (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 @@ (define (fail) 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)) -- cgit v1.2.3