aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaroly Lorentey2005-12-26 02:14:10 +0000
committerKaroly Lorentey2005-12-26 02:14:10 +0000
commitf105f403d206f95bf534226abb99f14aa2f3052e (patch)
treed326884972abd85997fc9e688e0fefa60a3ec977
parented8dad6b616204b4dd4e853801f41da6f4c3b0a7 (diff)
downloademacs-f105f403d206f95bf534226abb99f14aa2f3052e.tar.gz
emacs-f105f403d206f95bf534226abb99f14aa2f3052e.zip
Implement automatic terminal-local environment variables via `local-environment-variables'.
* lisp/env.el (setenv, getenv): Add optional terminal parameter. Update docs. (setenv): Handle `local-environment-variables'. (read-envvar-name): Also allow (and complete) local environment variables on the current terminal. * src/callproc.c: Include frame.h and termhooks.h, for terminal parameters. (Qenvironment): New constant. (Vlocal_environment_variables): New variable. (syms_of_callproc): Register and initialize them. (child_setup): Handle Vlocal_environment_variables. (getenv_internal): Add terminal parameter. Handle Vlocal_environment_variables. (Fgetenv_internal): Add terminal parameter. * src/termhooks.h (get_terminal_param): Declare. * src/Makefile.in (callproc.o): Update dependencies. * mac/makefile.MPW (callproc.c.x): Update dependencies. * lisp/termdev.el (terminal-id): Make parameter optional. (terminal-getenv, terminal-setenv, with-terminal-environment): Disable functions. * lisp/mule-cmds.el (set-locale-environment): Convert `terminal-getenv' calls to `getenv'. * lisp/rxvt.el (rxvt-set-background-mode): Ditto. * lisp/x-win.el (x-initialize-window-system): Ditto. * lisp/xterm.el (terminal-init-xterm): Ditto. * lisp/server.el (server-process-filter): Fix reference to the 'display frame parameter. git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-461
-rw-r--r--README.multi-tty54
-rw-r--r--lisp/env.el76
-rw-r--r--lisp/international/mule-cmds.el6
-rw-r--r--lisp/server.el2
-rw-r--r--lisp/term/rxvt.el2
-rw-r--r--lisp/term/x-win.el3
-rw-r--r--lisp/term/xterm.el4
-rw-r--r--lisp/termdev.el282
-rw-r--r--mac/makefile.MPW8
-rw-r--r--src/Makefile.in2
-rw-r--r--src/callproc.c160
-rw-r--r--src/termhooks.h2
12 files changed, 385 insertions, 216 deletions
diff --git a/README.multi-tty b/README.multi-tty
index ebe064c2fca..de75aa6a10b 100644
--- a/README.multi-tty
+++ b/README.multi-tty
@@ -401,28 +401,10 @@ is probably not very interesting for anyone else.)
401THINGS TO DO 401THINGS TO DO
402------------ 402------------
403 403
404** Implement automatic forwarding of client environment variables to 404** Trouble: `setenv' doesn't actually set environment variables in the
405 forked processes, as discussed on the multi-tty list. Terminal 405 Emacs process. This defeats the purpose of the elaborate
406 parameters are now accessible in C code, so the biggest obstacle is 406 `server-with-environment' magic around the `tgetent' call in
407 gone. The `getenv_internal' and `child_setup' functions in 407 `init_tty'. D'oh.
408 callproc.c must be changed to support the following variable:
409
410 terminal-local-environment-variables is a variable defined in ...
411
412 Enable or disable terminal-local environment variables.
413
414 If set to t, `getenv', `setenv' and subprocess creation
415 functions use the environment variables of the emacsclient
416 process that created the selected frame, ignoring
417 `process-environment'.
418
419 If set to nil, Emacs uses `process-environment' and ignores
420 the client environment.
421
422 Otherwise, `terminal-local-environment-variables' should be a
423 list of variable names (represented by Lisp strings) to look
424 up in the client environment. The rest will come from
425 `process-environment'.
426 408
427** (Possibly) create hooks in struct device for creating frames on a 409** (Possibly) create hooks in struct device for creating frames on a
428 specific terminal, and eliminate the hackish terminal-related frame 410 specific terminal, and eliminate the hackish terminal-related frame
@@ -1348,5 +1330,33 @@ DIARY OF CHANGES
1348 1330
1349 (Disabled in patch-450.) 1331 (Disabled in patch-450.)
1350 1332
1333-- Implement automatic forwarding of client environment variables to
1334 forked processes, as discussed on the multi-tty list. Terminal
1335 parameters are now accessible in C code, so the biggest obstacle is
1336 gone. The `getenv_internal' and `child_setup' functions in
1337 callproc.c must be changed to support the following variable:
1338
1339 terminal-local-environment-variables is a variable defined in ...
1340
1341 Enable or disable terminal-local environment variables.
1342
1343 If set to t, `getenv', `setenv' and subprocess creation
1344 functions use the environment variables of the emacsclient
1345 process that created the selected frame, ignoring
1346 `process-environment'.
1347
1348 If set to nil, Emacs uses `process-environment' and ignores
1349 the client environment.
1350
1351 Otherwise, `terminal-local-environment-variables' should be a
1352 list of variable names (represented by Lisp strings) to look
1353 up in the client environment. The rest will come from
1354 `process-environment'.
1355
1356 (Implemented in patch-461; `terminal-getenv', `terminal-setenv' and
1357 `with-terminal-environment' are now replaced by extensions to
1358 `getenv' and `setenv', and the new `local-environment-variables'
1359 facility. Yay!)
1360
1351;;; arch-tag: 8da1619e-2e79-41a8-9ac9-a0485daad17d 1361;;; arch-tag: 8da1619e-2e79-41a8-9ac9-a0485daad17d
1352 1362
diff --git a/lisp/env.el b/lisp/env.el
index 409765f5ff4..378b7f078be 100644
--- a/lisp/env.el
+++ b/lisp/env.el
@@ -52,7 +52,8 @@ If it is also not t, RET does not exit if it does non-null completion."
52 locale-coding-system t) 52 locale-coding-system t)
53 (substring enventry 0 53 (substring enventry 0
54 (string-match "=" enventry))))) 54 (string-match "=" enventry)))))
55 process-environment) 55 (append (terminal-parameter nil 'environment)
56 process-environment))
56 nil mustmatch nil 'read-envvar-name-history)) 57 nil mustmatch nil 'read-envvar-name-history))
57 58
58;; History list for VALUE argument to setenv. 59;; History list for VALUE argument to setenv.
@@ -90,7 +91,7 @@ Use `$$' to insert a single dollar sign."
90 91
91;; Fixme: Should `process-environment' be recoded if LC_CTYPE &c is set? 92;; Fixme: Should `process-environment' be recoded if LC_CTYPE &c is set?
92 93
93(defun setenv (variable &optional value unset substitute-env-vars) 94(defun setenv (variable &optional value unset substitute-env-vars terminal)
94 "Set the value of the environment variable named VARIABLE to VALUE. 95 "Set the value of the environment variable named VARIABLE to VALUE.
95VARIABLE should be a string. VALUE is optional; if not provided or 96VARIABLE should be a string. VALUE is optional; if not provided or
96nil, the environment variable VARIABLE will be removed. UNSET 97nil, the environment variable VARIABLE will be removed. UNSET
@@ -105,7 +106,14 @@ Interactively, the current value (if any) of the variable
105appears at the front of the history list when you type in the new value. 106appears at the front of the history list when you type in the new value.
106Interactively, always replace environment variables in the new value. 107Interactively, always replace environment variables in the new value.
107 108
108This function works by modifying `process-environment'. 109If optional parameter TERMINAL is non-nil, then it should be a
110terminal id or a frame. If the specified terminal device has its own
111set of environment variables, this function will modify VAR in it.
112
113Otherwise, this function works by modifying either
114`process-environment' or the environment belonging to the
115terminal device of the selected frame, depending on the value of
116`local-environment-variables'.
109 117
110As a special case, setting variable `TZ' calls `set-time-zone-rule' as 118As a special case, setting variable `TZ' calls `set-time-zone-rule' as
111a side-effect." 119a side-effect."
@@ -138,36 +146,58 @@ a side-effect."
138 (if (and value (multibyte-string-p value)) 146 (if (and value (multibyte-string-p value))
139 (setq value (encode-coding-string value locale-coding-system))) 147 (setq value (encode-coding-string value locale-coding-system)))
140 (if (string-match "=" variable) 148 (if (string-match "=" variable)
141 (error "Environment variable name `%s' contains `='" variable) 149 (error "Environment variable name `%s' contains `='" variable))
142 (let ((pattern (concat "\\`" (regexp-quote (concat variable "=")))) 150 (let* ((pattern (concat "\\`" (regexp-quote (concat variable "="))))
143 (case-fold-search nil) 151 (case-fold-search nil)
144 (scan process-environment) 152 (local-var-p (and (terminal-parameter terminal 'environment)
145 found) 153 (or terminal
146 (if (string-equal "TZ" variable) 154 (eq t local-environment-variables)
147 (set-time-zone-rule value)) 155 (member variable local-environment-variables))))
148 (while scan 156 (scan (if local-var-p
149 (cond ((string-match pattern (car scan)) 157 (terminal-parameter terminal 'environment)
150 (setq found t) 158 process-environment))
151 (if (eq nil value) 159 found)
160 (if (string-equal "TZ" variable)
161 (set-time-zone-rule value))
162 (while scan
163 (cond ((string-match pattern (car scan))
164 (setq found t)
165 (if (eq nil value)
166 (if local-var-p
167 (set-terminal-parameter terminal 'environment
168 (delq (car scan)
169 (terminal-parameter terminal 'environment)))
152 (setq process-environment (delq (car scan) 170 (setq process-environment (delq (car scan)
153 process-environment)) 171 process-environment)))
154 (setcar scan (concat variable "=" value))) 172 (setcar scan (concat variable "=" value)))
155 (setq scan nil))) 173 (setq scan nil)))
156 (setq scan (cdr scan))) 174 (setq scan (cdr scan)))
157 (or found 175 (or found
158 (if value 176 (if value
177 (if local-var-p
178 (set-terminal-parameter nil 'environment
179 (cons (concat variable "=" value)
180 (terminal-parameter nil 'environment)))
159 (setq process-environment 181 (setq process-environment
160 (cons (concat variable "=" value) 182 (cons (concat variable "=" value)
161 process-environment)))))) 183 process-environment))))))
162 value) 184 value)
163 185
164(defun getenv (variable) 186(defun getenv (variable &optional terminal)
165 "Get the value of environment variable VARIABLE. 187 "Get the value of environment variable VARIABLE.
166VARIABLE should be a string. Value is nil if VARIABLE is undefined in 188VARIABLE should be a string. Value is nil if VARIABLE is undefined in
167the environment. Otherwise, value is a string. 189the environment. Otherwise, value is a string.
168 190
169This function consults the variable `process-environment' 191If optional parameter TERMINAL is non-nil, then it should be a
170for its value." 192terminal id or a frame. If the specified terminal device has its own
193set of environment variables, this function will look up VAR in it.
194
195Otherwise, if `local-environment-variables' specifies that VAR is a
196local environment variable, then this function consults the
197environment variables belonging to the terminal device of the selected
198frame.
199
200Otherwise, the value of VAR will come from `process-environment'."
171 (interactive (list (read-envvar-name "Get environment variable: " t))) 201 (interactive (list (read-envvar-name "Get environment variable: " t)))
172 (let ((value (getenv-internal (if (multibyte-string-p variable) 202 (let ((value (getenv-internal (if (multibyte-string-p variable)
173 (encode-coding-string 203 (encode-coding-string
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index b66243f2270..575653e8f5a 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -2460,7 +2460,7 @@ See also `locale-charset-language-names', `locale-language-names',
2460 (let ((vars '("LC_ALL" "LC_CTYPE" "LANG"))) 2460 (let ((vars '("LC_ALL" "LC_CTYPE" "LANG")))
2461 (while (and vars 2461 (while (and vars
2462 (= 0 (length locale))) ; nil or empty string 2462 (= 0 (length locale))) ; nil or empty string
2463 (setq locale (terminal-getenv (pop vars)))))) 2463 (setq locale (getenv (pop vars) display)))))
2464 2464
2465 (unless locale 2465 (unless locale
2466 ;; The two tests are kept separate so the byte-compiler sees 2466 ;; The two tests are kept separate so the byte-compiler sees
@@ -2573,7 +2573,7 @@ See also `locale-charset-language-names', `locale-language-names',
2573 ;; Mac OS X's Terminal.app by default uses utf-8 regardless of 2573 ;; Mac OS X's Terminal.app by default uses utf-8 regardless of
2574 ;; the locale. 2574 ;; the locale.
2575 (when (and (null window-system) 2575 (when (and (null window-system)
2576 (equal (terminal-getenv "TERM_PROGRAM") "Apple_Terminal")) 2576 (equal (getenv "TERM_PROGRAM" display) "Apple_Terminal"))
2577 (set-terminal-coding-system 'utf-8) 2577 (set-terminal-coding-system 'utf-8)
2578 (set-keyboard-coding-system 'utf-8))) 2578 (set-keyboard-coding-system 'utf-8)))
2579 2579
@@ -2591,7 +2591,7 @@ See also `locale-charset-language-names', `locale-language-names',
2591 (setq ps-paper-type 'a4))) 2591 (setq ps-paper-type 'a4)))
2592 (let ((vars '("LC_ALL" "LC_PAPER" "LANG"))) 2592 (let ((vars '("LC_ALL" "LC_PAPER" "LANG")))
2593 (while (and vars (= 0 (length locale))) 2593 (while (and vars (= 0 (length locale)))
2594 (setq locale (terminal-getenv (pop vars))))) 2594 (setq locale (getenv (pop vars) display))))
2595 (when locale 2595 (when locale
2596 ;; As of glibc 2.2.5, these are the only US Letter locales, 2596 ;; As of glibc 2.2.5, these are the only US Letter locales,
2597 ;; and the rest are A4. 2597 ;; and the rest are A4.
diff --git a/lisp/server.el b/lisp/server.el
index 7aed300e99a..fb587b640a3 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -624,7 +624,7 @@ The following commands are accepted by the client:
624 (list (cons 'client proc))))) 624 (list (cons 'client proc)))))
625 (setq frame (make-frame-on-display 625 (setq frame (make-frame-on-display
626 (or display 626 (or display
627 (frame-parameter nil 'device) 627 (frame-parameter nil 'display)
628 (getenv "DISPLAY") 628 (getenv "DISPLAY")
629 (error "Please specify display")) 629 (error "Please specify display"))
630 params)) 630 params))
diff --git a/lisp/term/rxvt.el b/lisp/term/rxvt.el
index e7e92e70042..79994403301 100644
--- a/lisp/term/rxvt.el
+++ b/lisp/term/rxvt.el
@@ -291,7 +291,7 @@ for the currently selected frame."
291;; intelligent way than the default guesswork in startup.el. 291;; intelligent way than the default guesswork in startup.el.
292(defun rxvt-set-background-mode () 292(defun rxvt-set-background-mode ()
293 "Set background mode as appropriate for the default rxvt colors." 293 "Set background mode as appropriate for the default rxvt colors."
294 (let ((fgbg (terminal-getenv "COLORFGBG")) 294 (let ((fgbg (getenv "COLORFGBG" (terminal-id)))
295 bg rgb) 295 bg rgb)
296 (setq default-frame-background-mode 'light) 296 (setq default-frame-background-mode 'light)
297 (when (and fgbg 297 (when (and fgbg
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index 49ef4cb9a58..a61577215e5 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -2407,7 +2407,8 @@ order until succeed.")
2407 (aset x-resource-name i ?-)))) 2407 (aset x-resource-name i ?-))))
2408 2408
2409 (x-open-connection (or x-display-name 2409 (x-open-connection (or x-display-name
2410 (setq x-display-name (terminal-getenv "DISPLAY" nil 'global-ok))) 2410 (setq x-display-name (or (getenv "DISPLAY" (terminal-id))
2411 (getenv "DISPLAY"))))
2411 x-command-line-resources 2412 x-command-line-resources
2412 ;; Exit Emacs with fatal error if this fails and we 2413 ;; Exit Emacs with fatal error if this fails and we
2413 ;; are the initial display. 2414 ;; are the initial display.
diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el
index ecfeaba51fc..399385b4fc4 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -192,8 +192,8 @@
192 ;; rxvt terminals sometimes set the TERM variable to "xterm", but 192 ;; rxvt terminals sometimes set the TERM variable to "xterm", but
193 ;; rxvt's keybindings that are incompatible with xterm's. It is 193 ;; rxvt's keybindings that are incompatible with xterm's. It is
194 ;; better in that case to use rxvt's initializion function. 194 ;; better in that case to use rxvt's initializion function.
195 (if (and (terminal-getenv "COLORTERM") 195 (if (and (getenv "COLORTERM" (terminal-id))
196 (string-match "\\`rxvt" (terminal-getenv "COLORTERM"))) 196 (string-match "\\`rxvt" (getenv "COLORTERM" (terminal-id))))
197 (progn 197 (progn
198 (eval-and-compile (load "term/rxvt")) 198 (eval-and-compile (load "term/rxvt"))
199 (terminal-init-rxvt)) 199 (terminal-init-rxvt))
diff --git a/lisp/termdev.el b/lisp/termdev.el
index f413067d542..5e12740e11c 100644
--- a/lisp/termdev.el
+++ b/lisp/termdev.el
@@ -25,7 +25,7 @@
25 25
26(substitute-key-definition 'suspend-emacs 'suspend-frame global-map) 26(substitute-key-definition 'suspend-emacs 'suspend-frame global-map)
27 27
28(defun terminal-id (terminal) 28(defun terminal-id (&optional terminal)
29 "Return the numerical id of terminal TERMINAL. 29 "Return the numerical id of terminal TERMINAL.
30 30
31TERMINAL can be a terminal id (an integer), a frame, or 31TERMINAL can be a terminal id (an integer), a frame, or
@@ -48,146 +48,146 @@ device (HOST.SERVER.SCREEN) or a tty device file."
48 (t 48 (t
49 (error "Invalid argument %s in `terminal-id'" terminal)))) 49 (error "Invalid argument %s in `terminal-id'" terminal))))
50 50
51(defun terminal-getenv (variable &optional terminal global-ok) 51;; (defun terminal-getenv (variable &optional terminal global-ok)
52 "Get the value of VARIABLE in the client environment of TERMINAL. 52;; "Get the value of VARIABLE in the client environment of TERMINAL.
53VARIABLE should be a string. Value is nil if VARIABLE is undefined in 53;; VARIABLE should be a string. Value is nil if VARIABLE is undefined in
54the environment. Otherwise, value is a string. 54;; the environment. Otherwise, value is a string.
55 55
56If TERMINAL has an associated emacsclient process, then 56;; If TERMINAL has an associated emacsclient process, then
57`terminal-getenv' looks up VARIABLE in the environment of that 57;; `terminal-getenv' looks up VARIABLE in the environment of that
58process; otherwise the function consults the global environment, 58;; process; otherwise the function consults the global environment,
59i.e., the environment of the Emacs process itself. 59;; i.e., the environment of the Emacs process itself.
60 60
61If GLOBAL-OK is non-nil, and VARIABLE is not defined in the 61;; If GLOBAL-OK is non-nil, and VARIABLE is not defined in the
62terminal-local environment, then `terminal-getenv' will return 62;; terminal-local environment, then `terminal-getenv' will return
63its value in the global environment instead. 63;; its value in the global environment instead.
64 64
65TERMINAL can be a terminal id, a frame, or nil (meaning the 65;; TERMINAL can be a terminal id, a frame, or nil (meaning the
66selected frame's terminal)." 66;; selected frame's terminal)."
67 (setq terminal (terminal-id terminal)) 67;; (setq terminal (terminal-id terminal))
68 (if (null (terminal-parameter terminal 'environment)) 68;; (if (null (terminal-parameter terminal 'environment))
69 (getenv variable) 69;; (getenv variable)
70 (if (multibyte-string-p variable) 70;; (if (multibyte-string-p variable)
71 (setq variable (encode-coding-string variable locale-coding-system))) 71;; (setq variable (encode-coding-string variable locale-coding-system)))
72 (let ((env (terminal-parameter terminal 'environment)) 72;; (let ((env (terminal-parameter terminal 'environment))
73 result entry) 73;; result entry)
74 (while (and env (null result)) 74;; (while (and env (null result))
75 (setq entry (car env) 75;; (setq entry (car env)
76 env (cdr env)) 76;; env (cdr env))
77 (if (and (> (length entry) (length variable)) 77;; (if (and (> (length entry) (length variable))
78 (eq ?= (aref entry (length variable))) 78;; (eq ?= (aref entry (length variable)))
79 (equal variable (substring entry 0 (length variable)))) 79;; (equal variable (substring entry 0 (length variable))))
80 (setq result (substring entry (+ (length variable) 1))))) 80;; (setq result (substring entry (+ (length variable) 1)))))
81 (if (and global-ok (null result)) 81;; (if (and global-ok (null result))
82 (getenv variable) 82;; (getenv variable)
83 (and result (decode-coding-string result locale-coding-system)))))) 83;; (and result (decode-coding-string result locale-coding-system))))))
84 84
85(defun terminal-setenv (variable &optional value terminal) 85;; (defun terminal-setenv (variable &optional value terminal)
86 "Set the value of VARIABLE in the environment of TERMINAL. 86;; "Set the value of VARIABLE in the environment of TERMINAL.
87VARIABLE should be string. VALUE is optional; if not provided or 87;; VARIABLE should be string. VALUE is optional; if not provided or
88nil, the environment variable VARIABLE is removed. Returned 88;; nil, the environment variable VARIABLE is removed. Returned
89value is the new value of VARIABLE, or nil if it was removed from 89;; value is the new value of VARIABLE, or nil if it was removed from
90the environment. 90;; the environment.
91 91
92If TERMINAL was created by an emacsclient invocation, then the 92;; If TERMINAL was created by an emacsclient invocation, then the
93variable is set in the environment of the emacsclient process; 93;; variable is set in the environment of the emacsclient process;
94otherwise the function changes the environment of the Emacs 94;; otherwise the function changes the environment of the Emacs
95process itself. 95;; process itself.
96 96
97TERMINAL can be a terminal id, a frame, or nil (meaning the 97;; TERMINAL can be a terminal id, a frame, or nil (meaning the
98selected frame's terminal)." 98;; selected frame's terminal)."
99 (if (null (terminal-parameter terminal 'environment)) 99;; (if (null (terminal-parameter terminal 'environment))
100 (setenv variable value) 100;; (setenv variable value)
101 (with-terminal-environment terminal variable 101;; (with-terminal-environment terminal variable
102 (setenv variable value)))) 102;; (setenv variable value))))
103 103
104(defun terminal-setenv-internal (variable value terminal) 104;; (defun terminal-setenv-internal (variable value terminal)
105 "Set the value of VARIABLE in the environment of TERMINAL. 105;; "Set the value of VARIABLE in the environment of TERMINAL.
106The caller is responsible to ensure that both VARIABLE and VALUE 106;; The caller is responsible to ensure that both VARIABLE and VALUE
107are usable in environment variables and that TERMINAL is a 107;; are usable in environment variables and that TERMINAL is a
108remote terminal." 108;; remote terminal."
109 (if (multibyte-string-p variable) 109;; (if (multibyte-string-p variable)
110 (setq variable (encode-coding-string variable locale-coding-system))) 110;; (setq variable (encode-coding-string variable locale-coding-system)))
111 (if (and value (multibyte-string-p value)) 111;; (if (and value (multibyte-string-p value))
112 (setq value (encode-coding-string value locale-coding-system))) 112;; (setq value (encode-coding-string value locale-coding-system)))
113 (let ((env (terminal-parameter terminal 'environment)) 113;; (let ((env (terminal-parameter terminal 'environment))
114 found) 114;; found)
115 (while (and env (not found)) 115;; (while (and env (not found))
116 (if (and (> (length (car env)) (length variable)) 116;; (if (and (> (length (car env)) (length variable))
117 (eq ?= (aref (car env) (length variable))) 117;; (eq ?= (aref (car env) (length variable)))
118 (equal variable (substring (car env) 0 (length variable)))) 118;; (equal variable (substring (car env) 0 (length variable))))
119 (progn 119;; (progn
120 (if value 120;; (if value
121 (setcar env (concat variable "=" value)) 121;; (setcar env (concat variable "=" value))
122 (set-terminal-parameter terminal 'environment 122;; (set-terminal-parameter terminal 'environment
123 (delq (car env) 123;; (delq (car env)
124 (terminal-parameter terminal 124;; (terminal-parameter terminal
125 'environment)))) 125;; 'environment))))
126 (setq found t)) 126;; (setq found t))
127 (setq env (cdr env)))) 127;; (setq env (cdr env))))
128 (cond 128;; (cond
129 ((and value found) 129;; ((and value found)
130 (setcar env (concat variable "=" value))) 130;; (setcar env (concat variable "=" value)))
131 ((and value (not found)) 131;; ((and value (not found))
132 (set-terminal-parameter terminal 'environment 132;; (set-terminal-parameter terminal 'environment
133 (cons (concat variable "=" value) 133;; (cons (concat variable "=" value)
134 (terminal-parameter terminal 134;; (terminal-parameter terminal
135 'environment)))) 135;; 'environment))))
136 ((and (not value) found) 136;; ((and (not value) found)
137 (set-terminal-parameter terminal 'environment 137;; (set-terminal-parameter terminal 'environment
138 (delq (car env) 138;; (delq (car env)
139 (terminal-parameter terminal 139;; (terminal-parameter terminal
140 'environment))))))) 140;; 'environment)))))))
141 141
142(defmacro with-terminal-environment (terminal vars &rest body) 142;; (defmacro with-terminal-environment (terminal vars &rest body)
143 "Evaluate BODY with environment variables VARS set to those of TERMINAL. 143;; "Evaluate BODY with environment variables VARS set to those of TERMINAL.
144The environment variables are then restored to their previous values. 144;; The environment variables are then restored to their previous values.
145 145
146VARS should be a single string, a list of strings, or t for all 146;; VARS should be a single string, a list of strings, or t for all
147environment variables. 147;; environment variables.
148 148
149TERMINAL can be a terminal id, a frame, or nil (meaning the 149;; TERMINAL can be a terminal id, a frame, or nil (meaning the
150selected frame's terminal). 150;; selected frame's terminal).
151 151
152If BODY uses `setenv' to change environment variables in VARS, 152;; If BODY uses `setenv' to change environment variables in VARS,
153then the new variable values will be remembered for TERMINAL, and 153;; then the new variable values will be remembered for TERMINAL, and
154`terminal-getenv' will return them even outside BODY." 154;; `terminal-getenv' will return them even outside BODY."
155 (declare (indent 2)) 155;; (declare (indent 2))
156 (let ((var (make-symbol "var")) 156;; (let ((var (make-symbol "var"))
157 (term (make-symbol "term")) 157;; (term (make-symbol "term"))
158 (v (make-symbol "v")) 158;; (v (make-symbol "v"))
159 (old-env (make-symbol "old-env"))) 159;; (old-env (make-symbol "old-env")))
160 `(let ((,term ,terminal) ; Evaluate arguments only once. 160;; `(let ((,term ,terminal) ; Evaluate arguments only once.
161 (,v ,vars)) 161;; (,v ,vars))
162 (if (stringp ,v) 162;; (if (stringp ,v)
163 (setq ,v (list ,v))) 163;; (setq ,v (list ,v)))
164 (cond 164;; (cond
165 ((null (terminal-parameter ,term 'environment)) 165;; ((null (terminal-parameter ,term 'environment))
166 ;; Not a remote terminal; nothing to do. 166;; ;; Not a remote terminal; nothing to do.
167 (progn ,@body)) 167;; (progn ,@body))
168 ((eq ,v t) 168;; ((eq ,v t)
169 ;; Switch the entire process-environment. 169;; ;; Switch the entire process-environment.
170 (let (,old-env process-environment) 170;; (let (,old-env process-environment)
171 (setq process-environment (terminal-parameter ,term 'environment)) 171;; (setq process-environment (terminal-parameter ,term 'environment))
172 (unwind-protect 172;; (unwind-protect
173 (progn ,@body) 173;; (progn ,@body)
174 (set-terminal-parameter ,term 'environment process-environment) 174;; (set-terminal-parameter ,term 'environment process-environment)
175 (setq process-environment ,old-env)))) 175;; (setq process-environment ,old-env))))
176 (t 176;; (t
177 ;; Do only a set of variables. 177;; ;; Do only a set of variables.
178 (let (,old-env) 178;; (let (,old-env)
179 (dolist (,var ,v) 179;; (dolist (,var ,v)
180 (setq ,old-env (cons (cons ,var (getenv ,var)) ,old-env)) 180;; (setq ,old-env (cons (cons ,var (getenv ,var)) ,old-env))
181 (setenv ,var (terminal-getenv ,var ,term))) 181;; (setenv ,var (terminal-getenv ,var ,term)))
182 (unwind-protect 182;; (unwind-protect
183 (progn ,@body) 183;; (progn ,@body)
184 ;; Split storing new values and restoring old ones so 184;; ;; Split storing new values and restoring old ones so
185 ;; that we DTRT even if a variable is specified twice in 185;; ;; that we DTRT even if a variable is specified twice in
186 ;; VARS. 186;; ;; VARS.
187 (dolist (,var ,v) 187;; (dolist (,var ,v)
188 (terminal-setenv-internal ,var (getenv ,var) ,term)) 188;; (terminal-setenv-internal ,var (getenv ,var) ,term))
189 (dolist (,var ,old-env) 189;; (dolist (,var ,old-env)
190 (setenv (car ,var) (cdr ,var)))))))))) 190;; (setenv (car ,var) (cdr ,var))))))))))
191 191
192(provide 'termdev) 192(provide 'termdev)
193 193
diff --git a/mac/makefile.MPW b/mac/makefile.MPW
index 031a2dddb06..4c999a90dfa 100644
--- a/mac/makefile.MPW
+++ b/mac/makefile.MPW
@@ -261,8 +261,8 @@ buildobj.lst Ä
261 {CONFIG_H_GROUP} ¶ 261 {CONFIG_H_GROUP} ¶
262 "{Includes}sys:types.h" ¶ 262 "{Includes}sys:types.h" ¶
263 "{Includes}sys:file.h" ¶ 263 "{Includes}sys:file.h" ¶
264 "{Includes}sys:types.h" ¶ 264 "{Includes}sys:types.h" ¶
265 "{Includes}sys:stat.h" ¶ 265 "{Includes}sys:stat.h" ¶
266 "{Src}lisp.h" ¶ 266 "{Src}lisp.h" ¶
267 "{Src}commands.h" ¶ 267 "{Src}commands.h" ¶
268 "{Src}buffer.h" ¶ 268 "{Src}buffer.h" ¶
@@ -274,7 +274,9 @@ buildobj.lst Ä
274 "{Src}process.h" ¶ 274 "{Src}process.h" ¶
275 "{Src}syssignal.h" ¶ 275 "{Src}syssignal.h" ¶
276 "{Src}systty.h" ¶ 276 "{Src}systty.h" ¶
277 "{Includes}termio.h" 277 "{Includes}termio.h" ¶
278 "{Src}frame.h" ¶
279 "{Src}termhooks.h"
278 280
279{Src}casefiddle Ä ¶ 281{Src}casefiddle Ä ¶
280 {CONFIG_H_GROUP} ¶ 282 {CONFIG_H_GROUP} ¶
diff --git a/src/Makefile.in b/src/Makefile.in
index f8029d5e246..1054b76ac14 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -1078,7 +1078,7 @@ callint.o: callint.c window.h commands.h buffer.h keymap.h \
1078 keyboard.h dispextern.h $(config_h) 1078 keyboard.h dispextern.h $(config_h)
1079callproc.o: callproc.c epaths.h buffer.h commands.h $(config_h) \ 1079callproc.o: callproc.c epaths.h buffer.h commands.h $(config_h) \
1080 process.h systty.h syssignal.h charset.h coding.h ccl.h msdos.h \ 1080 process.h systty.h syssignal.h charset.h coding.h ccl.h msdos.h \
1081 composite.h w32.h blockinput.h atimer.h systime.h 1081 composite.h w32.h blockinput.h atimer.h systime.h frame.h termhooks.h
1082casefiddle.o: casefiddle.c syntax.h commands.h buffer.h composite.h \ 1082casefiddle.o: casefiddle.c syntax.h commands.h buffer.h composite.h \
1083 charset.h keymap.h $(config_h) 1083 charset.h keymap.h $(config_h)
1084casetab.o: casetab.c buffer.h $(config_h) 1084casetab.o: casetab.c buffer.h $(config_h)
diff --git a/src/callproc.c b/src/callproc.c
index 47930819c07..35331e4b5dd 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -84,6 +84,8 @@ extern int errno;
84#include "syssignal.h" 84#include "syssignal.h"
85#include "systty.h" 85#include "systty.h"
86#include "blockinput.h" 86#include "blockinput.h"
87#include "frame.h"
88#include "termhooks.h"
87 89
88#ifdef MSDOS 90#ifdef MSDOS
89#include "msdos.h" 91#include "msdos.h"
@@ -116,6 +118,7 @@ Lisp_Object Vprocess_environment;
116#ifdef DOS_NT 118#ifdef DOS_NT
117Lisp_Object Qbuffer_file_type; 119Lisp_Object Qbuffer_file_type;
118#endif /* DOS_NT */ 120#endif /* DOS_NT */
121Lisp_Object Qenvironment;
119 122
120/* True iff we are about to fork off a synchronous process or if we 123/* True iff we are about to fork off a synchronous process or if we
121 are waiting for it. */ 124 are waiting for it. */
@@ -130,6 +133,10 @@ int synch_process_termsig;
130/* If synch_process_death is zero, 133/* If synch_process_death is zero,
131 this is exit code of synchronous subprocess. */ 134 this is exit code of synchronous subprocess. */
132int synch_process_retcode; 135int synch_process_retcode;
136
137/* List of environment variables to look up in emacsclient. */
138Lisp_Object Vlocal_environment_variables;
139
133 140
134/* Clean up when exiting Fcall_process. 141/* Clean up when exiting Fcall_process.
135 On MSDOS, delete the temporary file on any kind of termination. 142 On MSDOS, delete the temporary file on any kind of termination.
@@ -1264,9 +1271,25 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir)
1264 register Lisp_Object tem; 1271 register Lisp_Object tem;
1265 register char **new_env; 1272 register char **new_env;
1266 register int new_length; 1273 register int new_length;
1274 Lisp_Object environment = Vprocess_environment;
1275 Lisp_Object local;
1267 1276
1268 new_length = 0; 1277 new_length = 0;
1269 for (tem = Vprocess_environment; 1278
1279 if (!NILP (Vlocal_environment_variables))
1280 {
1281 local = get_terminal_param (FRAME_DEVICE (XFRAME (selected_frame)),
1282 Qenvironment);
1283 if (EQ (Vlocal_environment_variables, Qt)
1284 && !NILP (local))
1285 environment = local;
1286 else if (CONSP (local))
1287 {
1288 new_length += Fsafe_length (Vlocal_environment_variables);
1289 }
1290 }
1291
1292 for (tem = environment;
1270 CONSP (tem) && STRINGP (XCAR (tem)); 1293 CONSP (tem) && STRINGP (XCAR (tem));
1271 tem = XCDR (tem)) 1294 tem = XCDR (tem))
1272 new_length++; 1295 new_length++;
@@ -1279,8 +1302,42 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir)
1279 if (getenv ("PWD")) 1302 if (getenv ("PWD"))
1280 *new_env++ = pwd_var; 1303 *new_env++ = pwd_var;
1281 1304
1282 /* Copy the Vprocess_environment strings into new_env. */ 1305 /* Get the local environment variables first. */
1283 for (tem = Vprocess_environment; 1306 for (tem = Vlocal_environment_variables;
1307 CONSP (tem) && STRINGP (XCAR (tem));
1308 tem = XCDR (tem))
1309 {
1310 char **ep = env;
1311 char *string = egetenv (SDATA (XCAR (tem)));
1312 int ok = 1;
1313 if (string == NULL)
1314 continue;
1315
1316 /* See if this string duplicates any string already in the env.
1317 If so, don't put it in.
1318 When an env var has multiple definitions,
1319 we keep the definition that comes first in process-environment. */
1320 for (; ep != new_env; ep++)
1321 {
1322 char *p = *ep, *q = string;
1323 while (ok)
1324 {
1325 if (*q == 0)
1326 /* The string is malformed; might as well drop it. */
1327 ok = 0;
1328 if (*q != *p)
1329 break;
1330 if (*q == '=')
1331 ok = 0;
1332 p++, q++;
1333 }
1334 }
1335 if (ok)
1336 *new_env++ = string;
1337 }
1338
1339 /* Copy the environment strings into new_env. */
1340 for (tem = environment;
1284 CONSP (tem) && STRINGP (XCAR (tem)); 1341 CONSP (tem) && STRINGP (XCAR (tem));
1285 tem = XCDR (tem)) 1342 tem = XCDR (tem))
1286 { 1343 {
@@ -1423,29 +1480,68 @@ relocate_fd (fd, minfd)
1423} 1480}
1424 1481
1425static int 1482static int
1426getenv_internal (var, varlen, value, valuelen) 1483getenv_internal (var, varlen, value, valuelen, terminal)
1427 char *var; 1484 char *var;
1428 int varlen; 1485 int varlen;
1429 char **value; 1486 char **value;
1430 int *valuelen; 1487 int *valuelen;
1488 Lisp_Object terminal;
1431{ 1489{
1432 Lisp_Object scan; 1490 Lisp_Object scan;
1491 Lisp_Object environment = Vprocess_environment;
1492
1493 /* Find the environment in which to search the variable. */
1494 if (!NILP (terminal))
1495 {
1496 Lisp_Object local = get_terminal_param (get_device (terminal, 1));
1497 /* Use Vprocess_environment if there is no local environment. */
1498 if (!NILP (local))
1499 environment = local;
1500 }
1501 else if (!NILP (Vlocal_environment_variables))
1502 {
1503 Lisp_Object local = get_terminal_param (FRAME_DEVICE (XFRAME (selected_frame)),
1504 Qenvironment);
1505 if (EQ (Vlocal_environment_variables, Qt)
1506 && !NILP (local))
1507 environment = local;
1508 else if (CONSP (local))
1509 {
1510 for (scan = Vlocal_environment_variables; CONSP (scan); scan = XCDR (scan))
1511 {
1512 Lisp_Object entry = XCAR (scan);
1513 if (STRINGP (entry)
1514 && SBYTES (entry) == varlen
1515#ifdef WINDOWSNT
1516 /* NT environment variables are case insensitive. */
1517 && ! strnicmp (SDATA (entry), var, varlen)
1518#else /* not WINDOWSNT */
1519 && ! bcmp (SDATA (entry), var, varlen)
1520#endif /* not WINDOWSNT */
1521 )
1522 {
1523 environment = local;
1524 break;
1525 }
1526 }
1527 }
1528 }
1433 1529
1434 for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan)) 1530 for (scan = environment; CONSP (scan); scan = XCDR (scan))
1435 { 1531 {
1436 Lisp_Object entry; 1532 Lisp_Object entry;
1437 1533
1438 entry = XCAR (scan); 1534 entry = XCAR (scan);
1439 if (STRINGP (entry) 1535 if (STRINGP (entry)
1440 && SBYTES (entry) > varlen 1536 && SBYTES (entry) > varlen
1441 && SREF (entry, varlen) == '=' 1537 && SREF (entry, varlen) == '='
1442#ifdef WINDOWSNT 1538#ifdef WINDOWSNT
1443 /* NT environment variables are case insensitive. */ 1539 /* NT environment variables are case insensitive. */
1444 && ! strnicmp (SDATA (entry), var, varlen) 1540 && ! strnicmp (SDATA (entry), var, varlen)
1445#else /* not WINDOWSNT */ 1541#else /* not WINDOWSNT */
1446 && ! bcmp (SDATA (entry), var, varlen) 1542 && ! bcmp (SDATA (entry), var, varlen)
1447#endif /* not WINDOWSNT */ 1543#endif /* not WINDOWSNT */
1448 ) 1544 )
1449 { 1545 {
1450 *value = (char *) SDATA (entry) + (varlen + 1); 1546 *value = (char *) SDATA (entry) + (varlen + 1);
1451 *valuelen = SBYTES (entry) - (varlen + 1); 1547 *valuelen = SBYTES (entry) - (varlen + 1);
@@ -1456,19 +1552,30 @@ getenv_internal (var, varlen, value, valuelen)
1456 return 0; 1552 return 0;
1457} 1553}
1458 1554
1459DEFUN ("getenv-internal", Fgetenv_internal, Sgetenv_internal, 1, 1, 0, 1555DEFUN ("getenv-internal", Fgetenv_internal, Sgetenv_internal, 1, 2, 0,
1460 doc: /* Return the value of environment variable VAR, as a string. 1556 doc: /* Return the value of environment variable VAR, as a string.
1461VAR should be a string. Value is nil if VAR is undefined in the environment. 1557VAR should be a string. Value is nil if VAR is undefined in the
1462This function consults the variable ``process-environment'' for its value. */) 1558environment.
1463 (var) 1559
1464 Lisp_Object var; 1560If optional parameter TERMINAL is non-nil, then it should be a
1561terminal id or a frame. If the specified terminal device has its own
1562set of environment variables, this function will look up VAR in it.
1563
1564Otherwise, if `local-environment-variables' specifies that VAR is a
1565local environment variable, then this function consults the
1566environment variables belonging to the terminal device of the selected
1567frame.
1568
1569Otherwise, the value of VAR will come from `process-environment'. */)
1570 (var, terminal)
1571 Lisp_Object var, terminal;
1465{ 1572{
1466 char *value; 1573 char *value;
1467 int valuelen; 1574 int valuelen;
1468 1575
1469 CHECK_STRING (var); 1576 CHECK_STRING (var);
1470 if (getenv_internal (SDATA (var), SBYTES (var), 1577 if (getenv_internal (SDATA (var), SBYTES (var),
1471 &value, &valuelen)) 1578 &value, &valuelen, terminal))
1472 return make_string (value, valuelen); 1579 return make_string (value, valuelen);
1473 else 1580 else
1474 return Qnil; 1581 return Qnil;
@@ -1483,7 +1590,7 @@ egetenv (var)
1483 char *value; 1590 char *value;
1484 int valuelen; 1591 int valuelen;
1485 1592
1486 if (getenv_internal (var, strlen (var), &value, &valuelen)) 1593 if (getenv_internal (var, strlen (var), &value, &valuelen, Qnil))
1487 return value; 1594 return value;
1488 else 1595 else
1489 return 0; 1596 return 0;
@@ -1707,6 +1814,23 @@ See `setenv' and `getenv'. */);
1707 defsubr (&Sgetenv_internal); 1814 defsubr (&Sgetenv_internal);
1708#endif 1815#endif
1709 defsubr (&Scall_process_region); 1816 defsubr (&Scall_process_region);
1817
1818 DEFVAR_LISP ("local-environment-variables", &Vlocal_environment_variables,
1819 doc: /* Enable or disable terminal-local environment variables.
1820If set to t, `getenv', `setenv' and subprocess creation functions use
1821the environment variables of the emacsclient process that created the
1822selected frame, ignoring `process-environment'.
1823
1824If set to nil, Emacs uses `process-environment' and ignores the client
1825environment.
1826
1827Otherwise, `terminal-local-environment-variables' should be a list of
1828variable names (represented by Lisp strings) to look up in the client
1829environment. The rest will come from `process-environment'. */);
1830 Vlocal_environment_variables = Qnil;
1831
1832 Qenvironment = intern ("environment");
1833 staticpro (&Qenvironment);
1710} 1834}
1711 1835
1712/* arch-tag: 769b8045-1df7-4d2b-8968-e3fb49017f95 1836/* arch-tag: 769b8045-1df7-4d2b-8968-e3fb49017f95
diff --git a/src/termhooks.h b/src/termhooks.h
index 824cef60351..f12dbadd197 100644
--- a/src/termhooks.h
+++ b/src/termhooks.h
@@ -595,6 +595,8 @@ extern struct device *device_list;
595/* Return true if the display device is not suspended. */ 595/* Return true if the display device is not suspended. */
596#define DEVICE_ACTIVE_P(d) ((d)->type != output_termcap || (d)->display_info.tty->input) 596#define DEVICE_ACTIVE_P(d) ((d)->type != output_termcap || (d)->display_info.tty->input)
597 597
598extern Lisp_Object get_terminal_param P_ ((struct device *, Lisp_Object));
599
598extern struct device *create_device P_ ((void)); 600extern struct device *create_device P_ ((void));
599extern void delete_device P_ ((struct device *)); 601extern void delete_device P_ ((struct device *));
600 602