Commit da8e8fc1 authored by Karoly Lorentey's avatar Karoly Lorentey

Store local environment in frame (not terminal) parameters.

* src/callproc.c (child_setup, getenv_internal, Fgetenv_internal):
  Store the local environment in a frame (not terminal) parameter.
  Update doc strings.
  (syms_of_callproc): Update doc strings.
  (Qenvironment): Moved to frame.c. 

* lisp/env.el (read-envvar-name, setenv, getenv, environment): Use frame
  parameters to store the local environment, not terminal parameters.

* server.el (server-process-filter): Store the local environment in a
  frame (not terminal) parameter.  Do not try to decode environment
  strings.

* lisp/frame.el (make-frame): Set up the 'environment frame parameter,
  when needed.

* src/frame.c (Qenvironment): Move here from callproc.c.
  (Fdelete_frame): Don't allow other frames to refer to a deleted frame
  in their 'environment parameter.
  (Fframe_with_environment): New function.
  (syms_of_frame): Defsubr it.  Initialize and staticpro Qenvironment.

* frame.h (Qenvironment): Declare.
* lisp.h (Fframe_with_environment): EXFUN it.

git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-467
parent 86f5ca04
......@@ -412,7 +412,10 @@ THINGS TO DO
make_terminal_frame
create_tty_output
** Decide whether to keep the C implementation of terminal parameters,
or revert to the previous, purely Lisp code. It turned out that
local environments do not need terminal parameters after all.
** Move Fsend_string_to_terminal to term.c, and declare get_named_tty
as static, removing it from dispextern.h.
......@@ -1362,5 +1365,16 @@ DIARY OF CHANGES
`getenv' and `setenv', and the new `local-environment-variables'
facility. Yay!)
(Updated in patch-465 to fix the semantics of let-binding
`process-environment'. `process-environment' was changed to
override all local/global environment variables, and a new variable
`global-environment' was introduced to have `process-environment's
old meaning.)
(Updated in patch-466 to fix the case when two emacsclient sessions
share the same terminal, but have different environment. The local
environment lists are now stored as frame parameters, so the
C-level terminal parameters are not strictly necessary any more.)
;;; arch-tag: 8da1619e-2e79-41a8-9ac9-a0485daad17d
......@@ -55,7 +55,7 @@ If it is also not t, RET does not exit if it does non-null completion."
(substring enventry 0
(string-match "=" enventry)))))
(append process-environment
(terminal-parameter nil 'environment)
(frame-parameter (frame-with-environment) 'environment)
global-environment))
nil mustmatch nil 'read-envvar-name-history))
......@@ -94,7 +94,7 @@ Use `$$' to insert a single dollar sign."
;; Fixme: Should the environment be recoded if LC_CTYPE &c is set?
(defun setenv (variable &optional value unset substitute-env-vars terminal)
(defun setenv (variable &optional value unset substitute-env-vars frame)
"Set the value of the environment variable named VARIABLE to VALUE.
VARIABLE should be a string. VALUE is optional; if not provided or
nil, the environment variable VARIABLE will be removed. UNSET
......@@ -112,12 +112,15 @@ 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'.
belonging to 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.
If optional parameter FRAME is non-nil, then it should be a a
frame. If the specified frame has its own set of environment
variables, this function will modify VARIABLE in it. Note that
frames on the same terminal device usually share their
environment, so calling `setenv' on one of them affects the
others as well.
As a special case, setting variable `TZ' calls `set-time-zone-rule' as
a side-effect."
......@@ -153,9 +156,11 @@ a side-effect."
(error "Environment variable name `%s' contains `='" variable))
(let ((pattern (concat "\\`" (regexp-quote variable) "\\(=\\|\\'\\)"))
(case-fold-search nil)
(terminal-env (terminal-parameter terminal 'environment))
(frame-env (frame-parameter (frame-with-environment frame) 'environment))
(frame-forced (not frame))
(scan process-environment)
found)
(setq frame (frame-with-environment frame))
(if (string-equal "TZ" variable)
(set-time-zone-rule value))
(block nil
......@@ -166,55 +171,54 @@ a side-effect."
(setcar scan (concat variable "=" value))
;; Leave unset variables in `process-environment',
;; otherwise the overridden value in `global-environment'
;; or terminal-env would become unmasked.
;; or frame-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
(let ((local-var-p (and frame-env
(or frame-forced
(eq t local-environment-variables)
(member variable local-environment-variables)))))
(setq scan (if local-var-p
terminal-env
frame-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)))
(set-frame-parameter frame 'environment
(delq (car scan) frame-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-env))
(set-frame-parameter frame 'environment
(cons (concat variable "=" value)
frame-env))
(setq global-environment
(cons (concat variable "=" value)
global-environment))))
(return value)))))
(defun getenv (variable &optional terminal)
(defun getenv (variable &optional frame)
"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 VARIABLE in
it.
If optional parameter FRAME is non-nil, then it should be a
frame. If the specified terminal device has its own set of
environment variables, this function will look up VARIABLE in it.
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
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 environment list of
the selected frame, 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)
......@@ -236,21 +240,23 @@ 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'.
selected frame, 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))))
(let ((env (let ((local-env (frame-parameter (frame-with-environment)
'environment)))
(cond ((or (not local-environment-variables)
(not local-env))
(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 local-env nil)))))
scan seen)
;; Find the first valid entry in env.
(while (and env (stringp (car env))
......
......@@ -674,12 +674,20 @@ setup is for focus to follow the pointer."
(cdr (assq 'window-system parameters)))
(t window-system)))
(frame-creation-function (cdr (assq w frame-creation-function-alist)))
(oldframe (selected-frame))
frame)
(unless frame-creation-function
(error "Don't know how to create a frame on window system %s" w))
(run-hooks 'before-make-frame-hook)
(setq frame (funcall frame-creation-function (append parameters (cdr (assq w window-system-default-frame-alist)))))
(normal-erase-is-backspace-setup-frame frame)
;; Set up the frame-local environment, if needed.
(when (eq (frame-display frame) (frame-display oldframe))
(let ((env (frame-parameter oldframe 'environment)))
(if (not (framep env))
(setq env oldframe))
(if env
(set-frame-parameter frame 'environment env))))
(run-hook-with-args 'after-make-frame-functions frame)
frame))
......
......@@ -620,8 +620,8 @@ The following commands are accepted by the client:
;; emacsclient quits while also preventing
;; `server-save-buffers-kill-display' from unexpectedly
;; killing emacs on that frame.
(list (cons 'client 'nowait))
(list (cons 'client proc)))))
(list (cons 'client 'nowait) (cons 'environment env))
(list (cons 'client proc) (cons 'environment env)))))
(setq frame (make-frame-on-display
(or display
(frame-parameter nil 'display)
......@@ -637,7 +637,6 @@ The following commands are accepted by the client:
(select-frame frame)
(server-client-set client 'frame frame)
(server-client-set client 'device (frame-display frame))
(set-terminal-parameter frame 'environment env)
(setq dontkill t))
;; This emacs does not support X.
(server-log "Window system unsupported" proc)
......@@ -684,12 +683,12 @@ The following commands are accepted by the client:
(setq frame (make-frame-on-tty tty type
;; Ignore nowait here; we always need to clean
;; up opened ttys when the client dies.
`((client . ,proc)))))
`((client . ,proc)
(environment . ,env)))))
(select-frame frame)
(server-client-set client 'frame frame)
(server-client-set client 'tty (display-name frame))
(server-client-set client 'device (frame-display frame))
(set-terminal-parameter frame 'environment env)
;; Reply with our pid.
(server-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n"))
......@@ -740,8 +739,7 @@ The following commands are accepted by the client:
;; -env NAME=VALUE: An environment variable.
((and (equal "-env" arg) (string-match "\\([^ ]+\\) " request))
(let ((var (server-unquote-arg (match-string 1 request))))
(when coding-system
(setq var (decode-coding-string var coding-system)))
;; XXX Variables should be encoded as in getenv/setenv.
(setq request (substring request (match-end 0)))
(setq env (cons var env))))
......
......@@ -119,7 +119,6 @@ Lisp_Object Vprocess_environment;
#ifdef DOS_NT
Lisp_Object Qbuffer_file_type;
#endif /* DOS_NT */
Lisp_Object Qenvironment;
/* True iff we are about to fork off a synchronous process or if we
are waiting for it. */
......@@ -1319,8 +1318,8 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir)
if (!NILP (Vlocal_environment_variables))
{
local = get_terminal_param (FRAME_DEVICE (XFRAME (selected_frame)),
Qenvironment);
local = get_frame_param (XFRAME (Fframe_with_environment (selected_frame)),
Qenvironment);
if (EQ (Vlocal_environment_variables, Qt)
&& !NILP (local))
environment = local;
......@@ -1356,7 +1355,7 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir)
new_env = add_env (env, new_env, egetenv (SDATA (XCAR (tem))));
/* The rest of the environment (either Vglobal_environment or the
'environment terminal parameter). */
'environment frame parameter). */
for (tem = environment;
CONSP (tem) && STRINGP (XCAR (tem));
tem = XCDR (tem))
......@@ -1488,12 +1487,12 @@ relocate_fd (fd, minfd)
}
static int
getenv_internal (var, varlen, value, valuelen, terminal)
getenv_internal (var, varlen, value, valuelen, frame)
char *var;
int varlen;
char **value;
int *valuelen;
Lisp_Object terminal;
Lisp_Object frame;
{
Lisp_Object scan;
Lisp_Object environment = Vglobal_environment;
......@@ -1528,17 +1527,19 @@ getenv_internal (var, varlen, value, valuelen, terminal)
}
/* Find the environment in which to search the variable. */
if (!NILP (terminal))
if (!NILP (frame))
{
Lisp_Object local = get_terminal_param (get_device (terminal, 1), Qenvironment);
CHECK_FRAME (frame);
frame = Fframe_with_environment (frame);
Lisp_Object local = get_frame_param (XFRAME (frame), Qenvironment);
/* Use Vglobal_environment if there is no local environment. */
if (!NILP (local))
environment = local;
}
else if (!NILP (Vlocal_environment_variables))
{
Lisp_Object local = get_terminal_param (FRAME_DEVICE (XFRAME (selected_frame)),
Qenvironment);
Lisp_Object local = get_frame_param (XFRAME (Fframe_with_environment (selected_frame)),
Qenvironment);
if (EQ (Vlocal_environment_variables, Qt)
&& !NILP (local))
environment = local;
......@@ -1594,25 +1595,23 @@ DEFUN ("getenv-internal", Fgetenv_internal, Sgetenv_internal, 1, 2, 0,
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 VARIABLE in
it.
If optional parameter FRAME is non-nil, then it should be a frame. If
that frame has its own set of environment variables, this function
will look up VARIABLE in there.
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;
frame, depending on the value of `local-environment-variables'. */)
(variable, frame)
Lisp_Object variable, frame;
{
char *value;
int valuelen;
CHECK_STRING (variable);
if (getenv_internal (SDATA (variable), SBYTES (variable),
&value, &valuelen, terminal))
&value, &valuelen, frame))
return make_string (value, valuelen);
else
return Qnil;
......@@ -1842,11 +1841,10 @@ 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.
Some frames 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 frames.
If multiple entries define the same variable, the first one always
takes precedence.
......@@ -1860,12 +1858,12 @@ See `setenv' and `getenv'. */);
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".
or the frame-local environment. (See `local-environment-variables'.)
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.
......@@ -1886,21 +1884,18 @@ See `setenv' and `getenv'. */);
defsubr (&Scall_process_region);
DEFVAR_LISP ("local-environment-variables", &Vlocal_environment_variables,
doc: /* Enable or disable terminal-local environment variables.
doc: /* Enable or disable frame-local environment variables.
If set to t, `getenv', `setenv' and subprocess creation functions use
the local environment of the terminal device of the selected frame,
ignoring `global-environment'.
the local environment of the selected frame, ignoring
`global-environment'.
If set to nil, Emacs uses `global-environment' and ignores the
terminal environment.
frame-local environment.
Otherwise, `local-environment-variables' should be a list of variable
names (represented by Lisp strings) to look up in the terminal's
names (represented by Lisp strings) to look up in the frame's
environment. The rest will come from `global-environment'. */);
Vlocal_environment_variables = Qnil;
Qenvironment = intern ("environment");
staticpro (&Qenvironment);
}
/* arch-tag: 769b8045-1df7-4d2b-8968-e3fb49017f95
......
......@@ -111,6 +111,7 @@ Lisp_Object Qbuffer_predicate, Qbuffer_list, Qburied_buffer_list;
Lisp_Object Qtty_color_mode;
Lisp_Object Qtty, Qtty_type;
Lisp_Object Qwindow_system;
Lisp_Object Qenvironment;
Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth;
......@@ -1473,6 +1474,24 @@ The functions are run with one arg, the frame to be deleted. */)
if (EQ (f->minibuffer_window, echo_area_window))
echo_area_window = sf->minibuffer_window;
/* Don't allow other frames to refer to a deleted frame in their
'environment parameter. */
{
Lisp_Object tail, frame1;
Lisp_Object env = get_frame_param (XFRAME (frame), Qenvironment);
FOR_EACH_FRAME (tail, frame1)
{
if (EQ (frame, frame1) || !FRAME_LIVE_P (XFRAME (frame1)))
continue;
if (EQ (frame, get_frame_param (XFRAME (frame1), Qenvironment)))
{
store_frame_param (XFRAME (frame1), Qenvironment, env);
if (!FRAMEP (env))
env = frame1;
}
}
}
/* Clear any X selections for this frame. */
#ifdef HAVE_X_WINDOWS
if (FRAME_X_P (f))
......@@ -2577,6 +2596,43 @@ enabled such bindings for that variable with `make-variable-frame-local'. */)
return unbind_to (count, Qnil);
}
DEFUN ("frame-with-environment", Fframe_with_environment, Sframe_with_environment, 0, 1, 0,
doc: /* Return the frame that has the environment variable list for FRAME.
The frame-local environment variable list is normally shared between
frames that were created in the same Emacsclient session. The
environment list is stored in a single frame's 'environment parameter;
the other frames' 'environment parameter is set to this frame. This
function follows to chain of 'environment references to reach the
frame that stores the actual local environment list, and returns that
frame. */)
(frame)
Lisp_Object frame;
{
Lisp_Object hare, tortoise;
if (NILP (frame))
frame = selected_frame;
CHECK_FRAME (frame);
hare = tortoise = get_frame_param (XFRAME (frame), Qenvironment);
while (!NILP (hare) && FRAMEP (hare))
{
frame = hare;
hare = get_frame_param (XFRAME (hare), Qenvironment);
if (NILP (hare) || !FRAMEP (hare))
break;
frame = hare;
hare = get_frame_param (XFRAME (hare), Qenvironment);
tortoise = get_frame_param (XFRAME (tortoise), Qenvironment);
if (EQ (hare, tortoise))
error ("Cyclic frame-local environment indirection");
}
return frame;
}
DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height,
0, 1, 0,
......@@ -4232,6 +4288,8 @@ syms_of_frame ()
staticpro (&Qtty_type);
Qwindow_system = intern ("window-system");
staticpro (&Qwindow_system);
Qenvironment = intern ("environment");
staticpro (&Qenvironment);
Qface_set_after_frame_default = intern ("face-set-after-frame-default");
staticpro (&Qface_set_after_frame_default);
......@@ -4416,6 +4474,7 @@ This variable is local to the current terminal and cannot be buffer-local. */);
defsubr (&Sframe_parameters);
defsubr (&Sframe_parameter);
defsubr (&Smodify_frame_parameters);
defsubr (&Sframe_with_environment);
defsubr (&Sframe_char_height);
defsubr (&Sframe_char_width);
defsubr (&Sframe_pixel_height);
......
......@@ -781,6 +781,7 @@ typedef struct frame *FRAME_PTR;
extern Lisp_Object Qframep, Qframe_live_p;
extern Lisp_Object Qtty, Qtty_type;
extern Lisp_Object Qdevice, Qdisplay_live_p;
extern Lisp_Object Qenvironment;
extern struct frame *last_nonminibuf_frame;
......
......@@ -2998,6 +2998,7 @@ EXFUN (Fvisible_frame_list, 0);
EXFUN (Fframe_parameter, 2);
EXFUN (Fframe_parameters, 1);
EXFUN (Fmodify_frame_parameters, 2);
EXFUN (Fframe_with_environment, 1);
EXFUN (Fset_frame_height, 3);
EXFUN (Fset_frame_width, 3);
EXFUN (Fset_frame_size, 3);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment