Reimplement and extend support for terminal-local environment variables.

* lisp/termdev.el: New file.  Move terminal parameter-related functions
  here from frame.el.
  (terminal-getenv, with-terminal-environment): Reimplement and extend.
  (terminal-setenv, terminal-setenv-internal): New functions.

* lisp/frame.el (make-frame-on-tty, framep-on-display, suspend-frame):
  Extend doc string, update parameter names.
  (terminal-id, terminal-parameter-alist, terminal-parameters)
  (terminal-parameter-p, terminal-parameter, set-terminal-parameter)
  (terminal-handle-delete-frame, terminal-getenv, terminal-getenv)
  (with-terminal-environment): Move to termdev.el.

* lisp/loadup.el: Load termdev as well.
* lisp/Makefile.in (lisp, shortlisp): Add termdev.elc.
* lisp/makefile.MPW (shortlisp): Ditto.

* lisp/ebuff-menu.el (electric-buffer-menu-mode-map): Bind C-z to
  `suspend-frame', not `suspend-emacs'.
* lisp/echistory.el (electric-history-map): Ditto.
* lisp/ebrowse.el (ebrowse-electric-list-mode-map): Ditto.
* lisp/ebrowse.el (ebrowse-electric-position-mode-map): Ditto.

* lisp/startup.el (normal-splash-screen): Use `save-buffers-kill-display'
  instead of `save-buffers-kill-emacs'.

* lisp/x-win.el (x-initialize-window-system): Add 'global-ok option to
  `terminal-getenv'.

* src/term.c (suspend-tty): Update doc string.

git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-456

1 files changed, 255 insertions, 0 deletions

diff --git a/lisp/termdev.el b/lisp/termdev.el
new file mode 100644
index 00000000000..667975b9b8b
--- /dev/null
+++ b/lisp/termdev.el
@@ -0,0 +1,255 @@
+;;; 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))))
+
+(defvar terminal-parameter-alist nil
+  "An alist of terminal parameter alists.")
+
+(defun terminal-parameters (&optional terminal)
+  "Return the paramater-alist of terminal TERMINAL.
+It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
+
+TERMINAL can be a terminal id, a frame, or nil (meaning the
+selected frame's terminal)."
+  (cdr (assq (terminal-id terminal) terminal-parameter-alist)))
+
+(defun terminal-parameter-p (terminal parameter)
+  "Return non-nil if PARAMETER is a terminal parameter on TERMINAL.
+
+The actual value returned in that case is a cell (PARAMETER . VALUE),
+where VALUE is the current value of PARAMETER.
+
+TERMINAL can be a terminal id, a frame, or nil (meaning the
+selected frame's terminal)."
+  (assq parameter (cdr (assq (terminal-id terminal) terminal-parameter-alist))))
+
+(defun terminal-parameter (terminal parameter)
+  "Return TERMINAL's value for parameter PARAMETER.
+
+TERMINAL can be a terminal id, a frame, or nil (meaning the
+selected frame's terminal)."
+  (cdr (terminal-parameter-p terminal parameter)))
+
+(defun set-terminal-parameter (terminal parameter value)
+  "Set TERMINAL's value for parameter PARAMETER to VALUE.
+Returns the previous value of PARAMETER.
+
+TERMINAL can be a terminal id, a frame, or nil (meaning the
+selected frame's terminal)."
+  (setq terminal (terminal-id terminal))
+  (let* ((alist (assq terminal terminal-parameter-alist))
+         (pair (assq parameter (cdr alist)))
+         (result (cdr pair)))
+    (cond
+     (pair (setcdr pair value))
+     (alist (setcdr alist (cons (cons parameter value) (cdr alist))))
+     (t (setq terminal-parameter-alist
+              (cons (cons terminal
+                          (cons (cons parameter value)
+                                nil))
+                    terminal-parameter-alist))))
+    result))
+
+(defun terminal-handle-delete-frame (frame)
+  "Clean up terminal parameters of FRAME, if it's the last frame on its terminal."
+  ;; XXX We assume that the display is closed immediately after the
+  ;; last frame is deleted on it.  It would be better to create a hook
+  ;; called `delete-display-functions', and use it instead.
+  (when (and (frame-live-p frame)
+             (= 1 (length (frames-on-display-list (frame-display frame)))))
+    (setq terminal-parameter-alist
+          (assq-delete-all (frame-display frame) terminal-parameter-alist))))
+
+(add-hook 'delete-frame-functions 'terminal-handle-delete-frame)
+
+(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 (not (terminal-parameter-p 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 (not (terminal-parameter-p 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
+        ((not (terminal-parameter-p ,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