aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/termdev.el
blob: 667975b9b8bd73295ae3c661e3abce2c10d6995e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
;;; termdev.el --- functions for dealing with terminals

;; Copyright (C) 2005 Free Software Foundation, Inc.

;; Author: Karoly Lorentey <[email protected]>
;; 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