]> code.delx.au - gnu-emacs/blob - lisp/term/xterm.el
Merge from emacs-24; up to 2014-05-08T06:58:46Z!rgm@gnu.org
[gnu-emacs] / lisp / term / xterm.el
1 ;;; xterm.el --- define function key sequences and standard colors for xterm -*- lexical-binding: t -*-
2
3 ;; Copyright (C) 1995, 2001-2014 Free Software Foundation, Inc.
4
5 ;; Author: FSF
6 ;; Keywords: terminals
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23 ;;; Commentary:
24
25 ;;; Code:
26
27 (defgroup xterm nil
28 "XTerm support."
29 :version "24.1"
30 :group 'terminals)
31
32 (defcustom xterm-extra-capabilities 'check
33 "Whether Xterm supports some additional, more modern, features.
34 If nil, just assume that it does not.
35 If `check', try to check if it does.
36 If a list, assume that the listed features are supported, without checking.
37
38 The relevant features are:
39 modifyOtherKeys -- if supported, more key bindings work (e.g., \"\\C-,\")
40 reportBackground -- if supported, Xterm reports its background color"
41 :version "24.1"
42 :group 'xterm
43 :type '(choice (const :tag "No" nil)
44 (const :tag "Check" check)
45 ;; NOTE: If you add entries here, make sure to update
46 ;; `terminal-init-xterm' as well.
47 (set (const :tag "modifyOtherKeys support" modifyOtherKeys)
48 (const :tag "report background" reportBackground))))
49
50 (defconst xterm-paste-ending-sequence "\e[201~"
51 "Characters send by the terminal to end a bracketed paste.")
52
53 (defun xterm-paste ()
54 "Handle the start of a terminal paste operation."
55 (interactive)
56 (let* ((end-marker-length (length xterm-paste-ending-sequence))
57 (pasted-text (with-temp-buffer
58 (set-buffer-multibyte nil)
59 (while (not (search-backward
60 xterm-paste-ending-sequence
61 (- (point) end-marker-length) t))
62 (let ((event (read-event
63 nil nil
64 ;; Use finite timeout to avoid
65 ;; glomming the event onto
66 ;; this-command-keys.
67 most-positive-fixnum)))
68 (when (eql event ?\r)
69 (setf event ?\n))
70 (insert event)))
71 (let ((last-coding-system-used))
72 (decode-coding-region
73 (point-min) (point)
74 (keyboard-coding-system) t))))
75 (interprogram-paste-function (lambda () pasted-text)))
76 (yank)))
77
78 (define-key global-map [xterm-paste] #'xterm-paste)
79
80 (defvar xterm-function-map
81 (let ((map (make-sparse-keymap)))
82
83 ;; xterm from X.org 6.8.2 uses these key definitions.
84 (define-key map "\eOP" [f1])
85 (define-key map "\eOQ" [f2])
86 (define-key map "\eOR" [f3])
87 (define-key map "\eOS" [f4])
88 (define-key map "\e[15~" [f5])
89 (define-key map "\e[17~" [f6])
90 (define-key map "\e[18~" [f7])
91 (define-key map "\e[19~" [f8])
92 (define-key map "\e[20~" [f9])
93 (define-key map "\e[21~" [f10])
94 (define-key map "\e[23~" [f11])
95 (define-key map "\e[24~" [f12])
96
97 (define-key map "\eO2P" [S-f1])
98 (define-key map "\eO2Q" [S-f2])
99 (define-key map "\eO2R" [S-f3])
100 (define-key map "\eO2S" [S-f4])
101 (define-key map "\e[1;2P" [S-f1])
102 (define-key map "\e[1;2Q" [S-f2])
103 (define-key map "\e[1;2R" [S-f3])
104 (define-key map "\e[1;2S" [S-f4])
105 (define-key map "\e[15;2~" [S-f5])
106 (define-key map "\e[17;2~" [S-f6])
107 (define-key map "\e[18;2~" [S-f7])
108 (define-key map "\e[19;2~" [S-f8])
109 (define-key map "\e[20;2~" [S-f9])
110 (define-key map "\e[21;2~" [S-f10])
111 (define-key map "\e[23;2~" [S-f11])
112 (define-key map "\e[24;2~" [S-f12])
113
114 (define-key map "\eO5P" [C-f1])
115 (define-key map "\eO5Q" [C-f2])
116 (define-key map "\eO5R" [C-f3])
117 (define-key map "\eO5S" [C-f4])
118 (define-key map "\e[15;5~" [C-f5])
119 (define-key map "\e[17;5~" [C-f6])
120 (define-key map "\e[18;5~" [C-f7])
121 (define-key map "\e[19;5~" [C-f8])
122 (define-key map "\e[20;5~" [C-f9])
123 (define-key map "\e[21;5~" [C-f10])
124 (define-key map "\e[23;5~" [C-f11])
125 (define-key map "\e[24;5~" [C-f12])
126
127 (define-key map "\eO6P" [C-S-f1])
128 (define-key map "\eO6Q" [C-S-f2])
129 (define-key map "\eO6R" [C-S-f3])
130 (define-key map "\eO6S" [C-S-f4])
131 (define-key map "\e[15;6~" [C-S-f5])
132 (define-key map "\e[17;6~" [C-S-f6])
133 (define-key map "\e[18;6~" [C-S-f7])
134 (define-key map "\e[19;6~" [C-S-f8])
135 (define-key map "\e[20;6~" [C-S-f9])
136 (define-key map "\e[21;6~" [C-S-f10])
137 (define-key map "\e[23;6~" [C-S-f11])
138 (define-key map "\e[24;6~" [C-S-f12])
139
140 (define-key map "\eO3P" [M-f1])
141 (define-key map "\eO3Q" [M-f2])
142 (define-key map "\eO3R" [M-f3])
143 (define-key map "\eO3S" [M-f4])
144 (define-key map "\e[15;3~" [M-f5])
145 (define-key map "\e[17;3~" [M-f6])
146 (define-key map "\e[18;3~" [M-f7])
147 (define-key map "\e[19;3~" [M-f8])
148 (define-key map "\e[20;3~" [M-f9])
149 (define-key map "\e[21;3~" [M-f10])
150 (define-key map "\e[23;3~" [M-f11])
151 (define-key map "\e[24;3~" [M-f12])
152
153 (define-key map "\eO4P" [M-S-f1])
154 (define-key map "\eO4Q" [M-S-f2])
155 (define-key map "\eO4R" [M-S-f3])
156 (define-key map "\eO4S" [M-S-f4])
157 (define-key map "\e[15;4~" [M-S-f5])
158 (define-key map "\e[17;4~" [M-S-f6])
159 (define-key map "\e[18;4~" [M-S-f7])
160 (define-key map "\e[19;4~" [M-S-f8])
161 (define-key map "\e[20;4~" [M-S-f9])
162 (define-key map "\e[21;4~" [M-S-f10])
163 (define-key map "\e[23;4~" [M-S-f11])
164 (define-key map "\e[24;4~" [M-S-f12])
165
166 (define-key map "\eOA" [up])
167 (define-key map "\eOB" [down])
168 (define-key map "\eOC" [right])
169 (define-key map "\eOD" [left])
170 (define-key map "\eOF" [end])
171 (define-key map "\eOH" [home])
172
173 (define-key map "\e[1;2A" [S-up])
174 (define-key map "\e[1;2B" [S-down])
175 (define-key map "\e[1;2C" [S-right])
176 (define-key map "\e[1;2D" [S-left])
177 (define-key map "\e[1;2F" [S-end])
178 (define-key map "\e[1;2H" [S-home])
179
180 (define-key map "\e[1;4A" [M-S-up])
181 (define-key map "\e[1;4B" [M-S-down])
182 (define-key map "\e[1;4C" [M-S-right])
183 (define-key map "\e[1;4D" [M-S-left])
184 (define-key map "\e[1;4F" [M-S-end])
185 (define-key map "\e[1;4H" [M-S-home])
186
187 (define-key map "\e[1;5A" [C-up])
188 (define-key map "\e[1;5B" [C-down])
189 (define-key map "\e[1;5C" [C-right])
190 (define-key map "\e[1;5D" [C-left])
191 (define-key map "\e[1;5F" [C-end])
192 (define-key map "\e[1;5H" [C-home])
193
194 (define-key map "\e[1;6A" [C-S-up])
195 (define-key map "\e[1;6B" [C-S-down])
196 (define-key map "\e[1;6C" [C-S-right])
197 (define-key map "\e[1;6D" [C-S-left])
198 (define-key map "\e[1;6F" [C-S-end])
199 (define-key map "\e[1;6H" [C-S-home])
200
201 (define-key map "\e[1;7A" [C-M-up])
202 (define-key map "\e[1;7B" [C-M-down])
203 (define-key map "\e[1;7C" [C-M-right])
204 (define-key map "\e[1;7D" [C-M-left])
205 (define-key map "\e[1;7F" [C-M-end])
206 (define-key map "\e[1;7H" [C-M-home])
207
208 (define-key map "\e[1;8A" [C-M-S-up])
209 (define-key map "\e[1;8B" [C-M-S-down])
210 (define-key map "\e[1;8C" [C-M-S-right])
211 (define-key map "\e[1;8D" [C-M-S-left])
212 (define-key map "\e[1;8F" [C-M-S-end])
213 (define-key map "\e[1;8H" [C-M-S-home])
214
215 (define-key map "\e[1;3A" [M-up])
216 (define-key map "\e[1;3B" [M-down])
217 (define-key map "\e[1;3C" [M-right])
218 (define-key map "\e[1;3D" [M-left])
219 (define-key map "\e[1;3F" [M-end])
220 (define-key map "\e[1;3H" [M-home])
221
222 (define-key map "\e[2~" [insert])
223 (define-key map "\e[3~" [delete])
224 (define-key map "\e[5~" [prior])
225 (define-key map "\e[6~" [next])
226
227 (define-key map "\e[2;2~" [S-insert])
228 (define-key map "\e[3;2~" [S-delete])
229 (define-key map "\e[5;2~" [S-prior])
230 (define-key map "\e[6;2~" [S-next])
231
232 (define-key map "\e[2;4~" [M-S-insert])
233 (define-key map "\e[3;4~" [M-S-delete])
234 (define-key map "\e[5;4~" [M-S-prior])
235 (define-key map "\e[6;4~" [M-S-next])
236
237 (define-key map "\e[2;5~" [C-insert])
238 (define-key map "\e[3;5~" [C-delete])
239 (define-key map "\e[5;5~" [C-prior])
240 (define-key map "\e[6;5~" [C-next])
241
242 (define-key map "\e[2;6~" [C-S-insert])
243 (define-key map "\e[3;6~" [C-S-delete])
244 (define-key map "\e[5;6~" [C-S-prior])
245 (define-key map "\e[6;6~" [C-S-next])
246
247 (define-key map "\e[2;7~" [C-M-insert])
248 (define-key map "\e[3;7~" [C-M-delete])
249 (define-key map "\e[5;7~" [C-M-prior])
250 (define-key map "\e[6;7~" [C-M-next])
251
252 (define-key map "\e[2;8~" [C-M-S-insert])
253 (define-key map "\e[3;8~" [C-M-S-delete])
254 (define-key map "\e[5;8~" [C-M-S-prior])
255 (define-key map "\e[6;8~" [C-M-S-next])
256
257 (define-key map "\e[2;3~" [M-insert])
258 (define-key map "\e[3;3~" [M-delete])
259 (define-key map "\e[5;3~" [M-prior])
260 (define-key map "\e[6;3~" [M-next])
261
262 (define-key map "\e[4~" [select])
263 (define-key map "\e[29~" [print])
264
265 (define-key map "\eOj" [kp-multiply])
266 (define-key map "\eOk" [kp-add])
267 (define-key map "\eOl" [kp-separator])
268 (define-key map "\eOm" [kp-subtract])
269 (define-key map "\eOo" [kp-divide])
270 (define-key map "\eOp" [kp-0])
271 (define-key map "\eOq" [kp-1])
272 (define-key map "\eOr" [kp-2])
273 (define-key map "\eOs" [kp-3])
274 (define-key map "\eOt" [kp-4])
275 (define-key map "\eOu" [kp-5])
276 (define-key map "\eOv" [kp-6])
277 (define-key map "\eOw" [kp-7])
278 (define-key map "\eOx" [kp-8])
279 (define-key map "\eOy" [kp-9])
280
281 ;; These keys are available in xterm starting from version 216
282 ;; if the modifyOtherKeys resource is set to 1.
283 (dolist (bind '((5 9 [C-tab])
284 (5 13 [C-return])
285 (5 39 [?\C-\'])
286 (5 44 [?\C-,])
287 (5 45 [?\C--])
288 (5 46 [?\C-.])
289 (5 47 [?\C-/])
290 (5 48 [?\C-0])
291 (5 49 [?\C-1])
292 ;; Not all C-DIGIT keys have a distinct binding.
293 (5 57 [?\C-9])
294 (5 59 [?\C-\;])
295 (5 61 [?\C-=])
296 (5 92 [?\C-\\])
297
298 (6 33 [?\C-!])
299 (6 34 [?\C-\"])
300 (6 35 [?\C-#])
301 (6 36 [?\C-$])
302 (6 37 [?\C-%])
303 (6 38 [?\C-&])
304 (6 40 [?\C-\(])
305 (6 41 [?\C-\)])
306 (6 42 [?\C-*])
307 (6 43 [?\C-+])
308 (6 58 [?\C-:])
309 (6 60 [?\C-<])
310 (6 62 [?\C->])
311 (6 63 [(control ??)])
312
313 ;; These are the strings emitted for various C-M-
314 ;; combinations for keyboards whose Meta and Alt
315 ;; modifiers are on the same key (usually labeled "Alt").
316 (13 9 [C-M-tab])
317 (13 13 [C-M-return])
318
319 (13 39 [?\C-\M-\'])
320 (13 44 [?\C-\M-,])
321 (13 45 [?\C-\M--])
322 (13 46 [?\C-\M-.])
323 (13 47 [?\C-\M-/])
324 (13 48 [?\C-\M-0])
325 (13 49 [?\C-\M-1])
326 (13 50 [?\C-\M-2])
327 (13 51 [?\C-\M-3])
328 (13 52 [?\C-\M-4])
329 (13 53 [?\C-\M-5])
330 (13 54 [?\C-\M-6])
331 (13 55 [?\C-\M-7])
332 (13 56 [?\C-\M-8])
333 (13 57 [?\C-\M-9])
334 (13 59 [?\C-\M-\;])
335 (13 61 [?\C-\M-=])
336 (13 92 [?\C-\M-\\])
337
338 (14 33 [?\C-\M-!])
339 (14 34 [?\C-\M-\"])
340 (14 35 [?\C-\M-#])
341 (14 36 [?\C-\M-$])
342 (14 37 [?\C-\M-%])
343 (14 38 [?\C-\M-&])
344 (14 40 [?\C-\M-\(])
345 (14 41 [?\C-\M-\)])
346 (14 42 [?\C-\M-*])
347 (14 43 [?\C-\M-+])
348 (14 58 [?\C-\M-:])
349 (14 60 [?\C-\M-<])
350 (14 62 [?\C-\M->])
351 (14 63 [(control meta ??)])
352
353 (7 9 [C-M-tab])
354 (7 13 [C-M-return])
355
356 (7 32 [?\C-\M-\s])
357 (7 39 [?\C-\M-\'])
358 (7 44 [?\C-\M-,])
359 (7 45 [?\C-\M--])
360 (7 46 [?\C-\M-.])
361 (7 47 [?\C-\M-/])
362 (7 48 [?\C-\M-0])
363 (7 49 [?\C-\M-1])
364 (7 50 [?\C-\M-2])
365 (7 51 [?\C-\M-3])
366 (7 52 [?\C-\M-4])
367 (7 53 [?\C-\M-5])
368 (7 54 [?\C-\M-6])
369 (7 55 [?\C-\M-7])
370 (7 56 [?\C-\M-8])
371 (7 57 [?\C-\M-9])
372 (7 59 [?\C-\M-\;])
373 (7 61 [?\C-\M-=])
374 (7 92 [?\C-\M-\\])
375
376 (8 33 [?\C-\M-!])
377 (8 34 [?\C-\M-\"])
378 (8 35 [?\C-\M-#])
379 (8 36 [?\C-\M-$])
380 (8 37 [?\C-\M-%])
381 (8 38 [?\C-\M-&])
382 (8 40 [?\C-\M-\(])
383 (8 41 [?\C-\M-\)])
384 (8 42 [?\C-\M-*])
385 (8 43 [?\C-\M-+])
386 (8 58 [?\C-\M-:])
387 (8 60 [?\C-\M-<])
388 (8 62 [?\C-\M->])
389 (8 63 [(control meta ??)])
390
391 (2 9 [S-tab])
392 (2 13 [S-return])
393
394 (6 9 [C-S-tab])
395 (6 13 [C-S-return])))
396 (define-key map
397 (format "\e[27;%d;%d~" (nth 0 bind) (nth 1 bind)) (nth 2 bind))
398 ;; For formatOtherKeys=1, the sequence is a bit shorter (bug#13839).
399 (define-key map
400 (format "\e[%d;%du" (nth 1 bind) (nth 0 bind)) (nth 2 bind)))
401
402 ;; Other versions of xterm might emit these.
403 (define-key map "\e[A" [up])
404 (define-key map "\e[B" [down])
405 (define-key map "\e[C" [right])
406 (define-key map "\e[D" [left])
407 (define-key map "\e[1~" [home])
408
409 (define-key map "\eO2A" [S-up])
410 (define-key map "\eO2B" [S-down])
411 (define-key map "\eO2C" [S-right])
412 (define-key map "\eO2D" [S-left])
413 (define-key map "\eO2F" [S-end])
414 (define-key map "\eO2H" [S-home])
415
416 (define-key map "\eO5A" [C-up])
417 (define-key map "\eO5B" [C-down])
418 (define-key map "\eO5C" [C-right])
419 (define-key map "\eO5D" [C-left])
420 (define-key map "\eO5F" [C-end])
421 (define-key map "\eO5H" [C-home])
422
423 (define-key map "\e[11~" [f1])
424 (define-key map "\e[12~" [f2])
425 (define-key map "\e[13~" [f3])
426 (define-key map "\e[14~" [f4])
427
428 ;; Recognize the start of a bracketed paste sequence. The handler
429 ;; internally recognizes the end.
430 (define-key map "\e[200~" [xterm-paste])
431
432 map)
433 "Function key map overrides for xterm.")
434
435 (defvar xterm-alternatives-map
436 (let ((map (make-sparse-keymap)))
437 ;; The terminal initialization C code file might have initialized
438 ;; function keys F13->F60 from the termcap/terminfo information.
439 ;; On a PC-style keyboard these keys correspond to
440 ;; MODIFIER-FUNCTION_KEY, where modifier is S-, C, A-, C-S-. The code
441 ;; here substitutes the corresponding definitions in function-key-map.
442 ;; The mapping from escape sequences to Fn is done in input-decode-map
443 ;; whereas this here mapping is done in local-function-key-map so that
444 ;; bindings to f45 still work, in case your keyboard really has an f45
445 ;; key rather than C-S-f9.
446 (define-key map [f13] [S-f1])
447 (define-key map [f14] [S-f2])
448 (define-key map [f15] [S-f3])
449 (define-key map [f16] [S-f4])
450 (define-key map [f17] [S-f5])
451 (define-key map [f18] [S-f6])
452 (define-key map [f19] [S-f7])
453 (define-key map [f20] [S-f8])
454 (define-key map [f21] [S-f9])
455 (define-key map [f22] [S-f10])
456 (define-key map [f23] [S-f11])
457 (define-key map [f24] [S-f12])
458
459 (define-key map [f25] [C-f1])
460 (define-key map [f26] [C-f2])
461 (define-key map [f27] [C-f3])
462 (define-key map [f28] [C-f4])
463 (define-key map [f29] [C-f5])
464 (define-key map [f30] [C-f6])
465 (define-key map [f31] [C-f7])
466 (define-key map [f32] [C-f8])
467 (define-key map [f33] [C-f9])
468 (define-key map [f34] [C-f10])
469 (define-key map [f35] [C-f11])
470 (define-key map [f36] [C-f12])
471
472 (define-key map [f37] [C-S-f1])
473 (define-key map [f38] [C-S-f2])
474 (define-key map [f39] [C-S-f3])
475 (define-key map [f40] [C-S-f4])
476 (define-key map [f41] [C-S-f5])
477 (define-key map [f42] [C-S-f6])
478 (define-key map [f43] [C-S-f7])
479 (define-key map [f44] [C-S-f8])
480 (define-key map [f45] [C-S-f9])
481 (define-key map [f46] [C-S-f10])
482 (define-key map [f47] [C-S-f11])
483 (define-key map [f48] [C-S-f12])
484
485 (define-key map [f49] [M-f1])
486 (define-key map [f50] [M-f2])
487 (define-key map [f51] [M-f3])
488 (define-key map [f52] [M-f4])
489 (define-key map [f53] [M-f5])
490 (define-key map [f54] [M-f6])
491 (define-key map [f55] [M-f7])
492 (define-key map [f56] [M-f8])
493 (define-key map [f57] [M-f9])
494 (define-key map [f58] [M-f10])
495 (define-key map [f59] [M-f11])
496 (define-key map [f60] [M-f12])
497
498 map)
499 "Keymap of possible alternative meanings for some keys.")
500
501 (defun xterm--report-background-handler ()
502 (let ((str "")
503 chr)
504 ;; The reply should be: \e ] 11 ; rgb: NUMBER1 / NUMBER2 / NUMBER3 \e \\
505 (while (and (setq chr (read-event nil nil 2)) (not (equal chr ?\\)))
506 (setq str (concat str (string chr))))
507 (when (string-match
508 "rgb:\\([a-f0-9]+\\)/\\([a-f0-9]+\\)/\\([a-f0-9]+\\)" str)
509 (let ((recompute-faces
510 (xterm-maybe-set-dark-background-mode
511 (string-to-number (match-string 1 str) 16)
512 (string-to-number (match-string 2 str) 16)
513 (string-to-number (match-string 3 str) 16))))
514
515 ;; Recompute faces here in case the background mode was
516 ;; set to dark. We used to call
517 ;; `tty-set-up-initial-frame-faces' only once, but that
518 ;; caused the light background faces to be computed
519 ;; incorrectly. See:
520 ;; http://permalink.gmane.org/gmane.emacs.devel/119627
521 (when recompute-faces
522 (tty-set-up-initial-frame-faces))))))
523
524 (defun xterm--version-handler ()
525 (let ((str "")
526 chr)
527 ;; The reply should be: \e [ > NUMBER1 ; NUMBER2 ; NUMBER3 c
528 ;; If the timeout is completely removed for read-event, this
529 ;; might hang for terminals that pretend to be xterm, but don't
530 ;; respond to this escape sequence. RMS' opinion was to remove
531 ;; it completely. That might be right, but let's first try to
532 ;; see if by using a longer timeout we get rid of most issues.
533 (while (and (setq chr (read-event nil nil 2)) (not (equal chr ?c)))
534 (setq str (concat str (string chr))))
535 ;; Since xterm-280, the terminal type (NUMBER1) is now 41 instead of 0.
536 (when (string-match "\\([0-9]+\\);\\([0-9]+\\);0" str)
537 (let ((version (string-to-number (match-string 2 str))))
538 (when (and (> version 2000) (equal (match-string 1 str) "1"))
539 ;; Hack attack! bug#16988: gnome-terminal reports "1;NNNN;0"
540 ;; with a large NNNN but is based on a rather old xterm code.
541 ;; Gnome terminal 3.6.1 reports 1;3406;0
542 ;; Gnome terminal 2.32.1 reports 1;2802;0
543 (setq version 200))
544 ;; If version is 242 or higher, assume the xterm supports
545 ;; reporting the background color (TODO: maybe earlier
546 ;; versions do too...)
547 (when (>= version 242)
548 (xterm--query "\e]11;?\e\\"
549 '(("\e]11;" . xterm--report-background-handler))))
550
551 ;; If version is 216 (the version when modifyOtherKeys was
552 ;; introduced) or higher, initialize the
553 ;; modifyOtherKeys support.
554 (when (>= version 216)
555 (terminal-init-xterm-modify-other-keys))))))
556
557 (defun xterm--query (query handlers)
558 "Send QUERY string to the terminal and watch for a response.
559 HANDLERS is an alist with elements of the form (STRING . FUNCTION).
560 We run the first FUNCTION whose STRING matches the input events."
561 ;; We used to query synchronously, but the need to use `discard-input' is
562 ;; rather annoying (bug#6758). Maybe we could always use the asynchronous
563 ;; approach, but it's less tested.
564 ;; FIXME: Merge the two branches.
565 (if (input-pending-p)
566 (progn
567 (dolist (handler handlers)
568 (define-key input-decode-map (car handler)
569 (lambda (&optional _prompt)
570 ;; Unregister the handler, since we don't expect further answers.
571 (dolist (handler handlers)
572 (define-key input-decode-map (car handler) nil))
573 (funcall (cdr handler))
574 [])))
575 (send-string-to-terminal query))
576 ;; Pending input can be mistakenly returned by the calls to
577 ;; read-event below. Discard it.
578 (send-string-to-terminal query)
579 (while handlers
580 (let ((handler (pop handlers))
581 (i 0))
582 (while (and (< i (length (car handler)))
583 (let ((evt (read-event nil nil 2)))
584 (or (eq evt (aref (car handler) i))
585 (progn (if evt (push evt unread-command-events))
586 nil))))
587 (setq i (1+ i)))
588 (if (= i (length (car handler)))
589 (progn (setq handlers nil)
590 (funcall (cdr handler)))
591 (while (> i 0)
592 (push (aref (car handler) (setq i (1- i)))
593 unread-command-events)))))))
594
595 (defun terminal-init-xterm ()
596 "Terminal initialization function for xterm."
597 ;; rxvt terminals sometimes set the TERM variable to "xterm", but
598 ;; rxvt's keybindings are incompatible with xterm's. It is
599 ;; better in that case to use rxvt's initialization function.
600 (if (and (getenv "COLORTERM" (selected-frame))
601 (string-match "\\`rxvt" (getenv "COLORTERM" (selected-frame))))
602 (tty-run-terminal-initialization (selected-frame) "rxvt")
603
604 (let ((map (copy-keymap xterm-alternatives-map)))
605 (set-keymap-parent map (keymap-parent local-function-key-map))
606 (set-keymap-parent local-function-key-map map))
607
608 (let ((map (copy-keymap xterm-function-map)))
609
610 ;; Use inheritance to let the main keymap override those defaults.
611 ;; This way we don't override terminfo-derived settings or settings
612 ;; made in the init file.
613 (set-keymap-parent map (keymap-parent input-decode-map))
614 (set-keymap-parent input-decode-map map)))
615
616 (xterm-register-default-colors)
617 (tty-set-up-initial-frame-faces)
618
619 (if (eq xterm-extra-capabilities 'check)
620 ;; Try to find out the type of terminal by sending a "Secondary
621 ;; Device Attributes (DA)" query.
622 (xterm--query "\e[>0c"
623 ;; Some terminals (like OS X's Terminal.app) respond to
624 ;; this query as if it were a "Primary Device Attributes"
625 ;; query instead, so we should handle that too.
626 '(("\e[?" . xterm--version-handler)
627 ("\e[>" . xterm--version-handler)))
628
629 (when (memq 'reportBackground xterm-extra-capabilities)
630 (xterm--query "\e]11;?\e\\"
631 '(("\e]11;" . xterm--report-background-handler))))
632
633 (when (memq 'modifyOtherKeys xterm-extra-capabilities)
634 (terminal-init-xterm-modify-other-keys)))
635
636 ;; Unconditionally enable bracketed paste mode: terminals that don't
637 ;; support it just ignore the sequence.
638 (terminal-init-xterm-bracketed-paste-mode)
639
640 (run-hooks 'terminal-init-xterm-hook))
641
642 (defun terminal-init-xterm-modify-other-keys ()
643 "Terminal initialization for xterm's modifyOtherKeys support."
644 (send-string-to-terminal "\e[>4;1m")
645 (push "\e[>4m" (terminal-parameter nil 'tty-mode-reset-strings))
646 (push "\e[>4;1m" (terminal-parameter nil 'tty-mode-set-strings)))
647
648 (defun terminal-init-xterm-bracketed-paste-mode ()
649 "Terminal initialization for bracketed paste mode."
650 (send-string-to-terminal "\e[?2004h")
651 (push "\e[?2004l" (terminal-parameter nil 'tty-mode-reset-strings))
652 (push "\e[?2004h" (terminal-parameter nil 'tty-mode-set-strings)))
653
654 ;; Set up colors, for those versions of xterm that support it.
655 (defvar xterm-standard-colors
656 ;; The names in the comments taken from XTerm-col.ad in the xterm
657 ;; distribution, see ftp://dickey.his.com/xterm/. RGB values are
658 ;; from rgb.txt.
659 '(("black" 0 ( 0 0 0)) ; black
660 ("red" 1 (205 0 0)) ; red3
661 ("green" 2 ( 0 205 0)) ; green3
662 ("yellow" 3 (205 205 0)) ; yellow3
663 ("blue" 4 ( 0 0 238)) ; blue2
664 ("magenta" 5 (205 0 205)) ; magenta3
665 ("cyan" 6 ( 0 205 205)) ; cyan3
666 ("white" 7 (229 229 229)) ; gray90
667 ("brightblack" 8 (127 127 127)) ; gray50
668 ("brightred" 9 (255 0 0)) ; red
669 ("brightgreen" 10 ( 0 255 0)) ; green
670 ("brightyellow" 11 (255 255 0)) ; yellow
671 ("brightblue" 12 (92 92 255)) ; rgb:5c/5c/ff
672 ("brightmagenta" 13 (255 0 255)) ; magenta
673 ("brightcyan" 14 ( 0 255 255)) ; cyan
674 ("brightwhite" 15 (255 255 255))) ; white
675 "Names of 16 standard xterm/aixterm colors, their numbers, and RGB values.")
676
677 (defun xterm-rgb-convert-to-16bit (prim)
678 "Convert an 8-bit primary color value PRIM to a corresponding 16-bit value."
679 (logior prim (lsh prim 8)))
680
681 (defun xterm-register-default-colors ()
682 "Register the default set of colors for xterm or compatible emulator.
683
684 This function registers the number of colors returned by `display-color-cells'
685 for the currently selected frame. The first 16 colors are taken from
686 `xterm-standard-colors', which see, while the rest are computed assuming
687 either the 88- or 256-color standard color scheme supported by latest
688 versions of xterm."
689 (let* ((ncolors (display-color-cells (selected-frame)))
690 (colors xterm-standard-colors)
691 (color (car colors)))
692 (if (> ncolors 0)
693 ;; Clear the 8 default tty colors registered by startup.el
694 (tty-color-clear))
695 ;; Only register as many colors as are supported by the display.
696 (while (and (> ncolors 0) colors)
697 (tty-color-define (car color) (cadr color)
698 (mapcar 'xterm-rgb-convert-to-16bit
699 (car (cddr color))))
700 (setq colors (cdr colors)
701 color (car colors)
702 ncolors (1- ncolors)))
703 ;; We've exhausted the colors from `xterm-standard-colors'. If there
704 ;; are more colors to support, compute them now.
705 (when (> ncolors 0)
706 (cond
707 ((= ncolors 240) ; 256-color xterm
708 ;; 216 non-gray colors first
709 (let ((r 0) (g 0) (b 0))
710 (while (> ncolors 24)
711 ;; This and other formulas taken from 256colres.pl and
712 ;; 88colres.pl in the xterm distribution.
713 (tty-color-define (format "color-%d" (- 256 ncolors))
714 (- 256 ncolors)
715 (mapcar 'xterm-rgb-convert-to-16bit
716 (list (if (zerop r) 0 (+ (* r 40) 55))
717 (if (zerop g) 0 (+ (* g 40) 55))
718 (if (zerop b) 0 (+ (* b 40) 55)))))
719
720 (setq b (1+ b))
721 (if (> b 5)
722 (setq g (1+ g)
723 b 0))
724 (if (> g 5)
725 (setq r (1+ r)
726 g 0))
727 (setq ncolors (1- ncolors))))
728 ;; Now the 24 gray colors
729 (while (> ncolors 0)
730 (setq color (xterm-rgb-convert-to-16bit (+ 8 (* (- 24 ncolors) 10))))
731 (tty-color-define (format "color-%d" (- 256 ncolors))
732 (- 256 ncolors)
733 (list color color color))
734 (setq ncolors (1- ncolors))))
735 ((= ncolors 72) ; 88-color xterm
736 ;; 64 non-gray colors
737 (let ((levels '(0 139 205 255))
738 (r 0) (g 0) (b 0))
739 (while (> ncolors 8)
740 (tty-color-define (format "color-%d" (- 88 ncolors))
741 (- 88 ncolors)
742 (mapcar 'xterm-rgb-convert-to-16bit
743 (list (nth r levels)
744 (nth g levels)
745 (nth b levels))))
746 (setq b (1+ b))
747 (if (> b 3)
748 (setq g (1+ g)
749 b 0))
750 (if (> g 3)
751 (setq r (1+ r)
752 g 0))
753 (setq ncolors (1- ncolors))))
754 ;; Now the 8 gray colors
755 (while (> ncolors 0)
756 (setq color (xterm-rgb-convert-to-16bit
757 (floor
758 (if (= ncolors 8)
759 46.36363636
760 (+ (* (- 8 ncolors) 23.18181818) 69.54545454)))))
761 (tty-color-define (format "color-%d" (- 88 ncolors))
762 (- 88 ncolors)
763 (list color color color))
764 (setq ncolors (1- ncolors))))
765 (t (error "Unsupported number of xterm colors (%d)" (+ 16 ncolors)))))
766 ;; Modifying color mappings means realized faces don't use the
767 ;; right colors, so clear them.
768 (clear-face-cache)))
769
770 (defun xterm-maybe-set-dark-background-mode (redc greenc bluec)
771 ;; Use the heuristic in `frame-set-background-mode' to decide if a
772 ;; frame is dark.
773 (when (< (+ redc greenc bluec) (* .6 (+ 65535 65535 65535)))
774 (set-terminal-parameter nil 'background-mode 'dark)
775 t))
776
777 (provide 'xterm)
778
779 ;;; xterm.el ends here