unofficial mirror of guix-devel@gnu.org 
 help / color / mirror / code / Atom feed
* [PATCH] guix environment: add a '--env-name' option
@ 2015-06-24 21:41 Cyril Roelandt
  2015-06-25 11:45 ` guix environment & PS1 Ludovic Courtès
  0 siblings, 1 reply; 13+ messages in thread
From: Cyril Roelandt @ 2015-06-24 21:41 UTC (permalink / raw)
  To: guix-devel

* 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

^ permalink raw reply related	[flat|nested] 13+ messages in thread

end of thread, other threads:[~2015-07-01 17:07 UTC | newest]

Thread overview: 13+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2015-06-24 21:41 [PATCH] guix environment: add a '--env-name' option Cyril Roelandt
2015-06-25 11:45 ` guix environment & PS1 Ludovic Courtès
2015-06-25 12:02   ` Ricardo Wurmus
2015-06-25 13:04     ` Thompson, David
2015-06-25 13:28       ` Ricardo Wurmus
2015-06-25 20:00         ` Claes Wallin (韋嘉誠)
2015-06-25 20:40           ` Claes Wallin (韋嘉誠)
2015-06-29  8:41           ` Ludovic Courtès
2015-06-29 10:04             ` Claes Wallin (韋嘉誠)
2015-06-25 13:02   ` Thompson, David
2015-07-01 13:10     ` Ludovic Courtès
2015-07-01 13:59       ` Thompson, David
2015-07-01 17:07         ` Claes Wallin (韋嘉誠)

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).