comparison 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

83416:4513d8dcdfd5

;;; 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