lisp/termdev.el

   1 ;;; termdev.el --- functions for dealing with terminals
   2
   3 ;; Copyright (C) 2005 Free Software Foundation, Inc.
   4
   5 ;; Author: Karoly Lorentey <karoly@lorentey.hu>
   6 ;; Created: 2005-12-22
   7 ;; Keywords: internal
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 (substitute-key-definition 'suspend-emacs 'suspend-frame global-map)
  27
  28 (defun terminal-id (terminal)
  29   "Return the numerical id of terminal TERMINAL.
  30
  31 TERMINAL can be a terminal id (an integer), a frame, or
  32 nil (meaning the selected frame's terminal).  Alternatively,
  33 TERMINAL may be the name of an X display
  34 device (HOST.SERVER.SCREEN) or a tty device file."
  35   (cond
  36    ((integerp terminal)
  37     (if (display-live-p terminal)
  38         terminal
  39       (signal 'wrong-type-argument (list 'display-live-p terminal))))
  40    ((or (null terminal) (framep terminal))
  41     (frame-display terminal))
  42    ((stringp terminal)
  43     (let ((f (car (filtered-frame-list (lambda (frame)
  44                                          (or (equal (frame-parameter frame 'display) terminal)
  45                                              (equal (frame-parameter frame 'tty) terminal)))))))
  46       (or f (error "Display %s does not exist" terminal))
  47       (frame-display f)))
  48    (t
  49     (error "Invalid argument %s in `terminal-id'" terminal))))
  50
  51 (defun terminal-getenv (variable &optional terminal global-ok)
  52   "Get the value of VARIABLE in the client environment of TERMINAL.
  53 VARIABLE should be a string.  Value is nil if VARIABLE is undefined in
  54 the environment.  Otherwise, value is a string.
  55
  56 If TERMINAL has an associated emacsclient process, then
  57 `terminal-getenv' looks up VARIABLE in the environment of that
  58 process; otherwise the function consults the global environment,
  59 i.e., the environment of the Emacs process itself.
  60
  61 If GLOBAL-OK is non-nil, and VARIABLE is not defined in the
  62 terminal-local environment, then `terminal-getenv' will return
  63 its value in the global environment instead.
  64
  65 TERMINAL can be a terminal id, a frame, or nil (meaning the
  66 selected frame's terminal)."
  67   (setq terminal (terminal-id terminal))
  68   (if (null (terminal-parameter terminal 'environment))
  69       (getenv variable)
  70     (if (multibyte-string-p variable)
  71         (setq variable (encode-coding-string variable locale-coding-system)))
  72     (let ((env (terminal-parameter terminal 'environment))
  73           result entry)
  74       (while (and env (null result))
  75         (setq entry (car env)
  76               env (cdr env))
  77         (if (and (> (length entry) (length variable))
  78                  (eq ?= (aref entry (length variable)))
  79                  (equal variable (substring entry 0 (length variable))))
  80             (setq result (substring entry (+ (length variable) 1)))))
  81       (if (and global-ok (null result))
  82           (getenv variable)
  83         (and result (decode-coding-string result locale-coding-system))))))
  84
  85 (defun terminal-setenv (variable &optional value terminal)
  86   "Set the value of VARIABLE in the environment of TERMINAL.
  87 VARIABLE should be string.  VALUE is optional; if not provided or
  88 nil, the environment variable VARIABLE is removed.  Returned
  89 value is the new value of VARIABLE, or nil if it was removed from
  90 the environment.
  91
  92 If TERMINAL was created by an emacsclient invocation, then the
  93 variable is set in the environment of the emacsclient process;
  94 otherwise the function changes the environment of the Emacs
  95 process itself.
  96
  97 TERMINAL can be a terminal id, a frame, or nil (meaning the
  98 selected frame's terminal)."
  99   (if (null (terminal-parameter terminal 'environment))
 100       (setenv variable value)
 101     (with-terminal-environment terminal variable
 102       (setenv variable value))))
 103
 104 (defun terminal-setenv-internal (variable value terminal)
 105   "Set the value of VARIABLE in the environment of TERMINAL.
 106 The caller is responsible to ensure that both VARIABLE and VALUE
 107 are usable in environment variables and that TERMINAL is a
 108 remote terminal."
 109   (if (multibyte-string-p variable)
 110       (setq variable (encode-coding-string variable locale-coding-system)))
 111   (if (and value (multibyte-string-p value))
 112       (setq value (encode-coding-string value locale-coding-system)))
 113   (let ((env (terminal-parameter terminal 'environment))
 114         found)
 115     (while (and env (not found))
 116       (if (and (> (length (car env)) (length variable))
 117                  (eq ?= (aref (car env) (length variable)))
 118                  (equal variable (substring (car env) 0 (length variable))))
 119           (progn
 120             (if value
 121                 (setcar env (concat variable "=" value))
 122               (set-terminal-parameter terminal 'environment
 123                                       (delq (car env)
 124                                             (terminal-parameter terminal
 125                                                                 'environment))))
 126             (setq found t))
 127         (setq env (cdr env))))
 128     (cond
 129      ((and value found)
 130       (setcar env (concat variable "=" value)))
 131      ((and value (not found))
 132       (set-terminal-parameter terminal 'environment
 133                               (cons (concat variable "=" value)
 134                                     (terminal-parameter terminal
 135                                                         'environment))))
 136      ((and (not value) found)
 137       (set-terminal-parameter terminal 'environment
 138                               (delq (car env)
 139                                     (terminal-parameter terminal
 140                                                         'environment)))))))
 141
 142 (defmacro with-terminal-environment (terminal vars &rest body)
 143   "Evaluate BODY with environment variables VARS set to those of TERMINAL.
 144 The environment variables are then restored to their previous values.
 145
 146 VARS should be a single string, a list of strings, or t for all
 147 environment variables.
 148
 149 TERMINAL can be a terminal id, a frame, or nil (meaning the
 150 selected frame's terminal).
 151
 152 If BODY uses `setenv' to change environment variables in VARS,
 153 then the new variable values will be remembered for TERMINAL, and
 154 `terminal-getenv' will return them even outside BODY."
 155   (declare (indent 2))
 156   (let ((var (make-symbol "var"))
 157         (term (make-symbol "term"))
 158         (v (make-symbol "v"))
 159         (old-env (make-symbol "old-env")))
 160     `(let ((,term ,terminal)            ; Evaluate arguments only once.
 161            (,v ,vars))
 162        (if (stringp ,v)
 163            (setq ,v (list ,v)))
 164        (cond
 165         ((null (terminal-parameter ,term 'environment))
 166          ;; Not a remote terminal; nothing to do.
 167          (progn ,@body))
 168         ((eq ,v t)
 169          ;; Switch the entire process-environment.
 170          (let (,old-env process-environment)
 171            (setq process-environment (terminal-parameter ,term 'environment))
 172            (unwind-protect
 173                (progn ,@body)
 174              (set-terminal-parameter ,term 'environment process-environment)
 175              (setq process-environment ,old-env))))
 176         (t
 177          ;; Do only a set of variables.
 178          (let (,old-env)
 179            (dolist (,var ,v)
 180              (setq ,old-env (cons (cons ,var (getenv ,var)) ,old-env))
 181              (setenv ,var (terminal-getenv ,var ,term)))
 182            (unwind-protect
 183                (progn ,@body)
 184              ;; Split storing new values and restoring old ones so
 185              ;; that we DTRT even if a variable is specified twice in
 186              ;; VARS.
 187              (dolist (,var ,v)
 188                (terminal-setenv-internal ,var (getenv ,var) ,term))
 189              (dolist (,var ,old-env)
 190                (setenv (car ,var) (cdr ,var))))))))))
 191
 192 (provide 'termdev)
 193
 194 ;;; arch-tag: 4c4df277-1ec1-4f56-bfde-7f156fe62fb2
 195 ;;; termdev.el ends here