Fix bug #14970 with crashes when deleting many frames on MS-Windows.
[bpt/emacs.git] / src / frame.c
1 /* Generic frame functions.
2
3 Copyright (C) 1993-1995, 1997, 1999-2013 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19
20 #include <config.h>
21
22 #define FRAME_INLINE EXTERN_INLINE
23
24 #include <stdio.h>
25 #include <errno.h>
26 #include <limits.h>
27
28 #include <c-ctype.h>
29
30 #include "lisp.h"
31 #include "character.h"
32
33 #ifdef HAVE_WINDOW_SYSTEM
34 #include TERM_HEADER
35 #endif /* HAVE_WINDOW_SYSTEM */
36
37 #include "buffer.h"
38 /* These help us bind and responding to switch-frame events. */
39 #include "commands.h"
40 #include "keyboard.h"
41 #include "frame.h"
42 #include "blockinput.h"
43 #include "termchar.h"
44 #include "termhooks.h"
45 #include "dispextern.h"
46 #include "window.h"
47 #include "font.h"
48 #ifdef HAVE_WINDOW_SYSTEM
49 #include "fontset.h"
50 #endif
51 #ifdef MSDOS
52 #include "msdos.h"
53 #include "dosfns.h"
54 #endif
55
56 #ifdef HAVE_NS
57 Lisp_Object Qns_parse_geometry;
58 #endif
59
60 Lisp_Object Qframep, Qframe_live_p;
61 Lisp_Object Qicon, Qmodeline;
62 Lisp_Object Qonly, Qnone;
63 Lisp_Object Qx, Qw32, Qpc, Qns;
64 Lisp_Object Qvisible;
65 Lisp_Object Qdisplay_type;
66 static Lisp_Object Qbackground_mode;
67 Lisp_Object Qnoelisp;
68
69 static Lisp_Object Qx_frame_parameter;
70 Lisp_Object Qx_resource_name;
71 Lisp_Object Qterminal;
72 Lisp_Object Qterminal_live_p;
73
74 /* Frame parameters (set or reported). */
75
76 Lisp_Object Qauto_raise, Qauto_lower;
77 Lisp_Object Qborder_color, Qborder_width;
78 Lisp_Object Qcursor_color, Qcursor_type;
79 Lisp_Object Qheight, Qwidth;
80 Lisp_Object Qleft, Qright;
81 Lisp_Object Qicon_left, Qicon_top, Qicon_type, Qicon_name;
82 Lisp_Object Qtooltip;
83 Lisp_Object Qinternal_border_width;
84 Lisp_Object Qmouse_color;
85 Lisp_Object Qminibuffer;
86 Lisp_Object Qscroll_bar_width, Qvertical_scroll_bars;
87 Lisp_Object Qvisibility;
88 Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
89 Lisp_Object Qscreen_gamma;
90 Lisp_Object Qline_spacing;
91 static Lisp_Object Quser_position, Quser_size;
92 Lisp_Object Qwait_for_wm;
93 static Lisp_Object Qwindow_id;
94 #ifdef HAVE_X_WINDOWS
95 static Lisp_Object Qouter_window_id;
96 #endif
97 Lisp_Object Qparent_id;
98 Lisp_Object Qtitle, Qname;
99 static Lisp_Object Qexplicit_name;
100 Lisp_Object Qunsplittable;
101 Lisp_Object Qmenu_bar_lines, Qtool_bar_lines, Qtool_bar_position;
102 Lisp_Object Qleft_fringe, Qright_fringe;
103 Lisp_Object Qbuffer_predicate;
104 static Lisp_Object Qbuffer_list, Qburied_buffer_list;
105 Lisp_Object Qtty_color_mode;
106 Lisp_Object Qtty, Qtty_type;
107
108 Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth, Qmaximized;
109 Lisp_Object Qsticky;
110 Lisp_Object Qfont_backend;
111 Lisp_Object Qalpha;
112
113 Lisp_Object Qface_set_after_frame_default;
114
115 static Lisp_Object Qdelete_frame_functions;
116
117 static Lisp_Object Qgeometry, Qworkarea, Qmm_size, Qframes, Qsource;
118
119 #ifdef HAVE_WINDOW_SYSTEM
120 static void x_report_frame_params (struct frame *, Lisp_Object *);
121 #endif
122
123 /* These setters are used only in this file, so they can be private. */
124 static void
125 fset_buffer_predicate (struct frame *f, Lisp_Object val)
126 {
127 f->buffer_predicate = val;
128 }
129 static void
130 fset_minibuffer_window (struct frame *f, Lisp_Object val)
131 {
132 f->minibuffer_window = val;
133 }
134
135 struct frame *
136 decode_live_frame (register Lisp_Object frame)
137 {
138 if (NILP (frame))
139 frame = selected_frame;
140 CHECK_LIVE_FRAME (frame);
141 return XFRAME (frame);
142 }
143
144 struct frame *
145 decode_any_frame (register Lisp_Object frame)
146 {
147 if (NILP (frame))
148 frame = selected_frame;
149 CHECK_FRAME (frame);
150 return XFRAME (frame);
151 }
152
153 bool
154 window_system_available (struct frame *f)
155 {
156 if (f)
157 return FRAME_WINDOW_P (f) || FRAME_MSDOS_P (f);
158 else
159 #ifdef HAVE_WINDOW_SYSTEM
160 return x_display_list != NULL;
161 #else
162 return 0;
163 #endif
164 }
165
166 struct frame *
167 decode_window_system_frame (Lisp_Object frame)
168 {
169 struct frame *f = decode_live_frame (frame);
170
171 if (!window_system_available (f))
172 error ("Window system frame should be used");
173 return f;
174 }
175
176 void
177 check_window_system (struct frame *f)
178 {
179 if (!window_system_available (f))
180 error (f ? "Window system frame should be used"
181 : "Window system is not in use or not initialized");
182 }
183
184 static void
185 set_menu_bar_lines_1 (Lisp_Object window, int n)
186 {
187 struct window *w = XWINDOW (window);
188
189 w->last_modified = 0;
190 w->top_line += n;
191 w->total_lines -= n;
192
193 /* Handle just the top child in a vertical split. */
194 if (WINDOW_VERTICAL_COMBINATION_P (w))
195 set_menu_bar_lines_1 (w->contents, n);
196 else if (WINDOW_HORIZONTAL_COMBINATION_P (w))
197 /* Adjust all children in a horizontal split. */
198 for (window = w->contents; !NILP (window); window = w->next)
199 {
200 w = XWINDOW (window);
201 set_menu_bar_lines_1 (window, n);
202 }
203 }
204
205 void
206 set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
207 {
208 int nlines;
209 int olines = FRAME_MENU_BAR_LINES (f);
210
211 /* Right now, menu bars don't work properly in minibuf-only frames;
212 most of the commands try to apply themselves to the minibuffer
213 frame itself, and get an error because you can't switch buffers
214 in or split the minibuffer window. */
215 if (FRAME_MINIBUF_ONLY_P (f))
216 return;
217
218 if (TYPE_RANGED_INTEGERP (int, value))
219 nlines = XINT (value);
220 else
221 nlines = 0;
222
223 if (nlines != olines)
224 {
225 windows_or_buffers_changed++;
226 FRAME_WINDOW_SIZES_CHANGED (f) = 1;
227 FRAME_MENU_BAR_LINES (f) = nlines;
228 set_menu_bar_lines_1 (f->root_window, nlines - olines);
229 adjust_glyphs (f);
230 }
231 }
232 \f
233 Lisp_Object Vframe_list;
234
235 \f
236 DEFUN ("framep", Fframep, Sframep, 1, 1, 0,
237 doc: /* Return non-nil if OBJECT is a frame.
238 Value is:
239 t for a termcap frame (a character-only terminal),
240 'x' for an Emacs frame that is really an X window,
241 'w32' for an Emacs frame that is a window on MS-Windows display,
242 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
243 'pc' for a direct-write MS-DOS frame.
244 See also `frame-live-p'. */)
245 (Lisp_Object object)
246 {
247 if (!FRAMEP (object))
248 return Qnil;
249 switch (XFRAME (object)->output_method)
250 {
251 case output_initial: /* The initial frame is like a termcap frame. */
252 case output_termcap:
253 return Qt;
254 case output_x_window:
255 return Qx;
256 case output_w32:
257 return Qw32;
258 case output_msdos_raw:
259 return Qpc;
260 case output_ns:
261 return Qns;
262 default:
263 emacs_abort ();
264 }
265 }
266
267 DEFUN ("frame-live-p", Fframe_live_p, Sframe_live_p, 1, 1, 0,
268 doc: /* Return non-nil if OBJECT is a frame which has not been deleted.
269 Value is nil if OBJECT is not a live frame. If object is a live
270 frame, the return value indicates what sort of terminal device it is
271 displayed on. See the documentation of `framep' for possible
272 return values. */)
273 (Lisp_Object object)
274 {
275 return ((FRAMEP (object)
276 && FRAME_LIVE_P (XFRAME (object)))
277 ? Fframep (object)
278 : Qnil);
279 }
280
281 DEFUN ("window-system", Fwindow_system, Swindow_system, 0, 1, 0,
282 doc: /* The name of the window system that FRAME is displaying through.
283 The value is a symbol:
284 nil for a termcap frame (a character-only terminal),
285 'x' for an Emacs frame that is really an X window,
286 'w32' for an Emacs frame that is a window on MS-Windows display,
287 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
288 'pc' for a direct-write MS-DOS frame.
289
290 FRAME defaults to the currently selected frame.
291
292 Use of this function as a predicate is deprecated. Instead,
293 use `display-graphic-p' or any of the other `display-*-p'
294 predicates which report frame's specific UI-related capabilities. */)
295 (Lisp_Object frame)
296 {
297 Lisp_Object type;
298 if (NILP (frame))
299 frame = selected_frame;
300
301 type = Fframep (frame);
302
303 if (NILP (type))
304 wrong_type_argument (Qframep, frame);
305
306 if (EQ (type, Qt))
307 return Qnil;
308 else
309 return type;
310 }
311
312 struct frame *
313 make_frame (int mini_p)
314 {
315 Lisp_Object frame;
316 register struct frame *f;
317 register Lisp_Object root_window;
318 register Lisp_Object mini_window;
319
320 f = allocate_frame ();
321 XSETFRAME (frame, f);
322
323 /* Initialize Lisp data. Note that allocate_frame initializes all
324 Lisp data to nil, so do it only for slots which should not be nil. */
325 fset_tool_bar_position (f, Qtop);
326
327 /* Initialize non-Lisp data. Note that allocate_frame zeroes out all
328 non-Lisp data, so do it only for slots which should not be zero.
329 To avoid subtle bugs and for the sake of readability, it's better to
330 initialize enum members explicitly even if their values are zero. */
331 f->wants_modeline = 1;
332 f->garbaged = 1;
333 f->has_minibuffer = mini_p;
334 f->vertical_scroll_bar_type = vertical_scroll_bar_none;
335 f->column_width = 1; /* !FRAME_WINDOW_P value */
336 f->line_height = 1; /* !FRAME_WINDOW_P value */
337 #ifdef HAVE_WINDOW_SYSTEM
338 f->want_fullscreen = FULLSCREEN_NONE;
339 #endif
340
341 root_window = make_window ();
342 if (mini_p)
343 {
344 mini_window = make_window ();
345 wset_next (XWINDOW (root_window), mini_window);
346 wset_prev (XWINDOW (mini_window), root_window);
347 XWINDOW (mini_window)->mini = 1;
348 wset_frame (XWINDOW (mini_window), frame);
349 fset_minibuffer_window (f, mini_window);
350 }
351 else
352 {
353 mini_window = Qnil;
354 wset_next (XWINDOW (root_window), Qnil);
355 fset_minibuffer_window (f, Qnil);
356 }
357
358 wset_frame (XWINDOW (root_window), frame);
359
360 /* 10 is arbitrary,
361 just so that there is "something there."
362 Correct size will be set up later with change_frame_size. */
363
364 SET_FRAME_COLS (f, 10);
365 FRAME_LINES (f) = 10;
366
367 XWINDOW (root_window)->total_cols = 10;
368 XWINDOW (root_window)->total_lines = mini_p ? 9 : 10;
369
370 if (mini_p)
371 {
372 XWINDOW (mini_window)->total_cols = 10;
373 XWINDOW (mini_window)->top_line = 9;
374 XWINDOW (mini_window)->total_lines = 1;
375 }
376
377 /* Choose a buffer for the frame's root window. */
378 {
379 Lisp_Object buf = Fcurrent_buffer ();
380
381 /* If current buffer is hidden, try to find another one. */
382 if (BUFFER_HIDDEN_P (XBUFFER (buf)))
383 buf = other_buffer_safely (buf);
384
385 /* Use set_window_buffer, not Fset_window_buffer, and don't let
386 hooks be run by it. The reason is that the whole frame/window
387 arrangement is not yet fully initialized at this point. Windows
388 don't have the right size, glyph matrices aren't initialized
389 etc. Running Lisp functions at this point surely ends in a
390 SEGV. */
391 set_window_buffer (root_window, buf, 0, 0);
392 fset_buffer_list (f, list1 (buf));
393 }
394
395 if (mini_p)
396 set_window_buffer (mini_window,
397 (NILP (Vminibuffer_list)
398 ? get_minibuffer (0)
399 : Fcar (Vminibuffer_list)),
400 0, 0);
401
402 fset_root_window (f, root_window);
403 fset_selected_window (f, root_window);
404 /* Make sure this window seems more recently used than
405 a newly-created, never-selected window. */
406 XWINDOW (f->selected_window)->use_time = ++window_select_count;
407
408 return f;
409 }
410 \f
411 #ifdef HAVE_WINDOW_SYSTEM
412 /* Make a frame using a separate minibuffer window on another frame.
413 MINI_WINDOW is the minibuffer window to use. nil means use the
414 default (the global minibuffer). */
415
416 struct frame *
417 make_frame_without_minibuffer (register Lisp_Object mini_window, KBOARD *kb, Lisp_Object display)
418 {
419 register struct frame *f;
420 struct gcpro gcpro1;
421
422 if (!NILP (mini_window))
423 CHECK_LIVE_WINDOW (mini_window);
424
425 if (!NILP (mini_window)
426 && FRAME_KBOARD (XFRAME (XWINDOW (mini_window)->frame)) != kb)
427 error ("Frame and minibuffer must be on the same terminal");
428
429 /* Make a frame containing just a root window. */
430 f = make_frame (0);
431
432 if (NILP (mini_window))
433 {
434 /* Use default-minibuffer-frame if possible. */
435 if (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
436 || ! FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))
437 {
438 Lisp_Object frame_dummy;
439
440 XSETFRAME (frame_dummy, f);
441 GCPRO1 (frame_dummy);
442 /* If there's no minibuffer frame to use, create one. */
443 kset_default_minibuffer_frame
444 (kb, call1 (intern ("make-initial-minibuffer-frame"), display));
445 UNGCPRO;
446 }
447
448 mini_window
449 = XFRAME (KVAR (kb, Vdefault_minibuffer_frame))->minibuffer_window;
450 }
451
452 fset_minibuffer_window (f, mini_window);
453
454 /* Make the chosen minibuffer window display the proper minibuffer,
455 unless it is already showing a minibuffer. */
456 if (NILP (Fmemq (XWINDOW (mini_window)->contents, Vminibuffer_list)))
457 /* Use set_window_buffer instead of Fset_window_buffer (see
458 discussion of bug#11984, bug#12025, bug#12026). */
459 set_window_buffer (mini_window,
460 (NILP (Vminibuffer_list)
461 ? get_minibuffer (0)
462 : Fcar (Vminibuffer_list)), 0, 0);
463 return f;
464 }
465
466 /* Make a frame containing only a minibuffer window. */
467
468 struct frame *
469 make_minibuffer_frame (void)
470 {
471 /* First make a frame containing just a root window, no minibuffer. */
472
473 register struct frame *f = make_frame (0);
474 register Lisp_Object mini_window;
475 register Lisp_Object frame;
476
477 XSETFRAME (frame, f);
478
479 f->auto_raise = 0;
480 f->auto_lower = 0;
481 f->no_split = 1;
482 f->wants_modeline = 0;
483 f->has_minibuffer = 1;
484
485 /* Now label the root window as also being the minibuffer.
486 Avoid infinite looping on the window chain by marking next pointer
487 as nil. */
488
489 mini_window = f->root_window;
490 fset_minibuffer_window (f, mini_window);
491 XWINDOW (mini_window)->mini = 1;
492 wset_next (XWINDOW (mini_window), Qnil);
493 wset_prev (XWINDOW (mini_window), Qnil);
494 wset_frame (XWINDOW (mini_window), frame);
495
496 /* Put the proper buffer in that window. */
497
498 /* Use set_window_buffer instead of Fset_window_buffer (see
499 discussion of bug#11984, bug#12025, bug#12026). */
500 set_window_buffer (mini_window,
501 (NILP (Vminibuffer_list)
502 ? get_minibuffer (0)
503 : Fcar (Vminibuffer_list)), 0, 0);
504 return f;
505 }
506 #endif /* HAVE_WINDOW_SYSTEM */
507 \f
508 /* Construct a frame that refers to a terminal. */
509
510 static printmax_t tty_frame_count;
511
512 struct frame *
513 make_initial_frame (void)
514 {
515 struct frame *f;
516 struct terminal *terminal;
517 Lisp_Object frame;
518
519 eassert (initial_kboard);
520
521 /* The first call must initialize Vframe_list. */
522 if (! (NILP (Vframe_list) || CONSP (Vframe_list)))
523 Vframe_list = Qnil;
524
525 terminal = init_initial_terminal ();
526
527 f = make_frame (1);
528 XSETFRAME (frame, f);
529
530 Vframe_list = Fcons (frame, Vframe_list);
531
532 tty_frame_count = 1;
533 fset_name (f, build_pure_c_string ("F1"));
534
535 SET_FRAME_VISIBLE (f, 1);
536
537 f->output_method = terminal->type;
538 f->terminal = terminal;
539 f->terminal->reference_count++;
540 f->output_data.nothing = 0;
541
542 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
543 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
544
545 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
546
547 /* The default value of menu-bar-mode is t. */
548 set_menu_bar_lines (f, make_number (1), Qnil);
549
550 if (!noninteractive)
551 init_frame_faces (f);
552
553 return f;
554 }
555
556
557 static struct frame *
558 make_terminal_frame (struct terminal *terminal)
559 {
560 register struct frame *f;
561 Lisp_Object frame;
562 char name[sizeof "F" + INT_STRLEN_BOUND (printmax_t)];
563
564 if (!terminal->name)
565 error ("Terminal is not live, can't create new frames on it");
566
567 f = make_frame (1);
568
569 XSETFRAME (frame, f);
570 Vframe_list = Fcons (frame, Vframe_list);
571
572 fset_name (f, make_formatted_string (name, "F%"pMd, ++tty_frame_count));
573
574 SET_FRAME_VISIBLE (f, 1);
575
576 f->terminal = terminal;
577 f->terminal->reference_count++;
578 #ifdef MSDOS
579 f->output_data.tty->display_info = &the_only_display_info;
580 if (!inhibit_window_system
581 && (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame))
582 || XFRAME (selected_frame)->output_method == output_msdos_raw))
583 f->output_method = output_msdos_raw;
584 else
585 f->output_method = output_termcap;
586 #else /* not MSDOS */
587 f->output_method = output_termcap;
588 create_tty_output (f);
589 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
590 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
591 #endif /* not MSDOS */
592
593 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
594 FRAME_MENU_BAR_LINES(f) = NILP (Vmenu_bar_mode) ? 0 : 1;
595
596 /* Set the top frame to the newly created frame. */
597 if (FRAMEP (FRAME_TTY (f)->top_frame)
598 && FRAME_LIVE_P (XFRAME (FRAME_TTY (f)->top_frame)))
599 SET_FRAME_VISIBLE (XFRAME (FRAME_TTY (f)->top_frame), 2); /* obscured */
600
601 FRAME_TTY (f)->top_frame = frame;
602
603 if (!noninteractive)
604 init_frame_faces (f);
605
606 return f;
607 }
608
609 /* Get a suitable value for frame parameter PARAMETER for a newly
610 created frame, based on (1) the user-supplied frame parameter
611 alist SUPPLIED_PARMS, and (2) CURRENT_VALUE. */
612
613 static Lisp_Object
614 get_future_frame_param (Lisp_Object parameter,
615 Lisp_Object supplied_parms,
616 char *current_value)
617 {
618 Lisp_Object result;
619
620 result = Fassq (parameter, supplied_parms);
621 if (NILP (result))
622 result = Fassq (parameter, XFRAME (selected_frame)->param_alist);
623 if (NILP (result) && current_value != NULL)
624 result = build_string (current_value);
625 if (!NILP (result) && !STRINGP (result))
626 result = XCDR (result);
627 if (NILP (result) || !STRINGP (result))
628 result = Qnil;
629
630 return result;
631 }
632
633 DEFUN ("make-terminal-frame", Fmake_terminal_frame, Smake_terminal_frame,
634 1, 1, 0,
635 doc: /* Create an additional terminal frame, possibly on another terminal.
636 This function takes one argument, an alist specifying frame parameters.
637
638 You can create multiple frames on a single text terminal, but only one
639 of them (the selected terminal frame) is actually displayed.
640
641 In practice, generally you don't need to specify any parameters,
642 except when you want to create a new frame on another terminal.
643 In that case, the `tty' parameter specifies the device file to open,
644 and the `tty-type' parameter specifies the terminal type. Example:
645
646 (make-terminal-frame '((tty . "/dev/pts/5") (tty-type . "xterm")))
647
648 Note that changing the size of one terminal frame automatically
649 affects all frames on the same terminal device. */)
650 (Lisp_Object parms)
651 {
652 struct frame *f;
653 struct terminal *t = NULL;
654 Lisp_Object frame, tem;
655 struct frame *sf = SELECTED_FRAME ();
656
657 #ifdef MSDOS
658 if (sf->output_method != output_msdos_raw
659 && sf->output_method != output_termcap)
660 emacs_abort ();
661 #else /* not MSDOS */
662
663 #ifdef WINDOWSNT /* This should work now! */
664 if (sf->output_method != output_termcap)
665 error ("Not using an ASCII terminal now; cannot make a new ASCII frame");
666 #endif
667 #endif /* not MSDOS */
668
669 {
670 Lisp_Object terminal;
671
672 terminal = Fassq (Qterminal, parms);
673 if (CONSP (terminal))
674 {
675 terminal = XCDR (terminal);
676 t = get_terminal (terminal, 1);
677 }
678 #ifdef MSDOS
679 if (t && t != the_only_display_info.terminal)
680 /* msdos.c assumes a single tty_display_info object. */
681 error ("Multiple terminals are not supported on this platform");
682 if (!t)
683 t = the_only_display_info.terminal;
684 #endif
685 }
686
687 if (!t)
688 {
689 char *name = 0, *type = 0;
690 Lisp_Object tty, tty_type;
691
692 tty = get_future_frame_param
693 (Qtty, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
694 ? FRAME_TTY (XFRAME (selected_frame))->name
695 : NULL));
696 if (!NILP (tty))
697 {
698 name = alloca (SBYTES (tty) + 1);
699 memcpy (name, SSDATA (tty), SBYTES (tty));
700 name[SBYTES (tty)] = 0;
701 }
702
703 tty_type = get_future_frame_param
704 (Qtty_type, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
705 ? FRAME_TTY (XFRAME (selected_frame))->type
706 : NULL));
707 if (!NILP (tty_type))
708 {
709 type = alloca (SBYTES (tty_type) + 1);
710 memcpy (type, SSDATA (tty_type), SBYTES (tty_type));
711 type[SBYTES (tty_type)] = 0;
712 }
713
714 t = init_tty (name, type, 0); /* Errors are not fatal. */
715 }
716
717 f = make_terminal_frame (t);
718
719 {
720 int width, height;
721 get_tty_size (fileno (FRAME_TTY (f)->input), &width, &height);
722 change_frame_size (f, height, width, 0, 0, 0);
723 }
724
725 adjust_glyphs (f);
726 calculate_costs (f);
727 XSETFRAME (frame, f);
728 Fmodify_frame_parameters (frame, parms);
729 Fmodify_frame_parameters
730 (frame, list1 (Fcons (Qtty_type,
731 build_string (t->display_info.tty->type))));
732 if (t->display_info.tty->name != NULL)
733 Fmodify_frame_parameters
734 (frame, list1 (Fcons (Qtty,
735 build_string (t->display_info.tty->name))));
736 else
737 Fmodify_frame_parameters (frame, list1 (Fcons (Qtty, Qnil)));
738
739 /* Make the frame face alist be frame-specific, so that each
740 frame could change its face definitions independently. */
741 fset_face_alist (f, Fcopy_alist (sf->face_alist));
742 /* Simple Fcopy_alist isn't enough, because we need the contents of
743 the vectors which are the CDRs of associations in face_alist to
744 be copied as well. */
745 for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem))
746 XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem))));
747 return frame;
748 }
749
750 \f
751 /* Perform the switch to frame FRAME.
752
753 If FRAME is a switch-frame event `(switch-frame FRAME1)', use
754 FRAME1 as frame.
755
756 If TRACK is non-zero and the frame that currently has the focus
757 redirects its focus to the selected frame, redirect that focused
758 frame's focus to FRAME instead.
759
760 FOR_DELETION non-zero means that the selected frame is being
761 deleted, which includes the possibility that the frame's terminal
762 is dead.
763
764 The value of NORECORD is passed as argument to Fselect_window. */
765
766 Lisp_Object
767 do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object norecord)
768 {
769 struct frame *sf = SELECTED_FRAME ();
770
771 /* If FRAME is a switch-frame event, extract the frame we should
772 switch to. */
773 if (CONSP (frame)
774 && EQ (XCAR (frame), Qswitch_frame)
775 && CONSP (XCDR (frame)))
776 frame = XCAR (XCDR (frame));
777
778 /* This used to say CHECK_LIVE_FRAME, but apparently it's possible for
779 a switch-frame event to arrive after a frame is no longer live,
780 especially when deleting the initial frame during startup. */
781 CHECK_FRAME (frame);
782 if (! FRAME_LIVE_P (XFRAME (frame)))
783 return Qnil;
784
785 if (sf == XFRAME (frame))
786 return frame;
787
788 /* This is too greedy; it causes inappropriate focus redirection
789 that's hard to get rid of. */
790 #if 0
791 /* If a frame's focus has been redirected toward the currently
792 selected frame, we should change the redirection to point to the
793 newly selected frame. This means that if the focus is redirected
794 from a minibufferless frame to a surrogate minibuffer frame, we
795 can use `other-window' to switch between all the frames using
796 that minibuffer frame, and the focus redirection will follow us
797 around. */
798 if (track)
799 {
800 Lisp_Object tail;
801
802 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
803 {
804 Lisp_Object focus;
805
806 if (!FRAMEP (XCAR (tail)))
807 emacs_abort ();
808
809 focus = FRAME_FOCUS_FRAME (XFRAME (XCAR (tail)));
810
811 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
812 Fredirect_frame_focus (XCAR (tail), frame);
813 }
814 }
815 #else /* ! 0 */
816 /* Instead, apply it only to the frame we're pointing to. */
817 #ifdef HAVE_WINDOW_SYSTEM
818 if (track && FRAME_WINDOW_P (XFRAME (frame)))
819 {
820 Lisp_Object focus, xfocus;
821
822 xfocus = x_get_focus_frame (XFRAME (frame));
823 if (FRAMEP (xfocus))
824 {
825 focus = FRAME_FOCUS_FRAME (XFRAME (xfocus));
826 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
827 Fredirect_frame_focus (xfocus, frame);
828 }
829 }
830 #endif /* HAVE_X_WINDOWS */
831 #endif /* ! 0 */
832
833 if (!for_deletion && FRAME_HAS_MINIBUF_P (sf))
834 resize_mini_window (XWINDOW (FRAME_MINIBUF_WINDOW (sf)), 1);
835
836 if (FRAME_TERMCAP_P (XFRAME (frame)) || FRAME_MSDOS_P (XFRAME (frame)))
837 {
838 Lisp_Object top_frame = FRAME_TTY (XFRAME (frame))->top_frame;
839
840 /* Don't mark the frame garbaged and/or obscured if we are
841 switching to the frame that is already the top frame of that
842 TTY. */
843 if (!EQ (frame, top_frame))
844 {
845 if (FRAMEP (top_frame))
846 /* Mark previously displayed frame as now obscured. */
847 SET_FRAME_VISIBLE (XFRAME (top_frame), 2);
848 SET_FRAME_VISIBLE (XFRAME (frame), 1);
849 }
850 FRAME_TTY (XFRAME (frame))->top_frame = frame;
851 }
852
853 selected_frame = frame;
854 if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
855 last_nonminibuf_frame = XFRAME (selected_frame);
856
857 Fselect_window (XFRAME (frame)->selected_window, norecord);
858
859 /* We want to make sure that the next event generates a frame-switch
860 event to the appropriate frame. This seems kludgy to me, but
861 before you take it out, make sure that evaluating something like
862 (select-window (frame-root-window (new-frame))) doesn't end up
863 with your typing being interpreted in the new frame instead of
864 the one you're actually typing in. */
865 internal_last_event_frame = Qnil;
866
867 return frame;
868 }
869
870 DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 2, "e",
871 doc: /* Select FRAME.
872 Subsequent editing commands apply to its selected window.
873 Optional argument NORECORD means to neither change the order of
874 recently selected windows nor the buffer list.
875
876 The selection of FRAME lasts until the next time the user does
877 something to select a different frame, or until the next time
878 this function is called. If you are using a window system, the
879 previously selected frame may be restored as the selected frame
880 when returning to the command loop, because it still may have
881 the window system's input focus. On a text terminal, the next
882 redisplay will display FRAME.
883
884 This function returns FRAME, or nil if FRAME has been deleted. */)
885 (Lisp_Object frame, Lisp_Object norecord)
886 {
887 return do_switch_frame (frame, 1, 0, norecord);
888 }
889
890 DEFUN ("handle-focus-in", Fhandle_focus_in, Shandle_focus_in, 1, 1, "e",
891 doc: /* Handle a focus-in event.
892 Focus in events are usually bound to this function.
893 Focus in events occur when a frame has focus, but a switch-frame event
894 is not generated.
895 This function checks if blink-cursor timers should be turned on again. */)
896 (Lisp_Object event)
897 {
898 return call0 (intern ("blink-cursor-check"));
899 }
900
901 DEFUN ("handle-focus-out", Fhandle_focus_out, Shandle_focus_out, 1, 1, "e",
902 doc: /* Handle a focus-out event.
903 Focus out events are usually bound to this function.
904 Focus out events occur when no frame has focus.
905 This function checks if blink-cursor timers should be turned off. */)
906 (Lisp_Object event)
907 {
908 return call0 (intern ("blink-cursor-suspend"));
909 }
910
911 DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 1, "e",
912 doc: /* Handle a switch-frame event EVENT.
913 Switch-frame events are usually bound to this function.
914 A switch-frame event tells Emacs that the window manager has requested
915 that the user's events be directed to the frame mentioned in the event.
916 This function selects the selected window of the frame of EVENT.
917
918 If EVENT is frame object, handle it as if it were a switch-frame event
919 to that frame. */)
920 (Lisp_Object event)
921 {
922 /* Preserve prefix arg that the command loop just cleared. */
923 kset_prefix_arg (current_kboard, Vcurrent_prefix_arg);
924 Frun_hooks (1, &Qmouse_leave_buffer_hook);
925 Fhandle_focus_in (event); // switch-frame implies a focus in.
926 return do_switch_frame (event, 0, 0, Qnil);
927 }
928
929 DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0,
930 doc: /* Return the frame that is now selected. */)
931 (void)
932 {
933 return selected_frame;
934 }
935 \f
936 DEFUN ("frame-list", Fframe_list, Sframe_list,
937 0, 0, 0,
938 doc: /* Return a list of all live frames. */)
939 (void)
940 {
941 Lisp_Object frames;
942 frames = Fcopy_sequence (Vframe_list);
943 #ifdef HAVE_WINDOW_SYSTEM
944 if (FRAMEP (tip_frame))
945 frames = Fdelq (tip_frame, frames);
946 #endif
947 return frames;
948 }
949
950 /* Return CANDIDATE if it can be used as 'other-than-FRAME' frame on the
951 same tty (for tty frames) or among frames which uses FRAME's keyboard.
952 If MINIBUF is nil, do not consider minibuffer-only candidate.
953 If MINIBUF is `visible', do not consider an invisible candidate.
954 If MINIBUF is a window, consider only its own frame and candidate now
955 using that window as the minibuffer.
956 If MINIBUF is 0, consider candidate if it is visible or iconified.
957 Otherwise consider any candidate and return nil if CANDIDATE is not
958 acceptable. */
959
960 static Lisp_Object
961 candidate_frame (Lisp_Object candidate, Lisp_Object frame, Lisp_Object minibuf)
962 {
963 struct frame *c = XFRAME (candidate), *f = XFRAME (frame);
964
965 if ((!FRAME_TERMCAP_P (c) && !FRAME_TERMCAP_P (f)
966 && FRAME_KBOARD (c) == FRAME_KBOARD (f))
967 || (FRAME_TERMCAP_P (c) && FRAME_TERMCAP_P (f)
968 && FRAME_TTY (c) == FRAME_TTY (f)))
969 {
970 if (NILP (minibuf))
971 {
972 if (!FRAME_MINIBUF_ONLY_P (c))
973 return candidate;
974 }
975 else if (EQ (minibuf, Qvisible))
976 {
977 if (FRAME_VISIBLE_P (c))
978 return candidate;
979 }
980 else if (WINDOWP (minibuf))
981 {
982 if (EQ (FRAME_MINIBUF_WINDOW (c), minibuf)
983 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), candidate)
984 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
985 FRAME_FOCUS_FRAME (c)))
986 return candidate;
987 }
988 else if (XFASTINT (minibuf) == 0)
989 {
990 if (FRAME_VISIBLE_P (c) || FRAME_ICONIFIED_P (c))
991 return candidate;
992 }
993 else
994 return candidate;
995 }
996 return Qnil;
997 }
998
999 /* Return the next frame in the frame list after FRAME. */
1000
1001 static Lisp_Object
1002 next_frame (Lisp_Object frame, Lisp_Object minibuf)
1003 {
1004 Lisp_Object f, tail;
1005 int passed = 0;
1006
1007 /* There must always be at least one frame in Vframe_list. */
1008 eassert (CONSP (Vframe_list));
1009
1010 while (passed < 2)
1011 FOR_EACH_FRAME (tail, f)
1012 {
1013 if (passed)
1014 {
1015 f = candidate_frame (f, frame, minibuf);
1016 if (!NILP (f))
1017 return f;
1018 }
1019 if (EQ (frame, f))
1020 passed++;
1021 }
1022 return frame;
1023 }
1024
1025 /* Return the previous frame in the frame list before FRAME. */
1026
1027 static Lisp_Object
1028 prev_frame (Lisp_Object frame, Lisp_Object minibuf)
1029 {
1030 Lisp_Object f, tail, prev = Qnil;
1031
1032 /* There must always be at least one frame in Vframe_list. */
1033 eassert (CONSP (Vframe_list));
1034
1035 FOR_EACH_FRAME (tail, f)
1036 {
1037 if (EQ (frame, f) && !NILP (prev))
1038 return prev;
1039 f = candidate_frame (f, frame, minibuf);
1040 if (!NILP (f))
1041 prev = f;
1042 }
1043
1044 /* We've scanned the entire list. */
1045 if (NILP (prev))
1046 /* We went through the whole frame list without finding a single
1047 acceptable frame. Return the original frame. */
1048 return frame;
1049 else
1050 /* There were no acceptable frames in the list before FRAME; otherwise,
1051 we would have returned directly from the loop. Since PREV is the last
1052 acceptable frame in the list, return it. */
1053 return prev;
1054 }
1055
1056
1057 DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0,
1058 doc: /* Return the next frame in the frame list after FRAME.
1059 It considers only frames on the same terminal as FRAME.
1060 By default, skip minibuffer-only frames.
1061 If omitted, FRAME defaults to the selected frame.
1062 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1063 If MINIFRAME is a window, include only its own frame
1064 and any frame now using that window as the minibuffer.
1065 If MINIFRAME is `visible', include all visible frames.
1066 If MINIFRAME is 0, include all visible and iconified frames.
1067 Otherwise, include all frames. */)
1068 (Lisp_Object frame, Lisp_Object miniframe)
1069 {
1070 if (NILP (frame))
1071 frame = selected_frame;
1072 CHECK_LIVE_FRAME (frame);
1073 return next_frame (frame, miniframe);
1074 }
1075
1076 DEFUN ("previous-frame", Fprevious_frame, Sprevious_frame, 0, 2, 0,
1077 doc: /* Return the previous frame in the frame list before FRAME.
1078 It considers only frames on the same terminal as FRAME.
1079 By default, skip minibuffer-only frames.
1080 If omitted, FRAME defaults to the selected frame.
1081 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1082 If MINIFRAME is a window, include only its own frame
1083 and any frame now using that window as the minibuffer.
1084 If MINIFRAME is `visible', include all visible frames.
1085 If MINIFRAME is 0, include all visible and iconified frames.
1086 Otherwise, include all frames. */)
1087 (Lisp_Object frame, Lisp_Object miniframe)
1088 {
1089 if (NILP (frame))
1090 frame = selected_frame;
1091 CHECK_LIVE_FRAME (frame);
1092 return prev_frame (frame, miniframe);
1093 }
1094 \f
1095 /* Return 1 if it is ok to delete frame F;
1096 0 if all frames aside from F are invisible.
1097 (Exception: if F is the terminal frame, and we are using X, return 1.) */
1098
1099 static int
1100 other_visible_frames (FRAME_PTR f)
1101 {
1102 Lisp_Object frames, this;
1103
1104 FOR_EACH_FRAME (frames, this)
1105 {
1106 if (f == XFRAME (this))
1107 continue;
1108
1109 /* Verify that we can still talk to the frame's X window,
1110 and note any recent change in visibility. */
1111 #ifdef HAVE_WINDOW_SYSTEM
1112 if (FRAME_WINDOW_P (XFRAME (this)))
1113 x_sync (XFRAME (this));
1114 #endif
1115
1116 if (FRAME_VISIBLE_P (XFRAME (this))
1117 || FRAME_ICONIFIED_P (XFRAME (this))
1118 /* Allow deleting the terminal frame when at least one X
1119 frame exists. */
1120 || (FRAME_WINDOW_P (XFRAME (this)) && !FRAME_WINDOW_P (f)))
1121 return 1;
1122 }
1123 return 0;
1124 }
1125
1126 /* Delete FRAME. When FORCE equals Qnoelisp, delete FRAME
1127 unconditionally. x_connection_closed and delete_terminal use
1128 this. Any other value of FORCE implements the semantics
1129 described for Fdelete_frame. */
1130 Lisp_Object
1131 delete_frame (Lisp_Object frame, Lisp_Object force)
1132 {
1133 struct frame *f = decode_any_frame (frame);
1134 struct frame *sf = SELECTED_FRAME ();
1135 struct kboard *kb;
1136
1137 int minibuffer_selected, is_tooltip_frame;
1138
1139 if (! FRAME_LIVE_P (f))
1140 return Qnil;
1141
1142 if (NILP (force) && !other_visible_frames (f))
1143 error ("Attempt to delete the sole visible or iconified frame");
1144
1145 /* x_connection_closed must have set FORCE to `noelisp' in order
1146 to delete the last frame, if it is gone. */
1147 if (NILP (XCDR (Vframe_list)) && !EQ (force, Qnoelisp))
1148 error ("Attempt to delete the only frame");
1149
1150 XSETFRAME (frame, f);
1151
1152 /* Does this frame have a minibuffer, and is it the surrogate
1153 minibuffer for any other frame? */
1154 if (FRAME_HAS_MINIBUF_P (f))
1155 {
1156 Lisp_Object frames, this;
1157
1158 FOR_EACH_FRAME (frames, this)
1159 {
1160 Lisp_Object fminiw;
1161 struct frame *this_f;
1162
1163 if (! EQ (this, frame)
1164 && (this_f = XFRAME (this))
1165 && WINDOWP (fminiw = FRAME_MINIBUF_WINDOW (this_f))
1166 && EQ (frame, WINDOW_FRAME (XWINDOW (fminiw))))
1167 {
1168 /* If we MUST delete this frame, delete the other first.
1169 But do this only if FORCE equals `noelisp'. */
1170 if (EQ (force, Qnoelisp))
1171 delete_frame (this, Qnoelisp);
1172 else
1173 error ("Attempt to delete a surrogate minibuffer frame");
1174 }
1175 }
1176 }
1177
1178 is_tooltip_frame = !NILP (Fframe_parameter (frame, intern ("tooltip")));
1179
1180 /* Run `delete-frame-functions' unless FORCE is `noelisp' or
1181 frame is a tooltip. FORCE is set to `noelisp' when handling
1182 a disconnect from the terminal, so we don't dare call Lisp
1183 code. */
1184 if (NILP (Vrun_hooks) || is_tooltip_frame)
1185 ;
1186 else if (EQ (force, Qnoelisp))
1187 pending_funcalls
1188 = Fcons (list3 (Qrun_hook_with_args, Qdelete_frame_functions, frame),
1189 pending_funcalls);
1190 else
1191 {
1192 #ifdef HAVE_X_WINDOWS
1193 /* Also, save clipboard to the clipboard manager. */
1194 x_clipboard_manager_save_frame (frame);
1195 #endif
1196
1197 safe_call2 (Qrun_hook_with_args, Qdelete_frame_functions, frame);
1198 }
1199
1200 /* The hook may sometimes (indirectly) cause the frame to be deleted. */
1201 if (! FRAME_LIVE_P (f))
1202 return Qnil;
1203
1204 /* At this point, we are committed to deleting the frame.
1205 There is no more chance for errors to prevent it. */
1206
1207 minibuffer_selected = EQ (minibuf_window, selected_window);
1208
1209 /* Don't let the frame remain selected. */
1210 if (f == sf)
1211 {
1212 Lisp_Object tail, frame1;
1213
1214 /* Look for another visible frame on the same terminal. */
1215 frame1 = next_frame (frame, Qvisible);
1216
1217 /* If there is none, find *some* other frame. */
1218 if (NILP (frame1) || EQ (frame1, frame))
1219 {
1220 FOR_EACH_FRAME (tail, frame1)
1221 {
1222 if (! EQ (frame, frame1) && FRAME_LIVE_P (XFRAME (frame1)))
1223 {
1224 /* Do not change a text terminal's top-frame. */
1225 struct frame *f1 = XFRAME (frame1);
1226 if (FRAME_TERMCAP_P (f1) || FRAME_MSDOS_P (f1))
1227 {
1228 Lisp_Object top_frame = FRAME_TTY (f1)->top_frame;
1229 if (!EQ (top_frame, frame))
1230 frame1 = top_frame;
1231 }
1232 break;
1233 }
1234 }
1235 }
1236 #ifdef NS_IMPL_COCOA
1237 else
1238 /* Under NS, there is no system mechanism for choosing a new
1239 window to get focus -- it is left to application code.
1240 So the portion of THIS application interfacing with NS
1241 needs to know about it. We call Fraise_frame, but the
1242 purpose is really to transfer focus. */
1243 Fraise_frame (frame1);
1244 #endif
1245
1246 do_switch_frame (frame1, 0, 1, Qnil);
1247 sf = SELECTED_FRAME ();
1248 }
1249
1250 /* Don't allow minibuf_window to remain on a deleted frame. */
1251 if (EQ (f->minibuffer_window, minibuf_window))
1252 {
1253 /* Use set_window_buffer instead of Fset_window_buffer (see
1254 discussion of bug#11984, bug#12025, bug#12026). */
1255 set_window_buffer (sf->minibuffer_window,
1256 XWINDOW (minibuf_window)->contents, 0, 0);
1257 minibuf_window = sf->minibuffer_window;
1258
1259 /* If the dying minibuffer window was selected,
1260 select the new one. */
1261 if (minibuffer_selected)
1262 Fselect_window (minibuf_window, Qnil);
1263 }
1264
1265 /* Don't let echo_area_window to remain on a deleted frame. */
1266 if (EQ (f->minibuffer_window, echo_area_window))
1267 echo_area_window = sf->minibuffer_window;
1268
1269 /* Clear any X selections for this frame. */
1270 #ifdef HAVE_X_WINDOWS
1271 if (FRAME_X_P (f))
1272 x_clear_frame_selections (f);
1273 #endif
1274
1275 /* Free glyphs.
1276 This function must be called before the window tree of the
1277 frame is deleted because windows contain dynamically allocated
1278 memory. */
1279 free_glyphs (f);
1280
1281 #ifdef HAVE_WINDOW_SYSTEM
1282 /* Give chance to each font driver to free a frame specific data. */
1283 font_update_drivers (f, Qnil);
1284 #endif
1285
1286 /* Mark all the windows that used to be on FRAME as deleted, and then
1287 remove the reference to them. */
1288 delete_all_child_windows (f->root_window);
1289 fset_root_window (f, Qnil);
1290
1291 Vframe_list = Fdelq (frame, Vframe_list);
1292 SET_FRAME_VISIBLE (f, 0);
1293
1294 /* Allow the vector of menu bar contents to be freed in the next
1295 garbage collection. The frame object itself may not be garbage
1296 collected until much later, because recent_keys and other data
1297 structures can still refer to it. */
1298 fset_menu_bar_vector (f, Qnil);
1299
1300 /* If FRAME's buffer lists contains killed
1301 buffers, this helps GC to reclaim them. */
1302 fset_buffer_list (f, Qnil);
1303 fset_buried_buffer_list (f, Qnil);
1304
1305 free_font_driver_list (f);
1306 xfree (f->namebuf);
1307 xfree (f->decode_mode_spec_buffer);
1308 xfree (FRAME_INSERT_COST (f));
1309 xfree (FRAME_DELETEN_COST (f));
1310 xfree (FRAME_INSERTN_COST (f));
1311 xfree (FRAME_DELETE_COST (f));
1312
1313 /* Since some events are handled at the interrupt level, we may get
1314 an event for f at any time; if we zero out the frame's terminal
1315 now, then we may trip up the event-handling code. Instead, we'll
1316 promise that the terminal of the frame must be valid until we
1317 have called the window-system-dependent frame destruction
1318 routine. */
1319
1320 if (FRAME_TERMINAL (f)->delete_frame_hook)
1321 (*FRAME_TERMINAL (f)->delete_frame_hook) (f);
1322
1323 {
1324 struct terminal *terminal = FRAME_TERMINAL (f);
1325 f->output_data.nothing = 0;
1326 f->terminal = 0; /* Now the frame is dead. */
1327
1328 /* If needed, delete the terminal that this frame was on.
1329 (This must be done after the frame is killed.) */
1330 terminal->reference_count--;
1331 #ifdef USE_GTK
1332 /* FIXME: Deleting the terminal crashes emacs because of a GTK
1333 bug.
1334 http://lists.gnu.org/archive/html/emacs-devel/2011-10/msg00363.html */
1335 if (terminal->reference_count == 0 && terminal->type == output_x_window)
1336 terminal->reference_count = 1;
1337 #endif /* USE_GTK */
1338 if (terminal->reference_count == 0)
1339 {
1340 Lisp_Object tmp;
1341 XSETTERMINAL (tmp, terminal);
1342
1343 kb = NULL;
1344 Fdelete_terminal (tmp, NILP (force) ? Qt : force);
1345 }
1346 else
1347 kb = terminal->kboard;
1348 }
1349
1350 /* If we've deleted the last_nonminibuf_frame, then try to find
1351 another one. */
1352 if (f == last_nonminibuf_frame)
1353 {
1354 Lisp_Object frames, this;
1355
1356 last_nonminibuf_frame = 0;
1357
1358 FOR_EACH_FRAME (frames, this)
1359 {
1360 f = XFRAME (this);
1361 if (!FRAME_MINIBUF_ONLY_P (f))
1362 {
1363 last_nonminibuf_frame = f;
1364 break;
1365 }
1366 }
1367 }
1368
1369 /* If there's no other frame on the same kboard, get out of
1370 single-kboard state if we're in it for this kboard. */
1371 if (kb != NULL)
1372 {
1373 Lisp_Object frames, this;
1374 /* Some frame we found on the same kboard, or nil if there are none. */
1375 Lisp_Object frame_on_same_kboard = Qnil;
1376
1377 FOR_EACH_FRAME (frames, this)
1378 if (kb == FRAME_KBOARD (XFRAME (this)))
1379 frame_on_same_kboard = this;
1380
1381 if (NILP (frame_on_same_kboard))
1382 not_single_kboard_state (kb);
1383 }
1384
1385
1386 /* If we've deleted this keyboard's default_minibuffer_frame, try to
1387 find another one. Prefer minibuffer-only frames, but also notice
1388 frames with other windows. */
1389 if (kb != NULL && EQ (frame, KVAR (kb, Vdefault_minibuffer_frame)))
1390 {
1391 Lisp_Object frames, this;
1392
1393 /* The last frame we saw with a minibuffer, minibuffer-only or not. */
1394 Lisp_Object frame_with_minibuf = Qnil;
1395 /* Some frame we found on the same kboard, or nil if there are none. */
1396 Lisp_Object frame_on_same_kboard = Qnil;
1397
1398 FOR_EACH_FRAME (frames, this)
1399 {
1400 struct frame *f1 = XFRAME (this);
1401
1402 /* Consider only frames on the same kboard
1403 and only those with minibuffers. */
1404 if (kb == FRAME_KBOARD (f1)
1405 && FRAME_HAS_MINIBUF_P (f1))
1406 {
1407 frame_with_minibuf = this;
1408 if (FRAME_MINIBUF_ONLY_P (f1))
1409 break;
1410 }
1411
1412 if (kb == FRAME_KBOARD (f1))
1413 frame_on_same_kboard = this;
1414 }
1415
1416 if (!NILP (frame_on_same_kboard))
1417 {
1418 /* We know that there must be some frame with a minibuffer out
1419 there. If this were not true, all of the frames present
1420 would have to be minibufferless, which implies that at some
1421 point their minibuffer frames must have been deleted, but
1422 that is prohibited at the top; you can't delete surrogate
1423 minibuffer frames. */
1424 if (NILP (frame_with_minibuf))
1425 emacs_abort ();
1426
1427 kset_default_minibuffer_frame (kb, frame_with_minibuf);
1428 }
1429 else
1430 /* No frames left on this kboard--say no minibuffer either. */
1431 kset_default_minibuffer_frame (kb, Qnil);
1432 }
1433
1434 /* Cause frame titles to update--necessary if we now have just one frame. */
1435 if (!is_tooltip_frame)
1436 update_mode_lines = 1;
1437
1438 return Qnil;
1439 }
1440
1441 DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 2, "",
1442 doc: /* Delete FRAME, permanently eliminating it from use.
1443 FRAME defaults to the selected frame.
1444
1445 A frame may not be deleted if its minibuffer is used by other frames.
1446 Normally, you may not delete a frame if all other frames are invisible,
1447 but if the second optional argument FORCE is non-nil, you may do so.
1448
1449 This function runs `delete-frame-functions' before actually
1450 deleting the frame, unless the frame is a tooltip.
1451 The functions are run with one argument, the frame to be deleted. */)
1452 (Lisp_Object frame, Lisp_Object force)
1453 {
1454 return delete_frame (frame, !NILP (force) ? Qt : Qnil);
1455 }
1456
1457 \f
1458 /* Return mouse position in character cell units. */
1459
1460 DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0,
1461 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1462 The position is given in character cells, where (0, 0) is the
1463 upper-left corner of the frame, X is the horizontal offset, and Y is
1464 the vertical offset.
1465 If Emacs is running on a mouseless terminal or hasn't been programmed
1466 to read the mouse position, it returns the selected frame for FRAME
1467 and nil for X and Y.
1468 If `mouse-position-function' is non-nil, `mouse-position' calls it,
1469 passing the normal return value to that function as an argument,
1470 and returns whatever that function returns. */)
1471 (void)
1472 {
1473 FRAME_PTR f;
1474 Lisp_Object lispy_dummy;
1475 Lisp_Object x, y, retval;
1476 struct gcpro gcpro1;
1477
1478 f = SELECTED_FRAME ();
1479 x = y = Qnil;
1480
1481 /* It's okay for the hook to refrain from storing anything. */
1482 if (FRAME_TERMINAL (f)->mouse_position_hook)
1483 {
1484 enum scroll_bar_part party_dummy;
1485 Time time_dummy;
1486 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1487 &lispy_dummy, &party_dummy,
1488 &x, &y,
1489 &time_dummy);
1490 }
1491
1492 if (! NILP (x))
1493 {
1494 int col = XINT (x);
1495 int row = XINT (y);
1496 pixel_to_glyph_coords (f, col, row, &col, &row, NULL, 1);
1497 XSETINT (x, col);
1498 XSETINT (y, row);
1499 }
1500 XSETFRAME (lispy_dummy, f);
1501 retval = Fcons (lispy_dummy, Fcons (x, y));
1502 GCPRO1 (retval);
1503 if (!NILP (Vmouse_position_function))
1504 retval = call1 (Vmouse_position_function, retval);
1505 RETURN_UNGCPRO (retval);
1506 }
1507
1508 DEFUN ("mouse-pixel-position", Fmouse_pixel_position,
1509 Smouse_pixel_position, 0, 0, 0,
1510 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1511 The position is given in pixel units, where (0, 0) is the
1512 upper-left corner of the frame, X is the horizontal offset, and Y is
1513 the vertical offset.
1514 If Emacs is running on a mouseless terminal or hasn't been programmed
1515 to read the mouse position, it returns the selected frame for FRAME
1516 and nil for X and Y. */)
1517 (void)
1518 {
1519 FRAME_PTR f;
1520 Lisp_Object lispy_dummy;
1521 Lisp_Object x, y;
1522
1523 f = SELECTED_FRAME ();
1524 x = y = Qnil;
1525
1526 /* It's okay for the hook to refrain from storing anything. */
1527 if (FRAME_TERMINAL (f)->mouse_position_hook)
1528 {
1529 enum scroll_bar_part party_dummy;
1530 Time time_dummy;
1531 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1532 &lispy_dummy, &party_dummy,
1533 &x, &y,
1534 &time_dummy);
1535 }
1536
1537 XSETFRAME (lispy_dummy, f);
1538 return Fcons (lispy_dummy, Fcons (x, y));
1539 }
1540
1541 DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0,
1542 doc: /* Move the mouse pointer to the center of character cell (X,Y) in FRAME.
1543 Coordinates are relative to the frame, not a window,
1544 so the coordinates of the top left character in the frame
1545 may be nonzero due to left-hand scroll bars or the menu bar.
1546
1547 The position is given in character cells, where (0, 0) is the
1548 upper-left corner of the frame, X is the horizontal offset, and Y is
1549 the vertical offset.
1550
1551 This function is a no-op for an X frame that is not visible.
1552 If you have just created a frame, you must wait for it to become visible
1553 before calling this function on it, like this.
1554 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1555 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1556 {
1557 CHECK_LIVE_FRAME (frame);
1558 CHECK_TYPE_RANGED_INTEGER (int, x);
1559 CHECK_TYPE_RANGED_INTEGER (int, y);
1560
1561 /* I think this should be done with a hook. */
1562 #ifdef HAVE_WINDOW_SYSTEM
1563 if (FRAME_WINDOW_P (XFRAME (frame)))
1564 /* Warping the mouse will cause enternotify and focus events. */
1565 x_set_mouse_position (XFRAME (frame), XINT (x), XINT (y));
1566 #else
1567 #if defined (MSDOS)
1568 if (FRAME_MSDOS_P (XFRAME (frame)))
1569 {
1570 Fselect_frame (frame, Qnil);
1571 mouse_moveto (XINT (x), XINT (y));
1572 }
1573 #else
1574 #ifdef HAVE_GPM
1575 {
1576 Fselect_frame (frame, Qnil);
1577 term_mouse_moveto (XINT (x), XINT (y));
1578 }
1579 #endif
1580 #endif
1581 #endif
1582
1583 return Qnil;
1584 }
1585
1586 DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position,
1587 Sset_mouse_pixel_position, 3, 3, 0,
1588 doc: /* Move the mouse pointer to pixel position (X,Y) in FRAME.
1589 The position is given in pixels, where (0, 0) is the upper-left corner
1590 of the frame, X is the horizontal offset, and Y is the vertical offset.
1591
1592 Note, this is a no-op for an X frame that is not visible.
1593 If you have just created a frame, you must wait for it to become visible
1594 before calling this function on it, like this.
1595 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1596 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1597 {
1598 CHECK_LIVE_FRAME (frame);
1599 CHECK_TYPE_RANGED_INTEGER (int, x);
1600 CHECK_TYPE_RANGED_INTEGER (int, y);
1601
1602 /* I think this should be done with a hook. */
1603 #ifdef HAVE_WINDOW_SYSTEM
1604 if (FRAME_WINDOW_P (XFRAME (frame)))
1605 /* Warping the mouse will cause enternotify and focus events. */
1606 x_set_mouse_pixel_position (XFRAME (frame), XINT (x), XINT (y));
1607 #else
1608 #if defined (MSDOS)
1609 if (FRAME_MSDOS_P (XFRAME (frame)))
1610 {
1611 Fselect_frame (frame, Qnil);
1612 mouse_moveto (XINT (x), XINT (y));
1613 }
1614 #else
1615 #ifdef HAVE_GPM
1616 {
1617 Fselect_frame (frame, Qnil);
1618 term_mouse_moveto (XINT (x), XINT (y));
1619 }
1620 #endif
1621 #endif
1622 #endif
1623
1624 return Qnil;
1625 }
1626 \f
1627 static void make_frame_visible_1 (Lisp_Object);
1628
1629 DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible,
1630 0, 1, "",
1631 doc: /* Make the frame FRAME visible (assuming it is an X window).
1632 If omitted, FRAME defaults to the currently selected frame. */)
1633 (Lisp_Object frame)
1634 {
1635 struct frame *f = decode_live_frame (frame);
1636
1637 /* I think this should be done with a hook. */
1638 #ifdef HAVE_WINDOW_SYSTEM
1639 if (FRAME_WINDOW_P (f))
1640 x_make_frame_visible (f);
1641 #endif
1642
1643 make_frame_visible_1 (f->root_window);
1644
1645 /* Make menu bar update for the Buffers and Frames menus. */
1646 windows_or_buffers_changed++;
1647
1648 XSETFRAME (frame, f);
1649 return frame;
1650 }
1651
1652 /* Update the display_time slot of the buffers shown in WINDOW
1653 and all its descendants. */
1654
1655 static void
1656 make_frame_visible_1 (Lisp_Object window)
1657 {
1658 struct window *w;
1659
1660 for (; !NILP (window); window = w->next)
1661 {
1662 w = XWINDOW (window);
1663 if (WINDOWP (w->contents))
1664 make_frame_visible_1 (w->contents);
1665 else
1666 bset_display_time (XBUFFER (w->contents), Fcurrent_time ());
1667 }
1668 }
1669
1670 DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible,
1671 0, 2, "",
1672 doc: /* Make the frame FRAME invisible.
1673 If omitted, FRAME defaults to the currently selected frame.
1674 On graphical displays, invisible frames are not updated and are
1675 usually not displayed at all, even in a window system's \"taskbar\".
1676
1677 Normally you may not make FRAME invisible if all other frames are invisible,
1678 but if the second optional argument FORCE is non-nil, you may do so.
1679
1680 This function has no effect on text terminal frames. Such frames are
1681 always considered visible, whether or not they are currently being
1682 displayed in the terminal. */)
1683 (Lisp_Object frame, Lisp_Object force)
1684 {
1685 struct frame *f = decode_live_frame (frame);
1686
1687 if (NILP (force) && !other_visible_frames (f))
1688 error ("Attempt to make invisible the sole visible or iconified frame");
1689
1690 /* Don't allow minibuf_window to remain on a deleted frame. */
1691 if (EQ (f->minibuffer_window, minibuf_window))
1692 {
1693 struct frame *sf = XFRAME (selected_frame);
1694 /* Use set_window_buffer instead of Fset_window_buffer (see
1695 discussion of bug#11984, bug#12025, bug#12026). */
1696 set_window_buffer (sf->minibuffer_window,
1697 XWINDOW (minibuf_window)->contents, 0, 0);
1698 minibuf_window = sf->minibuffer_window;
1699 }
1700
1701 /* I think this should be done with a hook. */
1702 #ifdef HAVE_WINDOW_SYSTEM
1703 if (FRAME_WINDOW_P (f))
1704 x_make_frame_invisible (f);
1705 #endif
1706
1707 /* Make menu bar update for the Buffers and Frames menus. */
1708 windows_or_buffers_changed++;
1709
1710 return Qnil;
1711 }
1712
1713 DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame,
1714 0, 1, "",
1715 doc: /* Make the frame FRAME into an icon.
1716 If omitted, FRAME defaults to the currently selected frame. */)
1717 (Lisp_Object frame)
1718 {
1719 struct frame *f = decode_live_frame (frame);
1720
1721 /* Don't allow minibuf_window to remain on an iconified frame. */
1722 if (EQ (f->minibuffer_window, minibuf_window))
1723 {
1724 struct frame *sf = XFRAME (selected_frame);
1725 /* Use set_window_buffer instead of Fset_window_buffer (see
1726 discussion of bug#11984, bug#12025, bug#12026). */
1727 set_window_buffer (sf->minibuffer_window,
1728 XWINDOW (minibuf_window)->contents, 0, 0);
1729 minibuf_window = sf->minibuffer_window;
1730 }
1731
1732 /* I think this should be done with a hook. */
1733 #ifdef HAVE_WINDOW_SYSTEM
1734 if (FRAME_WINDOW_P (f))
1735 x_iconify_frame (f);
1736 #endif
1737
1738 /* Make menu bar update for the Buffers and Frames menus. */
1739 windows_or_buffers_changed++;
1740
1741 return Qnil;
1742 }
1743
1744 DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p,
1745 1, 1, 0,
1746 doc: /* Return t if FRAME is \"visible\" (actually in use for display).
1747 Return the symbol `icon' if FRAME is iconified or \"minimized\".
1748 Return nil if FRAME was made invisible, via `make-frame-invisible'.
1749 On graphical displays, invisible frames are not updated and are
1750 usually not displayed at all, even in a window system's \"taskbar\".
1751
1752 If FRAME is a text terminal frame, this always returns t.
1753 Such frames are always considered visible, whether or not they are
1754 currently being displayed on the terminal. */)
1755 (Lisp_Object frame)
1756 {
1757 CHECK_LIVE_FRAME (frame);
1758
1759 if (FRAME_VISIBLE_P (XFRAME (frame)))
1760 return Qt;
1761 if (FRAME_ICONIFIED_P (XFRAME (frame)))
1762 return Qicon;
1763 return Qnil;
1764 }
1765
1766 DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list,
1767 0, 0, 0,
1768 doc: /* Return a list of all frames now \"visible\" (being updated). */)
1769 (void)
1770 {
1771 Lisp_Object tail, frame, value = Qnil;
1772
1773 FOR_EACH_FRAME (tail, frame)
1774 if (FRAME_VISIBLE_P (XFRAME (frame)))
1775 value = Fcons (frame, value);
1776
1777 return value;
1778 }
1779
1780
1781 DEFUN ("raise-frame", Fraise_frame, Sraise_frame, 0, 1, "",
1782 doc: /* Bring FRAME to the front, so it occludes any frames it overlaps.
1783 If FRAME is invisible or iconified, make it visible.
1784 If you don't specify a frame, the selected frame is used.
1785 If Emacs is displaying on an ordinary terminal or some other device which
1786 doesn't support multiple overlapping frames, this function selects FRAME. */)
1787 (Lisp_Object frame)
1788 {
1789 struct frame *f = decode_live_frame (frame);
1790
1791 XSETFRAME (frame, f);
1792
1793 if (FRAME_TERMCAP_P (f))
1794 /* On a text terminal select FRAME. */
1795 Fselect_frame (frame, Qnil);
1796 else
1797 /* Do like the documentation says. */
1798 Fmake_frame_visible (frame);
1799
1800 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
1801 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 1);
1802
1803 return Qnil;
1804 }
1805
1806 /* Should we have a corresponding function called Flower_Power? */
1807 DEFUN ("lower-frame", Flower_frame, Slower_frame, 0, 1, "",
1808 doc: /* Send FRAME to the back, so it is occluded by any frames that overlap it.
1809 If you don't specify a frame, the selected frame is used.
1810 If Emacs is displaying on an ordinary terminal or some other device which
1811 doesn't support multiple overlapping frames, this function does nothing. */)
1812 (Lisp_Object frame)
1813 {
1814 struct frame *f = decode_live_frame (frame);
1815
1816 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
1817 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 0);
1818
1819 return Qnil;
1820 }
1821
1822 \f
1823 DEFUN ("redirect-frame-focus", Fredirect_frame_focus, Sredirect_frame_focus,
1824 1, 2, 0,
1825 doc: /* Arrange for keystrokes typed at FRAME to be sent to FOCUS-FRAME.
1826 In other words, switch-frame events caused by events in FRAME will
1827 request a switch to FOCUS-FRAME, and `last-event-frame' will be
1828 FOCUS-FRAME after reading an event typed at FRAME.
1829
1830 If FOCUS-FRAME is nil, any existing redirection is canceled, and the
1831 frame again receives its own keystrokes.
1832
1833 Focus redirection is useful for temporarily redirecting keystrokes to
1834 a surrogate minibuffer frame when a frame doesn't have its own
1835 minibuffer window.
1836
1837 A frame's focus redirection can be changed by `select-frame'. If frame
1838 FOO is selected, and then a different frame BAR is selected, any
1839 frames redirecting their focus to FOO are shifted to redirect their
1840 focus to BAR. This allows focus redirection to work properly when the
1841 user switches from one frame to another using `select-window'.
1842
1843 This means that a frame whose focus is redirected to itself is treated
1844 differently from a frame whose focus is redirected to nil; the former
1845 is affected by `select-frame', while the latter is not.
1846
1847 The redirection lasts until `redirect-frame-focus' is called to change it. */)
1848 (Lisp_Object frame, Lisp_Object focus_frame)
1849 {
1850 /* Note that we don't check for a live frame here. It's reasonable
1851 to redirect the focus of a frame you're about to delete, if you
1852 know what other frame should receive those keystrokes. */
1853 struct frame *f = decode_any_frame (frame);
1854
1855 if (! NILP (focus_frame))
1856 CHECK_LIVE_FRAME (focus_frame);
1857
1858 fset_focus_frame (f, focus_frame);
1859
1860 if (FRAME_TERMINAL (f)->frame_rehighlight_hook)
1861 (*FRAME_TERMINAL (f)->frame_rehighlight_hook) (f);
1862
1863 return Qnil;
1864 }
1865
1866
1867 DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 0, 1, 0,
1868 doc: /* Return the frame to which FRAME's keystrokes are currently being sent.
1869 If FRAME is omitted or nil, the selected frame is used.
1870 Return nil if FRAME's focus is not redirected.
1871 See `redirect-frame-focus'. */)
1872 (Lisp_Object frame)
1873 {
1874 return FRAME_FOCUS_FRAME (decode_live_frame (frame));
1875 }
1876
1877
1878 \f
1879 /* Return the value of frame parameter PROP in frame FRAME. */
1880
1881 #ifdef HAVE_WINDOW_SYSTEM
1882 #if !HAVE_NS && !defined (WINDOWSNT)
1883 static
1884 #endif
1885 Lisp_Object
1886 get_frame_param (register struct frame *frame, Lisp_Object prop)
1887 {
1888 register Lisp_Object tem;
1889
1890 tem = Fassq (prop, frame->param_alist);
1891 if (EQ (tem, Qnil))
1892 return tem;
1893 return Fcdr (tem);
1894 }
1895 #endif
1896
1897 /* Discard BUFFER from the buffer-list and buried-buffer-list of each frame. */
1898
1899 void
1900 frames_discard_buffer (Lisp_Object buffer)
1901 {
1902 Lisp_Object frame, tail;
1903
1904 FOR_EACH_FRAME (tail, frame)
1905 {
1906 fset_buffer_list
1907 (XFRAME (frame), Fdelq (buffer, XFRAME (frame)->buffer_list));
1908 fset_buried_buffer_list
1909 (XFRAME (frame), Fdelq (buffer, XFRAME (frame)->buried_buffer_list));
1910 }
1911 }
1912
1913 /* Modify the alist in *ALISTPTR to associate PROP with VAL.
1914 If the alist already has an element for PROP, we change it. */
1915
1916 void
1917 store_in_alist (Lisp_Object *alistptr, Lisp_Object prop, Lisp_Object val)
1918 {
1919 register Lisp_Object tem;
1920
1921 tem = Fassq (prop, *alistptr);
1922 if (EQ (tem, Qnil))
1923 *alistptr = Fcons (Fcons (prop, val), *alistptr);
1924 else
1925 Fsetcdr (tem, val);
1926 }
1927
1928 static int
1929 frame_name_fnn_p (char *str, ptrdiff_t len)
1930 {
1931 if (len > 1 && str[0] == 'F' && '0' <= str[1] && str[1] <= '9')
1932 {
1933 char *p = str + 2;
1934 while ('0' <= *p && *p <= '9')
1935 p++;
1936 if (p == str + len)
1937 return 1;
1938 }
1939 return 0;
1940 }
1941
1942 /* Set the name of the terminal frame. Also used by MSDOS frames.
1943 Modeled after x_set_name which is used for WINDOW frames. */
1944
1945 static void
1946 set_term_frame_name (struct frame *f, Lisp_Object name)
1947 {
1948 f->explicit_name = ! NILP (name);
1949
1950 /* If NAME is nil, set the name to F<num>. */
1951 if (NILP (name))
1952 {
1953 char namebuf[sizeof "F" + INT_STRLEN_BOUND (printmax_t)];
1954
1955 /* Check for no change needed in this very common case
1956 before we do any consing. */
1957 if (frame_name_fnn_p (SSDATA (f->name), SBYTES (f->name)))
1958 return;
1959
1960 name = make_formatted_string (namebuf, "F%"pMd, ++tty_frame_count);
1961 }
1962 else
1963 {
1964 CHECK_STRING (name);
1965
1966 /* Don't change the name if it's already NAME. */
1967 if (! NILP (Fstring_equal (name, f->name)))
1968 return;
1969
1970 /* Don't allow the user to set the frame name to F<num>, so it
1971 doesn't clash with the names we generate for terminal frames. */
1972 if (frame_name_fnn_p (SSDATA (name), SBYTES (name)))
1973 error ("Frame names of the form F<num> are usurped by Emacs");
1974 }
1975
1976 fset_name (f, name);
1977 update_mode_lines = 1;
1978 }
1979
1980 void
1981 store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
1982 {
1983 register Lisp_Object old_alist_elt;
1984
1985 /* The buffer-list parameters are stored in a special place and not
1986 in the alist. All buffers must be live. */
1987 if (EQ (prop, Qbuffer_list))
1988 {
1989 Lisp_Object list = Qnil;
1990 for (; CONSP (val); val = XCDR (val))
1991 if (!NILP (Fbuffer_live_p (XCAR (val))))
1992 list = Fcons (XCAR (val), list);
1993 fset_buffer_list (f, Fnreverse (list));
1994 return;
1995 }
1996 if (EQ (prop, Qburied_buffer_list))
1997 {
1998 Lisp_Object list = Qnil;
1999 for (; CONSP (val); val = XCDR (val))
2000 if (!NILP (Fbuffer_live_p (XCAR (val))))
2001 list = Fcons (XCAR (val), list);
2002 fset_buried_buffer_list (f, Fnreverse (list));
2003 return;
2004 }
2005
2006 /* If PROP is a symbol which is supposed to have frame-local values,
2007 and it is set up based on this frame, switch to the global
2008 binding. That way, we can create or alter the frame-local binding
2009 without messing up the symbol's status. */
2010 if (SYMBOLP (prop))
2011 {
2012 struct Lisp_Symbol *sym = XSYMBOL (prop);
2013 start:
2014 switch (sym->redirect)
2015 {
2016 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
2017 case SYMBOL_PLAINVAL: case SYMBOL_FORWARDED: break;
2018 case SYMBOL_LOCALIZED:
2019 { struct Lisp_Buffer_Local_Value *blv = sym->val.blv;
2020 if (blv->frame_local && blv_found (blv) && XFRAME (blv->where) == f)
2021 swap_in_global_binding (sym);
2022 break;
2023 }
2024 default: emacs_abort ();
2025 }
2026 }
2027
2028 /* The tty color needed to be set before the frame's parameter
2029 alist was updated with the new value. This is not true any more,
2030 but we still do this test early on. */
2031 if (FRAME_TERMCAP_P (f) && EQ (prop, Qtty_color_mode)
2032 && f == FRAME_TTY (f)->previous_frame)
2033 /* Force redisplay of this tty. */
2034 FRAME_TTY (f)->previous_frame = NULL;
2035
2036 /* Update the frame parameter alist. */
2037 old_alist_elt = Fassq (prop, f->param_alist);
2038 if (EQ (old_alist_elt, Qnil))
2039 fset_param_alist (f, Fcons (Fcons (prop, val), f->param_alist));
2040 else
2041 Fsetcdr (old_alist_elt, val);
2042
2043 /* Update some other special parameters in their special places
2044 in addition to the alist. */
2045
2046 if (EQ (prop, Qbuffer_predicate))
2047 fset_buffer_predicate (f, val);
2048
2049 if (! FRAME_WINDOW_P (f))
2050 {
2051 if (EQ (prop, Qmenu_bar_lines))
2052 set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f)));
2053 else if (EQ (prop, Qname))
2054 set_term_frame_name (f, val);
2055 }
2056
2057 if (EQ (prop, Qminibuffer) && WINDOWP (val))
2058 {
2059 if (! MINI_WINDOW_P (XWINDOW (val)))
2060 error ("Surrogate minibuffer windows must be minibuffer windows");
2061
2062 if ((FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
2063 && !EQ (val, f->minibuffer_window))
2064 error ("Can't change the surrogate minibuffer of a frame with its own minibuffer");
2065
2066 /* Install the chosen minibuffer window, with proper buffer. */
2067 fset_minibuffer_window (f, val);
2068 }
2069 }
2070
2071 DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0,
2072 doc: /* Return the parameters-alist of frame FRAME.
2073 It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
2074 The meaningful PARMs depend on the kind of frame.
2075 If FRAME is omitted or nil, return information on the currently selected frame. */)
2076 (Lisp_Object frame)
2077 {
2078 Lisp_Object alist;
2079 struct frame *f = decode_any_frame (frame);
2080 int height, width;
2081 struct gcpro gcpro1;
2082
2083 if (!FRAME_LIVE_P (f))
2084 return Qnil;
2085
2086 alist = Fcopy_alist (f->param_alist);
2087 GCPRO1 (alist);
2088
2089 if (!FRAME_WINDOW_P (f))
2090 {
2091 int fg = FRAME_FOREGROUND_PIXEL (f);
2092 int bg = FRAME_BACKGROUND_PIXEL (f);
2093 Lisp_Object elt;
2094
2095 /* If the frame's parameter alist says the colors are
2096 unspecified and reversed, take the frame's background pixel
2097 for foreground and vice versa. */
2098 elt = Fassq (Qforeground_color, alist);
2099 if (CONSP (elt) && STRINGP (XCDR (elt)))
2100 {
2101 if (strncmp (SSDATA (XCDR (elt)),
2102 unspecified_bg,
2103 SCHARS (XCDR (elt))) == 0)
2104 store_in_alist (&alist, Qforeground_color, tty_color_name (f, bg));
2105 else if (strncmp (SSDATA (XCDR (elt)),
2106 unspecified_fg,
2107 SCHARS (XCDR (elt))) == 0)
2108 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2109 }
2110 else
2111 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2112 elt = Fassq (Qbackground_color, alist);
2113 if (CONSP (elt) && STRINGP (XCDR (elt)))
2114 {
2115 if (strncmp (SSDATA (XCDR (elt)),
2116 unspecified_fg,
2117 SCHARS (XCDR (elt))) == 0)
2118 store_in_alist (&alist, Qbackground_color, tty_color_name (f, fg));
2119 else if (strncmp (SSDATA (XCDR (elt)),
2120 unspecified_bg,
2121 SCHARS (XCDR (elt))) == 0)
2122 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2123 }
2124 else
2125 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2126 store_in_alist (&alist, intern ("font"),
2127 build_string (FRAME_MSDOS_P (f)
2128 ? "ms-dos"
2129 : FRAME_W32_P (f) ? "w32term"
2130 :"tty"));
2131 }
2132 store_in_alist (&alist, Qname, f->name);
2133 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2134 store_in_alist (&alist, Qheight, make_number (height));
2135 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2136 store_in_alist (&alist, Qwidth, make_number (width));
2137 store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil));
2138 store_in_alist (&alist, Qminibuffer,
2139 (! FRAME_HAS_MINIBUF_P (f) ? Qnil
2140 : FRAME_MINIBUF_ONLY_P (f) ? Qonly
2141 : FRAME_MINIBUF_WINDOW (f)));
2142 store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
2143 store_in_alist (&alist, Qbuffer_list, f->buffer_list);
2144 store_in_alist (&alist, Qburied_buffer_list, f->buried_buffer_list);
2145
2146 /* I think this should be done with a hook. */
2147 #ifdef HAVE_WINDOW_SYSTEM
2148 if (FRAME_WINDOW_P (f))
2149 x_report_frame_params (f, &alist);
2150 else
2151 #endif
2152 {
2153 /* This ought to be correct in f->param_alist for an X frame. */
2154 Lisp_Object lines;
2155 XSETFASTINT (lines, FRAME_MENU_BAR_LINES (f));
2156 store_in_alist (&alist, Qmenu_bar_lines, lines);
2157 }
2158
2159 UNGCPRO;
2160 return alist;
2161 }
2162
2163
2164 DEFUN ("frame-parameter", Fframe_parameter, Sframe_parameter, 2, 2, 0,
2165 doc: /* Return FRAME's value for parameter PARAMETER.
2166 If FRAME is nil, describe the currently selected frame. */)
2167 (Lisp_Object frame, Lisp_Object parameter)
2168 {
2169 struct frame *f = decode_any_frame (frame);
2170 Lisp_Object value = Qnil;
2171
2172 CHECK_SYMBOL (parameter);
2173
2174 XSETFRAME (frame, f);
2175
2176 if (FRAME_LIVE_P (f))
2177 {
2178 /* Avoid consing in frequent cases. */
2179 if (EQ (parameter, Qname))
2180 value = f->name;
2181 #ifdef HAVE_X_WINDOWS
2182 else if (EQ (parameter, Qdisplay) && FRAME_X_P (f))
2183 value = XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element);
2184 #endif /* HAVE_X_WINDOWS */
2185 else if (EQ (parameter, Qbackground_color)
2186 || EQ (parameter, Qforeground_color))
2187 {
2188 value = Fassq (parameter, f->param_alist);
2189 if (CONSP (value))
2190 {
2191 value = XCDR (value);
2192 /* Fframe_parameters puts the actual fg/bg color names,
2193 even if f->param_alist says otherwise. This is
2194 important when param_alist's notion of colors is
2195 "unspecified". We need to do the same here. */
2196 if (STRINGP (value) && !FRAME_WINDOW_P (f))
2197 {
2198 const char *color_name;
2199 ptrdiff_t csz;
2200
2201 if (EQ (parameter, Qbackground_color))
2202 {
2203 color_name = SSDATA (value);
2204 csz = SCHARS (value);
2205 if (strncmp (color_name, unspecified_bg, csz) == 0)
2206 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2207 else if (strncmp (color_name, unspecified_fg, csz) == 0)
2208 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2209 }
2210 else if (EQ (parameter, Qforeground_color))
2211 {
2212 color_name = SSDATA (value);
2213 csz = SCHARS (value);
2214 if (strncmp (color_name, unspecified_fg, csz) == 0)
2215 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2216 else if (strncmp (color_name, unspecified_bg, csz) == 0)
2217 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2218 }
2219 }
2220 }
2221 else
2222 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2223 }
2224 else if (EQ (parameter, Qdisplay_type)
2225 || EQ (parameter, Qbackground_mode))
2226 value = Fcdr (Fassq (parameter, f->param_alist));
2227 else
2228 /* FIXME: Avoid this code path at all (as well as code duplication)
2229 by sharing more code with Fframe_parameters. */
2230 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2231 }
2232
2233 return value;
2234 }
2235
2236
2237 DEFUN ("modify-frame-parameters", Fmodify_frame_parameters,
2238 Smodify_frame_parameters, 2, 2, 0,
2239 doc: /* Modify the parameters of frame FRAME according to ALIST.
2240 If FRAME is nil, it defaults to the selected frame.
2241 ALIST is an alist of parameters to change and their new values.
2242 Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.
2243 The meaningful PARMs depend on the kind of frame.
2244 Undefined PARMs are ignored, but stored in the frame's parameter list
2245 so that `frame-parameters' will return them.
2246
2247 The value of frame parameter FOO can also be accessed
2248 as a frame-local binding for the variable FOO, if you have
2249 enabled such bindings for that variable with `make-variable-frame-local'.
2250 Note that this functionality is obsolete as of Emacs 22.2, and its
2251 use is not recommended. Explicitly check for a frame-parameter instead. */)
2252 (Lisp_Object frame, Lisp_Object alist)
2253 {
2254 struct frame *f = decode_live_frame (frame);
2255 register Lisp_Object tail, prop, val;
2256
2257 /* I think this should be done with a hook. */
2258 #ifdef HAVE_WINDOW_SYSTEM
2259 if (FRAME_WINDOW_P (f))
2260 x_set_frame_parameters (f, alist);
2261 else
2262 #endif
2263 #ifdef MSDOS
2264 if (FRAME_MSDOS_P (f))
2265 IT_set_frame_parameters (f, alist);
2266 else
2267 #endif
2268
2269 {
2270 EMACS_INT length = XFASTINT (Flength (alist));
2271 ptrdiff_t i;
2272 Lisp_Object *parms;
2273 Lisp_Object *values;
2274 USE_SAFE_ALLOCA;
2275 SAFE_ALLOCA_LISP (parms, 2 * length);
2276 values = parms + length;
2277
2278 /* Extract parm names and values into those vectors. */
2279
2280 i = 0;
2281 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2282 {
2283 Lisp_Object elt;
2284
2285 elt = XCAR (tail);
2286 parms[i] = Fcar (elt);
2287 values[i] = Fcdr (elt);
2288 i++;
2289 }
2290
2291 /* Now process them in reverse of specified order. */
2292 while (--i >= 0)
2293 {
2294 prop = parms[i];
2295 val = values[i];
2296 store_frame_param (f, prop, val);
2297
2298 if (EQ (prop, Qforeground_color)
2299 || EQ (prop, Qbackground_color))
2300 update_face_from_frame_parameter (f, prop, val);
2301 }
2302
2303 SAFE_FREE ();
2304 }
2305 return Qnil;
2306 }
2307 \f
2308 DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height,
2309 0, 1, 0,
2310 doc: /* Height in pixels of a line in the font in frame FRAME.
2311 If FRAME is omitted or nil, the selected frame is used.
2312 For a terminal frame, the value is always 1. */)
2313 (Lisp_Object frame)
2314 {
2315 #ifdef HAVE_WINDOW_SYSTEM
2316 struct frame *f = decode_any_frame (frame);
2317
2318 if (FRAME_WINDOW_P (f))
2319 return make_number (FRAME_LINE_HEIGHT (f));
2320 else
2321 #endif
2322 return make_number (1);
2323 }
2324
2325
2326 DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width,
2327 0, 1, 0,
2328 doc: /* Width in pixels of characters in the font in frame FRAME.
2329 If FRAME is omitted or nil, the selected frame is used.
2330 On a graphical screen, the width is the standard width of the default font.
2331 For a terminal screen, the value is always 1. */)
2332 (Lisp_Object frame)
2333 {
2334 #ifdef HAVE_WINDOW_SYSTEM
2335 struct frame *f = decode_any_frame (frame);
2336
2337 if (FRAME_WINDOW_P (f))
2338 return make_number (FRAME_COLUMN_WIDTH (f));
2339 else
2340 #endif
2341 return make_number (1);
2342 }
2343
2344 DEFUN ("frame-pixel-height", Fframe_pixel_height,
2345 Sframe_pixel_height, 0, 1, 0,
2346 doc: /* Return a FRAME's height in pixels.
2347 If FRAME is omitted or nil, the selected frame is used. The exact value
2348 of the result depends on the window-system and toolkit in use:
2349
2350 In the Gtk+ version of Emacs, it includes only any window (including
2351 the minibuffer or echo area), mode line, and header line. It does not
2352 include the tool bar or menu bar.
2353
2354 With other graphical versions, it also includes the tool bar and the
2355 menu bar.
2356
2357 For a text terminal, it includes the menu bar. In this case, the
2358 result is really in characters rather than pixels (i.e., is identical
2359 to `frame-height'). */)
2360 (Lisp_Object frame)
2361 {
2362 struct frame *f = decode_any_frame (frame);
2363
2364 #ifdef HAVE_WINDOW_SYSTEM
2365 if (FRAME_WINDOW_P (f))
2366 return make_number (x_pixel_height (f));
2367 else
2368 #endif
2369 return make_number (FRAME_LINES (f));
2370 }
2371
2372 DEFUN ("frame-pixel-width", Fframe_pixel_width,
2373 Sframe_pixel_width, 0, 1, 0,
2374 doc: /* Return FRAME's width in pixels.
2375 For a terminal frame, the result really gives the width in characters.
2376 If FRAME is omitted or nil, the selected frame is used. */)
2377 (Lisp_Object frame)
2378 {
2379 struct frame *f = decode_any_frame (frame);
2380
2381 #ifdef HAVE_WINDOW_SYSTEM
2382 if (FRAME_WINDOW_P (f))
2383 return make_number (x_pixel_width (f));
2384 else
2385 #endif
2386 return make_number (FRAME_COLS (f));
2387 }
2388
2389 DEFUN ("tool-bar-pixel-width", Ftool_bar_pixel_width,
2390 Stool_bar_pixel_width, 0, 1, 0,
2391 doc: /* Return width in pixels of FRAME's tool bar.
2392 The result is greater than zero only when the tool bar is on the left
2393 or right side of FRAME. If FRAME is omitted or nil, the selected frame
2394 is used. */)
2395 (Lisp_Object frame)
2396 {
2397 #ifdef FRAME_TOOLBAR_WIDTH
2398 struct frame *f = decode_any_frame (frame);
2399
2400 if (FRAME_WINDOW_P (f))
2401 return make_number (FRAME_TOOLBAR_WIDTH (f));
2402 #endif
2403 return make_number (0);
2404 }
2405 \f
2406 DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0,
2407 doc: /* Specify that the frame FRAME has LINES lines.
2408 Optional third arg non-nil means that redisplay should use LINES lines
2409 but that the idea of the actual height of the frame should not be changed. */)
2410 (Lisp_Object frame, Lisp_Object lines, Lisp_Object pretend)
2411 {
2412 register struct frame *f = decode_live_frame (frame);
2413
2414 CHECK_TYPE_RANGED_INTEGER (int, lines);
2415
2416 /* I think this should be done with a hook. */
2417 #ifdef HAVE_WINDOW_SYSTEM
2418 if (FRAME_WINDOW_P (f))
2419 {
2420 if (XINT (lines) != FRAME_LINES (f))
2421 x_set_window_size (f, 1, FRAME_COLS (f), XINT (lines));
2422 do_pending_window_change (0);
2423 }
2424 else
2425 #endif
2426 change_frame_size (f, XINT (lines), 0, !NILP (pretend), 0, 0);
2427 return Qnil;
2428 }
2429
2430 DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 3, 0,
2431 doc: /* Specify that the frame FRAME has COLS columns.
2432 Optional third arg non-nil means that redisplay should use COLS columns
2433 but that the idea of the actual width of the frame should not be changed. */)
2434 (Lisp_Object frame, Lisp_Object cols, Lisp_Object pretend)
2435 {
2436 register struct frame *f = decode_live_frame (frame);
2437
2438 CHECK_TYPE_RANGED_INTEGER (int, cols);
2439
2440 /* I think this should be done with a hook. */
2441 #ifdef HAVE_WINDOW_SYSTEM
2442 if (FRAME_WINDOW_P (f))
2443 {
2444 if (XINT (cols) != FRAME_COLS (f))
2445 x_set_window_size (f, 1, XINT (cols), FRAME_LINES (f));
2446 do_pending_window_change (0);
2447 }
2448 else
2449 #endif
2450 change_frame_size (f, 0, XINT (cols), !NILP (pretend), 0, 0);
2451 return Qnil;
2452 }
2453
2454 DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0,
2455 doc: /* Sets size of FRAME to COLS by ROWS, measured in characters. */)
2456 (Lisp_Object frame, Lisp_Object cols, Lisp_Object rows)
2457 {
2458 register struct frame *f;
2459
2460 CHECK_LIVE_FRAME (frame);
2461 CHECK_TYPE_RANGED_INTEGER (int, cols);
2462 CHECK_TYPE_RANGED_INTEGER (int, rows);
2463 f = XFRAME (frame);
2464
2465 /* I think this should be done with a hook. */
2466 #ifdef HAVE_WINDOW_SYSTEM
2467 if (FRAME_WINDOW_P (f))
2468 {
2469 if (XINT (rows) != FRAME_LINES (f)
2470 || XINT (cols) != FRAME_COLS (f)
2471 || f->new_text_lines || f->new_text_cols)
2472 x_set_window_size (f, 1, XINT (cols), XINT (rows));
2473 do_pending_window_change (0);
2474 }
2475 else
2476 #endif
2477 change_frame_size (f, XINT (rows), XINT (cols), 0, 0, 0);
2478
2479 return Qnil;
2480 }
2481
2482 DEFUN ("set-frame-position", Fset_frame_position,
2483 Sset_frame_position, 3, 3, 0,
2484 doc: /* Sets position of FRAME in pixels to XOFFSET by YOFFSET.
2485 This is actually the position of the upper left corner of the frame.
2486 Negative values for XOFFSET or YOFFSET are interpreted relative to
2487 the rightmost or bottommost possible position (that stays within the screen). */)
2488 (Lisp_Object frame, Lisp_Object xoffset, Lisp_Object yoffset)
2489 {
2490 register struct frame *f;
2491
2492 CHECK_LIVE_FRAME (frame);
2493 CHECK_TYPE_RANGED_INTEGER (int, xoffset);
2494 CHECK_TYPE_RANGED_INTEGER (int, yoffset);
2495 f = XFRAME (frame);
2496
2497 /* I think this should be done with a hook. */
2498 #ifdef HAVE_WINDOW_SYSTEM
2499 if (FRAME_WINDOW_P (f))
2500 x_set_offset (f, XINT (xoffset), XINT (yoffset), 1);
2501 #endif
2502
2503 return Qt;
2504 }
2505
2506 \f
2507 /***********************************************************************
2508 Frame Parameters
2509 ***********************************************************************/
2510
2511 /* Connect the frame-parameter names for X frames
2512 to the ways of passing the parameter values to the window system.
2513
2514 The name of a parameter, as a Lisp symbol,
2515 has an `x-frame-parameter' property which is an integer in Lisp
2516 that is an index in this table. */
2517
2518 struct frame_parm_table {
2519 const char *name;
2520 Lisp_Object *variable;
2521 };
2522
2523 static const struct frame_parm_table frame_parms[] =
2524 {
2525 {"auto-raise", &Qauto_raise},
2526 {"auto-lower", &Qauto_lower},
2527 {"background-color", 0},
2528 {"border-color", &Qborder_color},
2529 {"border-width", &Qborder_width},
2530 {"cursor-color", &Qcursor_color},
2531 {"cursor-type", &Qcursor_type},
2532 {"font", 0},
2533 {"foreground-color", 0},
2534 {"icon-name", &Qicon_name},
2535 {"icon-type", &Qicon_type},
2536 {"internal-border-width", &Qinternal_border_width},
2537 {"menu-bar-lines", &Qmenu_bar_lines},
2538 {"mouse-color", &Qmouse_color},
2539 {"name", &Qname},
2540 {"scroll-bar-width", &Qscroll_bar_width},
2541 {"title", &Qtitle},
2542 {"unsplittable", &Qunsplittable},
2543 {"vertical-scroll-bars", &Qvertical_scroll_bars},
2544 {"visibility", &Qvisibility},
2545 {"tool-bar-lines", &Qtool_bar_lines},
2546 {"scroll-bar-foreground", &Qscroll_bar_foreground},
2547 {"scroll-bar-background", &Qscroll_bar_background},
2548 {"screen-gamma", &Qscreen_gamma},
2549 {"line-spacing", &Qline_spacing},
2550 {"left-fringe", &Qleft_fringe},
2551 {"right-fringe", &Qright_fringe},
2552 {"wait-for-wm", &Qwait_for_wm},
2553 {"fullscreen", &Qfullscreen},
2554 {"font-backend", &Qfont_backend},
2555 {"alpha", &Qalpha},
2556 {"sticky", &Qsticky},
2557 {"tool-bar-position", &Qtool_bar_position},
2558 };
2559
2560 #ifdef HAVE_NTGUI
2561
2562 /* Calculate fullscreen size. Return in *TOP_POS and *LEFT_POS the
2563 wanted positions of the WM window (not Emacs window).
2564 Return in *WIDTH and *HEIGHT the wanted width and height of Emacs
2565 window (FRAME_X_WINDOW).
2566 */
2567
2568 void
2569 x_fullscreen_adjust (struct frame *f, int *width, int *height, int *top_pos, int *left_pos)
2570 {
2571 int newwidth = FRAME_COLS (f);
2572 int newheight = FRAME_LINES (f);
2573 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2574
2575 *top_pos = f->top_pos;
2576 *left_pos = f->left_pos;
2577
2578 if (f->want_fullscreen & FULLSCREEN_HEIGHT)
2579 {
2580 int ph;
2581
2582 ph = x_display_pixel_height (dpyinfo);
2583 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2584 ph = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, newheight) - f->y_pixels_diff;
2585 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2586 *top_pos = 0;
2587 }
2588
2589 if (f->want_fullscreen & FULLSCREEN_WIDTH)
2590 {
2591 int pw;
2592
2593 pw = x_display_pixel_width (dpyinfo);
2594 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2595 pw = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, newwidth) - f->x_pixels_diff;
2596 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2597 *left_pos = 0;
2598 }
2599
2600 *width = newwidth;
2601 *height = newheight;
2602 }
2603
2604 #endif /* HAVE_NTGUI */
2605
2606 #ifdef HAVE_WINDOW_SYSTEM
2607
2608 /* Change the parameters of frame F as specified by ALIST.
2609 If a parameter is not specially recognized, do nothing special;
2610 otherwise call the `x_set_...' function for that parameter.
2611 Except for certain geometry properties, always call store_frame_param
2612 to store the new value in the parameter alist. */
2613
2614 void
2615 x_set_frame_parameters (FRAME_PTR f, Lisp_Object alist)
2616 {
2617 Lisp_Object tail;
2618
2619 /* If both of these parameters are present, it's more efficient to
2620 set them both at once. So we wait until we've looked at the
2621 entire list before we set them. */
2622 int width, height;
2623
2624 /* Same here. */
2625 Lisp_Object left, top;
2626
2627 /* Same with these. */
2628 Lisp_Object icon_left, icon_top;
2629
2630 /* Record in these vectors all the parms specified. */
2631 Lisp_Object *parms;
2632 Lisp_Object *values;
2633 ptrdiff_t i, p;
2634 int left_no_change = 0, top_no_change = 0;
2635 int icon_left_no_change = 0, icon_top_no_change = 0;
2636 int size_changed = 0;
2637 struct gcpro gcpro1, gcpro2;
2638
2639 i = 0;
2640 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2641 i++;
2642
2643 parms = alloca (i * sizeof *parms);
2644 values = alloca (i * sizeof *values);
2645
2646 /* Extract parm names and values into those vectors. */
2647
2648 i = 0;
2649 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2650 {
2651 Lisp_Object elt;
2652
2653 elt = XCAR (tail);
2654 parms[i] = Fcar (elt);
2655 values[i] = Fcdr (elt);
2656 i++;
2657 }
2658 /* TAIL and ALIST are not used again below here. */
2659 alist = tail = Qnil;
2660
2661 GCPRO2 (*parms, *values);
2662 gcpro1.nvars = i;
2663 gcpro2.nvars = i;
2664
2665 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
2666 because their values appear in VALUES and strings are not valid. */
2667 top = left = Qunbound;
2668 icon_left = icon_top = Qunbound;
2669
2670 /* Provide default values for HEIGHT and WIDTH. */
2671 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2672 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2673
2674 /* Process foreground_color and background_color before anything else.
2675 They are independent of other properties, but other properties (e.g.,
2676 cursor_color) are dependent upon them. */
2677 /* Process default font as well, since fringe widths depends on it. */
2678 for (p = 0; p < i; p++)
2679 {
2680 Lisp_Object prop, val;
2681
2682 prop = parms[p];
2683 val = values[p];
2684 if (EQ (prop, Qforeground_color)
2685 || EQ (prop, Qbackground_color)
2686 || EQ (prop, Qfont))
2687 {
2688 register Lisp_Object param_index, old_value;
2689
2690 old_value = get_frame_param (f, prop);
2691 if (NILP (Fequal (val, old_value)))
2692 {
2693 store_frame_param (f, prop, val);
2694
2695 param_index = Fget (prop, Qx_frame_parameter);
2696 if (NATNUMP (param_index)
2697 && (XFASTINT (param_index)
2698 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2699 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
2700 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2701 }
2702 }
2703 }
2704
2705 /* Now process them in reverse of specified order. */
2706 while (i-- != 0)
2707 {
2708 Lisp_Object prop, val;
2709
2710 prop = parms[i];
2711 val = values[i];
2712
2713 if (EQ (prop, Qwidth) && RANGED_INTEGERP (0, val, INT_MAX))
2714 {
2715 size_changed = 1;
2716 width = XFASTINT (val);
2717 }
2718 else if (EQ (prop, Qheight) && RANGED_INTEGERP (0, val, INT_MAX))
2719 {
2720 size_changed = 1;
2721 height = XFASTINT (val);
2722 }
2723 else if (EQ (prop, Qtop))
2724 top = val;
2725 else if (EQ (prop, Qleft))
2726 left = val;
2727 else if (EQ (prop, Qicon_top))
2728 icon_top = val;
2729 else if (EQ (prop, Qicon_left))
2730 icon_left = val;
2731 else if (EQ (prop, Qforeground_color)
2732 || EQ (prop, Qbackground_color)
2733 || EQ (prop, Qfont))
2734 /* Processed above. */
2735 continue;
2736 else
2737 {
2738 register Lisp_Object param_index, old_value;
2739
2740 old_value = get_frame_param (f, prop);
2741
2742 store_frame_param (f, prop, val);
2743
2744 param_index = Fget (prop, Qx_frame_parameter);
2745 if (NATNUMP (param_index)
2746 && (XFASTINT (param_index)
2747 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2748 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
2749 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2750 }
2751 }
2752
2753 /* Don't die if just one of these was set. */
2754 if (EQ (left, Qunbound))
2755 {
2756 left_no_change = 1;
2757 if (f->left_pos < 0)
2758 left = list2 (Qplus, make_number (f->left_pos));
2759 else
2760 XSETINT (left, f->left_pos);
2761 }
2762 if (EQ (top, Qunbound))
2763 {
2764 top_no_change = 1;
2765 if (f->top_pos < 0)
2766 top = list2 (Qplus, make_number (f->top_pos));
2767 else
2768 XSETINT (top, f->top_pos);
2769 }
2770
2771 /* If one of the icon positions was not set, preserve or default it. */
2772 if (! TYPE_RANGED_INTEGERP (int, icon_left))
2773 {
2774 icon_left_no_change = 1;
2775 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
2776 if (NILP (icon_left))
2777 XSETINT (icon_left, 0);
2778 }
2779 if (! TYPE_RANGED_INTEGERP (int, icon_top))
2780 {
2781 icon_top_no_change = 1;
2782 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
2783 if (NILP (icon_top))
2784 XSETINT (icon_top, 0);
2785 }
2786
2787 /* Don't set these parameters unless they've been explicitly
2788 specified. The window might be mapped or resized while we're in
2789 this function, and we don't want to override that unless the lisp
2790 code has asked for it.
2791
2792 Don't set these parameters unless they actually differ from the
2793 window's current parameters; the window may not actually exist
2794 yet. */
2795 {
2796 Lisp_Object frame;
2797
2798 check_frame_size (f, &height, &width);
2799
2800 XSETFRAME (frame, f);
2801
2802 if (size_changed
2803 && (width != FRAME_COLS (f)
2804 || height != FRAME_LINES (f)
2805 || f->new_text_lines || f->new_text_cols))
2806 Fset_frame_size (frame, make_number (width), make_number (height));
2807
2808 if ((!NILP (left) || !NILP (top))
2809 && ! (left_no_change && top_no_change)
2810 && ! (NUMBERP (left) && XINT (left) == f->left_pos
2811 && NUMBERP (top) && XINT (top) == f->top_pos))
2812 {
2813 int leftpos = 0;
2814 int toppos = 0;
2815
2816 /* Record the signs. */
2817 f->size_hint_flags &= ~ (XNegative | YNegative);
2818 if (EQ (left, Qminus))
2819 f->size_hint_flags |= XNegative;
2820 else if (TYPE_RANGED_INTEGERP (int, left))
2821 {
2822 leftpos = XINT (left);
2823 if (leftpos < 0)
2824 f->size_hint_flags |= XNegative;
2825 }
2826 else if (CONSP (left) && EQ (XCAR (left), Qminus)
2827 && CONSP (XCDR (left))
2828 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (left)), INT_MAX))
2829 {
2830 leftpos = - XINT (XCAR (XCDR (left)));
2831 f->size_hint_flags |= XNegative;
2832 }
2833 else if (CONSP (left) && EQ (XCAR (left), Qplus)
2834 && CONSP (XCDR (left))
2835 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (left))))
2836 {
2837 leftpos = XINT (XCAR (XCDR (left)));
2838 }
2839
2840 if (EQ (top, Qminus))
2841 f->size_hint_flags |= YNegative;
2842 else if (TYPE_RANGED_INTEGERP (int, top))
2843 {
2844 toppos = XINT (top);
2845 if (toppos < 0)
2846 f->size_hint_flags |= YNegative;
2847 }
2848 else if (CONSP (top) && EQ (XCAR (top), Qminus)
2849 && CONSP (XCDR (top))
2850 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (top)), INT_MAX))
2851 {
2852 toppos = - XINT (XCAR (XCDR (top)));
2853 f->size_hint_flags |= YNegative;
2854 }
2855 else if (CONSP (top) && EQ (XCAR (top), Qplus)
2856 && CONSP (XCDR (top))
2857 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (top))))
2858 {
2859 toppos = XINT (XCAR (XCDR (top)));
2860 }
2861
2862
2863 /* Store the numeric value of the position. */
2864 f->top_pos = toppos;
2865 f->left_pos = leftpos;
2866
2867 f->win_gravity = NorthWestGravity;
2868
2869 /* Actually set that position, and convert to absolute. */
2870 x_set_offset (f, leftpos, toppos, -1);
2871 }
2872
2873 if ((!NILP (icon_left) || !NILP (icon_top))
2874 && ! (icon_left_no_change && icon_top_no_change))
2875 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
2876 }
2877
2878 UNGCPRO;
2879 }
2880
2881
2882 /* Insert a description of internally-recorded parameters of frame X
2883 into the parameter alist *ALISTPTR that is to be given to the user.
2884 Only parameters that are specific to the X window system
2885 and whose values are not correctly recorded in the frame's
2886 param_alist need to be considered here. */
2887
2888 void
2889 x_report_frame_params (struct frame *f, Lisp_Object *alistptr)
2890 {
2891 Lisp_Object tem;
2892 uprintmax_t w;
2893 char buf[INT_BUFSIZE_BOUND (w)];
2894
2895 /* Represent negative positions (off the top or left screen edge)
2896 in a way that Fmodify_frame_parameters will understand correctly. */
2897 XSETINT (tem, f->left_pos);
2898 if (f->left_pos >= 0)
2899 store_in_alist (alistptr, Qleft, tem);
2900 else
2901 store_in_alist (alistptr, Qleft, list2 (Qplus, tem));
2902
2903 XSETINT (tem, f->top_pos);
2904 if (f->top_pos >= 0)
2905 store_in_alist (alistptr, Qtop, tem);
2906 else
2907 store_in_alist (alistptr, Qtop, list2 (Qplus, tem));
2908
2909 store_in_alist (alistptr, Qborder_width,
2910 make_number (f->border_width));
2911 store_in_alist (alistptr, Qinternal_border_width,
2912 make_number (FRAME_INTERNAL_BORDER_WIDTH (f)));
2913 store_in_alist (alistptr, Qleft_fringe,
2914 make_number (FRAME_LEFT_FRINGE_WIDTH (f)));
2915 store_in_alist (alistptr, Qright_fringe,
2916 make_number (FRAME_RIGHT_FRINGE_WIDTH (f)));
2917 store_in_alist (alistptr, Qscroll_bar_width,
2918 (! FRAME_HAS_VERTICAL_SCROLL_BARS (f)
2919 ? make_number (0)
2920 : FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0
2921 ? make_number (FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
2922 /* nil means "use default width"
2923 for non-toolkit scroll bar.
2924 ruler-mode.el depends on this. */
2925 : Qnil));
2926 /* FRAME_X_WINDOW is not guaranteed to return an integer. E.g., on
2927 MS-Windows it returns a value whose type is HANDLE, which is
2928 actually a pointer. Explicit casting avoids compiler
2929 warnings. */
2930 w = (uintptr_t) FRAME_X_WINDOW (f);
2931 store_in_alist (alistptr, Qwindow_id,
2932 make_formatted_string (buf, "%"pMu, w));
2933 #ifdef HAVE_X_WINDOWS
2934 #ifdef USE_X_TOOLKIT
2935 /* Tooltip frame may not have this widget. */
2936 if (FRAME_X_OUTPUT (f)->widget)
2937 #endif
2938 w = (uintptr_t) FRAME_OUTER_WINDOW (f);
2939 store_in_alist (alistptr, Qouter_window_id,
2940 make_formatted_string (buf, "%"pMu, w));
2941 #endif
2942 store_in_alist (alistptr, Qicon_name, f->icon_name);
2943 store_in_alist (alistptr, Qvisibility,
2944 (FRAME_VISIBLE_P (f) ? Qt
2945 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
2946 store_in_alist (alistptr, Qdisplay,
2947 XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
2948
2949 if (FRAME_X_OUTPUT (f)->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
2950 tem = Qnil;
2951 else
2952 tem = make_natnum ((uintptr_t) FRAME_X_OUTPUT (f)->parent_desc);
2953 store_in_alist (alistptr, Qexplicit_name, (f->explicit_name ? Qt : Qnil));
2954 store_in_alist (alistptr, Qparent_id, tem);
2955 store_in_alist (alistptr, Qtool_bar_position, f->tool_bar_position);
2956 }
2957
2958
2959 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
2960 the previous value of that parameter, NEW_VALUE is the new value. */
2961
2962 void
2963 x_set_fullscreen (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
2964 {
2965 if (NILP (new_value))
2966 f->want_fullscreen = FULLSCREEN_NONE;
2967 else if (EQ (new_value, Qfullboth) || EQ (new_value, Qfullscreen))
2968 f->want_fullscreen = FULLSCREEN_BOTH;
2969 else if (EQ (new_value, Qfullwidth))
2970 f->want_fullscreen = FULLSCREEN_WIDTH;
2971 else if (EQ (new_value, Qfullheight))
2972 f->want_fullscreen = FULLSCREEN_HEIGHT;
2973 else if (EQ (new_value, Qmaximized))
2974 f->want_fullscreen = FULLSCREEN_MAXIMIZED;
2975
2976 if (FRAME_TERMINAL (f)->fullscreen_hook != NULL)
2977 FRAME_TERMINAL (f)->fullscreen_hook (f);
2978 }
2979
2980
2981 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
2982 the previous value of that parameter, NEW_VALUE is the new value. */
2983
2984 void
2985 x_set_line_spacing (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
2986 {
2987 if (NILP (new_value))
2988 f->extra_line_spacing = 0;
2989 else if (RANGED_INTEGERP (0, new_value, INT_MAX))
2990 f->extra_line_spacing = XFASTINT (new_value);
2991 else if (FLOATP (new_value))
2992 {
2993 int new_spacing = XFLOAT_DATA (new_value) * FRAME_LINE_HEIGHT (f) + 0.5;
2994
2995 if (new_spacing >= 0)
2996 f->extra_line_spacing = new_spacing;
2997 else
2998 signal_error ("Invalid line-spacing", new_value);
2999 }
3000 else
3001 signal_error ("Invalid line-spacing", new_value);
3002 if (FRAME_VISIBLE_P (f))
3003 redraw_frame (f);
3004 }
3005
3006
3007 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
3008 the previous value of that parameter, NEW_VALUE is the new value. */
3009
3010 void
3011 x_set_screen_gamma (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3012 {
3013 Lisp_Object bgcolor;
3014
3015 if (NILP (new_value))
3016 f->gamma = 0;
3017 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
3018 /* The value 0.4545 is the normal viewing gamma. */
3019 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
3020 else
3021 signal_error ("Invalid screen-gamma", new_value);
3022
3023 /* Apply the new gamma value to the frame background. */
3024 bgcolor = Fassq (Qbackground_color, f->param_alist);
3025 if (CONSP (bgcolor) && (bgcolor = XCDR (bgcolor), STRINGP (bgcolor)))
3026 {
3027 Lisp_Object parm_index = Fget (Qbackground_color, Qx_frame_parameter);
3028 if (NATNUMP (parm_index)
3029 && (XFASTINT (parm_index)
3030 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3031 && FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
3032 (*FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
3033 (f, bgcolor, Qnil);
3034 }
3035
3036 Fclear_face_cache (Qnil);
3037 }
3038
3039
3040 void
3041 x_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3042 {
3043 Lisp_Object font_object;
3044 int fontset = -1;
3045 #ifdef HAVE_X_WINDOWS
3046 Lisp_Object font_param = arg;
3047 #endif
3048
3049 /* Set the frame parameter back to the old value because we may
3050 fail to use ARG as the new parameter value. */
3051 store_frame_param (f, Qfont, oldval);
3052
3053 /* ARG is a fontset name, a font name, a cons of fontset name and a
3054 font object, or a font object. In the last case, this function
3055 never fail. */
3056 if (STRINGP (arg))
3057 {
3058 fontset = fs_query_fontset (arg, 0);
3059 if (fontset < 0)
3060 {
3061 font_object = font_open_by_name (f, arg);
3062 if (NILP (font_object))
3063 error ("Font `%s' is not defined", SSDATA (arg));
3064 arg = AREF (font_object, FONT_NAME_INDEX);
3065 }
3066 else if (fontset > 0)
3067 {
3068 font_object = font_open_by_name (f, fontset_ascii (fontset));
3069 if (NILP (font_object))
3070 error ("Font `%s' is not defined", SDATA (arg));
3071 arg = AREF (font_object, FONT_NAME_INDEX);
3072 }
3073 else
3074 error ("The default fontset can't be used for a frame font");
3075 }
3076 else if (CONSP (arg) && STRINGP (XCAR (arg)) && FONT_OBJECT_P (XCDR (arg)))
3077 {
3078 /* This is the case that the ASCII font of F's fontset XCAR
3079 (arg) is changed to the font XCDR (arg) by
3080 `set-fontset-font'. */
3081 fontset = fs_query_fontset (XCAR (arg), 0);
3082 if (fontset < 0)
3083 error ("Unknown fontset: %s", SDATA (XCAR (arg)));
3084 font_object = XCDR (arg);
3085 arg = AREF (font_object, FONT_NAME_INDEX);
3086 #ifdef HAVE_X_WINDOWS
3087 font_param = Ffont_get (font_object, QCname);
3088 #endif
3089 }
3090 else if (FONT_OBJECT_P (arg))
3091 {
3092 font_object = arg;
3093 #ifdef HAVE_X_WINDOWS
3094 font_param = Ffont_get (font_object, QCname);
3095 #endif
3096 /* This is to store the XLFD font name in the frame parameter for
3097 backward compatibility. We should store the font-object
3098 itself in the future. */
3099 arg = AREF (font_object, FONT_NAME_INDEX);
3100 fontset = FRAME_FONTSET (f);
3101 /* Check if we can use the current fontset. If not, set FONTSET
3102 to -1 to generate a new fontset from FONT-OBJECT. */
3103 if (fontset >= 0)
3104 {
3105 Lisp_Object ascii_font = fontset_ascii (fontset);
3106 Lisp_Object spec = font_spec_from_name (ascii_font);
3107
3108 if (NILP (spec))
3109 signal_error ("Invalid font name", ascii_font);
3110
3111 if (! font_match_p (spec, font_object))
3112 fontset = -1;
3113 }
3114 }
3115 else
3116 signal_error ("Invalid font", arg);
3117
3118 if (! NILP (Fequal (font_object, oldval)))
3119 return;
3120
3121 x_new_font (f, font_object, fontset);
3122 store_frame_param (f, Qfont, arg);
3123 #ifdef HAVE_X_WINDOWS
3124 store_frame_param (f, Qfont_param, font_param);
3125 #endif
3126 /* Recalculate toolbar height. */
3127 f->n_tool_bar_rows = 0;
3128 /* Ensure we redraw it. */
3129 clear_current_matrices (f);
3130
3131 recompute_basic_faces (f);
3132
3133 do_pending_window_change (0);
3134
3135 /* We used to call face-set-after-frame-default here, but it leads to
3136 recursive calls (since that function can set the `default' face's
3137 font which in turns changes the frame's `font' parameter).
3138 Also I don't know what this call is meant to do, but it seems the
3139 wrong way to do it anyway (it does a lot more work than what seems
3140 reasonable in response to a change to `font'). */
3141 }
3142
3143
3144 void
3145 x_set_font_backend (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3146 {
3147 if (! NILP (new_value)
3148 && !CONSP (new_value))
3149 {
3150 char *p0, *p1;
3151
3152 CHECK_STRING (new_value);
3153 p0 = p1 = SSDATA (new_value);
3154 new_value = Qnil;
3155 while (*p0)
3156 {
3157 while (*p1 && ! c_isspace (*p1) && *p1 != ',') p1++;
3158 if (p0 < p1)
3159 new_value = Fcons (Fintern (make_string (p0, p1 - p0), Qnil),
3160 new_value);
3161 if (*p1)
3162 {
3163 int c;
3164
3165 while ((c = *++p1) && c_isspace (c));
3166 }
3167 p0 = p1;
3168 }
3169 new_value = Fnreverse (new_value);
3170 }
3171
3172 if (! NILP (old_value) && ! NILP (Fequal (old_value, new_value)))
3173 return;
3174
3175 if (FRAME_FONT (f))
3176 free_all_realized_faces (Qnil);
3177
3178 new_value = font_update_drivers (f, NILP (new_value) ? Qt : new_value);
3179 if (NILP (new_value))
3180 {
3181 if (NILP (old_value))
3182 error ("No font backend available");
3183 font_update_drivers (f, old_value);
3184 error ("None of specified font backends are available");
3185 }
3186 store_frame_param (f, Qfont_backend, new_value);
3187
3188 if (FRAME_FONT (f))
3189 {
3190 Lisp_Object frame;
3191
3192 XSETFRAME (frame, f);
3193 x_set_font (f, Fframe_parameter (frame, Qfont), Qnil);
3194 ++face_change_count;
3195 ++windows_or_buffers_changed;
3196 }
3197 }
3198
3199
3200 void
3201 x_set_fringe_width (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3202 {
3203 compute_fringe_widths (f, 1);
3204 #ifdef HAVE_X_WINDOWS
3205 /* Must adjust this so window managers report correct number of columns. */
3206 if (FRAME_X_WINDOW (f) != 0)
3207 x_wm_set_size_hint (f, 0, 0);
3208 #endif
3209 }
3210
3211 void
3212 x_set_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3213 {
3214 CHECK_TYPE_RANGED_INTEGER (int, arg);
3215
3216 if (XINT (arg) == f->border_width)
3217 return;
3218
3219 if (FRAME_X_WINDOW (f) != 0)
3220 error ("Cannot change the border width of a frame");
3221
3222 f->border_width = XINT (arg);
3223 }
3224
3225 void
3226 x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3227 {
3228 int old = FRAME_INTERNAL_BORDER_WIDTH (f);
3229
3230 CHECK_TYPE_RANGED_INTEGER (int, arg);
3231 FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
3232 if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
3233 FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
3234
3235 #ifdef USE_X_TOOLKIT
3236 if (FRAME_X_OUTPUT (f)->edit_widget)
3237 widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
3238 #endif
3239
3240 if (FRAME_INTERNAL_BORDER_WIDTH (f) == old)
3241 return;
3242
3243 if (FRAME_X_WINDOW (f) != 0)
3244 {
3245 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3246 SET_FRAME_GARBAGED (f);
3247 do_pending_window_change (0);
3248 }
3249 else
3250 SET_FRAME_GARBAGED (f);
3251 }
3252
3253 void
3254 x_set_visibility (struct frame *f, Lisp_Object value, Lisp_Object oldval)
3255 {
3256 Lisp_Object frame;
3257 XSETFRAME (frame, f);
3258
3259 if (NILP (value))
3260 Fmake_frame_invisible (frame, Qt);
3261 else if (EQ (value, Qicon))
3262 Ficonify_frame (frame);
3263 else
3264 Fmake_frame_visible (frame);
3265 }
3266
3267 void
3268 x_set_autoraise (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3269 {
3270 f->auto_raise = !EQ (Qnil, arg);
3271 }
3272
3273 void
3274 x_set_autolower (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3275 {
3276 f->auto_lower = !EQ (Qnil, arg);
3277 }
3278
3279 void
3280 x_set_unsplittable (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3281 {
3282 f->no_split = !NILP (arg);
3283 }
3284
3285 void
3286 x_set_vertical_scroll_bars (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3287 {
3288 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
3289 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
3290 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
3291 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
3292 {
3293 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
3294 = (NILP (arg)
3295 ? vertical_scroll_bar_none
3296 : EQ (Qleft, arg)
3297 ? vertical_scroll_bar_left
3298 : EQ (Qright, arg)
3299 ? vertical_scroll_bar_right
3300 : EQ (Qleft, Vdefault_frame_scroll_bars)
3301 ? vertical_scroll_bar_left
3302 : EQ (Qright, Vdefault_frame_scroll_bars)
3303 ? vertical_scroll_bar_right
3304 : vertical_scroll_bar_none);
3305
3306 /* We set this parameter before creating the X window for the
3307 frame, so we can get the geometry right from the start.
3308 However, if the window hasn't been created yet, we shouldn't
3309 call x_set_window_size. */
3310 if (FRAME_X_WINDOW (f))
3311 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3312 do_pending_window_change (0);
3313 }
3314 }
3315
3316 void
3317 x_set_scroll_bar_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3318 {
3319 int wid = FRAME_COLUMN_WIDTH (f);
3320
3321 if (NILP (arg))
3322 {
3323 x_set_scroll_bar_default_width (f);
3324
3325 if (FRAME_X_WINDOW (f))
3326 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3327 do_pending_window_change (0);
3328 }
3329 else if (RANGED_INTEGERP (1, arg, INT_MAX)
3330 && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3331 {
3332 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
3333 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
3334
3335 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg);
3336 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
3337 if (FRAME_X_WINDOW (f))
3338 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3339 do_pending_window_change (0);
3340 }
3341
3342 change_frame_size (f, 0, FRAME_COLS (f), 0, 0, 0);
3343 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
3344 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
3345 }
3346
3347
3348
3349 /* Return non-nil if frame F wants a bitmap icon. */
3350
3351 Lisp_Object
3352 x_icon_type (FRAME_PTR f)
3353 {
3354 Lisp_Object tem;
3355
3356 tem = assq_no_quit (Qicon_type, f->param_alist);
3357 if (CONSP (tem))
3358 return XCDR (tem);
3359 else
3360 return Qnil;
3361 }
3362
3363 void
3364 x_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3365 {
3366 double alpha = 1.0;
3367 double newval[2];
3368 int i;
3369 Lisp_Object item;
3370
3371 for (i = 0; i < 2; i++)
3372 {
3373 newval[i] = 1.0;
3374 if (CONSP (arg))
3375 {
3376 item = CAR (arg);
3377 arg = CDR (arg);
3378 }
3379 else
3380 item = arg;
3381
3382 if (NILP (item))
3383 alpha = - 1.0;
3384 else if (FLOATP (item))
3385 {
3386 alpha = XFLOAT_DATA (item);
3387 if (! (0 <= alpha && alpha <= 1.0))
3388 args_out_of_range (make_float (0.0), make_float (1.0));
3389 }
3390 else if (INTEGERP (item))
3391 {
3392 EMACS_INT ialpha = XINT (item);
3393 if (! (0 <= ialpha && alpha <= 100))
3394 args_out_of_range (make_number (0), make_number (100));
3395 alpha = ialpha / 100.0;
3396 }
3397 else
3398 wrong_type_argument (Qnumberp, item);
3399 newval[i] = alpha;
3400 }
3401
3402 for (i = 0; i < 2; i++)
3403 f->alpha[i] = newval[i];
3404
3405 #if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA)
3406 block_input ();
3407 x_set_frame_alpha (f);
3408 unblock_input ();
3409 #endif
3410
3411 return;
3412 }
3413
3414 \f
3415 /* Subroutines of creating an X frame. */
3416
3417 /* Make sure that Vx_resource_name is set to a reasonable value.
3418 Fix it up, or set it to `emacs' if it is too hopeless. */
3419
3420 void
3421 validate_x_resource_name (void)
3422 {
3423 ptrdiff_t len = 0;
3424 /* Number of valid characters in the resource name. */
3425 ptrdiff_t good_count = 0;
3426 /* Number of invalid characters in the resource name. */
3427 ptrdiff_t bad_count = 0;
3428 Lisp_Object new;
3429 ptrdiff_t i;
3430
3431 if (!STRINGP (Vx_resource_class))
3432 Vx_resource_class = build_string (EMACS_CLASS);
3433
3434 if (STRINGP (Vx_resource_name))
3435 {
3436 unsigned char *p = SDATA (Vx_resource_name);
3437
3438 len = SBYTES (Vx_resource_name);
3439
3440 /* Only letters, digits, - and _ are valid in resource names.
3441 Count the valid characters and count the invalid ones. */
3442 for (i = 0; i < len; i++)
3443 {
3444 int c = p[i];
3445 if (! ((c >= 'a' && c <= 'z')
3446 || (c >= 'A' && c <= 'Z')
3447 || (c >= '0' && c <= '9')
3448 || c == '-' || c == '_'))
3449 bad_count++;
3450 else
3451 good_count++;
3452 }
3453 }
3454 else
3455 /* Not a string => completely invalid. */
3456 bad_count = 5, good_count = 0;
3457
3458 /* If name is valid already, return. */
3459 if (bad_count == 0)
3460 return;
3461
3462 /* If name is entirely invalid, or nearly so, or is so implausibly
3463 large that alloca might not work, use `emacs'. */
3464 if (good_count < 2 || MAX_ALLOCA - sizeof ".customization" < len)
3465 {
3466 Vx_resource_name = build_string ("emacs");
3467 return;
3468 }
3469
3470 /* Name is partly valid. Copy it and replace the invalid characters
3471 with underscores. */
3472
3473 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
3474
3475 for (i = 0; i < len; i++)
3476 {
3477 int c = SREF (new, i);
3478 if (! ((c >= 'a' && c <= 'z')
3479 || (c >= 'A' && c <= 'Z')
3480 || (c >= '0' && c <= '9')
3481 || c == '-' || c == '_'))
3482 SSET (new, i, '_');
3483 }
3484 }
3485
3486
3487 extern char *x_get_string_resource (XrmDatabase, const char *, const char *);
3488 extern Display_Info *check_x_display_info (Lisp_Object);
3489
3490
3491 /* Get specified attribute from resource database RDB.
3492 See Fx_get_resource below for other parameters. */
3493
3494 static Lisp_Object
3495 xrdb_get_resource (XrmDatabase rdb, Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3496 {
3497 register char *value;
3498 char *name_key;
3499 char *class_key;
3500
3501 CHECK_STRING (attribute);
3502 CHECK_STRING (class);
3503
3504 if (!NILP (component))
3505 CHECK_STRING (component);
3506 if (!NILP (subclass))
3507 CHECK_STRING (subclass);
3508 if (NILP (component) != NILP (subclass))
3509 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3510
3511 validate_x_resource_name ();
3512
3513 /* Allocate space for the components, the dots which separate them,
3514 and the final '\0'. Make them big enough for the worst case. */
3515 name_key = alloca (SBYTES (Vx_resource_name)
3516 + (STRINGP (component)
3517 ? SBYTES (component) : 0)
3518 + SBYTES (attribute)
3519 + 3);
3520
3521 class_key = alloca (SBYTES (Vx_resource_class)
3522 + SBYTES (class)
3523 + (STRINGP (subclass)
3524 ? SBYTES (subclass) : 0)
3525 + 3);
3526
3527 /* Start with emacs.FRAMENAME for the name (the specific one)
3528 and with `Emacs' for the class key (the general one). */
3529 strcpy (name_key, SSDATA (Vx_resource_name));
3530 strcpy (class_key, SSDATA (Vx_resource_class));
3531
3532 strcat (class_key, ".");
3533 strcat (class_key, SSDATA (class));
3534
3535 if (!NILP (component))
3536 {
3537 strcat (class_key, ".");
3538 strcat (class_key, SSDATA (subclass));
3539
3540 strcat (name_key, ".");
3541 strcat (name_key, SSDATA (component));
3542 }
3543
3544 strcat (name_key, ".");
3545 strcat (name_key, SSDATA (attribute));
3546
3547 value = x_get_string_resource (rdb, name_key, class_key);
3548
3549 if (value != (char *) 0 && *value)
3550 return build_string (value);
3551 else
3552 return Qnil;
3553 }
3554
3555
3556 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
3557 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
3558 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
3559 class, where INSTANCE is the name under which Emacs was invoked, or
3560 the name specified by the `-name' or `-rn' command-line arguments.
3561
3562 The optional arguments COMPONENT and SUBCLASS add to the key and the
3563 class, respectively. You must specify both of them or neither.
3564 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
3565 and the class is `Emacs.CLASS.SUBCLASS'. */)
3566 (Lisp_Object attribute, Lisp_Object class, Lisp_Object component,
3567 Lisp_Object subclass)
3568 {
3569 check_window_system (NULL);
3570
3571 return xrdb_get_resource (check_x_display_info (Qnil)->xrdb,
3572 attribute, class, component, subclass);
3573 }
3574
3575 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
3576
3577 Lisp_Object
3578 display_x_get_resource (Display_Info *dpyinfo, Lisp_Object attribute,
3579 Lisp_Object class, Lisp_Object component,
3580 Lisp_Object subclass)
3581 {
3582 return xrdb_get_resource (dpyinfo->xrdb,
3583 attribute, class, component, subclass);
3584 }
3585
3586 #if defined HAVE_X_WINDOWS && !defined USE_X_TOOLKIT
3587 /* Used when C code wants a resource value. */
3588 /* Called from oldXMenu/Create.c. */
3589 char *
3590 x_get_resource_string (const char *attribute, const char *class)
3591 {
3592 char *result;
3593 struct frame *sf = SELECTED_FRAME ();
3594 ptrdiff_t invocation_namelen = SBYTES (Vinvocation_name);
3595 USE_SAFE_ALLOCA;
3596
3597 /* Allocate space for the components, the dots which separate them,
3598 and the final '\0'. */
3599 char *name_key = SAFE_ALLOCA (invocation_namelen + strlen (attribute) + 2);
3600 char *class_key = alloca ((sizeof (EMACS_CLASS) - 1) + strlen (class) + 2);
3601
3602 esprintf (name_key, "%s.%s", SSDATA (Vinvocation_name), attribute);
3603 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3604
3605 result = x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
3606 name_key, class_key);
3607 SAFE_FREE ();
3608 return result;
3609 }
3610 #endif
3611
3612 /* Return the value of parameter PARAM.
3613
3614 First search ALIST, then Vdefault_frame_alist, then the X defaults
3615 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3616
3617 Convert the resource to the type specified by desired_type.
3618
3619 If no default is specified, return Qunbound. If you call
3620 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3621 and don't let it get stored in any Lisp-visible variables! */
3622
3623 Lisp_Object
3624 x_get_arg (Display_Info *dpyinfo, Lisp_Object alist, Lisp_Object param,
3625 const char *attribute, const char *class, enum resource_types type)
3626 {
3627 register Lisp_Object tem;
3628
3629 tem = Fassq (param, alist);
3630
3631 if (!NILP (tem))
3632 {
3633 /* If we find this parm in ALIST, clear it out
3634 so that it won't be "left over" at the end. */
3635 Lisp_Object tail;
3636 XSETCAR (tem, Qnil);
3637 /* In case the parameter appears more than once in the alist,
3638 clear it out. */
3639 for (tail = alist; CONSP (tail); tail = XCDR (tail))
3640 if (CONSP (XCAR (tail))
3641 && EQ (XCAR (XCAR (tail)), param))
3642 XSETCAR (XCAR (tail), Qnil);
3643 }
3644 else
3645 tem = Fassq (param, Vdefault_frame_alist);
3646
3647 /* If it wasn't specified in ALIST or the Lisp-level defaults,
3648 look in the X resources. */
3649 if (EQ (tem, Qnil))
3650 {
3651 if (attribute && dpyinfo)
3652 {
3653 tem = display_x_get_resource (dpyinfo,
3654 build_string (attribute),
3655 build_string (class),
3656 Qnil, Qnil);
3657
3658 if (NILP (tem))
3659 return Qunbound;
3660
3661 switch (type)
3662 {
3663 case RES_TYPE_NUMBER:
3664 return make_number (atoi (SSDATA (tem)));
3665
3666 case RES_TYPE_BOOLEAN_NUMBER:
3667 if (!strcmp (SSDATA (tem), "on")
3668 || !strcmp (SSDATA (tem), "true"))
3669 return make_number (1);
3670 return make_number (atoi (SSDATA (tem)));
3671 break;
3672
3673 case RES_TYPE_FLOAT:
3674 return make_float (atof (SSDATA (tem)));
3675
3676 case RES_TYPE_BOOLEAN:
3677 tem = Fdowncase (tem);
3678 if (!strcmp (SSDATA (tem), "on")
3679 #ifdef HAVE_NS
3680 || !strcmp (SSDATA (tem), "yes")
3681 #endif
3682 || !strcmp (SSDATA (tem), "true"))
3683 return Qt;
3684 else
3685 return Qnil;
3686
3687 case RES_TYPE_STRING:
3688 return tem;
3689
3690 case RES_TYPE_SYMBOL:
3691 /* As a special case, we map the values `true' and `on'
3692 to Qt, and `false' and `off' to Qnil. */
3693 {
3694 Lisp_Object lower;
3695 lower = Fdowncase (tem);
3696 if (!strcmp (SSDATA (lower), "on")
3697 #ifdef HAVE_NS
3698 || !strcmp (SSDATA (lower), "yes")
3699 #endif
3700 || !strcmp (SSDATA (lower), "true"))
3701 return Qt;
3702 else if (!strcmp (SSDATA (lower), "off")
3703 #ifdef HAVE_NS
3704 || !strcmp (SSDATA (lower), "no")
3705 #endif
3706 || !strcmp (SSDATA (lower), "false"))
3707 return Qnil;
3708 else
3709 return Fintern (tem, Qnil);
3710 }
3711
3712 default:
3713 emacs_abort ();
3714 }
3715 }
3716 else
3717 return Qunbound;
3718 }
3719 return Fcdr (tem);
3720 }
3721
3722 static Lisp_Object
3723 x_frame_get_arg (struct frame *f, Lisp_Object alist, Lisp_Object param,
3724 const char *attribute, const char *class,
3725 enum resource_types type)
3726 {
3727 return x_get_arg (FRAME_X_DISPLAY_INFO (f),
3728 alist, param, attribute, class, type);
3729 }
3730
3731 /* Like x_frame_get_arg, but also record the value in f->param_alist. */
3732
3733 Lisp_Object
3734 x_frame_get_and_record_arg (struct frame *f, Lisp_Object alist,
3735 Lisp_Object param,
3736 const char *attribute, const char *class,
3737 enum resource_types type)
3738 {
3739 Lisp_Object value;
3740
3741 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
3742 attribute, class, type);
3743 if (! NILP (value) && ! EQ (value, Qunbound))
3744 store_frame_param (f, param, value);
3745
3746 return value;
3747 }
3748
3749
3750 /* Record in frame F the specified or default value according to ALIST
3751 of the parameter named PROP (a Lisp symbol).
3752 If no value is specified for PROP, look for an X default for XPROP
3753 on the frame named NAME.
3754 If that is not found either, use the value DEFLT. */
3755
3756 Lisp_Object
3757 x_default_parameter (struct frame *f, Lisp_Object alist, Lisp_Object prop,
3758 Lisp_Object deflt, const char *xprop, const char *xclass,
3759 enum resource_types type)
3760 {
3761 Lisp_Object tem;
3762
3763 tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type);
3764 if (EQ (tem, Qunbound))
3765 tem = deflt;
3766 x_set_frame_parameters (f, list1 (Fcons (prop, tem)));
3767 return tem;
3768 }
3769
3770
3771 #if !defined (HAVE_X_WINDOWS) && defined (NoValue)
3772
3773 /*
3774 * XParseGeometry parses strings of the form
3775 * "=<width>x<height>{+-}<xoffset>{+-}<yoffset>", where
3776 * width, height, xoffset, and yoffset are unsigned integers.
3777 * Example: "=80x24+300-49"
3778 * The equal sign is optional.
3779 * It returns a bitmask that indicates which of the four values
3780 * were actually found in the string. For each value found,
3781 * the corresponding argument is updated; for each value
3782 * not found, the corresponding argument is left unchanged.
3783 */
3784
3785 static int
3786 XParseGeometry (char *string,
3787 int *x, int *y,
3788 unsigned int *width, unsigned int *height)
3789 {
3790 int mask = NoValue;
3791 char *strind;
3792 unsigned long int tempWidth, tempHeight;
3793 long int tempX, tempY;
3794 char *nextCharacter;
3795
3796 if (string == NULL || *string == '\0')
3797 return mask;
3798 if (*string == '=')
3799 string++; /* ignore possible '=' at beg of geometry spec */
3800
3801 strind = string;
3802 if (*strind != '+' && *strind != '-' && *strind != 'x')
3803 {
3804 tempWidth = strtoul (strind, &nextCharacter, 10);
3805 if (strind == nextCharacter)
3806 return 0;
3807 strind = nextCharacter;
3808 mask |= WidthValue;
3809 }
3810
3811 if (*strind == 'x' || *strind == 'X')
3812 {
3813 strind++;
3814 tempHeight = strtoul (strind, &nextCharacter, 10);
3815 if (strind == nextCharacter)
3816 return 0;
3817 strind = nextCharacter;
3818 mask |= HeightValue;
3819 }
3820
3821 if (*strind == '+' || *strind == '-')
3822 {
3823 if (*strind == '-')
3824 mask |= XNegative;
3825 tempX = strtol (strind, &nextCharacter, 10);
3826 if (strind == nextCharacter)
3827 return 0;
3828 strind = nextCharacter;
3829 mask |= XValue;
3830 if (*strind == '+' || *strind == '-')
3831 {
3832 if (*strind == '-')
3833 mask |= YNegative;
3834 tempY = strtol (strind, &nextCharacter, 10);
3835 if (strind == nextCharacter)
3836 return 0;
3837 strind = nextCharacter;
3838 mask |= YValue;
3839 }
3840 }
3841
3842 /* If strind isn't at the end of the string then it's an invalid
3843 geometry specification. */
3844
3845 if (*strind != '\0')
3846 return 0;
3847
3848 if (mask & XValue)
3849 *x = clip_to_bounds (INT_MIN, tempX, INT_MAX);
3850 if (mask & YValue)
3851 *y = clip_to_bounds (INT_MIN, tempY, INT_MAX);
3852 if (mask & WidthValue)
3853 *width = min (tempWidth, UINT_MAX);
3854 if (mask & HeightValue)
3855 *height = min (tempHeight, UINT_MAX);
3856 return mask;
3857 }
3858
3859 #endif /* !defined (HAVE_X_WINDOWS) && defined (NoValue) */
3860
3861 \f
3862 /* NS used to define x-parse-geometry in ns-win.el, but that confused
3863 make-docfile: the documentation string in ns-win.el was used for
3864 x-parse-geometry even in non-NS builds.
3865
3866 With two definitions of x-parse-geometry in this file, various
3867 things still get confused (eg M-x apropos documentation), so that
3868 it is best if the two definitions just share the same doc-string.
3869 */
3870 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
3871 doc: /* Parse a display geometry string STRING.
3872 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3873 The properties returned may include `top', `left', `height', and `width'.
3874 For X, the value of `left' or `top' may be an integer,
3875 or a list (+ N) meaning N pixels relative to top/left corner,
3876 or a list (- N) meaning -N pixels relative to bottom/right corner.
3877 On Nextstep, this just calls `ns-parse-geometry'. */)
3878 (Lisp_Object string)
3879 {
3880 int geometry, x, y;
3881 unsigned int width, height;
3882 Lisp_Object result;
3883
3884 CHECK_STRING (string);
3885
3886 #ifdef HAVE_NS
3887 if (strchr (SSDATA (string), ' ') != NULL)
3888 return call1 (Qns_parse_geometry, string);
3889 #endif
3890 geometry = XParseGeometry (SSDATA (string),
3891 &x, &y, &width, &height);
3892 result = Qnil;
3893 if (geometry & XValue)
3894 {
3895 Lisp_Object element;
3896
3897 if (x >= 0 && (geometry & XNegative))
3898 element = list3 (Qleft, Qminus, make_number (-x));
3899 else if (x < 0 && ! (geometry & XNegative))
3900 element = list3 (Qleft, Qplus, make_number (x));
3901 else
3902 element = Fcons (Qleft, make_number (x));
3903 result = Fcons (element, result);
3904 }
3905
3906 if (geometry & YValue)
3907 {
3908 Lisp_Object element;
3909
3910 if (y >= 0 && (geometry & YNegative))
3911 element = list3 (Qtop, Qminus, make_number (-y));
3912 else if (y < 0 && ! (geometry & YNegative))
3913 element = list3 (Qtop, Qplus, make_number (y));
3914 else
3915 element = Fcons (Qtop, make_number (y));
3916 result = Fcons (element, result);
3917 }
3918
3919 if (geometry & WidthValue)
3920 result = Fcons (Fcons (Qwidth, make_number (width)), result);
3921 if (geometry & HeightValue)
3922 result = Fcons (Fcons (Qheight, make_number (height)), result);
3923
3924 return result;
3925 }
3926
3927
3928 /* Calculate the desired size and position of frame F.
3929 Return the flags saying which aspects were specified.
3930
3931 Also set the win_gravity and size_hint_flags of F.
3932
3933 Adjust height for toolbar if TOOLBAR_P is 1.
3934
3935 This function does not make the coordinates positive. */
3936
3937 #define DEFAULT_ROWS 35
3938 #define DEFAULT_COLS 80
3939
3940 int
3941 x_figure_window_size (struct frame *f, Lisp_Object parms, int toolbar_p)
3942 {
3943 register Lisp_Object tem0, tem1, tem2;
3944 long window_prompting = 0;
3945 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3946
3947 /* Default values if we fall through.
3948 Actually, if that happens we should get
3949 window manager prompting. */
3950 SET_FRAME_COLS (f, DEFAULT_COLS);
3951 FRAME_LINES (f) = DEFAULT_ROWS;
3952 /* Window managers expect that if program-specified
3953 positions are not (0,0), they're intentional, not defaults. */
3954 f->top_pos = 0;
3955 f->left_pos = 0;
3956
3957 /* Ensure that old new_text_cols and new_text_lines will not override the
3958 values set here. */
3959 /* ++KFS: This was specific to W32, but seems ok for all platforms */
3960 f->new_text_cols = f->new_text_lines = 0;
3961
3962 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
3963 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
3964 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
3965 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3966 {
3967 if (!EQ (tem0, Qunbound))
3968 {
3969 CHECK_NUMBER (tem0);
3970 if (! (0 <= XINT (tem0) && XINT (tem0) <= INT_MAX))
3971 xsignal1 (Qargs_out_of_range, tem0);
3972 FRAME_LINES (f) = XINT (tem0);
3973 }
3974 if (!EQ (tem1, Qunbound))
3975 {
3976 CHECK_NUMBER (tem1);
3977 if (! (0 <= XINT (tem1) && XINT (tem1) <= INT_MAX))
3978 xsignal1 (Qargs_out_of_range, tem1);
3979 SET_FRAME_COLS (f, XINT (tem1));
3980 }
3981 if (!NILP (tem2) && !EQ (tem2, Qunbound))
3982 window_prompting |= USSize;
3983 else
3984 window_prompting |= PSize;
3985 }
3986
3987 f->scroll_bar_actual_width
3988 = FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f);
3989
3990 /* This used to be done _before_ calling x_figure_window_size, but
3991 since the height is reset here, this was really a no-op. I
3992 assume that moving it here does what Gerd intended (although he
3993 no longer can remember what that was... ++KFS, 2003-03-25. */
3994
3995 /* Add the tool-bar height to the initial frame height so that the
3996 user gets a text display area of the size he specified with -g or
3997 via .Xdefaults. Later changes of the tool-bar height don't
3998 change the frame size. This is done so that users can create
3999 tall Emacs frames without having to guess how tall the tool-bar
4000 will get. */
4001 if (toolbar_p && FRAME_TOOL_BAR_LINES (f))
4002 {
4003 int margin, relief, bar_height;
4004
4005 relief = (tool_bar_button_relief >= 0
4006 ? tool_bar_button_relief
4007 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
4008
4009 if (RANGED_INTEGERP (1, Vtool_bar_button_margin, INT_MAX))
4010 margin = XFASTINT (Vtool_bar_button_margin);
4011 else if (CONSP (Vtool_bar_button_margin)
4012 && RANGED_INTEGERP (1, XCDR (Vtool_bar_button_margin), INT_MAX))
4013 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
4014 else
4015 margin = 0;
4016
4017 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
4018 FRAME_LINES (f) += (bar_height + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f);
4019 }
4020
4021 compute_fringe_widths (f, 0);
4022
4023 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, FRAME_COLS (f));
4024 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, FRAME_LINES (f));
4025
4026 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
4027 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
4028 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
4029 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4030 {
4031 if (EQ (tem0, Qminus))
4032 {
4033 f->top_pos = 0;
4034 window_prompting |= YNegative;
4035 }
4036 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
4037 && CONSP (XCDR (tem0))
4038 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (tem0)), INT_MAX))
4039 {
4040 f->top_pos = - XINT (XCAR (XCDR (tem0)));
4041 window_prompting |= YNegative;
4042 }
4043 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
4044 && CONSP (XCDR (tem0))
4045 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (tem0))))
4046 {
4047 f->top_pos = XINT (XCAR (XCDR (tem0)));
4048 }
4049 else if (EQ (tem0, Qunbound))
4050 f->top_pos = 0;
4051 else
4052 {
4053 CHECK_TYPE_RANGED_INTEGER (int, tem0);
4054 f->top_pos = XINT (tem0);
4055 if (f->top_pos < 0)
4056 window_prompting |= YNegative;
4057 }
4058
4059 if (EQ (tem1, Qminus))
4060 {
4061 f->left_pos = 0;
4062 window_prompting |= XNegative;
4063 }
4064 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
4065 && CONSP (XCDR (tem1))
4066 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (tem1)), INT_MAX))
4067 {
4068 f->left_pos = - XINT (XCAR (XCDR (tem1)));
4069 window_prompting |= XNegative;
4070 }
4071 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
4072 && CONSP (XCDR (tem1))
4073 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (tem1))))
4074 {
4075 f->left_pos = XINT (XCAR (XCDR (tem1)));
4076 }
4077 else if (EQ (tem1, Qunbound))
4078 f->left_pos = 0;
4079 else
4080 {
4081 CHECK_TYPE_RANGED_INTEGER (int, tem1);
4082 f->left_pos = XINT (tem1);
4083 if (f->left_pos < 0)
4084 window_prompting |= XNegative;
4085 }
4086
4087 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
4088 window_prompting |= USPosition;
4089 else
4090 window_prompting |= PPosition;
4091 }
4092
4093 if (window_prompting & XNegative)
4094 {
4095 if (window_prompting & YNegative)
4096 f->win_gravity = SouthEastGravity;
4097 else
4098 f->win_gravity = NorthEastGravity;
4099 }
4100 else
4101 {
4102 if (window_prompting & YNegative)
4103 f->win_gravity = SouthWestGravity;
4104 else
4105 f->win_gravity = NorthWestGravity;
4106 }
4107
4108 f->size_hint_flags = window_prompting;
4109
4110 return window_prompting;
4111 }
4112
4113
4114
4115 #endif /* HAVE_WINDOW_SYSTEM */
4116
4117 void
4118 frame_make_pointer_invisible (void)
4119 {
4120 if (! NILP (Vmake_pointer_invisible))
4121 {
4122 struct frame *f;
4123 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4124 return;
4125
4126 f = SELECTED_FRAME ();
4127 if (f && !f->pointer_invisible
4128 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4129 {
4130 f->mouse_moved = 0;
4131 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 1);
4132 f->pointer_invisible = 1;
4133 }
4134 }
4135 }
4136
4137 void
4138 frame_make_pointer_visible (void)
4139 {
4140 /* We don't check Vmake_pointer_invisible here in case the
4141 pointer was invisible when Vmake_pointer_invisible was set to nil. */
4142 struct frame *f;
4143
4144 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4145 return;
4146
4147 f = SELECTED_FRAME ();
4148 if (f && f->pointer_invisible && f->mouse_moved
4149 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4150 {
4151 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 0);
4152 f->pointer_invisible = 0;
4153 }
4154 }
4155
4156 DEFUN ("frame-pointer-visible-p", Fframe_pointer_visible_p,
4157 Sframe_pointer_visible_p, 0, 1, 0,
4158 doc: /* Return t if the mouse pointer displayed on FRAME is visible.
4159 Otherwise it returns nil. FRAME omitted or nil means the
4160 selected frame. This is useful when `make-pointer-invisible' is set. */)
4161 (Lisp_Object frame)
4162 {
4163 return decode_any_frame (frame)->pointer_invisible ? Qnil : Qt;
4164 }
4165
4166
4167 \f
4168 /***********************************************************************
4169 Multimonitor data
4170 ***********************************************************************/
4171
4172 #ifdef HAVE_WINDOW_SYSTEM
4173
4174 # if (defined HAVE_NS \
4175 || (!defined USE_GTK && (defined HAVE_XINERAMA || defined HAVE_XRANDR)))
4176 void
4177 free_monitors (struct MonitorInfo *monitors, int n_monitors)
4178 {
4179 int i;
4180 for (i = 0; i < n_monitors; ++i)
4181 xfree (monitors[i].name);
4182 xfree (monitors);
4183 }
4184 # endif
4185
4186 Lisp_Object
4187 make_monitor_attribute_list (struct MonitorInfo *monitors,
4188 int n_monitors,
4189 int primary_monitor,
4190 Lisp_Object monitor_frames,
4191 const char *source)
4192 {
4193 Lisp_Object attributes_list = Qnil;
4194 Lisp_Object primary_monitor_attributes = Qnil;
4195 int i;
4196
4197 for (i = 0; i < n_monitors; ++i)
4198 {
4199 Lisp_Object geometry, workarea, attributes = Qnil;
4200 struct MonitorInfo *mi = &monitors[i];
4201
4202 if (mi->geom.width == 0) continue;
4203
4204 workarea = list4i (mi->work.x, mi->work.y,
4205 mi->work.width, mi->work.height);
4206 geometry = list4i (mi->geom.x, mi->geom.y,
4207 mi->geom.width, mi->geom.height);
4208 attributes = Fcons (Fcons (Qsource,
4209 make_string (source, strlen (source))),
4210 attributes);
4211 attributes = Fcons (Fcons (Qframes, AREF (monitor_frames, i)),
4212 attributes);
4213 attributes = Fcons (Fcons (Qmm_size,
4214 list2i (mi->mm_width, mi->mm_height)),
4215 attributes);
4216 attributes = Fcons (Fcons (Qworkarea, workarea), attributes);
4217 attributes = Fcons (Fcons (Qgeometry, geometry), attributes);
4218 if (mi->name)
4219 attributes = Fcons (Fcons (Qname, make_string (mi->name,
4220 strlen (mi->name))),
4221 attributes);
4222
4223 if (i == primary_monitor)
4224 primary_monitor_attributes = attributes;
4225 else
4226 attributes_list = Fcons (attributes, attributes_list);
4227 }
4228
4229 if (!NILP (primary_monitor_attributes))
4230 attributes_list = Fcons (primary_monitor_attributes, attributes_list);
4231 return attributes_list;
4232 }
4233
4234 #endif /* HAVE_WINDOW_SYSTEM */
4235
4236 \f
4237 /***********************************************************************
4238 Initialization
4239 ***********************************************************************/
4240
4241 void
4242 syms_of_frame (void)
4243 {
4244 DEFSYM (Qframep, "framep");
4245 DEFSYM (Qframe_live_p, "frame-live-p");
4246 DEFSYM (Qexplicit_name, "explicit-name");
4247 DEFSYM (Qheight, "height");
4248 DEFSYM (Qicon, "icon");
4249 DEFSYM (Qminibuffer, "minibuffer");
4250 DEFSYM (Qmodeline, "modeline");
4251 DEFSYM (Qonly, "only");
4252 DEFSYM (Qnone, "none");
4253 DEFSYM (Qwidth, "width");
4254 DEFSYM (Qgeometry, "geometry");
4255 DEFSYM (Qicon_left, "icon-left");
4256 DEFSYM (Qicon_top, "icon-top");
4257 DEFSYM (Qtooltip, "tooltip");
4258 DEFSYM (Qleft, "left");
4259 DEFSYM (Qright, "right");
4260 DEFSYM (Quser_position, "user-position");
4261 DEFSYM (Quser_size, "user-size");
4262 DEFSYM (Qwindow_id, "window-id");
4263 #ifdef HAVE_X_WINDOWS
4264 DEFSYM (Qouter_window_id, "outer-window-id");
4265 #endif
4266 DEFSYM (Qparent_id, "parent-id");
4267 DEFSYM (Qx, "x");
4268 DEFSYM (Qw32, "w32");
4269 DEFSYM (Qpc, "pc");
4270 DEFSYM (Qns, "ns");
4271 DEFSYM (Qvisible, "visible");
4272 DEFSYM (Qbuffer_predicate, "buffer-predicate");
4273 DEFSYM (Qbuffer_list, "buffer-list");
4274 DEFSYM (Qburied_buffer_list, "buried-buffer-list");
4275 DEFSYM (Qdisplay_type, "display-type");
4276 DEFSYM (Qbackground_mode, "background-mode");
4277 DEFSYM (Qnoelisp, "noelisp");
4278 DEFSYM (Qtty_color_mode, "tty-color-mode");
4279 DEFSYM (Qtty, "tty");
4280 DEFSYM (Qtty_type, "tty-type");
4281
4282 DEFSYM (Qface_set_after_frame_default, "face-set-after-frame-default");
4283
4284 DEFSYM (Qfullwidth, "fullwidth");
4285 DEFSYM (Qfullheight, "fullheight");
4286 DEFSYM (Qfullboth, "fullboth");
4287 DEFSYM (Qmaximized, "maximized");
4288 DEFSYM (Qx_resource_name, "x-resource-name");
4289 DEFSYM (Qx_frame_parameter, "x-frame-parameter");
4290
4291 DEFSYM (Qterminal, "terminal");
4292 DEFSYM (Qterminal_live_p, "terminal-live-p");
4293
4294 DEFSYM (Qgeometry, "geometry");
4295 DEFSYM (Qworkarea, "workarea");
4296 DEFSYM (Qmm_size, "mm-size");
4297 DEFSYM (Qframes, "frames");
4298 DEFSYM (Qsource, "source");
4299
4300 #ifdef HAVE_NS
4301 DEFSYM (Qns_parse_geometry, "ns-parse-geometry");
4302 #endif
4303
4304 {
4305 int i;
4306
4307 for (i = 0; i < sizeof (frame_parms) / sizeof (frame_parms[0]); i++)
4308 {
4309 Lisp_Object v = intern_c_string (frame_parms[i].name);
4310 if (frame_parms[i].variable)
4311 {
4312 *frame_parms[i].variable = v;
4313 staticpro (frame_parms[i].variable);
4314 }
4315 Fput (v, Qx_frame_parameter, make_number (i));
4316 }
4317 }
4318
4319 #ifdef HAVE_WINDOW_SYSTEM
4320 DEFVAR_LISP ("x-resource-name", Vx_resource_name,
4321 doc: /* The name Emacs uses to look up X resources.
4322 `x-get-resource' uses this as the first component of the instance name
4323 when requesting resource values.
4324 Emacs initially sets `x-resource-name' to the name under which Emacs
4325 was invoked, or to the value specified with the `-name' or `-rn'
4326 switches, if present.
4327
4328 It may be useful to bind this variable locally around a call
4329 to `x-get-resource'. See also the variable `x-resource-class'. */);
4330 Vx_resource_name = Qnil;
4331
4332 DEFVAR_LISP ("x-resource-class", Vx_resource_class,
4333 doc: /* The class Emacs uses to look up X resources.
4334 `x-get-resource' uses this as the first component of the instance class
4335 when requesting resource values.
4336
4337 Emacs initially sets `x-resource-class' to "Emacs".
4338
4339 Setting this variable permanently is not a reasonable thing to do,
4340 but binding this variable locally around a call to `x-get-resource'
4341 is a reasonable practice. See also the variable `x-resource-name'. */);
4342 Vx_resource_class = build_string (EMACS_CLASS);
4343
4344 DEFVAR_LISP ("frame-alpha-lower-limit", Vframe_alpha_lower_limit,
4345 doc: /* The lower limit of the frame opacity (alpha transparency).
4346 The value should range from 0 (invisible) to 100 (completely opaque).
4347 You can also use a floating number between 0.0 and 1.0.
4348 The default is 20. */);
4349 Vframe_alpha_lower_limit = make_number (20);
4350 #endif
4351
4352 DEFVAR_LISP ("default-frame-alist", Vdefault_frame_alist,
4353 doc: /* Alist of default values for frame creation.
4354 These may be set in your init file, like this:
4355 (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1)))
4356 These override values given in window system configuration data,
4357 including X Windows' defaults database.
4358 For values specific to the first Emacs frame, see `initial-frame-alist'.
4359 For window-system specific values, see `window-system-default-frame-alist'.
4360 For values specific to the separate minibuffer frame, see
4361 `minibuffer-frame-alist'.
4362 The `menu-bar-lines' element of the list controls whether new frames
4363 have menu bars; `menu-bar-mode' works by altering this element.
4364 Setting this variable does not affect existing frames, only new ones. */);
4365 Vdefault_frame_alist = Qnil;
4366
4367 DEFVAR_LISP ("default-frame-scroll-bars", Vdefault_frame_scroll_bars,
4368 doc: /* Default position of scroll bars on this window-system. */);
4369 #ifdef HAVE_WINDOW_SYSTEM
4370 #if defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA) || (defined (USE_GTK) && defined (USE_TOOLKIT_SCROLL_BARS))
4371 /* MS-Windows, Mac OS X, and GTK have scroll bars on the right by
4372 default. */
4373 Vdefault_frame_scroll_bars = Qright;
4374 #else
4375 Vdefault_frame_scroll_bars = Qleft;
4376 #endif
4377 #else
4378 Vdefault_frame_scroll_bars = Qnil;
4379 #endif
4380
4381 DEFVAR_BOOL ("scroll-bar-adjust-thumb-portion",
4382 scroll_bar_adjust_thumb_portion_p,
4383 doc: /* Adjust thumb for overscrolling for Gtk+ and MOTIF.
4384 Non-nil means adjust the thumb in the scroll bar so it can be dragged downwards
4385 even if the end of the buffer is shown (i.e. overscrolling).
4386 Set to nil if you want the thumb to be at the bottom when the end of the buffer
4387 is shown. Also, the thumb fills the whole scroll bar when the entire buffer
4388 is visible. In this case you can not overscroll. */);
4389 scroll_bar_adjust_thumb_portion_p = 1;
4390
4391 DEFVAR_LISP ("terminal-frame", Vterminal_frame,
4392 doc: /* The initial frame-object, which represents Emacs's stdout. */);
4393
4394 DEFVAR_LISP ("mouse-position-function", Vmouse_position_function,
4395 doc: /* If non-nil, function to transform normal value of `mouse-position'.
4396 `mouse-position' calls this function, passing its usual return value as
4397 argument, and returns whatever this function returns.
4398 This abnormal hook exists for the benefit of packages like `xt-mouse.el'
4399 which need to do mouse handling at the Lisp level. */);
4400 Vmouse_position_function = Qnil;
4401
4402 DEFVAR_LISP ("mouse-highlight", Vmouse_highlight,
4403 doc: /* If non-nil, clickable text is highlighted when mouse is over it.
4404 If the value is an integer, highlighting is only shown after moving the
4405 mouse, while keyboard input turns off the highlight even when the mouse
4406 is over the clickable text. However, the mouse shape still indicates
4407 when the mouse is over clickable text. */);
4408 Vmouse_highlight = Qt;
4409
4410 DEFVAR_LISP ("make-pointer-invisible", Vmake_pointer_invisible,
4411 doc: /* If non-nil, make pointer invisible while typing.
4412 The pointer becomes visible again when the mouse is moved. */);
4413 Vmake_pointer_invisible = Qt;
4414
4415 DEFVAR_LISP ("delete-frame-functions", Vdelete_frame_functions,
4416 doc: /* Functions run before deleting a frame.
4417 The functions are run with one arg, the frame to be deleted.
4418 See `delete-frame'.
4419
4420 Note that functions in this list may be called just before the frame is
4421 actually deleted, or some time later (or even both when an earlier function
4422 in `delete-frame-functions' (indirectly) calls `delete-frame'
4423 recursively). */);
4424 Vdelete_frame_functions = Qnil;
4425 DEFSYM (Qdelete_frame_functions, "delete-frame-functions");
4426
4427 DEFVAR_LISP ("menu-bar-mode", Vmenu_bar_mode,
4428 doc: /* Non-nil if Menu-Bar mode is enabled.
4429 See the command `menu-bar-mode' for a description of this minor mode.
4430 Setting this variable directly does not take effect;
4431 either customize it (see the info node `Easy Customization')
4432 or call the function `menu-bar-mode'. */);
4433 Vmenu_bar_mode = Qt;
4434
4435 DEFVAR_LISP ("tool-bar-mode", Vtool_bar_mode,
4436 doc: /* Non-nil if Tool-Bar mode is enabled.
4437 See the command `tool-bar-mode' for a description of this minor mode.
4438 Setting this variable directly does not take effect;
4439 either customize it (see the info node `Easy Customization')
4440 or call the function `tool-bar-mode'. */);
4441 #ifdef HAVE_WINDOW_SYSTEM
4442 Vtool_bar_mode = Qt;
4443 #else
4444 Vtool_bar_mode = Qnil;
4445 #endif
4446
4447 DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
4448 doc: /* Minibufferless frames use this frame's minibuffer.
4449
4450 Emacs cannot create minibufferless frames unless this is set to an
4451 appropriate surrogate.
4452
4453 Emacs consults this variable only when creating minibufferless
4454 frames; once the frame is created, it sticks with its assigned
4455 minibuffer, no matter what this variable is set to. This means that
4456 this variable doesn't necessarily say anything meaningful about the
4457 current set of frames, or where the minibuffer is currently being
4458 displayed.
4459
4460 This variable is local to the current terminal and cannot be buffer-local. */);
4461
4462 DEFVAR_BOOL ("focus-follows-mouse", focus_follows_mouse,
4463 doc: /* Non-nil if window system changes focus when you move the mouse.
4464 You should set this variable to tell Emacs how your window manager
4465 handles focus, since there is no way in general for Emacs to find out
4466 automatically. See also `mouse-autoselect-window'. */);
4467 focus_follows_mouse = 0;
4468
4469 staticpro (&Vframe_list);
4470
4471 defsubr (&Sframep);
4472 defsubr (&Sframe_live_p);
4473 defsubr (&Swindow_system);
4474 defsubr (&Smake_terminal_frame);
4475 defsubr (&Shandle_switch_frame);
4476 defsubr (&Shandle_focus_in);
4477 defsubr (&Shandle_focus_out);
4478 defsubr (&Sselect_frame);
4479 defsubr (&Sselected_frame);
4480 defsubr (&Sframe_list);
4481 defsubr (&Snext_frame);
4482 defsubr (&Sprevious_frame);
4483 defsubr (&Sdelete_frame);
4484 defsubr (&Smouse_position);
4485 defsubr (&Smouse_pixel_position);
4486 defsubr (&Sset_mouse_position);
4487 defsubr (&Sset_mouse_pixel_position);
4488 #if 0
4489 defsubr (&Sframe_configuration);
4490 defsubr (&Srestore_frame_configuration);
4491 #endif
4492 defsubr (&Smake_frame_visible);
4493 defsubr (&Smake_frame_invisible);
4494 defsubr (&Siconify_frame);
4495 defsubr (&Sframe_visible_p);
4496 defsubr (&Svisible_frame_list);
4497 defsubr (&Sraise_frame);
4498 defsubr (&Slower_frame);
4499 defsubr (&Sredirect_frame_focus);
4500 defsubr (&Sframe_focus);
4501 defsubr (&Sframe_parameters);
4502 defsubr (&Sframe_parameter);
4503 defsubr (&Smodify_frame_parameters);
4504 defsubr (&Sframe_char_height);
4505 defsubr (&Sframe_char_width);
4506 defsubr (&Sframe_pixel_height);
4507 defsubr (&Sframe_pixel_width);
4508 defsubr (&Stool_bar_pixel_width);
4509 defsubr (&Sset_frame_height);
4510 defsubr (&Sset_frame_width);
4511 defsubr (&Sset_frame_size);
4512 defsubr (&Sset_frame_position);
4513 defsubr (&Sframe_pointer_visible_p);
4514
4515 #ifdef HAVE_WINDOW_SYSTEM
4516 defsubr (&Sx_get_resource);
4517 defsubr (&Sx_parse_geometry);
4518 #endif
4519
4520 }