aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/termdev.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/termdev.el')
-rw-r--r--lisp/termdev.el282
1 files changed, 141 insertions, 141 deletions
diff --git a/lisp/termdev.el b/lisp/termdev.el
index f413067d542..5e12740e11c 100644
--- a/lisp/termdev.el
+++ b/lisp/termdev.el
@@ -25,7 +25,7 @@
25 25
26(substitute-key-definition 'suspend-emacs 'suspend-frame global-map) 26(substitute-key-definition 'suspend-emacs 'suspend-frame global-map)
27 27
28(defun terminal-id (terminal) 28(defun terminal-id (&optional terminal)
29 "Return the numerical id of terminal TERMINAL. 29 "Return the numerical id of terminal TERMINAL.
30 30
31TERMINAL can be a terminal id (an integer), a frame, or 31TERMINAL can be a terminal id (an integer), a frame, or
@@ -48,146 +48,146 @@ device (HOST.SERVER.SCREEN) or a tty device file."
48 (t 48 (t
49 (error "Invalid argument %s in `terminal-id'" terminal)))) 49 (error "Invalid argument %s in `terminal-id'" terminal))))
50 50
51(defun terminal-getenv (variable &optional terminal global-ok) 51;; (defun terminal-getenv (variable &optional terminal global-ok)
52 "Get the value of VARIABLE in the client environment of TERMINAL. 52;; "Get the value of VARIABLE in the client environment of TERMINAL.
53VARIABLE should be a string. Value is nil if VARIABLE is undefined in 53;; VARIABLE should be a string. Value is nil if VARIABLE is undefined in
54the environment. Otherwise, value is a string. 54;; the environment. Otherwise, value is a string.
55 55
56If TERMINAL has an associated emacsclient process, then 56;; If TERMINAL has an associated emacsclient process, then
57`terminal-getenv' looks up VARIABLE in the environment of that 57;; `terminal-getenv' looks up VARIABLE in the environment of that
58process; otherwise the function consults the global environment, 58;; process; otherwise the function consults the global environment,
59i.e., the environment of the Emacs process itself. 59;; i.e., the environment of the Emacs process itself.
60 60
61If GLOBAL-OK is non-nil, and VARIABLE is not defined in the 61;; If GLOBAL-OK is non-nil, and VARIABLE is not defined in the
62terminal-local environment, then `terminal-getenv' will return 62;; terminal-local environment, then `terminal-getenv' will return
63its value in the global environment instead. 63;; its value in the global environment instead.
64 64
65TERMINAL can be a terminal id, a frame, or nil (meaning the 65;; TERMINAL can be a terminal id, a frame, or nil (meaning the
66selected frame's terminal)." 66;; selected frame's terminal)."
67 (setq terminal (terminal-id terminal)) 67;; (setq terminal (terminal-id terminal))
68 (if (null (terminal-parameter terminal 'environment)) 68;; (if (null (terminal-parameter terminal 'environment))
69 (getenv variable) 69;; (getenv variable)
70 (if (multibyte-string-p variable) 70;; (if (multibyte-string-p variable)
71 (setq variable (encode-coding-string variable locale-coding-system))) 71;; (setq variable (encode-coding-string variable locale-coding-system)))
72 (let ((env (terminal-parameter terminal 'environment)) 72;; (let ((env (terminal-parameter terminal 'environment))
73 result entry) 73;; result entry)
74 (while (and env (null result)) 74;; (while (and env (null result))
75 (setq entry (car env) 75;; (setq entry (car env)
76 env (cdr env)) 76;; env (cdr env))
77 (if (and (> (length entry) (length variable)) 77;; (if (and (> (length entry) (length variable))
78 (eq ?= (aref entry (length variable))) 78;; (eq ?= (aref entry (length variable)))
79 (equal variable (substring entry 0 (length variable)))) 79;; (equal variable (substring entry 0 (length variable))))
80 (setq result (substring entry (+ (length variable) 1))))) 80;; (setq result (substring entry (+ (length variable) 1)))))
81 (if (and global-ok (null result)) 81;; (if (and global-ok (null result))
82 (getenv variable) 82;; (getenv variable)
83 (and result (decode-coding-string result locale-coding-system)))))) 83;; (and result (decode-coding-string result locale-coding-system))))))
84 84
85(defun terminal-setenv (variable &optional value terminal) 85;; (defun terminal-setenv (variable &optional value terminal)
86 "Set the value of VARIABLE in the environment of TERMINAL. 86;; "Set the value of VARIABLE in the environment of TERMINAL.
87VARIABLE should be string. VALUE is optional; if not provided or 87;; VARIABLE should be string. VALUE is optional; if not provided or
88nil, the environment variable VARIABLE is removed. Returned 88;; nil, the environment variable VARIABLE is removed. Returned
89value is the new value of VARIABLE, or nil if it was removed from 89;; value is the new value of VARIABLE, or nil if it was removed from
90the environment. 90;; the environment.
91 91
92If TERMINAL was created by an emacsclient invocation, then the 92;; If TERMINAL was created by an emacsclient invocation, then the
93variable is set in the environment of the emacsclient process; 93;; variable is set in the environment of the emacsclient process;
94otherwise the function changes the environment of the Emacs 94;; otherwise the function changes the environment of the Emacs
95process itself. 95;; process itself.
96 96
97TERMINAL can be a terminal id, a frame, or nil (meaning the 97;; TERMINAL can be a terminal id, a frame, or nil (meaning the
98selected frame's terminal)." 98;; selected frame's terminal)."
99 (if (null (terminal-parameter terminal 'environment)) 99;; (if (null (terminal-parameter terminal 'environment))
100 (setenv variable value) 100;; (setenv variable value)
101 (with-terminal-environment terminal variable 101;; (with-terminal-environment terminal variable
102 (setenv variable value)))) 102;; (setenv variable value))))
103 103
104(defun terminal-setenv-internal (variable value terminal) 104;; (defun terminal-setenv-internal (variable value terminal)
105 "Set the value of VARIABLE in the environment of TERMINAL. 105;; "Set the value of VARIABLE in the environment of TERMINAL.
106The caller is responsible to ensure that both VARIABLE and VALUE 106;; The caller is responsible to ensure that both VARIABLE and VALUE
107are usable in environment variables and that TERMINAL is a 107;; are usable in environment variables and that TERMINAL is a
108remote terminal." 108;; remote terminal."
109 (if (multibyte-string-p variable) 109;; (if (multibyte-string-p variable)
110 (setq variable (encode-coding-string variable locale-coding-system))) 110;; (setq variable (encode-coding-string variable locale-coding-system)))
111 (if (and value (multibyte-string-p value)) 111;; (if (and value (multibyte-string-p value))
112 (setq value (encode-coding-string value locale-coding-system))) 112;; (setq value (encode-coding-string value locale-coding-system)))
113 (let ((env (terminal-parameter terminal 'environment)) 113;; (let ((env (terminal-parameter terminal 'environment))
114 found) 114;; found)
115 (while (and env (not found)) 115;; (while (and env (not found))
116 (if (and (> (length (car env)) (length variable)) 116;; (if (and (> (length (car env)) (length variable))
117 (eq ?= (aref (car env) (length variable))) 117;; (eq ?= (aref (car env) (length variable)))
118 (equal variable (substring (car env) 0 (length variable)))) 118;; (equal variable (substring (car env) 0 (length variable))))
119 (progn 119;; (progn
120 (if value 120;; (if value
121 (setcar env (concat variable "=" value)) 121;; (setcar env (concat variable "=" value))
122 (set-terminal-parameter terminal 'environment 122;; (set-terminal-parameter terminal 'environment
123 (delq (car env) 123;; (delq (car env)
124 (terminal-parameter terminal 124;; (terminal-parameter terminal
125 'environment)))) 125;; 'environment))))
126 (setq found t)) 126;; (setq found t))
127 (setq env (cdr env)))) 127;; (setq env (cdr env))))
128 (cond 128;; (cond
129 ((and value found) 129;; ((and value found)
130 (setcar env (concat variable "=" value))) 130;; (setcar env (concat variable "=" value)))
131 ((and value (not found)) 131;; ((and value (not found))
132 (set-terminal-parameter terminal 'environment 132;; (set-terminal-parameter terminal 'environment
133 (cons (concat variable "=" value) 133;; (cons (concat variable "=" value)
134 (terminal-parameter terminal 134;; (terminal-parameter terminal
135 'environment)))) 135;; 'environment))))
136 ((and (not value) found) 136;; ((and (not value) found)
137 (set-terminal-parameter terminal 'environment 137;; (set-terminal-parameter terminal 'environment
138 (delq (car env) 138;; (delq (car env)
139 (terminal-parameter terminal 139;; (terminal-parameter terminal
140 'environment))))))) 140;; 'environment)))))))
141 141
142(defmacro with-terminal-environment (terminal vars &rest body) 142;; (defmacro with-terminal-environment (terminal vars &rest body)
143 "Evaluate BODY with environment variables VARS set to those of TERMINAL. 143;; "Evaluate BODY with environment variables VARS set to those of TERMINAL.
144The environment variables are then restored to their previous values. 144;; The environment variables are then restored to their previous values.
145 145
146VARS should be a single string, a list of strings, or t for all 146;; VARS should be a single string, a list of strings, or t for all
147environment variables. 147;; environment variables.
148 148
149TERMINAL can be a terminal id, a frame, or nil (meaning the 149;; TERMINAL can be a terminal id, a frame, or nil (meaning the
150selected frame's terminal). 150;; selected frame's terminal).
151 151
152If BODY uses `setenv' to change environment variables in VARS, 152;; If BODY uses `setenv' to change environment variables in VARS,
153then the new variable values will be remembered for TERMINAL, and 153;; then the new variable values will be remembered for TERMINAL, and
154`terminal-getenv' will return them even outside BODY." 154;; `terminal-getenv' will return them even outside BODY."
155 (declare (indent 2)) 155;; (declare (indent 2))
156 (let ((var (make-symbol "var")) 156;; (let ((var (make-symbol "var"))
157 (term (make-symbol "term")) 157;; (term (make-symbol "term"))
158 (v (make-symbol "v")) 158;; (v (make-symbol "v"))
159 (old-env (make-symbol "old-env"))) 159;; (old-env (make-symbol "old-env")))
160 `(let ((,term ,terminal) ; Evaluate arguments only once. 160;; `(let ((,term ,terminal) ; Evaluate arguments only once.
161 (,v ,vars)) 161;; (,v ,vars))
162 (if (stringp ,v) 162;; (if (stringp ,v)
163 (setq ,v (list ,v))) 163;; (setq ,v (list ,v)))
164 (cond 164;; (cond
165 ((null (terminal-parameter ,term 'environment)) 165;; ((null (terminal-parameter ,term 'environment))
166 ;; Not a remote terminal; nothing to do. 166;; ;; Not a remote terminal; nothing to do.
167 (progn ,@body)) 167;; (progn ,@body))
168 ((eq ,v t) 168;; ((eq ,v t)
169 ;; Switch the entire process-environment. 169;; ;; Switch the entire process-environment.
170 (let (,old-env process-environment) 170;; (let (,old-env process-environment)
171 (setq process-environment (terminal-parameter ,term 'environment)) 171;; (setq process-environment (terminal-parameter ,term 'environment))
172 (unwind-protect 172;; (unwind-protect
173 (progn ,@body) 173;; (progn ,@body)
174 (set-terminal-parameter ,term 'environment process-environment) 174;; (set-terminal-parameter ,term 'environment process-environment)
175 (setq process-environment ,old-env)))) 175;; (setq process-environment ,old-env))))
176 (t 176;; (t
177 ;; Do only a set of variables. 177;; ;; Do only a set of variables.
178 (let (,old-env) 178;; (let (,old-env)
179 (dolist (,var ,v) 179;; (dolist (,var ,v)
180 (setq ,old-env (cons (cons ,var (getenv ,var)) ,old-env)) 180;; (setq ,old-env (cons (cons ,var (getenv ,var)) ,old-env))
181 (setenv ,var (terminal-getenv ,var ,term))) 181;; (setenv ,var (terminal-getenv ,var ,term)))
182 (unwind-protect 182;; (unwind-protect
183 (progn ,@body) 183;; (progn ,@body)
184 ;; Split storing new values and restoring old ones so 184;; ;; Split storing new values and restoring old ones so
185 ;; that we DTRT even if a variable is specified twice in 185;; ;; that we DTRT even if a variable is specified twice in
186 ;; VARS. 186;; ;; VARS.
187 (dolist (,var ,v) 187;; (dolist (,var ,v)
188 (terminal-setenv-internal ,var (getenv ,var) ,term)) 188;; (terminal-setenv-internal ,var (getenv ,var) ,term))
189 (dolist (,var ,old-env) 189;; (dolist (,var ,old-env)
190 (setenv (car ,var) (cdr ,var)))))))))) 190;; (setenv (car ,var) (cdr ,var))))))))))
191 191
192(provide 'termdev) 192(provide 'termdev)
193 193
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-18 14:28:35 +0000