* lisp/emacs-lisp/rx.el (rx-constituents): Don't define as constant.
[emacs/old-mirror.git] / src / frame.c
blob09049ddae7285275d0b265b5bf5b9d9dba98bc1d
1 /* Generic frame functions.
3 Copyright (C) 1993-1995, 1997, 1999-2012 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20 #include <config.h>
22 #include <stdio.h>
23 #include <ctype.h>
24 #include <errno.h>
25 #include <limits.h>
26 #include <setjmp.h>
27 #include "lisp.h"
28 #include "character.h"
29 #ifdef HAVE_X_WINDOWS
30 #include "xterm.h"
31 #endif
32 #ifdef WINDOWSNT
33 #include "w32term.h"
34 #endif
35 #ifdef HAVE_NS
36 #include "nsterm.h"
37 #endif
38 #include "buffer.h"
39 /* These help us bind and responding to switch-frame events. */
40 #include "commands.h"
41 #include "keyboard.h"
42 #include "frame.h"
43 #include "blockinput.h"
44 #include "termchar.h"
45 #include "termhooks.h"
46 #include "dispextern.h"
47 #include "window.h"
48 #include "font.h"
49 #ifdef HAVE_WINDOW_SYSTEM
50 #include "fontset.h"
51 #endif
52 #ifdef MSDOS
53 #include "msdos.h"
54 #include "dosfns.h"
55 #endif
58 #ifdef HAVE_WINDOW_SYSTEM
60 #endif
62 #ifdef HAVE_NS
63 Lisp_Object Qns_parse_geometry;
64 #endif
66 Lisp_Object Qframep, Qframe_live_p;
67 Lisp_Object Qicon, Qmodeline;
68 Lisp_Object Qonly, Qnone;
69 Lisp_Object Qx, Qw32, Qmac, Qpc, Qns;
70 Lisp_Object Qvisible;
71 Lisp_Object Qdisplay_type;
72 static Lisp_Object Qbackground_mode;
73 Lisp_Object Qnoelisp;
75 static Lisp_Object Qx_frame_parameter;
76 Lisp_Object Qx_resource_name;
77 Lisp_Object Qterminal;
78 Lisp_Object Qterminal_live_p;
80 /* Frame parameters (set or reported). */
82 Lisp_Object Qauto_raise, Qauto_lower;
83 Lisp_Object Qborder_color, Qborder_width;
84 Lisp_Object Qcursor_color, Qcursor_type;
85 static Lisp_Object Qgeometry; /* Not used */
86 Lisp_Object Qheight, Qwidth;
87 Lisp_Object Qleft, Qright;
88 Lisp_Object Qicon_left, Qicon_top, Qicon_type, Qicon_name;
89 Lisp_Object Qtooltip;
90 Lisp_Object Qinternal_border_width;
91 Lisp_Object Qmouse_color;
92 Lisp_Object Qminibuffer;
93 Lisp_Object Qscroll_bar_width, Qvertical_scroll_bars;
94 Lisp_Object Qvisibility;
95 Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
96 Lisp_Object Qscreen_gamma;
97 Lisp_Object Qline_spacing;
98 static Lisp_Object Quser_position, Quser_size;
99 Lisp_Object Qwait_for_wm;
100 static Lisp_Object Qwindow_id;
101 #ifdef HAVE_X_WINDOWS
102 static Lisp_Object Qouter_window_id;
103 #endif
104 Lisp_Object Qparent_id;
105 Lisp_Object Qtitle, Qname;
106 static Lisp_Object Qexplicit_name;
107 Lisp_Object Qunsplittable;
108 Lisp_Object Qmenu_bar_lines, Qtool_bar_lines, Qtool_bar_position;
109 Lisp_Object Qleft_fringe, Qright_fringe;
110 Lisp_Object Qbuffer_predicate;
111 static Lisp_Object Qbuffer_list, Qburied_buffer_list;
112 Lisp_Object Qtty_color_mode;
113 Lisp_Object Qtty, Qtty_type;
115 Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth, Qmaximized;
116 Lisp_Object Qsticky;
117 Lisp_Object Qfont_backend;
118 Lisp_Object Qalpha;
120 Lisp_Object Qface_set_after_frame_default;
122 static Lisp_Object Qdelete_frame_functions;
124 #ifdef HAVE_WINDOW_SYSTEM
125 static void x_report_frame_params (struct frame *, Lisp_Object *);
126 #endif
129 static void
130 set_menu_bar_lines_1 (Lisp_Object window, int n)
132 struct window *w = XWINDOW (window);
134 w->last_modified = 0;
135 WSET (w, top_line, make_number (XFASTINT (w->top_line) + n));
136 WSET (w, total_lines, make_number (XFASTINT (w->total_lines) - n));
138 /* Handle just the top child in a vertical split. */
139 if (!NILP (w->vchild))
140 set_menu_bar_lines_1 (w->vchild, n);
142 /* Adjust all children in a horizontal split. */
143 for (window = w->hchild; !NILP (window); window = w->next)
145 w = XWINDOW (window);
146 set_menu_bar_lines_1 (window, n);
150 void
151 set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
153 int nlines;
154 int olines = FRAME_MENU_BAR_LINES (f);
156 /* Right now, menu bars don't work properly in minibuf-only frames;
157 most of the commands try to apply themselves to the minibuffer
158 frame itself, and get an error because you can't switch buffers
159 in or split the minibuffer window. */
160 if (FRAME_MINIBUF_ONLY_P (f))
161 return;
163 if (TYPE_RANGED_INTEGERP (int, value))
164 nlines = XINT (value);
165 else
166 nlines = 0;
168 if (nlines != olines)
170 windows_or_buffers_changed++;
171 FRAME_WINDOW_SIZES_CHANGED (f) = 1;
172 FRAME_MENU_BAR_LINES (f) = nlines;
173 set_menu_bar_lines_1 (f->root_window, nlines - olines);
174 adjust_glyphs (f);
178 Lisp_Object Vframe_list;
181 DEFUN ("framep", Fframep, Sframep, 1, 1, 0,
182 doc: /* Return non-nil if OBJECT is a frame.
183 Value is:
184 t for a termcap frame (a character-only terminal),
185 'x' for an Emacs frame that is really an X window,
186 'w32' for an Emacs frame that is a window on MS-Windows display,
187 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
188 'pc' for a direct-write MS-DOS frame.
189 See also `frame-live-p'. */)
190 (Lisp_Object object)
192 if (!FRAMEP (object))
193 return Qnil;
194 switch (XFRAME (object)->output_method)
196 case output_initial: /* The initial frame is like a termcap frame. */
197 case output_termcap:
198 return Qt;
199 case output_x_window:
200 return Qx;
201 case output_w32:
202 return Qw32;
203 case output_msdos_raw:
204 return Qpc;
205 case output_mac:
206 return Qmac;
207 case output_ns:
208 return Qns;
209 default:
210 abort ();
214 DEFUN ("frame-live-p", Fframe_live_p, Sframe_live_p, 1, 1, 0,
215 doc: /* Return non-nil if OBJECT is a frame which has not been deleted.
216 Value is nil if OBJECT is not a live frame. If object is a live
217 frame, the return value indicates what sort of terminal device it is
218 displayed on. See the documentation of `framep' for possible
219 return values. */)
220 (Lisp_Object object)
222 return ((FRAMEP (object)
223 && FRAME_LIVE_P (XFRAME (object)))
224 ? Fframep (object)
225 : Qnil);
228 DEFUN ("window-system", Fwindow_system, Swindow_system, 0, 1, 0,
229 doc: /* The name of the window system that FRAME is displaying through.
230 The value is a symbol:
231 nil for a termcap frame (a character-only terminal),
232 'x' for an Emacs frame that is really an X window,
233 'w32' for an Emacs frame that is a window on MS-Windows display,
234 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
235 'pc' for a direct-write MS-DOS frame.
237 FRAME defaults to the currently selected frame.
239 Use of this function as a predicate is deprecated. Instead,
240 use `display-graphic-p' or any of the other `display-*-p'
241 predicates which report frame's specific UI-related capabilities. */)
242 (Lisp_Object frame)
244 Lisp_Object type;
245 if (NILP (frame))
246 frame = selected_frame;
248 type = Fframep (frame);
250 if (NILP (type))
251 wrong_type_argument (Qframep, frame);
253 if (EQ (type, Qt))
254 return Qnil;
255 else
256 return type;
259 struct frame *
260 make_frame (int mini_p)
262 Lisp_Object frame;
263 register struct frame *f;
264 register Lisp_Object root_window;
265 register Lisp_Object mini_window;
267 f = allocate_frame ();
268 XSETFRAME (frame, f);
270 /* Initialize Lisp data. Note that allocate_frame initializes all
271 Lisp data to nil, so do it only for slots which should not be nil. */
272 FSET (f, tool_bar_position, Qtop);
274 /* Initialize non-Lisp data. Note that allocate_frame zeroes out all
275 non-Lisp data, so do it only for slots which should not be zero.
276 To avoid subtle bugs and for the sake of readability, it's better to
277 initialize enum members explicitly even if their values are zero. */
278 f->wants_modeline = 1;
279 f->garbaged = 1;
280 f->has_minibuffer = mini_p;
281 f->vertical_scroll_bar_type = vertical_scroll_bar_none;
282 f->column_width = 1; /* !FRAME_WINDOW_P value */
283 f->line_height = 1; /* !FRAME_WINDOW_P value */
284 #ifdef HAVE_WINDOW_SYSTEM
285 f->want_fullscreen = FULLSCREEN_NONE;
286 #endif
288 root_window = make_window ();
289 if (mini_p)
291 mini_window = make_window ();
292 WSET (XWINDOW (root_window), next, mini_window);
293 WSET (XWINDOW (mini_window), prev, root_window);
294 XWINDOW (mini_window)->mini = 1;
295 WSET (XWINDOW (mini_window), frame, frame);
296 FSET (f, minibuffer_window, mini_window);
298 else
300 mini_window = Qnil;
301 WSET (XWINDOW (root_window), next, Qnil);
302 FSET (f, minibuffer_window, Qnil);
305 WSET (XWINDOW (root_window), frame, frame);
307 /* 10 is arbitrary,
308 just so that there is "something there."
309 Correct size will be set up later with change_frame_size. */
311 SET_FRAME_COLS (f, 10);
312 FRAME_LINES (f) = 10;
314 WSET (XWINDOW (root_window), total_cols, make_number (10));
315 WSET (XWINDOW (root_window), total_lines, make_number (mini_p ? 9 : 10));
317 if (mini_p)
319 WSET (XWINDOW (mini_window), total_cols, make_number (10));
320 WSET (XWINDOW (mini_window), top_line, make_number (9));
321 WSET (XWINDOW (mini_window), total_lines, make_number (1));
324 /* Choose a buffer for the frame's root window. */
326 Lisp_Object buf;
328 WSET (XWINDOW (root_window), buffer, Qt);
329 buf = Fcurrent_buffer ();
330 /* If buf is a 'hidden' buffer (i.e. one whose name starts with
331 a space), try to find another one. */
332 if (SREF (Fbuffer_name (buf), 0) == ' ')
333 buf = other_buffer_safely (buf);
335 /* Use set_window_buffer, not Fset_window_buffer, and don't let
336 hooks be run by it. The reason is that the whole frame/window
337 arrangement is not yet fully initialized at this point. Windows
338 don't have the right size, glyph matrices aren't initialized
339 etc. Running Lisp functions at this point surely ends in a
340 SEGV. */
341 set_window_buffer (root_window, buf, 0, 0);
342 FSET (f, buffer_list, Fcons (buf, Qnil));
345 if (mini_p)
347 WSET (XWINDOW (mini_window), buffer, Qt);
348 set_window_buffer (mini_window,
349 (NILP (Vminibuffer_list)
350 ? get_minibuffer (0)
351 : Fcar (Vminibuffer_list)),
352 0, 0);
355 FSET (f, root_window, root_window);
356 FSET (f, selected_window, root_window);
357 /* Make sure this window seems more recently used than
358 a newly-created, never-selected window. */
359 XWINDOW (f->selected_window)->use_time = ++window_select_count;
361 return f;
364 #ifdef HAVE_WINDOW_SYSTEM
365 /* Make a frame using a separate minibuffer window on another frame.
366 MINI_WINDOW is the minibuffer window to use. nil means use the
367 default (the global minibuffer). */
369 struct frame *
370 make_frame_without_minibuffer (register Lisp_Object mini_window, KBOARD *kb, Lisp_Object display)
372 register struct frame *f;
373 struct gcpro gcpro1;
375 if (!NILP (mini_window))
376 CHECK_LIVE_WINDOW (mini_window);
378 if (!NILP (mini_window)
379 && FRAME_KBOARD (XFRAME (XWINDOW (mini_window)->frame)) != kb)
380 error ("Frame and minibuffer must be on the same terminal");
382 /* Make a frame containing just a root window. */
383 f = make_frame (0);
385 if (NILP (mini_window))
387 /* Use default-minibuffer-frame if possible. */
388 if (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
389 || ! FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))
391 Lisp_Object frame_dummy;
393 XSETFRAME (frame_dummy, f);
394 GCPRO1 (frame_dummy);
395 /* If there's no minibuffer frame to use, create one. */
396 KVAR (kb, Vdefault_minibuffer_frame) =
397 call1 (intern ("make-initial-minibuffer-frame"), display);
398 UNGCPRO;
401 mini_window
402 = XFRAME (KVAR (kb, Vdefault_minibuffer_frame))->minibuffer_window;
405 FSET (f, minibuffer_window, mini_window);
407 /* Make the chosen minibuffer window display the proper minibuffer,
408 unless it is already showing a minibuffer. */
409 if (NILP (Fmemq (XWINDOW (mini_window)->buffer, Vminibuffer_list)))
410 Fset_window_buffer (mini_window,
411 (NILP (Vminibuffer_list)
412 ? get_minibuffer (0)
413 : Fcar (Vminibuffer_list)), Qnil);
414 return f;
417 /* Make a frame containing only a minibuffer window. */
419 struct frame *
420 make_minibuffer_frame (void)
422 /* First make a frame containing just a root window, no minibuffer. */
424 register struct frame *f = make_frame (0);
425 register Lisp_Object mini_window;
426 register Lisp_Object frame;
428 XSETFRAME (frame, f);
430 f->auto_raise = 0;
431 f->auto_lower = 0;
432 f->no_split = 1;
433 f->wants_modeline = 0;
434 f->has_minibuffer = 1;
436 /* Now label the root window as also being the minibuffer.
437 Avoid infinite looping on the window chain by marking next pointer
438 as nil. */
440 mini_window = FSET (f, minibuffer_window, f->root_window);
441 XWINDOW (mini_window)->mini = 1;
442 WSET (XWINDOW (mini_window), next, Qnil);
443 WSET (XWINDOW (mini_window), prev, Qnil);
444 WSET (XWINDOW (mini_window), frame, frame);
446 /* Put the proper buffer in that window. */
448 Fset_window_buffer (mini_window,
449 (NILP (Vminibuffer_list)
450 ? get_minibuffer (0)
451 : Fcar (Vminibuffer_list)), Qnil);
452 return f;
454 #endif /* HAVE_WINDOW_SYSTEM */
456 /* Construct a frame that refers to a terminal. */
458 static printmax_t tty_frame_count;
460 struct frame *
461 make_initial_frame (void)
463 struct frame *f;
464 struct terminal *terminal;
465 Lisp_Object frame;
467 eassert (initial_kboard);
469 /* The first call must initialize Vframe_list. */
470 if (! (NILP (Vframe_list) || CONSP (Vframe_list)))
471 Vframe_list = Qnil;
473 terminal = init_initial_terminal ();
475 f = make_frame (1);
476 XSETFRAME (frame, f);
478 Vframe_list = Fcons (frame, Vframe_list);
480 tty_frame_count = 1;
481 FSET (f, name, build_pure_c_string ("F1"));
483 f->visible = 1;
484 f->async_visible = 1;
486 f->output_method = terminal->type;
487 f->terminal = terminal;
488 f->terminal->reference_count++;
489 f->output_data.nothing = 0;
491 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
492 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
494 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
495 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
497 /* The default value of menu-bar-mode is t. */
498 set_menu_bar_lines (f, make_number (1), Qnil);
500 if (!noninteractive)
501 init_frame_faces (f);
503 return f;
507 static struct frame *
508 make_terminal_frame (struct terminal *terminal)
510 register struct frame *f;
511 Lisp_Object frame;
512 char name[sizeof "F" + INT_STRLEN_BOUND (printmax_t)];
514 if (!terminal->name)
515 error ("Terminal is not live, can't create new frames on it");
517 f = make_frame (1);
519 XSETFRAME (frame, f);
520 Vframe_list = Fcons (frame, Vframe_list);
522 FSET (f, name, make_formatted_string (name, "F%"pMd, ++tty_frame_count));
524 f->visible = 1; /* FRAME_SET_VISIBLE wd set frame_garbaged. */
525 f->async_visible = 1; /* Don't let visible be cleared later. */
526 f->terminal = terminal;
527 f->terminal->reference_count++;
528 #ifdef MSDOS
529 f->output_data.tty->display_info = &the_only_display_info;
530 if (!inhibit_window_system
531 && (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame))
532 || XFRAME (selected_frame)->output_method == output_msdos_raw))
533 f->output_method = output_msdos_raw;
534 else
535 f->output_method = output_termcap;
536 #else /* not MSDOS */
537 f->output_method = output_termcap;
538 create_tty_output (f);
539 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
540 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
541 #endif /* not MSDOS */
543 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
544 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
545 FRAME_MENU_BAR_LINES(f) = NILP (Vmenu_bar_mode) ? 0 : 1;
547 /* Set the top frame to the newly created frame. */
548 if (FRAMEP (FRAME_TTY (f)->top_frame)
549 && FRAME_LIVE_P (XFRAME (FRAME_TTY (f)->top_frame)))
550 XFRAME (FRAME_TTY (f)->top_frame)->async_visible = 2; /* obscured */
552 FRAME_TTY (f)->top_frame = frame;
554 if (!noninteractive)
555 init_frame_faces (f);
557 return f;
560 /* Get a suitable value for frame parameter PARAMETER for a newly
561 created frame, based on (1) the user-supplied frame parameter
562 alist SUPPLIED_PARMS, and (2) CURRENT_VALUE. */
564 static Lisp_Object
565 get_future_frame_param (Lisp_Object parameter,
566 Lisp_Object supplied_parms,
567 char *current_value)
569 Lisp_Object result;
571 result = Fassq (parameter, supplied_parms);
572 if (NILP (result))
573 result = Fassq (parameter, XFRAME (selected_frame)->param_alist);
574 if (NILP (result) && current_value != NULL)
575 result = build_string (current_value);
576 if (!NILP (result) && !STRINGP (result))
577 result = XCDR (result);
578 if (NILP (result) || !STRINGP (result))
579 result = Qnil;
581 return result;
584 DEFUN ("make-terminal-frame", Fmake_terminal_frame, Smake_terminal_frame,
585 1, 1, 0,
586 doc: /* Create an additional terminal frame, possibly on another terminal.
587 This function takes one argument, an alist specifying frame parameters.
589 You can create multiple frames on a single text terminal, but only one
590 of them (the selected terminal frame) is actually displayed.
592 In practice, generally you don't need to specify any parameters,
593 except when you want to create a new frame on another terminal.
594 In that case, the `tty' parameter specifies the device file to open,
595 and the `tty-type' parameter specifies the terminal type. Example:
597 (make-terminal-frame '((tty . "/dev/pts/5") (tty-type . "xterm")))
599 Note that changing the size of one terminal frame automatically
600 affects all frames on the same terminal device. */)
601 (Lisp_Object parms)
603 struct frame *f;
604 struct terminal *t = NULL;
605 Lisp_Object frame, tem;
606 struct frame *sf = SELECTED_FRAME ();
608 #ifdef MSDOS
609 if (sf->output_method != output_msdos_raw
610 && sf->output_method != output_termcap)
611 abort ();
612 #else /* not MSDOS */
614 #ifdef WINDOWSNT /* This should work now! */
615 if (sf->output_method != output_termcap)
616 error ("Not using an ASCII terminal now; cannot make a new ASCII frame");
617 #endif
618 #endif /* not MSDOS */
621 Lisp_Object terminal;
623 terminal = Fassq (Qterminal, parms);
624 if (!NILP (terminal))
626 terminal = XCDR (terminal);
627 t = get_terminal (terminal, 1);
629 #ifdef MSDOS
630 if (t && t != the_only_display_info.terminal)
631 /* msdos.c assumes a single tty_display_info object. */
632 error ("Multiple terminals are not supported on this platform");
633 if (!t)
634 t = the_only_display_info.terminal;
635 #endif
638 if (!t)
640 char *name = 0, *type = 0;
641 Lisp_Object tty, tty_type;
643 tty = get_future_frame_param
644 (Qtty, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
645 ? FRAME_TTY (XFRAME (selected_frame))->name
646 : NULL));
647 if (!NILP (tty))
649 name = alloca (SBYTES (tty) + 1);
650 memcpy (name, SSDATA (tty), SBYTES (tty));
651 name[SBYTES (tty)] = 0;
654 tty_type = get_future_frame_param
655 (Qtty_type, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
656 ? FRAME_TTY (XFRAME (selected_frame))->type
657 : NULL));
658 if (!NILP (tty_type))
660 type = alloca (SBYTES (tty_type) + 1);
661 memcpy (type, SSDATA (tty_type), SBYTES (tty_type));
662 type[SBYTES (tty_type)] = 0;
665 t = init_tty (name, type, 0); /* Errors are not fatal. */
668 f = make_terminal_frame (t);
671 int width, height;
672 get_tty_size (fileno (FRAME_TTY (f)->input), &width, &height);
673 change_frame_size (f, height, width, 0, 0, 0);
676 adjust_glyphs (f);
677 calculate_costs (f);
678 XSETFRAME (frame, f);
679 Fmodify_frame_parameters (frame, parms);
680 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty_type,
681 build_string (t->display_info.tty->type)),
682 Qnil));
683 if (t->display_info.tty->name != NULL)
684 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty,
685 build_string (t->display_info.tty->name)),
686 Qnil));
687 else
688 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty, Qnil), Qnil));
690 /* Make the frame face alist be frame-specific, so that each
691 frame could change its face definitions independently. */
692 FSET (f, face_alist, Fcopy_alist (sf->face_alist));
693 /* Simple Fcopy_alist isn't enough, because we need the contents of
694 the vectors which are the CDRs of associations in face_alist to
695 be copied as well. */
696 for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem))
697 XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem))));
698 return frame;
702 /* Perform the switch to frame FRAME.
704 If FRAME is a switch-frame event `(switch-frame FRAME1)', use
705 FRAME1 as frame.
707 If TRACK is non-zero and the frame that currently has the focus
708 redirects its focus to the selected frame, redirect that focused
709 frame's focus to FRAME instead.
711 FOR_DELETION non-zero means that the selected frame is being
712 deleted, which includes the possibility that the frame's terminal
713 is dead.
715 The value of NORECORD is passed as argument to Fselect_window. */
717 Lisp_Object
718 do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object norecord)
720 struct frame *sf = SELECTED_FRAME ();
722 /* If FRAME is a switch-frame event, extract the frame we should
723 switch to. */
724 if (CONSP (frame)
725 && EQ (XCAR (frame), Qswitch_frame)
726 && CONSP (XCDR (frame)))
727 frame = XCAR (XCDR (frame));
729 /* This used to say CHECK_LIVE_FRAME, but apparently it's possible for
730 a switch-frame event to arrive after a frame is no longer live,
731 especially when deleting the initial frame during startup. */
732 CHECK_FRAME (frame);
733 if (! FRAME_LIVE_P (XFRAME (frame)))
734 return Qnil;
736 if (sf == XFRAME (frame))
737 return frame;
739 /* This is too greedy; it causes inappropriate focus redirection
740 that's hard to get rid of. */
741 #if 0
742 /* If a frame's focus has been redirected toward the currently
743 selected frame, we should change the redirection to point to the
744 newly selected frame. This means that if the focus is redirected
745 from a minibufferless frame to a surrogate minibuffer frame, we
746 can use `other-window' to switch between all the frames using
747 that minibuffer frame, and the focus redirection will follow us
748 around. */
749 if (track)
751 Lisp_Object tail;
753 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
755 Lisp_Object focus;
757 if (!FRAMEP (XCAR (tail)))
758 abort ();
760 focus = FRAME_FOCUS_FRAME (XFRAME (XCAR (tail)));
762 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
763 Fredirect_frame_focus (XCAR (tail), frame);
766 #else /* ! 0 */
767 /* Instead, apply it only to the frame we're pointing to. */
768 #ifdef HAVE_WINDOW_SYSTEM
769 if (track && FRAME_WINDOW_P (XFRAME (frame)))
771 Lisp_Object focus, xfocus;
773 xfocus = x_get_focus_frame (XFRAME (frame));
774 if (FRAMEP (xfocus))
776 focus = FRAME_FOCUS_FRAME (XFRAME (xfocus));
777 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
778 Fredirect_frame_focus (xfocus, frame);
781 #endif /* HAVE_X_WINDOWS */
782 #endif /* ! 0 */
784 if (!for_deletion && FRAME_HAS_MINIBUF_P (sf))
785 resize_mini_window (XWINDOW (FRAME_MINIBUF_WINDOW (sf)), 1);
787 if (FRAME_TERMCAP_P (XFRAME (frame)) || FRAME_MSDOS_P (XFRAME (frame)))
789 if (FRAMEP (FRAME_TTY (XFRAME (frame))->top_frame))
790 /* Mark previously displayed frame as now obscured. */
791 XFRAME (FRAME_TTY (XFRAME (frame))->top_frame)->async_visible = 2;
792 XFRAME (frame)->async_visible = 1;
793 FRAME_TTY (XFRAME (frame))->top_frame = frame;
796 selected_frame = frame;
797 if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
798 last_nonminibuf_frame = XFRAME (selected_frame);
800 Fselect_window (XFRAME (frame)->selected_window, norecord);
802 /* We want to make sure that the next event generates a frame-switch
803 event to the appropriate frame. This seems kludgy to me, but
804 before you take it out, make sure that evaluating something like
805 (select-window (frame-root-window (new-frame))) doesn't end up
806 with your typing being interpreted in the new frame instead of
807 the one you're actually typing in. */
808 internal_last_event_frame = Qnil;
810 return frame;
813 DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 2, "e",
814 doc: /* Select FRAME.
815 Subsequent editing commands apply to its selected window.
816 Optional argument NORECORD means to neither change the order of
817 recently selected windows nor the buffer list.
819 The selection of FRAME lasts until the next time the user does
820 something to select a different frame, or until the next time
821 this function is called. If you are using a window system, the
822 previously selected frame may be restored as the selected frame
823 when returning to the command loop, because it still may have
824 the window system's input focus. On a text terminal, the next
825 redisplay will display FRAME.
827 This function returns FRAME, or nil if FRAME has been deleted. */)
828 (Lisp_Object frame, Lisp_Object norecord)
830 return do_switch_frame (frame, 1, 0, norecord);
834 DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 1, "e",
835 doc: /* Handle a switch-frame event EVENT.
836 Switch-frame events are usually bound to this function.
837 A switch-frame event tells Emacs that the window manager has requested
838 that the user's events be directed to the frame mentioned in the event.
839 This function selects the selected window of the frame of EVENT.
841 If EVENT is frame object, handle it as if it were a switch-frame event
842 to that frame. */)
843 (Lisp_Object event)
845 /* Preserve prefix arg that the command loop just cleared. */
846 KVAR (current_kboard, Vprefix_arg) = Vcurrent_prefix_arg;
847 Frun_hooks (1, &Qmouse_leave_buffer_hook);
848 return do_switch_frame (event, 0, 0, Qnil);
851 DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0,
852 doc: /* Return the frame that is now selected. */)
853 (void)
855 return selected_frame;
858 DEFUN ("frame-list", Fframe_list, Sframe_list,
859 0, 0, 0,
860 doc: /* Return a list of all live frames. */)
861 (void)
863 Lisp_Object frames;
864 frames = Fcopy_sequence (Vframe_list);
865 #ifdef HAVE_WINDOW_SYSTEM
866 if (FRAMEP (tip_frame))
867 frames = Fdelq (tip_frame, frames);
868 #endif
869 return frames;
872 /* Return the next frame in the frame list after FRAME.
873 If MINIBUF is nil, exclude minibuffer-only frames.
874 If MINIBUF is a window, include only its own frame
875 and any frame now using that window as the minibuffer.
876 If MINIBUF is `visible', include all visible frames.
877 If MINIBUF is 0, include all visible and iconified frames.
878 Otherwise, include all frames. */
880 static Lisp_Object
881 next_frame (Lisp_Object frame, Lisp_Object minibuf)
883 Lisp_Object tail;
884 int passed = 0;
886 /* There must always be at least one frame in Vframe_list. */
887 if (! CONSP (Vframe_list))
888 abort ();
890 /* If this frame is dead, it won't be in Vframe_list, and we'll loop
891 forever. Forestall that. */
892 CHECK_LIVE_FRAME (frame);
894 while (1)
895 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
897 Lisp_Object f;
899 f = XCAR (tail);
901 if (passed
902 && ((!FRAME_TERMCAP_P (XFRAME (f)) && !FRAME_TERMCAP_P (XFRAME (frame))
903 && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
904 || (FRAME_TERMCAP_P (XFRAME (f)) && FRAME_TERMCAP_P (XFRAME (frame))
905 && FRAME_TTY (XFRAME (f)) == FRAME_TTY (XFRAME (frame)))))
907 /* Decide whether this frame is eligible to be returned. */
909 /* If we've looped all the way around without finding any
910 eligible frames, return the original frame. */
911 if (EQ (f, frame))
912 return f;
914 /* Let minibuf decide if this frame is acceptable. */
915 if (NILP (minibuf))
917 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
918 return f;
920 else if (EQ (minibuf, Qvisible))
922 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
923 if (FRAME_VISIBLE_P (XFRAME (f)))
924 return f;
926 else if (INTEGERP (minibuf) && XINT (minibuf) == 0)
928 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
929 if (FRAME_VISIBLE_P (XFRAME (f))
930 || FRAME_ICONIFIED_P (XFRAME (f)))
931 return f;
933 else if (WINDOWP (minibuf))
935 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
936 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
937 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
938 FRAME_FOCUS_FRAME (XFRAME (f))))
939 return f;
941 else
942 return f;
945 if (EQ (frame, f))
946 passed++;
950 /* Return the previous frame in the frame list before FRAME.
951 If MINIBUF is nil, exclude minibuffer-only frames.
952 If MINIBUF is a window, include only its own frame
953 and any frame now using that window as the minibuffer.
954 If MINIBUF is `visible', include all visible frames.
955 If MINIBUF is 0, include all visible and iconified frames.
956 Otherwise, include all frames. */
958 static Lisp_Object
959 prev_frame (Lisp_Object frame, Lisp_Object minibuf)
961 Lisp_Object tail;
962 Lisp_Object prev;
964 /* There must always be at least one frame in Vframe_list. */
965 if (! CONSP (Vframe_list))
966 abort ();
968 prev = Qnil;
969 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
971 Lisp_Object f;
973 f = XCAR (tail);
974 if (!FRAMEP (f))
975 abort ();
977 if (EQ (frame, f) && !NILP (prev))
978 return prev;
980 if ((!FRAME_TERMCAP_P (XFRAME (f)) && !FRAME_TERMCAP_P (XFRAME (frame))
981 && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
982 || (FRAME_TERMCAP_P (XFRAME (f)) && FRAME_TERMCAP_P (XFRAME (frame))
983 && FRAME_TTY (XFRAME (f)) == FRAME_TTY (XFRAME (frame))))
985 /* Decide whether this frame is eligible to be returned,
986 according to minibuf. */
987 if (NILP (minibuf))
989 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
990 prev = f;
992 else if (WINDOWP (minibuf))
994 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
995 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
996 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
997 FRAME_FOCUS_FRAME (XFRAME (f))))
998 prev = f;
1000 else if (EQ (minibuf, Qvisible))
1002 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1003 if (FRAME_VISIBLE_P (XFRAME (f)))
1004 prev = f;
1006 else if (XFASTINT (minibuf) == 0)
1008 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1009 if (FRAME_VISIBLE_P (XFRAME (f))
1010 || FRAME_ICONIFIED_P (XFRAME (f)))
1011 prev = f;
1013 else
1014 prev = f;
1018 /* We've scanned the entire list. */
1019 if (NILP (prev))
1020 /* We went through the whole frame list without finding a single
1021 acceptable frame. Return the original frame. */
1022 return frame;
1023 else
1024 /* There were no acceptable frames in the list before FRAME; otherwise,
1025 we would have returned directly from the loop. Since PREV is the last
1026 acceptable frame in the list, return it. */
1027 return prev;
1031 DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0,
1032 doc: /* Return the next frame in the frame list after FRAME.
1033 It considers only frames on the same terminal as FRAME.
1034 By default, skip minibuffer-only frames.
1035 If omitted, FRAME defaults to the selected frame.
1036 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1037 If MINIFRAME is a window, include only its own frame
1038 and any frame now using that window as the minibuffer.
1039 If MINIFRAME is `visible', include all visible frames.
1040 If MINIFRAME is 0, include all visible and iconified frames.
1041 Otherwise, include all frames. */)
1042 (Lisp_Object frame, Lisp_Object miniframe)
1044 if (NILP (frame))
1045 frame = selected_frame;
1047 CHECK_LIVE_FRAME (frame);
1048 return next_frame (frame, miniframe);
1051 DEFUN ("previous-frame", Fprevious_frame, Sprevious_frame, 0, 2, 0,
1052 doc: /* Return the previous frame in the frame list before FRAME.
1053 It considers only frames on the same terminal as FRAME.
1054 By default, skip minibuffer-only frames.
1055 If omitted, FRAME defaults to the selected frame.
1056 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1057 If MINIFRAME is a window, include only its own frame
1058 and any frame now using that window as the minibuffer.
1059 If MINIFRAME is `visible', include all visible frames.
1060 If MINIFRAME is 0, include all visible and iconified frames.
1061 Otherwise, include all frames. */)
1062 (Lisp_Object frame, Lisp_Object miniframe)
1064 if (NILP (frame))
1065 frame = selected_frame;
1066 CHECK_LIVE_FRAME (frame);
1067 return prev_frame (frame, miniframe);
1070 /* Return 1 if it is ok to delete frame F;
1071 0 if all frames aside from F are invisible.
1072 (Exception: if F is the terminal frame, and we are using X, return 1.) */
1074 static int
1075 other_visible_frames (FRAME_PTR f)
1077 Lisp_Object frames;
1079 for (frames = Vframe_list; CONSP (frames); frames = XCDR (frames))
1081 Lisp_Object this = XCAR (frames);
1082 if (f == XFRAME (this))
1083 continue;
1085 /* Verify that we can still talk to the frame's X window,
1086 and note any recent change in visibility. */
1087 #ifdef HAVE_WINDOW_SYSTEM
1088 if (FRAME_WINDOW_P (XFRAME (this)))
1090 x_sync (XFRAME (this));
1091 FRAME_SAMPLE_VISIBILITY (XFRAME (this));
1093 #endif
1095 if (FRAME_VISIBLE_P (XFRAME (this))
1096 || FRAME_ICONIFIED_P (XFRAME (this))
1097 /* Allow deleting the terminal frame when at least one X
1098 frame exists. */
1099 || (FRAME_WINDOW_P (XFRAME (this)) && !FRAME_WINDOW_P (f)))
1100 return 1;
1102 return 0;
1105 /* Delete FRAME. When FORCE equals Qnoelisp, delete FRAME
1106 unconditionally. x_connection_closed and delete_terminal use
1107 this. Any other value of FORCE implements the semantics
1108 described for Fdelete_frame. */
1109 Lisp_Object
1110 delete_frame (Lisp_Object frame, Lisp_Object force)
1112 struct frame *f;
1113 struct frame *sf = SELECTED_FRAME ();
1114 struct kboard *kb;
1116 int minibuffer_selected, tooltip_frame;
1118 if (EQ (frame, Qnil))
1120 f = sf;
1121 XSETFRAME (frame, f);
1123 else
1125 CHECK_FRAME (frame);
1126 f = XFRAME (frame);
1129 if (! FRAME_LIVE_P (f))
1130 return Qnil;
1132 if (NILP (force) && !other_visible_frames (f))
1133 error ("Attempt to delete the sole visible or iconified frame");
1135 /* x_connection_closed must have set FORCE to `noelisp' in order
1136 to delete the last frame, if it is gone. */
1137 if (NILP (XCDR (Vframe_list)) && !EQ (force, Qnoelisp))
1138 error ("Attempt to delete the only frame");
1140 /* Does this frame have a minibuffer, and is it the surrogate
1141 minibuffer for any other frame? */
1142 if (FRAME_HAS_MINIBUF_P (XFRAME (frame)))
1144 Lisp_Object frames;
1146 for (frames = Vframe_list;
1147 CONSP (frames);
1148 frames = XCDR (frames))
1150 Lisp_Object this;
1151 this = XCAR (frames);
1153 if (! EQ (this, frame)
1154 && EQ (frame,
1155 WINDOW_FRAME (XWINDOW
1156 (FRAME_MINIBUF_WINDOW (XFRAME (this))))))
1158 /* If we MUST delete this frame, delete the other first.
1159 But do this only if FORCE equals `noelisp'. */
1160 if (EQ (force, Qnoelisp))
1161 delete_frame (this, Qnoelisp);
1162 else
1163 error ("Attempt to delete a surrogate minibuffer frame");
1168 tooltip_frame = !NILP (Fframe_parameter (frame, intern ("tooltip")));
1170 /* Run `delete-frame-functions' unless FORCE is `noelisp' or
1171 frame is a tooltip. FORCE is set to `noelisp' when handling
1172 a disconnect from the terminal, so we don't dare call Lisp
1173 code. */
1174 if (NILP (Vrun_hooks) || tooltip_frame)
1176 else if (EQ (force, Qnoelisp))
1177 pending_funcalls
1178 = Fcons (list3 (Qrun_hook_with_args, Qdelete_frame_functions, frame),
1179 pending_funcalls);
1180 else
1182 #ifdef HAVE_X_WINDOWS
1183 /* Also, save clipboard to the clipboard manager. */
1184 x_clipboard_manager_save_frame (frame);
1185 #endif
1187 safe_call2 (Qrun_hook_with_args, Qdelete_frame_functions, frame);
1190 /* The hook may sometimes (indirectly) cause the frame to be deleted. */
1191 if (! FRAME_LIVE_P (f))
1192 return Qnil;
1194 /* At this point, we are committed to deleting the frame.
1195 There is no more chance for errors to prevent it. */
1197 minibuffer_selected = EQ (minibuf_window, selected_window);
1199 /* Don't let the frame remain selected. */
1200 if (f == sf)
1202 Lisp_Object tail, frame1;
1204 /* Look for another visible frame on the same terminal. */
1205 frame1 = next_frame (frame, Qvisible);
1207 /* If there is none, find *some* other frame. */
1208 if (NILP (frame1) || EQ (frame1, frame))
1210 FOR_EACH_FRAME (tail, frame1)
1212 if (! EQ (frame, frame1) && FRAME_LIVE_P (XFRAME (frame1)))
1214 /* Do not change a text terminal's top-frame. */
1215 struct frame *f1 = XFRAME (frame1);
1216 if (FRAME_TERMCAP_P (f1) || FRAME_MSDOS_P (f1))
1218 Lisp_Object top_frame = FRAME_TTY (f1)->top_frame;
1219 if (!EQ (top_frame, frame))
1220 frame1 = top_frame;
1222 break;
1226 #ifdef NS_IMPL_COCOA
1227 else
1228 /* Under NS, there is no system mechanism for choosing a new
1229 window to get focus -- it is left to application code.
1230 So the portion of THIS application interfacing with NS
1231 needs to know about it. We call Fraise_frame, but the
1232 purpose is really to transfer focus. */
1233 Fraise_frame (frame1);
1234 #endif
1236 do_switch_frame (frame1, 0, 1, Qnil);
1237 sf = SELECTED_FRAME ();
1240 /* Don't allow minibuf_window to remain on a deleted frame. */
1241 if (EQ (f->minibuffer_window, minibuf_window))
1243 Fset_window_buffer (sf->minibuffer_window,
1244 XWINDOW (minibuf_window)->buffer, Qnil);
1245 minibuf_window = sf->minibuffer_window;
1247 /* If the dying minibuffer window was selected,
1248 select the new one. */
1249 if (minibuffer_selected)
1250 Fselect_window (minibuf_window, Qnil);
1253 /* Don't let echo_area_window to remain on a deleted frame. */
1254 if (EQ (f->minibuffer_window, echo_area_window))
1255 echo_area_window = sf->minibuffer_window;
1257 /* Clear any X selections for this frame. */
1258 #ifdef HAVE_X_WINDOWS
1259 if (FRAME_X_P (f))
1260 x_clear_frame_selections (f);
1261 #endif
1263 /* Free glyphs.
1264 This function must be called before the window tree of the
1265 frame is deleted because windows contain dynamically allocated
1266 memory. */
1267 free_glyphs (f);
1269 #ifdef HAVE_WINDOW_SYSTEM
1270 /* Give chance to each font driver to free a frame specific data. */
1271 font_update_drivers (f, Qnil);
1272 #endif
1274 /* Mark all the windows that used to be on FRAME as deleted, and then
1275 remove the reference to them. */
1276 delete_all_child_windows (f->root_window);
1277 FSET (f, root_window, Qnil);
1279 Vframe_list = Fdelq (frame, Vframe_list);
1280 FRAME_SET_VISIBLE (f, 0);
1282 /* Allow the vector of menu bar contents to be freed in the next
1283 garbage collection. The frame object itself may not be garbage
1284 collected until much later, because recent_keys and other data
1285 structures can still refer to it. */
1286 FSET (f, menu_bar_vector, Qnil);
1288 free_font_driver_list (f);
1289 xfree (f->namebuf);
1290 xfree (f->decode_mode_spec_buffer);
1291 xfree (FRAME_INSERT_COST (f));
1292 xfree (FRAME_DELETEN_COST (f));
1293 xfree (FRAME_INSERTN_COST (f));
1294 xfree (FRAME_DELETE_COST (f));
1295 xfree (FRAME_MESSAGE_BUF (f));
1297 /* Since some events are handled at the interrupt level, we may get
1298 an event for f at any time; if we zero out the frame's terminal
1299 now, then we may trip up the event-handling code. Instead, we'll
1300 promise that the terminal of the frame must be valid until we
1301 have called the window-system-dependent frame destruction
1302 routine. */
1304 if (FRAME_TERMINAL (f)->delete_frame_hook)
1305 (*FRAME_TERMINAL (f)->delete_frame_hook) (f);
1308 struct terminal *terminal = FRAME_TERMINAL (f);
1309 f->output_data.nothing = 0;
1310 f->terminal = 0; /* Now the frame is dead. */
1312 /* If needed, delete the terminal that this frame was on.
1313 (This must be done after the frame is killed.) */
1314 terminal->reference_count--;
1315 #ifdef USE_GTK
1316 /* FIXME: Deleting the terminal crashes emacs because of a GTK
1317 bug.
1318 http://lists.gnu.org/archive/html/emacs-devel/2011-10/msg00363.html */
1319 if (terminal->reference_count == 0 && terminal->type == output_x_window)
1320 terminal->reference_count = 1;
1321 #endif /* USE_GTK */
1322 if (terminal->reference_count == 0)
1324 Lisp_Object tmp;
1325 XSETTERMINAL (tmp, terminal);
1327 kb = NULL;
1328 Fdelete_terminal (tmp, NILP (force) ? Qt : force);
1330 else
1331 kb = terminal->kboard;
1334 /* If we've deleted the last_nonminibuf_frame, then try to find
1335 another one. */
1336 if (f == last_nonminibuf_frame)
1338 Lisp_Object frames;
1340 last_nonminibuf_frame = 0;
1342 for (frames = Vframe_list;
1343 CONSP (frames);
1344 frames = XCDR (frames))
1346 f = XFRAME (XCAR (frames));
1347 if (!FRAME_MINIBUF_ONLY_P (f))
1349 last_nonminibuf_frame = f;
1350 break;
1355 /* If there's no other frame on the same kboard, get out of
1356 single-kboard state if we're in it for this kboard. */
1357 if (kb != NULL)
1359 Lisp_Object frames;
1360 /* Some frame we found on the same kboard, or nil if there are none. */
1361 Lisp_Object frame_on_same_kboard;
1363 frame_on_same_kboard = Qnil;
1365 for (frames = Vframe_list;
1366 CONSP (frames);
1367 frames = XCDR (frames))
1369 Lisp_Object this;
1370 struct frame *f1;
1372 this = XCAR (frames);
1373 if (!FRAMEP (this))
1374 abort ();
1375 f1 = XFRAME (this);
1377 if (kb == FRAME_KBOARD (f1))
1378 frame_on_same_kboard = this;
1381 if (NILP (frame_on_same_kboard))
1382 not_single_kboard_state (kb);
1386 /* If we've deleted this keyboard's default_minibuffer_frame, try to
1387 find another one. Prefer minibuffer-only frames, but also notice
1388 frames with other windows. */
1389 if (kb != NULL && EQ (frame, KVAR (kb, Vdefault_minibuffer_frame)))
1391 Lisp_Object frames;
1393 /* The last frame we saw with a minibuffer, minibuffer-only or not. */
1394 Lisp_Object frame_with_minibuf;
1395 /* Some frame we found on the same kboard, or nil if there are none. */
1396 Lisp_Object frame_on_same_kboard;
1398 frame_on_same_kboard = Qnil;
1399 frame_with_minibuf = Qnil;
1401 for (frames = Vframe_list;
1402 CONSP (frames);
1403 frames = XCDR (frames))
1405 Lisp_Object this;
1406 struct frame *f1;
1408 this = XCAR (frames);
1409 if (!FRAMEP (this))
1410 abort ();
1411 f1 = XFRAME (this);
1413 /* Consider only frames on the same kboard
1414 and only those with minibuffers. */
1415 if (kb == FRAME_KBOARD (f1)
1416 && FRAME_HAS_MINIBUF_P (f1))
1418 frame_with_minibuf = this;
1419 if (FRAME_MINIBUF_ONLY_P (f1))
1420 break;
1423 if (kb == FRAME_KBOARD (f1))
1424 frame_on_same_kboard = this;
1427 if (!NILP (frame_on_same_kboard))
1429 /* We know that there must be some frame with a minibuffer out
1430 there. If this were not true, all of the frames present
1431 would have to be minibufferless, which implies that at some
1432 point their minibuffer frames must have been deleted, but
1433 that is prohibited at the top; you can't delete surrogate
1434 minibuffer frames. */
1435 if (NILP (frame_with_minibuf))
1436 abort ();
1438 KVAR (kb, Vdefault_minibuffer_frame) = frame_with_minibuf;
1440 else
1441 /* No frames left on this kboard--say no minibuffer either. */
1442 KVAR (kb, Vdefault_minibuffer_frame) = Qnil;
1445 /* Cause frame titles to update--necessary if we now have just one frame. */
1446 if (!tooltip_frame)
1447 update_mode_lines = 1;
1449 return Qnil;
1452 DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 2, "",
1453 doc: /* Delete FRAME, permanently eliminating it from use.
1454 FRAME defaults to the selected frame.
1456 A frame may not be deleted if its minibuffer is used by other frames.
1457 Normally, you may not delete a frame if all other frames are invisible,
1458 but if the second optional argument FORCE is non-nil, you may do so.
1460 This function runs `delete-frame-functions' before actually
1461 deleting the frame, unless the frame is a tooltip.
1462 The functions are run with one argument, the frame to be deleted. */)
1463 (Lisp_Object frame, Lisp_Object force)
1465 return delete_frame (frame, !NILP (force) ? Qt : Qnil);
1469 /* Return mouse position in character cell units. */
1471 DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0,
1472 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1473 The position is given in character cells, where (0, 0) is the
1474 upper-left corner of the frame, X is the horizontal offset, and Y is
1475 the vertical offset.
1476 If Emacs is running on a mouseless terminal or hasn't been programmed
1477 to read the mouse position, it returns the selected frame for FRAME
1478 and nil for X and Y.
1479 If `mouse-position-function' is non-nil, `mouse-position' calls it,
1480 passing the normal return value to that function as an argument,
1481 and returns whatever that function returns. */)
1482 (void)
1484 FRAME_PTR f;
1485 Lisp_Object lispy_dummy;
1486 enum scroll_bar_part party_dummy;
1487 Lisp_Object x, y, retval;
1488 int col, row;
1489 Time long_dummy;
1490 struct gcpro gcpro1;
1492 f = SELECTED_FRAME ();
1493 x = y = Qnil;
1495 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
1496 /* It's okay for the hook to refrain from storing anything. */
1497 if (FRAME_TERMINAL (f)->mouse_position_hook)
1498 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1499 &lispy_dummy, &party_dummy,
1500 &x, &y,
1501 &long_dummy);
1502 if (! NILP (x))
1504 col = XINT (x);
1505 row = XINT (y);
1506 pixel_to_glyph_coords (f, col, row, &col, &row, NULL, 1);
1507 XSETINT (x, col);
1508 XSETINT (y, row);
1510 #endif
1511 XSETFRAME (lispy_dummy, f);
1512 retval = Fcons (lispy_dummy, Fcons (x, y));
1513 GCPRO1 (retval);
1514 if (!NILP (Vmouse_position_function))
1515 retval = call1 (Vmouse_position_function, retval);
1516 RETURN_UNGCPRO (retval);
1519 DEFUN ("mouse-pixel-position", Fmouse_pixel_position,
1520 Smouse_pixel_position, 0, 0, 0,
1521 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1522 The position is given in pixel units, where (0, 0) is the
1523 upper-left corner of the frame, X is the horizontal offset, and Y is
1524 the vertical offset.
1525 If Emacs is running on a mouseless terminal or hasn't been programmed
1526 to read the mouse position, it returns the selected frame for FRAME
1527 and nil for X and Y. */)
1528 (void)
1530 FRAME_PTR f;
1531 Lisp_Object lispy_dummy;
1532 enum scroll_bar_part party_dummy;
1533 Lisp_Object x, y;
1534 Time long_dummy;
1536 f = SELECTED_FRAME ();
1537 x = y = Qnil;
1539 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
1540 /* It's okay for the hook to refrain from storing anything. */
1541 if (FRAME_TERMINAL (f)->mouse_position_hook)
1542 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1543 &lispy_dummy, &party_dummy,
1544 &x, &y,
1545 &long_dummy);
1546 #endif
1547 XSETFRAME (lispy_dummy, f);
1548 return Fcons (lispy_dummy, Fcons (x, y));
1551 DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0,
1552 doc: /* Move the mouse pointer to the center of character cell (X,Y) in FRAME.
1553 Coordinates are relative to the frame, not a window,
1554 so the coordinates of the top left character in the frame
1555 may be nonzero due to left-hand scroll bars or the menu bar.
1557 The position is given in character cells, where (0, 0) is the
1558 upper-left corner of the frame, X is the horizontal offset, and Y is
1559 the vertical offset.
1561 This function is a no-op for an X frame that is not visible.
1562 If you have just created a frame, you must wait for it to become visible
1563 before calling this function on it, like this.
1564 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1565 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1567 CHECK_LIVE_FRAME (frame);
1568 CHECK_TYPE_RANGED_INTEGER (int, x);
1569 CHECK_TYPE_RANGED_INTEGER (int, y);
1571 /* I think this should be done with a hook. */
1572 #ifdef HAVE_WINDOW_SYSTEM
1573 if (FRAME_WINDOW_P (XFRAME (frame)))
1574 /* Warping the mouse will cause enternotify and focus events. */
1575 x_set_mouse_position (XFRAME (frame), XINT (x), XINT (y));
1576 #else
1577 #if defined (MSDOS) && defined (HAVE_MOUSE)
1578 if (FRAME_MSDOS_P (XFRAME (frame)))
1580 Fselect_frame (frame, Qnil);
1581 mouse_moveto (XINT (x), XINT (y));
1583 #else
1584 #ifdef HAVE_GPM
1586 Fselect_frame (frame, Qnil);
1587 term_mouse_moveto (XINT (x), XINT (y));
1589 #endif
1590 #endif
1591 #endif
1593 return Qnil;
1596 DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position,
1597 Sset_mouse_pixel_position, 3, 3, 0,
1598 doc: /* Move the mouse pointer to pixel position (X,Y) in FRAME.
1599 The position is given in pixels, where (0, 0) is the upper-left corner
1600 of the frame, X is the horizontal offset, and Y is the vertical offset.
1602 Note, this is a no-op for an X frame that is not visible.
1603 If you have just created a frame, you must wait for it to become visible
1604 before calling this function on it, like this.
1605 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1606 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1608 CHECK_LIVE_FRAME (frame);
1609 CHECK_TYPE_RANGED_INTEGER (int, x);
1610 CHECK_TYPE_RANGED_INTEGER (int, y);
1612 /* I think this should be done with a hook. */
1613 #ifdef HAVE_WINDOW_SYSTEM
1614 if (FRAME_WINDOW_P (XFRAME (frame)))
1615 /* Warping the mouse will cause enternotify and focus events. */
1616 x_set_mouse_pixel_position (XFRAME (frame), XINT (x), XINT (y));
1617 #else
1618 #if defined (MSDOS) && defined (HAVE_MOUSE)
1619 if (FRAME_MSDOS_P (XFRAME (frame)))
1621 Fselect_frame (frame, Qnil);
1622 mouse_moveto (XINT (x), XINT (y));
1624 #else
1625 #ifdef HAVE_GPM
1627 Fselect_frame (frame, Qnil);
1628 term_mouse_moveto (XINT (x), XINT (y));
1630 #endif
1631 #endif
1632 #endif
1634 return Qnil;
1637 static void make_frame_visible_1 (Lisp_Object);
1639 DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible,
1640 0, 1, "",
1641 doc: /* Make the frame FRAME visible (assuming it is an X window).
1642 If omitted, FRAME defaults to the currently selected frame. */)
1643 (Lisp_Object frame)
1645 if (NILP (frame))
1646 frame = selected_frame;
1648 CHECK_LIVE_FRAME (frame);
1650 /* I think this should be done with a hook. */
1651 #ifdef HAVE_WINDOW_SYSTEM
1652 if (FRAME_WINDOW_P (XFRAME (frame)))
1654 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1655 x_make_frame_visible (XFRAME (frame));
1657 #endif
1659 make_frame_visible_1 (XFRAME (frame)->root_window);
1661 /* Make menu bar update for the Buffers and Frames menus. */
1662 windows_or_buffers_changed++;
1664 return frame;
1667 /* Update the display_time slot of the buffers shown in WINDOW
1668 and all its descendants. */
1670 static void
1671 make_frame_visible_1 (Lisp_Object window)
1673 struct window *w;
1675 for (;!NILP (window); window = w->next)
1677 w = XWINDOW (window);
1679 if (!NILP (w->buffer))
1680 BVAR (XBUFFER (w->buffer), display_time) = Fcurrent_time ();
1682 if (!NILP (w->vchild))
1683 make_frame_visible_1 (w->vchild);
1684 if (!NILP (w->hchild))
1685 make_frame_visible_1 (w->hchild);
1689 DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible,
1690 0, 2, "",
1691 doc: /* Make the frame FRAME invisible.
1692 If omitted, FRAME defaults to the currently selected frame.
1693 On graphical displays, invisible frames are not updated and are
1694 usually not displayed at all, even in a window system's \"taskbar\".
1696 Normally you may not make FRAME invisible if all other frames are invisible,
1697 but if the second optional argument FORCE is non-nil, you may do so.
1699 This function has no effect on text terminal frames. Such frames are
1700 always considered visible, whether or not they are currently being
1701 displayed in the terminal. */)
1702 (Lisp_Object frame, Lisp_Object force)
1704 if (NILP (frame))
1705 frame = selected_frame;
1707 CHECK_LIVE_FRAME (frame);
1709 if (NILP (force) && !other_visible_frames (XFRAME (frame)))
1710 error ("Attempt to make invisible the sole visible or iconified frame");
1712 /* Don't allow minibuf_window to remain on a deleted frame. */
1713 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1715 struct frame *sf = XFRAME (selected_frame);
1716 Fset_window_buffer (sf->minibuffer_window,
1717 XWINDOW (minibuf_window)->buffer, Qnil);
1718 minibuf_window = sf->minibuffer_window;
1721 /* I think this should be done with a hook. */
1722 #ifdef HAVE_WINDOW_SYSTEM
1723 if (FRAME_WINDOW_P (XFRAME (frame)))
1724 x_make_frame_invisible (XFRAME (frame));
1725 #endif
1727 /* Make menu bar update for the Buffers and Frames menus. */
1728 windows_or_buffers_changed++;
1730 return Qnil;
1733 DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame,
1734 0, 1, "",
1735 doc: /* Make the frame FRAME into an icon.
1736 If omitted, FRAME defaults to the currently selected frame. */)
1737 (Lisp_Object frame)
1739 if (NILP (frame))
1740 frame = selected_frame;
1742 CHECK_LIVE_FRAME (frame);
1744 #if 0 /* This isn't logically necessary, and it can do GC. */
1745 /* Don't let the frame remain selected. */
1746 if (EQ (frame, selected_frame))
1747 Fhandle_switch_frame (next_frame (frame, Qt));
1748 #endif
1750 /* Don't allow minibuf_window to remain on a deleted frame. */
1751 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1753 struct frame *sf = XFRAME (selected_frame);
1754 Fset_window_buffer (sf->minibuffer_window,
1755 XWINDOW (minibuf_window)->buffer, Qnil);
1756 minibuf_window = sf->minibuffer_window;
1759 /* I think this should be done with a hook. */
1760 #ifdef HAVE_WINDOW_SYSTEM
1761 if (FRAME_WINDOW_P (XFRAME (frame)))
1762 x_iconify_frame (XFRAME (frame));
1763 #endif
1765 /* Make menu bar update for the Buffers and Frames menus. */
1766 windows_or_buffers_changed++;
1768 return Qnil;
1771 DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p,
1772 1, 1, 0,
1773 doc: /* Return t if FRAME is \"visible\" (actually in use for display).
1774 Return the symbol `icon' if FRAME is iconified or \"minimized\".
1775 Return nil if FRAME was made invisible, via `make-frame-invisible'.
1776 On graphical displays, invisible frames are not updated and are
1777 usually not displayed at all, even in a window system's \"taskbar\".
1779 If FRAME is a text terminal frame, this always returns t.
1780 Such frames are always considered visible, whether or not they are
1781 currently being displayed on the terminal. */)
1782 (Lisp_Object frame)
1784 CHECK_LIVE_FRAME (frame);
1786 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1788 if (FRAME_VISIBLE_P (XFRAME (frame)))
1789 return Qt;
1790 if (FRAME_ICONIFIED_P (XFRAME (frame)))
1791 return Qicon;
1792 return Qnil;
1795 DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list,
1796 0, 0, 0,
1797 doc: /* Return a list of all frames now \"visible\" (being updated). */)
1798 (void)
1800 Lisp_Object tail, frame;
1801 struct frame *f;
1802 Lisp_Object value;
1804 value = Qnil;
1805 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1807 frame = XCAR (tail);
1808 if (!FRAMEP (frame))
1809 continue;
1810 f = XFRAME (frame);
1811 if (FRAME_VISIBLE_P (f))
1812 value = Fcons (frame, value);
1814 return value;
1818 DEFUN ("raise-frame", Fraise_frame, Sraise_frame, 0, 1, "",
1819 doc: /* Bring FRAME to the front, so it occludes any frames it overlaps.
1820 If FRAME is invisible or iconified, make it visible.
1821 If you don't specify a frame, the selected frame is used.
1822 If Emacs is displaying on an ordinary terminal or some other device which
1823 doesn't support multiple overlapping frames, this function selects FRAME. */)
1824 (Lisp_Object frame)
1826 struct frame *f;
1827 if (NILP (frame))
1828 frame = selected_frame;
1830 CHECK_LIVE_FRAME (frame);
1832 f = XFRAME (frame);
1834 if (FRAME_TERMCAP_P (f))
1835 /* On a text terminal select FRAME. */
1836 Fselect_frame (frame, Qnil);
1837 else
1838 /* Do like the documentation says. */
1839 Fmake_frame_visible (frame);
1841 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
1842 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 1);
1844 return Qnil;
1847 /* Should we have a corresponding function called Flower_Power? */
1848 DEFUN ("lower-frame", Flower_frame, Slower_frame, 0, 1, "",
1849 doc: /* Send FRAME to the back, so it is occluded by any frames that overlap it.
1850 If you don't specify a frame, the selected frame is used.
1851 If Emacs is displaying on an ordinary terminal or some other device which
1852 doesn't support multiple overlapping frames, this function does nothing. */)
1853 (Lisp_Object frame)
1855 struct frame *f;
1857 if (NILP (frame))
1858 frame = selected_frame;
1860 CHECK_LIVE_FRAME (frame);
1862 f = XFRAME (frame);
1864 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
1865 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 0);
1867 return Qnil;
1871 DEFUN ("redirect-frame-focus", Fredirect_frame_focus, Sredirect_frame_focus,
1872 1, 2, 0,
1873 doc: /* Arrange for keystrokes typed at FRAME to be sent to FOCUS-FRAME.
1874 In other words, switch-frame events caused by events in FRAME will
1875 request a switch to FOCUS-FRAME, and `last-event-frame' will be
1876 FOCUS-FRAME after reading an event typed at FRAME.
1878 If FOCUS-FRAME is nil, any existing redirection is canceled, and the
1879 frame again receives its own keystrokes.
1881 Focus redirection is useful for temporarily redirecting keystrokes to
1882 a surrogate minibuffer frame when a frame doesn't have its own
1883 minibuffer window.
1885 A frame's focus redirection can be changed by `select-frame'. If frame
1886 FOO is selected, and then a different frame BAR is selected, any
1887 frames redirecting their focus to FOO are shifted to redirect their
1888 focus to BAR. This allows focus redirection to work properly when the
1889 user switches from one frame to another using `select-window'.
1891 This means that a frame whose focus is redirected to itself is treated
1892 differently from a frame whose focus is redirected to nil; the former
1893 is affected by `select-frame', while the latter is not.
1895 The redirection lasts until `redirect-frame-focus' is called to change it. */)
1896 (Lisp_Object frame, Lisp_Object focus_frame)
1898 struct frame *f;
1900 /* Note that we don't check for a live frame here. It's reasonable
1901 to redirect the focus of a frame you're about to delete, if you
1902 know what other frame should receive those keystrokes. */
1903 CHECK_FRAME (frame);
1905 if (! NILP (focus_frame))
1906 CHECK_LIVE_FRAME (focus_frame);
1908 f = XFRAME (frame);
1910 FSET (f, focus_frame, focus_frame);
1912 if (FRAME_TERMINAL (f)->frame_rehighlight_hook)
1913 (*FRAME_TERMINAL (f)->frame_rehighlight_hook) (f);
1915 return Qnil;
1919 DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 1, 1, 0,
1920 doc: /* Return the frame to which FRAME's keystrokes are currently being sent.
1921 This returns nil if FRAME's focus is not redirected.
1922 See `redirect-frame-focus'. */)
1923 (Lisp_Object frame)
1925 CHECK_LIVE_FRAME (frame);
1927 return FRAME_FOCUS_FRAME (XFRAME (frame));
1932 /* Return the value of frame parameter PROP in frame FRAME. */
1934 #ifdef HAVE_WINDOW_SYSTEM
1935 #if !HAVE_NS
1936 static
1937 #endif
1938 Lisp_Object
1939 get_frame_param (register struct frame *frame, Lisp_Object prop)
1941 register Lisp_Object tem;
1943 tem = Fassq (prop, frame->param_alist);
1944 if (EQ (tem, Qnil))
1945 return tem;
1946 return Fcdr (tem);
1948 #endif
1950 /* Return the buffer-predicate of the selected frame. */
1952 Lisp_Object
1953 frame_buffer_predicate (Lisp_Object frame)
1955 return XFRAME (frame)->buffer_predicate;
1958 /* Return the buffer-list of the selected frame. */
1960 static Lisp_Object
1961 frame_buffer_list (Lisp_Object frame)
1963 return XFRAME (frame)->buffer_list;
1966 /* Discard BUFFER from the buffer-list and buried-buffer-list of each frame. */
1968 void
1969 frames_discard_buffer (Lisp_Object buffer)
1971 Lisp_Object frame, tail;
1973 FOR_EACH_FRAME (tail, frame)
1975 FSET (XFRAME (frame), buffer_list,
1976 Fdelq (buffer, XFRAME (frame)->buffer_list));
1977 FSET (XFRAME (frame), buried_buffer_list,
1978 Fdelq (buffer, XFRAME (frame)->buried_buffer_list));
1982 /* Modify the alist in *ALISTPTR to associate PROP with VAL.
1983 If the alist already has an element for PROP, we change it. */
1985 void
1986 store_in_alist (Lisp_Object *alistptr, Lisp_Object prop, Lisp_Object val)
1988 register Lisp_Object tem;
1990 tem = Fassq (prop, *alistptr);
1991 if (EQ (tem, Qnil))
1992 *alistptr = Fcons (Fcons (prop, val), *alistptr);
1993 else
1994 Fsetcdr (tem, val);
1997 static int
1998 frame_name_fnn_p (char *str, ptrdiff_t len)
2000 if (len > 1 && str[0] == 'F' && '0' <= str[1] && str[1] <= '9')
2002 char *p = str + 2;
2003 while ('0' <= *p && *p <= '9')
2004 p++;
2005 if (p == str + len)
2006 return 1;
2008 return 0;
2011 /* Set the name of the terminal frame. Also used by MSDOS frames.
2012 Modeled after x_set_name which is used for WINDOW frames. */
2014 static void
2015 set_term_frame_name (struct frame *f, Lisp_Object name)
2017 f->explicit_name = ! NILP (name);
2019 /* If NAME is nil, set the name to F<num>. */
2020 if (NILP (name))
2022 char namebuf[sizeof "F" + INT_STRLEN_BOUND (printmax_t)];
2024 /* Check for no change needed in this very common case
2025 before we do any consing. */
2026 if (frame_name_fnn_p (SSDATA (f->name), SBYTES (f->name)))
2027 return;
2029 name = make_formatted_string (namebuf, "F%"pMd, ++tty_frame_count);
2031 else
2033 CHECK_STRING (name);
2035 /* Don't change the name if it's already NAME. */
2036 if (! NILP (Fstring_equal (name, f->name)))
2037 return;
2039 /* Don't allow the user to set the frame name to F<num>, so it
2040 doesn't clash with the names we generate for terminal frames. */
2041 if (frame_name_fnn_p (SSDATA (name), SBYTES (name)))
2042 error ("Frame names of the form F<num> are usurped by Emacs");
2045 FSET (f, name, name);
2046 update_mode_lines = 1;
2049 void
2050 store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
2052 register Lisp_Object old_alist_elt;
2054 /* The buffer-list parameters are stored in a special place and not
2055 in the alist. All buffers must be live. */
2056 if (EQ (prop, Qbuffer_list))
2058 Lisp_Object list = Qnil;
2059 for (; CONSP (val); val = XCDR (val))
2060 if (!NILP (Fbuffer_live_p (XCAR (val))))
2061 list = Fcons (XCAR (val), list);
2062 FSET (f, buffer_list, Fnreverse (list));
2063 return;
2065 if (EQ (prop, Qburied_buffer_list))
2067 Lisp_Object list = Qnil;
2068 for (; CONSP (val); val = XCDR (val))
2069 if (!NILP (Fbuffer_live_p (XCAR (val))))
2070 list = Fcons (XCAR (val), list);
2071 FSET (f, buried_buffer_list, Fnreverse (list));
2072 return;
2075 /* If PROP is a symbol which is supposed to have frame-local values,
2076 and it is set up based on this frame, switch to the global
2077 binding. That way, we can create or alter the frame-local binding
2078 without messing up the symbol's status. */
2079 if (SYMBOLP (prop))
2081 struct Lisp_Symbol *sym = XSYMBOL (prop);
2082 start:
2083 switch (sym->redirect)
2085 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
2086 case SYMBOL_PLAINVAL: case SYMBOL_FORWARDED: break;
2087 case SYMBOL_LOCALIZED:
2088 { struct Lisp_Buffer_Local_Value *blv = sym->val.blv;
2089 if (blv->frame_local && BLV_FOUND (blv) && XFRAME (blv->where) == f)
2090 swap_in_global_binding (sym);
2091 break;
2093 default: abort ();
2097 /* The tty color needed to be set before the frame's parameter
2098 alist was updated with the new value. This is not true any more,
2099 but we still do this test early on. */
2100 if (FRAME_TERMCAP_P (f) && EQ (prop, Qtty_color_mode)
2101 && f == FRAME_TTY (f)->previous_frame)
2102 /* Force redisplay of this tty. */
2103 FRAME_TTY (f)->previous_frame = NULL;
2105 /* Update the frame parameter alist. */
2106 old_alist_elt = Fassq (prop, f->param_alist);
2107 if (EQ (old_alist_elt, Qnil))
2108 FSET (f, param_alist, Fcons (Fcons (prop, val), f->param_alist));
2109 else
2110 Fsetcdr (old_alist_elt, val);
2112 /* Update some other special parameters in their special places
2113 in addition to the alist. */
2115 if (EQ (prop, Qbuffer_predicate))
2116 FSET (f, buffer_predicate, val);
2118 if (! FRAME_WINDOW_P (f))
2120 if (EQ (prop, Qmenu_bar_lines))
2121 set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f)));
2122 else if (EQ (prop, Qname))
2123 set_term_frame_name (f, val);
2126 if (EQ (prop, Qminibuffer) && WINDOWP (val))
2128 if (! MINI_WINDOW_P (XWINDOW (val)))
2129 error ("Surrogate minibuffer windows must be minibuffer windows");
2131 if ((FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
2132 && !EQ (val, f->minibuffer_window))
2133 error ("Can't change the surrogate minibuffer of a frame with its own minibuffer");
2135 /* Install the chosen minibuffer window, with proper buffer. */
2136 FSET (f, minibuffer_window, val);
2140 DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0,
2141 doc: /* Return the parameters-alist of frame FRAME.
2142 It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
2143 The meaningful PARMs depend on the kind of frame.
2144 If FRAME is omitted, return information on the currently selected frame. */)
2145 (Lisp_Object frame)
2147 Lisp_Object alist;
2148 FRAME_PTR f;
2149 int height, width;
2150 struct gcpro gcpro1;
2152 if (NILP (frame))
2153 frame = selected_frame;
2155 CHECK_FRAME (frame);
2156 f = XFRAME (frame);
2158 if (!FRAME_LIVE_P (f))
2159 return Qnil;
2161 alist = Fcopy_alist (f->param_alist);
2162 GCPRO1 (alist);
2164 if (!FRAME_WINDOW_P (f))
2166 int fg = FRAME_FOREGROUND_PIXEL (f);
2167 int bg = FRAME_BACKGROUND_PIXEL (f);
2168 Lisp_Object elt;
2170 /* If the frame's parameter alist says the colors are
2171 unspecified and reversed, take the frame's background pixel
2172 for foreground and vice versa. */
2173 elt = Fassq (Qforeground_color, alist);
2174 if (CONSP (elt) && STRINGP (XCDR (elt)))
2176 if (strncmp (SSDATA (XCDR (elt)),
2177 unspecified_bg,
2178 SCHARS (XCDR (elt))) == 0)
2179 store_in_alist (&alist, Qforeground_color, tty_color_name (f, bg));
2180 else if (strncmp (SSDATA (XCDR (elt)),
2181 unspecified_fg,
2182 SCHARS (XCDR (elt))) == 0)
2183 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2185 else
2186 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2187 elt = Fassq (Qbackground_color, alist);
2188 if (CONSP (elt) && STRINGP (XCDR (elt)))
2190 if (strncmp (SSDATA (XCDR (elt)),
2191 unspecified_fg,
2192 SCHARS (XCDR (elt))) == 0)
2193 store_in_alist (&alist, Qbackground_color, tty_color_name (f, fg));
2194 else if (strncmp (SSDATA (XCDR (elt)),
2195 unspecified_bg,
2196 SCHARS (XCDR (elt))) == 0)
2197 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2199 else
2200 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2201 store_in_alist (&alist, intern ("font"),
2202 build_string (FRAME_MSDOS_P (f)
2203 ? "ms-dos"
2204 : FRAME_W32_P (f) ? "w32term"
2205 :"tty"));
2207 store_in_alist (&alist, Qname, f->name);
2208 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2209 store_in_alist (&alist, Qheight, make_number (height));
2210 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2211 store_in_alist (&alist, Qwidth, make_number (width));
2212 store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil));
2213 store_in_alist (&alist, Qminibuffer,
2214 (! FRAME_HAS_MINIBUF_P (f) ? Qnil
2215 : FRAME_MINIBUF_ONLY_P (f) ? Qonly
2216 : FRAME_MINIBUF_WINDOW (f)));
2217 store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
2218 store_in_alist (&alist, Qbuffer_list, frame_buffer_list (frame));
2219 store_in_alist (&alist, Qburied_buffer_list,
2220 XFRAME (frame)->buried_buffer_list);
2222 /* I think this should be done with a hook. */
2223 #ifdef HAVE_WINDOW_SYSTEM
2224 if (FRAME_WINDOW_P (f))
2225 x_report_frame_params (f, &alist);
2226 else
2227 #endif
2229 /* This ought to be correct in f->param_alist for an X frame. */
2230 Lisp_Object lines;
2231 XSETFASTINT (lines, FRAME_MENU_BAR_LINES (f));
2232 store_in_alist (&alist, Qmenu_bar_lines, lines);
2235 UNGCPRO;
2236 return alist;
2240 DEFUN ("frame-parameter", Fframe_parameter, Sframe_parameter, 2, 2, 0,
2241 doc: /* Return FRAME's value for parameter PARAMETER.
2242 If FRAME is nil, describe the currently selected frame. */)
2243 (Lisp_Object frame, Lisp_Object parameter)
2245 struct frame *f;
2246 Lisp_Object value;
2248 if (NILP (frame))
2249 frame = selected_frame;
2250 else
2251 CHECK_FRAME (frame);
2252 CHECK_SYMBOL (parameter);
2254 f = XFRAME (frame);
2255 value = Qnil;
2257 if (FRAME_LIVE_P (f))
2259 /* Avoid consing in frequent cases. */
2260 if (EQ (parameter, Qname))
2261 value = f->name;
2262 #ifdef HAVE_X_WINDOWS
2263 else if (EQ (parameter, Qdisplay) && FRAME_X_P (f))
2264 value = XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element);
2265 #endif /* HAVE_X_WINDOWS */
2266 else if (EQ (parameter, Qbackground_color)
2267 || EQ (parameter, Qforeground_color))
2269 value = Fassq (parameter, f->param_alist);
2270 if (CONSP (value))
2272 value = XCDR (value);
2273 /* Fframe_parameters puts the actual fg/bg color names,
2274 even if f->param_alist says otherwise. This is
2275 important when param_alist's notion of colors is
2276 "unspecified". We need to do the same here. */
2277 if (STRINGP (value) && !FRAME_WINDOW_P (f))
2279 const char *color_name;
2280 ptrdiff_t csz;
2282 if (EQ (parameter, Qbackground_color))
2284 color_name = SSDATA (value);
2285 csz = SCHARS (value);
2286 if (strncmp (color_name, unspecified_bg, csz) == 0)
2287 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2288 else if (strncmp (color_name, unspecified_fg, csz) == 0)
2289 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2291 else if (EQ (parameter, Qforeground_color))
2293 color_name = SSDATA (value);
2294 csz = SCHARS (value);
2295 if (strncmp (color_name, unspecified_fg, csz) == 0)
2296 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2297 else if (strncmp (color_name, unspecified_bg, csz) == 0)
2298 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2302 else
2303 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2305 else if (EQ (parameter, Qdisplay_type)
2306 || EQ (parameter, Qbackground_mode))
2307 value = Fcdr (Fassq (parameter, f->param_alist));
2308 else
2309 /* FIXME: Avoid this code path at all (as well as code duplication)
2310 by sharing more code with Fframe_parameters. */
2311 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2314 return value;
2318 DEFUN ("modify-frame-parameters", Fmodify_frame_parameters,
2319 Smodify_frame_parameters, 2, 2, 0,
2320 doc: /* Modify the parameters of frame FRAME according to ALIST.
2321 If FRAME is nil, it defaults to the selected frame.
2322 ALIST is an alist of parameters to change and their new values.
2323 Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.
2324 The meaningful PARMs depend on the kind of frame.
2325 Undefined PARMs are ignored, but stored in the frame's parameter list
2326 so that `frame-parameters' will return them.
2328 The value of frame parameter FOO can also be accessed
2329 as a frame-local binding for the variable FOO, if you have
2330 enabled such bindings for that variable with `make-variable-frame-local'.
2331 Note that this functionality is obsolete as of Emacs 22.2, and its
2332 use is not recommended. Explicitly check for a frame-parameter instead. */)
2333 (Lisp_Object frame, Lisp_Object alist)
2335 FRAME_PTR f;
2336 register Lisp_Object tail, prop, val;
2338 if (EQ (frame, Qnil))
2339 frame = selected_frame;
2340 CHECK_LIVE_FRAME (frame);
2341 f = XFRAME (frame);
2343 /* I think this should be done with a hook. */
2344 #ifdef HAVE_WINDOW_SYSTEM
2345 if (FRAME_WINDOW_P (f))
2346 x_set_frame_parameters (f, alist);
2347 else
2348 #endif
2349 #ifdef MSDOS
2350 if (FRAME_MSDOS_P (f))
2351 IT_set_frame_parameters (f, alist);
2352 else
2353 #endif
2356 EMACS_INT length = XFASTINT (Flength (alist));
2357 ptrdiff_t i;
2358 Lisp_Object *parms;
2359 Lisp_Object *values;
2360 USE_SAFE_ALLOCA;
2361 SAFE_ALLOCA_LISP (parms, 2 * length);
2362 values = parms + length;
2364 /* Extract parm names and values into those vectors. */
2366 i = 0;
2367 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2369 Lisp_Object elt;
2371 elt = XCAR (tail);
2372 parms[i] = Fcar (elt);
2373 values[i] = Fcdr (elt);
2374 i++;
2377 /* Now process them in reverse of specified order. */
2378 while (--i >= 0)
2380 prop = parms[i];
2381 val = values[i];
2382 store_frame_param (f, prop, val);
2384 if (EQ (prop, Qforeground_color)
2385 || EQ (prop, Qbackground_color))
2386 update_face_from_frame_parameter (f, prop, val);
2389 SAFE_FREE ();
2391 return Qnil;
2394 DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height,
2395 0, 1, 0,
2396 doc: /* Height in pixels of a line in the font in frame FRAME.
2397 If FRAME is omitted, the selected frame is used.
2398 For a terminal frame, the value is always 1. */)
2399 (Lisp_Object frame)
2401 struct frame *f;
2403 if (NILP (frame))
2404 frame = selected_frame;
2405 CHECK_FRAME (frame);
2406 f = XFRAME (frame);
2408 #ifdef HAVE_WINDOW_SYSTEM
2409 if (FRAME_WINDOW_P (f))
2410 return make_number (x_char_height (f));
2411 else
2412 #endif
2413 return make_number (1);
2417 DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width,
2418 0, 1, 0,
2419 doc: /* Width in pixels of characters in the font in frame FRAME.
2420 If FRAME is omitted, the selected frame is used.
2421 On a graphical screen, the width is the standard width of the default font.
2422 For a terminal screen, the value is always 1. */)
2423 (Lisp_Object frame)
2425 struct frame *f;
2427 if (NILP (frame))
2428 frame = selected_frame;
2429 CHECK_FRAME (frame);
2430 f = XFRAME (frame);
2432 #ifdef HAVE_WINDOW_SYSTEM
2433 if (FRAME_WINDOW_P (f))
2434 return make_number (x_char_width (f));
2435 else
2436 #endif
2437 return make_number (1);
2440 DEFUN ("frame-pixel-height", Fframe_pixel_height,
2441 Sframe_pixel_height, 0, 1, 0,
2442 doc: /* Return a FRAME's height in pixels.
2443 If FRAME is omitted, the selected frame is used. The exact value
2444 of the result depends on the window-system and toolkit in use:
2446 In the Gtk+ version of Emacs, it includes only any window (including
2447 the minibuffer or echo area), mode line, and header line. It does not
2448 include the tool bar or menu bar.
2450 With the Motif or Lucid toolkits, it also includes the tool bar (but
2451 not the menu bar).
2453 In a graphical version with no toolkit, it includes both the tool bar
2454 and menu bar.
2456 For a text terminal, it includes the menu bar. In this case, the
2457 result is really in characters rather than pixels (i.e., is identical
2458 to `frame-height'). */)
2459 (Lisp_Object frame)
2461 struct frame *f;
2463 if (NILP (frame))
2464 frame = selected_frame;
2465 CHECK_FRAME (frame);
2466 f = XFRAME (frame);
2468 #ifdef HAVE_WINDOW_SYSTEM
2469 if (FRAME_WINDOW_P (f))
2470 return make_number (x_pixel_height (f));
2471 else
2472 #endif
2473 return make_number (FRAME_LINES (f));
2476 DEFUN ("frame-pixel-width", Fframe_pixel_width,
2477 Sframe_pixel_width, 0, 1, 0,
2478 doc: /* Return FRAME's width in pixels.
2479 For a terminal frame, the result really gives the width in characters.
2480 If FRAME is omitted, the selected frame is used. */)
2481 (Lisp_Object frame)
2483 struct frame *f;
2485 if (NILP (frame))
2486 frame = selected_frame;
2487 CHECK_FRAME (frame);
2488 f = XFRAME (frame);
2490 #ifdef HAVE_WINDOW_SYSTEM
2491 if (FRAME_WINDOW_P (f))
2492 return make_number (x_pixel_width (f));
2493 else
2494 #endif
2495 return make_number (FRAME_COLS (f));
2498 DEFUN ("tool-bar-pixel-width", Ftool_bar_pixel_width,
2499 Stool_bar_pixel_width, 0, 1, 0,
2500 doc: /* Return width in pixels of FRAME's tool bar.
2501 The result is greater than zero only when the tool bar is on the left
2502 or right side of FRAME. If FRAME is omitted, the selected frame is
2503 used. */)
2504 (Lisp_Object frame)
2506 if (NILP (frame))
2507 frame = selected_frame;
2508 CHECK_FRAME (frame);
2510 #ifdef FRAME_TOOLBAR_WIDTH
2511 if (FRAME_WINDOW_P (XFRAME (frame)))
2512 return make_number (FRAME_TOOLBAR_WIDTH (XFRAME (frame)));
2513 #endif
2514 return make_number (0);
2517 DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0,
2518 doc: /* Specify that the frame FRAME has LINES lines.
2519 Optional third arg non-nil means that redisplay should use LINES lines
2520 but that the idea of the actual height of the frame should not be changed. */)
2521 (Lisp_Object frame, Lisp_Object lines, Lisp_Object pretend)
2523 register struct frame *f;
2525 CHECK_TYPE_RANGED_INTEGER (int, lines);
2526 if (NILP (frame))
2527 frame = selected_frame;
2528 CHECK_LIVE_FRAME (frame);
2529 f = XFRAME (frame);
2531 /* I think this should be done with a hook. */
2532 #ifdef HAVE_WINDOW_SYSTEM
2533 if (FRAME_WINDOW_P (f))
2535 if (XINT (lines) != FRAME_LINES (f))
2536 x_set_window_size (f, 1, FRAME_COLS (f), XINT (lines));
2537 do_pending_window_change (0);
2539 else
2540 #endif
2541 change_frame_size (f, XINT (lines), 0, !NILP (pretend), 0, 0);
2542 return Qnil;
2545 DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 3, 0,
2546 doc: /* Specify that the frame FRAME has COLS columns.
2547 Optional third arg non-nil means that redisplay should use COLS columns
2548 but that the idea of the actual width of the frame should not be changed. */)
2549 (Lisp_Object frame, Lisp_Object cols, Lisp_Object pretend)
2551 register struct frame *f;
2552 CHECK_TYPE_RANGED_INTEGER (int, cols);
2553 if (NILP (frame))
2554 frame = selected_frame;
2555 CHECK_LIVE_FRAME (frame);
2556 f = XFRAME (frame);
2558 /* I think this should be done with a hook. */
2559 #ifdef HAVE_WINDOW_SYSTEM
2560 if (FRAME_WINDOW_P (f))
2562 if (XINT (cols) != FRAME_COLS (f))
2563 x_set_window_size (f, 1, XINT (cols), FRAME_LINES (f));
2564 do_pending_window_change (0);
2566 else
2567 #endif
2568 change_frame_size (f, 0, XINT (cols), !NILP (pretend), 0, 0);
2569 return Qnil;
2572 DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0,
2573 doc: /* Sets size of FRAME to COLS by ROWS, measured in characters. */)
2574 (Lisp_Object frame, Lisp_Object cols, Lisp_Object rows)
2576 register struct frame *f;
2578 CHECK_LIVE_FRAME (frame);
2579 CHECK_TYPE_RANGED_INTEGER (int, cols);
2580 CHECK_TYPE_RANGED_INTEGER (int, rows);
2581 f = XFRAME (frame);
2583 /* I think this should be done with a hook. */
2584 #ifdef HAVE_WINDOW_SYSTEM
2585 if (FRAME_WINDOW_P (f))
2587 if (XINT (rows) != FRAME_LINES (f)
2588 || XINT (cols) != FRAME_COLS (f)
2589 || f->new_text_lines || f->new_text_cols)
2590 x_set_window_size (f, 1, XINT (cols), XINT (rows));
2591 do_pending_window_change (0);
2593 else
2594 #endif
2595 change_frame_size (f, XINT (rows), XINT (cols), 0, 0, 0);
2597 return Qnil;
2600 DEFUN ("set-frame-position", Fset_frame_position,
2601 Sset_frame_position, 3, 3, 0,
2602 doc: /* Sets position of FRAME in pixels to XOFFSET by YOFFSET.
2603 This is actually the position of the upper left corner of the frame.
2604 Negative values for XOFFSET or YOFFSET are interpreted relative to
2605 the rightmost or bottommost possible position (that stays within the screen). */)
2606 (Lisp_Object frame, Lisp_Object xoffset, Lisp_Object yoffset)
2608 register struct frame *f;
2610 CHECK_LIVE_FRAME (frame);
2611 CHECK_TYPE_RANGED_INTEGER (int, xoffset);
2612 CHECK_TYPE_RANGED_INTEGER (int, yoffset);
2613 f = XFRAME (frame);
2615 /* I think this should be done with a hook. */
2616 #ifdef HAVE_WINDOW_SYSTEM
2617 if (FRAME_WINDOW_P (f))
2618 x_set_offset (f, XINT (xoffset), XINT (yoffset), 1);
2619 #endif
2621 return Qt;
2625 /***********************************************************************
2626 Frame Parameters
2627 ***********************************************************************/
2629 /* Connect the frame-parameter names for X frames
2630 to the ways of passing the parameter values to the window system.
2632 The name of a parameter, as a Lisp symbol,
2633 has an `x-frame-parameter' property which is an integer in Lisp
2634 that is an index in this table. */
2636 struct frame_parm_table {
2637 const char *name;
2638 Lisp_Object *variable;
2641 static const struct frame_parm_table frame_parms[] =
2643 {"auto-raise", &Qauto_raise},
2644 {"auto-lower", &Qauto_lower},
2645 {"background-color", 0},
2646 {"border-color", &Qborder_color},
2647 {"border-width", &Qborder_width},
2648 {"cursor-color", &Qcursor_color},
2649 {"cursor-type", &Qcursor_type},
2650 {"font", 0},
2651 {"foreground-color", 0},
2652 {"icon-name", &Qicon_name},
2653 {"icon-type", &Qicon_type},
2654 {"internal-border-width", &Qinternal_border_width},
2655 {"menu-bar-lines", &Qmenu_bar_lines},
2656 {"mouse-color", &Qmouse_color},
2657 {"name", &Qname},
2658 {"scroll-bar-width", &Qscroll_bar_width},
2659 {"title", &Qtitle},
2660 {"unsplittable", &Qunsplittable},
2661 {"vertical-scroll-bars", &Qvertical_scroll_bars},
2662 {"visibility", &Qvisibility},
2663 {"tool-bar-lines", &Qtool_bar_lines},
2664 {"scroll-bar-foreground", &Qscroll_bar_foreground},
2665 {"scroll-bar-background", &Qscroll_bar_background},
2666 {"screen-gamma", &Qscreen_gamma},
2667 {"line-spacing", &Qline_spacing},
2668 {"left-fringe", &Qleft_fringe},
2669 {"right-fringe", &Qright_fringe},
2670 {"wait-for-wm", &Qwait_for_wm},
2671 {"fullscreen", &Qfullscreen},
2672 {"font-backend", &Qfont_backend},
2673 {"alpha", &Qalpha},
2674 {"sticky", &Qsticky},
2675 {"tool-bar-position", &Qtool_bar_position},
2678 #ifdef WINDOWSNT
2680 /* Calculate fullscreen size. Return in *TOP_POS and *LEFT_POS the
2681 wanted positions of the WM window (not Emacs window).
2682 Return in *WIDTH and *HEIGHT the wanted width and height of Emacs
2683 window (FRAME_X_WINDOW).
2686 void
2687 x_fullscreen_adjust (struct frame *f, int *width, int *height, int *top_pos, int *left_pos)
2689 int newwidth = FRAME_COLS (f);
2690 int newheight = FRAME_LINES (f);
2691 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2693 *top_pos = f->top_pos;
2694 *left_pos = f->left_pos;
2696 if (f->want_fullscreen & FULLSCREEN_HEIGHT)
2698 int ph;
2700 ph = x_display_pixel_height (dpyinfo);
2701 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2702 ph = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, newheight) - f->y_pixels_diff;
2703 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2704 *top_pos = 0;
2707 if (f->want_fullscreen & FULLSCREEN_WIDTH)
2709 int pw;
2711 pw = x_display_pixel_width (dpyinfo);
2712 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2713 pw = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, newwidth) - f->x_pixels_diff;
2714 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2715 *left_pos = 0;
2718 *width = newwidth;
2719 *height = newheight;
2722 #endif /* WINDOWSNT */
2724 #ifdef HAVE_WINDOW_SYSTEM
2726 /* Change the parameters of frame F as specified by ALIST.
2727 If a parameter is not specially recognized, do nothing special;
2728 otherwise call the `x_set_...' function for that parameter.
2729 Except for certain geometry properties, always call store_frame_param
2730 to store the new value in the parameter alist. */
2732 void
2733 x_set_frame_parameters (FRAME_PTR f, Lisp_Object alist)
2735 Lisp_Object tail;
2737 /* If both of these parameters are present, it's more efficient to
2738 set them both at once. So we wait until we've looked at the
2739 entire list before we set them. */
2740 int width, height;
2742 /* Same here. */
2743 Lisp_Object left, top;
2745 /* Same with these. */
2746 Lisp_Object icon_left, icon_top;
2748 /* Record in these vectors all the parms specified. */
2749 Lisp_Object *parms;
2750 Lisp_Object *values;
2751 ptrdiff_t i, p;
2752 int left_no_change = 0, top_no_change = 0;
2753 int icon_left_no_change = 0, icon_top_no_change = 0;
2754 int size_changed = 0;
2755 struct gcpro gcpro1, gcpro2;
2757 i = 0;
2758 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2759 i++;
2761 parms = alloca (i * sizeof *parms);
2762 values = alloca (i * sizeof *values);
2764 /* Extract parm names and values into those vectors. */
2766 i = 0;
2767 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2769 Lisp_Object elt;
2771 elt = XCAR (tail);
2772 parms[i] = Fcar (elt);
2773 values[i] = Fcdr (elt);
2774 i++;
2776 /* TAIL and ALIST are not used again below here. */
2777 alist = tail = Qnil;
2779 GCPRO2 (*parms, *values);
2780 gcpro1.nvars = i;
2781 gcpro2.nvars = i;
2783 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
2784 because their values appear in VALUES and strings are not valid. */
2785 top = left = Qunbound;
2786 icon_left = icon_top = Qunbound;
2788 /* Provide default values for HEIGHT and WIDTH. */
2789 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2790 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2792 /* Process foreground_color and background_color before anything else.
2793 They are independent of other properties, but other properties (e.g.,
2794 cursor_color) are dependent upon them. */
2795 /* Process default font as well, since fringe widths depends on it. */
2796 for (p = 0; p < i; p++)
2798 Lisp_Object prop, val;
2800 prop = parms[p];
2801 val = values[p];
2802 if (EQ (prop, Qforeground_color)
2803 || EQ (prop, Qbackground_color)
2804 || EQ (prop, Qfont))
2806 register Lisp_Object param_index, old_value;
2808 old_value = get_frame_param (f, prop);
2809 if (NILP (Fequal (val, old_value)))
2811 store_frame_param (f, prop, val);
2813 param_index = Fget (prop, Qx_frame_parameter);
2814 if (NATNUMP (param_index)
2815 && (XFASTINT (param_index)
2816 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2817 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
2818 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2823 /* Now process them in reverse of specified order. */
2824 while (i-- != 0)
2826 Lisp_Object prop, val;
2828 prop = parms[i];
2829 val = values[i];
2831 if (EQ (prop, Qwidth) && RANGED_INTEGERP (0, val, INT_MAX))
2833 size_changed = 1;
2834 width = XFASTINT (val);
2836 else if (EQ (prop, Qheight) && RANGED_INTEGERP (0, val, INT_MAX))
2838 size_changed = 1;
2839 height = XFASTINT (val);
2841 else if (EQ (prop, Qtop))
2842 top = val;
2843 else if (EQ (prop, Qleft))
2844 left = val;
2845 else if (EQ (prop, Qicon_top))
2846 icon_top = val;
2847 else if (EQ (prop, Qicon_left))
2848 icon_left = val;
2849 else if (EQ (prop, Qforeground_color)
2850 || EQ (prop, Qbackground_color)
2851 || EQ (prop, Qfont))
2852 /* Processed above. */
2853 continue;
2854 else
2856 register Lisp_Object param_index, old_value;
2858 old_value = get_frame_param (f, prop);
2860 store_frame_param (f, prop, val);
2862 param_index = Fget (prop, Qx_frame_parameter);
2863 if (NATNUMP (param_index)
2864 && (XFASTINT (param_index)
2865 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2866 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
2867 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2871 /* Don't die if just one of these was set. */
2872 if (EQ (left, Qunbound))
2874 left_no_change = 1;
2875 if (f->left_pos < 0)
2876 left = Fcons (Qplus, Fcons (make_number (f->left_pos), Qnil));
2877 else
2878 XSETINT (left, f->left_pos);
2880 if (EQ (top, Qunbound))
2882 top_no_change = 1;
2883 if (f->top_pos < 0)
2884 top = Fcons (Qplus, Fcons (make_number (f->top_pos), Qnil));
2885 else
2886 XSETINT (top, f->top_pos);
2889 /* If one of the icon positions was not set, preserve or default it. */
2890 if (! TYPE_RANGED_INTEGERP (int, icon_left))
2892 icon_left_no_change = 1;
2893 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
2894 if (NILP (icon_left))
2895 XSETINT (icon_left, 0);
2897 if (! TYPE_RANGED_INTEGERP (int, icon_top))
2899 icon_top_no_change = 1;
2900 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
2901 if (NILP (icon_top))
2902 XSETINT (icon_top, 0);
2905 /* Don't set these parameters unless they've been explicitly
2906 specified. The window might be mapped or resized while we're in
2907 this function, and we don't want to override that unless the lisp
2908 code has asked for it.
2910 Don't set these parameters unless they actually differ from the
2911 window's current parameters; the window may not actually exist
2912 yet. */
2914 Lisp_Object frame;
2916 check_frame_size (f, &height, &width);
2918 XSETFRAME (frame, f);
2920 if (size_changed
2921 && (width != FRAME_COLS (f)
2922 || height != FRAME_LINES (f)
2923 || f->new_text_lines || f->new_text_cols))
2924 Fset_frame_size (frame, make_number (width), make_number (height));
2926 if ((!NILP (left) || !NILP (top))
2927 && ! (left_no_change && top_no_change)
2928 && ! (NUMBERP (left) && XINT (left) == f->left_pos
2929 && NUMBERP (top) && XINT (top) == f->top_pos))
2931 int leftpos = 0;
2932 int toppos = 0;
2934 /* Record the signs. */
2935 f->size_hint_flags &= ~ (XNegative | YNegative);
2936 if (EQ (left, Qminus))
2937 f->size_hint_flags |= XNegative;
2938 else if (TYPE_RANGED_INTEGERP (int, left))
2940 leftpos = XINT (left);
2941 if (leftpos < 0)
2942 f->size_hint_flags |= XNegative;
2944 else if (CONSP (left) && EQ (XCAR (left), Qminus)
2945 && CONSP (XCDR (left))
2946 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (left)), INT_MAX))
2948 leftpos = - XINT (XCAR (XCDR (left)));
2949 f->size_hint_flags |= XNegative;
2951 else if (CONSP (left) && EQ (XCAR (left), Qplus)
2952 && CONSP (XCDR (left))
2953 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (left))))
2955 leftpos = XINT (XCAR (XCDR (left)));
2958 if (EQ (top, Qminus))
2959 f->size_hint_flags |= YNegative;
2960 else if (TYPE_RANGED_INTEGERP (int, top))
2962 toppos = XINT (top);
2963 if (toppos < 0)
2964 f->size_hint_flags |= YNegative;
2966 else if (CONSP (top) && EQ (XCAR (top), Qminus)
2967 && CONSP (XCDR (top))
2968 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (top)), INT_MAX))
2970 toppos = - XINT (XCAR (XCDR (top)));
2971 f->size_hint_flags |= YNegative;
2973 else if (CONSP (top) && EQ (XCAR (top), Qplus)
2974 && CONSP (XCDR (top))
2975 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (top))))
2977 toppos = XINT (XCAR (XCDR (top)));
2981 /* Store the numeric value of the position. */
2982 f->top_pos = toppos;
2983 f->left_pos = leftpos;
2985 f->win_gravity = NorthWestGravity;
2987 /* Actually set that position, and convert to absolute. */
2988 x_set_offset (f, leftpos, toppos, -1);
2991 if ((!NILP (icon_left) || !NILP (icon_top))
2992 && ! (icon_left_no_change && icon_top_no_change))
2993 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
2996 UNGCPRO;
3000 /* Insert a description of internally-recorded parameters of frame X
3001 into the parameter alist *ALISTPTR that is to be given to the user.
3002 Only parameters that are specific to the X window system
3003 and whose values are not correctly recorded in the frame's
3004 param_alist need to be considered here. */
3006 void
3007 x_report_frame_params (struct frame *f, Lisp_Object *alistptr)
3009 char buf[16];
3010 Lisp_Object tem;
3011 unsigned long w;
3013 /* Represent negative positions (off the top or left screen edge)
3014 in a way that Fmodify_frame_parameters will understand correctly. */
3015 XSETINT (tem, f->left_pos);
3016 if (f->left_pos >= 0)
3017 store_in_alist (alistptr, Qleft, tem);
3018 else
3019 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
3021 XSETINT (tem, f->top_pos);
3022 if (f->top_pos >= 0)
3023 store_in_alist (alistptr, Qtop, tem);
3024 else
3025 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
3027 store_in_alist (alistptr, Qborder_width,
3028 make_number (f->border_width));
3029 store_in_alist (alistptr, Qinternal_border_width,
3030 make_number (FRAME_INTERNAL_BORDER_WIDTH (f)));
3031 store_in_alist (alistptr, Qleft_fringe,
3032 make_number (FRAME_LEFT_FRINGE_WIDTH (f)));
3033 store_in_alist (alistptr, Qright_fringe,
3034 make_number (FRAME_RIGHT_FRINGE_WIDTH (f)));
3035 store_in_alist (alistptr, Qscroll_bar_width,
3036 (! FRAME_HAS_VERTICAL_SCROLL_BARS (f)
3037 ? make_number (0)
3038 : FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0
3039 ? make_number (FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3040 /* nil means "use default width"
3041 for non-toolkit scroll bar.
3042 ruler-mode.el depends on this. */
3043 : Qnil));
3044 /* FRAME_X_WINDOW is not guaranteed to return an integer. E.g., on
3045 MS-Windows it returns a value whose type is HANDLE, which is
3046 actually a pointer. Explicit casting avoids compiler
3047 warnings. */
3048 w = (unsigned long) FRAME_X_WINDOW (f);
3049 store_in_alist (alistptr, Qwindow_id,
3050 make_formatted_string (buf, "%lu", w));
3051 #ifdef HAVE_X_WINDOWS
3052 #ifdef USE_X_TOOLKIT
3053 /* Tooltip frame may not have this widget. */
3054 if (FRAME_X_OUTPUT (f)->widget)
3055 #endif
3056 w = (unsigned long) FRAME_OUTER_WINDOW (f);
3057 store_in_alist (alistptr, Qouter_window_id,
3058 make_formatted_string (buf, "%lu", w));
3059 #endif
3060 store_in_alist (alistptr, Qicon_name, f->icon_name);
3061 FRAME_SAMPLE_VISIBILITY (f);
3062 store_in_alist (alistptr, Qvisibility,
3063 (FRAME_VISIBLE_P (f) ? Qt
3064 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
3065 store_in_alist (alistptr, Qdisplay,
3066 XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
3068 if (FRAME_X_OUTPUT (f)->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
3069 tem = Qnil;
3070 else
3071 XSETFASTINT (tem, FRAME_X_OUTPUT (f)->parent_desc);
3072 store_in_alist (alistptr, Qexplicit_name, (f->explicit_name ? Qt : Qnil));
3073 store_in_alist (alistptr, Qparent_id, tem);
3074 store_in_alist (alistptr, Qtool_bar_position, f->tool_bar_position);
3078 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
3079 the previous value of that parameter, NEW_VALUE is the new value. */
3081 void
3082 x_set_fullscreen (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3084 if (NILP (new_value))
3085 f->want_fullscreen = FULLSCREEN_NONE;
3086 else if (EQ (new_value, Qfullboth) || EQ (new_value, Qfullscreen))
3087 f->want_fullscreen = FULLSCREEN_BOTH;
3088 else if (EQ (new_value, Qfullwidth))
3089 f->want_fullscreen = FULLSCREEN_WIDTH;
3090 else if (EQ (new_value, Qfullheight))
3091 f->want_fullscreen = FULLSCREEN_HEIGHT;
3092 else if (EQ (new_value, Qmaximized))
3093 f->want_fullscreen = FULLSCREEN_MAXIMIZED;
3095 if (FRAME_TERMINAL (f)->fullscreen_hook != NULL)
3096 FRAME_TERMINAL (f)->fullscreen_hook (f);
3100 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
3101 the previous value of that parameter, NEW_VALUE is the new value. */
3103 void
3104 x_set_line_spacing (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3106 if (NILP (new_value))
3107 f->extra_line_spacing = 0;
3108 else if (RANGED_INTEGERP (0, new_value, INT_MAX))
3109 f->extra_line_spacing = XFASTINT (new_value);
3110 else
3111 signal_error ("Invalid line-spacing", new_value);
3112 if (FRAME_VISIBLE_P (f))
3113 redraw_frame (f);
3117 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
3118 the previous value of that parameter, NEW_VALUE is the new value. */
3120 void
3121 x_set_screen_gamma (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3123 Lisp_Object bgcolor;
3125 if (NILP (new_value))
3126 f->gamma = 0;
3127 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
3128 /* The value 0.4545 is the normal viewing gamma. */
3129 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
3130 else
3131 signal_error ("Invalid screen-gamma", new_value);
3133 /* Apply the new gamma value to the frame background. */
3134 bgcolor = Fassq (Qbackground_color, f->param_alist);
3135 if (CONSP (bgcolor) && (bgcolor = XCDR (bgcolor), STRINGP (bgcolor)))
3137 Lisp_Object parm_index = Fget (Qbackground_color, Qx_frame_parameter);
3138 if (NATNUMP (parm_index)
3139 && (XFASTINT (parm_index)
3140 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3141 && FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
3142 (*FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
3143 (f, bgcolor, Qnil);
3146 Fclear_face_cache (Qnil);
3150 void
3151 x_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3153 Lisp_Object font_object;
3154 int fontset = -1;
3155 #ifdef HAVE_X_WINDOWS
3156 Lisp_Object font_param = arg;
3157 #endif
3159 /* Set the frame parameter back to the old value because we may
3160 fail to use ARG as the new parameter value. */
3161 store_frame_param (f, Qfont, oldval);
3163 /* ARG is a fontset name, a font name, a cons of fontset name and a
3164 font object, or a font object. In the last case, this function
3165 never fail. */
3166 if (STRINGP (arg))
3168 fontset = fs_query_fontset (arg, 0);
3169 if (fontset < 0)
3171 font_object = font_open_by_name (f, arg);
3172 if (NILP (font_object))
3173 error ("Font `%s' is not defined", SSDATA (arg));
3174 arg = AREF (font_object, FONT_NAME_INDEX);
3176 else if (fontset > 0)
3178 font_object = font_open_by_name (f, fontset_ascii (fontset));
3179 if (NILP (font_object))
3180 error ("Font `%s' is not defined", SDATA (arg));
3181 arg = AREF (font_object, FONT_NAME_INDEX);
3183 else
3184 error ("The default fontset can't be used for a frame font");
3186 else if (CONSP (arg) && STRINGP (XCAR (arg)) && FONT_OBJECT_P (XCDR (arg)))
3188 /* This is the case that the ASCII font of F's fontset XCAR
3189 (arg) is changed to the font XCDR (arg) by
3190 `set-fontset-font'. */
3191 fontset = fs_query_fontset (XCAR (arg), 0);
3192 if (fontset < 0)
3193 error ("Unknown fontset: %s", SDATA (XCAR (arg)));
3194 font_object = XCDR (arg);
3195 arg = AREF (font_object, FONT_NAME_INDEX);
3196 #ifdef HAVE_X_WINDOWS
3197 font_param = Ffont_get (font_object, QCname);
3198 #endif
3200 else if (FONT_OBJECT_P (arg))
3202 font_object = arg;
3203 #ifdef HAVE_X_WINDOWS
3204 font_param = Ffont_get (font_object, QCname);
3205 #endif
3206 /* This is to store the XLFD font name in the frame parameter for
3207 backward compatibility. We should store the font-object
3208 itself in the future. */
3209 arg = AREF (font_object, FONT_NAME_INDEX);
3210 fontset = FRAME_FONTSET (f);
3211 /* Check if we can use the current fontset. If not, set FONTSET
3212 to -1 to generate a new fontset from FONT-OBJECT. */
3213 if (fontset >= 0)
3215 Lisp_Object ascii_font = fontset_ascii (fontset);
3216 Lisp_Object spec = font_spec_from_name (ascii_font);
3218 if (! font_match_p (spec, font_object))
3219 fontset = -1;
3222 else
3223 signal_error ("Invalid font", arg);
3225 if (! NILP (Fequal (font_object, oldval)))
3226 return;
3228 x_new_font (f, font_object, fontset);
3229 store_frame_param (f, Qfont, arg);
3230 #ifdef HAVE_X_WINDOWS
3231 store_frame_param (f, Qfont_param, font_param);
3232 #endif
3233 /* Recalculate toolbar height. */
3234 f->n_tool_bar_rows = 0;
3235 /* Ensure we redraw it. */
3236 clear_current_matrices (f);
3238 recompute_basic_faces (f);
3240 do_pending_window_change (0);
3242 /* We used to call face-set-after-frame-default here, but it leads to
3243 recursive calls (since that function can set the `default' face's
3244 font which in turns changes the frame's `font' parameter).
3245 Also I don't know what this call is meant to do, but it seems the
3246 wrong way to do it anyway (it does a lot more work than what seems
3247 reasonable in response to a change to `font'). */
3251 void
3252 x_set_font_backend (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3254 if (! NILP (new_value)
3255 && !CONSP (new_value))
3257 char *p0, *p1;
3259 CHECK_STRING (new_value);
3260 p0 = p1 = SSDATA (new_value);
3261 new_value = Qnil;
3262 while (*p0)
3264 while (*p1 && ! isspace (*p1) && *p1 != ',') p1++;
3265 if (p0 < p1)
3266 new_value = Fcons (Fintern (make_string (p0, p1 - p0), Qnil),
3267 new_value);
3268 if (*p1)
3270 int c;
3272 while ((c = *++p1) && isspace (c));
3274 p0 = p1;
3276 new_value = Fnreverse (new_value);
3279 if (! NILP (old_value) && ! NILP (Fequal (old_value, new_value)))
3280 return;
3282 if (FRAME_FONT (f))
3283 free_all_realized_faces (Qnil);
3285 new_value = font_update_drivers (f, NILP (new_value) ? Qt : new_value);
3286 if (NILP (new_value))
3288 if (NILP (old_value))
3289 error ("No font backend available");
3290 font_update_drivers (f, old_value);
3291 error ("None of specified font backends are available");
3293 store_frame_param (f, Qfont_backend, new_value);
3295 if (FRAME_FONT (f))
3297 Lisp_Object frame;
3299 XSETFRAME (frame, f);
3300 x_set_font (f, Fframe_parameter (frame, Qfont), Qnil);
3301 ++face_change_count;
3302 ++windows_or_buffers_changed;
3307 void
3308 x_set_fringe_width (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3310 compute_fringe_widths (f, 1);
3311 #ifdef HAVE_X_WINDOWS
3312 /* Must adjust this so window managers report correct number of columns. */
3313 if (FRAME_X_WINDOW (f) != 0)
3314 x_wm_set_size_hint (f, 0, 0);
3315 #endif
3318 void
3319 x_set_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3321 CHECK_TYPE_RANGED_INTEGER (int, arg);
3323 if (XINT (arg) == f->border_width)
3324 return;
3326 if (FRAME_X_WINDOW (f) != 0)
3327 error ("Cannot change the border width of a frame");
3329 f->border_width = XINT (arg);
3332 void
3333 x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3335 int old = FRAME_INTERNAL_BORDER_WIDTH (f);
3337 CHECK_TYPE_RANGED_INTEGER (int, arg);
3338 FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
3339 if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
3340 FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
3342 #ifdef USE_X_TOOLKIT
3343 if (FRAME_X_OUTPUT (f)->edit_widget)
3344 widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
3345 #endif
3347 if (FRAME_INTERNAL_BORDER_WIDTH (f) == old)
3348 return;
3350 if (FRAME_X_WINDOW (f) != 0)
3352 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3353 SET_FRAME_GARBAGED (f);
3354 do_pending_window_change (0);
3356 else
3357 SET_FRAME_GARBAGED (f);
3360 void
3361 x_set_visibility (struct frame *f, Lisp_Object value, Lisp_Object oldval)
3363 Lisp_Object frame;
3364 XSETFRAME (frame, f);
3366 if (NILP (value))
3367 Fmake_frame_invisible (frame, Qt);
3368 else if (EQ (value, Qicon))
3369 Ficonify_frame (frame);
3370 else
3371 Fmake_frame_visible (frame);
3374 void
3375 x_set_autoraise (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3377 f->auto_raise = !EQ (Qnil, arg);
3380 void
3381 x_set_autolower (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3383 f->auto_lower = !EQ (Qnil, arg);
3386 void
3387 x_set_unsplittable (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3389 f->no_split = !NILP (arg);
3392 void
3393 x_set_vertical_scroll_bars (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3395 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
3396 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
3397 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
3398 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
3400 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
3401 = (NILP (arg)
3402 ? vertical_scroll_bar_none
3403 : EQ (Qleft, arg)
3404 ? vertical_scroll_bar_left
3405 : EQ (Qright, arg)
3406 ? vertical_scroll_bar_right
3407 : EQ (Qleft, Vdefault_frame_scroll_bars)
3408 ? vertical_scroll_bar_left
3409 : EQ (Qright, Vdefault_frame_scroll_bars)
3410 ? vertical_scroll_bar_right
3411 : vertical_scroll_bar_none);
3413 /* We set this parameter before creating the X window for the
3414 frame, so we can get the geometry right from the start.
3415 However, if the window hasn't been created yet, we shouldn't
3416 call x_set_window_size. */
3417 if (FRAME_X_WINDOW (f))
3418 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3419 do_pending_window_change (0);
3423 void
3424 x_set_scroll_bar_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3426 int wid = FRAME_COLUMN_WIDTH (f);
3428 if (NILP (arg))
3430 x_set_scroll_bar_default_width (f);
3432 if (FRAME_X_WINDOW (f))
3433 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3434 do_pending_window_change (0);
3436 else if (RANGED_INTEGERP (1, arg, INT_MAX)
3437 && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3439 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
3440 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
3442 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg);
3443 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
3444 if (FRAME_X_WINDOW (f))
3445 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3446 do_pending_window_change (0);
3449 change_frame_size (f, 0, FRAME_COLS (f), 0, 0, 0);
3450 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
3451 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
3456 /* Return non-nil if frame F wants a bitmap icon. */
3458 Lisp_Object
3459 x_icon_type (FRAME_PTR f)
3461 Lisp_Object tem;
3463 tem = assq_no_quit (Qicon_type, f->param_alist);
3464 if (CONSP (tem))
3465 return XCDR (tem);
3466 else
3467 return Qnil;
3470 void
3471 x_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3473 double alpha = 1.0;
3474 double newval[2];
3475 int i;
3476 Lisp_Object item;
3478 for (i = 0; i < 2; i++)
3480 newval[i] = 1.0;
3481 if (CONSP (arg))
3483 item = CAR (arg);
3484 arg = CDR (arg);
3486 else
3487 item = arg;
3489 if (NILP (item))
3490 alpha = - 1.0;
3491 else if (FLOATP (item))
3493 alpha = XFLOAT_DATA (item);
3494 if (alpha < 0.0 || 1.0 < alpha)
3495 args_out_of_range (make_float (0.0), make_float (1.0));
3497 else if (INTEGERP (item))
3499 EMACS_INT ialpha = XINT (item);
3500 if (ialpha < 0 || 100 < ialpha)
3501 args_out_of_range (make_number (0), make_number (100));
3502 else
3503 alpha = ialpha / 100.0;
3505 else
3506 wrong_type_argument (Qnumberp, item);
3507 newval[i] = alpha;
3510 for (i = 0; i < 2; i++)
3511 f->alpha[i] = newval[i];
3513 #if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA)
3514 BLOCK_INPUT;
3515 x_set_frame_alpha (f);
3516 UNBLOCK_INPUT;
3517 #endif
3519 return;
3523 /* Subroutines of creating an X frame. */
3525 /* Make sure that Vx_resource_name is set to a reasonable value.
3526 Fix it up, or set it to `emacs' if it is too hopeless. */
3528 void
3529 validate_x_resource_name (void)
3531 ptrdiff_t len = 0;
3532 /* Number of valid characters in the resource name. */
3533 ptrdiff_t good_count = 0;
3534 /* Number of invalid characters in the resource name. */
3535 ptrdiff_t bad_count = 0;
3536 Lisp_Object new;
3537 ptrdiff_t i;
3539 if (!STRINGP (Vx_resource_class))
3540 Vx_resource_class = build_string (EMACS_CLASS);
3542 if (STRINGP (Vx_resource_name))
3544 unsigned char *p = SDATA (Vx_resource_name);
3546 len = SBYTES (Vx_resource_name);
3548 /* Only letters, digits, - and _ are valid in resource names.
3549 Count the valid characters and count the invalid ones. */
3550 for (i = 0; i < len; i++)
3552 int c = p[i];
3553 if (! ((c >= 'a' && c <= 'z')
3554 || (c >= 'A' && c <= 'Z')
3555 || (c >= '0' && c <= '9')
3556 || c == '-' || c == '_'))
3557 bad_count++;
3558 else
3559 good_count++;
3562 else
3563 /* Not a string => completely invalid. */
3564 bad_count = 5, good_count = 0;
3566 /* If name is valid already, return. */
3567 if (bad_count == 0)
3568 return;
3570 /* If name is entirely invalid, or nearly so, or is so implausibly
3571 large that alloca might not work, use `emacs'. */
3572 if (good_count < 2 || MAX_ALLOCA - sizeof ".customization" < len)
3574 Vx_resource_name = build_string ("emacs");
3575 return;
3578 /* Name is partly valid. Copy it and replace the invalid characters
3579 with underscores. */
3581 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
3583 for (i = 0; i < len; i++)
3585 int c = SREF (new, i);
3586 if (! ((c >= 'a' && c <= 'z')
3587 || (c >= 'A' && c <= 'Z')
3588 || (c >= '0' && c <= '9')
3589 || c == '-' || c == '_'))
3590 SSET (new, i, '_');
3595 extern char *x_get_string_resource (XrmDatabase, const char *, const char *);
3596 extern Display_Info *check_x_display_info (Lisp_Object);
3599 /* Get specified attribute from resource database RDB.
3600 See Fx_get_resource below for other parameters. */
3602 static Lisp_Object
3603 xrdb_get_resource (XrmDatabase rdb, Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3605 register char *value;
3606 char *name_key;
3607 char *class_key;
3609 CHECK_STRING (attribute);
3610 CHECK_STRING (class);
3612 if (!NILP (component))
3613 CHECK_STRING (component);
3614 if (!NILP (subclass))
3615 CHECK_STRING (subclass);
3616 if (NILP (component) != NILP (subclass))
3617 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3619 validate_x_resource_name ();
3621 /* Allocate space for the components, the dots which separate them,
3622 and the final '\0'. Make them big enough for the worst case. */
3623 name_key = alloca (SBYTES (Vx_resource_name)
3624 + (STRINGP (component)
3625 ? SBYTES (component) : 0)
3626 + SBYTES (attribute)
3627 + 3);
3629 class_key = alloca (SBYTES (Vx_resource_class)
3630 + SBYTES (class)
3631 + (STRINGP (subclass)
3632 ? SBYTES (subclass) : 0)
3633 + 3);
3635 /* Start with emacs.FRAMENAME for the name (the specific one)
3636 and with `Emacs' for the class key (the general one). */
3637 strcpy (name_key, SSDATA (Vx_resource_name));
3638 strcpy (class_key, SSDATA (Vx_resource_class));
3640 strcat (class_key, ".");
3641 strcat (class_key, SSDATA (class));
3643 if (!NILP (component))
3645 strcat (class_key, ".");
3646 strcat (class_key, SSDATA (subclass));
3648 strcat (name_key, ".");
3649 strcat (name_key, SSDATA (component));
3652 strcat (name_key, ".");
3653 strcat (name_key, SSDATA (attribute));
3655 value = x_get_string_resource (rdb, name_key, class_key);
3657 if (value != (char *) 0 && *value)
3658 return build_string (value);
3659 else
3660 return Qnil;
3664 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
3665 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
3666 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
3667 class, where INSTANCE is the name under which Emacs was invoked, or
3668 the name specified by the `-name' or `-rn' command-line arguments.
3670 The optional arguments COMPONENT and SUBCLASS add to the key and the
3671 class, respectively. You must specify both of them or neither.
3672 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
3673 and the class is `Emacs.CLASS.SUBCLASS'. */)
3674 (Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3676 #ifdef HAVE_X_WINDOWS
3677 check_x ();
3678 #endif
3680 return xrdb_get_resource (check_x_display_info (Qnil)->xrdb,
3681 attribute, class, component, subclass);
3684 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
3686 Lisp_Object
3687 display_x_get_resource (Display_Info *dpyinfo, Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3689 return xrdb_get_resource (dpyinfo->xrdb,
3690 attribute, class, component, subclass);
3693 #if defined HAVE_X_WINDOWS && !defined USE_X_TOOLKIT
3694 /* Used when C code wants a resource value. */
3695 /* Called from oldXMenu/Create.c. */
3696 char *
3697 x_get_resource_string (const char *attribute, const char *class)
3699 char *result;
3700 struct frame *sf = SELECTED_FRAME ();
3701 ptrdiff_t invocation_namelen = SBYTES (Vinvocation_name);
3702 USE_SAFE_ALLOCA;
3704 /* Allocate space for the components, the dots which separate them,
3705 and the final '\0'. */
3706 char *name_key = SAFE_ALLOCA (invocation_namelen + strlen (attribute) + 2);
3707 char *class_key = alloca ((sizeof (EMACS_CLASS) - 1) + strlen (class) + 2);
3709 esprintf (name_key, "%s.%s", SSDATA (Vinvocation_name), attribute);
3710 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3712 result = x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
3713 name_key, class_key);
3714 SAFE_FREE ();
3715 return result;
3717 #endif
3719 /* Return the value of parameter PARAM.
3721 First search ALIST, then Vdefault_frame_alist, then the X defaults
3722 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3724 Convert the resource to the type specified by desired_type.
3726 If no default is specified, return Qunbound. If you call
3727 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3728 and don't let it get stored in any Lisp-visible variables! */
3730 Lisp_Object
3731 x_get_arg (Display_Info *dpyinfo, Lisp_Object alist, Lisp_Object param,
3732 const char *attribute, const char *class, enum resource_types type)
3734 register Lisp_Object tem;
3736 tem = Fassq (param, alist);
3738 if (!NILP (tem))
3740 /* If we find this parm in ALIST, clear it out
3741 so that it won't be "left over" at the end. */
3742 Lisp_Object tail;
3743 XSETCAR (tem, Qnil);
3744 /* In case the parameter appears more than once in the alist,
3745 clear it out. */
3746 for (tail = alist; CONSP (tail); tail = XCDR (tail))
3747 if (CONSP (XCAR (tail))
3748 && EQ (XCAR (XCAR (tail)), param))
3749 XSETCAR (XCAR (tail), Qnil);
3751 else
3752 tem = Fassq (param, Vdefault_frame_alist);
3754 /* If it wasn't specified in ALIST or the Lisp-level defaults,
3755 look in the X resources. */
3756 if (EQ (tem, Qnil))
3758 if (attribute && dpyinfo)
3760 tem = display_x_get_resource (dpyinfo,
3761 build_string (attribute),
3762 build_string (class),
3763 Qnil, Qnil);
3765 if (NILP (tem))
3766 return Qunbound;
3768 switch (type)
3770 case RES_TYPE_NUMBER:
3771 return make_number (atoi (SSDATA (tem)));
3773 case RES_TYPE_BOOLEAN_NUMBER:
3774 if (!strcmp (SSDATA (tem), "on")
3775 || !strcmp (SSDATA (tem), "true"))
3776 return make_number (1);
3777 return make_number (atoi (SSDATA (tem)));
3778 break;
3780 case RES_TYPE_FLOAT:
3781 return make_float (atof (SSDATA (tem)));
3783 case RES_TYPE_BOOLEAN:
3784 tem = Fdowncase (tem);
3785 if (!strcmp (SSDATA (tem), "on")
3786 #ifdef HAVE_NS
3787 || !strcmp (SSDATA (tem), "yes")
3788 #endif
3789 || !strcmp (SSDATA (tem), "true"))
3790 return Qt;
3791 else
3792 return Qnil;
3794 case RES_TYPE_STRING:
3795 return tem;
3797 case RES_TYPE_SYMBOL:
3798 /* As a special case, we map the values `true' and `on'
3799 to Qt, and `false' and `off' to Qnil. */
3801 Lisp_Object lower;
3802 lower = Fdowncase (tem);
3803 if (!strcmp (SSDATA (lower), "on")
3804 #ifdef HAVE_NS
3805 || !strcmp (SSDATA (lower), "yes")
3806 #endif
3807 || !strcmp (SSDATA (lower), "true"))
3808 return Qt;
3809 else if (!strcmp (SSDATA (lower), "off")
3810 #ifdef HAVE_NS
3811 || !strcmp (SSDATA (lower), "no")
3812 #endif
3813 || !strcmp (SSDATA (lower), "false"))
3814 return Qnil;
3815 else
3816 return Fintern (tem, Qnil);
3819 default:
3820 abort ();
3823 else
3824 return Qunbound;
3826 return Fcdr (tem);
3829 static Lisp_Object
3830 x_frame_get_arg (struct frame *f, Lisp_Object alist, Lisp_Object param,
3831 const char *attribute, const char *class,
3832 enum resource_types type)
3834 return x_get_arg (FRAME_X_DISPLAY_INFO (f),
3835 alist, param, attribute, class, type);
3838 /* Like x_frame_get_arg, but also record the value in f->param_alist. */
3840 Lisp_Object
3841 x_frame_get_and_record_arg (struct frame *f, Lisp_Object alist,
3842 Lisp_Object param,
3843 const char *attribute, const char *class,
3844 enum resource_types type)
3846 Lisp_Object value;
3848 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
3849 attribute, class, type);
3850 if (! NILP (value) && ! EQ (value, Qunbound))
3851 store_frame_param (f, param, value);
3853 return value;
3857 /* Record in frame F the specified or default value according to ALIST
3858 of the parameter named PROP (a Lisp symbol).
3859 If no value is specified for PROP, look for an X default for XPROP
3860 on the frame named NAME.
3861 If that is not found either, use the value DEFLT. */
3863 Lisp_Object
3864 x_default_parameter (struct frame *f, Lisp_Object alist, Lisp_Object prop,
3865 Lisp_Object deflt, const char *xprop, const char *xclass,
3866 enum resource_types type)
3868 Lisp_Object tem;
3870 tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type);
3871 if (EQ (tem, Qunbound))
3872 tem = deflt;
3873 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
3874 return tem;
3880 /* NS used to define x-parse-geometry in ns-win.el, but that confused
3881 make-docfile: the documentation string in ns-win.el was used for
3882 x-parse-geometry even in non-NS builds.
3884 With two definitions of x-parse-geometry in this file, various
3885 things still get confused (eg M-x apropos documentation), so that
3886 it is best if the two definitions just share the same doc-string.
3888 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
3889 doc: /* Parse a display geometry string STRING.
3890 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3891 The properties returned may include `top', `left', `height', and `width'.
3892 For X, the value of `left' or `top' may be an integer,
3893 or a list (+ N) meaning N pixels relative to top/left corner,
3894 or a list (- N) meaning -N pixels relative to bottom/right corner.
3895 On Nextstep, this just calls `ns-parse-geometry'. */)
3896 (Lisp_Object string)
3898 #ifdef HAVE_NS
3899 return call1 (Qns_parse_geometry, string);
3900 #else
3901 int geometry, x, y;
3902 unsigned int width, height;
3903 Lisp_Object result;
3905 CHECK_STRING (string);
3907 geometry = XParseGeometry (SSDATA (string),
3908 &x, &y, &width, &height);
3909 result = Qnil;
3910 if (geometry & XValue)
3912 Lisp_Object element;
3914 if (x >= 0 && (geometry & XNegative))
3915 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
3916 else if (x < 0 && ! (geometry & XNegative))
3917 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
3918 else
3919 element = Fcons (Qleft, make_number (x));
3920 result = Fcons (element, result);
3923 if (geometry & YValue)
3925 Lisp_Object element;
3927 if (y >= 0 && (geometry & YNegative))
3928 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
3929 else if (y < 0 && ! (geometry & YNegative))
3930 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
3931 else
3932 element = Fcons (Qtop, make_number (y));
3933 result = Fcons (element, result);
3936 if (geometry & WidthValue)
3937 result = Fcons (Fcons (Qwidth, make_number (width)), result);
3938 if (geometry & HeightValue)
3939 result = Fcons (Fcons (Qheight, make_number (height)), result);
3941 return result;
3942 #endif /* HAVE_NS */
3946 /* Calculate the desired size and position of frame F.
3947 Return the flags saying which aspects were specified.
3949 Also set the win_gravity and size_hint_flags of F.
3951 Adjust height for toolbar if TOOLBAR_P is 1.
3953 This function does not make the coordinates positive. */
3955 #define DEFAULT_ROWS 35
3956 #define DEFAULT_COLS 80
3959 x_figure_window_size (struct frame *f, Lisp_Object parms, int toolbar_p)
3961 register Lisp_Object tem0, tem1, tem2;
3962 long window_prompting = 0;
3963 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3965 /* Default values if we fall through.
3966 Actually, if that happens we should get
3967 window manager prompting. */
3968 SET_FRAME_COLS (f, DEFAULT_COLS);
3969 FRAME_LINES (f) = DEFAULT_ROWS;
3970 /* Window managers expect that if program-specified
3971 positions are not (0,0), they're intentional, not defaults. */
3972 f->top_pos = 0;
3973 f->left_pos = 0;
3975 /* Ensure that old new_text_cols and new_text_lines will not override the
3976 values set here. */
3977 /* ++KFS: This was specific to W32, but seems ok for all platforms */
3978 f->new_text_cols = f->new_text_lines = 0;
3980 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
3981 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
3982 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
3983 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3985 if (!EQ (tem0, Qunbound))
3987 CHECK_NUMBER (tem0);
3988 if (! (0 <= XINT (tem0) && XINT (tem0) <= INT_MAX))
3989 xsignal1 (Qargs_out_of_range, tem0);
3990 FRAME_LINES (f) = XINT (tem0);
3992 if (!EQ (tem1, Qunbound))
3994 CHECK_NUMBER (tem1);
3995 if (! (0 <= XINT (tem1) && XINT (tem1) <= INT_MAX))
3996 xsignal1 (Qargs_out_of_range, tem1);
3997 SET_FRAME_COLS (f, XINT (tem1));
3999 if (!NILP (tem2) && !EQ (tem2, Qunbound))
4000 window_prompting |= USSize;
4001 else
4002 window_prompting |= PSize;
4005 f->scroll_bar_actual_width
4006 = FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f);
4008 /* This used to be done _before_ calling x_figure_window_size, but
4009 since the height is reset here, this was really a no-op. I
4010 assume that moving it here does what Gerd intended (although he
4011 no longer can remember what that was... ++KFS, 2003-03-25. */
4013 /* Add the tool-bar height to the initial frame height so that the
4014 user gets a text display area of the size he specified with -g or
4015 via .Xdefaults. Later changes of the tool-bar height don't
4016 change the frame size. This is done so that users can create
4017 tall Emacs frames without having to guess how tall the tool-bar
4018 will get. */
4019 if (toolbar_p && FRAME_TOOL_BAR_LINES (f))
4021 int margin, relief, bar_height;
4023 relief = (tool_bar_button_relief >= 0
4024 ? tool_bar_button_relief
4025 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
4027 if (RANGED_INTEGERP (1, Vtool_bar_button_margin, INT_MAX))
4028 margin = XFASTINT (Vtool_bar_button_margin);
4029 else if (CONSP (Vtool_bar_button_margin)
4030 && RANGED_INTEGERP (1, XCDR (Vtool_bar_button_margin), INT_MAX))
4031 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
4032 else
4033 margin = 0;
4035 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
4036 FRAME_LINES (f) += (bar_height + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f);
4039 compute_fringe_widths (f, 0);
4041 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, FRAME_COLS (f));
4042 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, FRAME_LINES (f));
4044 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
4045 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
4046 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
4047 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4049 if (EQ (tem0, Qminus))
4051 f->top_pos = 0;
4052 window_prompting |= YNegative;
4054 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
4055 && CONSP (XCDR (tem0))
4056 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (tem0)), INT_MAX))
4058 f->top_pos = - XINT (XCAR (XCDR (tem0)));
4059 window_prompting |= YNegative;
4061 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
4062 && CONSP (XCDR (tem0))
4063 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (tem0))))
4065 f->top_pos = XINT (XCAR (XCDR (tem0)));
4067 else if (EQ (tem0, Qunbound))
4068 f->top_pos = 0;
4069 else
4071 CHECK_TYPE_RANGED_INTEGER (int, tem0);
4072 f->top_pos = XINT (tem0);
4073 if (f->top_pos < 0)
4074 window_prompting |= YNegative;
4077 if (EQ (tem1, Qminus))
4079 f->left_pos = 0;
4080 window_prompting |= XNegative;
4082 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
4083 && CONSP (XCDR (tem1))
4084 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (tem1)), INT_MAX))
4086 f->left_pos = - XINT (XCAR (XCDR (tem1)));
4087 window_prompting |= XNegative;
4089 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
4090 && CONSP (XCDR (tem1))
4091 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (tem1))))
4093 f->left_pos = XINT (XCAR (XCDR (tem1)));
4095 else if (EQ (tem1, Qunbound))
4096 f->left_pos = 0;
4097 else
4099 CHECK_TYPE_RANGED_INTEGER (int, tem1);
4100 f->left_pos = XINT (tem1);
4101 if (f->left_pos < 0)
4102 window_prompting |= XNegative;
4105 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
4106 window_prompting |= USPosition;
4107 else
4108 window_prompting |= PPosition;
4111 if (window_prompting & XNegative)
4113 if (window_prompting & YNegative)
4114 f->win_gravity = SouthEastGravity;
4115 else
4116 f->win_gravity = NorthEastGravity;
4118 else
4120 if (window_prompting & YNegative)
4121 f->win_gravity = SouthWestGravity;
4122 else
4123 f->win_gravity = NorthWestGravity;
4126 f->size_hint_flags = window_prompting;
4128 return window_prompting;
4133 #endif /* HAVE_WINDOW_SYSTEM */
4135 void
4136 frame_make_pointer_invisible (void)
4138 if (! NILP (Vmake_pointer_invisible))
4140 struct frame *f;
4141 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4142 return;
4144 f = SELECTED_FRAME ();
4145 if (f && !f->pointer_invisible
4146 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4148 f->mouse_moved = 0;
4149 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 1);
4150 f->pointer_invisible = 1;
4155 void
4156 frame_make_pointer_visible (void)
4158 /* We don't check Vmake_pointer_invisible here in case the
4159 pointer was invisible when Vmake_pointer_invisible was set to nil. */
4160 struct frame *f;
4162 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4163 return;
4165 f = SELECTED_FRAME ();
4166 if (f && f->pointer_invisible && f->mouse_moved
4167 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4169 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 0);
4170 f->pointer_invisible = 0;
4174 DEFUN ("frame-pointer-visible-p", Fframe_pointer_visible_p,
4175 Sframe_pointer_visible_p, 0, 1, 0,
4176 doc: /* Return t if the mouse pointer displayed on FRAME is visible.
4177 Otherwise it returns nil. FRAME omitted or nil means the
4178 selected frame. This is useful when `make-pointer-invisible' is set. */)
4179 (Lisp_Object frame)
4181 if (NILP (frame))
4182 frame = selected_frame;
4184 CHECK_FRAME (frame);
4186 return (XFRAME (frame)->pointer_invisible ? Qnil : Qt);
4190 /***********************************************************************
4191 Initialization
4192 ***********************************************************************/
4194 void
4195 syms_of_frame (void)
4197 DEFSYM (Qframep, "framep");
4198 DEFSYM (Qframe_live_p, "frame-live-p");
4199 DEFSYM (Qexplicit_name, "explicit-name");
4200 DEFSYM (Qheight, "height");
4201 DEFSYM (Qicon, "icon");
4202 DEFSYM (Qminibuffer, "minibuffer");
4203 DEFSYM (Qmodeline, "modeline");
4204 DEFSYM (Qonly, "only");
4205 DEFSYM (Qnone, "none");
4206 DEFSYM (Qwidth, "width");
4207 DEFSYM (Qgeometry, "geometry");
4208 DEFSYM (Qicon_left, "icon-left");
4209 DEFSYM (Qicon_top, "icon-top");
4210 DEFSYM (Qtooltip, "tooltip");
4211 DEFSYM (Qleft, "left");
4212 DEFSYM (Qright, "right");
4213 DEFSYM (Quser_position, "user-position");
4214 DEFSYM (Quser_size, "user-size");
4215 DEFSYM (Qwindow_id, "window-id");
4216 #ifdef HAVE_X_WINDOWS
4217 DEFSYM (Qouter_window_id, "outer-window-id");
4218 #endif
4219 DEFSYM (Qparent_id, "parent-id");
4220 DEFSYM (Qx, "x");
4221 DEFSYM (Qw32, "w32");
4222 DEFSYM (Qpc, "pc");
4223 DEFSYM (Qmac, "mac");
4224 DEFSYM (Qns, "ns");
4225 DEFSYM (Qvisible, "visible");
4226 DEFSYM (Qbuffer_predicate, "buffer-predicate");
4227 DEFSYM (Qbuffer_list, "buffer-list");
4228 DEFSYM (Qburied_buffer_list, "buried-buffer-list");
4229 DEFSYM (Qdisplay_type, "display-type");
4230 DEFSYM (Qbackground_mode, "background-mode");
4231 DEFSYM (Qnoelisp, "noelisp");
4232 DEFSYM (Qtty_color_mode, "tty-color-mode");
4233 DEFSYM (Qtty, "tty");
4234 DEFSYM (Qtty_type, "tty-type");
4236 DEFSYM (Qface_set_after_frame_default, "face-set-after-frame-default");
4238 DEFSYM (Qfullwidth, "fullwidth");
4239 DEFSYM (Qfullheight, "fullheight");
4240 DEFSYM (Qfullboth, "fullboth");
4241 DEFSYM (Qmaximized, "maximized");
4242 DEFSYM (Qx_resource_name, "x-resource-name");
4243 DEFSYM (Qx_frame_parameter, "x-frame-parameter");
4245 DEFSYM (Qterminal, "terminal");
4246 DEFSYM (Qterminal_live_p, "terminal-live-p");
4248 #ifdef HAVE_NS
4249 DEFSYM (Qns_parse_geometry, "ns-parse-geometry");
4250 #endif
4253 int i;
4255 for (i = 0; i < sizeof (frame_parms) / sizeof (frame_parms[0]); i++)
4257 Lisp_Object v = intern_c_string (frame_parms[i].name);
4258 if (frame_parms[i].variable)
4260 *frame_parms[i].variable = v;
4261 staticpro (frame_parms[i].variable);
4263 Fput (v, Qx_frame_parameter, make_number (i));
4267 #ifdef HAVE_WINDOW_SYSTEM
4268 DEFVAR_LISP ("x-resource-name", Vx_resource_name,
4269 doc: /* The name Emacs uses to look up X resources.
4270 `x-get-resource' uses this as the first component of the instance name
4271 when requesting resource values.
4272 Emacs initially sets `x-resource-name' to the name under which Emacs
4273 was invoked, or to the value specified with the `-name' or `-rn'
4274 switches, if present.
4276 It may be useful to bind this variable locally around a call
4277 to `x-get-resource'. See also the variable `x-resource-class'. */);
4278 Vx_resource_name = Qnil;
4280 DEFVAR_LISP ("x-resource-class", Vx_resource_class,
4281 doc: /* The class Emacs uses to look up X resources.
4282 `x-get-resource' uses this as the first component of the instance class
4283 when requesting resource values.
4285 Emacs initially sets `x-resource-class' to "Emacs".
4287 Setting this variable permanently is not a reasonable thing to do,
4288 but binding this variable locally around a call to `x-get-resource'
4289 is a reasonable practice. See also the variable `x-resource-name'. */);
4290 Vx_resource_class = build_string (EMACS_CLASS);
4292 DEFVAR_LISP ("frame-alpha-lower-limit", Vframe_alpha_lower_limit,
4293 doc: /* The lower limit of the frame opacity (alpha transparency).
4294 The value should range from 0 (invisible) to 100 (completely opaque).
4295 You can also use a floating number between 0.0 and 1.0.
4296 The default is 20. */);
4297 Vframe_alpha_lower_limit = make_number (20);
4298 #endif
4300 DEFVAR_LISP ("default-frame-alist", Vdefault_frame_alist,
4301 doc: /* Alist of default values for frame creation.
4302 These may be set in your init file, like this:
4303 (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1)))
4304 These override values given in window system configuration data,
4305 including X Windows' defaults database.
4306 For values specific to the first Emacs frame, see `initial-frame-alist'.
4307 For window-system specific values, see `window-system-default-frame-alist'.
4308 For values specific to the separate minibuffer frame, see
4309 `minibuffer-frame-alist'.
4310 The `menu-bar-lines' element of the list controls whether new frames
4311 have menu bars; `menu-bar-mode' works by altering this element.
4312 Setting this variable does not affect existing frames, only new ones. */);
4313 Vdefault_frame_alist = Qnil;
4315 DEFVAR_LISP ("default-frame-scroll-bars", Vdefault_frame_scroll_bars,
4316 doc: /* Default position of scroll bars on this window-system. */);
4317 #ifdef HAVE_WINDOW_SYSTEM
4318 #if defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA) || (defined (USE_GTK) && defined (USE_TOOLKIT_SCROLL_BARS))
4319 /* MS-Windows, Mac OS X, and GTK have scroll bars on the right by
4320 default. */
4321 Vdefault_frame_scroll_bars = Qright;
4322 #else
4323 Vdefault_frame_scroll_bars = Qleft;
4324 #endif
4325 #else
4326 Vdefault_frame_scroll_bars = Qnil;
4327 #endif
4329 DEFVAR_LISP ("terminal-frame", Vterminal_frame,
4330 doc: /* The initial frame-object, which represents Emacs's stdout. */);
4332 DEFVAR_LISP ("mouse-position-function", Vmouse_position_function,
4333 doc: /* If non-nil, function to transform normal value of `mouse-position'.
4334 `mouse-position' calls this function, passing its usual return value as
4335 argument, and returns whatever this function returns.
4336 This abnormal hook exists for the benefit of packages like `xt-mouse.el'
4337 which need to do mouse handling at the Lisp level. */);
4338 Vmouse_position_function = Qnil;
4340 DEFVAR_LISP ("mouse-highlight", Vmouse_highlight,
4341 doc: /* If non-nil, clickable text is highlighted when mouse is over it.
4342 If the value is an integer, highlighting is only shown after moving the
4343 mouse, while keyboard input turns off the highlight even when the mouse
4344 is over the clickable text. However, the mouse shape still indicates
4345 when the mouse is over clickable text. */);
4346 Vmouse_highlight = Qt;
4348 DEFVAR_LISP ("make-pointer-invisible", Vmake_pointer_invisible,
4349 doc: /* If non-nil, make pointer invisible while typing.
4350 The pointer becomes visible again when the mouse is moved. */);
4351 Vmake_pointer_invisible = Qt;
4353 DEFVAR_LISP ("delete-frame-functions", Vdelete_frame_functions,
4354 doc: /* Functions run before deleting a frame.
4355 The functions are run with one arg, the frame to be deleted.
4356 See `delete-frame'.
4358 Note that functions in this list may be called just before the frame is
4359 actually deleted, or some time later (or even both when an earlier function
4360 in `delete-frame-functions' (indirectly) calls `delete-frame'
4361 recursively). */);
4362 Vdelete_frame_functions = Qnil;
4363 DEFSYM (Qdelete_frame_functions, "delete-frame-functions");
4365 DEFVAR_LISP ("menu-bar-mode", Vmenu_bar_mode,
4366 doc: /* Non-nil if Menu-Bar mode is enabled.
4367 See the command `menu-bar-mode' for a description of this minor mode.
4368 Setting this variable directly does not take effect;
4369 either customize it (see the info node `Easy Customization')
4370 or call the function `menu-bar-mode'. */);
4371 Vmenu_bar_mode = Qt;
4373 DEFVAR_LISP ("tool-bar-mode", Vtool_bar_mode,
4374 doc: /* Non-nil if Tool-Bar mode is enabled.
4375 See the command `tool-bar-mode' for a description of this minor mode.
4376 Setting this variable directly does not take effect;
4377 either customize it (see the info node `Easy Customization')
4378 or call the function `tool-bar-mode'. */);
4379 #ifdef HAVE_WINDOW_SYSTEM
4380 Vtool_bar_mode = Qt;
4381 #else
4382 Vtool_bar_mode = Qnil;
4383 #endif
4385 DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
4386 doc: /* Minibufferless frames use this frame's minibuffer.
4388 Emacs cannot create minibufferless frames unless this is set to an
4389 appropriate surrogate.
4391 Emacs consults this variable only when creating minibufferless
4392 frames; once the frame is created, it sticks with its assigned
4393 minibuffer, no matter what this variable is set to. This means that
4394 this variable doesn't necessarily say anything meaningful about the
4395 current set of frames, or where the minibuffer is currently being
4396 displayed.
4398 This variable is local to the current terminal and cannot be buffer-local. */);
4400 DEFVAR_BOOL ("focus-follows-mouse", focus_follows_mouse,
4401 doc: /* Non-nil if window system changes focus when you move the mouse.
4402 You should set this variable to tell Emacs how your window manager
4403 handles focus, since there is no way in general for Emacs to find out
4404 automatically. See also `mouse-autoselect-window'. */);
4405 focus_follows_mouse = 0;
4407 staticpro (&Vframe_list);
4409 defsubr (&Sframep);
4410 defsubr (&Sframe_live_p);
4411 defsubr (&Swindow_system);
4412 defsubr (&Smake_terminal_frame);
4413 defsubr (&Shandle_switch_frame);
4414 defsubr (&Sselect_frame);
4415 defsubr (&Sselected_frame);
4416 defsubr (&Sframe_list);
4417 defsubr (&Snext_frame);
4418 defsubr (&Sprevious_frame);
4419 defsubr (&Sdelete_frame);
4420 defsubr (&Smouse_position);
4421 defsubr (&Smouse_pixel_position);
4422 defsubr (&Sset_mouse_position);
4423 defsubr (&Sset_mouse_pixel_position);
4424 #if 0
4425 defsubr (&Sframe_configuration);
4426 defsubr (&Srestore_frame_configuration);
4427 #endif
4428 defsubr (&Smake_frame_visible);
4429 defsubr (&Smake_frame_invisible);
4430 defsubr (&Siconify_frame);
4431 defsubr (&Sframe_visible_p);
4432 defsubr (&Svisible_frame_list);
4433 defsubr (&Sraise_frame);
4434 defsubr (&Slower_frame);
4435 defsubr (&Sredirect_frame_focus);
4436 defsubr (&Sframe_focus);
4437 defsubr (&Sframe_parameters);
4438 defsubr (&Sframe_parameter);
4439 defsubr (&Smodify_frame_parameters);
4440 defsubr (&Sframe_char_height);
4441 defsubr (&Sframe_char_width);
4442 defsubr (&Sframe_pixel_height);
4443 defsubr (&Sframe_pixel_width);
4444 defsubr (&Stool_bar_pixel_width);
4445 defsubr (&Sset_frame_height);
4446 defsubr (&Sset_frame_width);
4447 defsubr (&Sset_frame_size);
4448 defsubr (&Sset_frame_position);
4449 defsubr (&Sframe_pointer_visible_p);
4451 #ifdef HAVE_WINDOW_SYSTEM
4452 defsubr (&Sx_get_resource);
4453 defsubr (&Sx_parse_geometry);
4454 #endif