mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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
2 changed files with 46 additions and 13 deletions
|
@ -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
|
||||
|
||||
|
|
|
@ -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 @@ (define-module (guix scripts time-machine)
|
|||
#: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 @@ (define (show-help)
|
|||
--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 @@ (define (show-help)
|
|||
|
||||
(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 @@ (define %options
|
|||
(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 @@ (define (guix-time-machine . args)
|
|||
(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))))))))
|
||||
|
|
Loading…
Reference in a new issue