lisp/desktop.el: Fix problem creating minibuffer(less,only) frames.
[emacs.git] / src / frame.c
blob95f53569561595102b2d2c2ae385a14dbbd188a2
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 Lisp_Object fminiw;
1162 if (EQ (this, frame))
1163 continue;
1165 fminiw = FRAME_MINIBUF_WINDOW (XFRAME (this));
1167 if (WINDOWP (fminiw) && EQ (frame, WINDOW_FRAME (XWINDOW (fminiw))))
1169 /* If we MUST delete this frame, delete the other first.
1170 But do this only if FORCE equals `noelisp'. */
1171 if (EQ (force, Qnoelisp))
1172 delete_frame (this, Qnoelisp);
1173 else
1174 error ("Attempt to delete a surrogate minibuffer frame");
1179 is_tooltip_frame = !NILP (Fframe_parameter (frame, intern ("tooltip")));
1181 /* Run `delete-frame-functions' unless FORCE is `noelisp' or
1182 frame is a tooltip. FORCE is set to `noelisp' when handling
1183 a disconnect from the terminal, so we don't dare call Lisp
1184 code. */
1185 if (NILP (Vrun_hooks) || is_tooltip_frame)
1187 else if (EQ (force, Qnoelisp))
1188 pending_funcalls
1189 = Fcons (list3 (Qrun_hook_with_args, Qdelete_frame_functions, frame),
1190 pending_funcalls);
1191 else
1193 #ifdef HAVE_X_WINDOWS
1194 /* Also, save clipboard to the clipboard manager. */
1195 x_clipboard_manager_save_frame (frame);
1196 #endif
1198 safe_call2 (Qrun_hook_with_args, Qdelete_frame_functions, frame);
1201 /* The hook may sometimes (indirectly) cause the frame to be deleted. */
1202 if (! FRAME_LIVE_P (f))
1203 return Qnil;
1205 /* At this point, we are committed to deleting the frame.
1206 There is no more chance for errors to prevent it. */
1208 minibuffer_selected = EQ (minibuf_window, selected_window);
1210 /* Don't let the frame remain selected. */
1211 if (f == sf)
1213 Lisp_Object tail, frame1;
1215 /* Look for another visible frame on the same terminal. */
1216 frame1 = next_frame (frame, Qvisible);
1218 /* If there is none, find *some* other frame. */
1219 if (NILP (frame1) || EQ (frame1, frame))
1221 FOR_EACH_FRAME (tail, frame1)
1223 if (! EQ (frame, frame1) && FRAME_LIVE_P (XFRAME (frame1)))
1225 /* Do not change a text terminal's top-frame. */
1226 struct frame *f1 = XFRAME (frame1);
1227 if (FRAME_TERMCAP_P (f1) || FRAME_MSDOS_P (f1))
1229 Lisp_Object top_frame = FRAME_TTY (f1)->top_frame;
1230 if (!EQ (top_frame, frame))
1231 frame1 = top_frame;
1233 break;
1237 #ifdef NS_IMPL_COCOA
1238 else
1239 /* Under NS, there is no system mechanism for choosing a new
1240 window to get focus -- it is left to application code.
1241 So the portion of THIS application interfacing with NS
1242 needs to know about it. We call Fraise_frame, but the
1243 purpose is really to transfer focus. */
1244 Fraise_frame (frame1);
1245 #endif
1247 do_switch_frame (frame1, 0, 1, Qnil);
1248 sf = SELECTED_FRAME ();
1251 /* Don't allow minibuf_window to remain on a deleted frame. */
1252 if (EQ (f->minibuffer_window, minibuf_window))
1254 /* Use set_window_buffer instead of Fset_window_buffer (see
1255 discussion of bug#11984, bug#12025, bug#12026). */
1256 set_window_buffer (sf->minibuffer_window,
1257 XWINDOW (minibuf_window)->contents, 0, 0);
1258 minibuf_window = sf->minibuffer_window;
1260 /* If the dying minibuffer window was selected,
1261 select the new one. */
1262 if (minibuffer_selected)
1263 Fselect_window (minibuf_window, Qnil);
1266 /* Don't let echo_area_window to remain on a deleted frame. */
1267 if (EQ (f->minibuffer_window, echo_area_window))
1268 echo_area_window = sf->minibuffer_window;
1270 /* Clear any X selections for this frame. */
1271 #ifdef HAVE_X_WINDOWS
1272 if (FRAME_X_P (f))
1273 x_clear_frame_selections (f);
1274 #endif
1276 /* Free glyphs.
1277 This function must be called before the window tree of the
1278 frame is deleted because windows contain dynamically allocated
1279 memory. */
1280 free_glyphs (f);
1282 #ifdef HAVE_WINDOW_SYSTEM
1283 /* Give chance to each font driver to free a frame specific data. */
1284 font_update_drivers (f, Qnil);
1285 #endif
1287 /* Mark all the windows that used to be on FRAME as deleted, and then
1288 remove the reference to them. */
1289 delete_all_child_windows (f->root_window);
1290 fset_root_window (f, Qnil);
1292 Vframe_list = Fdelq (frame, Vframe_list);
1293 SET_FRAME_VISIBLE (f, 0);
1295 /* Allow the vector of menu bar contents to be freed in the next
1296 garbage collection. The frame object itself may not be garbage
1297 collected until much later, because recent_keys and other data
1298 structures can still refer to it. */
1299 fset_menu_bar_vector (f, Qnil);
1301 /* If FRAME's buffer lists contains killed
1302 buffers, this helps GC to reclaim them. */
1303 fset_buffer_list (f, Qnil);
1304 fset_buried_buffer_list (f, Qnil);
1306 free_font_driver_list (f);
1307 xfree (f->namebuf);
1308 xfree (f->decode_mode_spec_buffer);
1309 xfree (FRAME_INSERT_COST (f));
1310 xfree (FRAME_DELETEN_COST (f));
1311 xfree (FRAME_INSERTN_COST (f));
1312 xfree (FRAME_DELETE_COST (f));
1314 /* Since some events are handled at the interrupt level, we may get
1315 an event for f at any time; if we zero out the frame's terminal
1316 now, then we may trip up the event-handling code. Instead, we'll
1317 promise that the terminal of the frame must be valid until we
1318 have called the window-system-dependent frame destruction
1319 routine. */
1321 if (FRAME_TERMINAL (f)->delete_frame_hook)
1322 (*FRAME_TERMINAL (f)->delete_frame_hook) (f);
1325 struct terminal *terminal = FRAME_TERMINAL (f);
1326 f->output_data.nothing = 0;
1327 f->terminal = 0; /* Now the frame is dead. */
1329 /* If needed, delete the terminal that this frame was on.
1330 (This must be done after the frame is killed.) */
1331 terminal->reference_count--;
1332 #ifdef USE_GTK
1333 /* FIXME: Deleting the terminal crashes emacs because of a GTK
1334 bug.
1335 http://lists.gnu.org/archive/html/emacs-devel/2011-10/msg00363.html */
1336 if (terminal->reference_count == 0 && terminal->type == output_x_window)
1337 terminal->reference_count = 1;
1338 #endif /* USE_GTK */
1339 if (terminal->reference_count == 0)
1341 Lisp_Object tmp;
1342 XSETTERMINAL (tmp, terminal);
1344 kb = NULL;
1345 Fdelete_terminal (tmp, NILP (force) ? Qt : force);
1347 else
1348 kb = terminal->kboard;
1351 /* If we've deleted the last_nonminibuf_frame, then try to find
1352 another one. */
1353 if (f == last_nonminibuf_frame)
1355 Lisp_Object frames, this;
1357 last_nonminibuf_frame = 0;
1359 FOR_EACH_FRAME (frames, this)
1361 f = XFRAME (this);
1362 if (!FRAME_MINIBUF_ONLY_P (f))
1364 last_nonminibuf_frame = f;
1365 break;
1370 /* If there's no other frame on the same kboard, get out of
1371 single-kboard state if we're in it for this kboard. */
1372 if (kb != NULL)
1374 Lisp_Object frames, this;
1375 /* Some frame we found on the same kboard, or nil if there are none. */
1376 Lisp_Object frame_on_same_kboard = Qnil;
1378 FOR_EACH_FRAME (frames, this)
1379 if (kb == FRAME_KBOARD (XFRAME (this)))
1380 frame_on_same_kboard = this;
1382 if (NILP (frame_on_same_kboard))
1383 not_single_kboard_state (kb);
1387 /* If we've deleted this keyboard's default_minibuffer_frame, try to
1388 find another one. Prefer minibuffer-only frames, but also notice
1389 frames with other windows. */
1390 if (kb != NULL && EQ (frame, KVAR (kb, Vdefault_minibuffer_frame)))
1392 Lisp_Object frames, this;
1394 /* The last frame we saw with a minibuffer, minibuffer-only or not. */
1395 Lisp_Object frame_with_minibuf = Qnil;
1396 /* Some frame we found on the same kboard, or nil if there are none. */
1397 Lisp_Object frame_on_same_kboard = Qnil;
1399 FOR_EACH_FRAME (frames, this)
1401 struct frame *f1 = XFRAME (this);
1403 /* Consider only frames on the same kboard
1404 and only those with minibuffers. */
1405 if (kb == FRAME_KBOARD (f1)
1406 && FRAME_HAS_MINIBUF_P (f1))
1408 frame_with_minibuf = this;
1409 if (FRAME_MINIBUF_ONLY_P (f1))
1410 break;
1413 if (kb == FRAME_KBOARD (f1))
1414 frame_on_same_kboard = this;
1417 if (!NILP (frame_on_same_kboard))
1419 /* We know that there must be some frame with a minibuffer out
1420 there. If this were not true, all of the frames present
1421 would have to be minibufferless, which implies that at some
1422 point their minibuffer frames must have been deleted, but
1423 that is prohibited at the top; you can't delete surrogate
1424 minibuffer frames. */
1425 if (NILP (frame_with_minibuf))
1426 emacs_abort ();
1428 kset_default_minibuffer_frame (kb, frame_with_minibuf);
1430 else
1431 /* No frames left on this kboard--say no minibuffer either. */
1432 kset_default_minibuffer_frame (kb, Qnil);
1435 /* Cause frame titles to update--necessary if we now have just one frame. */
1436 if (!is_tooltip_frame)
1437 update_mode_lines = 1;
1439 return Qnil;
1442 DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 2, "",
1443 doc: /* Delete FRAME, permanently eliminating it from use.
1444 FRAME defaults to the selected frame.
1446 A frame may not be deleted if its minibuffer is used by other frames.
1447 Normally, you may not delete a frame if all other frames are invisible,
1448 but if the second optional argument FORCE is non-nil, you may do so.
1450 This function runs `delete-frame-functions' before actually
1451 deleting the frame, unless the frame is a tooltip.
1452 The functions are run with one argument, the frame to be deleted. */)
1453 (Lisp_Object frame, Lisp_Object force)
1455 return delete_frame (frame, !NILP (force) ? Qt : Qnil);
1459 /* Return mouse position in character cell units. */
1461 DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0,
1462 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1463 The position is given in character cells, where (0, 0) is the
1464 upper-left corner of the frame, X is the horizontal offset, and Y is
1465 the vertical offset.
1466 If Emacs is running on a mouseless terminal or hasn't been programmed
1467 to read the mouse position, it returns the selected frame for FRAME
1468 and nil for X and Y.
1469 If `mouse-position-function' is non-nil, `mouse-position' calls it,
1470 passing the normal return value to that function as an argument,
1471 and returns whatever that function returns. */)
1472 (void)
1474 FRAME_PTR f;
1475 Lisp_Object lispy_dummy;
1476 Lisp_Object x, y, retval;
1477 struct gcpro gcpro1;
1479 f = SELECTED_FRAME ();
1480 x = y = Qnil;
1482 /* It's okay for the hook to refrain from storing anything. */
1483 if (FRAME_TERMINAL (f)->mouse_position_hook)
1485 enum scroll_bar_part party_dummy;
1486 Time time_dummy;
1487 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1488 &lispy_dummy, &party_dummy,
1489 &x, &y,
1490 &time_dummy);
1493 if (! NILP (x))
1495 int col = XINT (x);
1496 int row = XINT (y);
1497 pixel_to_glyph_coords (f, col, row, &col, &row, NULL, 1);
1498 XSETINT (x, col);
1499 XSETINT (y, row);
1501 XSETFRAME (lispy_dummy, f);
1502 retval = Fcons (lispy_dummy, Fcons (x, y));
1503 GCPRO1 (retval);
1504 if (!NILP (Vmouse_position_function))
1505 retval = call1 (Vmouse_position_function, retval);
1506 RETURN_UNGCPRO (retval);
1509 DEFUN ("mouse-pixel-position", Fmouse_pixel_position,
1510 Smouse_pixel_position, 0, 0, 0,
1511 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1512 The position is given in pixel units, where (0, 0) is the
1513 upper-left corner of the frame, X is the horizontal offset, and Y is
1514 the vertical offset.
1515 If Emacs is running on a mouseless terminal or hasn't been programmed
1516 to read the mouse position, it returns the selected frame for FRAME
1517 and nil for X and Y. */)
1518 (void)
1520 FRAME_PTR f;
1521 Lisp_Object lispy_dummy;
1522 Lisp_Object x, y;
1524 f = SELECTED_FRAME ();
1525 x = y = Qnil;
1527 /* It's okay for the hook to refrain from storing anything. */
1528 if (FRAME_TERMINAL (f)->mouse_position_hook)
1530 enum scroll_bar_part party_dummy;
1531 Time time_dummy;
1532 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1533 &lispy_dummy, &party_dummy,
1534 &x, &y,
1535 &time_dummy);
1538 XSETFRAME (lispy_dummy, f);
1539 return Fcons (lispy_dummy, Fcons (x, y));
1542 DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0,
1543 doc: /* Move the mouse pointer to the center of character cell (X,Y) in FRAME.
1544 Coordinates are relative to the frame, not a window,
1545 so the coordinates of the top left character in the frame
1546 may be nonzero due to left-hand scroll bars or the menu bar.
1548 The position is given in character cells, where (0, 0) is the
1549 upper-left corner of the frame, X is the horizontal offset, and Y is
1550 the vertical offset.
1552 This function is a no-op for an X frame that is not visible.
1553 If you have just created a frame, you must wait for it to become visible
1554 before calling this function on it, like this.
1555 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1556 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1558 CHECK_LIVE_FRAME (frame);
1559 CHECK_TYPE_RANGED_INTEGER (int, x);
1560 CHECK_TYPE_RANGED_INTEGER (int, y);
1562 /* I think this should be done with a hook. */
1563 #ifdef HAVE_WINDOW_SYSTEM
1564 if (FRAME_WINDOW_P (XFRAME (frame)))
1565 /* Warping the mouse will cause enternotify and focus events. */
1566 x_set_mouse_position (XFRAME (frame), XINT (x), XINT (y));
1567 #else
1568 #if defined (MSDOS)
1569 if (FRAME_MSDOS_P (XFRAME (frame)))
1571 Fselect_frame (frame, Qnil);
1572 mouse_moveto (XINT (x), XINT (y));
1574 #else
1575 #ifdef HAVE_GPM
1577 Fselect_frame (frame, Qnil);
1578 term_mouse_moveto (XINT (x), XINT (y));
1580 #endif
1581 #endif
1582 #endif
1584 return Qnil;
1587 DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position,
1588 Sset_mouse_pixel_position, 3, 3, 0,
1589 doc: /* Move the mouse pointer to pixel position (X,Y) in FRAME.
1590 The position is given in pixels, where (0, 0) is the upper-left corner
1591 of the frame, X is the horizontal offset, and Y is the vertical offset.
1593 Note, this is a no-op for an X frame that is not visible.
1594 If you have just created a frame, you must wait for it to become visible
1595 before calling this function on it, like this.
1596 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1597 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1599 CHECK_LIVE_FRAME (frame);
1600 CHECK_TYPE_RANGED_INTEGER (int, x);
1601 CHECK_TYPE_RANGED_INTEGER (int, y);
1603 /* I think this should be done with a hook. */
1604 #ifdef HAVE_WINDOW_SYSTEM
1605 if (FRAME_WINDOW_P (XFRAME (frame)))
1606 /* Warping the mouse will cause enternotify and focus events. */
1607 x_set_mouse_pixel_position (XFRAME (frame), XINT (x), XINT (y));
1608 #else
1609 #if defined (MSDOS)
1610 if (FRAME_MSDOS_P (XFRAME (frame)))
1612 Fselect_frame (frame, Qnil);
1613 mouse_moveto (XINT (x), XINT (y));
1615 #else
1616 #ifdef HAVE_GPM
1618 Fselect_frame (frame, Qnil);
1619 term_mouse_moveto (XINT (x), XINT (y));
1621 #endif
1622 #endif
1623 #endif
1625 return Qnil;
1628 static void make_frame_visible_1 (Lisp_Object);
1630 DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible,
1631 0, 1, "",
1632 doc: /* Make the frame FRAME visible (assuming it is an X window).
1633 If omitted, FRAME defaults to the currently selected frame. */)
1634 (Lisp_Object frame)
1636 struct frame *f = decode_live_frame (frame);
1638 /* I think this should be done with a hook. */
1639 #ifdef HAVE_WINDOW_SYSTEM
1640 if (FRAME_WINDOW_P (f))
1641 x_make_frame_visible (f);
1642 #endif
1644 make_frame_visible_1 (f->root_window);
1646 /* Make menu bar update for the Buffers and Frames menus. */
1647 windows_or_buffers_changed++;
1649 XSETFRAME (frame, f);
1650 return frame;
1653 /* Update the display_time slot of the buffers shown in WINDOW
1654 and all its descendants. */
1656 static void
1657 make_frame_visible_1 (Lisp_Object window)
1659 struct window *w;
1661 for (; !NILP (window); window = w->next)
1663 w = XWINDOW (window);
1664 if (WINDOWP (w->contents))
1665 make_frame_visible_1 (w->contents);
1666 else
1667 bset_display_time (XBUFFER (w->contents), Fcurrent_time ());
1671 DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible,
1672 0, 2, "",
1673 doc: /* Make the frame FRAME invisible.
1674 If omitted, FRAME defaults to the currently selected frame.
1675 On graphical displays, invisible frames are not updated and are
1676 usually not displayed at all, even in a window system's \"taskbar\".
1678 Normally you may not make FRAME invisible if all other frames are invisible,
1679 but if the second optional argument FORCE is non-nil, you may do so.
1681 This function has no effect on text terminal frames. Such frames are
1682 always considered visible, whether or not they are currently being
1683 displayed in the terminal. */)
1684 (Lisp_Object frame, Lisp_Object force)
1686 struct frame *f = decode_live_frame (frame);
1688 if (NILP (force) && !other_visible_frames (f))
1689 error ("Attempt to make invisible the sole visible or iconified frame");
1691 /* Don't allow minibuf_window to remain on a deleted frame. */
1692 if (EQ (f->minibuffer_window, minibuf_window))
1694 struct frame *sf = XFRAME (selected_frame);
1695 /* Use set_window_buffer instead of Fset_window_buffer (see
1696 discussion of bug#11984, bug#12025, bug#12026). */
1697 set_window_buffer (sf->minibuffer_window,
1698 XWINDOW (minibuf_window)->contents, 0, 0);
1699 minibuf_window = sf->minibuffer_window;
1702 /* I think this should be done with a hook. */
1703 #ifdef HAVE_WINDOW_SYSTEM
1704 if (FRAME_WINDOW_P (f))
1705 x_make_frame_invisible (f);
1706 #endif
1708 /* Make menu bar update for the Buffers and Frames menus. */
1709 windows_or_buffers_changed++;
1711 return Qnil;
1714 DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame,
1715 0, 1, "",
1716 doc: /* Make the frame FRAME into an icon.
1717 If omitted, FRAME defaults to the currently selected frame. */)
1718 (Lisp_Object frame)
1720 struct frame *f = decode_live_frame (frame);
1722 /* Don't allow minibuf_window to remain on an iconified frame. */
1723 if (EQ (f->minibuffer_window, minibuf_window))
1725 struct frame *sf = XFRAME (selected_frame);
1726 /* Use set_window_buffer instead of Fset_window_buffer (see
1727 discussion of bug#11984, bug#12025, bug#12026). */
1728 set_window_buffer (sf->minibuffer_window,
1729 XWINDOW (minibuf_window)->contents, 0, 0);
1730 minibuf_window = sf->minibuffer_window;
1733 /* I think this should be done with a hook. */
1734 #ifdef HAVE_WINDOW_SYSTEM
1735 if (FRAME_WINDOW_P (f))
1736 x_iconify_frame (f);
1737 #endif
1739 /* Make menu bar update for the Buffers and Frames menus. */
1740 windows_or_buffers_changed++;
1742 return Qnil;
1745 DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p,
1746 1, 1, 0,
1747 doc: /* Return t if FRAME is \"visible\" (actually in use for display).
1748 Return the symbol `icon' if FRAME is iconified or \"minimized\".
1749 Return nil if FRAME was made invisible, via `make-frame-invisible'.
1750 On graphical displays, invisible frames are not updated and are
1751 usually not displayed at all, even in a window system's \"taskbar\".
1753 If FRAME is a text terminal frame, this always returns t.
1754 Such frames are always considered visible, whether or not they are
1755 currently being displayed on the terminal. */)
1756 (Lisp_Object frame)
1758 CHECK_LIVE_FRAME (frame);
1760 if (FRAME_VISIBLE_P (XFRAME (frame)))
1761 return Qt;
1762 if (FRAME_ICONIFIED_P (XFRAME (frame)))
1763 return Qicon;
1764 return Qnil;
1767 DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list,
1768 0, 0, 0,
1769 doc: /* Return a list of all frames now \"visible\" (being updated). */)
1770 (void)
1772 Lisp_Object tail, frame, value = Qnil;
1774 FOR_EACH_FRAME (tail, frame)
1775 if (FRAME_VISIBLE_P (XFRAME (frame)))
1776 value = Fcons (frame, value);
1778 return value;
1782 DEFUN ("raise-frame", Fraise_frame, Sraise_frame, 0, 1, "",
1783 doc: /* Bring FRAME to the front, so it occludes any frames it overlaps.
1784 If FRAME is invisible or iconified, make it visible.
1785 If you don't specify a frame, the selected frame is used.
1786 If Emacs is displaying on an ordinary terminal or some other device which
1787 doesn't support multiple overlapping frames, this function selects FRAME. */)
1788 (Lisp_Object frame)
1790 struct frame *f = decode_live_frame (frame);
1792 XSETFRAME (frame, f);
1794 if (FRAME_TERMCAP_P (f))
1795 /* On a text terminal select FRAME. */
1796 Fselect_frame (frame, Qnil);
1797 else
1798 /* Do like the documentation says. */
1799 Fmake_frame_visible (frame);
1801 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
1802 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 1);
1804 return Qnil;
1807 /* Should we have a corresponding function called Flower_Power? */
1808 DEFUN ("lower-frame", Flower_frame, Slower_frame, 0, 1, "",
1809 doc: /* Send FRAME to the back, so it is occluded by any frames that overlap it.
1810 If you don't specify a frame, the selected frame is used.
1811 If Emacs is displaying on an ordinary terminal or some other device which
1812 doesn't support multiple overlapping frames, this function does nothing. */)
1813 (Lisp_Object frame)
1815 struct frame *f = decode_live_frame (frame);
1817 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
1818 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 0);
1820 return Qnil;
1824 DEFUN ("redirect-frame-focus", Fredirect_frame_focus, Sredirect_frame_focus,
1825 1, 2, 0,
1826 doc: /* Arrange for keystrokes typed at FRAME to be sent to FOCUS-FRAME.
1827 In other words, switch-frame events caused by events in FRAME will
1828 request a switch to FOCUS-FRAME, and `last-event-frame' will be
1829 FOCUS-FRAME after reading an event typed at FRAME.
1831 If FOCUS-FRAME is nil, any existing redirection is canceled, and the
1832 frame again receives its own keystrokes.
1834 Focus redirection is useful for temporarily redirecting keystrokes to
1835 a surrogate minibuffer frame when a frame doesn't have its own
1836 minibuffer window.
1838 A frame's focus redirection can be changed by `select-frame'. If frame
1839 FOO is selected, and then a different frame BAR is selected, any
1840 frames redirecting their focus to FOO are shifted to redirect their
1841 focus to BAR. This allows focus redirection to work properly when the
1842 user switches from one frame to another using `select-window'.
1844 This means that a frame whose focus is redirected to itself is treated
1845 differently from a frame whose focus is redirected to nil; the former
1846 is affected by `select-frame', while the latter is not.
1848 The redirection lasts until `redirect-frame-focus' is called to change it. */)
1849 (Lisp_Object frame, Lisp_Object focus_frame)
1851 /* Note that we don't check for a live frame here. It's reasonable
1852 to redirect the focus of a frame you're about to delete, if you
1853 know what other frame should receive those keystrokes. */
1854 struct frame *f = decode_any_frame (frame);
1856 if (! NILP (focus_frame))
1857 CHECK_LIVE_FRAME (focus_frame);
1859 fset_focus_frame (f, focus_frame);
1861 if (FRAME_TERMINAL (f)->frame_rehighlight_hook)
1862 (*FRAME_TERMINAL (f)->frame_rehighlight_hook) (f);
1864 return Qnil;
1868 DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 0, 1, 0,
1869 doc: /* Return the frame to which FRAME's keystrokes are currently being sent.
1870 If FRAME is omitted or nil, the selected frame is used.
1871 Return nil if FRAME's focus is not redirected.
1872 See `redirect-frame-focus'. */)
1873 (Lisp_Object frame)
1875 return FRAME_FOCUS_FRAME (decode_live_frame (frame));
1880 /* Return the value of frame parameter PROP in frame FRAME. */
1882 #ifdef HAVE_WINDOW_SYSTEM
1883 #if !HAVE_NS && !defined (WINDOWSNT)
1884 static
1885 #endif
1886 Lisp_Object
1887 get_frame_param (register struct frame *frame, Lisp_Object prop)
1889 register Lisp_Object tem;
1891 tem = Fassq (prop, frame->param_alist);
1892 if (EQ (tem, Qnil))
1893 return tem;
1894 return Fcdr (tem);
1896 #endif
1898 /* Discard BUFFER from the buffer-list and buried-buffer-list of each frame. */
1900 void
1901 frames_discard_buffer (Lisp_Object buffer)
1903 Lisp_Object frame, tail;
1905 FOR_EACH_FRAME (tail, frame)
1907 fset_buffer_list
1908 (XFRAME (frame), Fdelq (buffer, XFRAME (frame)->buffer_list));
1909 fset_buried_buffer_list
1910 (XFRAME (frame), Fdelq (buffer, XFRAME (frame)->buried_buffer_list));
1914 /* Modify the alist in *ALISTPTR to associate PROP with VAL.
1915 If the alist already has an element for PROP, we change it. */
1917 void
1918 store_in_alist (Lisp_Object *alistptr, Lisp_Object prop, Lisp_Object val)
1920 register Lisp_Object tem;
1922 tem = Fassq (prop, *alistptr);
1923 if (EQ (tem, Qnil))
1924 *alistptr = Fcons (Fcons (prop, val), *alistptr);
1925 else
1926 Fsetcdr (tem, val);
1929 static int
1930 frame_name_fnn_p (char *str, ptrdiff_t len)
1932 if (len > 1 && str[0] == 'F' && '0' <= str[1] && str[1] <= '9')
1934 char *p = str + 2;
1935 while ('0' <= *p && *p <= '9')
1936 p++;
1937 if (p == str + len)
1938 return 1;
1940 return 0;
1943 /* Set the name of the terminal frame. Also used by MSDOS frames.
1944 Modeled after x_set_name which is used for WINDOW frames. */
1946 static void
1947 set_term_frame_name (struct frame *f, Lisp_Object name)
1949 f->explicit_name = ! NILP (name);
1951 /* If NAME is nil, set the name to F<num>. */
1952 if (NILP (name))
1954 char namebuf[sizeof "F" + INT_STRLEN_BOUND (printmax_t)];
1956 /* Check for no change needed in this very common case
1957 before we do any consing. */
1958 if (frame_name_fnn_p (SSDATA (f->name), SBYTES (f->name)))
1959 return;
1961 name = make_formatted_string (namebuf, "F%"pMd, ++tty_frame_count);
1963 else
1965 CHECK_STRING (name);
1967 /* Don't change the name if it's already NAME. */
1968 if (! NILP (Fstring_equal (name, f->name)))
1969 return;
1971 /* Don't allow the user to set the frame name to F<num>, so it
1972 doesn't clash with the names we generate for terminal frames. */
1973 if (frame_name_fnn_p (SSDATA (name), SBYTES (name)))
1974 error ("Frame names of the form F<num> are usurped by Emacs");
1977 fset_name (f, name);
1978 update_mode_lines = 1;
1981 void
1982 store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
1984 register Lisp_Object old_alist_elt;
1986 /* The buffer-list parameters are stored in a special place and not
1987 in the alist. All buffers must be live. */
1988 if (EQ (prop, Qbuffer_list))
1990 Lisp_Object list = Qnil;
1991 for (; CONSP (val); val = XCDR (val))
1992 if (!NILP (Fbuffer_live_p (XCAR (val))))
1993 list = Fcons (XCAR (val), list);
1994 fset_buffer_list (f, Fnreverse (list));
1995 return;
1997 if (EQ (prop, Qburied_buffer_list))
1999 Lisp_Object list = Qnil;
2000 for (; CONSP (val); val = XCDR (val))
2001 if (!NILP (Fbuffer_live_p (XCAR (val))))
2002 list = Fcons (XCAR (val), list);
2003 fset_buried_buffer_list (f, Fnreverse (list));
2004 return;
2007 /* If PROP is a symbol which is supposed to have frame-local values,
2008 and it is set up based on this frame, switch to the global
2009 binding. That way, we can create or alter the frame-local binding
2010 without messing up the symbol's status. */
2011 if (SYMBOLP (prop))
2013 struct Lisp_Symbol *sym = XSYMBOL (prop);
2014 start:
2015 switch (sym->redirect)
2017 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
2018 case SYMBOL_PLAINVAL: case SYMBOL_FORWARDED: break;
2019 case SYMBOL_LOCALIZED:
2020 { struct Lisp_Buffer_Local_Value *blv = sym->val.blv;
2021 if (blv->frame_local && blv_found (blv) && XFRAME (blv->where) == f)
2022 swap_in_global_binding (sym);
2023 break;
2025 default: emacs_abort ();
2029 /* The tty color needed to be set before the frame's parameter
2030 alist was updated with the new value. This is not true any more,
2031 but we still do this test early on. */
2032 if (FRAME_TERMCAP_P (f) && EQ (prop, Qtty_color_mode)
2033 && f == FRAME_TTY (f)->previous_frame)
2034 /* Force redisplay of this tty. */
2035 FRAME_TTY (f)->previous_frame = NULL;
2037 /* Update the frame parameter alist. */
2038 old_alist_elt = Fassq (prop, f->param_alist);
2039 if (EQ (old_alist_elt, Qnil))
2040 fset_param_alist (f, Fcons (Fcons (prop, val), f->param_alist));
2041 else
2042 Fsetcdr (old_alist_elt, val);
2044 /* Update some other special parameters in their special places
2045 in addition to the alist. */
2047 if (EQ (prop, Qbuffer_predicate))
2048 fset_buffer_predicate (f, val);
2050 if (! FRAME_WINDOW_P (f))
2052 if (EQ (prop, Qmenu_bar_lines))
2053 set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f)));
2054 else if (EQ (prop, Qname))
2055 set_term_frame_name (f, val);
2058 if (EQ (prop, Qminibuffer) && WINDOWP (val))
2060 if (! MINI_WINDOW_P (XWINDOW (val)))
2061 error ("Surrogate minibuffer windows must be minibuffer windows");
2063 if ((FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
2064 && !EQ (val, f->minibuffer_window))
2065 error ("Can't change the surrogate minibuffer of a frame with its own minibuffer");
2067 /* Install the chosen minibuffer window, with proper buffer. */
2068 fset_minibuffer_window (f, val);
2072 DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0,
2073 doc: /* Return the parameters-alist of frame FRAME.
2074 It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
2075 The meaningful PARMs depend on the kind of frame.
2076 If FRAME is omitted or nil, return information on the currently selected frame. */)
2077 (Lisp_Object frame)
2079 Lisp_Object alist;
2080 struct frame *f = decode_any_frame (frame);
2081 int height, width;
2082 struct gcpro gcpro1;
2084 if (!FRAME_LIVE_P (f))
2085 return Qnil;
2087 alist = Fcopy_alist (f->param_alist);
2088 GCPRO1 (alist);
2090 if (!FRAME_WINDOW_P (f))
2092 int fg = FRAME_FOREGROUND_PIXEL (f);
2093 int bg = FRAME_BACKGROUND_PIXEL (f);
2094 Lisp_Object elt;
2096 /* If the frame's parameter alist says the colors are
2097 unspecified and reversed, take the frame's background pixel
2098 for foreground and vice versa. */
2099 elt = Fassq (Qforeground_color, alist);
2100 if (CONSP (elt) && STRINGP (XCDR (elt)))
2102 if (strncmp (SSDATA (XCDR (elt)),
2103 unspecified_bg,
2104 SCHARS (XCDR (elt))) == 0)
2105 store_in_alist (&alist, Qforeground_color, tty_color_name (f, bg));
2106 else if (strncmp (SSDATA (XCDR (elt)),
2107 unspecified_fg,
2108 SCHARS (XCDR (elt))) == 0)
2109 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2111 else
2112 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2113 elt = Fassq (Qbackground_color, alist);
2114 if (CONSP (elt) && STRINGP (XCDR (elt)))
2116 if (strncmp (SSDATA (XCDR (elt)),
2117 unspecified_fg,
2118 SCHARS (XCDR (elt))) == 0)
2119 store_in_alist (&alist, Qbackground_color, tty_color_name (f, fg));
2120 else if (strncmp (SSDATA (XCDR (elt)),
2121 unspecified_bg,
2122 SCHARS (XCDR (elt))) == 0)
2123 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2125 else
2126 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2127 store_in_alist (&alist, intern ("font"),
2128 build_string (FRAME_MSDOS_P (f)
2129 ? "ms-dos"
2130 : FRAME_W32_P (f) ? "w32term"
2131 :"tty"));
2133 store_in_alist (&alist, Qname, f->name);
2134 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2135 store_in_alist (&alist, Qheight, make_number (height));
2136 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2137 store_in_alist (&alist, Qwidth, make_number (width));
2138 store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil));
2139 store_in_alist (&alist, Qminibuffer,
2140 (! FRAME_HAS_MINIBUF_P (f) ? Qnil
2141 : FRAME_MINIBUF_ONLY_P (f) ? Qonly
2142 : FRAME_MINIBUF_WINDOW (f)));
2143 store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
2144 store_in_alist (&alist, Qbuffer_list, f->buffer_list);
2145 store_in_alist (&alist, Qburied_buffer_list, f->buried_buffer_list);
2147 /* I think this should be done with a hook. */
2148 #ifdef HAVE_WINDOW_SYSTEM
2149 if (FRAME_WINDOW_P (f))
2150 x_report_frame_params (f, &alist);
2151 else
2152 #endif
2154 /* This ought to be correct in f->param_alist for an X frame. */
2155 Lisp_Object lines;
2156 XSETFASTINT (lines, FRAME_MENU_BAR_LINES (f));
2157 store_in_alist (&alist, Qmenu_bar_lines, lines);
2160 UNGCPRO;
2161 return alist;
2165 DEFUN ("frame-parameter", Fframe_parameter, Sframe_parameter, 2, 2, 0,
2166 doc: /* Return FRAME's value for parameter PARAMETER.
2167 If FRAME is nil, describe the currently selected frame. */)
2168 (Lisp_Object frame, Lisp_Object parameter)
2170 struct frame *f = decode_any_frame (frame);
2171 Lisp_Object value = Qnil;
2173 CHECK_SYMBOL (parameter);
2175 XSETFRAME (frame, f);
2177 if (FRAME_LIVE_P (f))
2179 /* Avoid consing in frequent cases. */
2180 if (EQ (parameter, Qname))
2181 value = f->name;
2182 #ifdef HAVE_X_WINDOWS
2183 else if (EQ (parameter, Qdisplay) && FRAME_X_P (f))
2184 value = XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element);
2185 #endif /* HAVE_X_WINDOWS */
2186 else if (EQ (parameter, Qbackground_color)
2187 || EQ (parameter, Qforeground_color))
2189 value = Fassq (parameter, f->param_alist);
2190 if (CONSP (value))
2192 value = XCDR (value);
2193 /* Fframe_parameters puts the actual fg/bg color names,
2194 even if f->param_alist says otherwise. This is
2195 important when param_alist's notion of colors is
2196 "unspecified". We need to do the same here. */
2197 if (STRINGP (value) && !FRAME_WINDOW_P (f))
2199 const char *color_name;
2200 ptrdiff_t csz;
2202 if (EQ (parameter, Qbackground_color))
2204 color_name = SSDATA (value);
2205 csz = SCHARS (value);
2206 if (strncmp (color_name, unspecified_bg, csz) == 0)
2207 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2208 else if (strncmp (color_name, unspecified_fg, csz) == 0)
2209 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2211 else if (EQ (parameter, Qforeground_color))
2213 color_name = SSDATA (value);
2214 csz = SCHARS (value);
2215 if (strncmp (color_name, unspecified_fg, csz) == 0)
2216 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2217 else if (strncmp (color_name, unspecified_bg, csz) == 0)
2218 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2222 else
2223 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2225 else if (EQ (parameter, Qdisplay_type)
2226 || EQ (parameter, Qbackground_mode))
2227 value = Fcdr (Fassq (parameter, f->param_alist));
2228 else
2229 /* FIXME: Avoid this code path at all (as well as code duplication)
2230 by sharing more code with Fframe_parameters. */
2231 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2234 return value;
2238 DEFUN ("modify-frame-parameters", Fmodify_frame_parameters,
2239 Smodify_frame_parameters, 2, 2, 0,
2240 doc: /* Modify the parameters of frame FRAME according to ALIST.
2241 If FRAME is nil, it defaults to the selected frame.
2242 ALIST is an alist of parameters to change and their new values.
2243 Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.
2244 The meaningful PARMs depend on the kind of frame.
2245 Undefined PARMs are ignored, but stored in the frame's parameter list
2246 so that `frame-parameters' will return them.
2248 The value of frame parameter FOO can also be accessed
2249 as a frame-local binding for the variable FOO, if you have
2250 enabled such bindings for that variable with `make-variable-frame-local'.
2251 Note that this functionality is obsolete as of Emacs 22.2, and its
2252 use is not recommended. Explicitly check for a frame-parameter instead. */)
2253 (Lisp_Object frame, Lisp_Object alist)
2255 struct frame *f = decode_live_frame (frame);
2256 register Lisp_Object tail, prop, val;
2258 /* I think this should be done with a hook. */
2259 #ifdef HAVE_WINDOW_SYSTEM
2260 if (FRAME_WINDOW_P (f))
2261 x_set_frame_parameters (f, alist);
2262 else
2263 #endif
2264 #ifdef MSDOS
2265 if (FRAME_MSDOS_P (f))
2266 IT_set_frame_parameters (f, alist);
2267 else
2268 #endif
2271 EMACS_INT length = XFASTINT (Flength (alist));
2272 ptrdiff_t i;
2273 Lisp_Object *parms;
2274 Lisp_Object *values;
2275 USE_SAFE_ALLOCA;
2276 SAFE_ALLOCA_LISP (parms, 2 * length);
2277 values = parms + length;
2279 /* Extract parm names and values into those vectors. */
2281 i = 0;
2282 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2284 Lisp_Object elt;
2286 elt = XCAR (tail);
2287 parms[i] = Fcar (elt);
2288 values[i] = Fcdr (elt);
2289 i++;
2292 /* Now process them in reverse of specified order. */
2293 while (--i >= 0)
2295 prop = parms[i];
2296 val = values[i];
2297 store_frame_param (f, prop, val);
2299 if (EQ (prop, Qforeground_color)
2300 || EQ (prop, Qbackground_color))
2301 update_face_from_frame_parameter (f, prop, val);
2304 SAFE_FREE ();
2306 return Qnil;
2309 DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height,
2310 0, 1, 0,
2311 doc: /* Height in pixels of a line in the font in frame FRAME.
2312 If FRAME is omitted or nil, the selected frame is used.
2313 For a terminal frame, the value is always 1. */)
2314 (Lisp_Object frame)
2316 #ifdef HAVE_WINDOW_SYSTEM
2317 struct frame *f = decode_any_frame (frame);
2319 if (FRAME_WINDOW_P (f))
2320 return make_number (FRAME_LINE_HEIGHT (f));
2321 else
2322 #endif
2323 return make_number (1);
2327 DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width,
2328 0, 1, 0,
2329 doc: /* Width in pixels of characters in the font in frame FRAME.
2330 If FRAME is omitted or nil, the selected frame is used.
2331 On a graphical screen, the width is the standard width of the default font.
2332 For a terminal screen, the value is always 1. */)
2333 (Lisp_Object frame)
2335 #ifdef HAVE_WINDOW_SYSTEM
2336 struct frame *f = decode_any_frame (frame);
2338 if (FRAME_WINDOW_P (f))
2339 return make_number (FRAME_COLUMN_WIDTH (f));
2340 else
2341 #endif
2342 return make_number (1);
2345 DEFUN ("frame-pixel-height", Fframe_pixel_height,
2346 Sframe_pixel_height, 0, 1, 0,
2347 doc: /* Return a FRAME's height in pixels.
2348 If FRAME is omitted or nil, the selected frame is used. The exact value
2349 of the result depends on the window-system and toolkit in use:
2351 In the Gtk+ version of Emacs, it includes only any window (including
2352 the minibuffer or echo area), mode line, and header line. It does not
2353 include the tool bar or menu bar.
2355 With other graphical versions, it also includes the tool bar and the
2356 menu bar.
2358 For a text terminal, it includes the menu bar. In this case, the
2359 result is really in characters rather than pixels (i.e., is identical
2360 to `frame-height'). */)
2361 (Lisp_Object frame)
2363 struct frame *f = decode_any_frame (frame);
2365 #ifdef HAVE_WINDOW_SYSTEM
2366 if (FRAME_WINDOW_P (f))
2367 return make_number (x_pixel_height (f));
2368 else
2369 #endif
2370 return make_number (FRAME_LINES (f));
2373 DEFUN ("frame-pixel-width", Fframe_pixel_width,
2374 Sframe_pixel_width, 0, 1, 0,
2375 doc: /* Return FRAME's width in pixels.
2376 For a terminal frame, the result really gives the width in characters.
2377 If FRAME is omitted or nil, the selected frame is used. */)
2378 (Lisp_Object frame)
2380 struct frame *f = decode_any_frame (frame);
2382 #ifdef HAVE_WINDOW_SYSTEM
2383 if (FRAME_WINDOW_P (f))
2384 return make_number (x_pixel_width (f));
2385 else
2386 #endif
2387 return make_number (FRAME_COLS (f));
2390 DEFUN ("tool-bar-pixel-width", Ftool_bar_pixel_width,
2391 Stool_bar_pixel_width, 0, 1, 0,
2392 doc: /* Return width in pixels of FRAME's tool bar.
2393 The result is greater than zero only when the tool bar is on the left
2394 or right side of FRAME. If FRAME is omitted or nil, the selected frame
2395 is used. */)
2396 (Lisp_Object frame)
2398 #ifdef FRAME_TOOLBAR_WIDTH
2399 struct frame *f = decode_any_frame (frame);
2401 if (FRAME_WINDOW_P (f))
2402 return make_number (FRAME_TOOLBAR_WIDTH (f));
2403 #endif
2404 return make_number (0);
2407 DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0,
2408 doc: /* Specify that the frame FRAME has LINES lines.
2409 Optional third arg non-nil means that redisplay should use LINES lines
2410 but that the idea of the actual height of the frame should not be changed. */)
2411 (Lisp_Object frame, Lisp_Object lines, Lisp_Object pretend)
2413 register struct frame *f = decode_live_frame (frame);
2415 CHECK_TYPE_RANGED_INTEGER (int, lines);
2417 /* I think this should be done with a hook. */
2418 #ifdef HAVE_WINDOW_SYSTEM
2419 if (FRAME_WINDOW_P (f))
2421 if (XINT (lines) != FRAME_LINES (f))
2422 x_set_window_size (f, 1, FRAME_COLS (f), XINT (lines));
2423 do_pending_window_change (0);
2425 else
2426 #endif
2427 change_frame_size (f, XINT (lines), 0, !NILP (pretend), 0, 0);
2428 return Qnil;
2431 DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 3, 0,
2432 doc: /* Specify that the frame FRAME has COLS columns.
2433 Optional third arg non-nil means that redisplay should use COLS columns
2434 but that the idea of the actual width of the frame should not be changed. */)
2435 (Lisp_Object frame, Lisp_Object cols, Lisp_Object pretend)
2437 register struct frame *f = decode_live_frame (frame);
2439 CHECK_TYPE_RANGED_INTEGER (int, cols);
2441 /* I think this should be done with a hook. */
2442 #ifdef HAVE_WINDOW_SYSTEM
2443 if (FRAME_WINDOW_P (f))
2445 if (XINT (cols) != FRAME_COLS (f))
2446 x_set_window_size (f, 1, XINT (cols), FRAME_LINES (f));
2447 do_pending_window_change (0);
2449 else
2450 #endif
2451 change_frame_size (f, 0, XINT (cols), !NILP (pretend), 0, 0);
2452 return Qnil;
2455 DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0,
2456 doc: /* Sets size of FRAME to COLS by ROWS, measured in characters. */)
2457 (Lisp_Object frame, Lisp_Object cols, Lisp_Object rows)
2459 register struct frame *f;
2461 CHECK_LIVE_FRAME (frame);
2462 CHECK_TYPE_RANGED_INTEGER (int, cols);
2463 CHECK_TYPE_RANGED_INTEGER (int, rows);
2464 f = XFRAME (frame);
2466 /* I think this should be done with a hook. */
2467 #ifdef HAVE_WINDOW_SYSTEM
2468 if (FRAME_WINDOW_P (f))
2470 if (XINT (rows) != FRAME_LINES (f)
2471 || XINT (cols) != FRAME_COLS (f)
2472 || f->new_text_lines || f->new_text_cols)
2473 x_set_window_size (f, 1, XINT (cols), XINT (rows));
2474 do_pending_window_change (0);
2476 else
2477 #endif
2478 change_frame_size (f, XINT (rows), XINT (cols), 0, 0, 0);
2480 return Qnil;
2483 DEFUN ("set-frame-position", Fset_frame_position,
2484 Sset_frame_position, 3, 3, 0,
2485 doc: /* Sets position of FRAME in pixels to XOFFSET by YOFFSET.
2486 This is actually the position of the upper left corner of the frame.
2487 Negative values for XOFFSET or YOFFSET are interpreted relative to
2488 the rightmost or bottommost possible position (that stays within the screen). */)
2489 (Lisp_Object frame, Lisp_Object xoffset, Lisp_Object yoffset)
2491 register struct frame *f;
2493 CHECK_LIVE_FRAME (frame);
2494 CHECK_TYPE_RANGED_INTEGER (int, xoffset);
2495 CHECK_TYPE_RANGED_INTEGER (int, yoffset);
2496 f = XFRAME (frame);
2498 /* I think this should be done with a hook. */
2499 #ifdef HAVE_WINDOW_SYSTEM
2500 if (FRAME_WINDOW_P (f))
2501 x_set_offset (f, XINT (xoffset), XINT (yoffset), 1);
2502 #endif
2504 return Qt;
2508 /***********************************************************************
2509 Frame Parameters
2510 ***********************************************************************/
2512 /* Connect the frame-parameter names for X frames
2513 to the ways of passing the parameter values to the window system.
2515 The name of a parameter, as a Lisp symbol,
2516 has an `x-frame-parameter' property which is an integer in Lisp
2517 that is an index in this table. */
2519 struct frame_parm_table {
2520 const char *name;
2521 Lisp_Object *variable;
2524 static const struct frame_parm_table frame_parms[] =
2526 {"auto-raise", &Qauto_raise},
2527 {"auto-lower", &Qauto_lower},
2528 {"background-color", 0},
2529 {"border-color", &Qborder_color},
2530 {"border-width", &Qborder_width},
2531 {"cursor-color", &Qcursor_color},
2532 {"cursor-type", &Qcursor_type},
2533 {"font", 0},
2534 {"foreground-color", 0},
2535 {"icon-name", &Qicon_name},
2536 {"icon-type", &Qicon_type},
2537 {"internal-border-width", &Qinternal_border_width},
2538 {"menu-bar-lines", &Qmenu_bar_lines},
2539 {"mouse-color", &Qmouse_color},
2540 {"name", &Qname},
2541 {"scroll-bar-width", &Qscroll_bar_width},
2542 {"title", &Qtitle},
2543 {"unsplittable", &Qunsplittable},
2544 {"vertical-scroll-bars", &Qvertical_scroll_bars},
2545 {"visibility", &Qvisibility},
2546 {"tool-bar-lines", &Qtool_bar_lines},
2547 {"scroll-bar-foreground", &Qscroll_bar_foreground},
2548 {"scroll-bar-background", &Qscroll_bar_background},
2549 {"screen-gamma", &Qscreen_gamma},
2550 {"line-spacing", &Qline_spacing},
2551 {"left-fringe", &Qleft_fringe},
2552 {"right-fringe", &Qright_fringe},
2553 {"wait-for-wm", &Qwait_for_wm},
2554 {"fullscreen", &Qfullscreen},
2555 {"font-backend", &Qfont_backend},
2556 {"alpha", &Qalpha},
2557 {"sticky", &Qsticky},
2558 {"tool-bar-position", &Qtool_bar_position},
2561 #ifdef HAVE_NTGUI
2563 /* Calculate fullscreen size. Return in *TOP_POS and *LEFT_POS the
2564 wanted positions of the WM window (not Emacs window).
2565 Return in *WIDTH and *HEIGHT the wanted width and height of Emacs
2566 window (FRAME_X_WINDOW).
2569 void
2570 x_fullscreen_adjust (struct frame *f, int *width, int *height, int *top_pos, int *left_pos)
2572 int newwidth = FRAME_COLS (f);
2573 int newheight = FRAME_LINES (f);
2574 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2576 *top_pos = f->top_pos;
2577 *left_pos = f->left_pos;
2579 if (f->want_fullscreen & FULLSCREEN_HEIGHT)
2581 int ph;
2583 ph = x_display_pixel_height (dpyinfo);
2584 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2585 ph = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, newheight) - f->y_pixels_diff;
2586 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2587 *top_pos = 0;
2590 if (f->want_fullscreen & FULLSCREEN_WIDTH)
2592 int pw;
2594 pw = x_display_pixel_width (dpyinfo);
2595 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2596 pw = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, newwidth) - f->x_pixels_diff;
2597 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2598 *left_pos = 0;
2601 *width = newwidth;
2602 *height = newheight;
2605 #endif /* HAVE_NTGUI */
2607 #ifdef HAVE_WINDOW_SYSTEM
2609 /* Change the parameters of frame F as specified by ALIST.
2610 If a parameter is not specially recognized, do nothing special;
2611 otherwise call the `x_set_...' function for that parameter.
2612 Except for certain geometry properties, always call store_frame_param
2613 to store the new value in the parameter alist. */
2615 void
2616 x_set_frame_parameters (FRAME_PTR f, Lisp_Object alist)
2618 Lisp_Object tail;
2620 /* If both of these parameters are present, it's more efficient to
2621 set them both at once. So we wait until we've looked at the
2622 entire list before we set them. */
2623 int width, height;
2625 /* Same here. */
2626 Lisp_Object left, top;
2628 /* Same with these. */
2629 Lisp_Object icon_left, icon_top;
2631 /* Record in these vectors all the parms specified. */
2632 Lisp_Object *parms;
2633 Lisp_Object *values;
2634 ptrdiff_t i, p;
2635 int left_no_change = 0, top_no_change = 0;
2636 int icon_left_no_change = 0, icon_top_no_change = 0;
2637 int size_changed = 0;
2638 struct gcpro gcpro1, gcpro2;
2640 i = 0;
2641 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2642 i++;
2644 parms = alloca (i * sizeof *parms);
2645 values = alloca (i * sizeof *values);
2647 /* Extract parm names and values into those vectors. */
2649 i = 0;
2650 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2652 Lisp_Object elt;
2654 elt = XCAR (tail);
2655 parms[i] = Fcar (elt);
2656 values[i] = Fcdr (elt);
2657 i++;
2659 /* TAIL and ALIST are not used again below here. */
2660 alist = tail = Qnil;
2662 GCPRO2 (*parms, *values);
2663 gcpro1.nvars = i;
2664 gcpro2.nvars = i;
2666 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
2667 because their values appear in VALUES and strings are not valid. */
2668 top = left = Qunbound;
2669 icon_left = icon_top = Qunbound;
2671 /* Provide default values for HEIGHT and WIDTH. */
2672 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2673 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2675 /* Process foreground_color and background_color before anything else.
2676 They are independent of other properties, but other properties (e.g.,
2677 cursor_color) are dependent upon them. */
2678 /* Process default font as well, since fringe widths depends on it. */
2679 for (p = 0; p < i; p++)
2681 Lisp_Object prop, val;
2683 prop = parms[p];
2684 val = values[p];
2685 if (EQ (prop, Qforeground_color)
2686 || EQ (prop, Qbackground_color)
2687 || EQ (prop, Qfont))
2689 register Lisp_Object param_index, old_value;
2691 old_value = get_frame_param (f, prop);
2692 if (NILP (Fequal (val, old_value)))
2694 store_frame_param (f, prop, val);
2696 param_index = Fget (prop, Qx_frame_parameter);
2697 if (NATNUMP (param_index)
2698 && (XFASTINT (param_index)
2699 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2700 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
2701 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2706 /* Now process them in reverse of specified order. */
2707 while (i-- != 0)
2709 Lisp_Object prop, val;
2711 prop = parms[i];
2712 val = values[i];
2714 if (EQ (prop, Qwidth) && RANGED_INTEGERP (0, val, INT_MAX))
2716 size_changed = 1;
2717 width = XFASTINT (val);
2719 else if (EQ (prop, Qheight) && RANGED_INTEGERP (0, val, INT_MAX))
2721 size_changed = 1;
2722 height = XFASTINT (val);
2724 else if (EQ (prop, Qtop))
2725 top = val;
2726 else if (EQ (prop, Qleft))
2727 left = val;
2728 else if (EQ (prop, Qicon_top))
2729 icon_top = val;
2730 else if (EQ (prop, Qicon_left))
2731 icon_left = val;
2732 else if (EQ (prop, Qforeground_color)
2733 || EQ (prop, Qbackground_color)
2734 || EQ (prop, Qfont))
2735 /* Processed above. */
2736 continue;
2737 else
2739 register Lisp_Object param_index, old_value;
2741 old_value = get_frame_param (f, prop);
2743 store_frame_param (f, prop, val);
2745 param_index = Fget (prop, Qx_frame_parameter);
2746 if (NATNUMP (param_index)
2747 && (XFASTINT (param_index)
2748 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2749 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
2750 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2754 /* Don't die if just one of these was set. */
2755 if (EQ (left, Qunbound))
2757 left_no_change = 1;
2758 if (f->left_pos < 0)
2759 left = list2 (Qplus, make_number (f->left_pos));
2760 else
2761 XSETINT (left, f->left_pos);
2763 if (EQ (top, Qunbound))
2765 top_no_change = 1;
2766 if (f->top_pos < 0)
2767 top = list2 (Qplus, make_number (f->top_pos));
2768 else
2769 XSETINT (top, f->top_pos);
2772 /* If one of the icon positions was not set, preserve or default it. */
2773 if (! TYPE_RANGED_INTEGERP (int, icon_left))
2775 icon_left_no_change = 1;
2776 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
2777 if (NILP (icon_left))
2778 XSETINT (icon_left, 0);
2780 if (! TYPE_RANGED_INTEGERP (int, icon_top))
2782 icon_top_no_change = 1;
2783 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
2784 if (NILP (icon_top))
2785 XSETINT (icon_top, 0);
2788 /* Don't set these parameters unless they've been explicitly
2789 specified. The window might be mapped or resized while we're in
2790 this function, and we don't want to override that unless the lisp
2791 code has asked for it.
2793 Don't set these parameters unless they actually differ from the
2794 window's current parameters; the window may not actually exist
2795 yet. */
2797 Lisp_Object frame;
2799 check_frame_size (f, &height, &width);
2801 XSETFRAME (frame, f);
2803 if (size_changed
2804 && (width != FRAME_COLS (f)
2805 || height != FRAME_LINES (f)
2806 || f->new_text_lines || f->new_text_cols))
2807 Fset_frame_size (frame, make_number (width), make_number (height));
2809 if ((!NILP (left) || !NILP (top))
2810 && ! (left_no_change && top_no_change)
2811 && ! (NUMBERP (left) && XINT (left) == f->left_pos
2812 && NUMBERP (top) && XINT (top) == f->top_pos))
2814 int leftpos = 0;
2815 int toppos = 0;
2817 /* Record the signs. */
2818 f->size_hint_flags &= ~ (XNegative | YNegative);
2819 if (EQ (left, Qminus))
2820 f->size_hint_flags |= XNegative;
2821 else if (TYPE_RANGED_INTEGERP (int, left))
2823 leftpos = XINT (left);
2824 if (leftpos < 0)
2825 f->size_hint_flags |= XNegative;
2827 else if (CONSP (left) && EQ (XCAR (left), Qminus)
2828 && CONSP (XCDR (left))
2829 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (left)), INT_MAX))
2831 leftpos = - XINT (XCAR (XCDR (left)));
2832 f->size_hint_flags |= XNegative;
2834 else if (CONSP (left) && EQ (XCAR (left), Qplus)
2835 && CONSP (XCDR (left))
2836 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (left))))
2838 leftpos = XINT (XCAR (XCDR (left)));
2841 if (EQ (top, Qminus))
2842 f->size_hint_flags |= YNegative;
2843 else if (TYPE_RANGED_INTEGERP (int, top))
2845 toppos = XINT (top);
2846 if (toppos < 0)
2847 f->size_hint_flags |= YNegative;
2849 else if (CONSP (top) && EQ (XCAR (top), Qminus)
2850 && CONSP (XCDR (top))
2851 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (top)), INT_MAX))
2853 toppos = - XINT (XCAR (XCDR (top)));
2854 f->size_hint_flags |= YNegative;
2856 else if (CONSP (top) && EQ (XCAR (top), Qplus)
2857 && CONSP (XCDR (top))
2858 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (top))))
2860 toppos = XINT (XCAR (XCDR (top)));
2864 /* Store the numeric value of the position. */
2865 f->top_pos = toppos;
2866 f->left_pos = leftpos;
2868 f->win_gravity = NorthWestGravity;
2870 /* Actually set that position, and convert to absolute. */
2871 x_set_offset (f, leftpos, toppos, -1);
2874 if ((!NILP (icon_left) || !NILP (icon_top))
2875 && ! (icon_left_no_change && icon_top_no_change))
2876 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
2879 UNGCPRO;
2883 /* Insert a description of internally-recorded parameters of frame X
2884 into the parameter alist *ALISTPTR that is to be given to the user.
2885 Only parameters that are specific to the X window system
2886 and whose values are not correctly recorded in the frame's
2887 param_alist need to be considered here. */
2889 void
2890 x_report_frame_params (struct frame *f, Lisp_Object *alistptr)
2892 Lisp_Object tem;
2893 uprintmax_t w;
2894 char buf[INT_BUFSIZE_BOUND (w)];
2896 /* Represent negative positions (off the top or left screen edge)
2897 in a way that Fmodify_frame_parameters will understand correctly. */
2898 XSETINT (tem, f->left_pos);
2899 if (f->left_pos >= 0)
2900 store_in_alist (alistptr, Qleft, tem);
2901 else
2902 store_in_alist (alistptr, Qleft, list2 (Qplus, tem));
2904 XSETINT (tem, f->top_pos);
2905 if (f->top_pos >= 0)
2906 store_in_alist (alistptr, Qtop, tem);
2907 else
2908 store_in_alist (alistptr, Qtop, list2 (Qplus, tem));
2910 store_in_alist (alistptr, Qborder_width,
2911 make_number (f->border_width));
2912 store_in_alist (alistptr, Qinternal_border_width,
2913 make_number (FRAME_INTERNAL_BORDER_WIDTH (f)));
2914 store_in_alist (alistptr, Qleft_fringe,
2915 make_number (FRAME_LEFT_FRINGE_WIDTH (f)));
2916 store_in_alist (alistptr, Qright_fringe,
2917 make_number (FRAME_RIGHT_FRINGE_WIDTH (f)));
2918 store_in_alist (alistptr, Qscroll_bar_width,
2919 (! FRAME_HAS_VERTICAL_SCROLL_BARS (f)
2920 ? make_number (0)
2921 : FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0
2922 ? make_number (FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
2923 /* nil means "use default width"
2924 for non-toolkit scroll bar.
2925 ruler-mode.el depends on this. */
2926 : Qnil));
2927 /* FRAME_X_WINDOW is not guaranteed to return an integer. E.g., on
2928 MS-Windows it returns a value whose type is HANDLE, which is
2929 actually a pointer. Explicit casting avoids compiler
2930 warnings. */
2931 w = (uintptr_t) FRAME_X_WINDOW (f);
2932 store_in_alist (alistptr, Qwindow_id,
2933 make_formatted_string (buf, "%"pMu, w));
2934 #ifdef HAVE_X_WINDOWS
2935 #ifdef USE_X_TOOLKIT
2936 /* Tooltip frame may not have this widget. */
2937 if (FRAME_X_OUTPUT (f)->widget)
2938 #endif
2939 w = (uintptr_t) FRAME_OUTER_WINDOW (f);
2940 store_in_alist (alistptr, Qouter_window_id,
2941 make_formatted_string (buf, "%"pMu, w));
2942 #endif
2943 store_in_alist (alistptr, Qicon_name, f->icon_name);
2944 store_in_alist (alistptr, Qvisibility,
2945 (FRAME_VISIBLE_P (f) ? Qt
2946 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
2947 store_in_alist (alistptr, Qdisplay,
2948 XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
2950 if (FRAME_X_OUTPUT (f)->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
2951 tem = Qnil;
2952 else
2953 tem = make_natnum ((uintptr_t) FRAME_X_OUTPUT (f)->parent_desc);
2954 store_in_alist (alistptr, Qexplicit_name, (f->explicit_name ? Qt : Qnil));
2955 store_in_alist (alistptr, Qparent_id, tem);
2956 store_in_alist (alistptr, Qtool_bar_position, f->tool_bar_position);
2960 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
2961 the previous value of that parameter, NEW_VALUE is the new value. */
2963 void
2964 x_set_fullscreen (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
2966 if (NILP (new_value))
2967 f->want_fullscreen = FULLSCREEN_NONE;
2968 else if (EQ (new_value, Qfullboth) || EQ (new_value, Qfullscreen))
2969 f->want_fullscreen = FULLSCREEN_BOTH;
2970 else if (EQ (new_value, Qfullwidth))
2971 f->want_fullscreen = FULLSCREEN_WIDTH;
2972 else if (EQ (new_value, Qfullheight))
2973 f->want_fullscreen = FULLSCREEN_HEIGHT;
2974 else if (EQ (new_value, Qmaximized))
2975 f->want_fullscreen = FULLSCREEN_MAXIMIZED;
2977 if (FRAME_TERMINAL (f)->fullscreen_hook != NULL)
2978 FRAME_TERMINAL (f)->fullscreen_hook (f);
2982 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
2983 the previous value of that parameter, NEW_VALUE is the new value. */
2985 void
2986 x_set_line_spacing (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
2988 if (NILP (new_value))
2989 f->extra_line_spacing = 0;
2990 else if (RANGED_INTEGERP (0, new_value, INT_MAX))
2991 f->extra_line_spacing = XFASTINT (new_value);
2992 else if (FLOATP (new_value))
2994 int new_spacing = XFLOAT_DATA (new_value) * FRAME_LINE_HEIGHT (f) + 0.5;
2996 if (new_spacing >= 0)
2997 f->extra_line_spacing = new_spacing;
2998 else
2999 signal_error ("Invalid line-spacing", new_value);
3001 else
3002 signal_error ("Invalid line-spacing", new_value);
3003 if (FRAME_VISIBLE_P (f))
3004 redraw_frame (f);
3008 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
3009 the previous value of that parameter, NEW_VALUE is the new value. */
3011 void
3012 x_set_screen_gamma (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3014 Lisp_Object bgcolor;
3016 if (NILP (new_value))
3017 f->gamma = 0;
3018 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
3019 /* The value 0.4545 is the normal viewing gamma. */
3020 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
3021 else
3022 signal_error ("Invalid screen-gamma", new_value);
3024 /* Apply the new gamma value to the frame background. */
3025 bgcolor = Fassq (Qbackground_color, f->param_alist);
3026 if (CONSP (bgcolor) && (bgcolor = XCDR (bgcolor), STRINGP (bgcolor)))
3028 Lisp_Object parm_index = Fget (Qbackground_color, Qx_frame_parameter);
3029 if (NATNUMP (parm_index)
3030 && (XFASTINT (parm_index)
3031 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3032 && FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
3033 (*FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
3034 (f, bgcolor, Qnil);
3037 Fclear_face_cache (Qnil);
3041 void
3042 x_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3044 Lisp_Object font_object;
3045 int fontset = -1;
3046 #ifdef HAVE_X_WINDOWS
3047 Lisp_Object font_param = arg;
3048 #endif
3050 /* Set the frame parameter back to the old value because we may
3051 fail to use ARG as the new parameter value. */
3052 store_frame_param (f, Qfont, oldval);
3054 /* ARG is a fontset name, a font name, a cons of fontset name and a
3055 font object, or a font object. In the last case, this function
3056 never fail. */
3057 if (STRINGP (arg))
3059 fontset = fs_query_fontset (arg, 0);
3060 if (fontset < 0)
3062 font_object = font_open_by_name (f, arg);
3063 if (NILP (font_object))
3064 error ("Font `%s' is not defined", SSDATA (arg));
3065 arg = AREF (font_object, FONT_NAME_INDEX);
3067 else if (fontset > 0)
3069 font_object = font_open_by_name (f, fontset_ascii (fontset));
3070 if (NILP (font_object))
3071 error ("Font `%s' is not defined", SDATA (arg));
3072 arg = AREF (font_object, FONT_NAME_INDEX);
3074 else
3075 error ("The default fontset can't be used for a frame font");
3077 else if (CONSP (arg) && STRINGP (XCAR (arg)) && FONT_OBJECT_P (XCDR (arg)))
3079 /* This is the case that the ASCII font of F's fontset XCAR
3080 (arg) is changed to the font XCDR (arg) by
3081 `set-fontset-font'. */
3082 fontset = fs_query_fontset (XCAR (arg), 0);
3083 if (fontset < 0)
3084 error ("Unknown fontset: %s", SDATA (XCAR (arg)));
3085 font_object = XCDR (arg);
3086 arg = AREF (font_object, FONT_NAME_INDEX);
3087 #ifdef HAVE_X_WINDOWS
3088 font_param = Ffont_get (font_object, QCname);
3089 #endif
3091 else if (FONT_OBJECT_P (arg))
3093 font_object = arg;
3094 #ifdef HAVE_X_WINDOWS
3095 font_param = Ffont_get (font_object, QCname);
3096 #endif
3097 /* This is to store the XLFD font name in the frame parameter for
3098 backward compatibility. We should store the font-object
3099 itself in the future. */
3100 arg = AREF (font_object, FONT_NAME_INDEX);
3101 fontset = FRAME_FONTSET (f);
3102 /* Check if we can use the current fontset. If not, set FONTSET
3103 to -1 to generate a new fontset from FONT-OBJECT. */
3104 if (fontset >= 0)
3106 Lisp_Object ascii_font = fontset_ascii (fontset);
3107 Lisp_Object spec = font_spec_from_name (ascii_font);
3109 if (NILP (spec))
3110 signal_error ("Invalid font name", ascii_font);
3112 if (! font_match_p (spec, font_object))
3113 fontset = -1;
3116 else
3117 signal_error ("Invalid font", arg);
3119 if (! NILP (Fequal (font_object, oldval)))
3120 return;
3122 x_new_font (f, font_object, fontset);
3123 store_frame_param (f, Qfont, arg);
3124 #ifdef HAVE_X_WINDOWS
3125 store_frame_param (f, Qfont_param, font_param);
3126 #endif
3127 /* Recalculate toolbar height. */
3128 f->n_tool_bar_rows = 0;
3129 /* Ensure we redraw it. */
3130 clear_current_matrices (f);
3132 recompute_basic_faces (f);
3134 do_pending_window_change (0);
3136 /* We used to call face-set-after-frame-default here, but it leads to
3137 recursive calls (since that function can set the `default' face's
3138 font which in turns changes the frame's `font' parameter).
3139 Also I don't know what this call is meant to do, but it seems the
3140 wrong way to do it anyway (it does a lot more work than what seems
3141 reasonable in response to a change to `font'). */
3145 void
3146 x_set_font_backend (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3148 if (! NILP (new_value)
3149 && !CONSP (new_value))
3151 char *p0, *p1;
3153 CHECK_STRING (new_value);
3154 p0 = p1 = SSDATA (new_value);
3155 new_value = Qnil;
3156 while (*p0)
3158 while (*p1 && ! c_isspace (*p1) && *p1 != ',') p1++;
3159 if (p0 < p1)
3160 new_value = Fcons (Fintern (make_string (p0, p1 - p0), Qnil),
3161 new_value);
3162 if (*p1)
3164 int c;
3166 while ((c = *++p1) && c_isspace (c));
3168 p0 = p1;
3170 new_value = Fnreverse (new_value);
3173 if (! NILP (old_value) && ! NILP (Fequal (old_value, new_value)))
3174 return;
3176 if (FRAME_FONT (f))
3177 free_all_realized_faces (Qnil);
3179 new_value = font_update_drivers (f, NILP (new_value) ? Qt : new_value);
3180 if (NILP (new_value))
3182 if (NILP (old_value))
3183 error ("No font backend available");
3184 font_update_drivers (f, old_value);
3185 error ("None of specified font backends are available");
3187 store_frame_param (f, Qfont_backend, new_value);
3189 if (FRAME_FONT (f))
3191 Lisp_Object frame;
3193 XSETFRAME (frame, f);
3194 x_set_font (f, Fframe_parameter (frame, Qfont), Qnil);
3195 ++face_change_count;
3196 ++windows_or_buffers_changed;
3201 void
3202 x_set_fringe_width (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3204 compute_fringe_widths (f, 1);
3205 #ifdef HAVE_X_WINDOWS
3206 /* Must adjust this so window managers report correct number of columns. */
3207 if (FRAME_X_WINDOW (f) != 0)
3208 x_wm_set_size_hint (f, 0, 0);
3209 #endif
3212 void
3213 x_set_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3215 CHECK_TYPE_RANGED_INTEGER (int, arg);
3217 if (XINT (arg) == f->border_width)
3218 return;
3220 if (FRAME_X_WINDOW (f) != 0)
3221 error ("Cannot change the border width of a frame");
3223 f->border_width = XINT (arg);
3226 void
3227 x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3229 int old = FRAME_INTERNAL_BORDER_WIDTH (f);
3231 CHECK_TYPE_RANGED_INTEGER (int, arg);
3232 FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
3233 if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
3234 FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
3236 #ifdef USE_X_TOOLKIT
3237 if (FRAME_X_OUTPUT (f)->edit_widget)
3238 widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
3239 #endif
3241 if (FRAME_INTERNAL_BORDER_WIDTH (f) == old)
3242 return;
3244 if (FRAME_X_WINDOW (f) != 0)
3246 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3247 SET_FRAME_GARBAGED (f);
3248 do_pending_window_change (0);
3250 else
3251 SET_FRAME_GARBAGED (f);
3254 void
3255 x_set_visibility (struct frame *f, Lisp_Object value, Lisp_Object oldval)
3257 Lisp_Object frame;
3258 XSETFRAME (frame, f);
3260 if (NILP (value))
3261 Fmake_frame_invisible (frame, Qt);
3262 else if (EQ (value, Qicon))
3263 Ficonify_frame (frame);
3264 else
3265 Fmake_frame_visible (frame);
3268 void
3269 x_set_autoraise (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3271 f->auto_raise = !EQ (Qnil, arg);
3274 void
3275 x_set_autolower (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3277 f->auto_lower = !EQ (Qnil, arg);
3280 void
3281 x_set_unsplittable (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3283 f->no_split = !NILP (arg);
3286 void
3287 x_set_vertical_scroll_bars (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3289 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
3290 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
3291 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
3292 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
3294 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
3295 = (NILP (arg)
3296 ? vertical_scroll_bar_none
3297 : EQ (Qleft, arg)
3298 ? vertical_scroll_bar_left
3299 : EQ (Qright, arg)
3300 ? vertical_scroll_bar_right
3301 : EQ (Qleft, Vdefault_frame_scroll_bars)
3302 ? vertical_scroll_bar_left
3303 : EQ (Qright, Vdefault_frame_scroll_bars)
3304 ? vertical_scroll_bar_right
3305 : vertical_scroll_bar_none);
3307 /* We set this parameter before creating the X window for the
3308 frame, so we can get the geometry right from the start.
3309 However, if the window hasn't been created yet, we shouldn't
3310 call x_set_window_size. */
3311 if (FRAME_X_WINDOW (f))
3312 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3313 do_pending_window_change (0);
3317 void
3318 x_set_scroll_bar_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3320 int wid = FRAME_COLUMN_WIDTH (f);
3322 if (NILP (arg))
3324 x_set_scroll_bar_default_width (f);
3326 if (FRAME_X_WINDOW (f))
3327 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3328 do_pending_window_change (0);
3330 else if (RANGED_INTEGERP (1, arg, INT_MAX)
3331 && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3333 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
3334 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
3336 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg);
3337 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
3338 if (FRAME_X_WINDOW (f))
3339 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3340 do_pending_window_change (0);
3343 change_frame_size (f, 0, FRAME_COLS (f), 0, 0, 0);
3344 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
3345 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
3350 /* Return non-nil if frame F wants a bitmap icon. */
3352 Lisp_Object
3353 x_icon_type (FRAME_PTR f)
3355 Lisp_Object tem;
3357 tem = assq_no_quit (Qicon_type, f->param_alist);
3358 if (CONSP (tem))
3359 return XCDR (tem);
3360 else
3361 return Qnil;
3364 void
3365 x_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3367 double alpha = 1.0;
3368 double newval[2];
3369 int i;
3370 Lisp_Object item;
3372 for (i = 0; i < 2; i++)
3374 newval[i] = 1.0;
3375 if (CONSP (arg))
3377 item = CAR (arg);
3378 arg = CDR (arg);
3380 else
3381 item = arg;
3383 if (NILP (item))
3384 alpha = - 1.0;
3385 else if (FLOATP (item))
3387 alpha = XFLOAT_DATA (item);
3388 if (! (0 <= alpha && alpha <= 1.0))
3389 args_out_of_range (make_float (0.0), make_float (1.0));
3391 else if (INTEGERP (item))
3393 EMACS_INT ialpha = XINT (item);
3394 if (! (0 <= ialpha && alpha <= 100))
3395 args_out_of_range (make_number (0), make_number (100));
3396 alpha = ialpha / 100.0;
3398 else
3399 wrong_type_argument (Qnumberp, item);
3400 newval[i] = alpha;
3403 for (i = 0; i < 2; i++)
3404 f->alpha[i] = newval[i];
3406 #if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA)
3407 block_input ();
3408 x_set_frame_alpha (f);
3409 unblock_input ();
3410 #endif
3412 return;
3416 /* Subroutines of creating an X frame. */
3418 /* Make sure that Vx_resource_name is set to a reasonable value.
3419 Fix it up, or set it to `emacs' if it is too hopeless. */
3421 void
3422 validate_x_resource_name (void)
3424 ptrdiff_t len = 0;
3425 /* Number of valid characters in the resource name. */
3426 ptrdiff_t good_count = 0;
3427 /* Number of invalid characters in the resource name. */
3428 ptrdiff_t bad_count = 0;
3429 Lisp_Object new;
3430 ptrdiff_t i;
3432 if (!STRINGP (Vx_resource_class))
3433 Vx_resource_class = build_string (EMACS_CLASS);
3435 if (STRINGP (Vx_resource_name))
3437 unsigned char *p = SDATA (Vx_resource_name);
3439 len = SBYTES (Vx_resource_name);
3441 /* Only letters, digits, - and _ are valid in resource names.
3442 Count the valid characters and count the invalid ones. */
3443 for (i = 0; i < len; i++)
3445 int c = p[i];
3446 if (! ((c >= 'a' && c <= 'z')
3447 || (c >= 'A' && c <= 'Z')
3448 || (c >= '0' && c <= '9')
3449 || c == '-' || c == '_'))
3450 bad_count++;
3451 else
3452 good_count++;
3455 else
3456 /* Not a string => completely invalid. */
3457 bad_count = 5, good_count = 0;
3459 /* If name is valid already, return. */
3460 if (bad_count == 0)
3461 return;
3463 /* If name is entirely invalid, or nearly so, or is so implausibly
3464 large that alloca might not work, use `emacs'. */
3465 if (good_count < 2 || MAX_ALLOCA - sizeof ".customization" < len)
3467 Vx_resource_name = build_string ("emacs");
3468 return;
3471 /* Name is partly valid. Copy it and replace the invalid characters
3472 with underscores. */
3474 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
3476 for (i = 0; i < len; i++)
3478 int c = SREF (new, i);
3479 if (! ((c >= 'a' && c <= 'z')
3480 || (c >= 'A' && c <= 'Z')
3481 || (c >= '0' && c <= '9')
3482 || c == '-' || c == '_'))
3483 SSET (new, i, '_');
3488 extern char *x_get_string_resource (XrmDatabase, const char *, const char *);
3489 extern Display_Info *check_x_display_info (Lisp_Object);
3492 /* Get specified attribute from resource database RDB.
3493 See Fx_get_resource below for other parameters. */
3495 static Lisp_Object
3496 xrdb_get_resource (XrmDatabase rdb, Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3498 register char *value;
3499 char *name_key;
3500 char *class_key;
3502 CHECK_STRING (attribute);
3503 CHECK_STRING (class);
3505 if (!NILP (component))
3506 CHECK_STRING (component);
3507 if (!NILP (subclass))
3508 CHECK_STRING (subclass);
3509 if (NILP (component) != NILP (subclass))
3510 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3512 validate_x_resource_name ();
3514 /* Allocate space for the components, the dots which separate them,
3515 and the final '\0'. Make them big enough for the worst case. */
3516 name_key = alloca (SBYTES (Vx_resource_name)
3517 + (STRINGP (component)
3518 ? SBYTES (component) : 0)
3519 + SBYTES (attribute)
3520 + 3);
3522 class_key = alloca (SBYTES (Vx_resource_class)
3523 + SBYTES (class)
3524 + (STRINGP (subclass)
3525 ? SBYTES (subclass) : 0)
3526 + 3);
3528 /* Start with emacs.FRAMENAME for the name (the specific one)
3529 and with `Emacs' for the class key (the general one). */
3530 strcpy (name_key, SSDATA (Vx_resource_name));
3531 strcpy (class_key, SSDATA (Vx_resource_class));
3533 strcat (class_key, ".");
3534 strcat (class_key, SSDATA (class));
3536 if (!NILP (component))
3538 strcat (class_key, ".");
3539 strcat (class_key, SSDATA (subclass));
3541 strcat (name_key, ".");
3542 strcat (name_key, SSDATA (component));
3545 strcat (name_key, ".");
3546 strcat (name_key, SSDATA (attribute));
3548 value = x_get_string_resource (rdb, name_key, class_key);
3550 if (value != (char *) 0 && *value)
3551 return build_string (value);
3552 else
3553 return Qnil;
3557 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
3558 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
3559 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
3560 class, where INSTANCE is the name under which Emacs was invoked, or
3561 the name specified by the `-name' or `-rn' command-line arguments.
3563 The optional arguments COMPONENT and SUBCLASS add to the key and the
3564 class, respectively. You must specify both of them or neither.
3565 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
3566 and the class is `Emacs.CLASS.SUBCLASS'. */)
3567 (Lisp_Object attribute, Lisp_Object class, Lisp_Object component,
3568 Lisp_Object subclass)
3570 check_window_system (NULL);
3572 return xrdb_get_resource (check_x_display_info (Qnil)->xrdb,
3573 attribute, class, component, subclass);
3576 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
3578 Lisp_Object
3579 display_x_get_resource (Display_Info *dpyinfo, Lisp_Object attribute,
3580 Lisp_Object class, Lisp_Object component,
3581 Lisp_Object subclass)
3583 return xrdb_get_resource (dpyinfo->xrdb,
3584 attribute, class, component, subclass);
3587 #if defined HAVE_X_WINDOWS && !defined USE_X_TOOLKIT
3588 /* Used when C code wants a resource value. */
3589 /* Called from oldXMenu/Create.c. */
3590 char *
3591 x_get_resource_string (const char *attribute, const char *class)
3593 char *result;
3594 struct frame *sf = SELECTED_FRAME ();
3595 ptrdiff_t invocation_namelen = SBYTES (Vinvocation_name);
3596 USE_SAFE_ALLOCA;
3598 /* Allocate space for the components, the dots which separate them,
3599 and the final '\0'. */
3600 char *name_key = SAFE_ALLOCA (invocation_namelen + strlen (attribute) + 2);
3601 char *class_key = alloca ((sizeof (EMACS_CLASS) - 1) + strlen (class) + 2);
3603 esprintf (name_key, "%s.%s", SSDATA (Vinvocation_name), attribute);
3604 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3606 result = x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
3607 name_key, class_key);
3608 SAFE_FREE ();
3609 return result;
3611 #endif
3613 /* Return the value of parameter PARAM.
3615 First search ALIST, then Vdefault_frame_alist, then the X defaults
3616 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3618 Convert the resource to the type specified by desired_type.
3620 If no default is specified, return Qunbound. If you call
3621 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3622 and don't let it get stored in any Lisp-visible variables! */
3624 Lisp_Object
3625 x_get_arg (Display_Info *dpyinfo, Lisp_Object alist, Lisp_Object param,
3626 const char *attribute, const char *class, enum resource_types type)
3628 register Lisp_Object tem;
3630 tem = Fassq (param, alist);
3632 if (!NILP (tem))
3634 /* If we find this parm in ALIST, clear it out
3635 so that it won't be "left over" at the end. */
3636 Lisp_Object tail;
3637 XSETCAR (tem, Qnil);
3638 /* In case the parameter appears more than once in the alist,
3639 clear it out. */
3640 for (tail = alist; CONSP (tail); tail = XCDR (tail))
3641 if (CONSP (XCAR (tail))
3642 && EQ (XCAR (XCAR (tail)), param))
3643 XSETCAR (XCAR (tail), Qnil);
3645 else
3646 tem = Fassq (param, Vdefault_frame_alist);
3648 /* If it wasn't specified in ALIST or the Lisp-level defaults,
3649 look in the X resources. */
3650 if (EQ (tem, Qnil))
3652 if (attribute && dpyinfo)
3654 tem = display_x_get_resource (dpyinfo,
3655 build_string (attribute),
3656 build_string (class),
3657 Qnil, Qnil);
3659 if (NILP (tem))
3660 return Qunbound;
3662 switch (type)
3664 case RES_TYPE_NUMBER:
3665 return make_number (atoi (SSDATA (tem)));
3667 case RES_TYPE_BOOLEAN_NUMBER:
3668 if (!strcmp (SSDATA (tem), "on")
3669 || !strcmp (SSDATA (tem), "true"))
3670 return make_number (1);
3671 return make_number (atoi (SSDATA (tem)));
3672 break;
3674 case RES_TYPE_FLOAT:
3675 return make_float (atof (SSDATA (tem)));
3677 case RES_TYPE_BOOLEAN:
3678 tem = Fdowncase (tem);
3679 if (!strcmp (SSDATA (tem), "on")
3680 #ifdef HAVE_NS
3681 || !strcmp (SSDATA (tem), "yes")
3682 #endif
3683 || !strcmp (SSDATA (tem), "true"))
3684 return Qt;
3685 else
3686 return Qnil;
3688 case RES_TYPE_STRING:
3689 return tem;
3691 case RES_TYPE_SYMBOL:
3692 /* As a special case, we map the values `true' and `on'
3693 to Qt, and `false' and `off' to Qnil. */
3695 Lisp_Object lower;
3696 lower = Fdowncase (tem);
3697 if (!strcmp (SSDATA (lower), "on")
3698 #ifdef HAVE_NS
3699 || !strcmp (SSDATA (lower), "yes")
3700 #endif
3701 || !strcmp (SSDATA (lower), "true"))
3702 return Qt;
3703 else if (!strcmp (SSDATA (lower), "off")
3704 #ifdef HAVE_NS
3705 || !strcmp (SSDATA (lower), "no")
3706 #endif
3707 || !strcmp (SSDATA (lower), "false"))
3708 return Qnil;
3709 else
3710 return Fintern (tem, Qnil);
3713 default:
3714 emacs_abort ();
3717 else
3718 return Qunbound;
3720 return Fcdr (tem);
3723 static Lisp_Object
3724 x_frame_get_arg (struct frame *f, Lisp_Object alist, Lisp_Object param,
3725 const char *attribute, const char *class,
3726 enum resource_types type)
3728 return x_get_arg (FRAME_X_DISPLAY_INFO (f),
3729 alist, param, attribute, class, type);
3732 /* Like x_frame_get_arg, but also record the value in f->param_alist. */
3734 Lisp_Object
3735 x_frame_get_and_record_arg (struct frame *f, Lisp_Object alist,
3736 Lisp_Object param,
3737 const char *attribute, const char *class,
3738 enum resource_types type)
3740 Lisp_Object value;
3742 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
3743 attribute, class, type);
3744 if (! NILP (value) && ! EQ (value, Qunbound))
3745 store_frame_param (f, param, value);
3747 return value;
3751 /* Record in frame F the specified or default value according to ALIST
3752 of the parameter named PROP (a Lisp symbol).
3753 If no value is specified for PROP, look for an X default for XPROP
3754 on the frame named NAME.
3755 If that is not found either, use the value DEFLT. */
3757 Lisp_Object
3758 x_default_parameter (struct frame *f, Lisp_Object alist, Lisp_Object prop,
3759 Lisp_Object deflt, const char *xprop, const char *xclass,
3760 enum resource_types type)
3762 Lisp_Object tem;
3764 tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type);
3765 if (EQ (tem, Qunbound))
3766 tem = deflt;
3767 x_set_frame_parameters (f, list1 (Fcons (prop, tem)));
3768 return tem;
3772 #if !defined (HAVE_X_WINDOWS) && defined (NoValue)
3775 * XParseGeometry parses strings of the form
3776 * "=<width>x<height>{+-}<xoffset>{+-}<yoffset>", where
3777 * width, height, xoffset, and yoffset are unsigned integers.
3778 * Example: "=80x24+300-49"
3779 * The equal sign is optional.
3780 * It returns a bitmask that indicates which of the four values
3781 * were actually found in the string. For each value found,
3782 * the corresponding argument is updated; for each value
3783 * not found, the corresponding argument is left unchanged.
3786 static int
3787 XParseGeometry (char *string,
3788 int *x, int *y,
3789 unsigned int *width, unsigned int *height)
3791 int mask = NoValue;
3792 char *strind;
3793 unsigned long int tempWidth, tempHeight;
3794 long int tempX, tempY;
3795 char *nextCharacter;
3797 if (string == NULL || *string == '\0')
3798 return mask;
3799 if (*string == '=')
3800 string++; /* ignore possible '=' at beg of geometry spec */
3802 strind = string;
3803 if (*strind != '+' && *strind != '-' && *strind != 'x')
3805 tempWidth = strtoul (strind, &nextCharacter, 10);
3806 if (strind == nextCharacter)
3807 return 0;
3808 strind = nextCharacter;
3809 mask |= WidthValue;
3812 if (*strind == 'x' || *strind == 'X')
3814 strind++;
3815 tempHeight = strtoul (strind, &nextCharacter, 10);
3816 if (strind == nextCharacter)
3817 return 0;
3818 strind = nextCharacter;
3819 mask |= HeightValue;
3822 if (*strind == '+' || *strind == '-')
3824 if (*strind == '-')
3825 mask |= XNegative;
3826 tempX = strtol (strind, &nextCharacter, 10);
3827 if (strind == nextCharacter)
3828 return 0;
3829 strind = nextCharacter;
3830 mask |= XValue;
3831 if (*strind == '+' || *strind == '-')
3833 if (*strind == '-')
3834 mask |= YNegative;
3835 tempY = strtol (strind, &nextCharacter, 10);
3836 if (strind == nextCharacter)
3837 return 0;
3838 strind = nextCharacter;
3839 mask |= YValue;
3843 /* If strind isn't at the end of the string then it's an invalid
3844 geometry specification. */
3846 if (*strind != '\0')
3847 return 0;
3849 if (mask & XValue)
3850 *x = clip_to_bounds (INT_MIN, tempX, INT_MAX);
3851 if (mask & YValue)
3852 *y = clip_to_bounds (INT_MIN, tempY, INT_MAX);
3853 if (mask & WidthValue)
3854 *width = min (tempWidth, UINT_MAX);
3855 if (mask & HeightValue)
3856 *height = min (tempHeight, UINT_MAX);
3857 return mask;
3860 #endif /* !defined (HAVE_X_WINDOWS) && defined (NoValue) */
3863 /* NS used to define x-parse-geometry in ns-win.el, but that confused
3864 make-docfile: the documentation string in ns-win.el was used for
3865 x-parse-geometry even in non-NS builds.
3867 With two definitions of x-parse-geometry in this file, various
3868 things still get confused (eg M-x apropos documentation), so that
3869 it is best if the two definitions just share the same doc-string.
3871 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
3872 doc: /* Parse a display geometry string STRING.
3873 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3874 The properties returned may include `top', `left', `height', and `width'.
3875 For X, the value of `left' or `top' may be an integer,
3876 or a list (+ N) meaning N pixels relative to top/left corner,
3877 or a list (- N) meaning -N pixels relative to bottom/right corner.
3878 On Nextstep, this just calls `ns-parse-geometry'. */)
3879 (Lisp_Object string)
3881 int geometry, x, y;
3882 unsigned int width, height;
3883 Lisp_Object result;
3885 CHECK_STRING (string);
3887 #ifdef HAVE_NS
3888 if (strchr (SSDATA (string), ' ') != NULL)
3889 return call1 (Qns_parse_geometry, string);
3890 #endif
3891 geometry = XParseGeometry (SSDATA (string),
3892 &x, &y, &width, &height);
3893 result = Qnil;
3894 if (geometry & XValue)
3896 Lisp_Object element;
3898 if (x >= 0 && (geometry & XNegative))
3899 element = list3 (Qleft, Qminus, make_number (-x));
3900 else if (x < 0 && ! (geometry & XNegative))
3901 element = list3 (Qleft, Qplus, make_number (x));
3902 else
3903 element = Fcons (Qleft, make_number (x));
3904 result = Fcons (element, result);
3907 if (geometry & YValue)
3909 Lisp_Object element;
3911 if (y >= 0 && (geometry & YNegative))
3912 element = list3 (Qtop, Qminus, make_number (-y));
3913 else if (y < 0 && ! (geometry & YNegative))
3914 element = list3 (Qtop, Qplus, make_number (y));
3915 else
3916 element = Fcons (Qtop, make_number (y));
3917 result = Fcons (element, result);
3920 if (geometry & WidthValue)
3921 result = Fcons (Fcons (Qwidth, make_number (width)), result);
3922 if (geometry & HeightValue)
3923 result = Fcons (Fcons (Qheight, make_number (height)), result);
3925 return result;
3929 /* Calculate the desired size and position of frame F.
3930 Return the flags saying which aspects were specified.
3932 Also set the win_gravity and size_hint_flags of F.
3934 Adjust height for toolbar if TOOLBAR_P is 1.
3936 This function does not make the coordinates positive. */
3938 #define DEFAULT_ROWS 35
3939 #define DEFAULT_COLS 80
3942 x_figure_window_size (struct frame *f, Lisp_Object parms, int toolbar_p)
3944 register Lisp_Object tem0, tem1, tem2;
3945 long window_prompting = 0;
3946 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3948 /* Default values if we fall through.
3949 Actually, if that happens we should get
3950 window manager prompting. */
3951 SET_FRAME_COLS (f, DEFAULT_COLS);
3952 FRAME_LINES (f) = DEFAULT_ROWS;
3953 /* Window managers expect that if program-specified
3954 positions are not (0,0), they're intentional, not defaults. */
3955 f->top_pos = 0;
3956 f->left_pos = 0;
3958 /* Ensure that old new_text_cols and new_text_lines will not override the
3959 values set here. */
3960 /* ++KFS: This was specific to W32, but seems ok for all platforms */
3961 f->new_text_cols = f->new_text_lines = 0;
3963 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
3964 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
3965 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
3966 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3968 if (!EQ (tem0, Qunbound))
3970 CHECK_NUMBER (tem0);
3971 if (! (0 <= XINT (tem0) && XINT (tem0) <= INT_MAX))
3972 xsignal1 (Qargs_out_of_range, tem0);
3973 FRAME_LINES (f) = XINT (tem0);
3975 if (!EQ (tem1, Qunbound))
3977 CHECK_NUMBER (tem1);
3978 if (! (0 <= XINT (tem1) && XINT (tem1) <= INT_MAX))
3979 xsignal1 (Qargs_out_of_range, tem1);
3980 SET_FRAME_COLS (f, XINT (tem1));
3982 if (!NILP (tem2) && !EQ (tem2, Qunbound))
3983 window_prompting |= USSize;
3984 else
3985 window_prompting |= PSize;
3988 f->scroll_bar_actual_width
3989 = FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f);
3991 /* This used to be done _before_ calling x_figure_window_size, but
3992 since the height is reset here, this was really a no-op. I
3993 assume that moving it here does what Gerd intended (although he
3994 no longer can remember what that was... ++KFS, 2003-03-25. */
3996 /* Add the tool-bar height to the initial frame height so that the
3997 user gets a text display area of the size he specified with -g or
3998 via .Xdefaults. Later changes of the tool-bar height don't
3999 change the frame size. This is done so that users can create
4000 tall Emacs frames without having to guess how tall the tool-bar
4001 will get. */
4002 if (toolbar_p && FRAME_TOOL_BAR_LINES (f))
4004 int margin, relief, bar_height;
4006 relief = (tool_bar_button_relief >= 0
4007 ? tool_bar_button_relief
4008 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
4010 if (RANGED_INTEGERP (1, Vtool_bar_button_margin, INT_MAX))
4011 margin = XFASTINT (Vtool_bar_button_margin);
4012 else if (CONSP (Vtool_bar_button_margin)
4013 && RANGED_INTEGERP (1, XCDR (Vtool_bar_button_margin), INT_MAX))
4014 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
4015 else
4016 margin = 0;
4018 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
4019 FRAME_LINES (f) += (bar_height + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f);
4022 compute_fringe_widths (f, 0);
4024 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, FRAME_COLS (f));
4025 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, FRAME_LINES (f));
4027 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
4028 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
4029 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
4030 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4032 if (EQ (tem0, Qminus))
4034 f->top_pos = 0;
4035 window_prompting |= YNegative;
4037 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
4038 && CONSP (XCDR (tem0))
4039 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (tem0)), INT_MAX))
4041 f->top_pos = - XINT (XCAR (XCDR (tem0)));
4042 window_prompting |= YNegative;
4044 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
4045 && CONSP (XCDR (tem0))
4046 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (tem0))))
4048 f->top_pos = XINT (XCAR (XCDR (tem0)));
4050 else if (EQ (tem0, Qunbound))
4051 f->top_pos = 0;
4052 else
4054 CHECK_TYPE_RANGED_INTEGER (int, tem0);
4055 f->top_pos = XINT (tem0);
4056 if (f->top_pos < 0)
4057 window_prompting |= YNegative;
4060 if (EQ (tem1, Qminus))
4062 f->left_pos = 0;
4063 window_prompting |= XNegative;
4065 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
4066 && CONSP (XCDR (tem1))
4067 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (tem1)), INT_MAX))
4069 f->left_pos = - XINT (XCAR (XCDR (tem1)));
4070 window_prompting |= XNegative;
4072 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
4073 && CONSP (XCDR (tem1))
4074 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (tem1))))
4076 f->left_pos = XINT (XCAR (XCDR (tem1)));
4078 else if (EQ (tem1, Qunbound))
4079 f->left_pos = 0;
4080 else
4082 CHECK_TYPE_RANGED_INTEGER (int, tem1);
4083 f->left_pos = XINT (tem1);
4084 if (f->left_pos < 0)
4085 window_prompting |= XNegative;
4088 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
4089 window_prompting |= USPosition;
4090 else
4091 window_prompting |= PPosition;
4094 if (window_prompting & XNegative)
4096 if (window_prompting & YNegative)
4097 f->win_gravity = SouthEastGravity;
4098 else
4099 f->win_gravity = NorthEastGravity;
4101 else
4103 if (window_prompting & YNegative)
4104 f->win_gravity = SouthWestGravity;
4105 else
4106 f->win_gravity = NorthWestGravity;
4109 f->size_hint_flags = window_prompting;
4111 return window_prompting;
4116 #endif /* HAVE_WINDOW_SYSTEM */
4118 void
4119 frame_make_pointer_invisible (void)
4121 if (! NILP (Vmake_pointer_invisible))
4123 struct frame *f;
4124 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4125 return;
4127 f = SELECTED_FRAME ();
4128 if (f && !f->pointer_invisible
4129 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4131 f->mouse_moved = 0;
4132 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 1);
4133 f->pointer_invisible = 1;
4138 void
4139 frame_make_pointer_visible (void)
4141 /* We don't check Vmake_pointer_invisible here in case the
4142 pointer was invisible when Vmake_pointer_invisible was set to nil. */
4143 struct frame *f;
4145 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4146 return;
4148 f = SELECTED_FRAME ();
4149 if (f && f->pointer_invisible && f->mouse_moved
4150 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4152 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 0);
4153 f->pointer_invisible = 0;
4157 DEFUN ("frame-pointer-visible-p", Fframe_pointer_visible_p,
4158 Sframe_pointer_visible_p, 0, 1, 0,
4159 doc: /* Return t if the mouse pointer displayed on FRAME is visible.
4160 Otherwise it returns nil. FRAME omitted or nil means the
4161 selected frame. This is useful when `make-pointer-invisible' is set. */)
4162 (Lisp_Object frame)
4164 return decode_any_frame (frame)->pointer_invisible ? Qnil : Qt;
4169 /***********************************************************************
4170 Multimonitor data
4171 ***********************************************************************/
4173 #ifdef HAVE_WINDOW_SYSTEM
4175 # if (defined HAVE_NS \
4176 || (!defined USE_GTK && (defined HAVE_XINERAMA || defined HAVE_XRANDR)))
4177 void
4178 free_monitors (struct MonitorInfo *monitors, int n_monitors)
4180 int i;
4181 for (i = 0; i < n_monitors; ++i)
4182 xfree (monitors[i].name);
4183 xfree (monitors);
4185 # endif
4187 Lisp_Object
4188 make_monitor_attribute_list (struct MonitorInfo *monitors,
4189 int n_monitors,
4190 int primary_monitor,
4191 Lisp_Object monitor_frames,
4192 const char *source)
4194 Lisp_Object attributes_list = Qnil;
4195 Lisp_Object primary_monitor_attributes = Qnil;
4196 int i;
4198 for (i = 0; i < n_monitors; ++i)
4200 Lisp_Object geometry, workarea, attributes = Qnil;
4201 struct MonitorInfo *mi = &monitors[i];
4203 if (mi->geom.width == 0) continue;
4205 workarea = list4i (mi->work.x, mi->work.y,
4206 mi->work.width, mi->work.height);
4207 geometry = list4i (mi->geom.x, mi->geom.y,
4208 mi->geom.width, mi->geom.height);
4209 attributes = Fcons (Fcons (Qsource,
4210 make_string (source, strlen (source))),
4211 attributes);
4212 attributes = Fcons (Fcons (Qframes, AREF (monitor_frames, i)),
4213 attributes);
4214 attributes = Fcons (Fcons (Qmm_size,
4215 list2i (mi->mm_width, mi->mm_height)),
4216 attributes);
4217 attributes = Fcons (Fcons (Qworkarea, workarea), attributes);
4218 attributes = Fcons (Fcons (Qgeometry, geometry), attributes);
4219 if (mi->name)
4220 attributes = Fcons (Fcons (Qname, make_string (mi->name,
4221 strlen (mi->name))),
4222 attributes);
4224 if (i == primary_monitor)
4225 primary_monitor_attributes = attributes;
4226 else
4227 attributes_list = Fcons (attributes, attributes_list);
4230 if (!NILP (primary_monitor_attributes))
4231 attributes_list = Fcons (primary_monitor_attributes, attributes_list);
4232 return attributes_list;
4235 #endif /* HAVE_WINDOW_SYSTEM */
4238 /***********************************************************************
4239 Initialization
4240 ***********************************************************************/
4242 void
4243 syms_of_frame (void)
4245 DEFSYM (Qframep, "framep");
4246 DEFSYM (Qframe_live_p, "frame-live-p");
4247 DEFSYM (Qexplicit_name, "explicit-name");
4248 DEFSYM (Qheight, "height");
4249 DEFSYM (Qicon, "icon");
4250 DEFSYM (Qminibuffer, "minibuffer");
4251 DEFSYM (Qmodeline, "modeline");
4252 DEFSYM (Qonly, "only");
4253 DEFSYM (Qnone, "none");
4254 DEFSYM (Qwidth, "width");
4255 DEFSYM (Qgeometry, "geometry");
4256 DEFSYM (Qicon_left, "icon-left");
4257 DEFSYM (Qicon_top, "icon-top");
4258 DEFSYM (Qtooltip, "tooltip");
4259 DEFSYM (Qleft, "left");
4260 DEFSYM (Qright, "right");
4261 DEFSYM (Quser_position, "user-position");
4262 DEFSYM (Quser_size, "user-size");
4263 DEFSYM (Qwindow_id, "window-id");
4264 #ifdef HAVE_X_WINDOWS
4265 DEFSYM (Qouter_window_id, "outer-window-id");
4266 #endif
4267 DEFSYM (Qparent_id, "parent-id");
4268 DEFSYM (Qx, "x");
4269 DEFSYM (Qw32, "w32");
4270 DEFSYM (Qpc, "pc");
4271 DEFSYM (Qns, "ns");
4272 DEFSYM (Qvisible, "visible");
4273 DEFSYM (Qbuffer_predicate, "buffer-predicate");
4274 DEFSYM (Qbuffer_list, "buffer-list");
4275 DEFSYM (Qburied_buffer_list, "buried-buffer-list");
4276 DEFSYM (Qdisplay_type, "display-type");
4277 DEFSYM (Qbackground_mode, "background-mode");
4278 DEFSYM (Qnoelisp, "noelisp");
4279 DEFSYM (Qtty_color_mode, "tty-color-mode");
4280 DEFSYM (Qtty, "tty");
4281 DEFSYM (Qtty_type, "tty-type");
4283 DEFSYM (Qface_set_after_frame_default, "face-set-after-frame-default");
4285 DEFSYM (Qfullwidth, "fullwidth");
4286 DEFSYM (Qfullheight, "fullheight");
4287 DEFSYM (Qfullboth, "fullboth");
4288 DEFSYM (Qmaximized, "maximized");
4289 DEFSYM (Qx_resource_name, "x-resource-name");
4290 DEFSYM (Qx_frame_parameter, "x-frame-parameter");
4292 DEFSYM (Qterminal, "terminal");
4293 DEFSYM (Qterminal_live_p, "terminal-live-p");
4295 DEFSYM (Qgeometry, "geometry");
4296 DEFSYM (Qworkarea, "workarea");
4297 DEFSYM (Qmm_size, "mm-size");
4298 DEFSYM (Qframes, "frames");
4299 DEFSYM (Qsource, "source");
4301 #ifdef HAVE_NS
4302 DEFSYM (Qns_parse_geometry, "ns-parse-geometry");
4303 #endif
4306 int i;
4308 for (i = 0; i < sizeof (frame_parms) / sizeof (frame_parms[0]); i++)
4310 Lisp_Object v = intern_c_string (frame_parms[i].name);
4311 if (frame_parms[i].variable)
4313 *frame_parms[i].variable = v;
4314 staticpro (frame_parms[i].variable);
4316 Fput (v, Qx_frame_parameter, make_number (i));
4320 #ifdef HAVE_WINDOW_SYSTEM
4321 DEFVAR_LISP ("x-resource-name", Vx_resource_name,
4322 doc: /* The name Emacs uses to look up X resources.
4323 `x-get-resource' uses this as the first component of the instance name
4324 when requesting resource values.
4325 Emacs initially sets `x-resource-name' to the name under which Emacs
4326 was invoked, or to the value specified with the `-name' or `-rn'
4327 switches, if present.
4329 It may be useful to bind this variable locally around a call
4330 to `x-get-resource'. See also the variable `x-resource-class'. */);
4331 Vx_resource_name = Qnil;
4333 DEFVAR_LISP ("x-resource-class", Vx_resource_class,
4334 doc: /* The class Emacs uses to look up X resources.
4335 `x-get-resource' uses this as the first component of the instance class
4336 when requesting resource values.
4338 Emacs initially sets `x-resource-class' to "Emacs".
4340 Setting this variable permanently is not a reasonable thing to do,
4341 but binding this variable locally around a call to `x-get-resource'
4342 is a reasonable practice. See also the variable `x-resource-name'. */);
4343 Vx_resource_class = build_string (EMACS_CLASS);
4345 DEFVAR_LISP ("frame-alpha-lower-limit", Vframe_alpha_lower_limit,
4346 doc: /* The lower limit of the frame opacity (alpha transparency).
4347 The value should range from 0 (invisible) to 100 (completely opaque).
4348 You can also use a floating number between 0.0 and 1.0.
4349 The default is 20. */);
4350 Vframe_alpha_lower_limit = make_number (20);
4351 #endif
4353 DEFVAR_LISP ("default-frame-alist", Vdefault_frame_alist,
4354 doc: /* Alist of default values for frame creation.
4355 These may be set in your init file, like this:
4356 (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1)))
4357 These override values given in window system configuration data,
4358 including X Windows' defaults database.
4359 For values specific to the first Emacs frame, see `initial-frame-alist'.
4360 For window-system specific values, see `window-system-default-frame-alist'.
4361 For values specific to the separate minibuffer frame, see
4362 `minibuffer-frame-alist'.
4363 The `menu-bar-lines' element of the list controls whether new frames
4364 have menu bars; `menu-bar-mode' works by altering this element.
4365 Setting this variable does not affect existing frames, only new ones. */);
4366 Vdefault_frame_alist = Qnil;
4368 DEFVAR_LISP ("default-frame-scroll-bars", Vdefault_frame_scroll_bars,
4369 doc: /* Default position of scroll bars on this window-system. */);
4370 #ifdef HAVE_WINDOW_SYSTEM
4371 #if defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA) || (defined (USE_GTK) && defined (USE_TOOLKIT_SCROLL_BARS))
4372 /* MS-Windows, Mac OS X, and GTK have scroll bars on the right by
4373 default. */
4374 Vdefault_frame_scroll_bars = Qright;
4375 #else
4376 Vdefault_frame_scroll_bars = Qleft;
4377 #endif
4378 #else
4379 Vdefault_frame_scroll_bars = Qnil;
4380 #endif
4382 DEFVAR_BOOL ("scroll-bar-adjust-thumb-portion",
4383 scroll_bar_adjust_thumb_portion_p,
4384 doc: /* Adjust thumb for overscrolling for Gtk+ and MOTIF.
4385 Non-nil means adjust the thumb in the scroll bar so it can be dragged downwards
4386 even if the end of the buffer is shown (i.e. overscrolling).
4387 Set to nil if you want the thumb to be at the bottom when the end of the buffer
4388 is shown. Also, the thumb fills the whole scroll bar when the entire buffer
4389 is visible. In this case you can not overscroll. */);
4390 scroll_bar_adjust_thumb_portion_p = 1;
4392 DEFVAR_LISP ("terminal-frame", Vterminal_frame,
4393 doc: /* The initial frame-object, which represents Emacs's stdout. */);
4395 DEFVAR_LISP ("mouse-position-function", Vmouse_position_function,
4396 doc: /* If non-nil, function to transform normal value of `mouse-position'.
4397 `mouse-position' calls this function, passing its usual return value as
4398 argument, and returns whatever this function returns.
4399 This abnormal hook exists for the benefit of packages like `xt-mouse.el'
4400 which need to do mouse handling at the Lisp level. */);
4401 Vmouse_position_function = Qnil;
4403 DEFVAR_LISP ("mouse-highlight", Vmouse_highlight,
4404 doc: /* If non-nil, clickable text is highlighted when mouse is over it.
4405 If the value is an integer, highlighting is only shown after moving the
4406 mouse, while keyboard input turns off the highlight even when the mouse
4407 is over the clickable text. However, the mouse shape still indicates
4408 when the mouse is over clickable text. */);
4409 Vmouse_highlight = Qt;
4411 DEFVAR_LISP ("make-pointer-invisible", Vmake_pointer_invisible,
4412 doc: /* If non-nil, make pointer invisible while typing.
4413 The pointer becomes visible again when the mouse is moved. */);
4414 Vmake_pointer_invisible = Qt;
4416 DEFVAR_LISP ("delete-frame-functions", Vdelete_frame_functions,
4417 doc: /* Functions run before deleting a frame.
4418 The functions are run with one arg, the frame to be deleted.
4419 See `delete-frame'.
4421 Note that functions in this list may be called just before the frame is
4422 actually deleted, or some time later (or even both when an earlier function
4423 in `delete-frame-functions' (indirectly) calls `delete-frame'
4424 recursively). */);
4425 Vdelete_frame_functions = Qnil;
4426 DEFSYM (Qdelete_frame_functions, "delete-frame-functions");
4428 DEFVAR_LISP ("menu-bar-mode", Vmenu_bar_mode,
4429 doc: /* Non-nil if Menu-Bar mode is enabled.
4430 See the command `menu-bar-mode' for a description of this minor mode.
4431 Setting this variable directly does not take effect;
4432 either customize it (see the info node `Easy Customization')
4433 or call the function `menu-bar-mode'. */);
4434 Vmenu_bar_mode = Qt;
4436 DEFVAR_LISP ("tool-bar-mode", Vtool_bar_mode,
4437 doc: /* Non-nil if Tool-Bar mode is enabled.
4438 See the command `tool-bar-mode' for a description of this minor mode.
4439 Setting this variable directly does not take effect;
4440 either customize it (see the info node `Easy Customization')
4441 or call the function `tool-bar-mode'. */);
4442 #ifdef HAVE_WINDOW_SYSTEM
4443 Vtool_bar_mode = Qt;
4444 #else
4445 Vtool_bar_mode = Qnil;
4446 #endif
4448 DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
4449 doc: /* Minibufferless frames use this frame's minibuffer.
4451 Emacs cannot create minibufferless frames unless this is set to an
4452 appropriate surrogate.
4454 Emacs consults this variable only when creating minibufferless
4455 frames; once the frame is created, it sticks with its assigned
4456 minibuffer, no matter what this variable is set to. This means that
4457 this variable doesn't necessarily say anything meaningful about the
4458 current set of frames, or where the minibuffer is currently being
4459 displayed.
4461 This variable is local to the current terminal and cannot be buffer-local. */);
4463 DEFVAR_BOOL ("focus-follows-mouse", focus_follows_mouse,
4464 doc: /* Non-nil if window system changes focus when you move the mouse.
4465 You should set this variable to tell Emacs how your window manager
4466 handles focus, since there is no way in general for Emacs to find out
4467 automatically. See also `mouse-autoselect-window'. */);
4468 focus_follows_mouse = 0;
4470 staticpro (&Vframe_list);
4472 defsubr (&Sframep);
4473 defsubr (&Sframe_live_p);
4474 defsubr (&Swindow_system);
4475 defsubr (&Smake_terminal_frame);
4476 defsubr (&Shandle_switch_frame);
4477 defsubr (&Shandle_focus_in);
4478 defsubr (&Shandle_focus_out);
4479 defsubr (&Sselect_frame);
4480 defsubr (&Sselected_frame);
4481 defsubr (&Sframe_list);
4482 defsubr (&Snext_frame);
4483 defsubr (&Sprevious_frame);
4484 defsubr (&Sdelete_frame);
4485 defsubr (&Smouse_position);
4486 defsubr (&Smouse_pixel_position);
4487 defsubr (&Sset_mouse_position);
4488 defsubr (&Sset_mouse_pixel_position);
4489 #if 0
4490 defsubr (&Sframe_configuration);
4491 defsubr (&Srestore_frame_configuration);
4492 #endif
4493 defsubr (&Smake_frame_visible);
4494 defsubr (&Smake_frame_invisible);
4495 defsubr (&Siconify_frame);
4496 defsubr (&Sframe_visible_p);
4497 defsubr (&Svisible_frame_list);
4498 defsubr (&Sraise_frame);
4499 defsubr (&Slower_frame);
4500 defsubr (&Sredirect_frame_focus);
4501 defsubr (&Sframe_focus);
4502 defsubr (&Sframe_parameters);
4503 defsubr (&Sframe_parameter);
4504 defsubr (&Smodify_frame_parameters);
4505 defsubr (&Sframe_char_height);
4506 defsubr (&Sframe_char_width);
4507 defsubr (&Sframe_pixel_height);
4508 defsubr (&Sframe_pixel_width);
4509 defsubr (&Stool_bar_pixel_width);
4510 defsubr (&Sset_frame_height);
4511 defsubr (&Sset_frame_width);
4512 defsubr (&Sset_frame_size);
4513 defsubr (&Sset_frame_position);
4514 defsubr (&Sframe_pointer_visible_p);
4516 #ifdef HAVE_WINDOW_SYSTEM
4517 defsubr (&Sx_get_resource);
4518 defsubr (&Sx_parse_geometry);
4519 #endif