[armedbear-cvs] r13899 - trunk/abcl/src/org/armedbear/lisp

[vvoutilainen at common-lisp.net]

Author: vvoutilainen
Date: Sat Mar 31 05:50:25 2012
New Revision: 13899

Log:
Add :clear-env to run-program, add getenv-all

Modified:
   trunk/abcl/src/org/armedbear/lisp/Extensions.java
   trunk/abcl/src/org/armedbear/lisp/run-program.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/Extensions.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Extensions.java	Wed Mar 28 14:36:39 2012	(r13898)
+++ trunk/abcl/src/org/armedbear/lisp/Extensions.java	Sat Mar 31 05:50:25 2012	(r13899)
@@ -37,6 +37,7 @@
 
 import java.io.File;
 import java.io.IOException;
+import java.util.*;
 
 public final class Extensions
 {
@@ -317,4 +318,28 @@
         return NIL;
     }
   }
+
+  // ### getenv-all variable => string
+  private static final Primitive GETENV_ALL = new getenv_all();
+  private static class getenv_all extends Primitive 
+  {
+    getenv_all() 
+    {
+      super("getenv-all", PACKAGE_EXT, true, "variable",
+             "Returns all environment variables as an alist containing (name . value)");
+    }
+    @Override
+    public LispObject execute()
+    {
+      Cons result = new Cons(NIL);
+      Map<String, String> env = System.getenv();
+      for (Map.Entry<String, String> entry : env.entrySet()) {
+          Cons entryPair = new Cons(new SimpleString(entry.getKey()), 
+                                    new SimpleString(entry.getValue()));
+          result = new Cons(entryPair, result);
+      }
+      return result;
+    }
+  }
+
 }

Modified: trunk/abcl/src/org/armedbear/lisp/run-program.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/run-program.lisp	Wed Mar 28 14:36:39 2012	(r13898)
+++ trunk/abcl/src/org/armedbear/lisp/run-program.lisp	Sat Mar 31 05:50:25 2012	(r13899)
@@ -40,11 +40,13 @@
 ;;; This implementation uses the JVM facilities for running external
 ;;; processes.
 ;;; <http://download.oracle.com/javase/6/docs/api/java/lang/ProcessBuilder.html>.
-(defun run-program (program args &key environment (wait t))
+(defun run-program (program args &key environment (wait t) clear-env)
   ;;For documentation, see below.
   (let ((pb (%make-process-builder program args)))
-    (when environment
-      (let ((env-map (%process-builder-environment pb)))
+    (let ((env-map (%process-builder-environment pb)))
+      (when clear-env
+        (%process-builder-env-clear env-map))            
+      (when environment
         (dolist (entry environment)
           (%process-builder-env-put env-map
                                     (princ-to-string (car entry))
@@ -80,9 +82,12 @@
 The &key arguments have the following meanings:
 
 :environment 
-    An alist of STRINGs (name . value) describing the new
-    environment. The default is to copy the environment of the current
-    process.
+    An alist of STRINGs (name . value) describing new
+    environment values that replace existing ones.
+
+:clear-env
+    If non-NIL, the current environment is cleared before the
+    values supplied by :environment are inserted.
 
 :wait 
     If non-NIL, which is the default, wait until the created process
@@ -131,6 +136,9 @@
 (defun %process-builder-env-put (env-map key value)
   (java:jcall "put" env-map key value))
 
+(defun %process-builder-env-clear (env-map)
+  (java:jcall "clear" env-map))
+
 (defun %process-builder-start (pb)
   (java:jcall "start" pb))