Implement token threading
[bpt/emacs.git] / src / terminal.c
1 /* Functions related to terminal devices.
2 Copyright (C) 2005-2012 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
18
19 #include <config.h>
20 #include <stdio.h>
21 #include <setjmp.h>
22
23 #include "lisp.h"
24 #include "frame.h"
25 #include "termchar.h"
26 #include "termhooks.h"
27 #include "charset.h"
28 #include "coding.h"
29 #include "keyboard.h"
30
31 /* Chain of all terminals currently in use. */
32 struct terminal *terminal_list;
33
34 /* The first unallocated terminal id. */
35 static int next_terminal_id;
36
37 /* The initial terminal device, created by initial_term_init. */
38 struct terminal *initial_terminal;
39
40 static void delete_initial_terminal (struct terminal *);
41
42 \f
43
44 void
45 ring_bell (struct frame *f)
46 {
47 if (!NILP (Vring_bell_function))
48 {
49 Lisp_Object function;
50
51 /* Temporarily set the global variable to nil
52 so that if we get an error, it stays nil
53 and we don't call it over and over.
54
55 We don't specbind it, because that would carefully
56 restore the bad value if there's an error
57 and make the loop of errors happen anyway. */
58
59 function = Vring_bell_function;
60 Vring_bell_function = Qnil;
61
62 call0 (function);
63
64 Vring_bell_function = function;
65 }
66 else if (FRAME_TERMINAL (f)->ring_bell_hook)
67 (*FRAME_TERMINAL (f)->ring_bell_hook) (f);
68 }
69
70 void
71 update_begin (struct frame *f)
72 {
73 if (FRAME_TERMINAL (f)->update_begin_hook)
74 (*FRAME_TERMINAL (f)->update_begin_hook) (f);
75 }
76
77 void
78 update_end (struct frame *f)
79 {
80 if (FRAME_TERMINAL (f)->update_end_hook)
81 (*FRAME_TERMINAL (f)->update_end_hook) (f);
82 }
83
84 /* Specify how many text lines, from the top of the window,
85 should be affected by insert-lines and delete-lines operations.
86 This, and those operations, are used only within an update
87 that is bounded by calls to update_begin and update_end. */
88
89 void
90 set_terminal_window (struct frame *f, int size)
91 {
92 if (FRAME_TERMINAL (f)->set_terminal_window_hook)
93 (*FRAME_TERMINAL (f)->set_terminal_window_hook) (f, size);
94 }
95
96 /* Move cursor to row/column position VPOS/HPOS. HPOS/VPOS are
97 frame-relative coordinates. */
98
99 void
100 cursor_to (struct frame *f, int vpos, int hpos)
101 {
102 if (FRAME_TERMINAL (f)->cursor_to_hook)
103 (*FRAME_TERMINAL (f)->cursor_to_hook) (f, vpos, hpos);
104 }
105
106 /* Similar but don't take any account of the wasted characters. */
107
108 void
109 raw_cursor_to (struct frame *f, int row, int col)
110 {
111 if (FRAME_TERMINAL (f)->raw_cursor_to_hook)
112 (*FRAME_TERMINAL (f)->raw_cursor_to_hook) (f, row, col);
113 }
114
115 /* Erase operations */
116
117 /* Clear from cursor to end of frame. */
118 void
119 clear_to_end (struct frame *f)
120 {
121 if (FRAME_TERMINAL (f)->clear_to_end_hook)
122 (*FRAME_TERMINAL (f)->clear_to_end_hook) (f);
123 }
124
125 /* Clear entire frame */
126
127 void
128 clear_frame (struct frame *f)
129 {
130 if (FRAME_TERMINAL (f)->clear_frame_hook)
131 (*FRAME_TERMINAL (f)->clear_frame_hook) (f);
132 }
133
134 /* Clear from cursor to end of line.
135 Assume that the line is already clear starting at column first_unused_hpos.
136
137 Note that the cursor may be moved, on terminals lacking a `ce' string. */
138
139 void
140 clear_end_of_line (struct frame *f, int first_unused_hpos)
141 {
142 if (FRAME_TERMINAL (f)->clear_end_of_line_hook)
143 (*FRAME_TERMINAL (f)->clear_end_of_line_hook) (f, first_unused_hpos);
144 }
145
146 /* Output LEN glyphs starting at STRING at the nominal cursor position.
147 Advance the nominal cursor over the text. */
148
149 void
150 write_glyphs (struct frame *f, struct glyph *string, int len)
151 {
152 if (FRAME_TERMINAL (f)->write_glyphs_hook)
153 (*FRAME_TERMINAL (f)->write_glyphs_hook) (f, string, len);
154 }
155
156 /* Insert LEN glyphs from START at the nominal cursor position.
157
158 If start is zero, insert blanks instead of a string at start */
159
160 void
161 insert_glyphs (struct frame *f, struct glyph *start, int len)
162 {
163 if (len <= 0)
164 return;
165
166 if (FRAME_TERMINAL (f)->insert_glyphs_hook)
167 (*FRAME_TERMINAL (f)->insert_glyphs_hook) (f, start, len);
168 }
169
170 /* Delete N glyphs at the nominal cursor position. */
171
172 void
173 delete_glyphs (struct frame *f, int n)
174 {
175 if (FRAME_TERMINAL (f)->delete_glyphs_hook)
176 (*FRAME_TERMINAL (f)->delete_glyphs_hook) (f, n);
177 }
178
179 /* Insert N lines at vpos VPOS. If N is negative, delete -N lines. */
180
181 void
182 ins_del_lines (struct frame *f, int vpos, int n)
183 {
184 if (FRAME_TERMINAL (f)->ins_del_lines_hook)
185 (*FRAME_TERMINAL (f)->ins_del_lines_hook) (f, vpos, n);
186 }
187
188
189 \f
190
191 /* Return the terminal object specified by TERMINAL. TERMINAL may be
192 a terminal object, a frame, or nil for the terminal device of the
193 current frame. If THROW is zero, return NULL for failure,
194 otherwise throw an error. */
195
196 struct terminal *
197 get_terminal (Lisp_Object terminal, int throw)
198 {
199 struct terminal *result = NULL;
200
201 if (NILP (terminal))
202 terminal = selected_frame;
203
204 if (TERMINALP (terminal))
205 result = XTERMINAL (terminal);
206 else if (FRAMEP (terminal))
207 result = FRAME_TERMINAL (XFRAME (terminal));
208
209 if (result && !result->name)
210 result = NULL;
211
212 if (result == NULL && throw)
213 wrong_type_argument (Qterminal_live_p, terminal);
214
215 return result;
216 }
217
218 \f
219
220 /* Create a new terminal object and add it to the terminal list. */
221
222 struct terminal *
223 create_terminal (void)
224 {
225 struct terminal *terminal = allocate_terminal ();
226 Lisp_Object terminal_coding, keyboard_coding;
227
228 terminal->next_terminal = terminal_list;
229 terminal_list = terminal;
230
231 terminal->id = next_terminal_id++;
232
233 terminal->keyboard_coding = xmalloc (sizeof (struct coding_system));
234 terminal->terminal_coding = xmalloc (sizeof (struct coding_system));
235
236 /* If default coding systems for the terminal and the keyboard are
237 already defined, use them in preference to the defaults. This is
238 needed when Emacs runs in daemon mode. */
239 keyboard_coding =
240 find_symbol_value (intern ("default-keyboard-coding-system"));
241 if (NILP (keyboard_coding)
242 || EQ (keyboard_coding, Qunbound)
243 || NILP (Fcoding_system_p (keyboard_coding)))
244 keyboard_coding = Qno_conversion;
245 terminal_coding =
246 find_symbol_value (intern ("default-terminal-coding-system"));
247 if (NILP (terminal_coding)
248 || EQ (terminal_coding, Qunbound)
249 || NILP (Fcoding_system_p (terminal_coding)))
250 terminal_coding = Qundecided;
251
252 setup_coding_system (keyboard_coding, terminal->keyboard_coding);
253 setup_coding_system (terminal_coding, terminal->terminal_coding);
254
255 return terminal;
256 }
257
258 /* Low-level function to close all frames on a terminal, remove it
259 from the terminal list and free its memory. */
260
261 void
262 delete_terminal (struct terminal *terminal)
263 {
264 struct terminal **tp;
265 Lisp_Object tail, frame;
266
267 /* Protect against recursive calls. delete_frame calls the
268 delete_terminal_hook when we delete our last frame. */
269 if (!terminal->name)
270 return;
271 xfree (terminal->name);
272 terminal->name = NULL;
273
274 /* Check for live frames that are still on this terminal. */
275 FOR_EACH_FRAME (tail, frame)
276 {
277 struct frame *f = XFRAME (frame);
278 if (FRAME_LIVE_P (f) && f->terminal == terminal)
279 {
280 /* Pass Qnoelisp rather than Qt. */
281 delete_frame (frame, Qnoelisp);
282 }
283 }
284
285 for (tp = &terminal_list; *tp != terminal; tp = &(*tp)->next_terminal)
286 if (! *tp)
287 abort ();
288 *tp = terminal->next_terminal;
289
290 xfree (terminal->keyboard_coding);
291 terminal->keyboard_coding = NULL;
292 xfree (terminal->terminal_coding);
293 terminal->terminal_coding = NULL;
294
295 if (terminal->kboard && --terminal->kboard->reference_count == 0)
296 {
297 delete_kboard (terminal->kboard);
298 terminal->kboard = NULL;
299 }
300 }
301
302 Lisp_Object Qrun_hook_with_args;
303 static Lisp_Object Qdelete_terminal_functions;
304 DEFUN ("delete-terminal", Fdelete_terminal, Sdelete_terminal, 0, 2, 0,
305 doc: /* Delete TERMINAL by deleting all frames on it and closing the terminal.
306 TERMINAL may be a terminal object, a frame, or nil (meaning the
307 selected frame's terminal).
308
309 Normally, you may not delete a display if all other displays are suspended,
310 but if the second argument FORCE is non-nil, you may do so. */)
311 (Lisp_Object terminal, Lisp_Object force)
312 {
313 struct terminal *t = get_terminal (terminal, 0);
314
315 if (!t)
316 return Qnil;
317
318 if (NILP (force))
319 {
320 struct terminal *p = terminal_list;
321 while (p && (p == t || !TERMINAL_ACTIVE_P (p)))
322 p = p->next_terminal;
323
324 if (!p)
325 error ("Attempt to delete the sole active display terminal");
326 }
327
328 if (NILP (Vrun_hooks))
329 ;
330 else if (EQ (force, Qnoelisp))
331 pending_funcalls
332 = Fcons (list3 (Qrun_hook_with_args,
333 Qdelete_terminal_functions, terminal),
334 pending_funcalls);
335 else
336 safe_call2 (Qrun_hook_with_args, Qdelete_terminal_functions, terminal);
337
338 if (t->delete_terminal_hook)
339 (*t->delete_terminal_hook) (t);
340 else
341 delete_terminal (t);
342
343 return Qnil;
344 }
345
346 \f
347 DEFUN ("frame-terminal", Fframe_terminal, Sframe_terminal, 0, 1, 0,
348 doc: /* Return the terminal that FRAME is displayed on.
349 If FRAME is nil, the selected frame is used.
350
351 The terminal device is represented by its integer identifier. */)
352 (Lisp_Object frame)
353 {
354 struct terminal *t;
355
356 if (NILP (frame))
357 frame = selected_frame;
358
359 CHECK_LIVE_FRAME (frame);
360
361 t = FRAME_TERMINAL (XFRAME (frame));
362
363 if (!t)
364 return Qnil;
365 else
366 {
367 Lisp_Object terminal;
368 XSETTERMINAL (terminal, t);
369 return terminal;
370 }
371 }
372
373 DEFUN ("terminal-live-p", Fterminal_live_p, Sterminal_live_p, 1, 1, 0,
374 doc: /* Return non-nil if OBJECT is a terminal which has not been deleted.
375 Value is nil if OBJECT is not a live display terminal.
376 If object is a live display terminal, the return value indicates what
377 sort of output terminal it uses. See the documentation of `framep' for
378 possible return values. */)
379 (Lisp_Object object)
380 {
381 struct terminal *t;
382
383 t = get_terminal (object, 0);
384
385 if (!t)
386 return Qnil;
387
388 switch (t->type)
389 {
390 case output_initial: /* The initial frame is like a termcap frame. */
391 case output_termcap:
392 return Qt;
393 case output_x_window:
394 return Qx;
395 case output_w32:
396 return Qw32;
397 case output_msdos_raw:
398 return Qpc;
399 case output_mac:
400 return Qmac;
401 case output_ns:
402 return Qns;
403 default:
404 abort ();
405 }
406 }
407
408 DEFUN ("terminal-list", Fterminal_list, Sterminal_list, 0, 0, 0,
409 doc: /* Return a list of all terminal devices. */)
410 (void)
411 {
412 Lisp_Object terminal, terminals = Qnil;
413 struct terminal *t;
414
415 for (t = terminal_list; t; t = t->next_terminal)
416 {
417 XSETTERMINAL (terminal, t);
418 terminals = Fcons (terminal, terminals);
419 }
420
421 return terminals;
422 }
423
424 DEFUN ("terminal-name", Fterminal_name, Sterminal_name, 0, 1, 0,
425 doc: /* Return the name of the terminal device TERMINAL.
426 It is not guaranteed that the returned value is unique among opened devices.
427
428 TERMINAL may be a terminal object, a frame, or nil (meaning the
429 selected frame's terminal). */)
430 (Lisp_Object terminal)
431 {
432 struct terminal *t
433 = TERMINALP (terminal) ? XTERMINAL (terminal) : get_terminal (terminal, 1);
434
435 return t->name ? build_string (t->name) : Qnil;
436 }
437
438
439 \f
440 /* Set the value of terminal parameter PARAMETER in terminal D to VALUE.
441 Return the previous value. */
442
443 static Lisp_Object
444 store_terminal_param (struct terminal *t, Lisp_Object parameter, Lisp_Object value)
445 {
446 Lisp_Object old_alist_elt = Fassq (parameter, t->param_alist);
447 if (EQ (old_alist_elt, Qnil))
448 {
449 t->param_alist = Fcons (Fcons (parameter, value), t->param_alist);
450 return Qnil;
451 }
452 else
453 {
454 Lisp_Object result = Fcdr (old_alist_elt);
455 Fsetcdr (old_alist_elt, value);
456 return result;
457 }
458 }
459
460
461 DEFUN ("terminal-parameters", Fterminal_parameters, Sterminal_parameters, 0, 1, 0,
462 doc: /* Return the parameter-alist of terminal TERMINAL.
463 The value is a list of elements of the form (PARM . VALUE), where PARM
464 is a symbol.
465
466 TERMINAL can be a terminal object, a frame, or nil (meaning the
467 selected frame's terminal). */)
468 (Lisp_Object terminal)
469 {
470 struct terminal *t
471 = TERMINALP (terminal) ? XTERMINAL (terminal) : get_terminal (terminal, 1);
472 return Fcopy_alist (t->param_alist);
473 }
474
475 DEFUN ("terminal-parameter", Fterminal_parameter, Sterminal_parameter, 2, 2, 0,
476 doc: /* Return TERMINAL's value for parameter PARAMETER.
477 TERMINAL can be a terminal object, a frame, or nil (meaning the
478 selected frame's terminal). */)
479 (Lisp_Object terminal, Lisp_Object parameter)
480 {
481 Lisp_Object value;
482 struct terminal *t
483 = TERMINALP (terminal) ? XTERMINAL (terminal) : get_terminal (terminal, 1);
484 CHECK_SYMBOL (parameter);
485 value = Fcdr (Fassq (parameter, t->param_alist));
486 return value;
487 }
488
489 DEFUN ("set-terminal-parameter", Fset_terminal_parameter,
490 Sset_terminal_parameter, 3, 3, 0,
491 doc: /* Set TERMINAL's value for parameter PARAMETER to VALUE.
492 Return the previous value of PARAMETER.
493
494 TERMINAL can be a terminal object, a frame or nil (meaning the
495 selected frame's terminal). */)
496 (Lisp_Object terminal, Lisp_Object parameter, Lisp_Object value)
497 {
498 struct terminal *t
499 = TERMINALP (terminal) ? XTERMINAL (terminal) : get_terminal (terminal, 1);
500 return store_terminal_param (t, parameter, value);
501 }
502
503 \f
504
505 /* Create the bootstrap display terminal for the initial frame.
506 Returns a terminal of type output_initial. */
507
508 struct terminal *
509 init_initial_terminal (void)
510 {
511 if (initialized || terminal_list || tty_list)
512 abort ();
513
514 initial_terminal = create_terminal ();
515 initial_terminal->type = output_initial;
516 initial_terminal->name = xstrdup ("initial_terminal");
517 initial_terminal->kboard = initial_kboard;
518 initial_terminal->delete_terminal_hook = &delete_initial_terminal;
519 /* All other hooks are NULL. */
520
521 return initial_terminal;
522 }
523
524 /* Deletes the bootstrap terminal device.
525 Called through delete_terminal_hook. */
526
527 static void
528 delete_initial_terminal (struct terminal *terminal)
529 {
530 if (terminal != initial_terminal)
531 abort ();
532
533 delete_terminal (terminal);
534 initial_terminal = NULL;
535 }
536
537 void
538 syms_of_terminal (void)
539 {
540
541 DEFVAR_LISP ("ring-bell-function", Vring_bell_function,
542 doc: /* Non-nil means call this function to ring the bell.
543 The function should accept no arguments. */);
544 Vring_bell_function = Qnil;
545
546 DEFVAR_LISP ("delete-terminal-functions", Vdelete_terminal_functions,
547 doc: /* Special hook run when a terminal is deleted.
548 Each function is called with argument, the terminal.
549 This may be called just before actually deleting the terminal,
550 or some time later. */);
551 Vdelete_terminal_functions = Qnil;
552 DEFSYM (Qdelete_terminal_functions, "delete-terminal-functions");
553 DEFSYM (Qrun_hook_with_args, "run-hook-with-args");
554
555 defsubr (&Sdelete_terminal);
556 defsubr (&Sframe_terminal);
557 defsubr (&Sterminal_live_p);
558 defsubr (&Sterminal_list);
559 defsubr (&Sterminal_name);
560 defsubr (&Sterminal_parameters);
561 defsubr (&Sterminal_parameter);
562 defsubr (&Sset_terminal_parameter);
563
564 Fprovide (intern_c_string ("multi-tty"), Qnil);
565 }