Refine redisplay optimizations to only redisplay *some* frames/windows
[emacs.git] / src / frame.c
blob35e7ff1fbb4b49344376713df4caaeede95fe270
1 /* Generic frame functions.
3 Copyright (C) 1993-1995, 1997, 1999-2013 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
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.
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.
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/>. */
20 #include <config.h>
22 #include <stdio.h>
23 #include <errno.h>
24 #include <limits.h>
26 #include <c-ctype.h>
28 #include "lisp.h"
29 #include "character.h"
31 #ifdef HAVE_WINDOW_SYSTEM
32 #include TERM_HEADER
33 #endif /* HAVE_WINDOW_SYSTEM */
35 #include "buffer.h"
36 /* These help us bind and responding to switch-frame events. */
37 #include "commands.h"
38 #include "keyboard.h"
39 #include "frame.h"
40 #include "blockinput.h"
41 #include "termchar.h"
42 #include "termhooks.h"
43 #include "dispextern.h"
44 #include "window.h"
45 #include "font.h"
46 #ifdef HAVE_WINDOW_SYSTEM
47 #include "fontset.h"
48 #endif
49 #ifdef MSDOS
50 #include "msdos.h"
51 #include "dosfns.h"
52 #endif
54 #ifdef HAVE_NS
55 Lisp_Object Qns_parse_geometry;
56 #endif
58 Lisp_Object Qframep, Qframe_live_p;
59 Lisp_Object Qicon, Qmodeline;
60 Lisp_Object Qonly, Qnone;
61 Lisp_Object Qx, Qw32, Qpc, Qns;
62 Lisp_Object Qvisible;
63 Lisp_Object Qdisplay_type;
64 static Lisp_Object Qbackground_mode;
65 Lisp_Object Qnoelisp;
67 static Lisp_Object Qx_frame_parameter;
68 Lisp_Object Qx_resource_name;
69 Lisp_Object Qterminal;
71 /* Frame parameters (set or reported). */
73 Lisp_Object Qauto_raise, Qauto_lower;
74 Lisp_Object Qborder_color, Qborder_width;
75 Lisp_Object Qcursor_color, Qcursor_type;
76 Lisp_Object Qheight, Qwidth;
77 Lisp_Object Qleft, Qright;
78 Lisp_Object Qicon_left, Qicon_top, Qicon_type, Qicon_name;
79 Lisp_Object Qtooltip;
80 Lisp_Object Qinternal_border_width;
81 Lisp_Object Qmouse_color;
82 Lisp_Object Qminibuffer;
83 Lisp_Object Qscroll_bar_width, Qvertical_scroll_bars;
84 Lisp_Object Qvisibility;
85 Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
86 Lisp_Object Qscreen_gamma;
87 Lisp_Object Qline_spacing;
88 static Lisp_Object Quser_position, Quser_size;
89 Lisp_Object Qwait_for_wm;
90 static Lisp_Object Qwindow_id;
91 #ifdef HAVE_X_WINDOWS
92 static Lisp_Object Qouter_window_id;
93 #endif
94 Lisp_Object Qparent_id;
95 Lisp_Object Qtitle, Qname;
96 static Lisp_Object Qexplicit_name;
97 Lisp_Object Qunsplittable;
98 Lisp_Object Qmenu_bar_lines, Qtool_bar_lines, Qtool_bar_position;
99 Lisp_Object Qleft_fringe, Qright_fringe;
100 Lisp_Object Qbuffer_predicate;
101 static Lisp_Object Qbuffer_list, Qburied_buffer_list;
102 Lisp_Object Qtty_color_mode;
103 Lisp_Object Qtty, Qtty_type;
105 Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth, Qmaximized;
106 Lisp_Object Qsticky;
107 Lisp_Object Qfont_backend;
108 Lisp_Object Qalpha;
110 Lisp_Object Qface_set_after_frame_default;
112 static Lisp_Object Qfocus_in_hook;
113 static Lisp_Object Qfocus_out_hook;
114 static Lisp_Object Qdelete_frame_functions;
116 static Lisp_Object Qgeometry, Qworkarea, Qmm_size, Qframes, Qsource;
118 /* The currently selected frame. */
120 Lisp_Object selected_frame;
122 /* A frame which is not just a mini-buffer, or NULL if there are no such
123 frames. This is usually the most recent such frame that was selected. */
125 static struct frame *last_nonminibuf_frame;
127 /* Nonzero means there is at least one garbaged frame. */
129 bool frame_garbaged;
131 #ifdef HAVE_WINDOW_SYSTEM
132 static void x_report_frame_params (struct frame *, Lisp_Object *);
133 #endif
135 /* These setters are used only in this file, so they can be private. */
136 static void
137 fset_buffer_predicate (struct frame *f, Lisp_Object val)
139 f->buffer_predicate = val;
141 static void
142 fset_minibuffer_window (struct frame *f, Lisp_Object val)
144 f->minibuffer_window = val;
147 struct frame *
148 decode_live_frame (register Lisp_Object frame)
150 if (NILP (frame))
151 frame = selected_frame;
152 CHECK_LIVE_FRAME (frame);
153 return XFRAME (frame);
156 struct frame *
157 decode_any_frame (register Lisp_Object frame)
159 if (NILP (frame))
160 frame = selected_frame;
161 CHECK_FRAME (frame);
162 return XFRAME (frame);
165 bool
166 window_system_available (struct frame *f)
168 if (f)
169 return FRAME_WINDOW_P (f) || FRAME_MSDOS_P (f);
170 else
171 #ifdef HAVE_WINDOW_SYSTEM
172 return x_display_list != NULL;
173 #else
174 return 0;
175 #endif
178 struct frame *
179 decode_window_system_frame (Lisp_Object frame)
181 struct frame *f = decode_live_frame (frame);
183 if (!window_system_available (f))
184 error ("Window system frame should be used");
185 return f;
188 void
189 check_window_system (struct frame *f)
191 if (!window_system_available (f))
192 error (f ? "Window system frame should be used"
193 : "Window system is not in use or not initialized");
196 static void
197 set_menu_bar_lines_1 (Lisp_Object window, int n)
199 struct window *w = XWINDOW (window);
201 w->top_line += n;
202 w->total_lines -= n;
204 /* Handle just the top child in a vertical split. */
205 if (WINDOW_VERTICAL_COMBINATION_P (w))
206 set_menu_bar_lines_1 (w->contents, n);
207 else if (WINDOW_HORIZONTAL_COMBINATION_P (w))
208 /* Adjust all children in a horizontal split. */
209 for (window = w->contents; !NILP (window); window = w->next)
211 w = XWINDOW (window);
212 set_menu_bar_lines_1 (window, n);
216 void
217 set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
219 int nlines;
220 int olines = FRAME_MENU_BAR_LINES (f);
222 /* Right now, menu bars don't work properly in minibuf-only frames;
223 most of the commands try to apply themselves to the minibuffer
224 frame itself, and get an error because you can't switch buffers
225 in or split the minibuffer window. */
226 if (FRAME_MINIBUF_ONLY_P (f))
227 return;
229 if (TYPE_RANGED_INTEGERP (int, value))
230 nlines = XINT (value);
231 else
232 nlines = 0;
234 if (nlines != olines)
236 windows_or_buffers_changed = 14;
237 FRAME_WINDOW_SIZES_CHANGED (f) = 1;
238 FRAME_MENU_BAR_LINES (f) = nlines;
239 set_menu_bar_lines_1 (f->root_window, nlines - olines);
240 adjust_frame_glyphs (f);
244 Lisp_Object Vframe_list;
247 DEFUN ("framep", Fframep, Sframep, 1, 1, 0,
248 doc: /* Return non-nil if OBJECT is a frame.
249 Value is:
250 t for a termcap frame (a character-only terminal),
251 'x' for an Emacs frame that is really an X window,
252 'w32' for an Emacs frame that is a window on MS-Windows display,
253 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
254 'pc' for a direct-write MS-DOS frame.
255 See also `frame-live-p'. */)
256 (Lisp_Object object)
258 if (!FRAMEP (object))
259 return Qnil;
260 switch (XFRAME (object)->output_method)
262 case output_initial: /* The initial frame is like a termcap frame. */
263 case output_termcap:
264 return Qt;
265 case output_x_window:
266 return Qx;
267 case output_w32:
268 return Qw32;
269 case output_msdos_raw:
270 return Qpc;
271 case output_ns:
272 return Qns;
273 default:
274 emacs_abort ();
278 DEFUN ("frame-live-p", Fframe_live_p, Sframe_live_p, 1, 1, 0,
279 doc: /* Return non-nil if OBJECT is a frame which has not been deleted.
280 Value is nil if OBJECT is not a live frame. If object is a live
281 frame, the return value indicates what sort of terminal device it is
282 displayed on. See the documentation of `framep' for possible
283 return values. */)
284 (Lisp_Object object)
286 return ((FRAMEP (object)
287 && FRAME_LIVE_P (XFRAME (object)))
288 ? Fframep (object)
289 : Qnil);
292 DEFUN ("window-system", Fwindow_system, Swindow_system, 0, 1, 0,
293 doc: /* The name of the window system that FRAME is displaying through.
294 The value is a symbol:
295 nil for a termcap frame (a character-only terminal),
296 'x' for an Emacs frame that is really an X window,
297 'w32' for an Emacs frame that is a window on MS-Windows display,
298 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
299 'pc' for a direct-write MS-DOS frame.
301 FRAME defaults to the currently selected frame.
303 Use of this function as a predicate is deprecated. Instead,
304 use `display-graphic-p' or any of the other `display-*-p'
305 predicates which report frame's specific UI-related capabilities. */)
306 (Lisp_Object frame)
308 Lisp_Object type;
309 if (NILP (frame))
310 frame = selected_frame;
312 type = Fframep (frame);
314 if (NILP (type))
315 wrong_type_argument (Qframep, frame);
317 if (EQ (type, Qt))
318 return Qnil;
319 else
320 return type;
323 struct frame *
324 make_frame (bool mini_p)
326 Lisp_Object frame;
327 register struct frame *f;
328 register Lisp_Object root_window;
329 register Lisp_Object mini_window;
331 f = allocate_frame ();
332 XSETFRAME (frame, f);
334 /* Initialize Lisp data. Note that allocate_frame initializes all
335 Lisp data to nil, so do it only for slots which should not be nil. */
336 fset_tool_bar_position (f, Qtop);
338 /* Initialize non-Lisp data. Note that allocate_frame zeroes out all
339 non-Lisp data, so do it only for slots which should not be zero.
340 To avoid subtle bugs and for the sake of readability, it's better to
341 initialize enum members explicitly even if their values are zero. */
342 f->wants_modeline = true;
343 f->redisplay = true;
344 f->garbaged = true;
345 f->vertical_scroll_bar_type = vertical_scroll_bar_none;
346 f->column_width = 1; /* !FRAME_WINDOW_P value. */
347 f->line_height = 1; /* !FRAME_WINDOW_P value. */
348 #ifdef HAVE_WINDOW_SYSTEM
349 f->want_fullscreen = FULLSCREEN_NONE;
350 #endif
352 root_window = make_window ();
353 if (mini_p)
355 mini_window = make_window ();
356 wset_next (XWINDOW (root_window), mini_window);
357 wset_prev (XWINDOW (mini_window), root_window);
358 XWINDOW (mini_window)->mini = 1;
359 wset_frame (XWINDOW (mini_window), frame);
360 fset_minibuffer_window (f, mini_window);
362 else
364 mini_window = Qnil;
365 wset_next (XWINDOW (root_window), Qnil);
366 fset_minibuffer_window (f, Qnil);
369 wset_frame (XWINDOW (root_window), frame);
371 /* 10 is arbitrary,
372 just so that there is "something there."
373 Correct size will be set up later with change_frame_size. */
375 SET_FRAME_COLS (f, 10);
376 FRAME_LINES (f) = 10;
378 XWINDOW (root_window)->total_cols = 10;
379 XWINDOW (root_window)->total_lines = mini_p ? 9 : 10;
381 if (mini_p)
383 XWINDOW (mini_window)->total_cols = 10;
384 XWINDOW (mini_window)->top_line = 9;
385 XWINDOW (mini_window)->total_lines = 1;
388 /* Choose a buffer for the frame's root window. */
390 Lisp_Object buf = Fcurrent_buffer ();
392 /* If current buffer is hidden, try to find another one. */
393 if (BUFFER_HIDDEN_P (XBUFFER (buf)))
394 buf = other_buffer_safely (buf);
396 /* Use set_window_buffer, not Fset_window_buffer, and don't let
397 hooks be run by it. The reason is that the whole frame/window
398 arrangement is not yet fully initialized at this point. Windows
399 don't have the right size, glyph matrices aren't initialized
400 etc. Running Lisp functions at this point surely ends in a
401 SEGV. */
402 set_window_buffer (root_window, buf, 0, 0);
403 fset_buffer_list (f, list1 (buf));
406 if (mini_p)
407 set_window_buffer (mini_window,
408 (NILP (Vminibuffer_list)
409 ? get_minibuffer (0)
410 : Fcar (Vminibuffer_list)),
411 0, 0);
413 fset_root_window (f, root_window);
414 fset_selected_window (f, root_window);
415 /* Make sure this window seems more recently used than
416 a newly-created, never-selected window. */
417 XWINDOW (f->selected_window)->use_time = ++window_select_count;
419 return f;
422 #ifdef HAVE_WINDOW_SYSTEM
423 /* Make a frame using a separate minibuffer window on another frame.
424 MINI_WINDOW is the minibuffer window to use. nil means use the
425 default (the global minibuffer). */
427 struct frame *
428 make_frame_without_minibuffer (register Lisp_Object mini_window, KBOARD *kb, Lisp_Object display)
430 register struct frame *f;
431 struct gcpro gcpro1;
433 if (!NILP (mini_window))
434 CHECK_LIVE_WINDOW (mini_window);
436 if (!NILP (mini_window)
437 && FRAME_KBOARD (XFRAME (XWINDOW (mini_window)->frame)) != kb)
438 error ("Frame and minibuffer must be on the same terminal");
440 /* Make a frame containing just a root window. */
441 f = make_frame (0);
443 if (NILP (mini_window))
445 /* Use default-minibuffer-frame if possible. */
446 if (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
447 || ! FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))
449 Lisp_Object frame_dummy;
451 XSETFRAME (frame_dummy, f);
452 GCPRO1 (frame_dummy);
453 /* If there's no minibuffer frame to use, create one. */
454 kset_default_minibuffer_frame
455 (kb, call1 (intern ("make-initial-minibuffer-frame"), display));
456 UNGCPRO;
459 mini_window
460 = XFRAME (KVAR (kb, Vdefault_minibuffer_frame))->minibuffer_window;
463 fset_minibuffer_window (f, mini_window);
465 /* Make the chosen minibuffer window display the proper minibuffer,
466 unless it is already showing a minibuffer. */
467 if (NILP (Fmemq (XWINDOW (mini_window)->contents, Vminibuffer_list)))
468 /* Use set_window_buffer instead of Fset_window_buffer (see
469 discussion of bug#11984, bug#12025, bug#12026). */
470 set_window_buffer (mini_window,
471 (NILP (Vminibuffer_list)
472 ? get_minibuffer (0)
473 : Fcar (Vminibuffer_list)), 0, 0);
474 return f;
477 /* Make a frame containing only a minibuffer window. */
479 struct frame *
480 make_minibuffer_frame (void)
482 /* First make a frame containing just a root window, no minibuffer. */
484 register struct frame *f = make_frame (0);
485 register Lisp_Object mini_window;
486 register Lisp_Object frame;
488 XSETFRAME (frame, f);
490 f->auto_raise = 0;
491 f->auto_lower = 0;
492 f->no_split = 1;
493 f->wants_modeline = 0;
495 /* Now label the root window as also being the minibuffer.
496 Avoid infinite looping on the window chain by marking next pointer
497 as nil. */
499 mini_window = f->root_window;
500 fset_minibuffer_window (f, mini_window);
501 XWINDOW (mini_window)->mini = 1;
502 wset_next (XWINDOW (mini_window), Qnil);
503 wset_prev (XWINDOW (mini_window), Qnil);
504 wset_frame (XWINDOW (mini_window), frame);
506 /* Put the proper buffer in that window. */
508 /* Use set_window_buffer instead of Fset_window_buffer (see
509 discussion of bug#11984, bug#12025, bug#12026). */
510 set_window_buffer (mini_window,
511 (NILP (Vminibuffer_list)
512 ? get_minibuffer (0)
513 : Fcar (Vminibuffer_list)), 0, 0);
514 return f;
516 #endif /* HAVE_WINDOW_SYSTEM */
518 /* Construct a frame that refers to a terminal. */
520 static printmax_t tty_frame_count;
522 struct frame *
523 make_initial_frame (void)
525 struct frame *f;
526 struct terminal *terminal;
527 Lisp_Object frame;
529 eassert (initial_kboard);
531 /* The first call must initialize Vframe_list. */
532 if (! (NILP (Vframe_list) || CONSP (Vframe_list)))
533 Vframe_list = Qnil;
535 terminal = init_initial_terminal ();
537 f = make_frame (1);
538 XSETFRAME (frame, f);
540 Vframe_list = Fcons (frame, Vframe_list);
542 tty_frame_count = 1;
543 fset_name (f, build_pure_c_string ("F1"));
545 SET_FRAME_VISIBLE (f, 1);
547 f->output_method = terminal->type;
548 f->terminal = terminal;
549 f->terminal->reference_count++;
550 f->output_data.nothing = 0;
552 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
553 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
555 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
557 /* The default value of menu-bar-mode is t. */
558 set_menu_bar_lines (f, make_number (1), Qnil);
560 if (!noninteractive)
561 init_frame_faces (f);
563 last_nonminibuf_frame = f;
565 return f;
569 static struct frame *
570 make_terminal_frame (struct terminal *terminal)
572 register struct frame *f;
573 Lisp_Object frame;
574 char name[sizeof "F" + INT_STRLEN_BOUND (printmax_t)];
576 if (!terminal->name)
577 error ("Terminal is not live, can't create new frames on it");
579 f = make_frame (1);
581 XSETFRAME (frame, f);
582 Vframe_list = Fcons (frame, Vframe_list);
584 fset_name (f, make_formatted_string (name, "F%"pMd, ++tty_frame_count));
586 SET_FRAME_VISIBLE (f, 1);
588 f->terminal = terminal;
589 f->terminal->reference_count++;
590 #ifdef MSDOS
591 f->output_data.tty->display_info = &the_only_display_info;
592 if (!inhibit_window_system
593 && (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame))
594 || XFRAME (selected_frame)->output_method == output_msdos_raw))
595 f->output_method = output_msdos_raw;
596 else
597 f->output_method = output_termcap;
598 #else /* not MSDOS */
599 f->output_method = output_termcap;
600 create_tty_output (f);
601 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
602 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
603 #endif /* not MSDOS */
605 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
606 FRAME_MENU_BAR_LINES(f) = NILP (Vmenu_bar_mode) ? 0 : 1;
608 /* Set the top frame to the newly created frame. */
609 if (FRAMEP (FRAME_TTY (f)->top_frame)
610 && FRAME_LIVE_P (XFRAME (FRAME_TTY (f)->top_frame)))
611 SET_FRAME_VISIBLE (XFRAME (FRAME_TTY (f)->top_frame), 2); /* obscured */
613 FRAME_TTY (f)->top_frame = frame;
615 if (!noninteractive)
616 init_frame_faces (f);
618 return f;
621 /* Get a suitable value for frame parameter PARAMETER for a newly
622 created frame, based on (1) the user-supplied frame parameter
623 alist SUPPLIED_PARMS, and (2) CURRENT_VALUE. */
625 static Lisp_Object
626 get_future_frame_param (Lisp_Object parameter,
627 Lisp_Object supplied_parms,
628 char *current_value)
630 Lisp_Object result;
632 result = Fassq (parameter, supplied_parms);
633 if (NILP (result))
634 result = Fassq (parameter, XFRAME (selected_frame)->param_alist);
635 if (NILP (result) && current_value != NULL)
636 result = build_string (current_value);
637 if (!NILP (result) && !STRINGP (result))
638 result = XCDR (result);
639 if (NILP (result) || !STRINGP (result))
640 result = Qnil;
642 return result;
645 DEFUN ("make-terminal-frame", Fmake_terminal_frame, Smake_terminal_frame,
646 1, 1, 0,
647 doc: /* Create an additional terminal frame, possibly on another terminal.
648 This function takes one argument, an alist specifying frame parameters.
650 You can create multiple frames on a single text terminal, but only one
651 of them (the selected terminal frame) is actually displayed.
653 In practice, generally you don't need to specify any parameters,
654 except when you want to create a new frame on another terminal.
655 In that case, the `tty' parameter specifies the device file to open,
656 and the `tty-type' parameter specifies the terminal type. Example:
658 (make-terminal-frame '((tty . "/dev/pts/5") (tty-type . "xterm")))
660 Note that changing the size of one terminal frame automatically
661 affects all frames on the same terminal device. */)
662 (Lisp_Object parms)
664 struct frame *f;
665 struct terminal *t = NULL;
666 Lisp_Object frame, tem;
667 struct frame *sf = SELECTED_FRAME ();
669 #ifdef MSDOS
670 if (sf->output_method != output_msdos_raw
671 && sf->output_method != output_termcap)
672 emacs_abort ();
673 #else /* not MSDOS */
675 #ifdef WINDOWSNT /* This should work now! */
676 if (sf->output_method != output_termcap)
677 error ("Not using an ASCII terminal now; cannot make a new ASCII frame");
678 #endif
679 #endif /* not MSDOS */
682 Lisp_Object terminal;
684 terminal = Fassq (Qterminal, parms);
685 if (CONSP (terminal))
687 terminal = XCDR (terminal);
688 t = get_terminal (terminal, 1);
690 #ifdef MSDOS
691 if (t && t != the_only_display_info.terminal)
692 /* msdos.c assumes a single tty_display_info object. */
693 error ("Multiple terminals are not supported on this platform");
694 if (!t)
695 t = the_only_display_info.terminal;
696 #endif
699 if (!t)
701 char *name = 0, *type = 0;
702 Lisp_Object tty, tty_type;
704 tty = get_future_frame_param
705 (Qtty, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
706 ? FRAME_TTY (XFRAME (selected_frame))->name
707 : NULL));
708 if (!NILP (tty))
709 name = xlispstrdupa (tty);
711 tty_type = get_future_frame_param
712 (Qtty_type, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
713 ? FRAME_TTY (XFRAME (selected_frame))->type
714 : NULL));
715 if (!NILP (tty_type))
716 type = xlispstrdupa (tty_type);
718 t = init_tty (name, type, 0); /* Errors are not fatal. */
721 f = make_terminal_frame (t);
724 int width, height;
725 get_tty_size (fileno (FRAME_TTY (f)->input), &width, &height);
726 change_frame_size (f, height, width, 0, 0, 0);
729 adjust_frame_glyphs (f);
730 calculate_costs (f);
731 XSETFRAME (frame, f);
733 store_in_alist (&parms, Qtty_type, build_string (t->display_info.tty->type));
734 store_in_alist (&parms, Qtty,
735 (t->display_info.tty->name
736 ? build_string (t->display_info.tty->name)
737 : Qnil));
738 Fmodify_frame_parameters (frame, parms);
740 /* Make the frame face alist be frame-specific, so that each
741 frame could change its face definitions independently. */
742 fset_face_alist (f, Fcopy_alist (sf->face_alist));
743 /* Simple Fcopy_alist isn't enough, because we need the contents of
744 the vectors which are the CDRs of associations in face_alist to
745 be copied as well. */
746 for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem))
747 XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem))));
748 return frame;
752 /* Perform the switch to frame FRAME.
754 If FRAME is a switch-frame event `(switch-frame FRAME1)', use
755 FRAME1 as frame.
757 If TRACK is non-zero and the frame that currently has the focus
758 redirects its focus to the selected frame, redirect that focused
759 frame's focus to FRAME instead.
761 FOR_DELETION non-zero means that the selected frame is being
762 deleted, which includes the possibility that the frame's terminal
763 is dead.
765 The value of NORECORD is passed as argument to Fselect_window. */
767 Lisp_Object
768 do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object norecord)
770 struct frame *sf = SELECTED_FRAME ();
772 /* If FRAME is a switch-frame event, extract the frame we should
773 switch to. */
774 if (CONSP (frame)
775 && EQ (XCAR (frame), Qswitch_frame)
776 && CONSP (XCDR (frame)))
777 frame = XCAR (XCDR (frame));
779 /* This used to say CHECK_LIVE_FRAME, but apparently it's possible for
780 a switch-frame event to arrive after a frame is no longer live,
781 especially when deleting the initial frame during startup. */
782 CHECK_FRAME (frame);
783 if (! FRAME_LIVE_P (XFRAME (frame)))
784 return Qnil;
786 if (sf == XFRAME (frame))
787 return frame;
789 /* If a frame's focus has been redirected toward the currently
790 selected frame, we should change the redirection to point to the
791 newly selected frame. This means that if the focus is redirected
792 from a minibufferless frame to a surrogate minibuffer frame, we
793 can use `other-window' to switch between all the frames using
794 that minibuffer frame, and the focus redirection will follow us
795 around. */
796 #if 0
797 /* This is too greedy; it causes inappropriate focus redirection
798 that's hard to get rid of. */
799 if (track)
801 Lisp_Object tail;
803 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
805 Lisp_Object focus;
807 if (!FRAMEP (XCAR (tail)))
808 emacs_abort ();
810 focus = FRAME_FOCUS_FRAME (XFRAME (XCAR (tail)));
812 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
813 Fredirect_frame_focus (XCAR (tail), frame);
816 #else /* ! 0 */
817 /* Instead, apply it only to the frame we're pointing to. */
818 #ifdef HAVE_WINDOW_SYSTEM
819 if (track && FRAME_WINDOW_P (XFRAME (frame)))
821 Lisp_Object focus, xfocus;
823 xfocus = x_get_focus_frame (XFRAME (frame));
824 if (FRAMEP (xfocus))
826 focus = FRAME_FOCUS_FRAME (XFRAME (xfocus));
827 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
828 Fredirect_frame_focus (xfocus, frame);
831 #endif /* HAVE_X_WINDOWS */
832 #endif /* ! 0 */
834 if (!for_deletion && FRAME_HAS_MINIBUF_P (sf))
835 resize_mini_window (XWINDOW (FRAME_MINIBUF_WINDOW (sf)), 1);
837 if (FRAME_TERMCAP_P (XFRAME (frame)) || FRAME_MSDOS_P (XFRAME (frame)))
839 Lisp_Object top_frame = FRAME_TTY (XFRAME (frame))->top_frame;
841 /* Don't mark the frame garbaged and/or obscured if we are
842 switching to the frame that is already the top frame of that
843 TTY. */
844 if (!EQ (frame, top_frame))
846 if (FRAMEP (top_frame))
847 /* Mark previously displayed frame as now obscured. */
848 SET_FRAME_VISIBLE (XFRAME (top_frame), 2);
849 SET_FRAME_VISIBLE (XFRAME (frame), 1);
851 FRAME_TTY (XFRAME (frame))->top_frame = frame;
854 selected_frame = frame;
855 if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
856 last_nonminibuf_frame = XFRAME (selected_frame);
858 Fselect_window (XFRAME (frame)->selected_window, norecord);
860 /* We want to make sure that the next event generates a frame-switch
861 event to the appropriate frame. This seems kludgy to me, but
862 before you take it out, make sure that evaluating something like
863 (select-window (frame-root-window (new-frame))) doesn't end up
864 with your typing being interpreted in the new frame instead of
865 the one you're actually typing in. */
866 internal_last_event_frame = Qnil;
868 return frame;
871 DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 2, "e",
872 doc: /* Select FRAME.
873 Subsequent editing commands apply to its selected window.
874 Optional argument NORECORD means to neither change the order of
875 recently selected windows nor the buffer list.
877 The selection of FRAME lasts until the next time the user does
878 something to select a different frame, or until the next time
879 this function is called. If you are using a window system, the
880 previously selected frame may be restored as the selected frame
881 when returning to the command loop, because it still may have
882 the window system's input focus. On a text terminal, the next
883 redisplay will display FRAME.
885 This function returns FRAME, or nil if FRAME has been deleted. */)
886 (Lisp_Object frame, Lisp_Object norecord)
888 return do_switch_frame (frame, 1, 0, norecord);
891 DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 1, "e",
892 doc: /* Handle a switch-frame event EVENT.
893 Switch-frame events are usually bound to this function.
894 A switch-frame event tells Emacs that the window manager has requested
895 that the user's events be directed to the frame mentioned in the event.
896 This function selects the selected window of the frame of EVENT.
898 If EVENT is frame object, handle it as if it were a switch-frame event
899 to that frame. */)
900 (Lisp_Object event)
902 /* Preserve prefix arg that the command loop just cleared. */
903 kset_prefix_arg (current_kboard, Vcurrent_prefix_arg);
904 Frun_hooks (1, &Qmouse_leave_buffer_hook);
905 /* `switch-frame' implies a focus in. */
906 call1 (intern ("handle-focus-in"), event);
907 return do_switch_frame (event, 0, 0, Qnil);
910 DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0,
911 doc: /* Return the frame that is now selected. */)
912 (void)
914 return selected_frame;
917 DEFUN ("frame-list", Fframe_list, Sframe_list,
918 0, 0, 0,
919 doc: /* Return a list of all live frames. */)
920 (void)
922 Lisp_Object frames;
923 frames = Fcopy_sequence (Vframe_list);
924 #ifdef HAVE_WINDOW_SYSTEM
925 if (FRAMEP (tip_frame))
926 frames = Fdelq (tip_frame, frames);
927 #endif
928 return frames;
931 /* Return CANDIDATE if it can be used as 'other-than-FRAME' frame on the
932 same tty (for tty frames) or among frames which uses FRAME's keyboard.
933 If MINIBUF is nil, do not consider minibuffer-only candidate.
934 If MINIBUF is `visible', do not consider an invisible candidate.
935 If MINIBUF is a window, consider only its own frame and candidate now
936 using that window as the minibuffer.
937 If MINIBUF is 0, consider candidate if it is visible or iconified.
938 Otherwise consider any candidate and return nil if CANDIDATE is not
939 acceptable. */
941 static Lisp_Object
942 candidate_frame (Lisp_Object candidate, Lisp_Object frame, Lisp_Object minibuf)
944 struct frame *c = XFRAME (candidate), *f = XFRAME (frame);
946 if ((!FRAME_TERMCAP_P (c) && !FRAME_TERMCAP_P (f)
947 && FRAME_KBOARD (c) == FRAME_KBOARD (f))
948 || (FRAME_TERMCAP_P (c) && FRAME_TERMCAP_P (f)
949 && FRAME_TTY (c) == FRAME_TTY (f)))
951 if (NILP (minibuf))
953 if (!FRAME_MINIBUF_ONLY_P (c))
954 return candidate;
956 else if (EQ (minibuf, Qvisible))
958 if (FRAME_VISIBLE_P (c))
959 return candidate;
961 else if (WINDOWP (minibuf))
963 if (EQ (FRAME_MINIBUF_WINDOW (c), minibuf)
964 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), candidate)
965 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
966 FRAME_FOCUS_FRAME (c)))
967 return candidate;
969 else if (XFASTINT (minibuf) == 0)
971 if (FRAME_VISIBLE_P (c) || FRAME_ICONIFIED_P (c))
972 return candidate;
974 else
975 return candidate;
977 return Qnil;
980 /* Return the next frame in the frame list after FRAME. */
982 static Lisp_Object
983 next_frame (Lisp_Object frame, Lisp_Object minibuf)
985 Lisp_Object f, tail;
986 int passed = 0;
988 /* There must always be at least one frame in Vframe_list. */
989 eassert (CONSP (Vframe_list));
991 while (passed < 2)
992 FOR_EACH_FRAME (tail, f)
994 if (passed)
996 f = candidate_frame (f, frame, minibuf);
997 if (!NILP (f))
998 return f;
1000 if (EQ (frame, f))
1001 passed++;
1003 return frame;
1006 /* Return the previous frame in the frame list before FRAME. */
1008 static Lisp_Object
1009 prev_frame (Lisp_Object frame, Lisp_Object minibuf)
1011 Lisp_Object f, tail, prev = Qnil;
1013 /* There must always be at least one frame in Vframe_list. */
1014 eassert (CONSP (Vframe_list));
1016 FOR_EACH_FRAME (tail, f)
1018 if (EQ (frame, f) && !NILP (prev))
1019 return prev;
1020 f = candidate_frame (f, frame, minibuf);
1021 if (!NILP (f))
1022 prev = f;
1025 /* We've scanned the entire list. */
1026 if (NILP (prev))
1027 /* We went through the whole frame list without finding a single
1028 acceptable frame. Return the original frame. */
1029 return frame;
1030 else
1031 /* There were no acceptable frames in the list before FRAME; otherwise,
1032 we would have returned directly from the loop. Since PREV is the last
1033 acceptable frame in the list, return it. */
1034 return prev;
1038 DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0,
1039 doc: /* Return the next frame in the frame list after FRAME.
1040 It considers only frames on the same terminal as FRAME.
1041 By default, skip minibuffer-only frames.
1042 If omitted, FRAME defaults to the selected frame.
1043 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1044 If MINIFRAME is a window, include only its own frame
1045 and any frame now using that window as the minibuffer.
1046 If MINIFRAME is `visible', include all visible frames.
1047 If MINIFRAME is 0, include all visible and iconified frames.
1048 Otherwise, include all frames. */)
1049 (Lisp_Object frame, Lisp_Object miniframe)
1051 if (NILP (frame))
1052 frame = selected_frame;
1053 CHECK_LIVE_FRAME (frame);
1054 return next_frame (frame, miniframe);
1057 DEFUN ("previous-frame", Fprevious_frame, Sprevious_frame, 0, 2, 0,
1058 doc: /* Return the previous frame in the frame list before 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)
1070 if (NILP (frame))
1071 frame = selected_frame;
1072 CHECK_LIVE_FRAME (frame);
1073 return prev_frame (frame, miniframe);
1076 DEFUN ("last-nonminibuffer-frame", Flast_nonminibuf_frame,
1077 Slast_nonminibuf_frame, 0, 0, 0,
1078 doc: /* Return last non-minibuffer frame selected. */)
1079 (void)
1081 Lisp_Object frame = Qnil;
1083 if (last_nonminibuf_frame)
1084 XSETFRAME (frame, last_nonminibuf_frame);
1086 return frame;
1089 /* Return 1 if it is ok to delete frame F;
1090 0 if all frames aside from F are invisible.
1091 (Exception: if F is the terminal frame, and we are using X, return 1.) */
1093 static int
1094 other_visible_frames (struct frame *f)
1096 Lisp_Object frames, this;
1098 FOR_EACH_FRAME (frames, this)
1100 if (f == XFRAME (this))
1101 continue;
1103 /* Verify that we can still talk to the frame's X window,
1104 and note any recent change in visibility. */
1105 #ifdef HAVE_X_WINDOWS
1106 if (FRAME_WINDOW_P (XFRAME (this)))
1107 x_sync (XFRAME (this));
1108 #endif
1110 if (FRAME_VISIBLE_P (XFRAME (this))
1111 || FRAME_ICONIFIED_P (XFRAME (this))
1112 /* Allow deleting the terminal frame when at least one X
1113 frame exists. */
1114 || (FRAME_WINDOW_P (XFRAME (this)) && !FRAME_WINDOW_P (f)))
1115 return 1;
1117 return 0;
1120 /* Make sure that minibuf_window doesn't refer to FRAME's minibuffer
1121 window. Preferably use the selected frame's minibuffer window
1122 instead. If the selected frame doesn't have one, get some other
1123 frame's minibuffer window. SELECT non-zero means select the new
1124 minibuffer window. */
1125 static void
1126 check_minibuf_window (Lisp_Object frame, int select)
1128 struct frame *f = decode_live_frame (frame);
1130 XSETFRAME (frame, f);
1132 if (WINDOWP (minibuf_window) && EQ (f->minibuffer_window, minibuf_window))
1134 Lisp_Object frames, this, window = make_number (0);
1136 if (!EQ (frame, selected_frame)
1137 && FRAME_HAS_MINIBUF_P (XFRAME (selected_frame)))
1138 window = FRAME_MINIBUF_WINDOW (XFRAME (selected_frame));
1139 else
1140 FOR_EACH_FRAME (frames, this)
1142 if (!EQ (this, frame) && FRAME_HAS_MINIBUF_P (XFRAME (this)))
1144 window = FRAME_MINIBUF_WINDOW (XFRAME (this));
1145 break;
1149 /* Don't abort if no window was found (Bug#15247). */
1150 if (WINDOWP (window))
1152 /* Use set_window_buffer instead of Fset_window_buffer (see
1153 discussion of bug#11984, bug#12025, bug#12026). */
1154 set_window_buffer (window, XWINDOW (minibuf_window)->contents, 0, 0);
1155 minibuf_window = window;
1157 /* SELECT non-zero usually means that FRAME's minibuffer
1158 window was selected; select the new one. */
1159 if (select)
1160 Fselect_window (minibuf_window, Qnil);
1166 /* Delete FRAME. When FORCE equals Qnoelisp, delete FRAME
1167 unconditionally. x_connection_closed and delete_terminal use
1168 this. Any other value of FORCE implements the semantics
1169 described for Fdelete_frame. */
1170 Lisp_Object
1171 delete_frame (Lisp_Object frame, Lisp_Object force)
1173 struct frame *f = decode_any_frame (frame);
1174 struct frame *sf;
1175 struct kboard *kb;
1177 int minibuffer_selected, is_tooltip_frame;
1179 if (! FRAME_LIVE_P (f))
1180 return Qnil;
1182 if (NILP (force) && !other_visible_frames (f))
1183 error ("Attempt to delete the sole visible or iconified frame");
1185 /* x_connection_closed must have set FORCE to `noelisp' in order
1186 to delete the last frame, if it is gone. */
1187 if (NILP (XCDR (Vframe_list)) && !EQ (force, Qnoelisp))
1188 error ("Attempt to delete the only frame");
1190 XSETFRAME (frame, f);
1192 /* Does this frame have a minibuffer, and is it the surrogate
1193 minibuffer for any other frame? */
1194 if (FRAME_HAS_MINIBUF_P (f))
1196 Lisp_Object frames, this;
1198 FOR_EACH_FRAME (frames, this)
1200 Lisp_Object fminiw;
1202 if (EQ (this, frame))
1203 continue;
1205 fminiw = FRAME_MINIBUF_WINDOW (XFRAME (this));
1207 if (WINDOWP (fminiw) && EQ (frame, WINDOW_FRAME (XWINDOW (fminiw))))
1209 /* If we MUST delete this frame, delete the other first.
1210 But do this only if FORCE equals `noelisp'. */
1211 if (EQ (force, Qnoelisp))
1212 delete_frame (this, Qnoelisp);
1213 else
1214 error ("Attempt to delete a surrogate minibuffer frame");
1219 is_tooltip_frame = !NILP (Fframe_parameter (frame, intern ("tooltip")));
1221 /* Run `delete-frame-functions' unless FORCE is `noelisp' or
1222 frame is a tooltip. FORCE is set to `noelisp' when handling
1223 a disconnect from the terminal, so we don't dare call Lisp
1224 code. */
1225 if (NILP (Vrun_hooks) || is_tooltip_frame)
1227 else if (EQ (force, Qnoelisp))
1228 pending_funcalls
1229 = Fcons (list3 (Qrun_hook_with_args, Qdelete_frame_functions, frame),
1230 pending_funcalls);
1231 else
1233 #ifdef HAVE_X_WINDOWS
1234 /* Also, save clipboard to the clipboard manager. */
1235 x_clipboard_manager_save_frame (frame);
1236 #endif
1238 safe_call2 (Qrun_hook_with_args, Qdelete_frame_functions, frame);
1241 /* The hook may sometimes (indirectly) cause the frame to be deleted. */
1242 if (! FRAME_LIVE_P (f))
1243 return Qnil;
1245 /* At this point, we are committed to deleting the frame.
1246 There is no more chance for errors to prevent it. */
1248 minibuffer_selected = EQ (minibuf_window, selected_window);
1249 sf = SELECTED_FRAME ();
1250 /* Don't let the frame remain selected. */
1251 if (f == sf)
1253 Lisp_Object tail;
1254 Lisp_Object frame1 = Qnil;
1256 /* Look for another visible frame on the same terminal.
1257 Do not call next_frame here because it may loop forever.
1258 See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=15025. */
1259 FOR_EACH_FRAME (tail, frame1)
1260 if (!EQ (frame, frame1)
1261 && (FRAME_TERMINAL (XFRAME (frame))
1262 == FRAME_TERMINAL (XFRAME (frame1)))
1263 && FRAME_VISIBLE_P (XFRAME (frame1)))
1264 break;
1266 /* If there is none, find *some* other frame. */
1267 if (NILP (frame1) || EQ (frame1, frame))
1269 FOR_EACH_FRAME (tail, frame1)
1271 if (! EQ (frame, frame1) && FRAME_LIVE_P (XFRAME (frame1)))
1273 /* Do not change a text terminal's top-frame. */
1274 struct frame *f1 = XFRAME (frame1);
1275 if (FRAME_TERMCAP_P (f1) || FRAME_MSDOS_P (f1))
1277 Lisp_Object top_frame = FRAME_TTY (f1)->top_frame;
1278 if (!EQ (top_frame, frame))
1279 frame1 = top_frame;
1281 break;
1285 #ifdef NS_IMPL_COCOA
1286 else
1287 /* Under NS, there is no system mechanism for choosing a new
1288 window to get focus -- it is left to application code.
1289 So the portion of THIS application interfacing with NS
1290 needs to know about it. We call Fraise_frame, but the
1291 purpose is really to transfer focus. */
1292 Fraise_frame (frame1);
1293 #endif
1295 do_switch_frame (frame1, 0, 1, Qnil);
1296 sf = SELECTED_FRAME ();
1299 /* Don't allow minibuf_window to remain on a deleted frame. */
1300 check_minibuf_window (frame, minibuffer_selected);
1302 /* Don't let echo_area_window to remain on a deleted frame. */
1303 if (EQ (f->minibuffer_window, echo_area_window))
1304 echo_area_window = sf->minibuffer_window;
1306 /* Clear any X selections for this frame. */
1307 #ifdef HAVE_X_WINDOWS
1308 if (FRAME_X_P (f))
1309 x_clear_frame_selections (f);
1310 #endif
1312 /* Free glyphs.
1313 This function must be called before the window tree of the
1314 frame is deleted because windows contain dynamically allocated
1315 memory. */
1316 free_glyphs (f);
1318 #ifdef HAVE_WINDOW_SYSTEM
1319 /* Give chance to each font driver to free a frame specific data. */
1320 font_update_drivers (f, Qnil);
1321 #endif
1323 /* Mark all the windows that used to be on FRAME as deleted, and then
1324 remove the reference to them. */
1325 delete_all_child_windows (f->root_window);
1326 fset_root_window (f, Qnil);
1328 Vframe_list = Fdelq (frame, Vframe_list);
1329 SET_FRAME_VISIBLE (f, 0);
1331 /* Allow the vector of menu bar contents to be freed in the next
1332 garbage collection. The frame object itself may not be garbage
1333 collected until much later, because recent_keys and other data
1334 structures can still refer to it. */
1335 fset_menu_bar_vector (f, Qnil);
1337 /* If FRAME's buffer lists contains killed
1338 buffers, this helps GC to reclaim them. */
1339 fset_buffer_list (f, Qnil);
1340 fset_buried_buffer_list (f, Qnil);
1342 free_font_driver_list (f);
1343 xfree (f->namebuf);
1344 xfree (f->decode_mode_spec_buffer);
1345 xfree (FRAME_INSERT_COST (f));
1346 xfree (FRAME_DELETEN_COST (f));
1347 xfree (FRAME_INSERTN_COST (f));
1348 xfree (FRAME_DELETE_COST (f));
1350 /* Since some events are handled at the interrupt level, we may get
1351 an event for f at any time; if we zero out the frame's terminal
1352 now, then we may trip up the event-handling code. Instead, we'll
1353 promise that the terminal of the frame must be valid until we
1354 have called the window-system-dependent frame destruction
1355 routine. */
1359 block_input ();
1360 if (FRAME_TERMINAL (f)->delete_frame_hook)
1361 (*FRAME_TERMINAL (f)->delete_frame_hook) (f);
1362 struct terminal *terminal = FRAME_TERMINAL (f);
1363 f->output_data.nothing = 0;
1364 f->terminal = 0; /* Now the frame is dead. */
1365 unblock_input ();
1367 /* If needed, delete the terminal that this frame was on.
1368 (This must be done after the frame is killed.) */
1369 terminal->reference_count--;
1370 #ifdef USE_GTK
1371 /* FIXME: Deleting the terminal crashes emacs because of a GTK
1372 bug.
1373 http://lists.gnu.org/archive/html/emacs-devel/2011-10/msg00363.html */
1374 if (terminal->reference_count == 0 && terminal->type == output_x_window)
1375 terminal->reference_count = 1;
1376 #endif /* USE_GTK */
1377 if (terminal->reference_count == 0)
1379 Lisp_Object tmp;
1380 XSETTERMINAL (tmp, terminal);
1382 kb = NULL;
1383 Fdelete_terminal (tmp, NILP (force) ? Qt : force);
1385 else
1386 kb = terminal->kboard;
1389 /* If we've deleted the last_nonminibuf_frame, then try to find
1390 another one. */
1391 if (f == last_nonminibuf_frame)
1393 Lisp_Object frames, this;
1395 last_nonminibuf_frame = 0;
1397 FOR_EACH_FRAME (frames, this)
1399 f = XFRAME (this);
1400 if (!FRAME_MINIBUF_ONLY_P (f))
1402 last_nonminibuf_frame = f;
1403 break;
1408 /* If there's no other frame on the same kboard, get out of
1409 single-kboard state if we're in it for this kboard. */
1410 if (kb != NULL)
1412 Lisp_Object frames, this;
1413 /* Some frame we found on the same kboard, or nil if there are none. */
1414 Lisp_Object frame_on_same_kboard = Qnil;
1416 FOR_EACH_FRAME (frames, this)
1417 if (kb == FRAME_KBOARD (XFRAME (this)))
1418 frame_on_same_kboard = this;
1420 if (NILP (frame_on_same_kboard))
1421 not_single_kboard_state (kb);
1425 /* If we've deleted this keyboard's default_minibuffer_frame, try to
1426 find another one. Prefer minibuffer-only frames, but also notice
1427 frames with other windows. */
1428 if (kb != NULL && EQ (frame, KVAR (kb, Vdefault_minibuffer_frame)))
1430 Lisp_Object frames, this;
1432 /* The last frame we saw with a minibuffer, minibuffer-only or not. */
1433 Lisp_Object frame_with_minibuf = Qnil;
1434 /* Some frame we found on the same kboard, or nil if there are none. */
1435 Lisp_Object frame_on_same_kboard = Qnil;
1437 FOR_EACH_FRAME (frames, this)
1439 struct frame *f1 = XFRAME (this);
1441 /* Consider only frames on the same kboard
1442 and only those with minibuffers. */
1443 if (kb == FRAME_KBOARD (f1)
1444 && FRAME_HAS_MINIBUF_P (f1))
1446 frame_with_minibuf = this;
1447 if (FRAME_MINIBUF_ONLY_P (f1))
1448 break;
1451 if (kb == FRAME_KBOARD (f1))
1452 frame_on_same_kboard = this;
1455 if (!NILP (frame_on_same_kboard))
1457 /* We know that there must be some frame with a minibuffer out
1458 there. If this were not true, all of the frames present
1459 would have to be minibufferless, which implies that at some
1460 point their minibuffer frames must have been deleted, but
1461 that is prohibited at the top; you can't delete surrogate
1462 minibuffer frames. */
1463 if (NILP (frame_with_minibuf))
1464 emacs_abort ();
1466 kset_default_minibuffer_frame (kb, frame_with_minibuf);
1468 else
1469 /* No frames left on this kboard--say no minibuffer either. */
1470 kset_default_minibuffer_frame (kb, Qnil);
1473 /* Cause frame titles to update--necessary if we now have just one frame. */
1474 if (!is_tooltip_frame)
1475 update_mode_lines = 15;
1477 return Qnil;
1480 DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 2, "",
1481 doc: /* Delete FRAME, permanently eliminating it from use.
1482 FRAME defaults to the selected frame.
1484 A frame may not be deleted if its minibuffer is used by other frames.
1485 Normally, you may not delete a frame if all other frames are invisible,
1486 but if the second optional argument FORCE is non-nil, you may do so.
1488 This function runs `delete-frame-functions' before actually
1489 deleting the frame, unless the frame is a tooltip.
1490 The functions are run with one argument, the frame to be deleted. */)
1491 (Lisp_Object frame, Lisp_Object force)
1493 return delete_frame (frame, !NILP (force) ? Qt : Qnil);
1497 /* Return mouse position in character cell units. */
1499 DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0,
1500 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1501 The position is given in character cells, where (0, 0) is the
1502 upper-left corner of the frame, X is the horizontal offset, and Y is
1503 the vertical offset.
1504 If Emacs is running on a mouseless terminal or hasn't been programmed
1505 to read the mouse position, it returns the selected frame for FRAME
1506 and nil for X and Y.
1507 If `mouse-position-function' is non-nil, `mouse-position' calls it,
1508 passing the normal return value to that function as an argument,
1509 and returns whatever that function returns. */)
1510 (void)
1512 struct frame *f;
1513 Lisp_Object lispy_dummy;
1514 Lisp_Object x, y, retval;
1515 struct gcpro gcpro1;
1517 f = SELECTED_FRAME ();
1518 x = y = Qnil;
1520 /* It's okay for the hook to refrain from storing anything. */
1521 if (FRAME_TERMINAL (f)->mouse_position_hook)
1523 enum scroll_bar_part party_dummy;
1524 Time time_dummy;
1525 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1526 &lispy_dummy, &party_dummy,
1527 &x, &y,
1528 &time_dummy);
1531 if (! NILP (x))
1533 int col = XINT (x);
1534 int row = XINT (y);
1535 pixel_to_glyph_coords (f, col, row, &col, &row, NULL, 1);
1536 XSETINT (x, col);
1537 XSETINT (y, row);
1539 XSETFRAME (lispy_dummy, f);
1540 retval = Fcons (lispy_dummy, Fcons (x, y));
1541 GCPRO1 (retval);
1542 if (!NILP (Vmouse_position_function))
1543 retval = call1 (Vmouse_position_function, retval);
1544 RETURN_UNGCPRO (retval);
1547 DEFUN ("mouse-pixel-position", Fmouse_pixel_position,
1548 Smouse_pixel_position, 0, 0, 0,
1549 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1550 The position is given in pixel units, where (0, 0) is the
1551 upper-left corner of the frame, X is the horizontal offset, and Y is
1552 the vertical offset.
1553 If Emacs is running on a mouseless terminal or hasn't been programmed
1554 to read the mouse position, it returns the selected frame for FRAME
1555 and nil for X and Y. */)
1556 (void)
1558 struct frame *f;
1559 Lisp_Object lispy_dummy;
1560 Lisp_Object x, y;
1562 f = SELECTED_FRAME ();
1563 x = y = Qnil;
1565 /* It's okay for the hook to refrain from storing anything. */
1566 if (FRAME_TERMINAL (f)->mouse_position_hook)
1568 enum scroll_bar_part party_dummy;
1569 Time time_dummy;
1570 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1571 &lispy_dummy, &party_dummy,
1572 &x, &y,
1573 &time_dummy);
1576 XSETFRAME (lispy_dummy, f);
1577 return Fcons (lispy_dummy, Fcons (x, y));
1580 DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0,
1581 doc: /* Move the mouse pointer to the center of character cell (X,Y) in FRAME.
1582 Coordinates are relative to the frame, not a window,
1583 so the coordinates of the top left character in the frame
1584 may be nonzero due to left-hand scroll bars or the menu bar.
1586 The position is given in character cells, where (0, 0) is the
1587 upper-left corner of the frame, X is the horizontal offset, and Y is
1588 the vertical offset.
1590 This function is a no-op for an X frame that is not visible.
1591 If you have just created a frame, you must wait for it to become visible
1592 before calling this function on it, like this.
1593 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1594 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1596 CHECK_LIVE_FRAME (frame);
1597 CHECK_TYPE_RANGED_INTEGER (int, x);
1598 CHECK_TYPE_RANGED_INTEGER (int, y);
1600 /* I think this should be done with a hook. */
1601 #ifdef HAVE_WINDOW_SYSTEM
1602 if (FRAME_WINDOW_P (XFRAME (frame)))
1603 /* Warping the mouse will cause enternotify and focus events. */
1604 x_set_mouse_position (XFRAME (frame), XINT (x), XINT (y));
1605 #else
1606 #if defined (MSDOS)
1607 if (FRAME_MSDOS_P (XFRAME (frame)))
1609 Fselect_frame (frame, Qnil);
1610 mouse_moveto (XINT (x), XINT (y));
1612 #else
1613 #ifdef HAVE_GPM
1615 Fselect_frame (frame, Qnil);
1616 term_mouse_moveto (XINT (x), XINT (y));
1618 #endif
1619 #endif
1620 #endif
1622 return Qnil;
1625 DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position,
1626 Sset_mouse_pixel_position, 3, 3, 0,
1627 doc: /* Move the mouse pointer to pixel position (X,Y) in FRAME.
1628 The position is given in pixels, where (0, 0) is the upper-left corner
1629 of the frame, X is the horizontal offset, and Y is the vertical offset.
1631 Note, this is a no-op for an X frame that is not visible.
1632 If you have just created a frame, you must wait for it to become visible
1633 before calling this function on it, like this.
1634 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1635 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1637 CHECK_LIVE_FRAME (frame);
1638 CHECK_TYPE_RANGED_INTEGER (int, x);
1639 CHECK_TYPE_RANGED_INTEGER (int, y);
1641 /* I think this should be done with a hook. */
1642 #ifdef HAVE_WINDOW_SYSTEM
1643 if (FRAME_WINDOW_P (XFRAME (frame)))
1644 /* Warping the mouse will cause enternotify and focus events. */
1645 x_set_mouse_pixel_position (XFRAME (frame), XINT (x), XINT (y));
1646 #else
1647 #if defined (MSDOS)
1648 if (FRAME_MSDOS_P (XFRAME (frame)))
1650 Fselect_frame (frame, Qnil);
1651 mouse_moveto (XINT (x), XINT (y));
1653 #else
1654 #ifdef HAVE_GPM
1656 Fselect_frame (frame, Qnil);
1657 term_mouse_moveto (XINT (x), XINT (y));
1659 #endif
1660 #endif
1661 #endif
1663 return Qnil;
1666 static void make_frame_visible_1 (Lisp_Object);
1668 DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible,
1669 0, 1, "",
1670 doc: /* Make the frame FRAME visible (assuming it is an X window).
1671 If omitted, FRAME defaults to the currently selected frame. */)
1672 (Lisp_Object frame)
1674 struct frame *f = decode_live_frame (frame);
1676 /* I think this should be done with a hook. */
1677 #ifdef HAVE_WINDOW_SYSTEM
1678 if (FRAME_WINDOW_P (f))
1679 x_make_frame_visible (f);
1680 #endif
1682 make_frame_visible_1 (f->root_window);
1684 /* Make menu bar update for the Buffers and Frames menus. */
1685 /* windows_or_buffers_changed = 15; FIXME: Why? */
1687 XSETFRAME (frame, f);
1688 return frame;
1691 /* Update the display_time slot of the buffers shown in WINDOW
1692 and all its descendants. */
1694 static void
1695 make_frame_visible_1 (Lisp_Object window)
1697 struct window *w;
1699 for (; !NILP (window); window = w->next)
1701 w = XWINDOW (window);
1702 if (WINDOWP (w->contents))
1703 make_frame_visible_1 (w->contents);
1704 else
1705 bset_display_time (XBUFFER (w->contents), Fcurrent_time ());
1709 DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible,
1710 0, 2, "",
1711 doc: /* Make the frame FRAME invisible.
1712 If omitted, FRAME defaults to the currently selected frame.
1713 On graphical displays, invisible frames are not updated and are
1714 usually not displayed at all, even in a window system's \"taskbar\".
1716 Normally you may not make FRAME invisible if all other frames are invisible,
1717 but if the second optional argument FORCE is non-nil, you may do so.
1719 This function has no effect on text terminal frames. Such frames are
1720 always considered visible, whether or not they are currently being
1721 displayed in the terminal. */)
1722 (Lisp_Object frame, Lisp_Object force)
1724 struct frame *f = decode_live_frame (frame);
1726 if (NILP (force) && !other_visible_frames (f))
1727 error ("Attempt to make invisible the sole visible or iconified frame");
1729 /* Don't allow minibuf_window to remain on an invisible frame. */
1730 check_minibuf_window (frame, EQ (minibuf_window, selected_window));
1732 /* I think this should be done with a hook. */
1733 #ifdef HAVE_WINDOW_SYSTEM
1734 if (FRAME_WINDOW_P (f))
1735 x_make_frame_invisible (f);
1736 #endif
1738 /* Make menu bar update for the Buffers and Frames menus. */
1739 windows_or_buffers_changed = 16;
1741 return Qnil;
1744 DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame,
1745 0, 1, "",
1746 doc: /* Make the frame FRAME into an icon.
1747 If omitted, FRAME defaults to the currently selected frame. */)
1748 (Lisp_Object frame)
1750 struct frame *f = decode_live_frame (frame);
1752 /* Don't allow minibuf_window to remain on an iconified frame. */
1753 check_minibuf_window (frame, EQ (minibuf_window, selected_window));
1755 /* I think this should be done with a hook. */
1756 #ifdef HAVE_WINDOW_SYSTEM
1757 if (FRAME_WINDOW_P (f))
1758 x_iconify_frame (f);
1759 #endif
1761 /* Make menu bar update for the Buffers and Frames menus. */
1762 windows_or_buffers_changed = 17;
1764 return Qnil;
1767 DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p,
1768 1, 1, 0,
1769 doc: /* Return t if FRAME is \"visible\" (actually in use for display).
1770 Return the symbol `icon' if FRAME is iconified or \"minimized\".
1771 Return nil if FRAME was made invisible, via `make-frame-invisible'.
1772 On graphical displays, invisible frames are not updated and are
1773 usually not displayed at all, even in a window system's \"taskbar\".
1775 If FRAME is a text terminal frame, this always returns t.
1776 Such frames are always considered visible, whether or not they are
1777 currently being displayed on the terminal. */)
1778 (Lisp_Object frame)
1780 CHECK_LIVE_FRAME (frame);
1782 if (FRAME_VISIBLE_P (XFRAME (frame)))
1783 return Qt;
1784 if (FRAME_ICONIFIED_P (XFRAME (frame)))
1785 return Qicon;
1786 return Qnil;
1789 DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list,
1790 0, 0, 0,
1791 doc: /* Return a list of all frames now \"visible\" (being updated). */)
1792 (void)
1794 Lisp_Object tail, frame, value = Qnil;
1796 FOR_EACH_FRAME (tail, frame)
1797 if (FRAME_VISIBLE_P (XFRAME (frame)))
1798 value = Fcons (frame, value);
1800 return value;
1804 DEFUN ("raise-frame", Fraise_frame, Sraise_frame, 0, 1, "",
1805 doc: /* Bring FRAME to the front, so it occludes any frames it overlaps.
1806 If FRAME is invisible or iconified, make it visible.
1807 If you don't specify a frame, the selected frame is used.
1808 If Emacs is displaying on an ordinary terminal or some other device which
1809 doesn't support multiple overlapping frames, this function selects FRAME. */)
1810 (Lisp_Object frame)
1812 struct frame *f = decode_live_frame (frame);
1814 XSETFRAME (frame, f);
1816 if (FRAME_TERMCAP_P (f))
1817 /* On a text terminal select FRAME. */
1818 Fselect_frame (frame, Qnil);
1819 else
1820 /* Do like the documentation says. */
1821 Fmake_frame_visible (frame);
1823 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
1824 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 1);
1826 return Qnil;
1829 /* Should we have a corresponding function called Flower_Power? */
1830 DEFUN ("lower-frame", Flower_frame, Slower_frame, 0, 1, "",
1831 doc: /* Send FRAME to the back, so it is occluded by any frames that overlap it.
1832 If you don't specify a frame, the selected frame is used.
1833 If Emacs is displaying on an ordinary terminal or some other device which
1834 doesn't support multiple overlapping frames, this function does nothing. */)
1835 (Lisp_Object frame)
1837 struct frame *f = decode_live_frame (frame);
1839 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
1840 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 0);
1842 return Qnil;
1846 DEFUN ("redirect-frame-focus", Fredirect_frame_focus, Sredirect_frame_focus,
1847 1, 2, 0,
1848 doc: /* Arrange for keystrokes typed at FRAME to be sent to FOCUS-FRAME.
1849 In other words, switch-frame events caused by events in FRAME will
1850 request a switch to FOCUS-FRAME, and `last-event-frame' will be
1851 FOCUS-FRAME after reading an event typed at FRAME.
1853 If FOCUS-FRAME is nil, any existing redirection is canceled, and the
1854 frame again receives its own keystrokes.
1856 Focus redirection is useful for temporarily redirecting keystrokes to
1857 a surrogate minibuffer frame when a frame doesn't have its own
1858 minibuffer window.
1860 A frame's focus redirection can be changed by `select-frame'. If frame
1861 FOO is selected, and then a different frame BAR is selected, any
1862 frames redirecting their focus to FOO are shifted to redirect their
1863 focus to BAR. This allows focus redirection to work properly when the
1864 user switches from one frame to another using `select-window'.
1866 This means that a frame whose focus is redirected to itself is treated
1867 differently from a frame whose focus is redirected to nil; the former
1868 is affected by `select-frame', while the latter is not.
1870 The redirection lasts until `redirect-frame-focus' is called to change it. */)
1871 (Lisp_Object frame, Lisp_Object focus_frame)
1873 /* Note that we don't check for a live frame here. It's reasonable
1874 to redirect the focus of a frame you're about to delete, if you
1875 know what other frame should receive those keystrokes. */
1876 struct frame *f = decode_any_frame (frame);
1878 if (! NILP (focus_frame))
1879 CHECK_LIVE_FRAME (focus_frame);
1881 fset_focus_frame (f, focus_frame);
1883 if (FRAME_TERMINAL (f)->frame_rehighlight_hook)
1884 (*FRAME_TERMINAL (f)->frame_rehighlight_hook) (f);
1886 return Qnil;
1890 DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 0, 1, 0,
1891 doc: /* Return the frame to which FRAME's keystrokes are currently being sent.
1892 If FRAME is omitted or nil, the selected frame is used.
1893 Return nil if FRAME's focus is not redirected.
1894 See `redirect-frame-focus'. */)
1895 (Lisp_Object frame)
1897 return FRAME_FOCUS_FRAME (decode_live_frame (frame));
1900 DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
1901 doc: /* Set the input focus to FRAME.
1902 FRAME nil means use the selected frame.
1903 If there is no window system support, this function does nothing. */)
1904 (Lisp_Object frame)
1906 #ifdef HAVE_WINDOW_SYSTEM
1907 x_focus_frame (decode_window_system_frame (frame));
1908 #endif
1909 return Qnil;
1913 /* Return the value of frame parameter PROP in frame FRAME. */
1915 #ifdef HAVE_WINDOW_SYSTEM
1916 #if !HAVE_NS && !defined (WINDOWSNT)
1917 static
1918 #endif
1919 Lisp_Object
1920 get_frame_param (register struct frame *frame, Lisp_Object prop)
1922 register Lisp_Object tem;
1924 tem = Fassq (prop, frame->param_alist);
1925 if (EQ (tem, Qnil))
1926 return tem;
1927 return Fcdr (tem);
1929 #endif
1931 /* Discard BUFFER from the buffer-list and buried-buffer-list of each frame. */
1933 void
1934 frames_discard_buffer (Lisp_Object buffer)
1936 Lisp_Object frame, tail;
1938 FOR_EACH_FRAME (tail, frame)
1940 fset_buffer_list
1941 (XFRAME (frame), Fdelq (buffer, XFRAME (frame)->buffer_list));
1942 fset_buried_buffer_list
1943 (XFRAME (frame), Fdelq (buffer, XFRAME (frame)->buried_buffer_list));
1947 /* Modify the alist in *ALISTPTR to associate PROP with VAL.
1948 If the alist already has an element for PROP, we change it. */
1950 void
1951 store_in_alist (Lisp_Object *alistptr, Lisp_Object prop, Lisp_Object val)
1953 register Lisp_Object tem;
1955 tem = Fassq (prop, *alistptr);
1956 if (EQ (tem, Qnil))
1957 *alistptr = Fcons (Fcons (prop, val), *alistptr);
1958 else
1959 Fsetcdr (tem, val);
1962 static int
1963 frame_name_fnn_p (char *str, ptrdiff_t len)
1965 if (len > 1 && str[0] == 'F' && '0' <= str[1] && str[1] <= '9')
1967 char *p = str + 2;
1968 while ('0' <= *p && *p <= '9')
1969 p++;
1970 if (p == str + len)
1971 return 1;
1973 return 0;
1976 /* Set the name of the terminal frame. Also used by MSDOS frames.
1977 Modeled after x_set_name which is used for WINDOW frames. */
1979 static void
1980 set_term_frame_name (struct frame *f, Lisp_Object name)
1982 f->explicit_name = ! NILP (name);
1984 /* If NAME is nil, set the name to F<num>. */
1985 if (NILP (name))
1987 char namebuf[sizeof "F" + INT_STRLEN_BOUND (printmax_t)];
1989 /* Check for no change needed in this very common case
1990 before we do any consing. */
1991 if (frame_name_fnn_p (SSDATA (f->name), SBYTES (f->name)))
1992 return;
1994 name = make_formatted_string (namebuf, "F%"pMd, ++tty_frame_count);
1996 else
1998 CHECK_STRING (name);
2000 /* Don't change the name if it's already NAME. */
2001 if (! NILP (Fstring_equal (name, f->name)))
2002 return;
2004 /* Don't allow the user to set the frame name to F<num>, so it
2005 doesn't clash with the names we generate for terminal frames. */
2006 if (frame_name_fnn_p (SSDATA (name), SBYTES (name)))
2007 error ("Frame names of the form F<num> are usurped by Emacs");
2010 fset_name (f, name);
2011 update_mode_lines = 16;
2014 void
2015 store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
2017 register Lisp_Object old_alist_elt;
2019 /* The buffer-list parameters are stored in a special place and not
2020 in the alist. All buffers must be live. */
2021 if (EQ (prop, Qbuffer_list))
2023 Lisp_Object list = Qnil;
2024 for (; CONSP (val); val = XCDR (val))
2025 if (!NILP (Fbuffer_live_p (XCAR (val))))
2026 list = Fcons (XCAR (val), list);
2027 fset_buffer_list (f, Fnreverse (list));
2028 return;
2030 if (EQ (prop, Qburied_buffer_list))
2032 Lisp_Object list = Qnil;
2033 for (; CONSP (val); val = XCDR (val))
2034 if (!NILP (Fbuffer_live_p (XCAR (val))))
2035 list = Fcons (XCAR (val), list);
2036 fset_buried_buffer_list (f, Fnreverse (list));
2037 return;
2040 /* If PROP is a symbol which is supposed to have frame-local values,
2041 and it is set up based on this frame, switch to the global
2042 binding. That way, we can create or alter the frame-local binding
2043 without messing up the symbol's status. */
2044 if (SYMBOLP (prop))
2046 struct Lisp_Symbol *sym = XSYMBOL (prop);
2047 start:
2048 switch (sym->redirect)
2050 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
2051 case SYMBOL_PLAINVAL: case SYMBOL_FORWARDED: break;
2052 case SYMBOL_LOCALIZED:
2053 { struct Lisp_Buffer_Local_Value *blv = sym->val.blv;
2054 if (blv->frame_local && blv_found (blv) && XFRAME (blv->where) == f)
2055 swap_in_global_binding (sym);
2056 break;
2058 default: emacs_abort ();
2062 /* The tty color needed to be set before the frame's parameter
2063 alist was updated with the new value. This is not true any more,
2064 but we still do this test early on. */
2065 if (FRAME_TERMCAP_P (f) && EQ (prop, Qtty_color_mode)
2066 && f == FRAME_TTY (f)->previous_frame)
2067 /* Force redisplay of this tty. */
2068 FRAME_TTY (f)->previous_frame = NULL;
2070 /* Update the frame parameter alist. */
2071 old_alist_elt = Fassq (prop, f->param_alist);
2072 if (EQ (old_alist_elt, Qnil))
2073 fset_param_alist (f, Fcons (Fcons (prop, val), f->param_alist));
2074 else
2075 Fsetcdr (old_alist_elt, val);
2077 /* Update some other special parameters in their special places
2078 in addition to the alist. */
2080 if (EQ (prop, Qbuffer_predicate))
2081 fset_buffer_predicate (f, val);
2083 if (! FRAME_WINDOW_P (f))
2085 if (EQ (prop, Qmenu_bar_lines))
2086 set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f)));
2087 else if (EQ (prop, Qname))
2088 set_term_frame_name (f, val);
2091 if (EQ (prop, Qminibuffer) && WINDOWP (val))
2093 if (! MINI_WINDOW_P (XWINDOW (val)))
2094 error ("Surrogate minibuffer windows must be minibuffer windows");
2096 if ((FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
2097 && !EQ (val, f->minibuffer_window))
2098 error ("Can't change the surrogate minibuffer of a frame with its own minibuffer");
2100 /* Install the chosen minibuffer window, with proper buffer. */
2101 fset_minibuffer_window (f, val);
2105 DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0,
2106 doc: /* Return the parameters-alist of frame FRAME.
2107 It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
2108 The meaningful PARMs depend on the kind of frame.
2109 If FRAME is omitted or nil, return information on the currently selected frame. */)
2110 (Lisp_Object frame)
2112 Lisp_Object alist;
2113 struct frame *f = decode_any_frame (frame);
2114 int height, width;
2115 struct gcpro gcpro1;
2117 if (!FRAME_LIVE_P (f))
2118 return Qnil;
2120 alist = Fcopy_alist (f->param_alist);
2121 GCPRO1 (alist);
2123 if (!FRAME_WINDOW_P (f))
2125 int fg = FRAME_FOREGROUND_PIXEL (f);
2126 int bg = FRAME_BACKGROUND_PIXEL (f);
2127 Lisp_Object elt;
2129 /* If the frame's parameter alist says the colors are
2130 unspecified and reversed, take the frame's background pixel
2131 for foreground and vice versa. */
2132 elt = Fassq (Qforeground_color, alist);
2133 if (CONSP (elt) && STRINGP (XCDR (elt)))
2135 if (strncmp (SSDATA (XCDR (elt)),
2136 unspecified_bg,
2137 SCHARS (XCDR (elt))) == 0)
2138 store_in_alist (&alist, Qforeground_color, tty_color_name (f, bg));
2139 else if (strncmp (SSDATA (XCDR (elt)),
2140 unspecified_fg,
2141 SCHARS (XCDR (elt))) == 0)
2142 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2144 else
2145 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2146 elt = Fassq (Qbackground_color, alist);
2147 if (CONSP (elt) && STRINGP (XCDR (elt)))
2149 if (strncmp (SSDATA (XCDR (elt)),
2150 unspecified_fg,
2151 SCHARS (XCDR (elt))) == 0)
2152 store_in_alist (&alist, Qbackground_color, tty_color_name (f, fg));
2153 else if (strncmp (SSDATA (XCDR (elt)),
2154 unspecified_bg,
2155 SCHARS (XCDR (elt))) == 0)
2156 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2158 else
2159 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2160 store_in_alist (&alist, intern ("font"),
2161 build_string (FRAME_MSDOS_P (f)
2162 ? "ms-dos"
2163 : FRAME_W32_P (f) ? "w32term"
2164 :"tty"));
2166 store_in_alist (&alist, Qname, f->name);
2167 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2168 store_in_alist (&alist, Qheight, make_number (height));
2169 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2170 store_in_alist (&alist, Qwidth, make_number (width));
2171 store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil));
2172 store_in_alist (&alist, Qminibuffer,
2173 (! FRAME_HAS_MINIBUF_P (f) ? Qnil
2174 : FRAME_MINIBUF_ONLY_P (f) ? Qonly
2175 : FRAME_MINIBUF_WINDOW (f)));
2176 store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
2177 store_in_alist (&alist, Qbuffer_list, f->buffer_list);
2178 store_in_alist (&alist, Qburied_buffer_list, f->buried_buffer_list);
2180 /* I think this should be done with a hook. */
2181 #ifdef HAVE_WINDOW_SYSTEM
2182 if (FRAME_WINDOW_P (f))
2183 x_report_frame_params (f, &alist);
2184 else
2185 #endif
2187 /* This ought to be correct in f->param_alist for an X frame. */
2188 Lisp_Object lines;
2189 XSETFASTINT (lines, FRAME_MENU_BAR_LINES (f));
2190 store_in_alist (&alist, Qmenu_bar_lines, lines);
2193 UNGCPRO;
2194 return alist;
2198 DEFUN ("frame-parameter", Fframe_parameter, Sframe_parameter, 2, 2, 0,
2199 doc: /* Return FRAME's value for parameter PARAMETER.
2200 If FRAME is nil, describe the currently selected frame. */)
2201 (Lisp_Object frame, Lisp_Object parameter)
2203 struct frame *f = decode_any_frame (frame);
2204 Lisp_Object value = Qnil;
2206 CHECK_SYMBOL (parameter);
2208 XSETFRAME (frame, f);
2210 if (FRAME_LIVE_P (f))
2212 /* Avoid consing in frequent cases. */
2213 if (EQ (parameter, Qname))
2214 value = f->name;
2215 #ifdef HAVE_X_WINDOWS
2216 else if (EQ (parameter, Qdisplay) && FRAME_X_P (f))
2217 value = XCAR (FRAME_DISPLAY_INFO (f)->name_list_element);
2218 #endif /* HAVE_X_WINDOWS */
2219 else if (EQ (parameter, Qbackground_color)
2220 || EQ (parameter, Qforeground_color))
2222 value = Fassq (parameter, f->param_alist);
2223 if (CONSP (value))
2225 value = XCDR (value);
2226 /* Fframe_parameters puts the actual fg/bg color names,
2227 even if f->param_alist says otherwise. This is
2228 important when param_alist's notion of colors is
2229 "unspecified". We need to do the same here. */
2230 if (STRINGP (value) && !FRAME_WINDOW_P (f))
2232 const char *color_name;
2233 ptrdiff_t csz;
2235 if (EQ (parameter, Qbackground_color))
2237 color_name = SSDATA (value);
2238 csz = SCHARS (value);
2239 if (strncmp (color_name, unspecified_bg, csz) == 0)
2240 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2241 else if (strncmp (color_name, unspecified_fg, csz) == 0)
2242 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2244 else if (EQ (parameter, Qforeground_color))
2246 color_name = SSDATA (value);
2247 csz = SCHARS (value);
2248 if (strncmp (color_name, unspecified_fg, csz) == 0)
2249 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2250 else if (strncmp (color_name, unspecified_bg, csz) == 0)
2251 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2255 else
2256 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2258 else if (EQ (parameter, Qdisplay_type)
2259 || EQ (parameter, Qbackground_mode))
2260 value = Fcdr (Fassq (parameter, f->param_alist));
2261 else
2262 /* FIXME: Avoid this code path at all (as well as code duplication)
2263 by sharing more code with Fframe_parameters. */
2264 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2267 return value;
2271 DEFUN ("modify-frame-parameters", Fmodify_frame_parameters,
2272 Smodify_frame_parameters, 2, 2, 0,
2273 doc: /* Modify the parameters of frame FRAME according to ALIST.
2274 If FRAME is nil, it defaults to the selected frame.
2275 ALIST is an alist of parameters to change and their new values.
2276 Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.
2277 The meaningful PARMs depend on the kind of frame.
2278 Undefined PARMs are ignored, but stored in the frame's parameter list
2279 so that `frame-parameters' will return them.
2281 The value of frame parameter FOO can also be accessed
2282 as a frame-local binding for the variable FOO, if you have
2283 enabled such bindings for that variable with `make-variable-frame-local'.
2284 Note that this functionality is obsolete as of Emacs 22.2, and its
2285 use is not recommended. Explicitly check for a frame-parameter instead. */)
2286 (Lisp_Object frame, Lisp_Object alist)
2288 struct frame *f = decode_live_frame (frame);
2289 register Lisp_Object prop, val;
2291 CHECK_LIST (alist);
2293 /* I think this should be done with a hook. */
2294 #ifdef HAVE_WINDOW_SYSTEM
2295 if (FRAME_WINDOW_P (f))
2296 x_set_frame_parameters (f, alist);
2297 else
2298 #endif
2299 #ifdef MSDOS
2300 if (FRAME_MSDOS_P (f))
2301 IT_set_frame_parameters (f, alist);
2302 else
2303 #endif
2306 EMACS_INT length = XFASTINT (Flength (alist));
2307 ptrdiff_t i;
2308 Lisp_Object *parms;
2309 Lisp_Object *values;
2310 USE_SAFE_ALLOCA;
2311 SAFE_ALLOCA_LISP (parms, 2 * length);
2312 values = parms + length;
2314 /* Extract parm names and values into those vectors. */
2316 for (i = 0; CONSP (alist); alist = XCDR (alist))
2318 Lisp_Object elt;
2320 elt = XCAR (alist);
2321 parms[i] = Fcar (elt);
2322 values[i] = Fcdr (elt);
2323 i++;
2326 /* Now process them in reverse of specified order. */
2327 while (--i >= 0)
2329 prop = parms[i];
2330 val = values[i];
2331 store_frame_param (f, prop, val);
2333 if (EQ (prop, Qforeground_color)
2334 || EQ (prop, Qbackground_color))
2335 update_face_from_frame_parameter (f, prop, val);
2338 SAFE_FREE ();
2340 return Qnil;
2343 DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height,
2344 0, 1, 0,
2345 doc: /* Height in pixels of a line in the font in frame FRAME.
2346 If FRAME is omitted or nil, the selected frame is used.
2347 For a terminal frame, the value is always 1. */)
2348 (Lisp_Object frame)
2350 #ifdef HAVE_WINDOW_SYSTEM
2351 struct frame *f = decode_any_frame (frame);
2353 if (FRAME_WINDOW_P (f))
2354 return make_number (FRAME_LINE_HEIGHT (f));
2355 else
2356 #endif
2357 return make_number (1);
2361 DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width,
2362 0, 1, 0,
2363 doc: /* Width in pixels of characters in the font in frame FRAME.
2364 If FRAME is omitted or nil, the selected frame is used.
2365 On a graphical screen, the width is the standard width of the default font.
2366 For a terminal screen, the value is always 1. */)
2367 (Lisp_Object frame)
2369 #ifdef HAVE_WINDOW_SYSTEM
2370 struct frame *f = decode_any_frame (frame);
2372 if (FRAME_WINDOW_P (f))
2373 return make_number (FRAME_COLUMN_WIDTH (f));
2374 else
2375 #endif
2376 return make_number (1);
2379 DEFUN ("frame-pixel-height", Fframe_pixel_height,
2380 Sframe_pixel_height, 0, 1, 0,
2381 doc: /* Return a FRAME's height in pixels.
2382 If FRAME is omitted or nil, the selected frame is used. The exact value
2383 of the result depends on the window-system and toolkit in use:
2385 In the Gtk+ version of Emacs, it includes only any window (including
2386 the minibuffer or echo area), mode line, and header line. It does not
2387 include the tool bar or menu bar.
2389 With other graphical versions, it also includes the tool bar and the
2390 menu bar.
2392 For a text terminal, it includes the menu bar. In this case, the
2393 result is really in characters rather than pixels (i.e., is identical
2394 to `frame-height'). */)
2395 (Lisp_Object frame)
2397 struct frame *f = decode_any_frame (frame);
2399 #ifdef HAVE_WINDOW_SYSTEM
2400 if (FRAME_WINDOW_P (f))
2401 return make_number (FRAME_PIXEL_HEIGHT (f));
2402 else
2403 #endif
2404 return make_number (FRAME_LINES (f));
2407 DEFUN ("frame-pixel-width", Fframe_pixel_width,
2408 Sframe_pixel_width, 0, 1, 0,
2409 doc: /* Return FRAME's width in pixels.
2410 For a terminal frame, the result really gives the width in characters.
2411 If FRAME is omitted or nil, the selected frame is used. */)
2412 (Lisp_Object frame)
2414 struct frame *f = decode_any_frame (frame);
2416 #ifdef HAVE_WINDOW_SYSTEM
2417 if (FRAME_WINDOW_P (f))
2418 return make_number (FRAME_PIXEL_WIDTH (f));
2419 else
2420 #endif
2421 return make_number (FRAME_COLS (f));
2424 DEFUN ("tool-bar-pixel-width", Ftool_bar_pixel_width,
2425 Stool_bar_pixel_width, 0, 1, 0,
2426 doc: /* Return width in pixels of FRAME's tool bar.
2427 The result is greater than zero only when the tool bar is on the left
2428 or right side of FRAME. If FRAME is omitted or nil, the selected frame
2429 is used. */)
2430 (Lisp_Object frame)
2432 #ifdef FRAME_TOOLBAR_WIDTH
2433 struct frame *f = decode_any_frame (frame);
2435 if (FRAME_WINDOW_P (f))
2436 return make_number (FRAME_TOOLBAR_WIDTH (f));
2437 #endif
2438 return make_number (0);
2441 DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0,
2442 doc: /* Specify that the frame FRAME has LINES lines.
2443 If FRAME is nil, the selected frame is used. Optional third arg
2444 non-nil means that redisplay should use LINES lines but that the
2445 idea of the actual height of the frame should not be changed. */)
2446 (Lisp_Object frame, Lisp_Object lines, Lisp_Object pretend)
2448 register struct frame *f = decode_live_frame (frame);
2450 CHECK_TYPE_RANGED_INTEGER (int, lines);
2452 /* I think this should be done with a hook. */
2453 #ifdef HAVE_WINDOW_SYSTEM
2454 if (FRAME_WINDOW_P (f))
2456 if (XINT (lines) != FRAME_LINES (f))
2457 x_set_window_size (f, 1, FRAME_COLS (f), XINT (lines));
2458 do_pending_window_change (0);
2460 else
2461 #endif
2462 change_frame_size (f, XINT (lines), 0, !NILP (pretend), 0, 0);
2463 return Qnil;
2466 DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 3, 0,
2467 doc: /* Specify that the frame FRAME has COLS columns.
2468 If FRAME is nil, the selected frame is used. Optional third arg
2469 non-nil means that redisplay should use COLS columns but that the
2470 idea of the actual width of the frame should not be changed. */)
2471 (Lisp_Object frame, Lisp_Object cols, Lisp_Object pretend)
2473 register struct frame *f = decode_live_frame (frame);
2475 CHECK_TYPE_RANGED_INTEGER (int, cols);
2477 /* I think this should be done with a hook. */
2478 #ifdef HAVE_WINDOW_SYSTEM
2479 if (FRAME_WINDOW_P (f))
2481 if (XINT (cols) != FRAME_COLS (f))
2482 x_set_window_size (f, 1, XINT (cols), FRAME_LINES (f));
2483 do_pending_window_change (0);
2485 else
2486 #endif
2487 change_frame_size (f, 0, XINT (cols), !NILP (pretend), 0, 0);
2488 return Qnil;
2491 DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0,
2492 doc: /* Sets size of FRAME to COLS by ROWS, measured in characters.
2493 If FRAME is nil, the selected frame is used. */)
2494 (Lisp_Object frame, Lisp_Object cols, Lisp_Object rows)
2496 register struct frame *f = decode_live_frame (frame);
2498 CHECK_TYPE_RANGED_INTEGER (int, cols);
2499 CHECK_TYPE_RANGED_INTEGER (int, rows);
2501 /* I think this should be done with a hook. */
2502 #ifdef HAVE_WINDOW_SYSTEM
2503 if (FRAME_WINDOW_P (f))
2505 if (XINT (rows) != FRAME_LINES (f)
2506 || XINT (cols) != FRAME_COLS (f)
2507 || f->new_text_lines || f->new_text_cols)
2508 x_set_window_size (f, 1, XINT (cols), XINT (rows));
2509 do_pending_window_change (0);
2511 else
2512 #endif
2513 change_frame_size (f, XINT (rows), XINT (cols), 0, 0, 0);
2515 return Qnil;
2518 DEFUN ("set-frame-position", Fset_frame_position,
2519 Sset_frame_position, 3, 3, 0,
2520 doc: /* Sets position of FRAME in pixels to XOFFSET by YOFFSET.
2521 If FRAME is nil, the selected frame is used. XOFFSET and YOFFSET are
2522 actually the position of the upper left corner of the frame. Negative
2523 values for XOFFSET or YOFFSET are interpreted relative to the rightmost
2524 or bottommost possible position (that stays within the screen). */)
2525 (Lisp_Object frame, Lisp_Object xoffset, Lisp_Object yoffset)
2527 register struct frame *f = decode_live_frame (frame);
2529 CHECK_TYPE_RANGED_INTEGER (int, xoffset);
2530 CHECK_TYPE_RANGED_INTEGER (int, yoffset);
2532 /* I think this should be done with a hook. */
2533 #ifdef HAVE_WINDOW_SYSTEM
2534 if (FRAME_WINDOW_P (f))
2535 x_set_offset (f, XINT (xoffset), XINT (yoffset), 1);
2536 #endif
2538 return Qt;
2542 /***********************************************************************
2543 Frame Parameters
2544 ***********************************************************************/
2546 /* Connect the frame-parameter names for X frames
2547 to the ways of passing the parameter values to the window system.
2549 The name of a parameter, as a Lisp symbol,
2550 has an `x-frame-parameter' property which is an integer in Lisp
2551 that is an index in this table. */
2553 struct frame_parm_table {
2554 const char *name;
2555 Lisp_Object *variable;
2558 static const struct frame_parm_table frame_parms[] =
2560 {"auto-raise", &Qauto_raise},
2561 {"auto-lower", &Qauto_lower},
2562 {"background-color", 0},
2563 {"border-color", &Qborder_color},
2564 {"border-width", &Qborder_width},
2565 {"cursor-color", &Qcursor_color},
2566 {"cursor-type", &Qcursor_type},
2567 {"font", 0},
2568 {"foreground-color", 0},
2569 {"icon-name", &Qicon_name},
2570 {"icon-type", &Qicon_type},
2571 {"internal-border-width", &Qinternal_border_width},
2572 {"menu-bar-lines", &Qmenu_bar_lines},
2573 {"mouse-color", &Qmouse_color},
2574 {"name", &Qname},
2575 {"scroll-bar-width", &Qscroll_bar_width},
2576 {"title", &Qtitle},
2577 {"unsplittable", &Qunsplittable},
2578 {"vertical-scroll-bars", &Qvertical_scroll_bars},
2579 {"visibility", &Qvisibility},
2580 {"tool-bar-lines", &Qtool_bar_lines},
2581 {"scroll-bar-foreground", &Qscroll_bar_foreground},
2582 {"scroll-bar-background", &Qscroll_bar_background},
2583 {"screen-gamma", &Qscreen_gamma},
2584 {"line-spacing", &Qline_spacing},
2585 {"left-fringe", &Qleft_fringe},
2586 {"right-fringe", &Qright_fringe},
2587 {"wait-for-wm", &Qwait_for_wm},
2588 {"fullscreen", &Qfullscreen},
2589 {"font-backend", &Qfont_backend},
2590 {"alpha", &Qalpha},
2591 {"sticky", &Qsticky},
2592 {"tool-bar-position", &Qtool_bar_position},
2595 #ifdef HAVE_NTGUI
2597 /* Calculate fullscreen size. Return in *TOP_POS and *LEFT_POS the
2598 wanted positions of the WM window (not Emacs window).
2599 Return in *WIDTH and *HEIGHT the wanted width and height of Emacs
2600 window (FRAME_X_WINDOW).
2603 void
2604 x_fullscreen_adjust (struct frame *f, int *width, int *height, int *top_pos, int *left_pos)
2606 int newwidth = FRAME_COLS (f);
2607 int newheight = FRAME_LINES (f);
2608 Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f);
2610 *top_pos = f->top_pos;
2611 *left_pos = f->left_pos;
2613 if (f->want_fullscreen & FULLSCREEN_HEIGHT)
2615 int ph;
2617 ph = x_display_pixel_height (dpyinfo);
2618 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2619 ph = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, newheight) - f->y_pixels_diff;
2620 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2621 *top_pos = 0;
2624 if (f->want_fullscreen & FULLSCREEN_WIDTH)
2626 int pw;
2628 pw = x_display_pixel_width (dpyinfo);
2629 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2630 pw = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, newwidth) - f->x_pixels_diff;
2631 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2632 *left_pos = 0;
2635 *width = newwidth;
2636 *height = newheight;
2639 #endif /* HAVE_NTGUI */
2641 #ifdef HAVE_WINDOW_SYSTEM
2643 /* Change the parameters of frame F as specified by ALIST.
2644 If a parameter is not specially recognized, do nothing special;
2645 otherwise call the `x_set_...' function for that parameter.
2646 Except for certain geometry properties, always call store_frame_param
2647 to store the new value in the parameter alist. */
2649 void
2650 x_set_frame_parameters (struct frame *f, Lisp_Object alist)
2652 Lisp_Object tail;
2654 /* If both of these parameters are present, it's more efficient to
2655 set them both at once. So we wait until we've looked at the
2656 entire list before we set them. */
2657 int width, height;
2659 /* Same here. */
2660 Lisp_Object left, top;
2662 /* Same with these. */
2663 Lisp_Object icon_left, icon_top;
2665 /* Record in these vectors all the parms specified. */
2666 Lisp_Object *parms;
2667 Lisp_Object *values;
2668 ptrdiff_t i, p;
2669 bool left_no_change = 0, top_no_change = 0;
2670 bool icon_left_no_change = 0, icon_top_no_change = 0;
2671 bool size_changed = 0;
2672 struct gcpro gcpro1, gcpro2;
2674 i = 0;
2675 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2676 i++;
2678 parms = alloca (i * sizeof *parms);
2679 values = alloca (i * sizeof *values);
2681 /* Extract parm names and values into those vectors. */
2683 i = 0;
2684 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2686 Lisp_Object elt;
2688 elt = XCAR (tail);
2689 parms[i] = Fcar (elt);
2690 values[i] = Fcdr (elt);
2691 i++;
2693 /* TAIL and ALIST are not used again below here. */
2694 alist = tail = Qnil;
2696 GCPRO2 (*parms, *values);
2697 gcpro1.nvars = i;
2698 gcpro2.nvars = i;
2700 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
2701 because their values appear in VALUES and strings are not valid. */
2702 top = left = Qunbound;
2703 icon_left = icon_top = Qunbound;
2705 /* Provide default values for HEIGHT and WIDTH. */
2706 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2707 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2709 /* Process foreground_color and background_color before anything else.
2710 They are independent of other properties, but other properties (e.g.,
2711 cursor_color) are dependent upon them. */
2712 /* Process default font as well, since fringe widths depends on it. */
2713 for (p = 0; p < i; p++)
2715 Lisp_Object prop, val;
2717 prop = parms[p];
2718 val = values[p];
2719 if (EQ (prop, Qforeground_color)
2720 || EQ (prop, Qbackground_color)
2721 || EQ (prop, Qfont))
2723 register Lisp_Object param_index, old_value;
2725 old_value = get_frame_param (f, prop);
2726 if (NILP (Fequal (val, old_value)))
2728 store_frame_param (f, prop, val);
2730 param_index = Fget (prop, Qx_frame_parameter);
2731 if (NATNUMP (param_index)
2732 && (XFASTINT (param_index)
2733 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2734 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
2735 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2740 /* Now process them in reverse of specified order. */
2741 while (i-- != 0)
2743 Lisp_Object prop, val;
2745 prop = parms[i];
2746 val = values[i];
2748 if (EQ (prop, Qwidth) && RANGED_INTEGERP (0, val, INT_MAX))
2750 size_changed = 1;
2751 width = XFASTINT (val);
2753 else if (EQ (prop, Qheight) && RANGED_INTEGERP (0, val, INT_MAX))
2755 size_changed = 1;
2756 height = XFASTINT (val);
2758 else if (EQ (prop, Qtop))
2759 top = val;
2760 else if (EQ (prop, Qleft))
2761 left = val;
2762 else if (EQ (prop, Qicon_top))
2763 icon_top = val;
2764 else if (EQ (prop, Qicon_left))
2765 icon_left = val;
2766 else if (EQ (prop, Qforeground_color)
2767 || EQ (prop, Qbackground_color)
2768 || EQ (prop, Qfont))
2769 /* Processed above. */
2770 continue;
2771 else
2773 register Lisp_Object param_index, old_value;
2775 old_value = get_frame_param (f, prop);
2777 store_frame_param (f, prop, val);
2779 param_index = Fget (prop, Qx_frame_parameter);
2780 if (NATNUMP (param_index)
2781 && (XFASTINT (param_index)
2782 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2783 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
2784 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2788 /* Don't die if just one of these was set. */
2789 if (EQ (left, Qunbound))
2791 left_no_change = 1;
2792 if (f->left_pos < 0)
2793 left = list2 (Qplus, make_number (f->left_pos));
2794 else
2795 XSETINT (left, f->left_pos);
2797 if (EQ (top, Qunbound))
2799 top_no_change = 1;
2800 if (f->top_pos < 0)
2801 top = list2 (Qplus, make_number (f->top_pos));
2802 else
2803 XSETINT (top, f->top_pos);
2806 /* If one of the icon positions was not set, preserve or default it. */
2807 if (! TYPE_RANGED_INTEGERP (int, icon_left))
2809 icon_left_no_change = 1;
2810 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
2811 if (NILP (icon_left))
2812 XSETINT (icon_left, 0);
2814 if (! TYPE_RANGED_INTEGERP (int, icon_top))
2816 icon_top_no_change = 1;
2817 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
2818 if (NILP (icon_top))
2819 XSETINT (icon_top, 0);
2822 /* Don't set these parameters unless they've been explicitly
2823 specified. The window might be mapped or resized while we're in
2824 this function, and we don't want to override that unless the lisp
2825 code has asked for it.
2827 Don't set these parameters unless they actually differ from the
2828 window's current parameters; the window may not actually exist
2829 yet. */
2831 Lisp_Object frame;
2833 check_frame_size (f, &height, &width);
2835 XSETFRAME (frame, f);
2837 if (size_changed
2838 && (width != FRAME_COLS (f)
2839 || height != FRAME_LINES (f)
2840 || f->new_text_lines || f->new_text_cols))
2841 Fset_frame_size (frame, make_number (width), make_number (height));
2843 if ((!NILP (left) || !NILP (top))
2844 && ! (left_no_change && top_no_change)
2845 && ! (NUMBERP (left) && XINT (left) == f->left_pos
2846 && NUMBERP (top) && XINT (top) == f->top_pos))
2848 int leftpos = 0;
2849 int toppos = 0;
2851 /* Record the signs. */
2852 f->size_hint_flags &= ~ (XNegative | YNegative);
2853 if (EQ (left, Qminus))
2854 f->size_hint_flags |= XNegative;
2855 else if (TYPE_RANGED_INTEGERP (int, left))
2857 leftpos = XINT (left);
2858 if (leftpos < 0)
2859 f->size_hint_flags |= XNegative;
2861 else if (CONSP (left) && EQ (XCAR (left), Qminus)
2862 && CONSP (XCDR (left))
2863 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (left)), INT_MAX))
2865 leftpos = - XINT (XCAR (XCDR (left)));
2866 f->size_hint_flags |= XNegative;
2868 else if (CONSP (left) && EQ (XCAR (left), Qplus)
2869 && CONSP (XCDR (left))
2870 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (left))))
2872 leftpos = XINT (XCAR (XCDR (left)));
2875 if (EQ (top, Qminus))
2876 f->size_hint_flags |= YNegative;
2877 else if (TYPE_RANGED_INTEGERP (int, top))
2879 toppos = XINT (top);
2880 if (toppos < 0)
2881 f->size_hint_flags |= YNegative;
2883 else if (CONSP (top) && EQ (XCAR (top), Qminus)
2884 && CONSP (XCDR (top))
2885 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (top)), INT_MAX))
2887 toppos = - XINT (XCAR (XCDR (top)));
2888 f->size_hint_flags |= YNegative;
2890 else if (CONSP (top) && EQ (XCAR (top), Qplus)
2891 && CONSP (XCDR (top))
2892 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (top))))
2894 toppos = XINT (XCAR (XCDR (top)));
2898 /* Store the numeric value of the position. */
2899 f->top_pos = toppos;
2900 f->left_pos = leftpos;
2902 f->win_gravity = NorthWestGravity;
2904 /* Actually set that position, and convert to absolute. */
2905 x_set_offset (f, leftpos, toppos, -1);
2907 #ifdef HAVE_X_WINDOWS
2908 if ((!NILP (icon_left) || !NILP (icon_top))
2909 && ! (icon_left_no_change && icon_top_no_change))
2910 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
2911 #endif /* HAVE_X_WINDOWS */
2914 UNGCPRO;
2918 /* Insert a description of internally-recorded parameters of frame X
2919 into the parameter alist *ALISTPTR that is to be given to the user.
2920 Only parameters that are specific to the X window system
2921 and whose values are not correctly recorded in the frame's
2922 param_alist need to be considered here. */
2924 void
2925 x_report_frame_params (struct frame *f, Lisp_Object *alistptr)
2927 Lisp_Object tem;
2928 uprintmax_t w;
2929 char buf[INT_BUFSIZE_BOUND (w)];
2931 /* Represent negative positions (off the top or left screen edge)
2932 in a way that Fmodify_frame_parameters will understand correctly. */
2933 XSETINT (tem, f->left_pos);
2934 if (f->left_pos >= 0)
2935 store_in_alist (alistptr, Qleft, tem);
2936 else
2937 store_in_alist (alistptr, Qleft, list2 (Qplus, tem));
2939 XSETINT (tem, f->top_pos);
2940 if (f->top_pos >= 0)
2941 store_in_alist (alistptr, Qtop, tem);
2942 else
2943 store_in_alist (alistptr, Qtop, list2 (Qplus, tem));
2945 store_in_alist (alistptr, Qborder_width,
2946 make_number (f->border_width));
2947 store_in_alist (alistptr, Qinternal_border_width,
2948 make_number (FRAME_INTERNAL_BORDER_WIDTH (f)));
2949 store_in_alist (alistptr, Qleft_fringe,
2950 make_number (FRAME_LEFT_FRINGE_WIDTH (f)));
2951 store_in_alist (alistptr, Qright_fringe,
2952 make_number (FRAME_RIGHT_FRINGE_WIDTH (f)));
2953 store_in_alist (alistptr, Qscroll_bar_width,
2954 (! FRAME_HAS_VERTICAL_SCROLL_BARS (f)
2955 ? make_number (0)
2956 : FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0
2957 ? make_number (FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
2958 /* nil means "use default width"
2959 for non-toolkit scroll bar.
2960 ruler-mode.el depends on this. */
2961 : Qnil));
2962 /* FRAME_X_WINDOW is not guaranteed to return an integer. E.g., on
2963 MS-Windows it returns a value whose type is HANDLE, which is
2964 actually a pointer. Explicit casting avoids compiler
2965 warnings. */
2966 w = (uintptr_t) FRAME_X_WINDOW (f);
2967 store_in_alist (alistptr, Qwindow_id,
2968 make_formatted_string (buf, "%"pMu, w));
2969 #ifdef HAVE_X_WINDOWS
2970 #ifdef USE_X_TOOLKIT
2971 /* Tooltip frame may not have this widget. */
2972 if (FRAME_X_OUTPUT (f)->widget)
2973 #endif
2974 w = (uintptr_t) FRAME_OUTER_WINDOW (f);
2975 store_in_alist (alistptr, Qouter_window_id,
2976 make_formatted_string (buf, "%"pMu, w));
2977 #endif
2978 store_in_alist (alistptr, Qicon_name, f->icon_name);
2979 store_in_alist (alistptr, Qvisibility,
2980 (FRAME_VISIBLE_P (f) ? Qt
2981 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
2982 store_in_alist (alistptr, Qdisplay,
2983 XCAR (FRAME_DISPLAY_INFO (f)->name_list_element));
2985 if (FRAME_X_OUTPUT (f)->parent_desc == FRAME_DISPLAY_INFO (f)->root_window)
2986 tem = Qnil;
2987 else
2988 tem = make_natnum ((uintptr_t) FRAME_X_OUTPUT (f)->parent_desc);
2989 store_in_alist (alistptr, Qexplicit_name, (f->explicit_name ? Qt : Qnil));
2990 store_in_alist (alistptr, Qparent_id, tem);
2991 store_in_alist (alistptr, Qtool_bar_position, f->tool_bar_position);
2995 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
2996 the previous value of that parameter, NEW_VALUE is the new value. */
2998 void
2999 x_set_fullscreen (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3001 if (NILP (new_value))
3002 f->want_fullscreen = FULLSCREEN_NONE;
3003 else if (EQ (new_value, Qfullboth) || EQ (new_value, Qfullscreen))
3004 f->want_fullscreen = FULLSCREEN_BOTH;
3005 else if (EQ (new_value, Qfullwidth))
3006 f->want_fullscreen = FULLSCREEN_WIDTH;
3007 else if (EQ (new_value, Qfullheight))
3008 f->want_fullscreen = FULLSCREEN_HEIGHT;
3009 else if (EQ (new_value, Qmaximized))
3010 f->want_fullscreen = FULLSCREEN_MAXIMIZED;
3012 if (FRAME_TERMINAL (f)->fullscreen_hook != NULL)
3013 FRAME_TERMINAL (f)->fullscreen_hook (f);
3017 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
3018 the previous value of that parameter, NEW_VALUE is the new value. */
3020 void
3021 x_set_line_spacing (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3023 if (NILP (new_value))
3024 f->extra_line_spacing = 0;
3025 else if (RANGED_INTEGERP (0, new_value, INT_MAX))
3026 f->extra_line_spacing = XFASTINT (new_value);
3027 else if (FLOATP (new_value))
3029 int new_spacing = XFLOAT_DATA (new_value) * FRAME_LINE_HEIGHT (f) + 0.5;
3031 if (new_spacing >= 0)
3032 f->extra_line_spacing = new_spacing;
3033 else
3034 signal_error ("Invalid line-spacing", new_value);
3036 else
3037 signal_error ("Invalid line-spacing", new_value);
3038 if (FRAME_VISIBLE_P (f))
3039 redraw_frame (f);
3043 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
3044 the previous value of that parameter, NEW_VALUE is the new value. */
3046 void
3047 x_set_screen_gamma (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3049 Lisp_Object bgcolor;
3051 if (NILP (new_value))
3052 f->gamma = 0;
3053 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
3054 /* The value 0.4545 is the normal viewing gamma. */
3055 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
3056 else
3057 signal_error ("Invalid screen-gamma", new_value);
3059 /* Apply the new gamma value to the frame background. */
3060 bgcolor = Fassq (Qbackground_color, f->param_alist);
3061 if (CONSP (bgcolor) && (bgcolor = XCDR (bgcolor), STRINGP (bgcolor)))
3063 Lisp_Object parm_index = Fget (Qbackground_color, Qx_frame_parameter);
3064 if (NATNUMP (parm_index)
3065 && (XFASTINT (parm_index)
3066 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3067 && FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
3068 (*FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
3069 (f, bgcolor, Qnil);
3072 Fclear_face_cache (Qnil);
3076 void
3077 x_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3079 Lisp_Object font_object;
3080 int fontset = -1;
3081 #ifdef HAVE_X_WINDOWS
3082 Lisp_Object font_param = arg;
3083 #endif
3085 /* Set the frame parameter back to the old value because we may
3086 fail to use ARG as the new parameter value. */
3087 store_frame_param (f, Qfont, oldval);
3089 /* ARG is a fontset name, a font name, a cons of fontset name and a
3090 font object, or a font object. In the last case, this function
3091 never fail. */
3092 if (STRINGP (arg))
3094 fontset = fs_query_fontset (arg, 0);
3095 if (fontset < 0)
3097 font_object = font_open_by_name (f, arg);
3098 if (NILP (font_object))
3099 error ("Font `%s' is not defined", SSDATA (arg));
3100 arg = AREF (font_object, FONT_NAME_INDEX);
3102 else if (fontset > 0)
3104 font_object = font_open_by_name (f, fontset_ascii (fontset));
3105 if (NILP (font_object))
3106 error ("Font `%s' is not defined", SDATA (arg));
3107 arg = AREF (font_object, FONT_NAME_INDEX);
3109 else
3110 error ("The default fontset can't be used for a frame font");
3112 else if (CONSP (arg) && STRINGP (XCAR (arg)) && FONT_OBJECT_P (XCDR (arg)))
3114 /* This is the case that the ASCII font of F's fontset XCAR
3115 (arg) is changed to the font XCDR (arg) by
3116 `set-fontset-font'. */
3117 fontset = fs_query_fontset (XCAR (arg), 0);
3118 if (fontset < 0)
3119 error ("Unknown fontset: %s", SDATA (XCAR (arg)));
3120 font_object = XCDR (arg);
3121 arg = AREF (font_object, FONT_NAME_INDEX);
3122 #ifdef HAVE_X_WINDOWS
3123 font_param = Ffont_get (font_object, QCname);
3124 #endif
3126 else if (FONT_OBJECT_P (arg))
3128 font_object = arg;
3129 #ifdef HAVE_X_WINDOWS
3130 font_param = Ffont_get (font_object, QCname);
3131 #endif
3132 /* This is to store the XLFD font name in the frame parameter for
3133 backward compatibility. We should store the font-object
3134 itself in the future. */
3135 arg = AREF (font_object, FONT_NAME_INDEX);
3136 fontset = FRAME_FONTSET (f);
3137 /* Check if we can use the current fontset. If not, set FONTSET
3138 to -1 to generate a new fontset from FONT-OBJECT. */
3139 if (fontset >= 0)
3141 Lisp_Object ascii_font = fontset_ascii (fontset);
3142 Lisp_Object spec = font_spec_from_name (ascii_font);
3144 if (NILP (spec))
3145 signal_error ("Invalid font name", ascii_font);
3147 if (! font_match_p (spec, font_object))
3148 fontset = -1;
3151 else
3152 signal_error ("Invalid font", arg);
3154 if (! NILP (Fequal (font_object, oldval)))
3155 return;
3157 x_new_font (f, font_object, fontset);
3158 store_frame_param (f, Qfont, arg);
3159 #ifdef HAVE_X_WINDOWS
3160 store_frame_param (f, Qfont_param, font_param);
3161 #endif
3162 /* Recalculate toolbar height. */
3163 f->n_tool_bar_rows = 0;
3164 /* Ensure we redraw it. */
3165 clear_current_matrices (f);
3167 recompute_basic_faces (f);
3169 do_pending_window_change (0);
3171 /* We used to call face-set-after-frame-default here, but it leads to
3172 recursive calls (since that function can set the `default' face's
3173 font which in turns changes the frame's `font' parameter).
3174 Also I don't know what this call is meant to do, but it seems the
3175 wrong way to do it anyway (it does a lot more work than what seems
3176 reasonable in response to a change to `font'). */
3180 void
3181 x_set_font_backend (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3183 if (! NILP (new_value)
3184 && !CONSP (new_value))
3186 char *p0, *p1;
3188 CHECK_STRING (new_value);
3189 p0 = p1 = SSDATA (new_value);
3190 new_value = Qnil;
3191 while (*p0)
3193 while (*p1 && ! c_isspace (*p1) && *p1 != ',') p1++;
3194 if (p0 < p1)
3195 new_value = Fcons (Fintern (make_string (p0, p1 - p0), Qnil),
3196 new_value);
3197 if (*p1)
3199 int c;
3201 while ((c = *++p1) && c_isspace (c));
3203 p0 = p1;
3205 new_value = Fnreverse (new_value);
3208 if (! NILP (old_value) && ! NILP (Fequal (old_value, new_value)))
3209 return;
3211 if (FRAME_FONT (f))
3212 free_all_realized_faces (Qnil);
3214 new_value = font_update_drivers (f, NILP (new_value) ? Qt : new_value);
3215 if (NILP (new_value))
3217 if (NILP (old_value))
3218 error ("No font backend available");
3219 font_update_drivers (f, old_value);
3220 error ("None of specified font backends are available");
3222 store_frame_param (f, Qfont_backend, new_value);
3224 if (FRAME_FONT (f))
3226 Lisp_Object frame;
3228 XSETFRAME (frame, f);
3229 x_set_font (f, Fframe_parameter (frame, Qfont), Qnil);
3230 ++face_change_count;
3231 windows_or_buffers_changed = 18;
3236 void
3237 x_set_fringe_width (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3239 compute_fringe_widths (f, 1);
3240 #ifdef HAVE_X_WINDOWS
3241 /* Must adjust this so window managers report correct number of columns. */
3242 if (FRAME_X_WINDOW (f) != 0)
3243 x_wm_set_size_hint (f, 0, 0);
3244 #endif
3247 void
3248 x_set_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3250 CHECK_TYPE_RANGED_INTEGER (int, arg);
3252 if (XINT (arg) == f->border_width)
3253 return;
3255 if (FRAME_X_WINDOW (f) != 0)
3256 error ("Cannot change the border width of a frame");
3258 f->border_width = XINT (arg);
3261 void
3262 x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3264 int old = FRAME_INTERNAL_BORDER_WIDTH (f);
3266 CHECK_TYPE_RANGED_INTEGER (int, arg);
3267 FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
3268 if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
3269 FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
3271 #ifdef USE_X_TOOLKIT
3272 if (FRAME_X_OUTPUT (f)->edit_widget)
3273 widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
3274 #endif
3276 if (FRAME_INTERNAL_BORDER_WIDTH (f) == old)
3277 return;
3279 if (FRAME_X_WINDOW (f) != 0)
3281 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3282 SET_FRAME_GARBAGED (f);
3283 do_pending_window_change (0);
3285 else
3286 SET_FRAME_GARBAGED (f);
3289 void
3290 x_set_visibility (struct frame *f, Lisp_Object value, Lisp_Object oldval)
3292 Lisp_Object frame;
3293 XSETFRAME (frame, f);
3295 if (NILP (value))
3296 Fmake_frame_invisible (frame, Qt);
3297 else if (EQ (value, Qicon))
3298 Ficonify_frame (frame);
3299 else
3300 Fmake_frame_visible (frame);
3303 void
3304 x_set_autoraise (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3306 f->auto_raise = !EQ (Qnil, arg);
3309 void
3310 x_set_autolower (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3312 f->auto_lower = !EQ (Qnil, arg);
3315 void
3316 x_set_unsplittable (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3318 f->no_split = !NILP (arg);
3321 void
3322 x_set_vertical_scroll_bars (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3324 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
3325 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
3326 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
3327 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
3329 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
3330 = (NILP (arg)
3331 ? vertical_scroll_bar_none
3332 : EQ (Qleft, arg)
3333 ? vertical_scroll_bar_left
3334 : EQ (Qright, arg)
3335 ? vertical_scroll_bar_right
3336 : EQ (Qleft, Vdefault_frame_scroll_bars)
3337 ? vertical_scroll_bar_left
3338 : EQ (Qright, Vdefault_frame_scroll_bars)
3339 ? vertical_scroll_bar_right
3340 : vertical_scroll_bar_none);
3342 /* We set this parameter before creating the X window for the
3343 frame, so we can get the geometry right from the start.
3344 However, if the window hasn't been created yet, we shouldn't
3345 call x_set_window_size. */
3346 if (FRAME_X_WINDOW (f))
3347 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3348 do_pending_window_change (0);
3352 void
3353 x_set_scroll_bar_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3355 int wid = FRAME_COLUMN_WIDTH (f);
3357 if (NILP (arg))
3359 x_set_scroll_bar_default_width (f);
3361 if (FRAME_X_WINDOW (f))
3362 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3363 do_pending_window_change (0);
3365 else if (RANGED_INTEGERP (1, arg, INT_MAX)
3366 && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3368 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg);
3369 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
3370 if (FRAME_X_WINDOW (f))
3371 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3372 do_pending_window_change (0);
3375 change_frame_size (f, 0, FRAME_COLS (f), 0, 0, 0);
3376 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
3377 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
3380 void
3381 x_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3383 double alpha = 1.0;
3384 double newval[2];
3385 int i;
3386 Lisp_Object item;
3388 for (i = 0; i < 2; i++)
3390 newval[i] = 1.0;
3391 if (CONSP (arg))
3393 item = CAR (arg);
3394 arg = CDR (arg);
3396 else
3397 item = arg;
3399 if (NILP (item))
3400 alpha = - 1.0;
3401 else if (FLOATP (item))
3403 alpha = XFLOAT_DATA (item);
3404 if (! (0 <= alpha && alpha <= 1.0))
3405 args_out_of_range (make_float (0.0), make_float (1.0));
3407 else if (INTEGERP (item))
3409 EMACS_INT ialpha = XINT (item);
3410 if (! (0 <= ialpha && alpha <= 100))
3411 args_out_of_range (make_number (0), make_number (100));
3412 alpha = ialpha / 100.0;
3414 else
3415 wrong_type_argument (Qnumberp, item);
3416 newval[i] = alpha;
3419 for (i = 0; i < 2; i++)
3420 f->alpha[i] = newval[i];
3422 #if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA)
3423 block_input ();
3424 x_set_frame_alpha (f);
3425 unblock_input ();
3426 #endif
3428 return;
3431 #ifndef HAVE_NS
3433 /* Non-zero if mouse is grabbed on DPYINFO
3434 and we know the frame where it is. */
3436 bool x_mouse_grabbed (Display_Info *dpyinfo)
3438 return (dpyinfo->grabbed
3439 && dpyinfo->last_mouse_frame
3440 && FRAME_LIVE_P (dpyinfo->last_mouse_frame));
3443 /* Re-highlight something with mouse-face properties
3444 on DPYINFO using saved frame and mouse position. */
3446 void
3447 x_redo_mouse_highlight (Display_Info *dpyinfo)
3449 if (dpyinfo->last_mouse_motion_frame
3450 && FRAME_LIVE_P (dpyinfo->last_mouse_motion_frame))
3451 note_mouse_highlight (dpyinfo->last_mouse_motion_frame,
3452 dpyinfo->last_mouse_motion_x,
3453 dpyinfo->last_mouse_motion_y);
3456 #endif /* HAVE_NS */
3458 /* Subroutines of creating an X frame. */
3460 /* Make sure that Vx_resource_name is set to a reasonable value.
3461 Fix it up, or set it to `emacs' if it is too hopeless. */
3463 void
3464 validate_x_resource_name (void)
3466 ptrdiff_t len = 0;
3467 /* Number of valid characters in the resource name. */
3468 ptrdiff_t good_count = 0;
3469 /* Number of invalid characters in the resource name. */
3470 ptrdiff_t bad_count = 0;
3471 Lisp_Object new;
3472 ptrdiff_t i;
3474 if (!STRINGP (Vx_resource_class))
3475 Vx_resource_class = build_string (EMACS_CLASS);
3477 if (STRINGP (Vx_resource_name))
3479 unsigned char *p = SDATA (Vx_resource_name);
3481 len = SBYTES (Vx_resource_name);
3483 /* Only letters, digits, - and _ are valid in resource names.
3484 Count the valid characters and count the invalid ones. */
3485 for (i = 0; i < len; i++)
3487 int c = p[i];
3488 if (! ((c >= 'a' && c <= 'z')
3489 || (c >= 'A' && c <= 'Z')
3490 || (c >= '0' && c <= '9')
3491 || c == '-' || c == '_'))
3492 bad_count++;
3493 else
3494 good_count++;
3497 else
3498 /* Not a string => completely invalid. */
3499 bad_count = 5, good_count = 0;
3501 /* If name is valid already, return. */
3502 if (bad_count == 0)
3503 return;
3505 /* If name is entirely invalid, or nearly so, or is so implausibly
3506 large that alloca might not work, use `emacs'. */
3507 if (good_count < 2 || MAX_ALLOCA - sizeof ".customization" < len)
3509 Vx_resource_name = build_string ("emacs");
3510 return;
3513 /* Name is partly valid. Copy it and replace the invalid characters
3514 with underscores. */
3516 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
3518 for (i = 0; i < len; i++)
3520 int c = SREF (new, i);
3521 if (! ((c >= 'a' && c <= 'z')
3522 || (c >= 'A' && c <= 'Z')
3523 || (c >= '0' && c <= '9')
3524 || c == '-' || c == '_'))
3525 SSET (new, i, '_');
3529 /* Get specified attribute from resource database RDB.
3530 See Fx_get_resource below for other parameters. */
3532 static Lisp_Object
3533 xrdb_get_resource (XrmDatabase rdb, Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3535 register char *value;
3536 char *name_key;
3537 char *class_key;
3539 CHECK_STRING (attribute);
3540 CHECK_STRING (class);
3542 if (!NILP (component))
3543 CHECK_STRING (component);
3544 if (!NILP (subclass))
3545 CHECK_STRING (subclass);
3546 if (NILP (component) != NILP (subclass))
3547 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3549 validate_x_resource_name ();
3551 /* Allocate space for the components, the dots which separate them,
3552 and the final '\0'. Make them big enough for the worst case. */
3553 name_key = alloca (SBYTES (Vx_resource_name)
3554 + (STRINGP (component)
3555 ? SBYTES (component) : 0)
3556 + SBYTES (attribute)
3557 + 3);
3559 class_key = alloca (SBYTES (Vx_resource_class)
3560 + SBYTES (class)
3561 + (STRINGP (subclass)
3562 ? SBYTES (subclass) : 0)
3563 + 3);
3565 /* Start with emacs.FRAMENAME for the name (the specific one)
3566 and with `Emacs' for the class key (the general one). */
3567 strcpy (name_key, SSDATA (Vx_resource_name));
3568 strcpy (class_key, SSDATA (Vx_resource_class));
3570 strcat (class_key, ".");
3571 strcat (class_key, SSDATA (class));
3573 if (!NILP (component))
3575 strcat (class_key, ".");
3576 strcat (class_key, SSDATA (subclass));
3578 strcat (name_key, ".");
3579 strcat (name_key, SSDATA (component));
3582 strcat (name_key, ".");
3583 strcat (name_key, SSDATA (attribute));
3585 value = x_get_string_resource (rdb, name_key, class_key);
3587 if (value && *value)
3588 return build_string (value);
3589 else
3590 return Qnil;
3594 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
3595 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
3596 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
3597 class, where INSTANCE is the name under which Emacs was invoked, or
3598 the name specified by the `-name' or `-rn' command-line arguments.
3600 The optional arguments COMPONENT and SUBCLASS add to the key and the
3601 class, respectively. You must specify both of them or neither.
3602 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
3603 and the class is `Emacs.CLASS.SUBCLASS'. */)
3604 (Lisp_Object attribute, Lisp_Object class, Lisp_Object component,
3605 Lisp_Object subclass)
3607 check_window_system (NULL);
3609 return xrdb_get_resource (check_x_display_info (Qnil)->xrdb,
3610 attribute, class, component, subclass);
3613 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
3615 Lisp_Object
3616 display_x_get_resource (Display_Info *dpyinfo, Lisp_Object attribute,
3617 Lisp_Object class, Lisp_Object component,
3618 Lisp_Object subclass)
3620 return xrdb_get_resource (dpyinfo->xrdb,
3621 attribute, class, component, subclass);
3624 #if defined HAVE_X_WINDOWS && !defined USE_X_TOOLKIT
3625 /* Used when C code wants a resource value. */
3626 /* Called from oldXMenu/Create.c. */
3627 char *
3628 x_get_resource_string (const char *attribute, const char *class)
3630 char *result;
3631 struct frame *sf = SELECTED_FRAME ();
3632 ptrdiff_t invocation_namelen = SBYTES (Vinvocation_name);
3633 USE_SAFE_ALLOCA;
3635 /* Allocate space for the components, the dots which separate them,
3636 and the final '\0'. */
3637 char *name_key = SAFE_ALLOCA (invocation_namelen + strlen (attribute) + 2);
3638 char *class_key = alloca ((sizeof (EMACS_CLASS) - 1) + strlen (class) + 2);
3640 esprintf (name_key, "%s.%s", SSDATA (Vinvocation_name), attribute);
3641 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3643 result = x_get_string_resource (FRAME_DISPLAY_INFO (sf)->xrdb,
3644 name_key, class_key);
3645 SAFE_FREE ();
3646 return result;
3648 #endif
3650 /* Return the value of parameter PARAM.
3652 First search ALIST, then Vdefault_frame_alist, then the X defaults
3653 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3655 Convert the resource to the type specified by desired_type.
3657 If no default is specified, return Qunbound. If you call
3658 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3659 and don't let it get stored in any Lisp-visible variables! */
3661 Lisp_Object
3662 x_get_arg (Display_Info *dpyinfo, Lisp_Object alist, Lisp_Object param,
3663 const char *attribute, const char *class, enum resource_types type)
3665 register Lisp_Object tem;
3667 tem = Fassq (param, alist);
3669 if (!NILP (tem))
3671 /* If we find this parm in ALIST, clear it out
3672 so that it won't be "left over" at the end. */
3673 Lisp_Object tail;
3674 XSETCAR (tem, Qnil);
3675 /* In case the parameter appears more than once in the alist,
3676 clear it out. */
3677 for (tail = alist; CONSP (tail); tail = XCDR (tail))
3678 if (CONSP (XCAR (tail))
3679 && EQ (XCAR (XCAR (tail)), param))
3680 XSETCAR (XCAR (tail), Qnil);
3682 else
3683 tem = Fassq (param, Vdefault_frame_alist);
3685 /* If it wasn't specified in ALIST or the Lisp-level defaults,
3686 look in the X resources. */
3687 if (EQ (tem, Qnil))
3689 if (attribute && dpyinfo)
3691 tem = display_x_get_resource (dpyinfo,
3692 build_string (attribute),
3693 build_string (class),
3694 Qnil, Qnil);
3696 if (NILP (tem))
3697 return Qunbound;
3699 switch (type)
3701 case RES_TYPE_NUMBER:
3702 return make_number (atoi (SSDATA (tem)));
3704 case RES_TYPE_BOOLEAN_NUMBER:
3705 if (!strcmp (SSDATA (tem), "on")
3706 || !strcmp (SSDATA (tem), "true"))
3707 return make_number (1);
3708 return make_number (atoi (SSDATA (tem)));
3709 break;
3711 case RES_TYPE_FLOAT:
3712 return make_float (atof (SSDATA (tem)));
3714 case RES_TYPE_BOOLEAN:
3715 tem = Fdowncase (tem);
3716 if (!strcmp (SSDATA (tem), "on")
3717 #ifdef HAVE_NS
3718 || !strcmp (SSDATA (tem), "yes")
3719 #endif
3720 || !strcmp (SSDATA (tem), "true"))
3721 return Qt;
3722 else
3723 return Qnil;
3725 case RES_TYPE_STRING:
3726 return tem;
3728 case RES_TYPE_SYMBOL:
3729 /* As a special case, we map the values `true' and `on'
3730 to Qt, and `false' and `off' to Qnil. */
3732 Lisp_Object lower;
3733 lower = Fdowncase (tem);
3734 if (!strcmp (SSDATA (lower), "on")
3735 #ifdef HAVE_NS
3736 || !strcmp (SSDATA (lower), "yes")
3737 #endif
3738 || !strcmp (SSDATA (lower), "true"))
3739 return Qt;
3740 else if (!strcmp (SSDATA (lower), "off")
3741 #ifdef HAVE_NS
3742 || !strcmp (SSDATA (lower), "no")
3743 #endif
3744 || !strcmp (SSDATA (lower), "false"))
3745 return Qnil;
3746 else
3747 return Fintern (tem, Qnil);
3750 default:
3751 emacs_abort ();
3754 else
3755 return Qunbound;
3757 return Fcdr (tem);
3760 static Lisp_Object
3761 x_frame_get_arg (struct frame *f, Lisp_Object alist, Lisp_Object param,
3762 const char *attribute, const char *class,
3763 enum resource_types type)
3765 return x_get_arg (FRAME_DISPLAY_INFO (f),
3766 alist, param, attribute, class, type);
3769 /* Like x_frame_get_arg, but also record the value in f->param_alist. */
3771 Lisp_Object
3772 x_frame_get_and_record_arg (struct frame *f, Lisp_Object alist,
3773 Lisp_Object param,
3774 const char *attribute, const char *class,
3775 enum resource_types type)
3777 Lisp_Object value;
3779 value = x_get_arg (FRAME_DISPLAY_INFO (f), alist, param,
3780 attribute, class, type);
3781 if (! NILP (value) && ! EQ (value, Qunbound))
3782 store_frame_param (f, param, value);
3784 return value;
3788 /* Record in frame F the specified or default value according to ALIST
3789 of the parameter named PROP (a Lisp symbol).
3790 If no value is specified for PROP, look for an X default for XPROP
3791 on the frame named NAME.
3792 If that is not found either, use the value DEFLT. */
3794 Lisp_Object
3795 x_default_parameter (struct frame *f, Lisp_Object alist, Lisp_Object prop,
3796 Lisp_Object deflt, const char *xprop, const char *xclass,
3797 enum resource_types type)
3799 Lisp_Object tem;
3801 tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type);
3802 if (EQ (tem, Qunbound))
3803 tem = deflt;
3804 x_set_frame_parameters (f, list1 (Fcons (prop, tem)));
3805 return tem;
3809 #if !defined (HAVE_X_WINDOWS) && defined (NoValue)
3812 * XParseGeometry parses strings of the form
3813 * "=<width>x<height>{+-}<xoffset>{+-}<yoffset>", where
3814 * width, height, xoffset, and yoffset are unsigned integers.
3815 * Example: "=80x24+300-49"
3816 * The equal sign is optional.
3817 * It returns a bitmask that indicates which of the four values
3818 * were actually found in the string. For each value found,
3819 * the corresponding argument is updated; for each value
3820 * not found, the corresponding argument is left unchanged.
3823 static int
3824 XParseGeometry (char *string,
3825 int *x, int *y,
3826 unsigned int *width, unsigned int *height)
3828 int mask = NoValue;
3829 char *strind;
3830 unsigned long tempWidth, tempHeight;
3831 long int tempX, tempY;
3832 char *nextCharacter;
3834 if (string == NULL || *string == '\0')
3835 return mask;
3836 if (*string == '=')
3837 string++; /* ignore possible '=' at beg of geometry spec */
3839 strind = string;
3840 if (*strind != '+' && *strind != '-' && *strind != 'x')
3842 tempWidth = strtoul (strind, &nextCharacter, 10);
3843 if (strind == nextCharacter)
3844 return 0;
3845 strind = nextCharacter;
3846 mask |= WidthValue;
3849 if (*strind == 'x' || *strind == 'X')
3851 strind++;
3852 tempHeight = strtoul (strind, &nextCharacter, 10);
3853 if (strind == nextCharacter)
3854 return 0;
3855 strind = nextCharacter;
3856 mask |= HeightValue;
3859 if (*strind == '+' || *strind == '-')
3861 if (*strind == '-')
3862 mask |= XNegative;
3863 tempX = strtol (strind, &nextCharacter, 10);
3864 if (strind == nextCharacter)
3865 return 0;
3866 strind = nextCharacter;
3867 mask |= XValue;
3868 if (*strind == '+' || *strind == '-')
3870 if (*strind == '-')
3871 mask |= YNegative;
3872 tempY = strtol (strind, &nextCharacter, 10);
3873 if (strind == nextCharacter)
3874 return 0;
3875 strind = nextCharacter;
3876 mask |= YValue;
3880 /* If strind isn't at the end of the string then it's an invalid
3881 geometry specification. */
3883 if (*strind != '\0')
3884 return 0;
3886 if (mask & XValue)
3887 *x = clip_to_bounds (INT_MIN, tempX, INT_MAX);
3888 if (mask & YValue)
3889 *y = clip_to_bounds (INT_MIN, tempY, INT_MAX);
3890 if (mask & WidthValue)
3891 *width = min (tempWidth, UINT_MAX);
3892 if (mask & HeightValue)
3893 *height = min (tempHeight, UINT_MAX);
3894 return mask;
3897 #endif /* !defined (HAVE_X_WINDOWS) && defined (NoValue) */
3900 /* NS used to define x-parse-geometry in ns-win.el, but that confused
3901 make-docfile: the documentation string in ns-win.el was used for
3902 x-parse-geometry even in non-NS builds.
3904 With two definitions of x-parse-geometry in this file, various
3905 things still get confused (eg M-x apropos documentation), so that
3906 it is best if the two definitions just share the same doc-string.
3908 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
3909 doc: /* Parse a display geometry string STRING.
3910 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3911 The properties returned may include `top', `left', `height', and `width'.
3912 For X, the value of `left' or `top' may be an integer,
3913 or a list (+ N) meaning N pixels relative to top/left corner,
3914 or a list (- N) meaning -N pixels relative to bottom/right corner.
3915 On Nextstep, this just calls `ns-parse-geometry'. */)
3916 (Lisp_Object string)
3918 int geometry, x, y;
3919 unsigned int width, height;
3920 Lisp_Object result;
3922 CHECK_STRING (string);
3924 #ifdef HAVE_NS
3925 if (strchr (SSDATA (string), ' ') != NULL)
3926 return call1 (Qns_parse_geometry, string);
3927 #endif
3928 geometry = XParseGeometry (SSDATA (string),
3929 &x, &y, &width, &height);
3930 result = Qnil;
3931 if (geometry & XValue)
3933 Lisp_Object element;
3935 if (x >= 0 && (geometry & XNegative))
3936 element = list3 (Qleft, Qminus, make_number (-x));
3937 else if (x < 0 && ! (geometry & XNegative))
3938 element = list3 (Qleft, Qplus, make_number (x));
3939 else
3940 element = Fcons (Qleft, make_number (x));
3941 result = Fcons (element, result);
3944 if (geometry & YValue)
3946 Lisp_Object element;
3948 if (y >= 0 && (geometry & YNegative))
3949 element = list3 (Qtop, Qminus, make_number (-y));
3950 else if (y < 0 && ! (geometry & YNegative))
3951 element = list3 (Qtop, Qplus, make_number (y));
3952 else
3953 element = Fcons (Qtop, make_number (y));
3954 result = Fcons (element, result);
3957 if (geometry & WidthValue)
3958 result = Fcons (Fcons (Qwidth, make_number (width)), result);
3959 if (geometry & HeightValue)
3960 result = Fcons (Fcons (Qheight, make_number (height)), result);
3962 return result;
3966 /* Calculate the desired size and position of frame F.
3967 Return the flags saying which aspects were specified.
3969 Also set the win_gravity and size_hint_flags of F.
3971 Adjust height for toolbar if TOOLBAR_P is 1.
3973 This function does not make the coordinates positive. */
3975 #define DEFAULT_ROWS 35
3976 #define DEFAULT_COLS 80
3978 long
3979 x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p)
3981 register Lisp_Object tem0, tem1, tem2;
3982 long window_prompting = 0;
3983 Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f);
3985 /* Default values if we fall through.
3986 Actually, if that happens we should get
3987 window manager prompting. */
3988 SET_FRAME_COLS (f, DEFAULT_COLS);
3989 FRAME_LINES (f) = DEFAULT_ROWS;
3990 /* Window managers expect that if program-specified
3991 positions are not (0,0), they're intentional, not defaults. */
3992 f->top_pos = 0;
3993 f->left_pos = 0;
3995 /* Ensure that old new_text_cols and new_text_lines will not override the
3996 values set here. */
3997 /* ++KFS: This was specific to W32, but seems ok for all platforms */
3998 f->new_text_cols = f->new_text_lines = 0;
4000 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
4001 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
4002 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
4003 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4005 if (!EQ (tem0, Qunbound))
4007 CHECK_NUMBER (tem0);
4008 if (! (0 <= XINT (tem0) && XINT (tem0) <= INT_MAX))
4009 xsignal1 (Qargs_out_of_range, tem0);
4010 FRAME_LINES (f) = XINT (tem0);
4012 if (!EQ (tem1, Qunbound))
4014 CHECK_NUMBER (tem1);
4015 if (! (0 <= XINT (tem1) && XINT (tem1) <= INT_MAX))
4016 xsignal1 (Qargs_out_of_range, tem1);
4017 SET_FRAME_COLS (f, XINT (tem1));
4019 if (!NILP (tem2) && !EQ (tem2, Qunbound))
4020 window_prompting |= USSize;
4021 else
4022 window_prompting |= PSize;
4025 f->scroll_bar_actual_width
4026 = FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f);
4028 /* This used to be done _before_ calling x_figure_window_size, but
4029 since the height is reset here, this was really a no-op. I
4030 assume that moving it here does what Gerd intended (although he
4031 no longer can remember what that was... ++KFS, 2003-03-25. */
4033 /* Add the tool-bar height to the initial frame height so that the
4034 user gets a text display area of the size he specified with -g or
4035 via .Xdefaults. Later changes of the tool-bar height don't
4036 change the frame size. This is done so that users can create
4037 tall Emacs frames without having to guess how tall the tool-bar
4038 will get. */
4039 if (toolbar_p && FRAME_TOOL_BAR_LINES (f))
4041 int margin, relief, bar_height;
4043 relief = (tool_bar_button_relief >= 0
4044 ? tool_bar_button_relief
4045 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
4047 if (RANGED_INTEGERP (1, Vtool_bar_button_margin, INT_MAX))
4048 margin = XFASTINT (Vtool_bar_button_margin);
4049 else if (CONSP (Vtool_bar_button_margin)
4050 && RANGED_INTEGERP (1, XCDR (Vtool_bar_button_margin), INT_MAX))
4051 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
4052 else
4053 margin = 0;
4055 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
4056 FRAME_LINES (f) += (bar_height + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f);
4059 compute_fringe_widths (f, 0);
4061 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, FRAME_COLS (f));
4062 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, FRAME_LINES (f));
4064 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
4065 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
4066 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
4067 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4069 if (EQ (tem0, Qminus))
4071 f->top_pos = 0;
4072 window_prompting |= YNegative;
4074 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
4075 && CONSP (XCDR (tem0))
4076 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (tem0)), INT_MAX))
4078 f->top_pos = - XINT (XCAR (XCDR (tem0)));
4079 window_prompting |= YNegative;
4081 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
4082 && CONSP (XCDR (tem0))
4083 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (tem0))))
4085 f->top_pos = XINT (XCAR (XCDR (tem0)));
4087 else if (EQ (tem0, Qunbound))
4088 f->top_pos = 0;
4089 else
4091 CHECK_TYPE_RANGED_INTEGER (int, tem0);
4092 f->top_pos = XINT (tem0);
4093 if (f->top_pos < 0)
4094 window_prompting |= YNegative;
4097 if (EQ (tem1, Qminus))
4099 f->left_pos = 0;
4100 window_prompting |= XNegative;
4102 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
4103 && CONSP (XCDR (tem1))
4104 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (tem1)), INT_MAX))
4106 f->left_pos = - XINT (XCAR (XCDR (tem1)));
4107 window_prompting |= XNegative;
4109 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
4110 && CONSP (XCDR (tem1))
4111 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (tem1))))
4113 f->left_pos = XINT (XCAR (XCDR (tem1)));
4115 else if (EQ (tem1, Qunbound))
4116 f->left_pos = 0;
4117 else
4119 CHECK_TYPE_RANGED_INTEGER (int, tem1);
4120 f->left_pos = XINT (tem1);
4121 if (f->left_pos < 0)
4122 window_prompting |= XNegative;
4125 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
4126 window_prompting |= USPosition;
4127 else
4128 window_prompting |= PPosition;
4131 if (window_prompting & XNegative)
4133 if (window_prompting & YNegative)
4134 f->win_gravity = SouthEastGravity;
4135 else
4136 f->win_gravity = NorthEastGravity;
4138 else
4140 if (window_prompting & YNegative)
4141 f->win_gravity = SouthWestGravity;
4142 else
4143 f->win_gravity = NorthWestGravity;
4146 f->size_hint_flags = window_prompting;
4148 return window_prompting;
4153 #endif /* HAVE_WINDOW_SYSTEM */
4155 void
4156 frame_make_pointer_invisible (void)
4158 if (! NILP (Vmake_pointer_invisible))
4160 struct frame *f;
4161 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4162 return;
4164 f = SELECTED_FRAME ();
4165 if (f && !f->pointer_invisible
4166 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4168 f->mouse_moved = 0;
4169 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 1);
4170 f->pointer_invisible = 1;
4175 void
4176 frame_make_pointer_visible (void)
4178 /* We don't check Vmake_pointer_invisible here in case the
4179 pointer was invisible when Vmake_pointer_invisible was set to nil. */
4180 struct frame *f;
4182 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4183 return;
4185 f = SELECTED_FRAME ();
4186 if (f && f->pointer_invisible && f->mouse_moved
4187 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4189 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 0);
4190 f->pointer_invisible = 0;
4194 DEFUN ("frame-pointer-visible-p", Fframe_pointer_visible_p,
4195 Sframe_pointer_visible_p, 0, 1, 0,
4196 doc: /* Return t if the mouse pointer displayed on FRAME is visible.
4197 Otherwise it returns nil. FRAME omitted or nil means the
4198 selected frame. This is useful when `make-pointer-invisible' is set. */)
4199 (Lisp_Object frame)
4201 return decode_any_frame (frame)->pointer_invisible ? Qnil : Qt;
4206 /***********************************************************************
4207 Multimonitor data
4208 ***********************************************************************/
4210 #ifdef HAVE_WINDOW_SYSTEM
4212 # if (defined HAVE_NS \
4213 || (!defined USE_GTK && (defined HAVE_XINERAMA || defined HAVE_XRANDR)))
4214 void
4215 free_monitors (struct MonitorInfo *monitors, int n_monitors)
4217 int i;
4218 for (i = 0; i < n_monitors; ++i)
4219 xfree (monitors[i].name);
4220 xfree (monitors);
4222 # endif
4224 Lisp_Object
4225 make_monitor_attribute_list (struct MonitorInfo *monitors,
4226 int n_monitors,
4227 int primary_monitor,
4228 Lisp_Object monitor_frames,
4229 const char *source)
4231 Lisp_Object attributes_list = Qnil;
4232 Lisp_Object primary_monitor_attributes = Qnil;
4233 int i;
4235 for (i = 0; i < n_monitors; ++i)
4237 Lisp_Object geometry, workarea, attributes = Qnil;
4238 struct MonitorInfo *mi = &monitors[i];
4240 if (mi->geom.width == 0) continue;
4242 workarea = list4i (mi->work.x, mi->work.y,
4243 mi->work.width, mi->work.height);
4244 geometry = list4i (mi->geom.x, mi->geom.y,
4245 mi->geom.width, mi->geom.height);
4246 attributes = Fcons (Fcons (Qsource, build_string (source)),
4247 attributes);
4248 attributes = Fcons (Fcons (Qframes, AREF (monitor_frames, i)),
4249 attributes);
4250 attributes = Fcons (Fcons (Qmm_size,
4251 list2i (mi->mm_width, mi->mm_height)),
4252 attributes);
4253 attributes = Fcons (Fcons (Qworkarea, workarea), attributes);
4254 attributes = Fcons (Fcons (Qgeometry, geometry), attributes);
4255 if (mi->name)
4256 attributes = Fcons (Fcons (Qname, make_string (mi->name,
4257 strlen (mi->name))),
4258 attributes);
4260 if (i == primary_monitor)
4261 primary_monitor_attributes = attributes;
4262 else
4263 attributes_list = Fcons (attributes, attributes_list);
4266 if (!NILP (primary_monitor_attributes))
4267 attributes_list = Fcons (primary_monitor_attributes, attributes_list);
4268 return attributes_list;
4271 #endif /* HAVE_WINDOW_SYSTEM */
4274 /***********************************************************************
4275 Initialization
4276 ***********************************************************************/
4278 void
4279 syms_of_frame (void)
4281 DEFSYM (Qframep, "framep");
4282 DEFSYM (Qframe_live_p, "frame-live-p");
4283 DEFSYM (Qexplicit_name, "explicit-name");
4284 DEFSYM (Qheight, "height");
4285 DEFSYM (Qicon, "icon");
4286 DEFSYM (Qminibuffer, "minibuffer");
4287 DEFSYM (Qmodeline, "modeline");
4288 DEFSYM (Qonly, "only");
4289 DEFSYM (Qnone, "none");
4290 DEFSYM (Qwidth, "width");
4291 DEFSYM (Qgeometry, "geometry");
4292 DEFSYM (Qicon_left, "icon-left");
4293 DEFSYM (Qicon_top, "icon-top");
4294 DEFSYM (Qtooltip, "tooltip");
4295 DEFSYM (Qleft, "left");
4296 DEFSYM (Qright, "right");
4297 DEFSYM (Quser_position, "user-position");
4298 DEFSYM (Quser_size, "user-size");
4299 DEFSYM (Qwindow_id, "window-id");
4300 #ifdef HAVE_X_WINDOWS
4301 DEFSYM (Qouter_window_id, "outer-window-id");
4302 #endif
4303 DEFSYM (Qparent_id, "parent-id");
4304 DEFSYM (Qx, "x");
4305 DEFSYM (Qw32, "w32");
4306 DEFSYM (Qpc, "pc");
4307 DEFSYM (Qns, "ns");
4308 DEFSYM (Qvisible, "visible");
4309 DEFSYM (Qbuffer_predicate, "buffer-predicate");
4310 DEFSYM (Qbuffer_list, "buffer-list");
4311 DEFSYM (Qburied_buffer_list, "buried-buffer-list");
4312 DEFSYM (Qdisplay_type, "display-type");
4313 DEFSYM (Qbackground_mode, "background-mode");
4314 DEFSYM (Qnoelisp, "noelisp");
4315 DEFSYM (Qtty_color_mode, "tty-color-mode");
4316 DEFSYM (Qtty, "tty");
4317 DEFSYM (Qtty_type, "tty-type");
4319 DEFSYM (Qface_set_after_frame_default, "face-set-after-frame-default");
4321 DEFSYM (Qfullwidth, "fullwidth");
4322 DEFSYM (Qfullheight, "fullheight");
4323 DEFSYM (Qfullboth, "fullboth");
4324 DEFSYM (Qmaximized, "maximized");
4325 DEFSYM (Qx_resource_name, "x-resource-name");
4326 DEFSYM (Qx_frame_parameter, "x-frame-parameter");
4328 DEFSYM (Qterminal, "terminal");
4330 DEFSYM (Qgeometry, "geometry");
4331 DEFSYM (Qworkarea, "workarea");
4332 DEFSYM (Qmm_size, "mm-size");
4333 DEFSYM (Qframes, "frames");
4334 DEFSYM (Qsource, "source");
4336 #ifdef HAVE_NS
4337 DEFSYM (Qns_parse_geometry, "ns-parse-geometry");
4338 #endif
4341 int i;
4343 for (i = 0; i < sizeof (frame_parms) / sizeof (frame_parms[0]); i++)
4345 Lisp_Object v = intern_c_string (frame_parms[i].name);
4346 if (frame_parms[i].variable)
4348 *frame_parms[i].variable = v;
4349 staticpro (frame_parms[i].variable);
4351 Fput (v, Qx_frame_parameter, make_number (i));
4355 #ifdef HAVE_WINDOW_SYSTEM
4356 DEFVAR_LISP ("x-resource-name", Vx_resource_name,
4357 doc: /* The name Emacs uses to look up X resources.
4358 `x-get-resource' uses this as the first component of the instance name
4359 when requesting resource values.
4360 Emacs initially sets `x-resource-name' to the name under which Emacs
4361 was invoked, or to the value specified with the `-name' or `-rn'
4362 switches, if present.
4364 It may be useful to bind this variable locally around a call
4365 to `x-get-resource'. See also the variable `x-resource-class'. */);
4366 Vx_resource_name = Qnil;
4368 DEFVAR_LISP ("x-resource-class", Vx_resource_class,
4369 doc: /* The class Emacs uses to look up X resources.
4370 `x-get-resource' uses this as the first component of the instance class
4371 when requesting resource values.
4373 Emacs initially sets `x-resource-class' to "Emacs".
4375 Setting this variable permanently is not a reasonable thing to do,
4376 but binding this variable locally around a call to `x-get-resource'
4377 is a reasonable practice. See also the variable `x-resource-name'. */);
4378 Vx_resource_class = build_string (EMACS_CLASS);
4380 DEFVAR_LISP ("frame-alpha-lower-limit", Vframe_alpha_lower_limit,
4381 doc: /* The lower limit of the frame opacity (alpha transparency).
4382 The value should range from 0 (invisible) to 100 (completely opaque).
4383 You can also use a floating number between 0.0 and 1.0.
4384 The default is 20. */);
4385 Vframe_alpha_lower_limit = make_number (20);
4386 #endif
4388 DEFVAR_LISP ("default-frame-alist", Vdefault_frame_alist,
4389 doc: /* Alist of default values for frame creation.
4390 These may be set in your init file, like this:
4391 (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1)))
4392 These override values given in window system configuration data,
4393 including X Windows' defaults database.
4394 For values specific to the first Emacs frame, see `initial-frame-alist'.
4395 For window-system specific values, see `window-system-default-frame-alist'.
4396 For values specific to the separate minibuffer frame, see
4397 `minibuffer-frame-alist'.
4398 The `menu-bar-lines' element of the list controls whether new frames
4399 have menu bars; `menu-bar-mode' works by altering this element.
4400 Setting this variable does not affect existing frames, only new ones. */);
4401 Vdefault_frame_alist = Qnil;
4403 DEFVAR_LISP ("default-frame-scroll-bars", Vdefault_frame_scroll_bars,
4404 doc: /* Default position of scroll bars on this window-system. */);
4405 #ifdef HAVE_WINDOW_SYSTEM
4406 #if defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA) || (defined (USE_GTK) && defined (USE_TOOLKIT_SCROLL_BARS))
4407 /* MS-Windows, Mac OS X, and GTK have scroll bars on the right by
4408 default. */
4409 Vdefault_frame_scroll_bars = Qright;
4410 #else
4411 Vdefault_frame_scroll_bars = Qleft;
4412 #endif
4413 #else
4414 Vdefault_frame_scroll_bars = Qnil;
4415 #endif
4417 DEFVAR_BOOL ("scroll-bar-adjust-thumb-portion",
4418 scroll_bar_adjust_thumb_portion_p,
4419 doc: /* Adjust thumb for overscrolling for Gtk+ and MOTIF.
4420 Non-nil means adjust the thumb in the scroll bar so it can be dragged downwards
4421 even if the end of the buffer is shown (i.e. overscrolling).
4422 Set to nil if you want the thumb to be at the bottom when the end of the buffer
4423 is shown. Also, the thumb fills the whole scroll bar when the entire buffer
4424 is visible. In this case you can not overscroll. */);
4425 scroll_bar_adjust_thumb_portion_p = 1;
4427 DEFVAR_LISP ("terminal-frame", Vterminal_frame,
4428 doc: /* The initial frame-object, which represents Emacs's stdout. */);
4430 DEFVAR_LISP ("mouse-position-function", Vmouse_position_function,
4431 doc: /* If non-nil, function to transform normal value of `mouse-position'.
4432 `mouse-position' calls this function, passing its usual return value as
4433 argument, and returns whatever this function returns.
4434 This abnormal hook exists for the benefit of packages like `xt-mouse.el'
4435 which need to do mouse handling at the Lisp level. */);
4436 Vmouse_position_function = Qnil;
4438 DEFVAR_LISP ("mouse-highlight", Vmouse_highlight,
4439 doc: /* If non-nil, clickable text is highlighted when mouse is over it.
4440 If the value is an integer, highlighting is only shown after moving the
4441 mouse, while keyboard input turns off the highlight even when the mouse
4442 is over the clickable text. However, the mouse shape still indicates
4443 when the mouse is over clickable text. */);
4444 Vmouse_highlight = Qt;
4446 DEFVAR_LISP ("make-pointer-invisible", Vmake_pointer_invisible,
4447 doc: /* If non-nil, make pointer invisible while typing.
4448 The pointer becomes visible again when the mouse is moved. */);
4449 Vmake_pointer_invisible = Qt;
4451 DEFVAR_LISP ("focus-in-hook", Vfocus_in_hook,
4452 doc: /* Normal hook run when a frame gains input focus. */);
4453 Vfocus_in_hook = Qnil;
4454 DEFSYM (Qfocus_in_hook, "focus-in-hook");
4456 DEFVAR_LISP ("focus-out-hook", Vfocus_out_hook,
4457 doc: /* Normal hook run when a frame loses input focus. */);
4458 Vfocus_out_hook = Qnil;
4459 DEFSYM (Qfocus_out_hook, "focus-out-hook");
4461 DEFVAR_LISP ("delete-frame-functions", Vdelete_frame_functions,
4462 doc: /* Functions run before deleting a frame.
4463 The functions are run with one arg, the frame to be deleted.
4464 See `delete-frame'.
4466 Note that functions in this list may be called just before the frame is
4467 actually deleted, or some time later (or even both when an earlier function
4468 in `delete-frame-functions' (indirectly) calls `delete-frame'
4469 recursively). */);
4470 Vdelete_frame_functions = Qnil;
4471 DEFSYM (Qdelete_frame_functions, "delete-frame-functions");
4473 DEFVAR_LISP ("menu-bar-mode", Vmenu_bar_mode,
4474 doc: /* Non-nil if Menu-Bar mode is enabled.
4475 See the command `menu-bar-mode' for a description of this minor mode.
4476 Setting this variable directly does not take effect;
4477 either customize it (see the info node `Easy Customization')
4478 or call the function `menu-bar-mode'. */);
4479 Vmenu_bar_mode = Qt;
4481 DEFVAR_LISP ("tool-bar-mode", Vtool_bar_mode,
4482 doc: /* Non-nil if Tool-Bar mode is enabled.
4483 See the command `tool-bar-mode' for a description of this minor mode.
4484 Setting this variable directly does not take effect;
4485 either customize it (see the info node `Easy Customization')
4486 or call the function `tool-bar-mode'. */);
4487 #ifdef HAVE_WINDOW_SYSTEM
4488 Vtool_bar_mode = Qt;
4489 #else
4490 Vtool_bar_mode = Qnil;
4491 #endif
4493 DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
4494 doc: /* Minibufferless frames use this frame's minibuffer.
4496 Emacs cannot create minibufferless frames unless this is set to an
4497 appropriate surrogate.
4499 Emacs consults this variable only when creating minibufferless
4500 frames; once the frame is created, it sticks with its assigned
4501 minibuffer, no matter what this variable is set to. This means that
4502 this variable doesn't necessarily say anything meaningful about the
4503 current set of frames, or where the minibuffer is currently being
4504 displayed.
4506 This variable is local to the current terminal and cannot be buffer-local. */);
4508 DEFVAR_BOOL ("focus-follows-mouse", focus_follows_mouse,
4509 doc: /* Non-nil if window system changes focus when you move the mouse.
4510 You should set this variable to tell Emacs how your window manager
4511 handles focus, since there is no way in general for Emacs to find out
4512 automatically. See also `mouse-autoselect-window'. */);
4513 focus_follows_mouse = 0;
4515 staticpro (&Vframe_list);
4517 defsubr (&Sframep);
4518 defsubr (&Sframe_live_p);
4519 defsubr (&Swindow_system);
4520 defsubr (&Smake_terminal_frame);
4521 defsubr (&Shandle_switch_frame);
4522 defsubr (&Sselect_frame);
4523 defsubr (&Sselected_frame);
4524 defsubr (&Sframe_list);
4525 defsubr (&Snext_frame);
4526 defsubr (&Sprevious_frame);
4527 defsubr (&Slast_nonminibuf_frame);
4528 defsubr (&Sdelete_frame);
4529 defsubr (&Smouse_position);
4530 defsubr (&Smouse_pixel_position);
4531 defsubr (&Sset_mouse_position);
4532 defsubr (&Sset_mouse_pixel_position);
4533 #if 0
4534 defsubr (&Sframe_configuration);
4535 defsubr (&Srestore_frame_configuration);
4536 #endif
4537 defsubr (&Smake_frame_visible);
4538 defsubr (&Smake_frame_invisible);
4539 defsubr (&Siconify_frame);
4540 defsubr (&Sframe_visible_p);
4541 defsubr (&Svisible_frame_list);
4542 defsubr (&Sraise_frame);
4543 defsubr (&Slower_frame);
4544 defsubr (&Sx_focus_frame);
4545 defsubr (&Sredirect_frame_focus);
4546 defsubr (&Sframe_focus);
4547 defsubr (&Sframe_parameters);
4548 defsubr (&Sframe_parameter);
4549 defsubr (&Smodify_frame_parameters);
4550 defsubr (&Sframe_char_height);
4551 defsubr (&Sframe_char_width);
4552 defsubr (&Sframe_pixel_height);
4553 defsubr (&Sframe_pixel_width);
4554 defsubr (&Stool_bar_pixel_width);
4555 defsubr (&Sset_frame_height);
4556 defsubr (&Sset_frame_width);
4557 defsubr (&Sset_frame_size);
4558 defsubr (&Sset_frame_position);
4559 defsubr (&Sframe_pointer_visible_p);
4561 #ifdef HAVE_WINDOW_SYSTEM
4562 defsubr (&Sx_get_resource);
4563 defsubr (&Sx_parse_geometry);
4564 #endif