From mboxrd@z Thu Jan 1 00:00:00 1970 From: Cyril Roelandt Subject: [PATCH] guix environment: add a '--env-name' option Date: Wed, 24 Jun 2015 23:41:34 +0200 Message-ID: <1435182094-13537-1-git-send-email-tipecaml@gmail.com> Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:37673) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Z7sQV-0001qe-KN for guix-devel@gnu.org; Wed, 24 Jun 2015 17:41:48 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Z7sQQ-0006OV-L8 for guix-devel@gnu.org; Wed, 24 Jun 2015 17:41:47 -0400 Received: from mail-wi0-x22a.google.com ([2a00:1450:400c:c05::22a]:36396) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Z7sQQ-0006OF-DL for guix-devel@gnu.org; Wed, 24 Jun 2015 17:41:42 -0400 Received: by wicnd19 with SMTP id nd19so147114817wic.1 for ; Wed, 24 Jun 2015 14:41:41 -0700 (PDT) List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org To: guix-devel@gnu.org * guix/scripts/environment.scm: add a '--env-name' option. --- guix/scripts/environment.scm | 26 +++++++++++++++++++++++++- 1 file changed, 25 insertions(+), 1 deletion(-) diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 007fde1..1d078ce 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -30,6 +30,7 @@ #:use-module (gnu packages) #:use-module (ice-9 format) #:use-module (ice-9 match) + #:use-module (rnrs io ports) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-37) @@ -106,6 +107,8 @@ shell command in that environment.\n")) --ad-hoc include all specified packages in the environment instead of only their inputs")) (display (_ " + --env-name name of the environment, used in the prompt")) + (display (_ " --pure unset existing environment variables")) (display (_ " --search-paths display needed environment variable definitions")) @@ -124,6 +127,7 @@ shell command in that environment.\n")) `((exec . ,(or (getenv "SHELL") "/bin/sh")) (substitutes? . #t) (max-silent-time . 3600) + (env-name . "guix-env") (verbosity . 0))) (define %options @@ -153,6 +157,9 @@ shell command in that environment.\n")) (option '("ad-hoc") #f #f (lambda (opt name arg result) (alist-cons 'ad-hoc? #t result))) + (option '("env-name") #t #f + (lambda (opt name arg result) + (alist-cons 'env-name arg result))) (option '(#\n "dry-run") #f #f (lambda (opt name arg result) (alist-cons 'dry-run? #t result))) @@ -226,6 +233,20 @@ packages." (built-derivations drvs) (return drvs))))))) +(define (run-shell shell env-name) + "Run the given SHELL, adding '(ENV-NAME) ' at the start of the prompt." + (cond ((string=? shell "/bin/bash") + (let* ((directory (or (getenv "TMPDIR") "/tmp")) + (template (string-append directory "/guix-file.XXXXXX")) + (out (mkstemp! template))) + (format out "export PS1=\"(~a) $PS1\"" env-name) + (flush-output-port out) + (system (string-append "/bin/bash --rcfile " template)))) + (else + (begin + (warning (_ "Unknown shell, will not update the prompt")) + (system shell))))) + ;; Entry point. (define (guix-environment . args) (define (handle-argument arg result) @@ -237,6 +258,7 @@ packages." (pure? (assoc-ref opts 'pure)) (ad-hoc? (assoc-ref opts 'ad-hoc?)) (command (assoc-ref opts 'exec)) + (env-name (assoc-ref opts 'env-name)) (packages (pick-all (options/resolve-packages opts) 'package)) (inputs (if ad-hoc? (packages+propagated-inputs packages) @@ -254,4 +276,6 @@ packages." (show-search-paths inputs drvs pure?)) (else (create-environment inputs drvs pure?) - (system command))))))) + (if (string=? command (assoc-ref %default-options 'exec)) + (run-shell command env-name) + (system command)))))))) -- 1.8.4.rc3