mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-28 07:45:00 +00:00
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
This commit is contained in:
Karoly Lorentey
parent
ed8dad6b61
commit
f105f403d2
@ -401,28 +401,10 @@ is probably not very interesting for anyone else.)
|
||||
THINGS TO DO
|
||||
------------
|
||||
|
||||
** Implement automatic forwarding of client environment variables to
|
||||
forked processes, as discussed on the multi-tty list. Terminal
|
||||
parameters are now accessible in C code, so the biggest obstacle is
|
||||
gone. The `getenv_internal' and `child_setup' functions in
|
||||
callproc.c must be changed to support the following variable:
|
||||
|
||||
terminal-local-environment-variables is a variable defined in ...
|
||||
|
||||
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'.
|
||||
|
||||
If set to nil, Emacs uses `process-environment' and ignores
|
||||
the client 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'.
|
||||
** Trouble: `setenv' doesn't actually set environment variables in the
|
||||
Emacs process. This defeats the purpose of the elaborate
|
||||
`server-with-environment' magic around the `tgetent' call in
|
||||
`init_tty'. D'oh.
|
||||
|
||||
** (Possibly) create hooks in struct device for creating frames on a
|
||||
specific terminal, and eliminate the hackish terminal-related frame
|
||||
@ -1348,5 +1330,33 @@ DIARY OF CHANGES
|
||||
|
||||
(Disabled in patch-450.)
|
||||
|
||||
-- Implement automatic forwarding of client environment variables to
|
||||
forked processes, as discussed on the multi-tty list. Terminal
|
||||
parameters are now accessible in C code, so the biggest obstacle is
|
||||
gone. The `getenv_internal' and `child_setup' functions in
|
||||
callproc.c must be changed to support the following variable:
|
||||
|
||||
terminal-local-environment-variables is a variable defined in ...
|
||||
|
||||
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'.
|
||||
|
||||
If set to nil, Emacs uses `process-environment' and ignores
|
||||
the client 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'.
|
||||
|
||||
(Implemented in patch-461; `terminal-getenv', `terminal-setenv' and
|
||||
`with-terminal-environment' are now replaced by extensions to
|
||||
`getenv' and `setenv', and the new `local-environment-variables'
|
||||
facility. Yay!)
|
||||
|
||||
;;; arch-tag: 8da1619e-2e79-41a8-9ac9-a0485daad17d
|
||||
|
||||
|
||||
76
lisp/env.el
76
lisp/env.el
@ -52,7 +52,8 @@ 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)))))
|
||||
process-environment)
|
||||
(append (terminal-parameter nil 'environment)
|
||||
process-environment))
|
||||
nil mustmatch nil 'read-envvar-name-history))
|
||||
|
||||
;; History list for VALUE argument to setenv.
|
||||
@ -90,7 +91,7 @@ Use `$$' to insert a single dollar sign."
|
||||
|
||||
;; Fixme: Should `process-environment' be recoded if LC_CTYPE &c is set?
|
||||
|
||||
(defun setenv (variable &optional value unset substitute-env-vars)
|
||||
(defun setenv (variable &optional value unset substitute-env-vars terminal)
|
||||
"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
|
||||
@ -105,7 +106,14 @@ 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.
|
||||
|
||||
This function works by modifying `process-environment'.
|
||||
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."
|
||||
@ -138,36 +146,58 @@ a side-effect."
|
||||
(if (and value (multibyte-string-p value))
|
||||
(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)
|
||||
(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)
|
||||
(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)
|
||||
(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
|
||||
(if value
|
||||
process-environment)))
|
||||
(setcar scan (concat variable "=" value)))
|
||||
(setq scan nil)))
|
||||
(setq scan (cdr scan)))
|
||||
(or found
|
||||
(if value
|
||||
(if local-var-p
|
||||
(set-terminal-parameter nil 'environment
|
||||
(cons (concat variable "=" value)
|
||||
(terminal-parameter nil 'environment)))
|
||||
(setq process-environment
|
||||
(cons (concat variable "=" value)
|
||||
process-environment))))))
|
||||
value)
|
||||
|
||||
(defun getenv (variable)
|
||||
(defun getenv (variable &optional terminal)
|
||||
"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.
|
||||
|
||||
This function consults the variable `process-environment'
|
||||
for its value."
|
||||
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.
|
||||
|
||||
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'."
|
||||
(interactive (list (read-envvar-name "Get environment variable: " t)))
|
||||
(let ((value (getenv-internal (if (multibyte-string-p variable)
|
||||
(encode-coding-string
|
||||
|
||||
@ -2460,7 +2460,7 @@ See also `locale-charset-language-names', `locale-language-names',
|
||||
(let ((vars '("LC_ALL" "LC_CTYPE" "LANG")))
|
||||
(while (and vars
|
||||
(= 0 (length locale))) ; nil or empty string
|
||||
(setq locale (terminal-getenv (pop vars))))))
|
||||
(setq locale (getenv (pop vars) display)))))
|
||||
|
||||
(unless locale
|
||||
;; The two tests are kept separate so the byte-compiler sees
|
||||
@ -2573,7 +2573,7 @@ See also `locale-charset-language-names', `locale-language-names',
|
||||
;; Mac OS X's Terminal.app by default uses utf-8 regardless of
|
||||
;; the locale.
|
||||
(when (and (null window-system)
|
||||
(equal (terminal-getenv "TERM_PROGRAM") "Apple_Terminal"))
|
||||
(equal (getenv "TERM_PROGRAM" display) "Apple_Terminal"))
|
||||
(set-terminal-coding-system 'utf-8)
|
||||
(set-keyboard-coding-system 'utf-8)))
|
||||
|
||||
@ -2591,7 +2591,7 @@ See also `locale-charset-language-names', `locale-language-names',
|
||||
(setq ps-paper-type 'a4)))
|
||||
(let ((vars '("LC_ALL" "LC_PAPER" "LANG")))
|
||||
(while (and vars (= 0 (length locale)))
|
||||
(setq locale (terminal-getenv (pop vars)))))
|
||||
(setq locale (getenv (pop vars) display))))
|
||||
(when locale
|
||||
;; As of glibc 2.2.5, these are the only US Letter locales,
|
||||
;; and the rest are A4.
|
||||
|
||||
@ -624,7 +624,7 @@ The following commands are accepted by the client:
|
||||
(list (cons 'client proc)))))
|
||||
(setq frame (make-frame-on-display
|
||||
(or display
|
||||
(frame-parameter nil 'device)
|
||||
(frame-parameter nil 'display)
|
||||
(getenv "DISPLAY")
|
||||
(error "Please specify display"))
|
||||
params))
|
||||
|
||||
@ -291,7 +291,7 @@ for the currently selected frame."
|
||||
;; intelligent way than the default guesswork in startup.el.
|
||||
(defun rxvt-set-background-mode ()
|
||||
"Set background mode as appropriate for the default rxvt colors."
|
||||
(let ((fgbg (terminal-getenv "COLORFGBG"))
|
||||
(let ((fgbg (getenv "COLORFGBG" (terminal-id)))
|
||||
bg rgb)
|
||||
(setq default-frame-background-mode 'light)
|
||||
(when (and fgbg
|
||||
|
||||
@ -2407,7 +2407,8 @@ order until succeed.")
|
||||
(aset x-resource-name i ?-))))
|
||||
|
||||
(x-open-connection (or x-display-name
|
||||
(setq x-display-name (terminal-getenv "DISPLAY" nil 'global-ok)))
|
||||
(setq x-display-name (or (getenv "DISPLAY" (terminal-id))
|
||||
(getenv "DISPLAY"))))
|
||||
x-command-line-resources
|
||||
;; Exit Emacs with fatal error if this fails and we
|
||||
;; are the initial display.
|
||||
|
||||
@ -192,8 +192,8 @@
|
||||
;; rxvt terminals sometimes set the TERM variable to "xterm", but
|
||||
;; rxvt's keybindings that are incompatible with xterm's. It is
|
||||
;; better in that case to use rxvt's initializion function.
|
||||
(if (and (terminal-getenv "COLORTERM")
|
||||
(string-match "\\`rxvt" (terminal-getenv "COLORTERM")))
|
||||
(if (and (getenv "COLORTERM" (terminal-id))
|
||||
(string-match "\\`rxvt" (getenv "COLORTERM" (terminal-id))))
|
||||
(progn
|
||||
(eval-and-compile (load "term/rxvt"))
|
||||
(terminal-init-rxvt))
|
||||
|
||||
260
lisp/termdev.el
260
lisp/termdev.el
@ -25,7 +25,7 @@
|
||||
|
||||
(substitute-key-definition 'suspend-emacs 'suspend-frame global-map)
|
||||
|
||||
(defun terminal-id (terminal)
|
||||
(defun terminal-id (&optional terminal)
|
||||
"Return the numerical id of terminal TERMINAL.
|
||||
|
||||
TERMINAL can be a terminal id (an integer), a frame, or
|
||||
@ -48,146 +48,146 @@ device (HOST.SERVER.SCREEN) or a tty device file."
|
||||
(t
|
||||
(error "Invalid argument %s in `terminal-id'" terminal))))
|
||||
|
||||
(defun terminal-getenv (variable &optional terminal global-ok)
|
||||
"Get the value of VARIABLE in the client environment of TERMINAL.
|
||||
VARIABLE should be a string. Value is nil if VARIABLE is undefined in
|
||||
the environment. Otherwise, value is a string.
|
||||
;; (defun terminal-getenv (variable &optional terminal global-ok)
|
||||
;; "Get the value of VARIABLE in the client environment of TERMINAL.
|
||||
;; VARIABLE should be a string. Value is nil if VARIABLE is undefined in
|
||||
;; the environment. Otherwise, value is a string.
|
||||
|
||||
If TERMINAL has an associated emacsclient process, then
|
||||
`terminal-getenv' looks up VARIABLE in the environment of that
|
||||
process; otherwise the function consults the global environment,
|
||||
i.e., the environment of the Emacs process itself.
|
||||
;; If TERMINAL has an associated emacsclient process, then
|
||||
;; `terminal-getenv' looks up VARIABLE in the environment of that
|
||||
;; process; otherwise the function consults the global environment,
|
||||
;; i.e., the environment of the Emacs process itself.
|
||||
|
||||
If GLOBAL-OK is non-nil, and VARIABLE is not defined in the
|
||||
terminal-local environment, then `terminal-getenv' will return
|
||||
its value in the global environment instead.
|
||||
;; If GLOBAL-OK is non-nil, and VARIABLE is not defined in the
|
||||
;; terminal-local environment, then `terminal-getenv' will return
|
||||
;; its value in the global environment instead.
|
||||
|
||||
TERMINAL can be a terminal id, a frame, or nil (meaning the
|
||||
selected frame's terminal)."
|
||||
(setq terminal (terminal-id terminal))
|
||||
(if (null (terminal-parameter terminal 'environment))
|
||||
(getenv variable)
|
||||
(if (multibyte-string-p variable)
|
||||
(setq variable (encode-coding-string variable locale-coding-system)))
|
||||
(let ((env (terminal-parameter terminal 'environment))
|
||||
result entry)
|
||||
(while (and env (null result))
|
||||
(setq entry (car env)
|
||||
env (cdr env))
|
||||
(if (and (> (length entry) (length variable))
|
||||
(eq ?= (aref entry (length variable)))
|
||||
(equal variable (substring entry 0 (length variable))))
|
||||
(setq result (substring entry (+ (length variable) 1)))))
|
||||
(if (and global-ok (null result))
|
||||
(getenv variable)
|
||||
(and result (decode-coding-string result locale-coding-system))))))
|
||||
;; TERMINAL can be a terminal id, a frame, or nil (meaning the
|
||||
;; selected frame's terminal)."
|
||||
;; (setq terminal (terminal-id terminal))
|
||||
;; (if (null (terminal-parameter terminal 'environment))
|
||||
;; (getenv variable)
|
||||
;; (if (multibyte-string-p variable)
|
||||
;; (setq variable (encode-coding-string variable locale-coding-system)))
|
||||
;; (let ((env (terminal-parameter terminal 'environment))
|
||||
;; result entry)
|
||||
;; (while (and env (null result))
|
||||
;; (setq entry (car env)
|
||||
;; env (cdr env))
|
||||
;; (if (and (> (length entry) (length variable))
|
||||
;; (eq ?= (aref entry (length variable)))
|
||||
;; (equal variable (substring entry 0 (length variable))))
|
||||
;; (setq result (substring entry (+ (length variable) 1)))))
|
||||
;; (if (and global-ok (null result))
|
||||
;; (getenv variable)
|
||||
;; (and result (decode-coding-string result locale-coding-system))))))
|
||||
|
||||
(defun terminal-setenv (variable &optional value terminal)
|
||||
"Set the value of VARIABLE in the environment of TERMINAL.
|
||||
VARIABLE should be string. VALUE is optional; if not provided or
|
||||
nil, the environment variable VARIABLE is removed. Returned
|
||||
value is the new value of VARIABLE, or nil if it was removed from
|
||||
the environment.
|
||||
;; (defun terminal-setenv (variable &optional value terminal)
|
||||
;; "Set the value of VARIABLE in the environment of TERMINAL.
|
||||
;; VARIABLE should be string. VALUE is optional; if not provided or
|
||||
;; nil, the environment variable VARIABLE is removed. Returned
|
||||
;; value is the new value of VARIABLE, or nil if it was removed from
|
||||
;; the environment.
|
||||
|
||||
If TERMINAL was created by an emacsclient invocation, then the
|
||||
variable is set in the environment of the emacsclient process;
|
||||
otherwise the function changes the environment of the Emacs
|
||||
process itself.
|
||||
;; If TERMINAL was created by an emacsclient invocation, then the
|
||||
;; variable is set in the environment of the emacsclient process;
|
||||
;; otherwise the function changes the environment of the Emacs
|
||||
;; process itself.
|
||||
|
||||
TERMINAL can be a terminal id, a frame, or nil (meaning the
|
||||
selected frame's terminal)."
|
||||
(if (null (terminal-parameter terminal 'environment))
|
||||
(setenv variable value)
|
||||
(with-terminal-environment terminal variable
|
||||
(setenv variable value))))
|
||||
;; TERMINAL can be a terminal id, a frame, or nil (meaning the
|
||||
;; selected frame's terminal)."
|
||||
;; (if (null (terminal-parameter terminal 'environment))
|
||||
;; (setenv variable value)
|
||||
;; (with-terminal-environment terminal variable
|
||||
;; (setenv variable value))))
|
||||
|
||||
(defun terminal-setenv-internal (variable value terminal)
|
||||
"Set the value of VARIABLE in the environment of TERMINAL.
|
||||
The caller is responsible to ensure that both VARIABLE and VALUE
|
||||
are usable in environment variables and that TERMINAL is a
|
||||
remote terminal."
|
||||
(if (multibyte-string-p variable)
|
||||
(setq variable (encode-coding-string variable locale-coding-system)))
|
||||
(if (and value (multibyte-string-p value))
|
||||
(setq value (encode-coding-string value locale-coding-system)))
|
||||
(let ((env (terminal-parameter terminal 'environment))
|
||||
found)
|
||||
(while (and env (not found))
|
||||
(if (and (> (length (car env)) (length variable))
|
||||
(eq ?= (aref (car env) (length variable)))
|
||||
(equal variable (substring (car env) 0 (length variable))))
|
||||
(progn
|
||||
(if value
|
||||
(setcar env (concat variable "=" value))
|
||||
(set-terminal-parameter terminal 'environment
|
||||
(delq (car env)
|
||||
(terminal-parameter terminal
|
||||
'environment))))
|
||||
(setq found t))
|
||||
(setq env (cdr env))))
|
||||
(cond
|
||||
((and value found)
|
||||
(setcar env (concat variable "=" value)))
|
||||
((and value (not found))
|
||||
(set-terminal-parameter terminal 'environment
|
||||
(cons (concat variable "=" value)
|
||||
(terminal-parameter terminal
|
||||
'environment))))
|
||||
((and (not value) found)
|
||||
(set-terminal-parameter terminal 'environment
|
||||
(delq (car env)
|
||||
(terminal-parameter terminal
|
||||
'environment)))))))
|
||||
;; (defun terminal-setenv-internal (variable value terminal)
|
||||
;; "Set the value of VARIABLE in the environment of TERMINAL.
|
||||
;; The caller is responsible to ensure that both VARIABLE and VALUE
|
||||
;; are usable in environment variables and that TERMINAL is a
|
||||
;; remote terminal."
|
||||
;; (if (multibyte-string-p variable)
|
||||
;; (setq variable (encode-coding-string variable locale-coding-system)))
|
||||
;; (if (and value (multibyte-string-p value))
|
||||
;; (setq value (encode-coding-string value locale-coding-system)))
|
||||
;; (let ((env (terminal-parameter terminal 'environment))
|
||||
;; found)
|
||||
;; (while (and env (not found))
|
||||
;; (if (and (> (length (car env)) (length variable))
|
||||
;; (eq ?= (aref (car env) (length variable)))
|
||||
;; (equal variable (substring (car env) 0 (length variable))))
|
||||
;; (progn
|
||||
;; (if value
|
||||
;; (setcar env (concat variable "=" value))
|
||||
;; (set-terminal-parameter terminal 'environment
|
||||
;; (delq (car env)
|
||||
;; (terminal-parameter terminal
|
||||
;; 'environment))))
|
||||
;; (setq found t))
|
||||
;; (setq env (cdr env))))
|
||||
;; (cond
|
||||
;; ((and value found)
|
||||
;; (setcar env (concat variable "=" value)))
|
||||
;; ((and value (not found))
|
||||
;; (set-terminal-parameter terminal 'environment
|
||||
;; (cons (concat variable "=" value)
|
||||
;; (terminal-parameter terminal
|
||||
;; 'environment))))
|
||||
;; ((and (not value) found)
|
||||
;; (set-terminal-parameter terminal 'environment
|
||||
;; (delq (car env)
|
||||
;; (terminal-parameter terminal
|
||||
;; 'environment)))))))
|
||||
|
||||
(defmacro with-terminal-environment (terminal vars &rest body)
|
||||
"Evaluate BODY with environment variables VARS set to those of TERMINAL.
|
||||
The environment variables are then restored to their previous values.
|
||||
;; (defmacro with-terminal-environment (terminal vars &rest body)
|
||||
;; "Evaluate BODY with environment variables VARS set to those of TERMINAL.
|
||||
;; The environment variables are then restored to their previous values.
|
||||
|
||||
VARS should be a single string, a list of strings, or t for all
|
||||
environment variables.
|
||||
;; VARS should be a single string, a list of strings, or t for all
|
||||
;; environment variables.
|
||||
|
||||
TERMINAL can be a terminal id, a frame, or nil (meaning the
|
||||
selected frame's terminal).
|
||||
;; TERMINAL can be a terminal id, a frame, or nil (meaning the
|
||||
;; selected frame's terminal).
|
||||
|
||||
If BODY uses `setenv' to change environment variables in VARS,
|
||||
then the new variable values will be remembered for TERMINAL, and
|
||||
`terminal-getenv' will return them even outside BODY."
|
||||
(declare (indent 2))
|
||||
(let ((var (make-symbol "var"))
|
||||
(term (make-symbol "term"))
|
||||
(v (make-symbol "v"))
|
||||
(old-env (make-symbol "old-env")))
|
||||
`(let ((,term ,terminal) ; Evaluate arguments only once.
|
||||
(,v ,vars))
|
||||
(if (stringp ,v)
|
||||
(setq ,v (list ,v)))
|
||||
(cond
|
||||
((null (terminal-parameter ,term 'environment))
|
||||
;; Not a remote terminal; nothing to do.
|
||||
(progn ,@body))
|
||||
((eq ,v t)
|
||||
;; Switch the entire process-environment.
|
||||
(let (,old-env process-environment)
|
||||
(setq process-environment (terminal-parameter ,term 'environment))
|
||||
(unwind-protect
|
||||
(progn ,@body)
|
||||
(set-terminal-parameter ,term 'environment process-environment)
|
||||
(setq process-environment ,old-env))))
|
||||
(t
|
||||
;; Do only a set of variables.
|
||||
(let (,old-env)
|
||||
(dolist (,var ,v)
|
||||
(setq ,old-env (cons (cons ,var (getenv ,var)) ,old-env))
|
||||
(setenv ,var (terminal-getenv ,var ,term)))
|
||||
(unwind-protect
|
||||
(progn ,@body)
|
||||
;; Split storing new values and restoring old ones so
|
||||
;; that we DTRT even if a variable is specified twice in
|
||||
;; VARS.
|
||||
(dolist (,var ,v)
|
||||
(terminal-setenv-internal ,var (getenv ,var) ,term))
|
||||
(dolist (,var ,old-env)
|
||||
(setenv (car ,var) (cdr ,var))))))))))
|
||||
;; If BODY uses `setenv' to change environment variables in VARS,
|
||||
;; then the new variable values will be remembered for TERMINAL, and
|
||||
;; `terminal-getenv' will return them even outside BODY."
|
||||
;; (declare (indent 2))
|
||||
;; (let ((var (make-symbol "var"))
|
||||
;; (term (make-symbol "term"))
|
||||
;; (v (make-symbol "v"))
|
||||
;; (old-env (make-symbol "old-env")))
|
||||
;; `(let ((,term ,terminal) ; Evaluate arguments only once.
|
||||
;; (,v ,vars))
|
||||
;; (if (stringp ,v)
|
||||
;; (setq ,v (list ,v)))
|
||||
;; (cond
|
||||
;; ((null (terminal-parameter ,term 'environment))
|
||||
;; ;; Not a remote terminal; nothing to do.
|
||||
;; (progn ,@body))
|
||||
;; ((eq ,v t)
|
||||
;; ;; Switch the entire process-environment.
|
||||
;; (let (,old-env process-environment)
|
||||
;; (setq process-environment (terminal-parameter ,term 'environment))
|
||||
;; (unwind-protect
|
||||
;; (progn ,@body)
|
||||
;; (set-terminal-parameter ,term 'environment process-environment)
|
||||
;; (setq process-environment ,old-env))))
|
||||
;; (t
|
||||
;; ;; Do only a set of variables.
|
||||
;; (let (,old-env)
|
||||
;; (dolist (,var ,v)
|
||||
;; (setq ,old-env (cons (cons ,var (getenv ,var)) ,old-env))
|
||||
;; (setenv ,var (terminal-getenv ,var ,term)))
|
||||
;; (unwind-protect
|
||||
;; (progn ,@body)
|
||||
;; ;; Split storing new values and restoring old ones so
|
||||
;; ;; that we DTRT even if a variable is specified twice in
|
||||
;; ;; VARS.
|
||||
;; (dolist (,var ,v)
|
||||
;; (terminal-setenv-internal ,var (getenv ,var) ,term))
|
||||
;; (dolist (,var ,old-env)
|
||||
;; (setenv (car ,var) (cdr ,var))))))))))
|
||||
|
||||
(provide 'termdev)
|
||||
|
||||
|
||||
@ -261,8 +261,8 @@ buildobj.lst
|
||||
{CONFIG_H_GROUP} ¶
|
||||
"{Includes}sys:types.h" ¶
|
||||
"{Includes}sys:file.h" ¶
|
||||
"{Includes}sys:types.h" ¶
|
||||
"{Includes}sys:stat.h" ¶
|
||||
"{Includes}sys:types.h" ¶
|
||||
"{Includes}sys:stat.h" ¶
|
||||
"{Src}lisp.h" ¶
|
||||
"{Src}commands.h" ¶
|
||||
"{Src}buffer.h" ¶
|
||||
@ -274,7 +274,9 @@ buildobj.lst
|
||||
"{Src}process.h" ¶
|
||||
"{Src}syssignal.h" ¶
|
||||
"{Src}systty.h" ¶
|
||||
"{Includes}termio.h"
|
||||
"{Includes}termio.h" ¶
|
||||
"{Src}frame.h" ¶
|
||||
"{Src}termhooks.h"
|
||||
|
||||
{Src}casefiddle Ä ¶
|
||||
{CONFIG_H_GROUP} ¶
|
||||
|
||||
@ -1078,7 +1078,7 @@ callint.o: callint.c window.h commands.h buffer.h keymap.h \
|
||||
keyboard.h dispextern.h $(config_h)
|
||||
callproc.o: callproc.c epaths.h buffer.h commands.h $(config_h) \
|
||||
process.h systty.h syssignal.h charset.h coding.h ccl.h msdos.h \
|
||||
composite.h w32.h blockinput.h atimer.h systime.h
|
||||
composite.h w32.h blockinput.h atimer.h systime.h frame.h termhooks.h
|
||||
casefiddle.o: casefiddle.c syntax.h commands.h buffer.h composite.h \
|
||||
charset.h keymap.h $(config_h)
|
||||
casetab.o: casetab.c buffer.h $(config_h)
|
||||
|
||||
160
src/callproc.c
160
src/callproc.c
@ -84,6 +84,8 @@ extern int errno;
|
||||
#include "syssignal.h"
|
||||
#include "systty.h"
|
||||
#include "blockinput.h"
|
||||
#include "frame.h"
|
||||
#include "termhooks.h"
|
||||
|
||||
#ifdef MSDOS
|
||||
#include "msdos.h"
|
||||
@ -116,6 +118,7 @@ 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. */
|
||||
@ -130,6 +133,10 @@ int synch_process_termsig;
|
||||
/* If synch_process_death is zero,
|
||||
this is exit code of synchronous subprocess. */
|
||||
int synch_process_retcode;
|
||||
|
||||
/* List of environment variables to look up in emacsclient. */
|
||||
Lisp_Object Vlocal_environment_variables;
|
||||
|
||||
|
||||
/* Clean up when exiting Fcall_process.
|
||||
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)
|
||||
register Lisp_Object tem;
|
||||
register char **new_env;
|
||||
register int new_length;
|
||||
Lisp_Object environment = Vprocess_environment;
|
||||
Lisp_Object local;
|
||||
|
||||
new_length = 0;
|
||||
for (tem = Vprocess_environment;
|
||||
|
||||
if (!NILP (Vlocal_environment_variables))
|
||||
{
|
||||
local = get_terminal_param (FRAME_DEVICE (XFRAME (selected_frame)),
|
||||
Qenvironment);
|
||||
if (EQ (Vlocal_environment_variables, Qt)
|
||||
&& !NILP (local))
|
||||
environment = local;
|
||||
else if (CONSP (local))
|
||||
{
|
||||
new_length += Fsafe_length (Vlocal_environment_variables);
|
||||
}
|
||||
}
|
||||
|
||||
for (tem = environment;
|
||||
CONSP (tem) && STRINGP (XCAR (tem));
|
||||
tem = XCDR (tem))
|
||||
new_length++;
|
||||
@ -1279,8 +1302,42 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir)
|
||||
if (getenv ("PWD"))
|
||||
*new_env++ = pwd_var;
|
||||
|
||||
/* Copy the Vprocess_environment strings into new_env. */
|
||||
for (tem = Vprocess_environment;
|
||||
/* Get the local environment variables first. */
|
||||
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;
|
||||
|
||||
/* 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. */
|
||||
for (tem = environment;
|
||||
CONSP (tem) && STRINGP (XCAR (tem));
|
||||
tem = XCDR (tem))
|
||||
{
|
||||
@ -1423,29 +1480,68 @@ relocate_fd (fd, minfd)
|
||||
}
|
||||
|
||||
static int
|
||||
getenv_internal (var, varlen, value, valuelen)
|
||||
getenv_internal (var, varlen, value, valuelen, terminal)
|
||||
char *var;
|
||||
int varlen;
|
||||
char **value;
|
||||
int *valuelen;
|
||||
Lisp_Object terminal;
|
||||
{
|
||||
Lisp_Object scan;
|
||||
Lisp_Object environment = Vprocess_environment;
|
||||
|
||||
for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan))
|
||||
/* Find the environment in which to search the variable. */
|
||||
if (!NILP (terminal))
|
||||
{
|
||||
Lisp_Object local = get_terminal_param (get_device (terminal, 1));
|
||||
/* Use Vprocess_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);
|
||||
if (EQ (Vlocal_environment_variables, Qt)
|
||||
&& !NILP (local))
|
||||
environment = local;
|
||||
else if (CONSP (local))
|
||||
{
|
||||
for (scan = Vlocal_environment_variables; 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 */
|
||||
)
|
||||
{
|
||||
environment = local;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
for (scan = environment; CONSP (scan); scan = XCDR (scan))
|
||||
{
|
||||
Lisp_Object entry;
|
||||
|
||||
entry = XCAR (scan);
|
||||
if (STRINGP (entry)
|
||||
&& SBYTES (entry) > varlen
|
||||
&& SREF (entry, varlen) == '='
|
||||
&& SBYTES (entry) > varlen
|
||||
&& SREF (entry, varlen) == '='
|
||||
#ifdef WINDOWSNT
|
||||
/* NT environment variables are case insensitive. */
|
||||
&& ! strnicmp (SDATA (entry), var, varlen)
|
||||
/* NT environment variables are case insensitive. */
|
||||
&& ! strnicmp (SDATA (entry), var, varlen)
|
||||
#else /* not WINDOWSNT */
|
||||
&& ! bcmp (SDATA (entry), var, varlen)
|
||||
&& ! bcmp (SDATA (entry), var, varlen)
|
||||
#endif /* not WINDOWSNT */
|
||||
)
|
||||
)
|
||||
{
|
||||
*value = (char *) SDATA (entry) + (varlen + 1);
|
||||
*valuelen = SBYTES (entry) - (varlen + 1);
|
||||
@ -1456,19 +1552,30 @@ getenv_internal (var, varlen, value, valuelen)
|
||||
return 0;
|
||||
}
|
||||
|
||||
DEFUN ("getenv-internal", Fgetenv_internal, Sgetenv_internal, 1, 1, 0,
|
||||
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.
|
||||
This function consults the variable ``process-environment'' for its value. */)
|
||||
(var)
|
||||
Lisp_Object var;
|
||||
VAR should be a string. Value is nil if VAR is undefined in the
|
||||
environment.
|
||||
|
||||
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.
|
||||
|
||||
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;
|
||||
{
|
||||
char *value;
|
||||
int valuelen;
|
||||
|
||||
CHECK_STRING (var);
|
||||
if (getenv_internal (SDATA (var), SBYTES (var),
|
||||
&value, &valuelen))
|
||||
&value, &valuelen, terminal))
|
||||
return make_string (value, valuelen);
|
||||
else
|
||||
return Qnil;
|
||||
@ -1483,7 +1590,7 @@ egetenv (var)
|
||||
char *value;
|
||||
int valuelen;
|
||||
|
||||
if (getenv_internal (var, strlen (var), &value, &valuelen))
|
||||
if (getenv_internal (var, strlen (var), &value, &valuelen, Qnil))
|
||||
return value;
|
||||
else
|
||||
return 0;
|
||||
@ -1707,6 +1814,23 @@ See `setenv' and `getenv'. */);
|
||||
defsubr (&Sgetenv_internal);
|
||||
#endif
|
||||
defsubr (&Scall_process_region);
|
||||
|
||||
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'.
|
||||
|
||||
If set to nil, Emacs uses `process-environment' and ignores the client
|
||||
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'. */);
|
||||
Vlocal_environment_variables = Qnil;
|
||||
|
||||
Qenvironment = intern ("environment");
|
||||
staticpro (&Qenvironment);
|
||||
}
|
||||
|
||||
/* arch-tag: 769b8045-1df7-4d2b-8968-e3fb49017f95
|
||||
|
||||
@ -595,6 +595,8 @@ extern struct device *device_list;
|
||||
/* Return true if the display device is not suspended. */
|
||||
#define DEVICE_ACTIVE_P(d) ((d)->type != output_termcap || (d)->display_info.tty->input)
|
||||
|
||||
extern Lisp_Object get_terminal_param P_ ((struct device *, Lisp_Object));
|
||||
|
||||
extern struct device *create_device P_ ((void));
|
||||
extern void delete_device P_ ((struct device *));
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user