diff lisp/termdev.el @ 83416:4513d8dcdfd5

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: [e-mail]--2004/emacs--multi-tty--0--patch-456

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/termdev.el	Thu Dec 22 21:02:45 2005 +0000
@@ -0,0 +1,255 @@
+;;; termdev.el --- functions for dealing with terminals
+
+;; Copyright (C) 2005 Free Software Foundation, Inc.
+
+;; Author: Karoly Lorentey <[e-mail]>
+;; 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