(bug-reference-map): Bind down-mouse-1 rather than mouse-1.
[emacs.git] / src / frame.c
blob6320d0ca1ff890307de9e7313e601120b0a7dafa
1 /* Generic frame functions.
2 Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2002, 2003,
3 2004, 2005, 2006, 2007, 2008 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 "lisp.h"
25 #include "character.h"
26 #ifdef HAVE_X_WINDOWS
27 #include "xterm.h"
28 #endif
29 #ifdef WINDOWSNT
30 #include "w32term.h"
31 #endif
32 #ifdef MAC_OS
33 #include "macterm.h"
34 #endif
35 #include "buffer.h"
36 /* These help us bind and responding to switch-frame events. */
37 #include "commands.h"
38 #include "keyboard.h"
39 #include "frame.h"
40 #include "blockinput.h"
41 #include "termchar.h"
42 #include "termhooks.h"
43 #include "dispextern.h"
44 #include "window.h"
45 #ifdef HAVE_WINDOW_SYSTEM
46 #include "font.h"
47 #include "fontset.h"
48 #endif
49 #ifdef MSDOS
50 #include "msdos.h"
51 #include "dosfns.h"
52 #endif
55 #ifdef HAVE_WINDOW_SYSTEM
57 /* The name we're using in resource queries. Most often "emacs". */
59 Lisp_Object Vx_resource_name;
61 /* The application class we're using in resource queries.
62 Normally "Emacs". */
64 Lisp_Object Vx_resource_class;
66 /* Lower limit value of the frame opacity (alpha transparency). */
68 Lisp_Object Vframe_alpha_lower_limit;
70 #endif
72 Lisp_Object Qframep, Qframe_live_p;
73 Lisp_Object Qicon, Qmodeline;
74 Lisp_Object Qonly;
75 Lisp_Object Qx, Qw32, Qmac, Qpc;
76 Lisp_Object Qvisible;
77 Lisp_Object Qdisplay_type;
78 Lisp_Object Qbackground_mode;
79 Lisp_Object Qnoelisp;
81 Lisp_Object Qx_frame_parameter;
82 Lisp_Object Qx_resource_name;
83 Lisp_Object Qterminal;
84 Lisp_Object Qterminal_live_p;
86 /* Frame parameters (set or reported). */
88 Lisp_Object Qauto_raise, Qauto_lower;
89 Lisp_Object Qborder_color, Qborder_width;
90 Lisp_Object Qcursor_color, Qcursor_type;
91 Lisp_Object Qgeometry; /* Not used */
92 Lisp_Object Qheight, Qwidth;
93 Lisp_Object Qleft, Qright;
94 Lisp_Object Qicon_left, Qicon_top, Qicon_type, Qicon_name;
95 Lisp_Object Qinternal_border_width;
96 Lisp_Object Qmouse_color;
97 Lisp_Object Qminibuffer;
98 Lisp_Object Qscroll_bar_width, Qvertical_scroll_bars;
99 Lisp_Object Qvisibility;
100 Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
101 Lisp_Object Qscreen_gamma;
102 Lisp_Object Qline_spacing;
103 Lisp_Object Quser_position, Quser_size;
104 Lisp_Object Qwait_for_wm;
105 Lisp_Object Qwindow_id;
106 #ifdef HAVE_X_WINDOWS
107 Lisp_Object Qouter_window_id;
108 #endif
109 Lisp_Object Qparent_id;
110 Lisp_Object Qtitle, Qname;
111 Lisp_Object Qexplicit_name;
112 Lisp_Object Qunsplittable;
113 Lisp_Object Qmenu_bar_lines, Qtool_bar_lines;
114 Lisp_Object Qleft_fringe, Qright_fringe;
115 Lisp_Object Qbuffer_predicate, Qbuffer_list, Qburied_buffer_list;
116 Lisp_Object Qtty_color_mode;
117 Lisp_Object Qtty, Qtty_type;
119 Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth;
120 Lisp_Object Qfont_backend;
121 Lisp_Object Qalpha;
123 Lisp_Object Qinhibit_face_set_after_frame_default;
124 Lisp_Object Qface_set_after_frame_default;
126 Lisp_Object Vterminal_frame;
127 Lisp_Object Vdefault_frame_alist;
128 Lisp_Object Vdefault_frame_scroll_bars;
129 Lisp_Object Vmouse_position_function;
130 Lisp_Object Vmouse_highlight;
131 static Lisp_Object Vdelete_frame_functions, Qdelete_frame_functions;
133 int focus_follows_mouse;
135 static void
136 set_menu_bar_lines_1 (window, n)
137 Lisp_Object window;
138 int n;
140 struct window *w = XWINDOW (window);
142 XSETFASTINT (w->last_modified, 0);
143 XSETFASTINT (w->top_line, XFASTINT (w->top_line) + n);
144 XSETFASTINT (w->total_lines, XFASTINT (w->total_lines) - n);
146 if (INTEGERP (w->orig_top_line))
147 XSETFASTINT (w->orig_top_line, XFASTINT (w->orig_top_line) + n);
148 if (INTEGERP (w->orig_total_lines))
149 XSETFASTINT (w->orig_total_lines, XFASTINT (w->orig_total_lines) - n);
151 /* Handle just the top child in a vertical split. */
152 if (!NILP (w->vchild))
153 set_menu_bar_lines_1 (w->vchild, n);
155 /* Adjust all children in a horizontal split. */
156 for (window = w->hchild; !NILP (window); window = w->next)
158 w = XWINDOW (window);
159 set_menu_bar_lines_1 (window, n);
163 void
164 set_menu_bar_lines (f, value, oldval)
165 struct frame *f;
166 Lisp_Object value, oldval;
168 int nlines;
169 int olines = FRAME_MENU_BAR_LINES (f);
171 /* Right now, menu bars don't work properly in minibuf-only frames;
172 most of the commands try to apply themselves to the minibuffer
173 frame itself, and get an error because you can't switch buffers
174 in or split the minibuffer window. */
175 if (FRAME_MINIBUF_ONLY_P (f))
176 return;
178 if (INTEGERP (value))
179 nlines = XINT (value);
180 else
181 nlines = 0;
183 if (nlines != olines)
185 windows_or_buffers_changed++;
186 FRAME_WINDOW_SIZES_CHANGED (f) = 1;
187 FRAME_MENU_BAR_LINES (f) = nlines;
188 set_menu_bar_lines_1 (f->root_window, nlines - olines);
189 adjust_glyphs (f);
193 Lisp_Object Vemacs_iconified;
194 Lisp_Object Vframe_list;
196 extern Lisp_Object Vminibuffer_list;
197 extern Lisp_Object get_minibuffer ();
198 extern Lisp_Object Fhandle_switch_frame ();
199 extern Lisp_Object Fredirect_frame_focus ();
200 extern Lisp_Object x_get_focus_frame ();
202 DEFUN ("framep", Fframep, Sframep, 1, 1, 0,
203 doc: /* Return non-nil if OBJECT is a frame.
204 Value is t for a termcap frame (a character-only terminal),
205 `x' for an Emacs frame that is really an X window,
206 `w32' for an Emacs frame that is a window on MS-Windows display,
207 `mac' for an Emacs frame on a Macintosh display,
208 `pc' for a direct-write MS-DOS frame.
209 See also `frame-live-p'. */)
210 (object)
211 Lisp_Object object;
213 if (!FRAMEP (object))
214 return Qnil;
215 switch (XFRAME (object)->output_method)
217 case output_initial: /* The initial frame is like a termcap frame. */
218 case output_termcap:
219 return Qt;
220 case output_x_window:
221 return Qx;
222 case output_w32:
223 return Qw32;
224 case output_msdos_raw:
225 return Qpc;
226 case output_mac:
227 return Qmac;
228 default:
229 abort ();
233 DEFUN ("frame-live-p", Fframe_live_p, Sframe_live_p, 1, 1, 0,
234 doc: /* Return non-nil if OBJECT is a frame which has not been deleted.
235 Value is nil if OBJECT is not a live frame. If object is a live
236 frame, the return value indicates what sort of terminal device it is
237 displayed on. See the documentation of `framep' for possible
238 return values. */)
239 (object)
240 Lisp_Object object;
242 return ((FRAMEP (object)
243 && FRAME_LIVE_P (XFRAME (object)))
244 ? Fframep (object)
245 : Qnil);
248 DEFUN ("window-system", Fwindow_system, Swindow_system, 0, 1, 0,
249 doc: /* The name of the window system that FRAME is displaying through.
250 The value is a symbol---for instance, 'x' for X windows.
251 The value is nil if Emacs is using a text-only terminal.
253 FRAME defaults to the currently selected frame. */)
254 (frame)
255 Lisp_Object frame;
257 Lisp_Object type;
258 if (NILP (frame))
259 frame = selected_frame;
261 type = Fframep (frame);
263 if (NILP (type))
264 wrong_type_argument (Qframep, frame);
266 if (EQ (type, Qt))
267 return Qnil;
268 else
269 return type;
272 struct frame *
273 make_frame (mini_p)
274 int mini_p;
276 Lisp_Object frame;
277 register struct frame *f;
278 register Lisp_Object root_window;
279 register Lisp_Object mini_window;
281 f = allocate_frame ();
282 XSETFRAME (frame, f);
284 f->desired_matrix = 0;
285 f->current_matrix = 0;
286 f->desired_pool = 0;
287 f->current_pool = 0;
288 f->glyphs_initialized_p = 0;
289 f->decode_mode_spec_buffer = 0;
290 f->visible = 0;
291 f->async_visible = 0;
292 f->output_data.nothing = 0;
293 f->iconified = 0;
294 f->async_iconified = 0;
295 f->wants_modeline = 1;
296 f->auto_raise = 0;
297 f->auto_lower = 0;
298 f->no_split = 0;
299 f->garbaged = 1;
300 f->has_minibuffer = mini_p;
301 f->focus_frame = Qnil;
302 f->explicit_name = 0;
303 f->can_have_scroll_bars = 0;
304 f->vertical_scroll_bar_type = vertical_scroll_bar_none;
305 f->param_alist = Qnil;
306 f->scroll_bars = Qnil;
307 f->condemned_scroll_bars = Qnil;
308 f->face_alist = Qnil;
309 f->face_cache = NULL;
310 f->menu_bar_items = Qnil;
311 f->menu_bar_vector = Qnil;
312 f->menu_bar_items_used = 0;
313 f->buffer_predicate = Qnil;
314 f->buffer_list = Qnil;
315 f->buried_buffer_list = Qnil;
316 f->namebuf = 0;
317 f->title = Qnil;
318 f->menu_bar_window = Qnil;
319 f->tool_bar_window = Qnil;
320 f->tool_bar_items = Qnil;
321 f->desired_tool_bar_string = f->current_tool_bar_string = Qnil;
322 f->n_tool_bar_items = 0;
323 f->left_fringe_width = f->right_fringe_width = 0;
324 f->fringe_cols = 0;
325 f->scroll_bar_actual_width = 0;
326 f->border_width = 0;
327 f->internal_border_width = 0;
328 f->column_width = 1; /* !FRAME_WINDOW_P value */
329 f->line_height = 1; /* !FRAME_WINDOW_P value */
330 f->x_pixels_diff = f->y_pixels_diff = 0;
331 #ifdef HAVE_WINDOW_SYSTEM
332 f->want_fullscreen = FULLSCREEN_NONE;
333 #endif
334 f->size_hint_flags = 0;
335 f->win_gravity = 0;
336 f->font_driver_list = NULL;
337 f->font_data_list = NULL;
339 root_window = make_window ();
340 if (mini_p)
342 mini_window = make_window ();
343 XWINDOW (root_window)->next = mini_window;
344 XWINDOW (mini_window)->prev = root_window;
345 XWINDOW (mini_window)->mini_p = Qt;
346 XWINDOW (mini_window)->frame = frame;
347 f->minibuffer_window = mini_window;
349 else
351 mini_window = Qnil;
352 XWINDOW (root_window)->next = Qnil;
353 f->minibuffer_window = Qnil;
356 XWINDOW (root_window)->frame = frame;
358 /* 10 is arbitrary,
359 just so that there is "something there."
360 Correct size will be set up later with change_frame_size. */
362 SET_FRAME_COLS (f, 10);
363 FRAME_LINES (f) = 10;
365 XSETFASTINT (XWINDOW (root_window)->total_cols, 10);
366 XSETFASTINT (XWINDOW (root_window)->total_lines, (mini_p ? 9 : 10));
368 if (mini_p)
370 XSETFASTINT (XWINDOW (mini_window)->total_cols, 10);
371 XSETFASTINT (XWINDOW (mini_window)->top_line, 9);
372 XSETFASTINT (XWINDOW (mini_window)->total_lines, 1);
375 /* Choose a buffer for the frame's root window. */
377 Lisp_Object buf;
379 XWINDOW (root_window)->buffer = Qt;
380 buf = Fcurrent_buffer ();
381 /* If buf is a 'hidden' buffer (i.e. one whose name starts with
382 a space), try to find another one. */
383 if (SREF (Fbuffer_name (buf), 0) == ' ')
384 buf = Fother_buffer (buf, Qnil, Qnil);
386 /* Use set_window_buffer, not Fset_window_buffer, and don't let
387 hooks be run by it. The reason is that the whole frame/window
388 arrangement is not yet fully intialized at this point. Windows
389 don't have the right size, glyph matrices aren't initialized
390 etc. Running Lisp functions at this point surely ends in a
391 SEGV. */
392 set_window_buffer (root_window, buf, 0, 0);
393 f->buffer_list = Fcons (buf, Qnil);
396 if (mini_p)
398 XWINDOW (mini_window)->buffer = Qt;
399 set_window_buffer (mini_window,
400 (NILP (Vminibuffer_list)
401 ? get_minibuffer (0)
402 : Fcar (Vminibuffer_list)),
403 0, 0);
406 f->root_window = root_window;
407 f->selected_window = root_window;
408 /* Make sure this window seems more recently used than
409 a newly-created, never-selected window. */
410 ++window_select_count;
411 XSETFASTINT (XWINDOW (f->selected_window)->use_time, window_select_count);
413 f->default_face_done_p = 0;
415 return f;
418 #ifdef HAVE_WINDOW_SYSTEM
419 /* Make a frame using a separate minibuffer window on another frame.
420 MINI_WINDOW is the minibuffer window to use. nil means use the
421 default (the global minibuffer). */
423 struct frame *
424 make_frame_without_minibuffer (mini_window, kb, display)
425 register Lisp_Object mini_window;
426 KBOARD *kb;
427 Lisp_Object display;
429 register struct frame *f;
430 struct gcpro gcpro1;
432 if (!NILP (mini_window))
433 CHECK_LIVE_WINDOW (mini_window);
435 #ifdef MULTI_KBOARD
436 if (!NILP (mini_window)
437 && FRAME_KBOARD (XFRAME (XWINDOW (mini_window)->frame)) != kb)
438 error ("Frame and minibuffer must be on the same terminal");
439 #endif
441 /* Make a frame containing just a root window. */
442 f = make_frame (0);
444 if (NILP (mini_window))
446 /* Use default-minibuffer-frame if possible. */
447 if (!FRAMEP (kb->Vdefault_minibuffer_frame)
448 || ! FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame)))
450 Lisp_Object frame_dummy;
452 XSETFRAME (frame_dummy, f);
453 GCPRO1 (frame_dummy);
454 /* If there's no minibuffer frame to use, create one. */
455 kb->Vdefault_minibuffer_frame =
456 call1 (intern ("make-initial-minibuffer-frame"), display);
457 UNGCPRO;
460 mini_window = XFRAME (kb->Vdefault_minibuffer_frame)->minibuffer_window;
463 f->minibuffer_window = mini_window;
465 /* Make the chosen minibuffer window display the proper minibuffer,
466 unless it is already showing a minibuffer. */
467 if (NILP (Fmemq (XWINDOW (mini_window)->buffer, Vminibuffer_list)))
468 Fset_window_buffer (mini_window,
469 (NILP (Vminibuffer_list)
470 ? get_minibuffer (0)
471 : Fcar (Vminibuffer_list)), Qnil);
472 return f;
475 /* Make a frame containing only a minibuffer window. */
477 struct frame *
478 make_minibuffer_frame ()
480 /* First make a frame containing just a root window, no minibuffer. */
482 register struct frame *f = make_frame (0);
483 register Lisp_Object mini_window;
484 register Lisp_Object frame;
486 XSETFRAME (frame, f);
488 f->auto_raise = 0;
489 f->auto_lower = 0;
490 f->no_split = 1;
491 f->wants_modeline = 0;
492 f->has_minibuffer = 1;
494 /* Now label the root window as also being the minibuffer.
495 Avoid infinite looping on the window chain by marking next pointer
496 as nil. */
498 mini_window = f->minibuffer_window = f->root_window;
499 XWINDOW (mini_window)->mini_p = Qt;
500 XWINDOW (mini_window)->next = Qnil;
501 XWINDOW (mini_window)->prev = Qnil;
502 XWINDOW (mini_window)->frame = frame;
504 /* Put the proper buffer in that window. */
506 Fset_window_buffer (mini_window,
507 (NILP (Vminibuffer_list)
508 ? get_minibuffer (0)
509 : Fcar (Vminibuffer_list)), Qnil);
510 return f;
512 #endif /* HAVE_WINDOW_SYSTEM */
514 /* Construct a frame that refers to a terminal. */
516 static int tty_frame_count;
518 struct frame *
519 make_initial_frame (void)
521 struct frame *f;
522 struct terminal *terminal;
523 Lisp_Object frame;
525 eassert (initial_kboard);
527 /* The first call must initialize Vframe_list. */
528 if (! (NILP (Vframe_list) || CONSP (Vframe_list)))
529 Vframe_list = Qnil;
531 terminal = init_initial_terminal ();
533 f = make_frame (1);
534 XSETFRAME (frame, f);
536 Vframe_list = Fcons (frame, Vframe_list);
538 tty_frame_count = 1;
539 f->name = build_string ("F1");
541 f->visible = 1;
542 f->async_visible = 1;
544 f->output_method = terminal->type;
545 f->terminal = terminal;
546 f->terminal->reference_count++;
547 f->output_data.nothing = 0;
549 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
550 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
552 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
553 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
555 return f;
559 struct frame *
560 make_terminal_frame (struct terminal *terminal)
562 register struct frame *f;
563 Lisp_Object frame;
564 char name[20];
566 if (!terminal->name)
567 error ("Terminal is not live, can't create new frames on it");
569 f = make_frame (1);
571 XSETFRAME (frame, f);
572 Vframe_list = Fcons (frame, Vframe_list);
574 tty_frame_count++;
575 sprintf (name, "F%d", tty_frame_count);
576 f->name = build_string (name);
578 f->visible = 1; /* FRAME_SET_VISIBLE wd set frame_garbaged. */
579 f->async_visible = 1; /* Don't let visible be cleared later. */
580 #ifdef MSDOS
581 f->output_data.x = &the_only_x_display;
582 if (!inhibit_window_system
583 && (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame))
584 || XFRAME (selected_frame)->output_method == output_msdos_raw))
586 f->output_method = output_msdos_raw;
587 /* This initialization of foreground and background pixels is
588 only important for the initial frame created in temacs. If
589 we don't do that, we get black background and foreground in
590 the dumped Emacs because the_only_x_display is a static
591 variable, hence it is born all-zeroes, and zero is the code
592 for the black color. Other frames all inherit their pixels
593 from what's already in the_only_x_display. */
594 if ((!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
595 && FRAME_BACKGROUND_PIXEL (f) == 0
596 && FRAME_FOREGROUND_PIXEL (f) == 0)
598 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
599 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
602 else
603 f->output_method = output_termcap;
604 #else
606 f->output_method = output_termcap;
607 f->terminal = terminal;
608 f->terminal->reference_count++;
609 create_tty_output (f);
611 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
612 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
614 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
615 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
617 /* Set the top frame to the newly created frame. */
618 if (FRAMEP (FRAME_TTY (f)->top_frame)
619 && FRAME_LIVE_P (XFRAME (FRAME_TTY (f)->top_frame)))
620 XFRAME (FRAME_TTY (f)->top_frame)->async_visible = 2; /* obscured */
622 FRAME_TTY (f)->top_frame = frame;
625 #ifdef CANNOT_DUMP
626 FRAME_FOREGROUND_PIXEL(f) = FACE_TTY_DEFAULT_FG_COLOR;
627 FRAME_BACKGROUND_PIXEL(f) = FACE_TTY_DEFAULT_BG_COLOR;
628 #endif
629 #endif /* MSDOS */
631 if (!noninteractive)
632 init_frame_faces (f);
634 return f;
637 /* Get a suitable value for frame parameter PARAMETER for a newly
638 created frame, based on (1) the user-supplied frame parameter
639 alist SUPPLIED_PARMS, (2) CURRENT_VALUE, and finally, if all else
640 fails, (3) Vdefault_frame_alist. */
642 static Lisp_Object
643 get_future_frame_param (Lisp_Object parameter,
644 Lisp_Object supplied_parms,
645 char *current_value)
647 Lisp_Object result;
649 result = Fassq (parameter, supplied_parms);
650 if (NILP (result))
651 result = Fassq (parameter, XFRAME (selected_frame)->param_alist);
652 if (NILP (result) && current_value != NULL)
653 result = build_string (current_value);
654 if (NILP (result))
655 result = Fassq (parameter, Vdefault_frame_alist);
656 if (!NILP (result) && !STRINGP (result))
657 result = XCDR (result);
658 if (NILP (result) || !STRINGP (result))
659 result = Qnil;
661 return result;
664 DEFUN ("make-terminal-frame", Fmake_terminal_frame, Smake_terminal_frame,
665 1, 1, 0,
666 doc: /* Create an additional terminal frame, possibly on another terminal.
667 This function takes one argument, an alist specifying frame parameters.
669 You can create multiple frames on a single text-only terminal, but
670 only one of them (the selected terminal frame) is actually displayed.
672 In practice, generally you don't need to specify any parameters,
673 except when you want to create a new frame on another terminal.
674 In that case, the `tty' parameter specifies the device file to open,
675 and the `tty-type' parameter specifies the terminal type. Example:
677 (make-terminal-frame '((tty . "/dev/pts/5") (tty-type . "xterm")))
679 Note that changing the size of one terminal frame automatically
680 affects all frames on the same terminal device. */)
681 (parms)
682 Lisp_Object parms;
684 struct frame *f;
685 struct terminal *t = NULL;
686 Lisp_Object frame, tem;
687 struct frame *sf = SELECTED_FRAME ();
689 #ifdef MSDOS
690 if (sf->output_method != output_msdos_raw
691 && sf->output_method != output_termcap)
692 abort ();
693 #else /* not MSDOS */
695 #if 0
696 /* This can happen for multi-tty when using both terminal frames and
697 Carbon frames. */
698 if (sf->output_method != output_mac)
699 error ("Not running on a Macintosh screen; cannot make a new Macintosh frame");
700 #else
701 #if 0 /* This should work now! */
702 if (sf->output_method != output_termcap)
703 error ("Not using an ASCII terminal now; cannot make a new ASCII frame");
704 #endif
705 #endif
706 #endif /* not MSDOS */
709 Lisp_Object terminal;
711 terminal = Fassq (Qterminal, parms);
712 if (!NILP (terminal))
714 terminal = XCDR (terminal);
715 t = get_terminal (terminal, 1);
719 if (!t)
721 char *name = 0, *type = 0;
722 Lisp_Object tty, tty_type;
724 tty = get_future_frame_param
725 (Qtty, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
726 ? FRAME_TTY (XFRAME (selected_frame))->name
727 : NULL));
728 if (!NILP (tty))
730 name = (char *) alloca (SBYTES (tty) + 1);
731 strncpy (name, SDATA (tty), SBYTES (tty));
732 name[SBYTES (tty)] = 0;
735 tty_type = get_future_frame_param
736 (Qtty_type, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
737 ? FRAME_TTY (XFRAME (selected_frame))->type
738 : NULL));
739 if (!NILP (tty_type))
741 type = (char *) alloca (SBYTES (tty_type) + 1);
742 strncpy (type, SDATA (tty_type), SBYTES (tty_type));
743 type[SBYTES (tty_type)] = 0;
746 t = init_tty (name, type, 0); /* Errors are not fatal. */
749 f = make_terminal_frame (t);
752 int width, height;
753 get_tty_size (fileno (FRAME_TTY (f)->input), &width, &height);
754 change_frame_size (f, height, width, 0, 0, 0);
757 adjust_glyphs (f);
758 calculate_costs (f);
759 XSETFRAME (frame, f);
760 Fmodify_frame_parameters (frame, Vdefault_frame_alist);
761 Fmodify_frame_parameters (frame, parms);
762 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty_type,
763 build_string (t->display_info.tty->type)),
764 Qnil));
765 if (t->display_info.tty->name != NULL)
766 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty,
767 build_string (t->display_info.tty->name)),
768 Qnil));
769 else
770 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty, Qnil), Qnil));
772 /* Make the frame face alist be frame-specific, so that each
773 frame could change its face definitions independently. */
774 f->face_alist = Fcopy_alist (sf->face_alist);
775 /* Simple Fcopy_alist isn't enough, because we need the contents of
776 the vectors which are the CDRs of associations in face_alist to
777 be copied as well. */
778 for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem))
779 XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem))));
780 return frame;
784 /* Perform the switch to frame FRAME.
786 If FRAME is a switch-frame event `(switch-frame FRAME1)', use
787 FRAME1 as frame.
789 If TRACK is non-zero and the frame that currently has the focus
790 redirects its focus to the selected frame, redirect that focused
791 frame's focus to FRAME instead.
793 FOR_DELETION non-zero means that the selected frame is being
794 deleted, which includes the possibility that the frame's terminal
795 is dead. */
797 Lisp_Object
798 do_switch_frame (frame, track, for_deletion)
799 Lisp_Object frame;
800 int track, for_deletion;
802 struct frame *sf = SELECTED_FRAME ();
804 /* If FRAME is a switch-frame event, extract the frame we should
805 switch to. */
806 if (CONSP (frame)
807 && EQ (XCAR (frame), Qswitch_frame)
808 && CONSP (XCDR (frame)))
809 frame = XCAR (XCDR (frame));
811 /* This used to say CHECK_LIVE_FRAME, but apparently it's possible for
812 a switch-frame event to arrive after a frame is no longer live,
813 especially when deleting the initial frame during startup. */
814 CHECK_FRAME (frame);
815 if (! FRAME_LIVE_P (XFRAME (frame)))
816 return Qnil;
818 if (sf == XFRAME (frame))
819 return frame;
821 /* This is too greedy; it causes inappropriate focus redirection
822 that's hard to get rid of. */
823 #if 0
824 /* If a frame's focus has been redirected toward the currently
825 selected frame, we should change the redirection to point to the
826 newly selected frame. This means that if the focus is redirected
827 from a minibufferless frame to a surrogate minibuffer frame, we
828 can use `other-window' to switch between all the frames using
829 that minibuffer frame, and the focus redirection will follow us
830 around. */
831 if (track)
833 Lisp_Object tail;
835 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
837 Lisp_Object focus;
839 if (!FRAMEP (XCAR (tail)))
840 abort ();
842 focus = FRAME_FOCUS_FRAME (XFRAME (XCAR (tail)));
844 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
845 Fredirect_frame_focus (XCAR (tail), frame);
848 #else /* ! 0 */
849 /* Instead, apply it only to the frame we're pointing to. */
850 #ifdef HAVE_WINDOW_SYSTEM
851 if (track && FRAME_WINDOW_P (XFRAME (frame)))
853 Lisp_Object focus, xfocus;
855 xfocus = x_get_focus_frame (XFRAME (frame));
856 if (FRAMEP (xfocus))
858 focus = FRAME_FOCUS_FRAME (XFRAME (xfocus));
859 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
860 Fredirect_frame_focus (xfocus, frame);
863 #endif /* HAVE_X_WINDOWS */
864 #endif /* ! 0 */
866 if (!for_deletion && FRAME_HAS_MINIBUF_P (sf))
867 resize_mini_window (XWINDOW (FRAME_MINIBUF_WINDOW (sf)), 1);
869 if (FRAME_TERMCAP_P (XFRAME (frame)))
871 if (FRAMEP (FRAME_TTY (XFRAME (frame))->top_frame))
872 /* Mark previously displayed frame as now obscured. */
873 XFRAME (FRAME_TTY (XFRAME (frame))->top_frame)->async_visible = 2;
874 XFRAME (frame)->async_visible = 1;
875 FRAME_TTY (XFRAME (frame))->top_frame = frame;
878 selected_frame = frame;
879 if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
880 last_nonminibuf_frame = XFRAME (selected_frame);
882 Fselect_window (XFRAME (frame)->selected_window, Qnil);
884 /* We want to make sure that the next event generates a frame-switch
885 event to the appropriate frame. This seems kludgy to me, but
886 before you take it out, make sure that evaluating something like
887 (select-window (frame-root-window (new-frame))) doesn't end up
888 with your typing being interpreted in the new frame instead of
889 the one you're actually typing in. */
890 internal_last_event_frame = Qnil;
892 return frame;
895 DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 1, "e",
896 doc: /* Select the frame FRAME.
897 Subsequent editing commands apply to its selected window.
898 The selection of FRAME lasts until the next time the user does
899 something to select a different frame, or until the next time this
900 function is called. If you are using a window system, the previously
901 selected frame may be restored as the selected frame after return to
902 the command loop, because it still may have the window system's input
903 focus. On a text-only terminal, the next redisplay will display FRAME.
905 This function returns FRAME, or nil if FRAME has been deleted. */)
906 (frame)
907 Lisp_Object frame;
909 return do_switch_frame (frame, 1, 0);
913 DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 1, "e",
914 doc: /* Handle a switch-frame event EVENT.
915 Switch-frame events are usually bound to this function.
916 A switch-frame event tells Emacs that the window manager has requested
917 that the user's events be directed to the frame mentioned in the event.
918 This function selects the selected window of the frame of EVENT.
920 If EVENT is frame object, handle it as if it were a switch-frame event
921 to that frame. */)
922 (event)
923 Lisp_Object event;
925 /* Preserve prefix arg that the command loop just cleared. */
926 current_kboard->Vprefix_arg = Vcurrent_prefix_arg;
927 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
928 return do_switch_frame (event, 0, 0);
931 DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0,
932 doc: /* Return the frame that is now selected. */)
935 return selected_frame;
938 DEFUN ("window-frame", Fwindow_frame, Swindow_frame, 1, 1, 0,
939 doc: /* Return the frame object that window WINDOW is on. */)
940 (window)
941 Lisp_Object window;
943 CHECK_LIVE_WINDOW (window);
944 return XWINDOW (window)->frame;
947 DEFUN ("frame-first-window", Fframe_first_window, Sframe_first_window, 0, 1, 0,
948 doc: /* Returns the topmost, leftmost window of FRAME.
949 If omitted, FRAME defaults to the currently selected frame. */)
950 (frame)
951 Lisp_Object frame;
953 Lisp_Object w;
955 if (NILP (frame))
956 w = SELECTED_FRAME ()->root_window;
957 else
959 CHECK_LIVE_FRAME (frame);
960 w = XFRAME (frame)->root_window;
962 while (NILP (XWINDOW (w)->buffer))
964 if (! NILP (XWINDOW (w)->hchild))
965 w = XWINDOW (w)->hchild;
966 else if (! NILP (XWINDOW (w)->vchild))
967 w = XWINDOW (w)->vchild;
968 else
969 abort ();
971 return w;
974 DEFUN ("active-minibuffer-window", Factive_minibuffer_window,
975 Sactive_minibuffer_window, 0, 0, 0,
976 doc: /* Return the currently active minibuffer window, or nil if none. */)
979 return minibuf_level ? minibuf_window : Qnil;
982 DEFUN ("frame-root-window", Fframe_root_window, Sframe_root_window, 0, 1, 0,
983 doc: /* Returns the root-window of FRAME.
984 If omitted, FRAME defaults to the currently selected frame. */)
985 (frame)
986 Lisp_Object frame;
988 Lisp_Object window;
990 if (NILP (frame))
991 window = SELECTED_FRAME ()->root_window;
992 else
994 CHECK_LIVE_FRAME (frame);
995 window = XFRAME (frame)->root_window;
998 return window;
1001 DEFUN ("frame-selected-window", Fframe_selected_window,
1002 Sframe_selected_window, 0, 1, 0,
1003 doc: /* Return the selected window of frame object FRAME.
1004 If omitted, FRAME defaults to the currently selected frame. */)
1005 (frame)
1006 Lisp_Object frame;
1008 Lisp_Object window;
1010 if (NILP (frame))
1011 window = SELECTED_FRAME ()->selected_window;
1012 else
1014 CHECK_LIVE_FRAME (frame);
1015 window = XFRAME (frame)->selected_window;
1018 return window;
1021 DEFUN ("set-frame-selected-window", Fset_frame_selected_window,
1022 Sset_frame_selected_window, 2, 2, 0,
1023 doc: /* Set the selected window of frame object FRAME to WINDOW.
1024 Return WINDOW.
1025 If FRAME is nil, the selected frame is used.
1026 If FRAME is the selected frame, this makes WINDOW the selected window. */)
1027 (frame, window)
1028 Lisp_Object frame, window;
1030 if (NILP (frame))
1031 frame = selected_frame;
1033 CHECK_LIVE_FRAME (frame);
1034 CHECK_LIVE_WINDOW (window);
1036 if (! EQ (frame, WINDOW_FRAME (XWINDOW (window))))
1037 error ("In `set-frame-selected-window', WINDOW is not on FRAME");
1039 if (EQ (frame, selected_frame))
1040 return Fselect_window (window, Qnil);
1042 return XFRAME (frame)->selected_window = window;
1046 DEFUN ("frame-list", Fframe_list, Sframe_list,
1047 0, 0, 0,
1048 doc: /* Return a list of all frames. */)
1051 Lisp_Object frames;
1052 frames = Fcopy_sequence (Vframe_list);
1053 #ifdef HAVE_WINDOW_SYSTEM
1054 if (FRAMEP (tip_frame))
1055 frames = Fdelq (tip_frame, frames);
1056 #endif
1057 return frames;
1060 /* Return the next frame in the frame list after FRAME.
1061 If MINIBUF is nil, exclude minibuffer-only frames.
1062 If MINIBUF is a window, include only its own frame
1063 and any frame now using that window as the minibuffer.
1064 If MINIBUF is `visible', include all visible frames.
1065 If MINIBUF is 0, include all visible and iconified frames.
1066 Otherwise, include all frames. */
1068 static Lisp_Object
1069 next_frame (frame, minibuf)
1070 Lisp_Object frame;
1071 Lisp_Object minibuf;
1073 Lisp_Object tail;
1074 int passed = 0;
1076 /* There must always be at least one frame in Vframe_list. */
1077 if (! CONSP (Vframe_list))
1078 abort ();
1080 /* If this frame is dead, it won't be in Vframe_list, and we'll loop
1081 forever. Forestall that. */
1082 CHECK_LIVE_FRAME (frame);
1084 while (1)
1085 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1087 Lisp_Object f;
1089 f = XCAR (tail);
1091 if (passed
1092 && ((!FRAME_TERMCAP_P (XFRAME (f)) && !FRAME_TERMCAP_P (XFRAME (frame))
1093 && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
1094 || (FRAME_TERMCAP_P (XFRAME (f)) && FRAME_TERMCAP_P (XFRAME (frame))
1095 && FRAME_TTY (XFRAME (f)) == FRAME_TTY (XFRAME (frame)))))
1097 /* Decide whether this frame is eligible to be returned. */
1099 /* If we've looped all the way around without finding any
1100 eligible frames, return the original frame. */
1101 if (EQ (f, frame))
1102 return f;
1104 /* Let minibuf decide if this frame is acceptable. */
1105 if (NILP (minibuf))
1107 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
1108 return f;
1110 else if (EQ (minibuf, Qvisible))
1112 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1113 if (FRAME_VISIBLE_P (XFRAME (f)))
1114 return f;
1116 else if (INTEGERP (minibuf) && XINT (minibuf) == 0)
1118 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1119 if (FRAME_VISIBLE_P (XFRAME (f))
1120 || FRAME_ICONIFIED_P (XFRAME (f)))
1121 return f;
1123 else if (WINDOWP (minibuf))
1125 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
1126 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
1127 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
1128 FRAME_FOCUS_FRAME (XFRAME (f))))
1129 return f;
1131 else
1132 return f;
1135 if (EQ (frame, f))
1136 passed++;
1140 /* Return the previous frame in the frame list before FRAME.
1141 If MINIBUF is nil, exclude minibuffer-only frames.
1142 If MINIBUF is a window, include only its own frame
1143 and any frame now using that window as the minibuffer.
1144 If MINIBUF is `visible', include all visible frames.
1145 If MINIBUF is 0, include all visible and iconified frames.
1146 Otherwise, include all frames. */
1148 static Lisp_Object
1149 prev_frame (frame, minibuf)
1150 Lisp_Object frame;
1151 Lisp_Object minibuf;
1153 Lisp_Object tail;
1154 Lisp_Object prev;
1156 /* There must always be at least one frame in Vframe_list. */
1157 if (! CONSP (Vframe_list))
1158 abort ();
1160 prev = Qnil;
1161 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1163 Lisp_Object f;
1165 f = XCAR (tail);
1166 if (!FRAMEP (f))
1167 abort ();
1169 if (EQ (frame, f) && !NILP (prev))
1170 return prev;
1172 if ((!FRAME_TERMCAP_P (XFRAME (f)) && !FRAME_TERMCAP_P (XFRAME (frame))
1173 && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
1174 || (FRAME_TERMCAP_P (XFRAME (f)) && FRAME_TERMCAP_P (XFRAME (frame))
1175 && FRAME_TTY (XFRAME (f)) == FRAME_TTY (XFRAME (frame))))
1177 /* Decide whether this frame is eligible to be returned,
1178 according to minibuf. */
1179 if (NILP (minibuf))
1181 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
1182 prev = f;
1184 else if (WINDOWP (minibuf))
1186 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
1187 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
1188 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
1189 FRAME_FOCUS_FRAME (XFRAME (f))))
1190 prev = f;
1192 else if (EQ (minibuf, Qvisible))
1194 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1195 if (FRAME_VISIBLE_P (XFRAME (f)))
1196 prev = f;
1198 else if (XFASTINT (minibuf) == 0)
1200 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1201 if (FRAME_VISIBLE_P (XFRAME (f))
1202 || FRAME_ICONIFIED_P (XFRAME (f)))
1203 prev = f;
1205 else
1206 prev = f;
1210 /* We've scanned the entire list. */
1211 if (NILP (prev))
1212 /* We went through the whole frame list without finding a single
1213 acceptable frame. Return the original frame. */
1214 return frame;
1215 else
1216 /* There were no acceptable frames in the list before FRAME; otherwise,
1217 we would have returned directly from the loop. Since PREV is the last
1218 acceptable frame in the list, return it. */
1219 return prev;
1223 DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0,
1224 doc: /* Return the next frame in the frame list after FRAME.
1225 It considers only frames on the same terminal as FRAME.
1226 By default, skip minibuffer-only frames.
1227 If omitted, FRAME defaults to the selected frame.
1228 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1229 If MINIFRAME is a window, include only its own frame
1230 and any frame now using that window as the minibuffer.
1231 If MINIFRAME is `visible', include all visible frames.
1232 If MINIFRAME is 0, include all visible and iconified frames.
1233 Otherwise, include all frames. */)
1234 (frame, miniframe)
1235 Lisp_Object frame, miniframe;
1237 if (NILP (frame))
1238 frame = selected_frame;
1240 CHECK_LIVE_FRAME (frame);
1241 return next_frame (frame, miniframe);
1244 DEFUN ("previous-frame", Fprevious_frame, Sprevious_frame, 0, 2, 0,
1245 doc: /* Return the previous frame in the frame list before FRAME.
1246 It considers only frames on the same terminal as FRAME.
1247 By default, skip minibuffer-only frames.
1248 If omitted, FRAME defaults to the selected frame.
1249 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1250 If MINIFRAME is a window, include only its own frame
1251 and any frame now using that window as the minibuffer.
1252 If MINIFRAME is `visible', include all visible frames.
1253 If MINIFRAME is 0, include all visible and iconified frames.
1254 Otherwise, include all frames. */)
1255 (frame, miniframe)
1256 Lisp_Object frame, miniframe;
1258 if (NILP (frame))
1259 frame = selected_frame;
1260 CHECK_LIVE_FRAME (frame);
1261 return prev_frame (frame, miniframe);
1264 /* Return 1 if it is ok to delete frame F;
1265 0 if all frames aside from F are invisible.
1266 (Exception: if F is the terminal frame, and we are using X, return 1.) */
1269 other_visible_frames (f)
1270 FRAME_PTR f;
1272 /* We know the selected frame is visible,
1273 so if F is some other frame, it can't be the sole visible one. */
1274 if (f == SELECTED_FRAME ())
1276 Lisp_Object frames;
1277 int count = 0;
1279 for (frames = Vframe_list;
1280 CONSP (frames);
1281 frames = XCDR (frames))
1283 Lisp_Object this;
1285 this = XCAR (frames);
1286 /* Verify that the frame's window still exists
1287 and we can still talk to it. And note any recent change
1288 in visibility. */
1289 #ifdef HAVE_WINDOW_SYSTEM
1290 if (FRAME_WINDOW_P (XFRAME (this)))
1292 x_sync (XFRAME (this));
1293 FRAME_SAMPLE_VISIBILITY (XFRAME (this));
1295 #endif
1297 if (FRAME_VISIBLE_P (XFRAME (this))
1298 || FRAME_ICONIFIED_P (XFRAME (this))
1299 /* Allow deleting the terminal frame when at least
1300 one X frame exists! */
1301 || (FRAME_WINDOW_P (XFRAME (this)) && !FRAME_WINDOW_P (f)))
1302 count++;
1304 return count > 1;
1306 return 1;
1309 /* Error handler for `delete-frame-functions'. */
1310 static Lisp_Object
1311 delete_frame_handler (Lisp_Object arg)
1313 add_to_log ("Error during `delete-frame': %s", arg, Qnil);
1314 return Qnil;
1317 extern Lisp_Object Qrun_hook_with_args;
1319 DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 2, "",
1320 doc: /* Delete FRAME, permanently eliminating it from use.
1321 If omitted, FRAME defaults to the selected frame.
1322 A frame may not be deleted if its minibuffer is used by other frames.
1323 Normally, you may not delete a frame if all other frames are invisible,
1324 but if the second optional argument FORCE is non-nil, you may do so.
1326 This function runs `delete-frame-functions' before actually deleting the
1327 frame, unless the frame is a tooltip.
1328 The functions are run with one arg, the frame to be deleted.
1329 But FORCE inhibits this too. */)
1330 /* FORCE is non-nil when handling a disconnected terminal. */
1331 (frame, force)
1332 Lisp_Object frame, force;
1334 struct frame *f;
1335 struct frame *sf = SELECTED_FRAME ();
1336 struct kboard *kb;
1338 int minibuffer_selected;
1340 if (EQ (frame, Qnil))
1342 f = sf;
1343 XSETFRAME (frame, f);
1345 else
1347 CHECK_FRAME (frame);
1348 f = XFRAME (frame);
1351 if (! FRAME_LIVE_P (f))
1352 return Qnil;
1354 if (NILP (force) && !other_visible_frames (f))
1355 error ("Attempt to delete the sole visible or iconified frame");
1357 #if 0
1358 /* This is a nice idea, but x_connection_closed needs to be able
1359 to delete the last frame, if it is gone. */
1360 if (NILP (XCDR (Vframe_list)))
1361 error ("Attempt to delete the only frame");
1362 #endif
1364 /* Does this frame have a minibuffer, and is it the surrogate
1365 minibuffer for any other frame? */
1366 if (FRAME_HAS_MINIBUF_P (XFRAME (frame)))
1368 Lisp_Object frames;
1370 for (frames = Vframe_list;
1371 CONSP (frames);
1372 frames = XCDR (frames))
1374 Lisp_Object this;
1375 this = XCAR (frames);
1377 if (! EQ (this, frame)
1378 && EQ (frame,
1379 WINDOW_FRAME (XWINDOW
1380 (FRAME_MINIBUF_WINDOW (XFRAME (this))))))
1382 /* If we MUST delete this frame, delete the other first. */
1383 if (!NILP (force))
1384 Fdelete_frame (this, force);
1385 else
1386 error ("Attempt to delete a surrogate minibuffer frame");
1391 /* Run `delete-frame-functions'
1392 unless FORCE is `noelisp' or frame is a tooltip.
1393 FORCE is set to `noelisp' when handling a disconnect from the terminal,
1394 so we don't dare call Lisp code. */
1395 if (NILP (Vrun_hooks) || !NILP (Fframe_parameter (frame, intern ("tooltip"))))
1397 if (EQ (force, Qnoelisp))
1398 pending_funcalls
1399 = Fcons (list3 (Qrun_hook_with_args, Qdelete_frame_functions, frame),
1400 pending_funcalls);
1401 else
1402 safe_call2 (Qrun_hook_with_args, Qdelete_frame_functions, frame);
1404 /* The hook may sometimes (indirectly) cause the frame to be deleted. */
1405 if (! FRAME_LIVE_P (f))
1406 return Qnil;
1408 /* At this point, we are committed to deleting the frame.
1409 There is no more chance for errors to prevent it. */
1411 minibuffer_selected = EQ (minibuf_window, selected_window);
1413 /* Don't let the frame remain selected. */
1414 if (f == sf)
1416 Lisp_Object tail, frame1;
1418 /* Look for another visible frame on the same terminal. */
1419 frame1 = next_frame (frame, Qvisible);
1421 /* If there is none, find *some* other frame. */
1422 if (NILP (frame1) || EQ (frame1, frame))
1424 FOR_EACH_FRAME (tail, frame1)
1426 if (! EQ (frame, frame1) && FRAME_LIVE_P (XFRAME (frame1)))
1427 break;
1431 do_switch_frame (frame1, 0, 1);
1432 sf = SELECTED_FRAME ();
1435 /* Don't allow minibuf_window to remain on a deleted frame. */
1436 if (EQ (f->minibuffer_window, minibuf_window))
1438 Fset_window_buffer (sf->minibuffer_window,
1439 XWINDOW (minibuf_window)->buffer, Qnil);
1440 minibuf_window = sf->minibuffer_window;
1442 /* If the dying minibuffer window was selected,
1443 select the new one. */
1444 if (minibuffer_selected)
1445 Fselect_window (minibuf_window, Qnil);
1448 /* Don't let echo_area_window to remain on a deleted frame. */
1449 if (EQ (f->minibuffer_window, echo_area_window))
1450 echo_area_window = sf->minibuffer_window;
1452 /* Clear any X selections for this frame. */
1453 #ifdef HAVE_X_WINDOWS
1454 if (FRAME_X_P (f))
1455 x_clear_frame_selections (f);
1456 #endif
1457 #ifdef MAC_OS
1458 if (FRAME_MAC_P (f))
1459 x_clear_frame_selections (f);
1460 #endif
1462 /* Free glyphs.
1463 This function must be called before the window tree of the
1464 frame is deleted because windows contain dynamically allocated
1465 memory. */
1466 free_glyphs (f);
1468 #ifdef HAVE_WINDOW_SYSTEM
1469 /* Give chance to each font driver to free a frame specific data. */
1470 font_update_drivers (f, Qnil);
1471 #endif
1473 /* Mark all the windows that used to be on FRAME as deleted, and then
1474 remove the reference to them. */
1475 delete_all_subwindows (XWINDOW (f->root_window));
1476 f->root_window = Qnil;
1478 Vframe_list = Fdelq (frame, Vframe_list);
1479 FRAME_SET_VISIBLE (f, 0);
1481 xfree (f->namebuf);
1482 xfree (f->decode_mode_spec_buffer);
1483 xfree (FRAME_INSERT_COST (f));
1484 xfree (FRAME_DELETEN_COST (f));
1485 xfree (FRAME_INSERTN_COST (f));
1486 xfree (FRAME_DELETE_COST (f));
1487 xfree (FRAME_MESSAGE_BUF (f));
1489 /* Since some events are handled at the interrupt level, we may get
1490 an event for f at any time; if we zero out the frame's terminal
1491 now, then we may trip up the event-handling code. Instead, we'll
1492 promise that the terminal of the frame must be valid until we
1493 have called the window-system-dependent frame destruction
1494 routine. */
1496 if (FRAME_TERMINAL (f)->delete_frame_hook)
1497 (*FRAME_TERMINAL (f)->delete_frame_hook) (f);
1500 struct terminal *terminal = FRAME_TERMINAL (f);
1501 f->output_data.nothing = 0;
1502 f->terminal = 0; /* Now the frame is dead. */
1504 /* If needed, delete the terminal that this frame was on.
1505 (This must be done after the frame is killed.) */
1506 terminal->reference_count--;
1507 if (terminal->reference_count == 0)
1509 Lisp_Object tmp;
1510 XSETTERMINAL (tmp, terminal);
1512 kb = NULL;
1513 Fdelete_terminal (tmp, NILP (force) ? Qt : force);
1515 #ifdef MULTI_KBOARD
1516 else
1517 kb = terminal->kboard;
1518 #endif
1521 /* If we've deleted the last_nonminibuf_frame, then try to find
1522 another one. */
1523 if (f == last_nonminibuf_frame)
1525 Lisp_Object frames;
1527 last_nonminibuf_frame = 0;
1529 for (frames = Vframe_list;
1530 CONSP (frames);
1531 frames = XCDR (frames))
1533 f = XFRAME (XCAR (frames));
1534 if (!FRAME_MINIBUF_ONLY_P (f))
1536 last_nonminibuf_frame = f;
1537 break;
1542 /* If there's no other frame on the same kboard, get out of
1543 single-kboard state if we're in it for this kboard. */
1544 if (kb != NULL)
1546 Lisp_Object frames;
1547 /* Some frame we found on the same kboard, or nil if there are none. */
1548 Lisp_Object frame_on_same_kboard;
1550 frame_on_same_kboard = Qnil;
1552 for (frames = Vframe_list;
1553 CONSP (frames);
1554 frames = XCDR (frames))
1556 Lisp_Object this;
1557 struct frame *f1;
1559 this = XCAR (frames);
1560 if (!FRAMEP (this))
1561 abort ();
1562 f1 = XFRAME (this);
1564 if (kb == FRAME_KBOARD (f1))
1565 frame_on_same_kboard = this;
1568 if (NILP (frame_on_same_kboard))
1569 not_single_kboard_state (kb);
1573 /* If we've deleted this keyboard's default_minibuffer_frame, try to
1574 find another one. Prefer minibuffer-only frames, but also notice
1575 frames with other windows. */
1576 if (kb != NULL && EQ (frame, kb->Vdefault_minibuffer_frame))
1578 Lisp_Object frames;
1580 /* The last frame we saw with a minibuffer, minibuffer-only or not. */
1581 Lisp_Object frame_with_minibuf;
1582 /* Some frame we found on the same kboard, or nil if there are none. */
1583 Lisp_Object frame_on_same_kboard;
1585 frame_on_same_kboard = Qnil;
1586 frame_with_minibuf = Qnil;
1588 for (frames = Vframe_list;
1589 CONSP (frames);
1590 frames = XCDR (frames))
1592 Lisp_Object this;
1593 struct frame *f1;
1595 this = XCAR (frames);
1596 if (!FRAMEP (this))
1597 abort ();
1598 f1 = XFRAME (this);
1600 /* Consider only frames on the same kboard
1601 and only those with minibuffers. */
1602 if (kb == FRAME_KBOARD (f1)
1603 && FRAME_HAS_MINIBUF_P (f1))
1605 frame_with_minibuf = this;
1606 if (FRAME_MINIBUF_ONLY_P (f1))
1607 break;
1610 if (kb == FRAME_KBOARD (f1))
1611 frame_on_same_kboard = this;
1614 if (!NILP (frame_on_same_kboard))
1616 /* We know that there must be some frame with a minibuffer out
1617 there. If this were not true, all of the frames present
1618 would have to be minibufferless, which implies that at some
1619 point their minibuffer frames must have been deleted, but
1620 that is prohibited at the top; you can't delete surrogate
1621 minibuffer frames. */
1622 if (NILP (frame_with_minibuf))
1623 abort ();
1625 kb->Vdefault_minibuffer_frame = frame_with_minibuf;
1627 else
1628 /* No frames left on this kboard--say no minibuffer either. */
1629 kb->Vdefault_minibuffer_frame = Qnil;
1632 /* Cause frame titles to update--necessary if we now have just one frame. */
1633 update_mode_lines = 1;
1635 return Qnil;
1638 /* Return mouse position in character cell units. */
1640 DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0,
1641 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1642 The position is given in character cells, where (0, 0) is the
1643 upper-left corner of the frame, X is the horizontal offset, and Y is
1644 the vertical offset.
1645 If Emacs is running on a mouseless terminal or hasn't been programmed
1646 to read the mouse position, it returns the selected frame for FRAME
1647 and nil for X and Y.
1648 If `mouse-position-function' is non-nil, `mouse-position' calls it,
1649 passing the normal return value to that function as an argument,
1650 and returns whatever that function returns. */)
1653 FRAME_PTR f;
1654 Lisp_Object lispy_dummy;
1655 enum scroll_bar_part party_dummy;
1656 Lisp_Object x, y, retval;
1657 int col, row;
1658 unsigned long long_dummy;
1659 struct gcpro gcpro1;
1661 f = SELECTED_FRAME ();
1662 x = y = Qnil;
1664 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
1665 /* It's okay for the hook to refrain from storing anything. */
1666 if (FRAME_TERMINAL (f)->mouse_position_hook)
1667 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1668 &lispy_dummy, &party_dummy,
1669 &x, &y,
1670 &long_dummy);
1671 if (! NILP (x))
1673 col = XINT (x);
1674 row = XINT (y);
1675 pixel_to_glyph_coords (f, col, row, &col, &row, NULL, 1);
1676 XSETINT (x, col);
1677 XSETINT (y, row);
1679 #endif
1680 XSETFRAME (lispy_dummy, f);
1681 retval = Fcons (lispy_dummy, Fcons (x, y));
1682 GCPRO1 (retval);
1683 if (!NILP (Vmouse_position_function))
1684 retval = call1 (Vmouse_position_function, retval);
1685 RETURN_UNGCPRO (retval);
1688 DEFUN ("mouse-pixel-position", Fmouse_pixel_position,
1689 Smouse_pixel_position, 0, 0, 0,
1690 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1691 The position is given in pixel units, where (0, 0) is the
1692 upper-left corner of the frame, X is the horizontal offset, and Y is
1693 the vertical offset.
1694 If Emacs is running on a mouseless terminal or hasn't been programmed
1695 to read the mouse position, it returns the selected frame for FRAME
1696 and nil for X and Y. */)
1699 FRAME_PTR f;
1700 Lisp_Object lispy_dummy;
1701 enum scroll_bar_part party_dummy;
1702 Lisp_Object x, y;
1703 unsigned long long_dummy;
1705 f = SELECTED_FRAME ();
1706 x = y = Qnil;
1708 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
1709 /* It's okay for the hook to refrain from storing anything. */
1710 if (FRAME_TERMINAL (f)->mouse_position_hook)
1711 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1712 &lispy_dummy, &party_dummy,
1713 &x, &y,
1714 &long_dummy);
1715 #endif
1716 XSETFRAME (lispy_dummy, f);
1717 return Fcons (lispy_dummy, Fcons (x, y));
1720 DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0,
1721 doc: /* Move the mouse pointer to the center of character cell (X,Y) in FRAME.
1722 Coordinates are relative to the frame, not a window,
1723 so the coordinates of the top left character in the frame
1724 may be nonzero due to left-hand scroll bars or the menu bar.
1726 The position is given in character cells, where (0, 0) is the
1727 upper-left corner of the frame, X is the horizontal offset, and Y is
1728 the vertical offset.
1730 This function is a no-op for an X frame that is not visible.
1731 If you have just created a frame, you must wait for it to become visible
1732 before calling this function on it, like this.
1733 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1734 (frame, x, y)
1735 Lisp_Object frame, x, y;
1737 CHECK_LIVE_FRAME (frame);
1738 CHECK_NUMBER (x);
1739 CHECK_NUMBER (y);
1741 /* I think this should be done with a hook. */
1742 #ifdef HAVE_WINDOW_SYSTEM
1743 if (FRAME_WINDOW_P (XFRAME (frame)))
1744 /* Warping the mouse will cause enternotify and focus events. */
1745 x_set_mouse_position (XFRAME (frame), XINT (x), XINT (y));
1746 #else
1747 #if defined (MSDOS) && defined (HAVE_MOUSE)
1748 if (FRAME_MSDOS_P (XFRAME (frame)))
1750 Fselect_frame (frame);
1751 mouse_moveto (XINT (x), XINT (y));
1753 #else
1754 #ifdef HAVE_GPM
1756 Fselect_frame (frame);
1757 term_mouse_moveto (XINT (x), XINT (y));
1759 #endif
1760 #endif
1761 #endif
1763 return Qnil;
1766 DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position,
1767 Sset_mouse_pixel_position, 3, 3, 0,
1768 doc: /* Move the mouse pointer to pixel position (X,Y) in FRAME.
1769 The position is given in pixels, where (0, 0) is the upper-left corner
1770 of the frame, X is the horizontal offset, and Y is the vertical offset.
1772 Note, this is a no-op for an X frame that is not visible.
1773 If you have just created a frame, you must wait for it to become visible
1774 before calling this function on it, like this.
1775 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1776 (frame, x, y)
1777 Lisp_Object frame, x, y;
1779 CHECK_LIVE_FRAME (frame);
1780 CHECK_NUMBER (x);
1781 CHECK_NUMBER (y);
1783 /* I think this should be done with a hook. */
1784 #ifdef HAVE_WINDOW_SYSTEM
1785 if (FRAME_WINDOW_P (XFRAME (frame)))
1786 /* Warping the mouse will cause enternotify and focus events. */
1787 x_set_mouse_pixel_position (XFRAME (frame), XINT (x), XINT (y));
1788 #else
1789 #if defined (MSDOS) && defined (HAVE_MOUSE)
1790 if (FRAME_MSDOS_P (XFRAME (frame)))
1792 Fselect_frame (frame);
1793 mouse_moveto (XINT (x), XINT (y));
1795 #else
1796 #ifdef HAVE_GPM
1798 Fselect_frame (frame);
1799 term_mouse_moveto (XINT (x), XINT (y));
1801 #endif
1802 #endif
1803 #endif
1805 return Qnil;
1808 static void make_frame_visible_1 P_ ((Lisp_Object));
1810 DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible,
1811 0, 1, "",
1812 doc: /* Make the frame FRAME visible (assuming it is an X window).
1813 If omitted, FRAME defaults to the currently selected frame. */)
1814 (frame)
1815 Lisp_Object frame;
1817 if (NILP (frame))
1818 frame = selected_frame;
1820 CHECK_LIVE_FRAME (frame);
1822 /* I think this should be done with a hook. */
1823 #ifdef HAVE_WINDOW_SYSTEM
1824 if (FRAME_WINDOW_P (XFRAME (frame)))
1826 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1827 x_make_frame_visible (XFRAME (frame));
1829 #endif
1831 make_frame_visible_1 (XFRAME (frame)->root_window);
1833 /* Make menu bar update for the Buffers and Frames menus. */
1834 windows_or_buffers_changed++;
1836 return frame;
1839 /* Update the display_time slot of the buffers shown in WINDOW
1840 and all its descendents. */
1842 static void
1843 make_frame_visible_1 (window)
1844 Lisp_Object window;
1846 struct window *w;
1848 for (;!NILP (window); window = w->next)
1850 w = XWINDOW (window);
1852 if (!NILP (w->buffer))
1853 XBUFFER (w->buffer)->display_time = Fcurrent_time ();
1855 if (!NILP (w->vchild))
1856 make_frame_visible_1 (w->vchild);
1857 if (!NILP (w->hchild))
1858 make_frame_visible_1 (w->hchild);
1862 DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible,
1863 0, 2, "",
1864 doc: /* Make the frame FRAME invisible (assuming it is an X window).
1865 If omitted, FRAME defaults to the currently selected frame.
1866 Normally you may not make FRAME invisible if all other frames are invisible,
1867 but if the second optional argument FORCE is non-nil, you may do so. */)
1868 (frame, force)
1869 Lisp_Object frame, force;
1871 if (NILP (frame))
1872 frame = selected_frame;
1874 CHECK_LIVE_FRAME (frame);
1876 if (NILP (force) && !other_visible_frames (XFRAME (frame)))
1877 error ("Attempt to make invisible the sole visible or iconified frame");
1879 #if 0 /* This isn't logically necessary, and it can do GC. */
1880 /* Don't let the frame remain selected. */
1881 if (EQ (frame, selected_frame))
1882 do_switch_frame (next_frame (frame, Qt), 0, 0)
1883 #endif
1885 /* Don't allow minibuf_window to remain on a deleted frame. */
1886 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1888 struct frame *sf = XFRAME (selected_frame);
1889 Fset_window_buffer (sf->minibuffer_window,
1890 XWINDOW (minibuf_window)->buffer, Qnil);
1891 minibuf_window = sf->minibuffer_window;
1894 /* I think this should be done with a hook. */
1895 #ifdef HAVE_WINDOW_SYSTEM
1896 if (FRAME_WINDOW_P (XFRAME (frame)))
1897 x_make_frame_invisible (XFRAME (frame));
1898 #endif
1900 /* Make menu bar update for the Buffers and Frames menus. */
1901 windows_or_buffers_changed++;
1903 return Qnil;
1906 DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame,
1907 0, 1, "",
1908 doc: /* Make the frame FRAME into an icon.
1909 If omitted, FRAME defaults to the currently selected frame. */)
1910 (frame)
1911 Lisp_Object frame;
1913 if (NILP (frame))
1914 frame = selected_frame;
1916 CHECK_LIVE_FRAME (frame);
1918 #if 0 /* This isn't logically necessary, and it can do GC. */
1919 /* Don't let the frame remain selected. */
1920 if (EQ (frame, selected_frame))
1921 Fhandle_switch_frame (next_frame (frame, Qt));
1922 #endif
1924 /* Don't allow minibuf_window to remain on a deleted frame. */
1925 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1927 struct frame *sf = XFRAME (selected_frame);
1928 Fset_window_buffer (sf->minibuffer_window,
1929 XWINDOW (minibuf_window)->buffer, Qnil);
1930 minibuf_window = sf->minibuffer_window;
1933 /* I think this should be done with a hook. */
1934 #ifdef HAVE_WINDOW_SYSTEM
1935 if (FRAME_WINDOW_P (XFRAME (frame)))
1936 x_iconify_frame (XFRAME (frame));
1937 #endif
1939 /* Make menu bar update for the Buffers and Frames menus. */
1940 windows_or_buffers_changed++;
1942 return Qnil;
1945 DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p,
1946 1, 1, 0,
1947 doc: /* Return t if FRAME is now \"visible\" (actually in use for display).
1948 A frame that is not \"visible\" is not updated and, if it works through
1949 a window system, it may not show at all.
1950 Return the symbol `icon' if frame is visible only as an icon.
1952 On a text-only terminal, all frames are considered visible, whether
1953 they are currently being displayed or not, and this function returns t
1954 for all frames. */)
1955 (frame)
1956 Lisp_Object frame;
1958 CHECK_LIVE_FRAME (frame);
1960 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1962 if (FRAME_VISIBLE_P (XFRAME (frame)))
1963 return Qt;
1964 if (FRAME_ICONIFIED_P (XFRAME (frame)))
1965 return Qicon;
1966 return Qnil;
1969 DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list,
1970 0, 0, 0,
1971 doc: /* Return a list of all frames now \"visible\" (being updated). */)
1974 Lisp_Object tail, frame;
1975 struct frame *f;
1976 Lisp_Object value;
1978 value = Qnil;
1979 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1981 frame = XCAR (tail);
1982 if (!FRAMEP (frame))
1983 continue;
1984 f = XFRAME (frame);
1985 if (FRAME_VISIBLE_P (f))
1986 value = Fcons (frame, value);
1988 return value;
1992 DEFUN ("raise-frame", Fraise_frame, Sraise_frame, 0, 1, "",
1993 doc: /* Bring FRAME to the front, so it occludes any frames it overlaps.
1994 If FRAME is invisible or iconified, make it visible.
1995 If you don't specify a frame, the selected frame is used.
1996 If Emacs is displaying on an ordinary terminal or some other device which
1997 doesn't support multiple overlapping frames, this function does nothing. */)
1998 (frame)
1999 Lisp_Object frame;
2001 struct frame *f;
2002 if (NILP (frame))
2003 frame = selected_frame;
2005 CHECK_LIVE_FRAME (frame);
2007 f = XFRAME (frame);
2009 /* Do like the documentation says. */
2010 Fmake_frame_visible (frame);
2012 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
2013 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 1);
2015 return Qnil;
2018 /* Should we have a corresponding function called Flower_Power? */
2019 DEFUN ("lower-frame", Flower_frame, Slower_frame, 0, 1, "",
2020 doc: /* Send FRAME to the back, so it is occluded by any frames that overlap it.
2021 If you don't specify a frame, the selected frame is used.
2022 If Emacs is displaying on an ordinary terminal or some other device which
2023 doesn't support multiple overlapping frames, this function does nothing. */)
2024 (frame)
2025 Lisp_Object frame;
2027 struct frame *f;
2029 if (NILP (frame))
2030 frame = selected_frame;
2032 CHECK_LIVE_FRAME (frame);
2034 f = XFRAME (frame);
2036 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
2037 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 0);
2039 return Qnil;
2043 DEFUN ("redirect-frame-focus", Fredirect_frame_focus, Sredirect_frame_focus,
2044 1, 2, 0,
2045 doc: /* Arrange for keystrokes typed at FRAME to be sent to FOCUS-FRAME.
2046 In other words, switch-frame events caused by events in FRAME will
2047 request a switch to FOCUS-FRAME, and `last-event-frame' will be
2048 FOCUS-FRAME after reading an event typed at FRAME.
2050 If FOCUS-FRAME is omitted or nil, any existing redirection is
2051 cancelled, and the frame again receives its own keystrokes.
2053 Focus redirection is useful for temporarily redirecting keystrokes to
2054 a surrogate minibuffer frame when a frame doesn't have its own
2055 minibuffer window.
2057 A frame's focus redirection can be changed by `select-frame'. If frame
2058 FOO is selected, and then a different frame BAR is selected, any
2059 frames redirecting their focus to FOO are shifted to redirect their
2060 focus to BAR. This allows focus redirection to work properly when the
2061 user switches from one frame to another using `select-window'.
2063 This means that a frame whose focus is redirected to itself is treated
2064 differently from a frame whose focus is redirected to nil; the former
2065 is affected by `select-frame', while the latter is not.
2067 The redirection lasts until `redirect-frame-focus' is called to change it. */)
2068 (frame, focus_frame)
2069 Lisp_Object frame, focus_frame;
2071 struct frame *f;
2073 /* Note that we don't check for a live frame here. It's reasonable
2074 to redirect the focus of a frame you're about to delete, if you
2075 know what other frame should receive those keystrokes. */
2076 CHECK_FRAME (frame);
2078 if (! NILP (focus_frame))
2079 CHECK_LIVE_FRAME (focus_frame);
2081 f = XFRAME (frame);
2083 f->focus_frame = focus_frame;
2085 if (FRAME_TERMINAL (f)->frame_rehighlight_hook)
2086 (*FRAME_TERMINAL (f)->frame_rehighlight_hook) (f);
2088 return Qnil;
2092 DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 1, 1, 0,
2093 doc: /* Return the frame to which FRAME's keystrokes are currently being sent.
2094 This returns nil if FRAME's focus is not redirected.
2095 See `redirect-frame-focus'. */)
2096 (frame)
2097 Lisp_Object frame;
2099 CHECK_LIVE_FRAME (frame);
2101 return FRAME_FOCUS_FRAME (XFRAME (frame));
2106 /* Return the value of frame parameter PROP in frame FRAME. */
2108 Lisp_Object
2109 get_frame_param (frame, prop)
2110 register struct frame *frame;
2111 Lisp_Object prop;
2113 register Lisp_Object tem;
2115 tem = Fassq (prop, frame->param_alist);
2116 if (EQ (tem, Qnil))
2117 return tem;
2118 return Fcdr (tem);
2121 /* Return the buffer-predicate of the selected frame. */
2123 Lisp_Object
2124 frame_buffer_predicate (frame)
2125 Lisp_Object frame;
2127 return XFRAME (frame)->buffer_predicate;
2130 /* Return the buffer-list of the selected frame. */
2132 Lisp_Object
2133 frame_buffer_list (frame)
2134 Lisp_Object frame;
2136 return XFRAME (frame)->buffer_list;
2139 /* Set the buffer-list of the selected frame. */
2141 void
2142 set_frame_buffer_list (frame, list)
2143 Lisp_Object frame, list;
2145 XFRAME (frame)->buffer_list = list;
2148 /* Discard BUFFER from the buffer-list and buried-buffer-list of each frame. */
2150 void
2151 frames_discard_buffer (buffer)
2152 Lisp_Object buffer;
2154 Lisp_Object frame, tail;
2156 FOR_EACH_FRAME (tail, frame)
2158 XFRAME (frame)->buffer_list
2159 = Fdelq (buffer, XFRAME (frame)->buffer_list);
2160 XFRAME (frame)->buried_buffer_list
2161 = Fdelq (buffer, XFRAME (frame)->buried_buffer_list);
2165 /* Modify the alist in *ALISTPTR to associate PROP with VAL.
2166 If the alist already has an element for PROP, we change it. */
2168 void
2169 store_in_alist (alistptr, prop, val)
2170 Lisp_Object *alistptr, val;
2171 Lisp_Object prop;
2173 register Lisp_Object tem;
2175 tem = Fassq (prop, *alistptr);
2176 if (EQ (tem, Qnil))
2177 *alistptr = Fcons (Fcons (prop, val), *alistptr);
2178 else
2179 Fsetcdr (tem, val);
2182 static int
2183 frame_name_fnn_p (str, len)
2184 char *str;
2185 EMACS_INT len;
2187 if (len > 1 && str[0] == 'F')
2189 char *end_ptr;
2191 strtol (str + 1, &end_ptr, 10);
2193 if (end_ptr == str + len)
2194 return 1;
2196 return 0;
2199 /* Set the name of the terminal frame. Also used by MSDOS frames.
2200 Modeled after x_set_name which is used for WINDOW frames. */
2202 static void
2203 set_term_frame_name (f, name)
2204 struct frame *f;
2205 Lisp_Object name;
2207 f->explicit_name = ! NILP (name);
2209 /* If NAME is nil, set the name to F<num>. */
2210 if (NILP (name))
2212 char namebuf[20];
2214 /* Check for no change needed in this very common case
2215 before we do any consing. */
2216 if (frame_name_fnn_p (SDATA (f->name),
2217 SBYTES (f->name)))
2218 return;
2220 tty_frame_count++;
2221 sprintf (namebuf, "F%d", tty_frame_count);
2222 name = build_string (namebuf);
2224 else
2226 CHECK_STRING (name);
2228 /* Don't change the name if it's already NAME. */
2229 if (! NILP (Fstring_equal (name, f->name)))
2230 return;
2232 /* Don't allow the user to set the frame name to F<num>, so it
2233 doesn't clash with the names we generate for terminal frames. */
2234 if (frame_name_fnn_p (SDATA (name), SBYTES (name)))
2235 error ("Frame names of the form F<num> are usurped by Emacs");
2238 f->name = name;
2239 update_mode_lines = 1;
2242 void
2243 store_frame_param (f, prop, val)
2244 struct frame *f;
2245 Lisp_Object prop, val;
2247 register Lisp_Object old_alist_elt;
2249 /* The buffer-list parameters are stored in a special place and not
2250 in the alist. */
2251 if (EQ (prop, Qbuffer_list))
2253 f->buffer_list = val;
2254 return;
2256 if (EQ (prop, Qburied_buffer_list))
2258 f->buried_buffer_list = val;
2259 return;
2262 /* If PROP is a symbol which is supposed to have frame-local values,
2263 and it is set up based on this frame, switch to the global
2264 binding. That way, we can create or alter the frame-local binding
2265 without messing up the symbol's status. */
2266 if (SYMBOLP (prop))
2268 Lisp_Object valcontents;
2269 valcontents = SYMBOL_VALUE (prop);
2270 if ((BUFFER_LOCAL_VALUEP (valcontents))
2271 && XBUFFER_LOCAL_VALUE (valcontents)->check_frame
2272 && XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame
2273 && XFRAME (XBUFFER_LOCAL_VALUE (valcontents)->frame) == f)
2274 swap_in_global_binding (prop);
2277 #ifndef WINDOWSNT
2278 /* The tty color needed to be set before the frame's parameter
2279 alist was updated with the new value. This is not true any more,
2280 but we still do this test early on. */
2281 if (FRAME_TERMCAP_P (f) && EQ (prop, Qtty_color_mode)
2282 && f == FRAME_TTY (f)->previous_frame)
2283 /* Force redisplay of this tty. */
2284 FRAME_TTY (f)->previous_frame = NULL;
2285 #endif
2287 /* Update the frame parameter alist. */
2288 old_alist_elt = Fassq (prop, f->param_alist);
2289 if (EQ (old_alist_elt, Qnil))
2290 f->param_alist = Fcons (Fcons (prop, val), f->param_alist);
2291 else
2292 Fsetcdr (old_alist_elt, val);
2294 /* Update some other special parameters in their special places
2295 in addition to the alist. */
2297 if (EQ (prop, Qbuffer_predicate))
2298 f->buffer_predicate = val;
2300 if (! FRAME_WINDOW_P (f))
2302 if (EQ (prop, Qmenu_bar_lines))
2303 set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f)));
2304 else if (EQ (prop, Qname))
2305 set_term_frame_name (f, val);
2308 if (EQ (prop, Qminibuffer) && WINDOWP (val))
2310 if (! MINI_WINDOW_P (XWINDOW (val)))
2311 error ("Surrogate minibuffer windows must be minibuffer windows");
2313 if ((FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
2314 && !EQ (val, f->minibuffer_window))
2315 error ("Can't change the surrogate minibuffer of a frame with its own minibuffer");
2317 /* Install the chosen minibuffer window, with proper buffer. */
2318 f->minibuffer_window = val;
2322 DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0,
2323 doc: /* Return the parameters-alist of frame FRAME.
2324 It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
2325 The meaningful PARMs depend on the kind of frame.
2326 If FRAME is omitted, return information on the currently selected frame. */)
2327 (frame)
2328 Lisp_Object frame;
2330 Lisp_Object alist;
2331 FRAME_PTR f;
2332 int height, width;
2333 struct gcpro gcpro1;
2335 if (NILP (frame))
2336 frame = selected_frame;
2338 CHECK_FRAME (frame);
2339 f = XFRAME (frame);
2341 if (!FRAME_LIVE_P (f))
2342 return Qnil;
2344 alist = Fcopy_alist (f->param_alist);
2345 GCPRO1 (alist);
2347 if (!FRAME_WINDOW_P (f))
2349 int fg = FRAME_FOREGROUND_PIXEL (f);
2350 int bg = FRAME_BACKGROUND_PIXEL (f);
2351 Lisp_Object elt;
2353 /* If the frame's parameter alist says the colors are
2354 unspecified and reversed, take the frame's background pixel
2355 for foreground and vice versa. */
2356 elt = Fassq (Qforeground_color, alist);
2357 if (CONSP (elt) && STRINGP (XCDR (elt)))
2359 if (strncmp (SDATA (XCDR (elt)),
2360 unspecified_bg,
2361 SCHARS (XCDR (elt))) == 0)
2362 store_in_alist (&alist, Qforeground_color, tty_color_name (f, bg));
2363 else if (strncmp (SDATA (XCDR (elt)),
2364 unspecified_fg,
2365 SCHARS (XCDR (elt))) == 0)
2366 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2368 else
2369 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2370 elt = Fassq (Qbackground_color, alist);
2371 if (CONSP (elt) && STRINGP (XCDR (elt)))
2373 if (strncmp (SDATA (XCDR (elt)),
2374 unspecified_fg,
2375 SCHARS (XCDR (elt))) == 0)
2376 store_in_alist (&alist, Qbackground_color, tty_color_name (f, fg));
2377 else if (strncmp (SDATA (XCDR (elt)),
2378 unspecified_bg,
2379 SCHARS (XCDR (elt))) == 0)
2380 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2382 else
2383 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2384 store_in_alist (&alist, intern ("font"),
2385 build_string (FRAME_MSDOS_P (f)
2386 ? "ms-dos"
2387 : FRAME_W32_P (f) ? "w32term"
2388 :"tty"));
2390 store_in_alist (&alist, Qname, f->name);
2391 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2392 store_in_alist (&alist, Qheight, make_number (height));
2393 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2394 store_in_alist (&alist, Qwidth, make_number (width));
2395 store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil));
2396 store_in_alist (&alist, Qminibuffer,
2397 (! FRAME_HAS_MINIBUF_P (f) ? Qnil
2398 : FRAME_MINIBUF_ONLY_P (f) ? Qonly
2399 : FRAME_MINIBUF_WINDOW (f)));
2400 store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
2401 store_in_alist (&alist, Qbuffer_list, frame_buffer_list (frame));
2402 store_in_alist (&alist, Qburied_buffer_list, XFRAME (frame)->buried_buffer_list);
2404 /* I think this should be done with a hook. */
2405 #ifdef HAVE_WINDOW_SYSTEM
2406 if (FRAME_WINDOW_P (f))
2407 x_report_frame_params (f, &alist);
2408 else
2409 #endif
2411 /* This ought to be correct in f->param_alist for an X frame. */
2412 Lisp_Object lines;
2413 XSETFASTINT (lines, FRAME_MENU_BAR_LINES (f));
2414 store_in_alist (&alist, Qmenu_bar_lines, lines);
2417 UNGCPRO;
2418 return alist;
2422 DEFUN ("frame-parameter", Fframe_parameter, Sframe_parameter, 2, 2, 0,
2423 doc: /* Return FRAME's value for parameter PARAMETER.
2424 If FRAME is nil, describe the currently selected frame. */)
2425 (frame, parameter)
2426 Lisp_Object frame, parameter;
2428 struct frame *f;
2429 Lisp_Object value;
2431 if (NILP (frame))
2432 frame = selected_frame;
2433 else
2434 CHECK_FRAME (frame);
2435 CHECK_SYMBOL (parameter);
2437 f = XFRAME (frame);
2438 value = Qnil;
2440 if (FRAME_LIVE_P (f))
2442 /* Avoid consing in frequent cases. */
2443 if (EQ (parameter, Qname))
2444 value = f->name;
2445 #ifdef HAVE_X_WINDOWS
2446 else if (EQ (parameter, Qdisplay) && FRAME_X_P (f))
2447 value = XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element);
2448 #endif /* HAVE_X_WINDOWS */
2449 else if (EQ (parameter, Qbackground_color)
2450 || EQ (parameter, Qforeground_color))
2452 value = Fassq (parameter, f->param_alist);
2453 if (CONSP (value))
2455 value = XCDR (value);
2456 /* Fframe_parameters puts the actual fg/bg color names,
2457 even if f->param_alist says otherwise. This is
2458 important when param_alist's notion of colors is
2459 "unspecified". We need to do the same here. */
2460 if (STRINGP (value) && !FRAME_WINDOW_P (f))
2462 const char *color_name;
2463 EMACS_INT csz;
2465 if (EQ (parameter, Qbackground_color))
2467 color_name = SDATA (value);
2468 csz = SCHARS (value);
2469 if (strncmp (color_name, unspecified_bg, csz) == 0)
2470 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2471 else if (strncmp (color_name, unspecified_fg, csz) == 0)
2472 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2474 else if (EQ (parameter, Qforeground_color))
2476 color_name = SDATA (value);
2477 csz = SCHARS (value);
2478 if (strncmp (color_name, unspecified_fg, csz) == 0)
2479 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2480 else if (strncmp (color_name, unspecified_bg, csz) == 0)
2481 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2485 else
2486 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2488 else if (EQ (parameter, Qdisplay_type)
2489 || EQ (parameter, Qbackground_mode))
2490 value = Fcdr (Fassq (parameter, f->param_alist));
2491 else
2492 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2495 return value;
2499 DEFUN ("modify-frame-parameters", Fmodify_frame_parameters,
2500 Smodify_frame_parameters, 2, 2, 0,
2501 doc: /* Modify the parameters of frame FRAME according to ALIST.
2502 If FRAME is nil, it defaults to the selected frame.
2503 ALIST is an alist of parameters to change and their new values.
2504 Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.
2505 The meaningful PARMs depend on the kind of frame.
2506 Undefined PARMs are ignored, but stored in the frame's parameter list
2507 so that `frame-parameters' will return them.
2509 The value of frame parameter FOO can also be accessed
2510 as a frame-local binding for the variable FOO, if you have
2511 enabled such bindings for that variable with `make-variable-frame-local'. */)
2512 (frame, alist)
2513 Lisp_Object frame, alist;
2515 FRAME_PTR f;
2516 register Lisp_Object tail, prop, val;
2518 if (EQ (frame, Qnil))
2519 frame = selected_frame;
2520 CHECK_LIVE_FRAME (frame);
2521 f = XFRAME (frame);
2523 /* I think this should be done with a hook. */
2524 #ifdef HAVE_WINDOW_SYSTEM
2525 if (FRAME_WINDOW_P (f))
2526 x_set_frame_parameters (f, alist);
2527 else
2528 #endif
2529 #ifdef MSDOS
2530 if (FRAME_MSDOS_P (f))
2531 IT_set_frame_parameters (f, alist);
2532 else
2533 #endif
2536 int length = XINT (Flength (alist));
2537 int i;
2538 Lisp_Object *parms
2539 = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
2540 Lisp_Object *values
2541 = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
2543 /* Extract parm names and values into those vectors. */
2545 i = 0;
2546 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2548 Lisp_Object elt;
2550 elt = XCAR (tail);
2551 parms[i] = Fcar (elt);
2552 values[i] = Fcdr (elt);
2553 i++;
2556 /* Now process them in reverse of specified order. */
2557 for (i--; i >= 0; i--)
2559 prop = parms[i];
2560 val = values[i];
2561 store_frame_param (f, prop, val);
2563 /* Changing the background color might change the background
2564 mode, so that we have to load new defface specs.
2565 Call frame-set-background-mode to do that. */
2566 if (EQ (prop, Qbackground_color))
2567 call1 (Qframe_set_background_mode, frame);
2570 return Qnil;
2573 DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height,
2574 0, 1, 0,
2575 doc: /* Height in pixels of a line in the font in frame FRAME.
2576 If FRAME is omitted, the selected frame is used.
2577 For a terminal frame, the value is always 1. */)
2578 (frame)
2579 Lisp_Object frame;
2581 struct frame *f;
2583 if (NILP (frame))
2584 frame = selected_frame;
2585 CHECK_FRAME (frame);
2586 f = XFRAME (frame);
2588 #ifdef HAVE_WINDOW_SYSTEM
2589 if (FRAME_WINDOW_P (f))
2590 return make_number (x_char_height (f));
2591 else
2592 #endif
2593 return make_number (1);
2597 DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width,
2598 0, 1, 0,
2599 doc: /* Width in pixels of characters in the font in frame FRAME.
2600 If FRAME is omitted, the selected frame is used.
2601 On a graphical screen, the width is the standard width of the default font.
2602 For a terminal screen, the value is always 1. */)
2603 (frame)
2604 Lisp_Object frame;
2606 struct frame *f;
2608 if (NILP (frame))
2609 frame = selected_frame;
2610 CHECK_FRAME (frame);
2611 f = XFRAME (frame);
2613 #ifdef HAVE_WINDOW_SYSTEM
2614 if (FRAME_WINDOW_P (f))
2615 return make_number (x_char_width (f));
2616 else
2617 #endif
2618 return make_number (1);
2621 DEFUN ("frame-pixel-height", Fframe_pixel_height,
2622 Sframe_pixel_height, 0, 1, 0,
2623 doc: /* Return a FRAME's height in pixels.
2624 This counts only the height available for text lines,
2625 not menu bars on window-system Emacs frames.
2626 For a terminal frame, the result really gives the height in characters.
2627 If FRAME is omitted, the selected frame is used. */)
2628 (frame)
2629 Lisp_Object frame;
2631 struct frame *f;
2633 if (NILP (frame))
2634 frame = selected_frame;
2635 CHECK_FRAME (frame);
2636 f = XFRAME (frame);
2638 #ifdef HAVE_WINDOW_SYSTEM
2639 if (FRAME_WINDOW_P (f))
2640 return make_number (x_pixel_height (f));
2641 else
2642 #endif
2643 return make_number (FRAME_LINES (f));
2646 DEFUN ("frame-pixel-width", Fframe_pixel_width,
2647 Sframe_pixel_width, 0, 1, 0,
2648 doc: /* Return FRAME's width in pixels.
2649 For a terminal frame, the result really gives the width in characters.
2650 If FRAME is omitted, the selected frame is used. */)
2651 (frame)
2652 Lisp_Object frame;
2654 struct frame *f;
2656 if (NILP (frame))
2657 frame = selected_frame;
2658 CHECK_FRAME (frame);
2659 f = XFRAME (frame);
2661 #ifdef HAVE_WINDOW_SYSTEM
2662 if (FRAME_WINDOW_P (f))
2663 return make_number (x_pixel_width (f));
2664 else
2665 #endif
2666 return make_number (FRAME_COLS (f));
2669 DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0,
2670 doc: /* Specify that the frame FRAME has LINES lines.
2671 Optional third arg non-nil means that redisplay should use LINES lines
2672 but that the idea of the actual height of the frame should not be changed. */)
2673 (frame, lines, pretend)
2674 Lisp_Object frame, lines, pretend;
2676 register struct frame *f;
2678 CHECK_NUMBER (lines);
2679 if (NILP (frame))
2680 frame = selected_frame;
2681 CHECK_LIVE_FRAME (frame);
2682 f = XFRAME (frame);
2684 /* I think this should be done with a hook. */
2685 #ifdef HAVE_WINDOW_SYSTEM
2686 if (FRAME_WINDOW_P (f))
2688 if (XINT (lines) != FRAME_LINES (f))
2689 x_set_window_size (f, 1, FRAME_COLS (f), XINT (lines));
2690 do_pending_window_change (0);
2692 else
2693 #endif
2694 change_frame_size (f, XINT (lines), 0, !NILP (pretend), 0, 0);
2695 return Qnil;
2698 DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 3, 0,
2699 doc: /* Specify that the frame FRAME has COLS columns.
2700 Optional third arg non-nil means that redisplay should use COLS columns
2701 but that the idea of the actual width of the frame should not be changed. */)
2702 (frame, cols, pretend)
2703 Lisp_Object frame, cols, pretend;
2705 register struct frame *f;
2706 CHECK_NUMBER (cols);
2707 if (NILP (frame))
2708 frame = selected_frame;
2709 CHECK_LIVE_FRAME (frame);
2710 f = XFRAME (frame);
2712 /* I think this should be done with a hook. */
2713 #ifdef HAVE_WINDOW_SYSTEM
2714 if (FRAME_WINDOW_P (f))
2716 if (XINT (cols) != FRAME_COLS (f))
2717 x_set_window_size (f, 1, XINT (cols), FRAME_LINES (f));
2718 do_pending_window_change (0);
2720 else
2721 #endif
2722 change_frame_size (f, 0, XINT (cols), !NILP (pretend), 0, 0);
2723 return Qnil;
2726 DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0,
2727 doc: /* Sets size of FRAME to COLS by ROWS, measured in characters. */)
2728 (frame, cols, rows)
2729 Lisp_Object frame, cols, rows;
2731 register struct frame *f;
2733 CHECK_LIVE_FRAME (frame);
2734 CHECK_NUMBER (cols);
2735 CHECK_NUMBER (rows);
2736 f = XFRAME (frame);
2738 /* I think this should be done with a hook. */
2739 #ifdef HAVE_WINDOW_SYSTEM
2740 if (FRAME_WINDOW_P (f))
2742 if (XINT (rows) != FRAME_LINES (f)
2743 || XINT (cols) != FRAME_COLS (f)
2744 || f->new_text_lines || f->new_text_cols)
2745 x_set_window_size (f, 1, XINT (cols), XINT (rows));
2746 do_pending_window_change (0);
2748 else
2749 #endif
2750 change_frame_size (f, XINT (rows), XINT (cols), 0, 0, 0);
2752 return Qnil;
2755 DEFUN ("set-frame-position", Fset_frame_position,
2756 Sset_frame_position, 3, 3, 0,
2757 doc: /* Sets position of FRAME in pixels to XOFFSET by YOFFSET.
2758 This is actually the position of the upper left corner of the frame.
2759 Negative values for XOFFSET or YOFFSET are interpreted relative to
2760 the rightmost or bottommost possible position (that stays within the screen). */)
2761 (frame, xoffset, yoffset)
2762 Lisp_Object frame, xoffset, yoffset;
2764 register struct frame *f;
2766 CHECK_LIVE_FRAME (frame);
2767 CHECK_NUMBER (xoffset);
2768 CHECK_NUMBER (yoffset);
2769 f = XFRAME (frame);
2771 /* I think this should be done with a hook. */
2772 #ifdef HAVE_WINDOW_SYSTEM
2773 if (FRAME_WINDOW_P (f))
2774 x_set_offset (f, XINT (xoffset), XINT (yoffset), 1);
2775 #endif
2777 return Qt;
2781 /***********************************************************************
2782 Frame Parameters
2783 ***********************************************************************/
2785 /* Connect the frame-parameter names for X frames
2786 to the ways of passing the parameter values to the window system.
2788 The name of a parameter, as a Lisp symbol,
2789 has an `x-frame-parameter' property which is an integer in Lisp
2790 that is an index in this table. */
2792 struct frame_parm_table {
2793 char *name;
2794 Lisp_Object *variable;
2797 static struct frame_parm_table frame_parms[] =
2799 {"auto-raise", &Qauto_raise},
2800 {"auto-lower", &Qauto_lower},
2801 {"background-color", 0},
2802 {"border-color", &Qborder_color},
2803 {"border-width", &Qborder_width},
2804 {"cursor-color", &Qcursor_color},
2805 {"cursor-type", &Qcursor_type},
2806 {"font", 0},
2807 {"foreground-color", 0},
2808 {"icon-name", &Qicon_name},
2809 {"icon-type", &Qicon_type},
2810 {"internal-border-width", &Qinternal_border_width},
2811 {"menu-bar-lines", &Qmenu_bar_lines},
2812 {"mouse-color", &Qmouse_color},
2813 {"name", &Qname},
2814 {"scroll-bar-width", &Qscroll_bar_width},
2815 {"title", &Qtitle},
2816 {"unsplittable", &Qunsplittable},
2817 {"vertical-scroll-bars", &Qvertical_scroll_bars},
2818 {"visibility", &Qvisibility},
2819 {"tool-bar-lines", &Qtool_bar_lines},
2820 {"scroll-bar-foreground", &Qscroll_bar_foreground},
2821 {"scroll-bar-background", &Qscroll_bar_background},
2822 {"screen-gamma", &Qscreen_gamma},
2823 {"line-spacing", &Qline_spacing},
2824 {"left-fringe", &Qleft_fringe},
2825 {"right-fringe", &Qright_fringe},
2826 {"wait-for-wm", &Qwait_for_wm},
2827 {"fullscreen", &Qfullscreen},
2828 {"font-backend", &Qfont_backend},
2829 {"alpha", &Qalpha}
2832 #ifdef HAVE_WINDOW_SYSTEM
2834 extern Lisp_Object Qbox;
2835 extern Lisp_Object Qtop;
2837 /* Calculate fullscreen size. Return in *TOP_POS and *LEFT_POS the
2838 wanted positions of the WM window (not Emacs window).
2839 Return in *WIDTH and *HEIGHT the wanted width and height of Emacs
2840 window (FRAME_X_WINDOW).
2843 void
2844 x_fullscreen_adjust (f, width, height, top_pos, left_pos)
2845 struct frame *f;
2846 int *width;
2847 int *height;
2848 int *top_pos;
2849 int *left_pos;
2851 int newwidth = FRAME_COLS (f);
2852 int newheight = FRAME_LINES (f);
2854 *top_pos = f->top_pos;
2855 *left_pos = f->left_pos;
2857 if (f->want_fullscreen & FULLSCREEN_HEIGHT)
2859 int ph;
2861 ph = FRAME_X_DISPLAY_INFO (f)->height;
2862 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2863 ph = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, newheight) - f->y_pixels_diff;
2864 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2865 *top_pos = 0;
2868 if (f->want_fullscreen & FULLSCREEN_WIDTH)
2870 int pw;
2872 pw = FRAME_X_DISPLAY_INFO (f)->width;
2873 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2874 pw = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, newwidth) - f->x_pixels_diff;
2875 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2876 *left_pos = 0;
2879 *width = newwidth;
2880 *height = newheight;
2884 /* Change the parameters of frame F as specified by ALIST.
2885 If a parameter is not specially recognized, do nothing special;
2886 otherwise call the `x_set_...' function for that parameter.
2887 Except for certain geometry properties, always call store_frame_param
2888 to store the new value in the parameter alist. */
2890 void
2891 x_set_frame_parameters (f, alist)
2892 FRAME_PTR f;
2893 Lisp_Object alist;
2895 Lisp_Object tail;
2897 /* If both of these parameters are present, it's more efficient to
2898 set them both at once. So we wait until we've looked at the
2899 entire list before we set them. */
2900 int width, height;
2902 /* Same here. */
2903 Lisp_Object left, top;
2905 /* Same with these. */
2906 Lisp_Object icon_left, icon_top;
2908 /* Record in these vectors all the parms specified. */
2909 Lisp_Object *parms;
2910 Lisp_Object *values;
2911 int i, p;
2912 int left_no_change = 0, top_no_change = 0;
2913 int icon_left_no_change = 0, icon_top_no_change = 0;
2914 int fullscreen_is_being_set = 0;
2916 struct gcpro gcpro1, gcpro2;
2918 i = 0;
2919 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
2920 i++;
2922 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
2923 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
2925 /* Extract parm names and values into those vectors. */
2927 i = 0;
2928 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2930 Lisp_Object elt;
2932 elt = XCAR (tail);
2933 parms[i] = Fcar (elt);
2934 values[i] = Fcdr (elt);
2935 i++;
2937 /* TAIL and ALIST are not used again below here. */
2938 alist = tail = Qnil;
2940 GCPRO2 (*parms, *values);
2941 gcpro1.nvars = i;
2942 gcpro2.nvars = i;
2944 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
2945 because their values appear in VALUES and strings are not valid. */
2946 top = left = Qunbound;
2947 icon_left = icon_top = Qunbound;
2949 /* Provide default values for HEIGHT and WIDTH. */
2950 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2951 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2953 /* Process foreground_color and background_color before anything else.
2954 They are independent of other properties, but other properties (e.g.,
2955 cursor_color) are dependent upon them. */
2956 /* Process default font as well, since fringe widths depends on it. */
2957 /* Also, process fullscreen, width and height depend upon that */
2958 for (p = 0; p < i; p++)
2960 Lisp_Object prop, val;
2962 prop = parms[p];
2963 val = values[p];
2964 if (EQ (prop, Qforeground_color)
2965 || EQ (prop, Qbackground_color)
2966 || EQ (prop, Qfont)
2967 || EQ (prop, Qfullscreen))
2969 register Lisp_Object param_index, old_value;
2970 int count = SPECPDL_INDEX ();
2972 old_value = get_frame_param (f, prop);
2973 fullscreen_is_being_set |= EQ (prop, Qfullscreen);
2975 if (NILP (Fequal (val, old_value)))
2977 /* For :font attributes, the frame_parm_handler
2978 x_set_font calls `face-set-after-frame-default'.
2979 Unless we bind inhibit-face-set-after-frame-default
2980 here, this would reset the :font attribute that we
2981 just applied to the default value for new faces. */
2982 specbind (Qinhibit_face_set_after_frame_default, Qt);
2984 store_frame_param (f, prop, val);
2986 param_index = Fget (prop, Qx_frame_parameter);
2987 if (NATNUMP (param_index)
2988 && (XFASTINT (param_index)
2989 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2990 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
2991 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2992 unbind_to (count, Qnil);
2997 /* Now process them in reverse of specified order. */
2998 for (i--; i >= 0; i--)
3000 Lisp_Object prop, val;
3002 prop = parms[i];
3003 val = values[i];
3005 if (EQ (prop, Qwidth) && NATNUMP (val))
3006 width = XFASTINT (val);
3007 else if (EQ (prop, Qheight) && NATNUMP (val))
3008 height = XFASTINT (val);
3009 else if (EQ (prop, Qtop))
3010 top = val;
3011 else if (EQ (prop, Qleft))
3012 left = val;
3013 else if (EQ (prop, Qicon_top))
3014 icon_top = val;
3015 else if (EQ (prop, Qicon_left))
3016 icon_left = val;
3017 else if (EQ (prop, Qforeground_color)
3018 || EQ (prop, Qbackground_color)
3019 || EQ (prop, Qfont)
3020 || EQ (prop, Qfullscreen))
3021 /* Processed above. */
3022 continue;
3023 else
3025 register Lisp_Object param_index, old_value;
3027 old_value = get_frame_param (f, prop);
3029 store_frame_param (f, prop, val);
3031 param_index = Fget (prop, Qx_frame_parameter);
3032 if (NATNUMP (param_index)
3033 && (XFASTINT (param_index)
3034 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3035 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
3036 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
3040 /* Don't die if just one of these was set. */
3041 if (EQ (left, Qunbound))
3043 left_no_change = 1;
3044 if (f->left_pos < 0)
3045 left = Fcons (Qplus, Fcons (make_number (f->left_pos), Qnil));
3046 else
3047 XSETINT (left, f->left_pos);
3049 if (EQ (top, Qunbound))
3051 top_no_change = 1;
3052 if (f->top_pos < 0)
3053 top = Fcons (Qplus, Fcons (make_number (f->top_pos), Qnil));
3054 else
3055 XSETINT (top, f->top_pos);
3058 /* If one of the icon positions was not set, preserve or default it. */
3059 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
3061 icon_left_no_change = 1;
3062 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
3063 if (NILP (icon_left))
3064 XSETINT (icon_left, 0);
3066 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
3068 icon_top_no_change = 1;
3069 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
3070 if (NILP (icon_top))
3071 XSETINT (icon_top, 0);
3074 if (FRAME_VISIBLE_P (f) && fullscreen_is_being_set)
3076 /* If the frame is visible already and the fullscreen parameter is
3077 being set, it is too late to set WM manager hints to specify
3078 size and position.
3079 Here we first get the width, height and position that applies to
3080 fullscreen. We then move the frame to the appropriate
3081 position. Resize of the frame is taken care of in the code after
3082 this if-statement. */
3083 int new_left, new_top;
3085 x_fullscreen_adjust (f, &width, &height, &new_top, &new_left);
3086 if (new_top != f->top_pos || new_left != f->left_pos)
3087 x_set_offset (f, new_left, new_top, 1);
3090 /* Don't set these parameters unless they've been explicitly
3091 specified. The window might be mapped or resized while we're in
3092 this function, and we don't want to override that unless the lisp
3093 code has asked for it.
3095 Don't set these parameters unless they actually differ from the
3096 window's current parameters; the window may not actually exist
3097 yet. */
3099 Lisp_Object frame;
3101 check_frame_size (f, &height, &width);
3103 XSETFRAME (frame, f);
3105 if (width != FRAME_COLS (f)
3106 || height != FRAME_LINES (f)
3107 || f->new_text_lines || f->new_text_cols)
3108 Fset_frame_size (frame, make_number (width), make_number (height));
3110 if ((!NILP (left) || !NILP (top))
3111 && ! (left_no_change && top_no_change)
3112 && ! (NUMBERP (left) && XINT (left) == f->left_pos
3113 && NUMBERP (top) && XINT (top) == f->top_pos))
3115 int leftpos = 0;
3116 int toppos = 0;
3118 /* Record the signs. */
3119 f->size_hint_flags &= ~ (XNegative | YNegative);
3120 if (EQ (left, Qminus))
3121 f->size_hint_flags |= XNegative;
3122 else if (INTEGERP (left))
3124 leftpos = XINT (left);
3125 if (leftpos < 0)
3126 f->size_hint_flags |= XNegative;
3128 else if (CONSP (left) && EQ (XCAR (left), Qminus)
3129 && CONSP (XCDR (left))
3130 && INTEGERP (XCAR (XCDR (left))))
3132 leftpos = - XINT (XCAR (XCDR (left)));
3133 f->size_hint_flags |= XNegative;
3135 else if (CONSP (left) && EQ (XCAR (left), Qplus)
3136 && CONSP (XCDR (left))
3137 && INTEGERP (XCAR (XCDR (left))))
3139 leftpos = XINT (XCAR (XCDR (left)));
3142 if (EQ (top, Qminus))
3143 f->size_hint_flags |= YNegative;
3144 else if (INTEGERP (top))
3146 toppos = XINT (top);
3147 if (toppos < 0)
3148 f->size_hint_flags |= YNegative;
3150 else if (CONSP (top) && EQ (XCAR (top), Qminus)
3151 && CONSP (XCDR (top))
3152 && INTEGERP (XCAR (XCDR (top))))
3154 toppos = - XINT (XCAR (XCDR (top)));
3155 f->size_hint_flags |= YNegative;
3157 else if (CONSP (top) && EQ (XCAR (top), Qplus)
3158 && CONSP (XCDR (top))
3159 && INTEGERP (XCAR (XCDR (top))))
3161 toppos = XINT (XCAR (XCDR (top)));
3165 /* Store the numeric value of the position. */
3166 f->top_pos = toppos;
3167 f->left_pos = leftpos;
3169 f->win_gravity = NorthWestGravity;
3171 /* Actually set that position, and convert to absolute. */
3172 x_set_offset (f, leftpos, toppos, -1);
3175 if ((!NILP (icon_left) || !NILP (icon_top))
3176 && ! (icon_left_no_change && icon_top_no_change))
3177 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
3180 UNGCPRO;
3184 /* Insert a description of internally-recorded parameters of frame X
3185 into the parameter alist *ALISTPTR that is to be given to the user.
3186 Only parameters that are specific to the X window system
3187 and whose values are not correctly recorded in the frame's
3188 param_alist need to be considered here. */
3190 void
3191 x_report_frame_params (f, alistptr)
3192 struct frame *f;
3193 Lisp_Object *alistptr;
3195 char buf[16];
3196 Lisp_Object tem;
3198 /* Represent negative positions (off the top or left screen edge)
3199 in a way that Fmodify_frame_parameters will understand correctly. */
3200 XSETINT (tem, f->left_pos);
3201 if (f->left_pos >= 0)
3202 store_in_alist (alistptr, Qleft, tem);
3203 else
3204 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
3206 XSETINT (tem, f->top_pos);
3207 if (f->top_pos >= 0)
3208 store_in_alist (alistptr, Qtop, tem);
3209 else
3210 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
3212 store_in_alist (alistptr, Qborder_width,
3213 make_number (f->border_width));
3214 store_in_alist (alistptr, Qinternal_border_width,
3215 make_number (FRAME_INTERNAL_BORDER_WIDTH (f)));
3216 store_in_alist (alistptr, Qleft_fringe,
3217 make_number (FRAME_LEFT_FRINGE_WIDTH (f)));
3218 store_in_alist (alistptr, Qright_fringe,
3219 make_number (FRAME_RIGHT_FRINGE_WIDTH (f)));
3220 store_in_alist (alistptr, Qscroll_bar_width,
3221 (! FRAME_HAS_VERTICAL_SCROLL_BARS (f)
3222 ? make_number (0)
3223 : FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0
3224 ? make_number (FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3225 /* nil means "use default width"
3226 for non-toolkit scroll bar.
3227 ruler-mode.el depends on this. */
3228 : Qnil));
3229 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
3230 store_in_alist (alistptr, Qwindow_id,
3231 build_string (buf));
3232 #ifdef HAVE_X_WINDOWS
3233 #ifdef USE_X_TOOLKIT
3234 /* Tooltip frame may not have this widget. */
3235 if (FRAME_X_OUTPUT (f)->widget)
3236 #endif
3237 sprintf (buf, "%ld", (long) FRAME_OUTER_WINDOW (f));
3238 store_in_alist (alistptr, Qouter_window_id,
3239 build_string (buf));
3240 #endif
3241 store_in_alist (alistptr, Qicon_name, f->icon_name);
3242 FRAME_SAMPLE_VISIBILITY (f);
3243 store_in_alist (alistptr, Qvisibility,
3244 (FRAME_VISIBLE_P (f) ? Qt
3245 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
3246 store_in_alist (alistptr, Qdisplay,
3247 XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
3249 if (FRAME_X_OUTPUT (f)->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
3250 tem = Qnil;
3251 else
3252 XSETFASTINT (tem, FRAME_X_OUTPUT (f)->parent_desc);
3253 store_in_alist (alistptr, Qexplicit_name, (f->explicit_name ? Qt : Qnil));
3254 store_in_alist (alistptr, Qparent_id, tem);
3258 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
3259 the previous value of that parameter, NEW_VALUE is the new value. */
3261 void
3262 x_set_fullscreen (f, new_value, old_value)
3263 struct frame *f;
3264 Lisp_Object new_value, old_value;
3266 if (NILP (new_value))
3267 f->want_fullscreen = FULLSCREEN_NONE;
3268 else if (EQ (new_value, Qfullboth))
3269 f->want_fullscreen = FULLSCREEN_BOTH;
3270 else if (EQ (new_value, Qfullwidth))
3271 f->want_fullscreen = FULLSCREEN_WIDTH;
3272 else if (EQ (new_value, Qfullheight))
3273 f->want_fullscreen = FULLSCREEN_HEIGHT;
3275 if (FRAME_TERMINAL (f)->fullscreen_hook != NULL)
3276 FRAME_TERMINAL (f)->fullscreen_hook (f);
3280 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
3281 the previous value of that parameter, NEW_VALUE is the new value. */
3283 void
3284 x_set_line_spacing (f, new_value, old_value)
3285 struct frame *f;
3286 Lisp_Object new_value, old_value;
3288 if (NILP (new_value))
3289 f->extra_line_spacing = 0;
3290 else if (NATNUMP (new_value))
3291 f->extra_line_spacing = XFASTINT (new_value);
3292 else
3293 signal_error ("Invalid line-spacing", new_value);
3294 if (FRAME_VISIBLE_P (f))
3295 redraw_frame (f);
3299 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
3300 the previous value of that parameter, NEW_VALUE is the new value. */
3302 void
3303 x_set_screen_gamma (f, new_value, old_value)
3304 struct frame *f;
3305 Lisp_Object new_value, old_value;
3307 Lisp_Object bgcolor;
3309 if (NILP (new_value))
3310 f->gamma = 0;
3311 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
3312 /* The value 0.4545 is the normal viewing gamma. */
3313 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
3314 else
3315 signal_error ("Invalid screen-gamma", new_value);
3317 /* Apply the new gamma value to the frame background. */
3318 bgcolor = Fassq (Qbackground_color, f->param_alist);
3319 if (CONSP (bgcolor) && (bgcolor = XCDR (bgcolor), STRINGP (bgcolor)))
3321 Lisp_Object index = Fget (Qbackground_color, Qx_frame_parameter);
3322 if (NATNUMP (index)
3323 && (XFASTINT (index)
3324 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3325 && FRAME_RIF (f)->frame_parm_handlers[XFASTINT (index)])
3326 (*FRAME_RIF (f)->frame_parm_handlers[XFASTINT (index)])
3327 (f, bgcolor, Qnil);
3330 Fclear_face_cache (Qnil);
3334 void
3335 x_set_font (f, arg, oldval)
3336 struct frame *f;
3337 Lisp_Object arg, oldval;
3339 Lisp_Object frame;
3340 int fontset = -1;
3341 Lisp_Object font_object;
3343 /* Set the frame parameter back to the old value because we mail
3344 fail to use ARG as the new parameter value. */
3345 store_frame_param (f, Qfont, oldval);
3347 /* ARG is a fontset name, a font name, or a font object.
3348 In the last case, this function never fail. */
3349 if (STRINGP (arg))
3351 fontset = fs_query_fontset (arg, 0);
3352 if (fontset < 0)
3354 font_object = font_open_by_name (f, SDATA (arg));
3355 if (NILP (font_object))
3356 error ("Font `%s' is not defined", SDATA (arg));
3357 arg = AREF (font_object, FONT_NAME_INDEX);
3359 else if (fontset > 0)
3361 Lisp_Object ascii_font = fontset_ascii (fontset);
3363 font_object = font_open_by_name (f, SDATA (ascii_font));
3364 if (NILP (font_object))
3365 error ("Font `%s' is not defined", SDATA (arg));
3366 arg = fontset_name (fontset);
3368 else
3369 error ("The default fontset can't be used for a frame font");
3371 else if (FONT_OBJECT_P (arg))
3373 font_object = arg;
3374 /* This is store the XLFD font name in the frame parameter for
3375 backward compatiblity. We should store the font-object
3376 itself in the future. */
3377 arg = AREF (font_object, FONT_NAME_INDEX);
3379 else
3380 signal_error ("Invalid font", arg);
3382 if (! NILP (Fequal (font_object, oldval)))
3383 return;
3384 x_new_font (f, font_object, fontset);
3385 store_frame_param (f, Qfont, arg);
3386 /* Recalculate toolbar height. */
3387 f->n_tool_bar_rows = 0;
3388 /* Ensure we redraw it. */
3389 clear_current_matrices (f);
3391 recompute_basic_faces (f);
3393 do_pending_window_change (0);
3395 /* Don't call `face-set-after-frame-default' when faces haven't been
3396 initialized yet. This is the case when called from
3397 Fx_create_frame. In that case, the X widget or window doesn't
3398 exist either, and we can end up in x_report_frame_params with a
3399 null widget which gives a segfault. */
3400 if (FRAME_FACE_CACHE (f))
3402 XSETFRAME (frame, f);
3403 /* We used to call face-set-after-frame-default here, but it leads to
3404 recursive calls (since that function can set the `default' face's
3405 font which in turns changes the frame's `font' parameter).
3406 Also I don't know what this call is meant to do, but it seems the
3407 wrong way to do it anyway (it does a lot more work than what seems
3408 reasonable in response to a change to `font'). */
3409 /* call1 (Qface_set_after_frame_default, frame); */
3414 void
3415 x_set_font_backend (f, new_value, old_value)
3416 struct frame *f;
3417 Lisp_Object new_value, old_value;
3419 if (! NILP (new_value)
3420 && !CONSP (new_value))
3422 char *p0, *p1;
3424 CHECK_STRING (new_value);
3425 p0 = p1 = SDATA (new_value);
3426 new_value = Qnil;
3427 while (*p0)
3429 while (*p1 && ! isspace (*p1) && *p1 != ',') p1++;
3430 if (p0 < p1)
3431 new_value = Fcons (Fintern (make_string (p0, p1 - p0), Qnil),
3432 new_value);
3433 if (*p1)
3435 int c;
3437 while ((c = *++p1) && isspace (c));
3439 p0 = p1;
3441 new_value = Fnreverse (new_value);
3444 if (! NILP (old_value) && ! NILP (Fequal (old_value, new_value)))
3445 return;
3447 if (FRAME_FONT (f))
3448 free_all_realized_faces (Qnil);
3450 new_value = font_update_drivers (f, NILP (new_value) ? Qt : new_value);
3451 if (NILP (new_value))
3453 if (NILP (old_value))
3454 error ("No font backend available");
3455 font_update_drivers (f, old_value);
3456 error ("None of specified font backends are available");
3458 store_frame_param (f, Qfont_backend, new_value);
3460 if (FRAME_FONT (f))
3462 Lisp_Object frame;
3464 XSETFRAME (frame, f);
3465 x_set_font (f, Fframe_parameter (frame, Qfont), Qnil);
3466 ++face_change_count;
3467 ++windows_or_buffers_changed;
3472 void
3473 x_set_fringe_width (f, new_value, old_value)
3474 struct frame *f;
3475 Lisp_Object new_value, old_value;
3477 compute_fringe_widths (f, 1);
3480 void
3481 x_set_border_width (f, arg, oldval)
3482 struct frame *f;
3483 Lisp_Object arg, oldval;
3485 CHECK_NUMBER (arg);
3487 if (XINT (arg) == f->border_width)
3488 return;
3490 if (FRAME_X_WINDOW (f) != 0)
3491 error ("Cannot change the border width of a frame");
3493 f->border_width = XINT (arg);
3496 void
3497 x_set_internal_border_width (f, arg, oldval)
3498 struct frame *f;
3499 Lisp_Object arg, oldval;
3501 int old = FRAME_INTERNAL_BORDER_WIDTH (f);
3503 CHECK_NUMBER (arg);
3504 FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
3505 if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
3506 FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
3508 #ifdef USE_X_TOOLKIT
3509 if (FRAME_X_OUTPUT (f)->edit_widget)
3510 widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
3511 #endif
3513 if (FRAME_INTERNAL_BORDER_WIDTH (f) == old)
3514 return;
3516 if (FRAME_X_WINDOW (f) != 0)
3518 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3519 SET_FRAME_GARBAGED (f);
3520 do_pending_window_change (0);
3522 else
3523 SET_FRAME_GARBAGED (f);
3526 void
3527 x_set_visibility (f, value, oldval)
3528 struct frame *f;
3529 Lisp_Object value, oldval;
3531 Lisp_Object frame;
3532 XSETFRAME (frame, f);
3534 if (NILP (value))
3535 Fmake_frame_invisible (frame, Qt);
3536 else if (EQ (value, Qicon))
3537 Ficonify_frame (frame);
3538 else
3539 Fmake_frame_visible (frame);
3542 void
3543 x_set_autoraise (f, arg, oldval)
3544 struct frame *f;
3545 Lisp_Object arg, oldval;
3547 f->auto_raise = !EQ (Qnil, arg);
3550 void
3551 x_set_autolower (f, arg, oldval)
3552 struct frame *f;
3553 Lisp_Object arg, oldval;
3555 f->auto_lower = !EQ (Qnil, arg);
3558 void
3559 x_set_unsplittable (f, arg, oldval)
3560 struct frame *f;
3561 Lisp_Object arg, oldval;
3563 f->no_split = !NILP (arg);
3566 void
3567 x_set_vertical_scroll_bars (f, arg, oldval)
3568 struct frame *f;
3569 Lisp_Object arg, oldval;
3571 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
3572 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
3573 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
3574 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
3576 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
3577 = (NILP (arg)
3578 ? vertical_scroll_bar_none
3579 : EQ (Qleft, arg)
3580 ? vertical_scroll_bar_left
3581 : EQ (Qright, arg)
3582 ? vertical_scroll_bar_right
3583 : EQ (Qleft, Vdefault_frame_scroll_bars)
3584 ? vertical_scroll_bar_left
3585 : EQ (Qright, Vdefault_frame_scroll_bars)
3586 ? vertical_scroll_bar_right
3587 : vertical_scroll_bar_none);
3589 /* We set this parameter before creating the X window for the
3590 frame, so we can get the geometry right from the start.
3591 However, if the window hasn't been created yet, we shouldn't
3592 call x_set_window_size. */
3593 if (FRAME_X_WINDOW (f))
3594 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3595 do_pending_window_change (0);
3599 void
3600 x_set_scroll_bar_width (f, arg, oldval)
3601 struct frame *f;
3602 Lisp_Object arg, oldval;
3604 int wid = FRAME_COLUMN_WIDTH (f);
3606 if (NILP (arg))
3608 x_set_scroll_bar_default_width (f);
3610 if (FRAME_X_WINDOW (f))
3611 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3612 do_pending_window_change (0);
3614 else if (INTEGERP (arg) && XINT (arg) > 0
3615 && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3617 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
3618 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
3620 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg);
3621 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
3622 if (FRAME_X_WINDOW (f))
3623 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3624 do_pending_window_change (0);
3627 change_frame_size (f, 0, FRAME_COLS (f), 0, 0, 0);
3628 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
3629 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
3634 /* Return non-nil if frame F wants a bitmap icon. */
3636 Lisp_Object
3637 x_icon_type (f)
3638 FRAME_PTR f;
3640 Lisp_Object tem;
3642 tem = assq_no_quit (Qicon_type, f->param_alist);
3643 if (CONSP (tem))
3644 return XCDR (tem);
3645 else
3646 return Qnil;
3649 void
3650 x_set_alpha (f, arg, oldval)
3651 struct frame *f;
3652 Lisp_Object arg, oldval;
3654 double alpha = 1.0;
3655 double newval[2];
3656 int i, ialpha;
3657 Lisp_Object item;
3659 for (i = 0; i < 2; i++)
3661 newval[i] = 1.0;
3662 if (CONSP (arg))
3664 item = CAR (arg);
3665 arg = CDR (arg);
3667 else
3668 item=arg;
3670 if (! NILP (item))
3672 if (FLOATP (item))
3674 alpha = XFLOAT_DATA (item);
3675 if (alpha < 0.0 || 1.0 < alpha)
3676 args_out_of_range (make_float (0.0), make_float (1.0));
3678 else if (INTEGERP (item))
3680 ialpha = XINT (item);
3681 if (ialpha < 0 || 100 < ialpha)
3682 args_out_of_range (make_number (0), make_number (100));
3683 else
3684 alpha = ialpha / 100.0;
3686 else
3687 wrong_type_argument (Qnumberp, item);
3689 newval[i] = alpha;
3692 for (i = 0; i < 2; i++)
3693 f->alpha[i] = newval[i];
3695 #ifdef HAVE_X_WINDOWS
3696 BLOCK_INPUT;
3697 x_set_frame_alpha (f);
3698 UNBLOCK_INPUT;
3699 #endif
3701 return;
3705 /* Subroutines of creating an X frame. */
3707 /* Make sure that Vx_resource_name is set to a reasonable value.
3708 Fix it up, or set it to `emacs' if it is too hopeless. */
3710 void
3711 validate_x_resource_name ()
3713 int len = 0;
3714 /* Number of valid characters in the resource name. */
3715 int good_count = 0;
3716 /* Number of invalid characters in the resource name. */
3717 int bad_count = 0;
3718 Lisp_Object new;
3719 int i;
3721 if (!STRINGP (Vx_resource_class))
3722 Vx_resource_class = build_string (EMACS_CLASS);
3724 if (STRINGP (Vx_resource_name))
3726 unsigned char *p = SDATA (Vx_resource_name);
3727 int i;
3729 len = SBYTES (Vx_resource_name);
3731 /* Only letters, digits, - and _ are valid in resource names.
3732 Count the valid characters and count the invalid ones. */
3733 for (i = 0; i < len; i++)
3735 int c = p[i];
3736 if (! ((c >= 'a' && c <= 'z')
3737 || (c >= 'A' && c <= 'Z')
3738 || (c >= '0' && c <= '9')
3739 || c == '-' || c == '_'))
3740 bad_count++;
3741 else
3742 good_count++;
3745 else
3746 /* Not a string => completely invalid. */
3747 bad_count = 5, good_count = 0;
3749 /* If name is valid already, return. */
3750 if (bad_count == 0)
3751 return;
3753 /* If name is entirely invalid, or nearly so, use `emacs'. */
3754 if (good_count == 0
3755 || (good_count == 1 && bad_count > 0))
3757 Vx_resource_name = build_string ("emacs");
3758 return;
3761 /* Name is partly valid. Copy it and replace the invalid characters
3762 with underscores. */
3764 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
3766 for (i = 0; i < len; i++)
3768 int c = SREF (new, i);
3769 if (! ((c >= 'a' && c <= 'z')
3770 || (c >= 'A' && c <= 'Z')
3771 || (c >= '0' && c <= '9')
3772 || c == '-' || c == '_'))
3773 SSET (new, i, '_');
3778 extern char *x_get_string_resource P_ ((XrmDatabase, char *, char *));
3779 extern Display_Info *check_x_display_info P_ ((Lisp_Object));
3782 /* Get specified attribute from resource database RDB.
3783 See Fx_get_resource below for other parameters. */
3785 static Lisp_Object
3786 xrdb_get_resource (rdb, attribute, class, component, subclass)
3787 XrmDatabase rdb;
3788 Lisp_Object attribute, class, component, subclass;
3790 register char *value;
3791 char *name_key;
3792 char *class_key;
3794 CHECK_STRING (attribute);
3795 CHECK_STRING (class);
3797 if (!NILP (component))
3798 CHECK_STRING (component);
3799 if (!NILP (subclass))
3800 CHECK_STRING (subclass);
3801 if (NILP (component) != NILP (subclass))
3802 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3804 validate_x_resource_name ();
3806 /* Allocate space for the components, the dots which separate them,
3807 and the final '\0'. Make them big enough for the worst case. */
3808 name_key = (char *) alloca (SBYTES (Vx_resource_name)
3809 + (STRINGP (component)
3810 ? SBYTES (component) : 0)
3811 + SBYTES (attribute)
3812 + 3);
3814 class_key = (char *) alloca (SBYTES (Vx_resource_class)
3815 + SBYTES (class)
3816 + (STRINGP (subclass)
3817 ? SBYTES (subclass) : 0)
3818 + 3);
3820 /* Start with emacs.FRAMENAME for the name (the specific one)
3821 and with `Emacs' for the class key (the general one). */
3822 strcpy (name_key, SDATA (Vx_resource_name));
3823 strcpy (class_key, SDATA (Vx_resource_class));
3825 strcat (class_key, ".");
3826 strcat (class_key, SDATA (class));
3828 if (!NILP (component))
3830 strcat (class_key, ".");
3831 strcat (class_key, SDATA (subclass));
3833 strcat (name_key, ".");
3834 strcat (name_key, SDATA (component));
3837 strcat (name_key, ".");
3838 strcat (name_key, SDATA (attribute));
3840 value = x_get_string_resource (rdb, name_key, class_key);
3842 if (value != (char *) 0)
3843 return build_string (value);
3844 else
3845 return Qnil;
3849 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
3850 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
3851 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
3852 class, where INSTANCE is the name under which Emacs was invoked, or
3853 the name specified by the `-name' or `-rn' command-line arguments.
3855 The optional arguments COMPONENT and SUBCLASS add to the key and the
3856 class, respectively. You must specify both of them or neither.
3857 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
3858 and the class is `Emacs.CLASS.SUBCLASS'. */)
3859 (attribute, class, component, subclass)
3860 Lisp_Object attribute, class, component, subclass;
3862 #ifdef HAVE_X_WINDOWS
3863 check_x ();
3864 #endif
3866 return xrdb_get_resource (check_x_display_info (Qnil)->xrdb,
3867 attribute, class, component, subclass);
3870 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
3872 Lisp_Object
3873 display_x_get_resource (dpyinfo, attribute, class, component, subclass)
3874 Display_Info *dpyinfo;
3875 Lisp_Object attribute, class, component, subclass;
3877 return xrdb_get_resource (dpyinfo->xrdb,
3878 attribute, class, component, subclass);
3881 /* Used when C code wants a resource value. */
3883 char *
3884 x_get_resource_string (attribute, class)
3885 char *attribute, *class;
3887 char *name_key;
3888 char *class_key;
3889 struct frame *sf = SELECTED_FRAME ();
3891 /* Allocate space for the components, the dots which separate them,
3892 and the final '\0'. */
3893 name_key = (char *) alloca (SBYTES (Vinvocation_name)
3894 + strlen (attribute) + 2);
3895 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
3896 + strlen (class) + 2);
3898 sprintf (name_key, "%s.%s", SDATA (Vinvocation_name), attribute);
3899 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3901 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
3902 name_key, class_key);
3906 /* Return the value of parameter PARAM.
3908 First search ALIST, then Vdefault_frame_alist, then the X defaults
3909 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3911 Convert the resource to the type specified by desired_type.
3913 If no default is specified, return Qunbound. If you call
3914 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3915 and don't let it get stored in any Lisp-visible variables! */
3917 Lisp_Object
3918 x_get_arg (dpyinfo, alist, param, attribute, class, type)
3919 Display_Info *dpyinfo;
3920 Lisp_Object alist, param;
3921 char *attribute;
3922 char *class;
3923 enum resource_types type;
3925 register Lisp_Object tem;
3927 tem = Fassq (param, alist);
3929 if (!NILP (tem))
3931 /* If we find this parm in ALIST, clear it out
3932 so that it won't be "left over" at the end. */
3933 #ifndef WINDOWSNT /* w32fns.c has not yet been changed to cope with this. */
3934 Lisp_Object tail;
3935 XSETCAR (tem, Qnil);
3936 /* In case the parameter appears more than once in the alist,
3937 clear it out. */
3938 for (tail = alist; CONSP (tail); tail = XCDR (tail))
3939 if (CONSP (XCAR (tail))
3940 && EQ (XCAR (XCAR (tail)), param))
3941 XSETCAR (XCAR (tail), Qnil);
3942 #endif
3944 else
3945 tem = Fassq (param, Vdefault_frame_alist);
3947 /* If it wasn't specified in ALIST or the Lisp-level defaults,
3948 look in the X resources. */
3949 if (EQ (tem, Qnil))
3951 if (attribute)
3953 tem = display_x_get_resource (dpyinfo,
3954 build_string (attribute),
3955 build_string (class),
3956 Qnil, Qnil);
3958 if (NILP (tem))
3959 return Qunbound;
3961 switch (type)
3963 case RES_TYPE_NUMBER:
3964 return make_number (atoi (SDATA (tem)));
3966 case RES_TYPE_FLOAT:
3967 return make_float (atof (SDATA (tem)));
3969 case RES_TYPE_BOOLEAN:
3970 tem = Fdowncase (tem);
3971 if (!strcmp (SDATA (tem), "on")
3972 || !strcmp (SDATA (tem), "true"))
3973 return Qt;
3974 else
3975 return Qnil;
3977 case RES_TYPE_STRING:
3978 return tem;
3980 case RES_TYPE_SYMBOL:
3981 /* As a special case, we map the values `true' and `on'
3982 to Qt, and `false' and `off' to Qnil. */
3984 Lisp_Object lower;
3985 lower = Fdowncase (tem);
3986 if (!strcmp (SDATA (lower), "on")
3987 || !strcmp (SDATA (lower), "true"))
3988 return Qt;
3989 else if (!strcmp (SDATA (lower), "off")
3990 || !strcmp (SDATA (lower), "false"))
3991 return Qnil;
3992 else
3993 return Fintern (tem, Qnil);
3996 default:
3997 abort ();
4000 else
4001 return Qunbound;
4003 return Fcdr (tem);
4006 Lisp_Object
4007 x_frame_get_arg (f, alist, param, attribute, class, type)
4008 struct frame *f;
4009 Lisp_Object alist, param;
4010 char *attribute;
4011 char *class;
4012 enum resource_types type;
4014 return x_get_arg (FRAME_X_DISPLAY_INFO (f),
4015 alist, param, attribute, class, type);
4018 /* Like x_frame_get_arg, but also record the value in f->param_alist. */
4020 Lisp_Object
4021 x_frame_get_and_record_arg (f, alist, param, attribute, class, type)
4022 struct frame *f;
4023 Lisp_Object alist, param;
4024 char *attribute;
4025 char *class;
4026 enum resource_types type;
4028 Lisp_Object value;
4030 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
4031 attribute, class, type);
4032 if (! NILP (value) && ! EQ (value, Qunbound))
4033 store_frame_param (f, param, value);
4035 return value;
4039 /* Record in frame F the specified or default value according to ALIST
4040 of the parameter named PROP (a Lisp symbol).
4041 If no value is specified for PROP, look for an X default for XPROP
4042 on the frame named NAME.
4043 If that is not found either, use the value DEFLT. */
4045 Lisp_Object
4046 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
4047 struct frame *f;
4048 Lisp_Object alist;
4049 Lisp_Object prop;
4050 Lisp_Object deflt;
4051 char *xprop;
4052 char *xclass;
4053 enum resource_types type;
4055 Lisp_Object tem;
4057 tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type);
4058 if (EQ (tem, Qunbound))
4059 tem = deflt;
4060 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
4061 return tem;
4067 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
4068 doc: /* Parse an X-style geometry string STRING.
4069 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
4070 The properties returned may include `top', `left', `height', and `width'.
4071 The value of `left' or `top' may be an integer,
4072 or a list (+ N) meaning N pixels relative to top/left corner,
4073 or a list (- N) meaning -N pixels relative to bottom/right corner. */)
4074 (string)
4075 Lisp_Object string;
4077 int geometry, x, y;
4078 unsigned int width, height;
4079 Lisp_Object result;
4081 CHECK_STRING (string);
4083 geometry = XParseGeometry ((char *) SDATA (string),
4084 &x, &y, &width, &height);
4086 #if 0
4087 if (!!(geometry & XValue) != !!(geometry & YValue))
4088 error ("Must specify both x and y position, or neither");
4089 #endif
4091 result = Qnil;
4092 if (geometry & XValue)
4094 Lisp_Object element;
4096 if (x >= 0 && (geometry & XNegative))
4097 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
4098 else if (x < 0 && ! (geometry & XNegative))
4099 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
4100 else
4101 element = Fcons (Qleft, make_number (x));
4102 result = Fcons (element, result);
4105 if (geometry & YValue)
4107 Lisp_Object element;
4109 if (y >= 0 && (geometry & YNegative))
4110 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
4111 else if (y < 0 && ! (geometry & YNegative))
4112 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
4113 else
4114 element = Fcons (Qtop, make_number (y));
4115 result = Fcons (element, result);
4118 if (geometry & WidthValue)
4119 result = Fcons (Fcons (Qwidth, make_number (width)), result);
4120 if (geometry & HeightValue)
4121 result = Fcons (Fcons (Qheight, make_number (height)), result);
4123 return result;
4126 /* Calculate the desired size and position of frame F.
4127 Return the flags saying which aspects were specified.
4129 Also set the win_gravity and size_hint_flags of F.
4131 Adjust height for toolbar if TOOLBAR_P is 1.
4133 This function does not make the coordinates positive. */
4135 #define DEFAULT_ROWS 40
4136 #define DEFAULT_COLS 80
4139 x_figure_window_size (f, parms, toolbar_p)
4140 struct frame *f;
4141 Lisp_Object parms;
4142 int toolbar_p;
4144 register Lisp_Object tem0, tem1, tem2;
4145 long window_prompting = 0;
4146 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
4148 /* Default values if we fall through.
4149 Actually, if that happens we should get
4150 window manager prompting. */
4151 SET_FRAME_COLS (f, DEFAULT_COLS);
4152 FRAME_LINES (f) = DEFAULT_ROWS;
4153 /* Window managers expect that if program-specified
4154 positions are not (0,0), they're intentional, not defaults. */
4155 f->top_pos = 0;
4156 f->left_pos = 0;
4158 /* Ensure that old new_text_cols and new_text_lines will not override the
4159 values set here. */
4160 /* ++KFS: This was specific to W32, but seems ok for all platforms */
4161 f->new_text_cols = f->new_text_lines = 0;
4163 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
4164 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
4165 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
4166 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4168 if (!EQ (tem0, Qunbound))
4170 CHECK_NUMBER (tem0);
4171 FRAME_LINES (f) = XINT (tem0);
4173 if (!EQ (tem1, Qunbound))
4175 CHECK_NUMBER (tem1);
4176 SET_FRAME_COLS (f, XINT (tem1));
4178 if (!NILP (tem2) && !EQ (tem2, Qunbound))
4179 window_prompting |= USSize;
4180 else
4181 window_prompting |= PSize;
4184 f->scroll_bar_actual_width
4185 = FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f);
4187 /* This used to be done _before_ calling x_figure_window_size, but
4188 since the height is reset here, this was really a no-op. I
4189 assume that moving it here does what Gerd intended (although he
4190 no longer can remember what that was... ++KFS, 2003-03-25. */
4192 /* Add the tool-bar height to the initial frame height so that the
4193 user gets a text display area of the size he specified with -g or
4194 via .Xdefaults. Later changes of the tool-bar height don't
4195 change the frame size. This is done so that users can create
4196 tall Emacs frames without having to guess how tall the tool-bar
4197 will get. */
4198 if (toolbar_p && FRAME_TOOL_BAR_LINES (f))
4200 int margin, relief, bar_height;
4202 relief = (tool_bar_button_relief >= 0
4203 ? tool_bar_button_relief
4204 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
4206 if (INTEGERP (Vtool_bar_button_margin)
4207 && XINT (Vtool_bar_button_margin) > 0)
4208 margin = XFASTINT (Vtool_bar_button_margin);
4209 else if (CONSP (Vtool_bar_button_margin)
4210 && INTEGERP (XCDR (Vtool_bar_button_margin))
4211 && XINT (XCDR (Vtool_bar_button_margin)) > 0)
4212 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
4213 else
4214 margin = 0;
4216 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
4217 FRAME_LINES (f) += (bar_height + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f);
4220 compute_fringe_widths (f, 0);
4222 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, FRAME_COLS (f));
4223 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, FRAME_LINES (f));
4225 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
4226 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
4227 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
4228 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4230 if (EQ (tem0, Qminus))
4232 f->top_pos = 0;
4233 window_prompting |= YNegative;
4235 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
4236 && CONSP (XCDR (tem0))
4237 && INTEGERP (XCAR (XCDR (tem0))))
4239 f->top_pos = - XINT (XCAR (XCDR (tem0)));
4240 window_prompting |= YNegative;
4242 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
4243 && CONSP (XCDR (tem0))
4244 && INTEGERP (XCAR (XCDR (tem0))))
4246 f->top_pos = XINT (XCAR (XCDR (tem0)));
4248 else if (EQ (tem0, Qunbound))
4249 f->top_pos = 0;
4250 else
4252 CHECK_NUMBER (tem0);
4253 f->top_pos = XINT (tem0);
4254 if (f->top_pos < 0)
4255 window_prompting |= YNegative;
4258 if (EQ (tem1, Qminus))
4260 f->left_pos = 0;
4261 window_prompting |= XNegative;
4263 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
4264 && CONSP (XCDR (tem1))
4265 && INTEGERP (XCAR (XCDR (tem1))))
4267 f->left_pos = - XINT (XCAR (XCDR (tem1)));
4268 window_prompting |= XNegative;
4270 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
4271 && CONSP (XCDR (tem1))
4272 && INTEGERP (XCAR (XCDR (tem1))))
4274 f->left_pos = XINT (XCAR (XCDR (tem1)));
4276 else if (EQ (tem1, Qunbound))
4277 f->left_pos = 0;
4278 else
4280 CHECK_NUMBER (tem1);
4281 f->left_pos = XINT (tem1);
4282 if (f->left_pos < 0)
4283 window_prompting |= XNegative;
4286 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
4287 window_prompting |= USPosition;
4288 else
4289 window_prompting |= PPosition;
4292 if (f->want_fullscreen != FULLSCREEN_NONE)
4294 int left, top;
4295 int width, height;
4297 /* It takes both for some WM:s to place it where we want */
4298 window_prompting |= USPosition | PPosition;
4299 x_fullscreen_adjust (f, &width, &height, &top, &left);
4300 FRAME_COLS (f) = width;
4301 FRAME_LINES (f) = height;
4302 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, width);
4303 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, height);
4304 f->left_pos = left;
4305 f->top_pos = top;
4308 if (window_prompting & XNegative)
4310 if (window_prompting & YNegative)
4311 f->win_gravity = SouthEastGravity;
4312 else
4313 f->win_gravity = NorthEastGravity;
4315 else
4317 if (window_prompting & YNegative)
4318 f->win_gravity = SouthWestGravity;
4319 else
4320 f->win_gravity = NorthWestGravity;
4323 f->size_hint_flags = window_prompting;
4325 return window_prompting;
4330 #endif /* HAVE_WINDOW_SYSTEM */
4334 /***********************************************************************
4335 Initialization
4336 ***********************************************************************/
4338 void
4339 syms_of_frame ()
4341 Qframep = intern ("framep");
4342 staticpro (&Qframep);
4343 Qframe_live_p = intern ("frame-live-p");
4344 staticpro (&Qframe_live_p);
4345 Qexplicit_name = intern ("explicit-name");
4346 staticpro (&Qexplicit_name);
4347 Qheight = intern ("height");
4348 staticpro (&Qheight);
4349 Qicon = intern ("icon");
4350 staticpro (&Qicon);
4351 Qminibuffer = intern ("minibuffer");
4352 staticpro (&Qminibuffer);
4353 Qmodeline = intern ("modeline");
4354 staticpro (&Qmodeline);
4355 Qonly = intern ("only");
4356 staticpro (&Qonly);
4357 Qwidth = intern ("width");
4358 staticpro (&Qwidth);
4359 Qgeometry = intern ("geometry");
4360 staticpro (&Qgeometry);
4361 Qicon_left = intern ("icon-left");
4362 staticpro (&Qicon_left);
4363 Qicon_top = intern ("icon-top");
4364 staticpro (&Qicon_top);
4365 Qleft = intern ("left");
4366 staticpro (&Qleft);
4367 Qright = intern ("right");
4368 staticpro (&Qright);
4369 Quser_position = intern ("user-position");
4370 staticpro (&Quser_position);
4371 Quser_size = intern ("user-size");
4372 staticpro (&Quser_size);
4373 Qwindow_id = intern ("window-id");
4374 staticpro (&Qwindow_id);
4375 #ifdef HAVE_X_WINDOWS
4376 Qouter_window_id = intern ("outer-window-id");
4377 staticpro (&Qouter_window_id);
4378 #endif
4379 Qparent_id = intern ("parent-id");
4380 staticpro (&Qparent_id);
4381 Qx = intern ("x");
4382 staticpro (&Qx);
4383 Qw32 = intern ("w32");
4384 staticpro (&Qw32);
4385 Qpc = intern ("pc");
4386 staticpro (&Qpc);
4387 Qmac = intern ("mac");
4388 staticpro (&Qmac);
4389 Qvisible = intern ("visible");
4390 staticpro (&Qvisible);
4391 Qbuffer_predicate = intern ("buffer-predicate");
4392 staticpro (&Qbuffer_predicate);
4393 Qbuffer_list = intern ("buffer-list");
4394 staticpro (&Qbuffer_list);
4395 Qburied_buffer_list = intern ("buried-buffer-list");
4396 staticpro (&Qburied_buffer_list);
4397 Qdisplay_type = intern ("display-type");
4398 staticpro (&Qdisplay_type);
4399 Qbackground_mode = intern ("background-mode");
4400 staticpro (&Qbackground_mode);
4401 Qnoelisp = intern ("noelisp");
4402 staticpro (&Qnoelisp);
4403 Qtty_color_mode = intern ("tty-color-mode");
4404 staticpro (&Qtty_color_mode);
4405 Qtty = intern ("tty");
4406 staticpro (&Qtty);
4407 Qtty_type = intern ("tty-type");
4408 staticpro (&Qtty_type);
4410 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
4411 staticpro (&Qface_set_after_frame_default);
4413 Qinhibit_face_set_after_frame_default
4414 = intern ("inhibit-face-set-after-frame-default");
4415 staticpro (&Qinhibit_face_set_after_frame_default);
4417 Qfullwidth = intern ("fullwidth");
4418 staticpro (&Qfullwidth);
4419 Qfullheight = intern ("fullheight");
4420 staticpro (&Qfullheight);
4421 Qfullboth = intern ("fullboth");
4422 staticpro (&Qfullboth);
4423 Qx_resource_name = intern ("x-resource-name");
4424 staticpro (&Qx_resource_name);
4426 Qx_frame_parameter = intern ("x-frame-parameter");
4427 staticpro (&Qx_frame_parameter);
4429 Qterminal = intern ("terminal");
4430 staticpro (&Qterminal);
4431 Qterminal_live_p = intern ("terminal-live-p");
4432 staticpro (&Qterminal_live_p);
4435 int i;
4437 for (i = 0; i < sizeof (frame_parms) / sizeof (frame_parms[0]); i++)
4439 Lisp_Object v = intern (frame_parms[i].name);
4440 if (frame_parms[i].variable)
4442 *frame_parms[i].variable = v;
4443 staticpro (frame_parms[i].variable);
4445 Fput (v, Qx_frame_parameter, make_number (i));
4449 #ifdef HAVE_WINDOW_SYSTEM
4450 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
4451 doc: /* The name Emacs uses to look up X resources.
4452 `x-get-resource' uses this as the first component of the instance name
4453 when requesting resource values.
4454 Emacs initially sets `x-resource-name' to the name under which Emacs
4455 was invoked, or to the value specified with the `-name' or `-rn'
4456 switches, if present.
4458 It may be useful to bind this variable locally around a call
4459 to `x-get-resource'. See also the variable `x-resource-class'. */);
4460 Vx_resource_name = Qnil;
4462 DEFVAR_LISP ("x-resource-class", &Vx_resource_class,
4463 doc: /* The class Emacs uses to look up X resources.
4464 `x-get-resource' uses this as the first component of the instance class
4465 when requesting resource values.
4467 Emacs initially sets `x-resource-class' to "Emacs".
4469 Setting this variable permanently is not a reasonable thing to do,
4470 but binding this variable locally around a call to `x-get-resource'
4471 is a reasonable practice. See also the variable `x-resource-name'. */);
4472 Vx_resource_class = build_string (EMACS_CLASS);
4474 DEFVAR_LISP ("frame-alpha-lower-limit", &Vframe_alpha_lower_limit,
4475 doc: /* The lower limit of the frame opacity (alpha transparency).
4476 The value should range from 0 (invisible) to 100 (completely opaque).
4477 You can also use a floating number between 0.0 and 1.0.
4478 The default is 20. */);
4479 Vframe_alpha_lower_limit = make_number (20);
4480 #endif
4482 DEFVAR_LISP ("default-frame-alist", &Vdefault_frame_alist,
4483 doc: /* Alist of default values for frame creation.
4484 These may be set in your init file, like this:
4485 (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1)))
4486 These override values given in window system configuration data,
4487 including X Windows' defaults database.
4488 For values specific to the first Emacs frame, see `initial-frame-alist'.
4489 For window-system specific values, see `window-system-default-frame-alist'.
4490 For values specific to the separate minibuffer frame, see
4491 `minibuffer-frame-alist'.
4492 The `menu-bar-lines' element of the list controls whether new frames
4493 have menu bars; `menu-bar-mode' works by altering this element.
4494 Setting this variable does not affect existing frames, only new ones. */);
4495 Vdefault_frame_alist = Qnil;
4497 DEFVAR_LISP ("default-frame-scroll-bars", &Vdefault_frame_scroll_bars,
4498 doc: /* Default position of scroll bars on this window-system. */);
4499 #ifdef HAVE_WINDOW_SYSTEM
4500 #if defined(HAVE_NTGUI) || defined(MAC_OS)
4501 /* MS-Windows has scroll bars on the right by default. */
4502 Vdefault_frame_scroll_bars = Qright;
4503 #else
4504 Vdefault_frame_scroll_bars = Qleft;
4505 #endif
4506 #else
4507 Vdefault_frame_scroll_bars = Qnil;
4508 #endif
4510 DEFVAR_LISP ("terminal-frame", &Vterminal_frame,
4511 doc: /* The initial frame-object, which represents Emacs's stdout. */);
4513 DEFVAR_LISP ("emacs-iconified", &Vemacs_iconified,
4514 doc: /* Non-nil if all of Emacs is iconified and frame updates are not needed. */);
4515 Vemacs_iconified = Qnil;
4517 DEFVAR_LISP ("mouse-position-function", &Vmouse_position_function,
4518 doc: /* If non-nil, function to transform normal value of `mouse-position'.
4519 `mouse-position' calls this function, passing its usual return value as
4520 argument, and returns whatever this function returns.
4521 This abnormal hook exists for the benefit of packages like `xt-mouse.el'
4522 which need to do mouse handling at the Lisp level. */);
4523 Vmouse_position_function = Qnil;
4525 DEFVAR_LISP ("mouse-highlight", &Vmouse_highlight,
4526 doc: /* If non-nil, clickable text is highlighted when mouse is over it.
4527 If the value is an integer, highlighting is only shown after moving the
4528 mouse, while keyboard input turns off the highlight even when the mouse
4529 is over the clickable text. However, the mouse shape still indicates
4530 when the mouse is over clickable text. */);
4531 Vmouse_highlight = Qt;
4533 DEFVAR_LISP ("delete-frame-functions", &Vdelete_frame_functions,
4534 doc: /* Functions to be run before deleting a frame.
4535 The functions are run with one arg, the frame to be deleted.
4536 See `delete-frame'.
4538 Note that functions in this list may be called just before the frame is
4539 actually deleted, or some time later (or even both when an earlier function
4540 in `delete-frame-functions' (indirectly) calls `delete-frame'
4541 recursively). */);
4542 Vdelete_frame_functions = Qnil;
4543 Qdelete_frame_functions = intern ("delete-frame-functions");
4544 staticpro (&Qdelete_frame_functions);
4546 DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
4547 doc: /* Minibufferless frames use this frame's minibuffer.
4549 Emacs cannot create minibufferless frames unless this is set to an
4550 appropriate surrogate.
4552 Emacs consults this variable only when creating minibufferless
4553 frames; once the frame is created, it sticks with its assigned
4554 minibuffer, no matter what this variable is set to. This means that
4555 this variable doesn't necessarily say anything meaningful about the
4556 current set of frames, or where the minibuffer is currently being
4557 displayed.
4559 This variable is local to the current terminal and cannot be buffer-local. */);
4561 DEFVAR_BOOL ("focus-follows-mouse", &focus_follows_mouse,
4562 doc: /* Non-nil if window system changes focus when you move the mouse.
4563 You should set this variable to tell Emacs how your window manager
4564 handles focus, since there is no way in general for Emacs to find out
4565 automatically. */);
4566 #ifdef HAVE_WINDOW_SYSTEM
4567 #if defined(HAVE_NTGUI) || defined(MAC_OS)
4568 focus_follows_mouse = 0;
4569 #else
4570 focus_follows_mouse = 1;
4571 #endif
4572 #else
4573 focus_follows_mouse = 0;
4574 #endif
4576 staticpro (&Vframe_list);
4578 defsubr (&Sactive_minibuffer_window);
4579 defsubr (&Sframep);
4580 defsubr (&Sframe_live_p);
4581 defsubr (&Swindow_system);
4582 defsubr (&Smake_terminal_frame);
4583 defsubr (&Shandle_switch_frame);
4584 defsubr (&Sselect_frame);
4585 defsubr (&Sselected_frame);
4586 defsubr (&Swindow_frame);
4587 defsubr (&Sframe_root_window);
4588 defsubr (&Sframe_first_window);
4589 defsubr (&Sframe_selected_window);
4590 defsubr (&Sset_frame_selected_window);
4591 defsubr (&Sframe_list);
4592 defsubr (&Snext_frame);
4593 defsubr (&Sprevious_frame);
4594 defsubr (&Sdelete_frame);
4595 defsubr (&Smouse_position);
4596 defsubr (&Smouse_pixel_position);
4597 defsubr (&Sset_mouse_position);
4598 defsubr (&Sset_mouse_pixel_position);
4599 #if 0
4600 defsubr (&Sframe_configuration);
4601 defsubr (&Srestore_frame_configuration);
4602 #endif
4603 defsubr (&Smake_frame_visible);
4604 defsubr (&Smake_frame_invisible);
4605 defsubr (&Siconify_frame);
4606 defsubr (&Sframe_visible_p);
4607 defsubr (&Svisible_frame_list);
4608 defsubr (&Sraise_frame);
4609 defsubr (&Slower_frame);
4610 defsubr (&Sredirect_frame_focus);
4611 defsubr (&Sframe_focus);
4612 defsubr (&Sframe_parameters);
4613 defsubr (&Sframe_parameter);
4614 defsubr (&Smodify_frame_parameters);
4615 defsubr (&Sframe_char_height);
4616 defsubr (&Sframe_char_width);
4617 defsubr (&Sframe_pixel_height);
4618 defsubr (&Sframe_pixel_width);
4619 defsubr (&Sset_frame_height);
4620 defsubr (&Sset_frame_width);
4621 defsubr (&Sset_frame_size);
4622 defsubr (&Sset_frame_position);
4624 #ifdef HAVE_WINDOW_SYSTEM
4625 defsubr (&Sx_get_resource);
4626 defsubr (&Sx_parse_geometry);
4627 #endif
4631 /* arch-tag: 7dbf2c69-9aad-45f8-8296-db893d6dd039
4632 (do not change this comment) */