time-machine: Honor the standard build options.
* guix/scripts/time-machine.scm (show-help): Call 'show-build-options-help'. (%options): Add %STANDARD-BUILD-OPTIONS. (%default-options): New variable. (parse-args): Pass (list %default-options) to 'parse-command-line' and remove #:build-options? parameter. (guix-time-machine): Call 'set-build-options-from-command-line' and wrap 'cached-channel-instance' call in 'with-status-verbosity'. * doc/guix.texi (Invoking guix time-machine): Mention common build options.
This commit is contained in:
parent
d17e012da7
commit
87e7faa2ae
@ -4222,6 +4222,10 @@ will thus build the package @code{hello} as defined in the master branch,
|
|||||||
which is in general a newer revison of Guix than you have installed.
|
which is in general a newer revison of Guix than you have installed.
|
||||||
Time travel works in both directions!
|
Time travel works in both directions!
|
||||||
|
|
||||||
|
Note that @command{guix time-machine} can trigger builds of channels and
|
||||||
|
their dependencies, and these are controlled by the standard build
|
||||||
|
options (@pxref{Common Build Options}).
|
||||||
|
|
||||||
@node Inferiors
|
@node Inferiors
|
||||||
@section Inferiors
|
@section Inferiors
|
||||||
|
|
||||||
|
@ -1,5 +1,6 @@
|
|||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2019 Konrad Hinsen <konrad.hinsen@fastmail.net>
|
;;; Copyright © 2019 Konrad Hinsen <konrad.hinsen@fastmail.net>
|
||||||
|
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
@ -22,8 +23,15 @@
|
|||||||
#:use-module (guix inferior)
|
#:use-module (guix inferior)
|
||||||
#:use-module (guix channels)
|
#:use-module (guix channels)
|
||||||
#:use-module (guix store)
|
#:use-module (guix store)
|
||||||
|
#:use-module (guix status)
|
||||||
|
#:use-module ((guix utils)
|
||||||
|
#:select (%current-system))
|
||||||
#:use-module ((guix scripts pull)
|
#:use-module ((guix scripts pull)
|
||||||
#:select (with-git-error-handling channel-list))
|
#:select (with-git-error-handling channel-list))
|
||||||
|
#:use-module ((guix scripts build)
|
||||||
|
#:select (%standard-build-options
|
||||||
|
show-build-options-help
|
||||||
|
set-build-options-from-command-line))
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-11)
|
#:use-module (srfi srfi-11)
|
||||||
@ -47,6 +55,9 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
|
|||||||
--commit=COMMIT use the specified COMMIT"))
|
--commit=COMMIT use the specified COMMIT"))
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
--branch=BRANCH use the tip of the specified BRANCH"))
|
--branch=BRANCH use the tip of the specified BRANCH"))
|
||||||
|
(newline)
|
||||||
|
(show-build-options-help)
|
||||||
|
(newline)
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
-h, --help display this help and exit"))
|
-h, --help display this help and exit"))
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
@ -56,9 +67,9 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
|
|||||||
|
|
||||||
(define %options
|
(define %options
|
||||||
;; Specifications of the command-line options.
|
;; Specifications of the command-line options.
|
||||||
(list (option '(#\C "channels") #t #f
|
(cons* (option '(#\C "channels") #t #f
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(alist-cons 'channel-file arg result)))
|
(alist-cons 'channel-file arg result)))
|
||||||
(option '("url") #t #f
|
(option '("url") #t #f
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(alist-cons 'repository-url arg
|
(alist-cons 'repository-url arg
|
||||||
@ -69,20 +80,35 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
|
|||||||
(option '("branch") #t #f
|
(option '("branch") #t #f
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(alist-cons 'ref `(branch . ,arg) result)))
|
(alist-cons 'ref `(branch . ,arg) result)))
|
||||||
(option '(#\h "help") #f #f
|
(option '(#\h "help") #f #f
|
||||||
(lambda args
|
(lambda args
|
||||||
(show-help)
|
(show-help)
|
||||||
(exit 0)))
|
(exit 0)))
|
||||||
(option '(#\V "version") #f #f
|
(option '(#\V "version") #f #f
|
||||||
(lambda args
|
(lambda args
|
||||||
(show-version-and-exit "guix time-machine")))))
|
(show-version-and-exit "guix time-machine")))
|
||||||
|
|
||||||
|
%standard-build-options))
|
||||||
|
|
||||||
|
(define %default-options
|
||||||
|
;; Alist of default option values.
|
||||||
|
`((system . ,(%current-system))
|
||||||
|
(substitutes? . #t)
|
||||||
|
(build-hook? . #t)
|
||||||
|
(print-build-trace? . #t)
|
||||||
|
(print-extended-build-trace? . #t)
|
||||||
|
(multiplexed-build-output? . #t)
|
||||||
|
(graft? . #t)
|
||||||
|
(debug . 0)
|
||||||
|
(verbosity . 1)))
|
||||||
|
|
||||||
(define (parse-args args)
|
(define (parse-args args)
|
||||||
"Parse the list of command line arguments ARGS."
|
"Parse the list of command line arguments ARGS."
|
||||||
;; The '--' token is used to separate the command to run from the rest of
|
;; The '--' token is used to separate the command to run from the rest of
|
||||||
;; the operands.
|
;; the operands.
|
||||||
(let-values (((args command) (break (cut string=? "--" <>) args)))
|
(let-values (((args command) (break (cut string=? "--" <>) args)))
|
||||||
(let ((opts (parse-command-line args %options '(()) #:build-options? #f)))
|
(let ((opts (parse-command-line args %options
|
||||||
|
(list %default-options))))
|
||||||
(match command
|
(match command
|
||||||
(() opts)
|
(() opts)
|
||||||
(("--") opts)
|
(("--") opts)
|
||||||
@ -100,7 +126,10 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
|
|||||||
(channels (channel-list opts))
|
(channels (channel-list opts))
|
||||||
(command-line (assoc-ref opts 'exec)))
|
(command-line (assoc-ref opts 'exec)))
|
||||||
(when command-line
|
(when command-line
|
||||||
(let* ((directory (with-store store
|
(let* ((directory
|
||||||
(cached-channel-instance store channels)))
|
(with-store store
|
||||||
|
(with-status-verbosity (assoc-ref opts 'verbosity)
|
||||||
|
(set-build-options-from-command-line store opts)
|
||||||
|
(cached-channel-instance store channels))))
|
||||||
(executable (string-append directory "/bin/guix")))
|
(executable (string-append directory "/bin/guix")))
|
||||||
(apply execl (cons* executable executable command-line))))))))
|
(apply execl (cons* executable executable command-line))))))))
|
||||||
|
Loading…
Reference in New Issue
Block a user