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