summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-11-15 21:48:35 +0100
committerLudovic Courtès <ludo@gnu.org>2019-11-15 23:29:06 +0100
commit87e7faa2ae641d8302efc8b90f1e45f43f67f6da (patch)
treeca738a80ce423af14ac1b118226ef3a8444d8345
parentd17e012da7b41165cb49a5604a773459736144e3 (diff)
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.
-rw-r--r--doc/guix.texi4
-rw-r--r--guix/scripts/time-machine.scm55
2 files changed, 46 insertions, 13 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index bc1d5d863a..51147e3e9a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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.
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
@section Inferiors
diff --git a/guix/scripts/time-machine.scm b/guix/scripts/time-machine.scm
index 946b523741..19e635555a 100644
--- a/guix/scripts/time-machine.scm
+++ b/guix/scripts/time-machine.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Konrad Hinsen <konrad.hinsen@fastmail.net>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -22,8 +23,15 @@
#:use-module (guix inferior)
#:use-module (guix channels)
#:use-module (guix store)
+ #:use-module (guix status)
+ #:use-module ((guix utils)
+ #:select (%current-system))
#:use-module ((guix scripts pull)
#: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 (srfi srfi-1)
#: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"))
(display (G_ "
--branch=BRANCH use the tip of the specified BRANCH"))
+ (newline)
+ (show-build-options-help)
+ (newline)
(display (G_ "
-h, --help display this help and exit"))
(display (G_ "
@@ -56,9 +67,9 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
(define %options
;; Specifications of the command-line options.
- (list (option '(#\C "channels") #t #f
- (lambda (opt name arg result)
- (alist-cons 'channel-file arg result)))
+ (cons* (option '(#\C "channels") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'channel-file arg result)))
(option '("url") #t #f
(lambda (opt name arg result)
(alist-cons 'repository-url arg
@@ -69,20 +80,35 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
(option '("branch") #t #f
(lambda (opt name arg result)
(alist-cons 'ref `(branch . ,arg) result)))
- (option '(#\h "help") #f #f
- (lambda args
- (show-help)
- (exit 0)))
- (option '(#\V "version") #f #f
- (lambda args
- (show-version-and-exit "guix time-machine")))))
+ (option '(#\h "help") #f #f
+ (lambda args
+ (show-help)
+ (exit 0)))
+ (option '(#\V "version") #f #f
+ (lambda args
+ (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)
"Parse the list of command line arguments ARGS."
;; The '--' token is used to separate the command to run from the rest of
;; the operands.
(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
(() opts)
(("--") opts)
@@ -100,7 +126,10 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
(channels (channel-list opts))
(command-line (assoc-ref opts 'exec)))
(when command-line
- (let* ((directory (with-store store
- (cached-channel-instance store channels)))
+ (let* ((directory
+ (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")))
(apply execl (cons* executable executable command-line))))))))