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 (&optional 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 (terminal-live-p terminal)
  38         terminal
  39       (signal 'wrong-type-argument (list 'terminal-live-p terminal))))
  40    ((or (null terminal) (framep terminal))
  41     (frame-terminal 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-terminal 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