amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Add 'guix shell'.

Browse source 
* guix/scripts/shell.scm, tests/guix-shell.sh: New files.
* Makefile.am (MODULES): Add 'shell.scm'.
(SH_TESTS): Add 'tests/guix-shell.sh'.
* guix/scripts/environment.scm (show-environment-options-help): New
procedure.
(show-help): Use it.
(guix-environment*): New procedure.
(guix-environment): Use it.
* po/guix/POTFILES.in: Add it.
* doc/guix.texi (Features): Refer to "guix shell"
(Invoking guix package): Likewise.
(Development): Likewise.
(Invoking guix shell): New node.
(Invoking guix environment): Add deprecation warning.
(Debugging Build Failures): Use 'guix shell' in examples.
(Invoking guix container): Refer to 'guix shell'.
(Invoking guix processes, Virtualization Services): Adjust examples to
use 'guix shell'.
* doc/contributing.texi (Building from Git): Refer to 'guix shell'.
* etc/completion/bash/guix: Handle "shell".
This commit is contained in:
Ludovic Courtès 2021-10-01 15:19:54 +02:00 • committed by Ludovic Courtès
parent 23f99f1a29
commit 80edb7df65
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
8 changed files with 579 additions and 47 deletions
Download patch file Download diff file Expand all files Collapse all files

135
guix/scripts/shell.scm Normal file
View file

@ -0,0 +1,135 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix scripts shell)
#:use-module (guix ui)
#:use-module (guix scripts environment)
#:autoload (guix scripts build) (show-build-options-help)
#:autoload (guix transformations) (show-transformation-options-help)
#:use-module (guix scripts)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-37)
#:use-module (srfi srfi-71)
#:use-module (ice-9 match)
#:export (guix-shell))
(define (show-help)
(display (G_ "Usage: guix shell [OPTION] PACKAGES... [-- COMMAND...]
Build an environment that includes PACKAGES and execute COMMAND or an
interactive shell in that environment.\n"))
(newline)
;; These two options differ from 'guix environment'.
(display (G_ "
-D, --development include the development inputs of the next package"))
(display (G_ "
-f, --file=FILE create environment for the package that the code within
FILE evaluates to"))
(show-environment-options-help)
(newline)
(show-build-options-help)
(newline)
(show-transformation-options-help)
(newline)
(display (G_ "
-h, --help display this help and exit"))
(display (G_ "
-V, --version display version information and exit"))
(newline)
(show-bug-report-information))
(define (tag-package-arg opts arg)
"Return a two-element list with the form (TAG ARG) that tags ARG with either
'ad-hoc' in OPTS has the 'ad-hoc?' key set to #t, or 'inputs' otherwise."
(if (assoc-ref opts 'ad-hoc?)
`(ad-hoc-package ,arg)
`(package ,arg)))
(define (ensure-ad-hoc alist)
(if (assq-ref alist 'ad-hoc?)
alist
`((ad-hoc? . #t) ,@alist)))
(define (wrapped-option opt)
"Wrap OPT, a SRFI-37 option, such that its processor always adds the
'ad-hoc?' flag to the resulting alist."
(option (option-names opt)
(option-required-arg? opt)
(option-optional-arg? opt)
(compose ensure-ad-hoc (option-processor opt))))
(define %options
;; Specification of the command-line options.
(let ((to-remove '("ad-hoc" "inherit" "load" "help" "version")))
(append
(list (option '(#\h "help") #f #f
(lambda args
(show-help)
(exit 0)))
(option '(#\V "version") #f #f
(lambda args
(show-version-and-exit "guix shell")))
(option '(#\D "development") #f #f
(lambda (opt name arg result)
;; Temporarily remove the 'ad-hoc?' flag from result.
;; The next option will put it back thanks to
;; 'wrapped-option'.
(alist-delete 'ad-hoc? result)))
;; For consistency with 'guix package', support '-f' rather than
;; '-l' like 'guix environment' does.
(option '(#\f "file") #t #f
(lambda (opt name arg result)
(alist-cons 'load (tag-package-arg result arg)
result))))
(filter-map (lambda (opt)
(and (not (any (lambda (name)
(member name to-remove))
(option-names opt)))
(wrapped-option opt)))
%environment-options))))
(define %default-options
`((ad-hoc? . #t) ;always true
,@%environment-default-options))
(define (parse-args args)
"Parse the list of command line arguments ARGS."
(define (handle-argument arg result)
(alist-cons 'package (tag-package-arg result arg)
(ensure-ad-hoc result)))
;; The '--' token is used to separate the command to run from the rest of
;; the operands.
(let ((args command (break (cut string=? "--" <>) args)))
(let ((opts (parse-command-line args %options (list %default-options)
#:argument-handler handle-argument)))
(match command
(() opts)
(("--") opts)
(("--" command ...) (alist-cons 'exec command opts))))))
(define-command (guix-shell . args)
(category development)
(synopsis "spawn one-off software environments")
(guix-environment* (parse-args args)))