Mercurial > emacs

--- a/lisp/env.el	Thu Dec 29 01:18:49 2005 +0000
+++ b/lisp/env.el	Thu Dec 29 01:28:33 2005 +0000
@@ -36,6 +36,8 @@

 ;;; Code:

+(eval-when-compile (require 'cl))
+
 ;; History list for environment variable names.
 (defvar read-envvar-name-history nil)

@@ -52,8 +54,9 @@
 					locale-coding-system t)
 				     (substring enventry 0
 						(string-match "=" enventry)))))
-			   (append (terminal-parameter nil 'environment)
-				   process-environment))
+			   (append process-environment
+				   (terminal-parameter nil 'environment)
+				   global-environment))
 		   nil mustmatch nil 'read-envvar-name-history))

 ;; History list for VALUE argument to setenv.
@@ -89,7 +92,7 @@
 		   start (+ (match-beginning 0) 1)))))
     string))

-;; Fixme: Should `process-environment' be recoded if LC_CTYPE &c is set?
+;; Fixme: Should the environment be recoded if LC_CTYPE &c is set?

 (defun setenv (variable &optional value unset substitute-env-vars terminal)
   "Set the value of the environment variable named VARIABLE to VALUE.
@@ -106,15 +109,16 @@
 appears at the front of the history list when you type in the new value.
 Interactively, always replace environment variables in the new value.

+If VARIABLE is set in `process-environment', then this function
+modifies its value there.  Otherwise, this function works by
+modifying either `global-environment' or the environment
+belonging to the terminal device of the selected frame, depending
+on the value of `local-environment-variables'.
+
 If optional parameter TERMINAL is non-nil, then it should be a
 terminal id or a frame.  If the specified terminal device has its own
 set of environment variables, this function will modify VAR in it.

-Otherwise, this function works by modifying either
-`process-environment' or the environment belonging to the
-terminal device of the selected frame, depending on the value of
-`local-environment-variables'.
-
 As a special case, setting variable `TZ' calls `set-time-zone-rule' as
 a side-effect."
   (interactive
@@ -147,41 +151,55 @@
       (setq value (encode-coding-string value locale-coding-system)))
   (if (string-match "=" variable)
       (error "Environment variable name `%s' contains `='" variable))
-  (let* ((pattern (concat "\\`" (regexp-quote (concat variable "="))))
-	 (case-fold-search nil)
-	 (local-var-p (and (terminal-parameter terminal 'environment)
-			   (or terminal
-			       (eq t local-environment-variables)
-			       (member variable local-environment-variables))))
-	 (scan (if local-var-p
-		   (terminal-parameter terminal 'environment)
-		 process-environment))
-	 found)
+  (let ((pattern (concat "\\`" (regexp-quote variable) "\\(=\\|\\'\\)"))
+	(case-fold-search nil)
+	(terminal-env (terminal-parameter terminal 'environment))
+	(scan process-environment)
+	found)
     (if (string-equal "TZ" variable)
 	(set-time-zone-rule value))
-    (while scan
-      (cond ((string-match pattern (car scan))
-	     (setq found t)
-	     (if (eq nil value)
-		 (if local-var-p
-		     (set-terminal-parameter terminal 'environment
-					     (delq (car scan)
-						   (terminal-parameter terminal 'environment)))
-		   (setq process-environment (delq (car scan)
-						   process-environment)))
-	       (setcar scan (concat variable "=" value)))
-	     (setq scan nil)))
-      (setq scan (cdr scan)))
-    (or found
+    (block nil
+      ;; Look for an existing entry for VARIABLE; try `process-environment' first.
+      (while (and scan (stringp (car scan)))
+	(when (string-match pattern (car scan))
+	  (if value
+	      (setcar scan (concat variable "=" value))
+	    ;; Leave unset variables in `process-environment',
+	    ;; otherwise the overridden value in `global-environment'
+	    ;; or terminal-env would become unmasked.
+	    (setcar scan variable))
+	  (return value))
+	(setq scan (cdr scan)))
+
+      ;; Look in the local or global environment, whichever is relevant.
+      (let ((local-var-p (and terminal-env
+			      (or terminal
+				  (eq t local-environment-variables)
+				  (member variable local-environment-variables)))))
+	(setq scan (if local-var-p
+		       terminal-env
+		     global-environment))
+	(while scan
+	  (when (string-match pattern (car scan))
+	    (if value
+		(setcar scan (concat variable "=" value))
+	      (if local-var-p
+		  (set-terminal-parameter terminal 'environment
+					  (delq (car scan) terminal-env))
+		(setq global-environment (delq (car scan) global-environment)))
+	      (return value)))
+	  (setq scan (cdr scan)))
+
+	;; VARIABLE is not in any environment list.
 	(if value
 	    (if local-var-p
 		(set-terminal-parameter nil 'environment
 					(cons (concat variable "=" value)
-					      (terminal-parameter nil 'environment)))
-	      (setq process-environment
+					      terminal-env))
+	      (setq global-environment
 		    (cons (concat variable "=" value)
-			  process-environment))))))
-  value)
+			  global-environment))))
+	(return value)))))

 (defun getenv (variable &optional terminal)
   "Get the value of environment variable VARIABLE.
@@ -190,14 +208,14 @@

 If optional parameter TERMINAL is non-nil, then it should be a
 terminal id or a frame.  If the specified terminal device has its own
-set of environment variables, this function will look up VAR in it.
+set of environment variables, this function will look up VARIABLE in
+it.

-Otherwise, if `local-environment-variables' specifies that VAR is a
-local environment variable, then this function consults the
-environment variables belonging to the terminal device of the selected
-frame.
-
-Otherwise, the value of VAR will come from `process-environment'."
+Otherwise, this function searches `process-environment' for VARIABLE.
+If it was not found there, then it continues the search in either
+`global-environment' or the local environment list of the current
+terminal device, depending on the value of
+`local-environment-variables'."
   (interactive (list (read-envvar-name "Get environment variable: " t)))
   (let ((value (getenv-internal (if (multibyte-string-p variable)
 				    (encode-coding-string
@@ -209,6 +227,93 @@
       (message "%s" (if value value "Not set")))
     value))

+(defun environment ()
+  "Return a list of environment variables with their values.
+Each entry in the list is a string of the form NAME=VALUE.
+
+The returned list can not be used to change environment
+variables, only read them.  See `setenv' to do that.
+
+The list is constructed from elements of `process-environment',
+`global-environment' and the local environment list of the
+current terminal, as specified by `local-environment-variables'.
+
+Non-ASCII characters are encoded according to the initial value of
+`locale-coding-system', i.e. the elements must normally be decoded for use.
+See `setenv' and `getenv'."
+  (let ((env (cond ((or (not local-environment-variables)
+			(not (terminal-parameter nil 'environment)))
+		    (append process-environment global-environment nil))
+		   ((consp local-environment-variables)
+		    (let ((e (reverse process-environment)))
+		      (dolist (entry local-environment-variables)
+			(setq e (cons (getenv entry) e)))
+		      (append (nreverse e) global-environment nil)))
+		   (t
+		    (append process-environment (terminal-parameter nil 'environment) nil))))
+	scan seen)
+    ;; Find the first valid entry in env.
+    (while (and env (stringp (car env))
+		(or (not (string-match "=" (car env)))
+		    (member (substring (car env) 0 (string-match "=" (car env))) seen)))
+      (setq seen (cons (car env) seen)
+	    env (cdr env)))
+    (setq scan env)
+    (while (and (cdr scan) (stringp (cadr scan)))
+      (let* ((match (string-match "=" (cadr scan)))
+	     (name (substring (cadr scan) 0 match)))
+	(cond ((not match)
+	       ;; Unset variable.
+	       (setq seen (cons name seen))
+	       (setcdr scan (cddr scan)))
+	      ((member name seen)
+	       ;; Duplicate variable.
+	       (setcdr scan (cddr scan)))
+	      (t
+	       ;; New variable.
+	       (setq seen (cons name seen)
+		     scan (cdr scan))))))
+    env))
+
+(defmacro let-environment (varlist &rest body)
+  "Evaluate BODY with environment variables set according to VARLIST.
+The environment variables are then restored to their previous
+values.
+The value of the last form in BODY is returned.
+
+Each element of VARLIST is either a string (which variable is
+then removed from the environment), or a list (NAME
+VALUEFORM) (which sets NAME to the value of VALUEFORM, a string).
+All the VALUEFORMs are evaluated before any variables are set."
+  (declare (indent 2))
+  (let ((old-env (make-symbol "old-env"))
+	(name (make-symbol "name"))
+	(value (make-symbol "value"))
+	(entry (make-symbol "entry"))
+	(frame (make-symbol "frame")))
+    `(let ((,frame (selected-frame))
+	    ,old-env)
+       ;; Evaluate VALUEFORMs and replace them in VARLIST with their values.
+       (dolist (,entry ,varlist)
+	 (unless (stringp ,entry)
+	   (if (cdr (cdr ,entry))
+	       (error "`let-environment' bindings can have only one value-form"))
+	   (setcdr ,entry (eval (cadr ,entry)))))
+       ;; Set the variables.
+       (dolist (,entry ,varlist)
+	 (let ((,name (if (stringp ,entry) ,entry (car ,entry)))
+	       (,value (if (consp ,entry) (cdr ,entry))))
+	   (setq ,old-env (cons (cons ,name (getenv ,name)) ,old-env))
+	   (setenv ,name ,value)))
+       (unwind-protect
+	   (progn ,@body)
+	 ;; Restore old values.
+	 (with-selected-frame (if (frame-live-p ,frame)
+				  ,frame
+				(selected-frame))
+	   (dolist (,entry ,old-env)
+	     (setenv (car ,entry) (cdr ,entry))))))))
+
 (provide 'env)

 ;;; arch-tag: b7d6a8f7-bc81-46db-8e39-8d721d4ed0b8
--- a/lisp/font-lock.el	Thu Dec 29 01:18:49 2005 +0000
+++ b/lisp/font-lock.el	Thu Dec 29 01:28:33 2005 +0000
@@ -1996,7 +1996,7 @@
      `(;; Control structures.  Emacs Lisp forms.
        (,(concat
 	  "(" (regexp-opt
-	       '("cond" "if" "while" "while-no-input" "let" "let*"
+	       '("cond" "if" "while" "while-no-input" "let" "let*" "let-environment"
 		 "prog" "progn" "progv" "prog1" "prog2" "prog*"
 		 "inline" "lambda" "save-restriction" "save-excursion"
 		 "save-window-excursion" "save-selected-window"
--- a/src/callproc.c	Thu Dec 29 01:18:49 2005 +0000
+++ b/src/callproc.c	Thu Dec 29 01:28:33 2005 +0000
@@ -113,6 +113,7 @@

 Lisp_Object Vshell_file_name;

+Lisp_Object Vglobal_environment;
 Lisp_Object Vprocess_environment;

 #ifdef DOS_NT
@@ -1165,6 +1166,40 @@

 static int relocate_fd ();

+static char **
+add_env (char **env, char **new_env, char *string)
+{
+  char **ep;
+  int ok = 1;
+  if (string == NULL)
+    return new_env;
+
+  /* See if this string duplicates any string already in the env.
+     If so, don't put it in.
+     When an env var has multiple definitions,
+     we keep the definition that comes first in process-environment.  */
+  for (ep = env; ok && ep != new_env; ep++)
+    {
+      char *p = *ep, *q = string;
+      while (ok)
+        {
+          if (*q != *p)
+            break;
+          if (*q == 0)
+            /* The string is a lone variable name; keep it for now, we
+               will remove it later.  It is a placeholder for a
+               variable that is not to be included in the environment.  */
+            break;
+          if (*q == '=')
+            ok = 0;
+          p++, q++;
+        }
+    }
+  if (ok)
+    *new_env++ = string;
+  return new_env;
+}
+
 /* This is the last thing run in a newly forked inferior
    either synchronous or asynchronous.
    Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
@@ -1266,16 +1301,22 @@
       temp[--i] = 0;
   }

-  /* Set `env' to a vector of the strings in Vprocess_environment.  */
+  /* Set `env' to a vector of the strings in the environment.  */
   {
     register Lisp_Object tem;
     register char **new_env;
+    char **p, **q;
     register int new_length;
-    Lisp_Object environment = Vprocess_environment;
+    Lisp_Object environment = Vglobal_environment;
     Lisp_Object local;

     new_length = 0;

+    for (tem = Vprocess_environment;
+         CONSP (tem) && STRINGP (XCAR (tem));
+         tem = XCDR (tem))
+      new_length++;
+
     if (!NILP (Vlocal_environment_variables))
       {
         local = get_terminal_param (FRAME_DEVICE (XFRAME (selected_frame)),
@@ -1301,71 +1342,38 @@
        but with corrected value.  */
     if (getenv ("PWD"))
       *new_env++ = pwd_var;
+
+    /* Overrides.  */
+    for (tem = Vprocess_environment;
+	 CONSP (tem) && STRINGP (XCAR (tem));
+	 tem = XCDR (tem))
+      new_env = add_env (env, new_env, SDATA (XCAR (tem)));

-    /* Get the local environment variables first. */
+    /* Local part of environment, if Vlocal_environment_variables is a list.  */
     for (tem = Vlocal_environment_variables;
          CONSP (tem) && STRINGP (XCAR (tem));
          tem = XCDR (tem))
-      {
-        char **ep = env;
-        char *string = egetenv (SDATA (XCAR (tem)));
-        int ok = 1;
-        if (string == NULL)
-          continue;
+      new_env = add_env (env, new_env, egetenv (SDATA (XCAR (tem))));

-	/* See if this string duplicates any string already in the env.
-	   If so, don't put it in.
-	   When an env var has multiple definitions,
-	   we keep the definition that comes first in process-environment.  */
-        for (; ep != new_env; ep++)
-          {
-	    char *p = *ep, *q = string;
-	    while (ok)
-	      {
-		if (*q == 0)
-                  /* The string is malformed; might as well drop it.  */
-                  ok = 0;
-		if (*q != *p)
-		  break;
-		if (*q == '=')
-                  ok = 0;
-		p++, q++;
-	      }
-          }
-        if (ok)
-          *new_env++ = string;
-      }
-
-    /* Copy the environment strings into new_env.  */
+    /* The rest of the environment (either Vglobal_environment or the
+       'environment terminal parameter).  */
     for (tem = environment;
 	 CONSP (tem) && STRINGP (XCAR (tem));
 	 tem = XCDR (tem))
+      new_env = add_env (env, new_env, SDATA (XCAR (tem)));
+
+    *new_env = 0;
+
+    /* Remove variable names without values.  */
+    p = q = env;
+    while (*p != 0)
       {
-	char **ep = env;
-	char *string = (char *) SDATA (XCAR (tem));
-	/* See if this string duplicates any string already in the env.
-	   If so, don't put it in.
-	   When an env var has multiple definitions,
-	   we keep the definition that comes first in process-environment.  */
-	for (; ep != new_env; ep++)
-	  {
-	    char *p = *ep, *q = string;
-	    while (1)
-	      {
-		if (*q == 0)
-		  /* The string is malformed; might as well drop it.  */
-		  goto duplicate;
-		if (*q != *p)
-		  break;
-		if (*q == '=')
-		  goto duplicate;
-		p++, q++;
-	      }
-	  }
-	*new_env++ = string;
-      duplicate: ;
+        while (*q != 0 && strchr (*q, '=') == NULL)
+          *q++;
+        *p = *q++;
+        if (*p != 0)
+          p++;
       }
-    *new_env = 0;
   }
 #ifdef WINDOWSNT
   prepare_standard_handles (in, out, err, handles);
@@ -1488,13 +1496,42 @@
      Lisp_Object terminal;
 {
   Lisp_Object scan;
-  Lisp_Object environment = Vprocess_environment;
+  Lisp_Object environment = Vglobal_environment;
+
+  /* Try to find VAR in Vprocess_environment first.  */
+  for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan))
+    {
+      Lisp_Object entry = XCAR (scan);
+      if (STRINGP (entry)
+          && SBYTES (entry) >= varlen
+#ifdef WINDOWSNT
+          /* NT environment variables are case insensitive.  */
+          && ! strnicmp (SDATA (entry), var, varlen)
+#else  /* not WINDOWSNT */
+          && ! bcmp (SDATA (entry), var, varlen)
+#endif /* not WINDOWSNT */
+          )
+        {
+          if (SBYTES (entry) > varlen && SREF (entry, varlen) == '=')
+            {
+              *value = (char *) SDATA (entry) + (varlen + 1);
+              *valuelen = SBYTES (entry) - (varlen + 1);
+              return 1;
+            }
+          else if (SBYTES (entry) == varlen)
+            {
+              /* Lone variable names in Vprocess_environment mean that
+                 variable should be removed from the environment. */
+              return 0;
+            }
+        }
+    }

   /* Find the environment in which to search the variable. */
   if (!NILP (terminal))
     {
       Lisp_Object local = get_terminal_param (get_device (terminal, 1), Qenvironment);
-      /* Use Vprocess_environment if there is no local environment.  */
+      /* Use Vglobal_environment if there is no local environment.  */
       if (!NILP (local))
         environment = local;
     }
@@ -1553,36 +1590,36 @@
 }

 DEFUN ("getenv-internal", Fgetenv_internal, Sgetenv_internal, 1, 2, 0,
-       doc: /* Return the value of environment variable VAR, as a string.
-VAR should be a string.  Value is nil if VAR is undefined in the
-environment.
+       doc: /* Get the value of environment variable VARIABLE.
+VARIABLE should be a string.  Value is nil if VARIABLE is undefined in
+the environment.  Otherwise, value is a string.

 If optional parameter TERMINAL is non-nil, then it should be a
 terminal id or a frame.  If the specified terminal device has its own
-set of environment variables, this function will look up VAR in it.
+set of environment variables, this function will look up VARIABLE in
+it.

-Otherwise, if `local-environment-variables' specifies that VAR is a
-local environment variable, then this function consults the
-environment variables belonging to the terminal device of the selected
-frame.
-
-Otherwise, the value of VAR will come from `process-environment'.  */)
-     (var, terminal)
-     Lisp_Object var, terminal;
+Otherwise, this function searches `process-environment' for VARIABLE.
+If it was not found there, then it continues the search in either
+`global-environment' or the local environment list of the current
+terminal device, depending on the value of
+`local-environment-variables'.  */)
+     (variable, terminal)
+     Lisp_Object variable, terminal;
 {
   char *value;
   int valuelen;

-  CHECK_STRING (var);
-  if (getenv_internal (SDATA (var), SBYTES (var),
+  CHECK_STRING (variable);
+  if (getenv_internal (SDATA (variable), SBYTES (variable),
 		       &value, &valuelen, terminal))
     return make_string (value, valuelen);
   else
     return Qnil;
 }

-/* A version of getenv that consults process_environment, easily
-   callable from C.  */
+/* A version of getenv that consults the Lisp environment lists,
+   easily callable from C.  */
 char *
 egetenv (var)
      char *var;
@@ -1730,17 +1767,17 @@
 }

 void
-set_process_environment ()
+set_global_environment ()
 {
   register char **envp;

-  Vprocess_environment = Qnil;
+  Vglobal_environment = Qnil;
 #ifndef CANNOT_DUMP
   if (initialized)
 #endif
     for (envp = environ; *envp; envp++)
-      Vprocess_environment = Fcons (build_string (*envp),
-				    Vprocess_environment);
+      Vglobal_environment = Fcons (build_string (*envp),
+				    Vglobal_environment);
 }

 void
@@ -1798,17 +1835,49 @@
 This is used by `call-process-region'.  */);
   /* This variable is initialized in init_callproc.  */

-  DEFVAR_LISP ("process-environment", &Vprocess_environment,
-	       doc: /* List of environment variables for subprocesses to inherit.
+  DEFVAR_LISP ("global-environment", &Vglobal_environment,
+	       doc: /* Global list of environment variables for subprocesses to inherit.
 Each element should be a string of the form ENVVARNAME=VALUE.
+
+The environment which Emacs inherits is placed in this variable when
+Emacs starts.
+
+Some terminal devices may have their own local list of environment
+variables in their 'environment parameter, which may override this
+global list; see `local-environment-variables'.  See
+`process-environment' for a way to modify an environment variable on
+all terminals.
+
 If multiple entries define the same variable, the first one always
 takes precedence.
-The environment which Emacs inherits is placed in this variable
-when Emacs starts.
+
 Non-ASCII characters are encoded according to the initial value of
 `locale-coding-system', i.e. the elements must normally be decoded for use.
 See `setenv' and `getenv'.  */);

+  DEFVAR_LISP ("process-environment", &Vprocess_environment,
+	       doc: /* List of overridden environment variables for subprocesses to inherit.
+Each element should be a string of the form ENVVARNAME=VALUE.
+
+Entries in this list take precedence to those in `global-environment'
+or the terminal environment.  (See `local-environment-variables' for
+an explanation of the terminal-local environment.)  Therefore,
+let-binding `process-environment' is an easy way to temporarily change
+the value of an environment variable, irrespective of where it comes
+from.  To use `process-environment' to remove an environment variable,
+include only its name in the list, without "=VALUE".
+
+This variable is set to nil when Emacs starts.
+
+If multiple entries define the same variable, the first one always
+takes precedence.
+
+Non-ASCII characters are encoded according to the initial value of
+`locale-coding-system', i.e. the elements must normally be decoded for
+use.
+
+See `setenv' and `getenv'.  */);
+
 #ifndef VMS
   defsubr (&Scall_process);
   defsubr (&Sgetenv_internal);
@@ -1818,15 +1887,15 @@
   DEFVAR_LISP ("local-environment-variables", &Vlocal_environment_variables,
                doc: /* 	Enable or disable terminal-local environment variables.
 If set to t, `getenv', `setenv' and subprocess creation functions use
-the environment variables of the emacsclient process that created the
-selected frame, ignoring `process-environment'.
+the local environment of the terminal device of the selected frame,
+ignoring `global-environment'.

-If set to nil, Emacs uses `process-environment' and ignores the client
-environment.
+If set to nil, Emacs uses `global-environment' and ignores the
+terminal environment.

-Otherwise, `terminal-local-environment-variables' should be a list of
-variable names (represented by Lisp strings) to look up in the client
-environment.  The rest will come from `process-environment'.  */);
+Otherwise, `local-environment-variables' should be a list of variable
+names (represented by Lisp strings) to look up in the terminal's
+environment.  The rest will come from `global-environment'.  */);
   Vlocal_environment_variables = Qnil;

   Qenvironment = intern ("environment");
--- a/src/emacs.c	Thu Dec 29 01:18:49 2005 +0000
+++ b/src/emacs.c	Thu Dec 29 01:28:33 2005 +0000
@@ -1515,10 +1515,10 @@
   /* egetenv is a pretty low-level facility, which may get called in
      many circumstances; it seems flimsy to put off initializing it
      until calling init_callproc.  */
-  set_process_environment ();
+  set_global_environment ();
   /* AIX crashes are reported in system versions 3.2.3 and 3.2.4
-     if this is not done.  Do it after set_process_environment so that we
-     don't pollute Vprocess_environment.  */
+     if this is not done.  Do it after set_global_environment so that we
+     don't pollute Vglobal_environment.  */
   /* Setting LANG here will defeat the startup locale processing...  */
 #ifdef AIX3_2
   putenv ("LANG=C");
--- a/src/fileio.c	Thu Dec 29 01:18:49 2005 +0000
+++ b/src/fileio.c	Thu Dec 29 01:28:33 2005 +0000
@@ -6335,7 +6335,7 @@
   /* If dir starts with user's homedir, change that to ~. */
   homedir = (char *) egetenv ("HOME");
 #ifdef DOS_NT
-  /* homedir can be NULL in temacs, since Vprocess_environment is not
+  /* homedir can be NULL in temacs, since Vglobal_environment is not
      yet set up.  We shouldn't crash in that case.  */
   if (homedir != 0)
     {