diff --git a/lisp/env.el b/lisp/env.el index 378b7f078be..7099a72ca2c 100644 --- a/lisp/env.el +++ b/lisp/env.el @@ -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 @@ If it is also not t, RET does not exit if it does non-null completion." 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 @@ Use `$$' to insert a single dollar sign." 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 @@ Interactively, the current value (if any) of the variable 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 @@ a side-effect." (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 @@ 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'." +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 @@ Otherwise, the value of VAR will come from `process-environment'." (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 diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 45feee19744..49e576e59db 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -1996,7 +1996,7 @@ This function could be MATCHER in a MATCH-ANCHORED `font-lock-keywords' item." `(;; 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" diff --git a/src/callproc.c b/src/callproc.c index a8735d51c9b..c13b653775f 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -113,6 +113,7 @@ Lisp_Object Vtemp_file_name_pattern; Lisp_Object Vshell_file_name; +Lisp_Object Vglobal_environment; Lisp_Object Vprocess_environment; #ifdef DOS_NT @@ -1165,6 +1166,40 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r 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 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir) 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 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir) 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)) - { - 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: ; - } + new_env = add_env (env, new_env, SDATA (XCAR (tem))); + *new_env = 0; + + /* Remove variable names without values. */ + p = q = env; + while (*p != 0) + { + while (*q != 0 && strchr (*q, '=') == NULL) + *q++; + *p = *q++; + if (*p != 0) + p++; + } } #ifdef WINDOWSNT prepare_standard_handles (in, out, err, handles); @@ -1488,13 +1496,42 @@ getenv_internal (var, varlen, value, valuelen, terminal) 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 @@ getenv_internal (var, varlen, value, valuelen, terminal) } 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 @@ init_callproc () } 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,15 +1835,47 @@ If this variable is nil, then Emacs is unable to use a shared directory. */); 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 @@ -1818,15 +1887,15 @@ See `setenv' and `getenv'. */); 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"); diff --git a/src/emacs.c b/src/emacs.c index 28b5f374ccd..142da86df95 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1515,10 +1515,10 @@ main (argc, argv /* 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"); diff --git a/src/fileio.c b/src/fileio.c index 4e9ac9541c3..add62fe5426 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -6335,7 +6335,7 @@ and `read-file-name-function'. */) /* 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) {