guix-package: Add `--verbose'; silence the environment's build by default.

* guix-package.in (%options): Add `--verbose'.
  (show-help): Update accordingly.
  (guix-package): Parameterize `current-build-output-port' according to
  VERBOSE?.  By default, silence the environment build's output.
This commit is contained in:
Ludovic Courtès 2012-12-12 14:59:16 +01:00
parent ba55b1cb69
commit 70915c1a2e
2 changed files with 15 additions and 1 deletions

View File

@ -235,6 +235,10 @@ Use @var{profile} instead of the user's default profile.
@itemx -n @itemx -n
Show what would be done without actually doing it. Show what would be done without actually doing it.
@item --verbose
Produce verbose output. In particular, emit the environment's build log
on the standard error port.
@item --bootstrap @item --bootstrap
Use the bootstrap Guile to build the profile. This option is only Use the bootstrap Guile to build the profile. This option is only
useful to distribution developers. useful to distribution developers.

View File

@ -200,6 +200,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
-n, --dry-run show what would be done without actually doing it")) -n, --dry-run show what would be done without actually doing it"))
(display (_ " (display (_ "
-b, --bootstrap use the bootstrap Guile to build the profile")) -b, --bootstrap use the bootstrap Guile to build the profile"))
(display (_ "
--verbose produce verbose output"))
(newline) (newline)
(display (_ " (display (_ "
-I, --list-installed[=REGEXP] -I, --list-installed[=REGEXP]
@ -242,6 +244,9 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
(option '(#\b "bootstrap") #f #f (option '(#\b "bootstrap") #f #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'bootstrap? #t result))) (alist-cons 'bootstrap? #t result)))
(option '("verbose") #f #f
(lambda (opt name arg result)
(alist-cons 'verbose? #t result)))
(option '(#\I "list-installed") #f #t (option '(#\I "list-installed") #f #t
(lambda (opt name arg result) (lambda (opt name arg result)
(cons `(query list-installed ,(or arg "")) (cons `(query list-installed ,(or arg ""))
@ -321,6 +326,7 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
(define (process-actions opts) (define (process-actions opts)
;; Process any install/remove/upgrade action from OPTS. ;; Process any install/remove/upgrade action from OPTS.
(let* ((dry-run? (assoc-ref opts 'dry-run?)) (let* ((dry-run? (assoc-ref opts 'dry-run?))
(verbose? (assoc-ref opts 'verbose?))
(profile (assoc-ref opts 'profile)) (profile (assoc-ref opts 'profile))
(install (filter-map (match-lambda (install (filter-map (match-lambda
(('install . (? store-path?)) (('install . (? store-path?))
@ -385,7 +391,11 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
(basename profile) (+ 1 number)))) (basename profile) (+ 1 number))))
(if (string=? old-prof prof) (if (string=? old-prof prof)
(format (current-error-port) (_ "nothing to be done~%")) (format (current-error-port) (_ "nothing to be done~%"))
(and (build-derivations %store (list prof-drv)) (and (parameterize ((current-build-output-port
(if verbose?
(current-error-port)
(%make-void-port "w"))))
(build-derivations %store (list prof-drv)))
(begin (begin
(symlink prof name) (symlink prof name)
(when (file-exists? profile) (when (file-exists? profile)