ui: Add 'run-guix'.
* guix/ui.scm (guix-main): Move the code to run guix command line to ... (run-guix): ...here. New procedure. Export it.master
parent
51dac38339
commit
caa6732e96
51
guix/ui.scm
51
guix/ui.scm
|
@ -2,7 +2,7 @@
|
||||||
;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
|
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
|
||||||
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
|
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
|
||||||
;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
|
;;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
|
||||||
;;; Copyright © 2014 Deck Pickard <deck.r.pickard@gmail.com>
|
;;; Copyright © 2014 Deck Pickard <deck.r.pickard@gmail.com>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
|
@ -77,6 +77,7 @@
|
||||||
args-fold*
|
args-fold*
|
||||||
parse-command-line
|
parse-command-line
|
||||||
run-guix-command
|
run-guix-command
|
||||||
|
run-guix
|
||||||
program-name
|
program-name
|
||||||
guix-warning-port
|
guix-warning-port
|
||||||
warning
|
warning
|
||||||
|
@ -1032,31 +1033,37 @@ found."
|
||||||
(parameterize ((program-name command))
|
(parameterize ((program-name command))
|
||||||
(apply command-main args))))
|
(apply command-main args))))
|
||||||
|
|
||||||
|
(define (run-guix . args)
|
||||||
|
"Run the 'guix' command defined by command line ARGS.
|
||||||
|
Unlike 'guix-main', this procedure assumes that locale, i18n support,
|
||||||
|
and signal handling has already been set up."
|
||||||
|
(define option? (cut string-prefix? "-" <>))
|
||||||
|
|
||||||
|
(match args
|
||||||
|
(()
|
||||||
|
(format (current-error-port)
|
||||||
|
(_ "guix: missing command name~%"))
|
||||||
|
(show-guix-usage))
|
||||||
|
((or ("-h") ("--help"))
|
||||||
|
(show-guix-help))
|
||||||
|
(("--version")
|
||||||
|
(show-version-and-exit "guix"))
|
||||||
|
(((? option? o) args ...)
|
||||||
|
(format (current-error-port)
|
||||||
|
(_ "guix: unrecognized option '~a'~%") o)
|
||||||
|
(show-guix-usage))
|
||||||
|
(("help" args ...)
|
||||||
|
(show-guix-help))
|
||||||
|
((command args ...)
|
||||||
|
(apply run-guix-command
|
||||||
|
(string->symbol command)
|
||||||
|
args))))
|
||||||
|
|
||||||
(define guix-warning-port
|
(define guix-warning-port
|
||||||
(make-parameter (current-warning-port)))
|
(make-parameter (current-warning-port)))
|
||||||
|
|
||||||
(define (guix-main arg0 . args)
|
(define (guix-main arg0 . args)
|
||||||
(initialize-guix)
|
(initialize-guix)
|
||||||
(let ()
|
(apply run-guix args))
|
||||||
(define (option? str) (string-prefix? "-" str))
|
|
||||||
(match args
|
|
||||||
(()
|
|
||||||
(format (current-error-port)
|
|
||||||
(_ "guix: missing command name~%"))
|
|
||||||
(show-guix-usage))
|
|
||||||
((or ("-h") ("--help"))
|
|
||||||
(show-guix-help))
|
|
||||||
(("--version")
|
|
||||||
(show-version-and-exit "guix"))
|
|
||||||
(((? option? o) args ...)
|
|
||||||
(format (current-error-port)
|
|
||||||
(_ "guix: unrecognized option '~a'~%") o)
|
|
||||||
(show-guix-usage))
|
|
||||||
(("help" args ...)
|
|
||||||
(show-guix-help))
|
|
||||||
((command args ...)
|
|
||||||
(apply run-guix-command
|
|
||||||
(string->symbol command)
|
|
||||||
args)))))
|
|
||||||
|
|
||||||
;;; ui.scm ends here
|
;;; ui.scm ends here
|
||||||
|
|
Loading…
Reference in New Issue