Implement automatic terminal-local environment variables via `local-environment-varia...
authorKaroly Lorentey <lorentey@elte.hu>
Mon, 26 Dec 2005 02:14:10 +0000 (02:14 +0000)
committerKaroly Lorentey <lorentey@elte.hu>
Mon, 26 Dec 2005 02:14:10 +0000 (02:14 +0000)
* 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

12 files changed:
README.multi-tty
lisp/env.el
lisp/international/mule-cmds.el
lisp/server.el
lisp/term/rxvt.el
lisp/term/x-win.el
lisp/term/xterm.el
lisp/termdev.el
mac/makefile.MPW
src/Makefile.in
src/callproc.c
src/termhooks.h

index ebe064c..de75aa6 100644 (file)
@@ -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
 
index 409765f..378b7f0 100644 (file)
@@ -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
index b66243f..575653e 100644 (file)
@@ -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.
index 7aed300..fb587b6 100644 (file)
@@ -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))
index e7e92e7..7999440 100644 (file)
@@ -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
index 49ef4cb..a615772 100644 (file)
@@ -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.
index ecfeaba..399385b 100644 (file)
   ;; 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))
dissimilarity index 73%
index f413067..5e12740 100644 (file)
-;;; termdev.el --- functions for dealing with terminals
-
-;; Copyright (C) 2005 Free Software Foundation, Inc.
-
-;; Author: Karoly Lorentey <karoly@lorentey.hu>
-;; Created: 2005-12-22
-;; Keywords: internal
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-(substitute-key-definition 'suspend-emacs 'suspend-frame global-map)
-
-(defun terminal-id (terminal)
-  "Return the numerical id of terminal TERMINAL.
-
-TERMINAL can be a terminal id (an integer), a frame, or
-nil (meaning the selected frame's terminal).  Alternatively,
-TERMINAL may be the name of an X display
-device (HOST.SERVER.SCREEN) or a tty device file."
-  (cond
-   ((integerp terminal)
-    (if (display-live-p terminal)
-       terminal
-      (signal 'wrong-type-argument (list 'display-live-p terminal))))
-   ((or (null terminal) (framep terminal))
-    (frame-display terminal))
-   ((stringp terminal)
-    (let ((f (car (filtered-frame-list (lambda (frame)
-                                        (or (equal (frame-parameter frame 'display) terminal)
-                                            (equal (frame-parameter frame 'tty) terminal)))))))
-      (or f (error "Display %s does not exist" terminal))
-      (frame-display f)))
-   (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.
-
-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.
-
-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.
-
-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))))
-
-(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.
-
-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).
-
-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)
-
-;;; arch-tag: 4c4df277-1ec1-4f56-bfde-7f156fe62fb2
-;;; termdev.el ends here
+;;; termdev.el --- functions for dealing with terminals
+
+;; Copyright (C) 2005 Free Software Foundation, Inc.
+
+;; Author: Karoly Lorentey <karoly@lorentey.hu>
+;; Created: 2005-12-22
+;; Keywords: internal
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+(substitute-key-definition 'suspend-emacs 'suspend-frame global-map)
+
+(defun terminal-id (&optional terminal)
+  "Return the numerical id of terminal TERMINAL.
+
+TERMINAL can be a terminal id (an integer), a frame, or
+nil (meaning the selected frame's terminal).  Alternatively,
+TERMINAL may be the name of an X display
+device (HOST.SERVER.SCREEN) or a tty device file."
+  (cond
+   ((integerp terminal)
+    (if (display-live-p terminal)
+       terminal
+      (signal 'wrong-type-argument (list 'display-live-p terminal))))
+   ((or (null terminal) (framep terminal))
+    (frame-display terminal))
+   ((stringp terminal)
+    (let ((f (car (filtered-frame-list (lambda (frame)
+                                        (or (equal (frame-parameter frame 'display) terminal)
+                                            (equal (frame-parameter frame 'tty) terminal)))))))
+      (or f (error "Display %s does not exist" terminal))
+      (frame-display f)))
+   (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.
+
+;; 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.
+
+;; 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.
+
+;; 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))))
+
+;; (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.
+
+;; 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).
+
+;; 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)
+
+;;; arch-tag: 4c4df277-1ec1-4f56-bfde-7f156fe62fb2
+;;; termdev.el ends here
index 031a2dd..4c999a9 100644 (file)
@@ -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} ¶
index f8029d5..1054b76 100644 (file)
@@ -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)
index 4793081..35331e4 100644 (file)
@@ -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;
+
 \f
 /* 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;
+
+  /* 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 = Vprocess_environment; CONSP (scan); scan = XCDR (scan))
+  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
index 824cef6..f12dbad 100644 (file)
@@ -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 *));