Merge from emacs--rel--22
[emacs.git] / src / frame.c
blob188e1d18717f58d64d525f5cc552d7fb03ea5e13
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, or (at your option)
10 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; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
22 #include <config.h>
24 #include <stdio.h>
25 #include "lisp.h"
26 #include "character.h"
27 #ifdef HAVE_X_WINDOWS
28 #include "xterm.h"
29 #endif
30 #ifdef WINDOWSNT
31 #include "w32term.h"
32 #endif
33 #ifdef MAC_OS
34 #include "macterm.h"
35 #endif
36 #include "buffer.h"
37 /* These help us bind and responding to switch-frame events. */
38 #include "commands.h"
39 #include "keyboard.h"
40 #include "frame.h"
41 #ifdef HAVE_WINDOW_SYSTEM
42 #include "fontset.h"
43 #endif
44 #include "blockinput.h"
45 #include "termchar.h"
46 #include "termhooks.h"
47 #include "dispextern.h"
48 #include "window.h"
49 #ifdef MSDOS
50 #include "msdos.h"
51 #include "dosfns.h"
52 #endif
55 #ifdef HAVE_WINDOW_SYSTEM
57 #ifdef USE_FONT_BACKEND
58 #include "font.h"
59 #endif /* USE_FONT_BACKEND */
61 /* The name we're using in resource queries. Most often "emacs". */
63 Lisp_Object Vx_resource_name;
65 /* The application class we're using in resource queries.
66 Normally "Emacs". */
68 Lisp_Object Vx_resource_class;
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 #ifdef USE_FONT_BACKEND
121 Lisp_Object Qfont_backend;
122 #endif /* USE_FONT_BACKEND */
124 Lisp_Object Qinhibit_face_set_after_frame_default;
125 Lisp_Object Qface_set_after_frame_default;
127 Lisp_Object Vterminal_frame;
128 Lisp_Object Vdefault_frame_alist;
129 Lisp_Object Vdefault_frame_scroll_bars;
130 Lisp_Object Vmouse_position_function;
131 Lisp_Object Vmouse_highlight;
132 static Lisp_Object Vdelete_frame_functions, Qdelete_frame_functions;
134 int focus_follows_mouse;
136 static void
137 set_menu_bar_lines_1 (window, n)
138 Lisp_Object window;
139 int n;
141 struct window *w = XWINDOW (window);
143 XSETFASTINT (w->last_modified, 0);
144 XSETFASTINT (w->top_line, XFASTINT (w->top_line) + n);
145 XSETFASTINT (w->total_lines, XFASTINT (w->total_lines) - n);
147 if (INTEGERP (w->orig_top_line))
148 XSETFASTINT (w->orig_top_line, XFASTINT (w->orig_top_line) + n);
149 if (INTEGERP (w->orig_total_lines))
150 XSETFASTINT (w->orig_total_lines, XFASTINT (w->orig_total_lines) - n);
152 /* Handle just the top child in a vertical split. */
153 if (!NILP (w->vchild))
154 set_menu_bar_lines_1 (w->vchild, n);
156 /* Adjust all children in a horizontal split. */
157 for (window = w->hchild; !NILP (window); window = w->next)
159 w = XWINDOW (window);
160 set_menu_bar_lines_1 (window, n);
164 void
165 set_menu_bar_lines (f, value, oldval)
166 struct frame *f;
167 Lisp_Object value, oldval;
169 int nlines;
170 int olines = FRAME_MENU_BAR_LINES (f);
172 /* Right now, menu bars don't work properly in minibuf-only frames;
173 most of the commands try to apply themselves to the minibuffer
174 frame itself, and get an error because you can't switch buffers
175 in or split the minibuffer window. */
176 if (FRAME_MINIBUF_ONLY_P (f))
177 return;
179 if (INTEGERP (value))
180 nlines = XINT (value);
181 else
182 nlines = 0;
184 if (nlines != olines)
186 windows_or_buffers_changed++;
187 FRAME_WINDOW_SIZES_CHANGED (f) = 1;
188 FRAME_MENU_BAR_LINES (f) = nlines;
189 set_menu_bar_lines_1 (f->root_window, nlines - olines);
190 adjust_glyphs (f);
194 Lisp_Object Vemacs_iconified;
195 Lisp_Object Vframe_list;
197 extern Lisp_Object Vminibuffer_list;
198 extern Lisp_Object get_minibuffer ();
199 extern Lisp_Object Fhandle_switch_frame ();
200 extern Lisp_Object Fredirect_frame_focus ();
201 extern Lisp_Object x_get_focus_frame ();
203 DEFUN ("framep", Fframep, Sframep, 1, 1, 0,
204 doc: /* Return non-nil if OBJECT is a frame.
205 Value is t for a termcap frame (a character-only terminal),
206 `x' for an Emacs frame that is really an X window,
207 `w32' for an Emacs frame that is a window on MS-Windows display,
208 `mac' for an Emacs frame on a Macintosh display,
209 `pc' for a direct-write MS-DOS frame.
210 See also `frame-live-p'. */)
211 (object)
212 Lisp_Object object;
214 if (!FRAMEP (object))
215 return Qnil;
216 switch (XFRAME (object)->output_method)
218 case output_initial: /* The initial frame is like a termcap frame. */
219 case output_termcap:
220 return Qt;
221 case output_x_window:
222 return Qx;
223 case output_w32:
224 return Qw32;
225 case output_msdos_raw:
226 return Qpc;
227 case output_mac:
228 return Qmac;
229 default:
230 abort ();
234 DEFUN ("frame-live-p", Fframe_live_p, Sframe_live_p, 1, 1, 0,
235 doc: /* Return non-nil if OBJECT is a frame which has not been deleted.
236 Value is nil if OBJECT is not a live frame. If object is a live
237 frame, the return value indicates what sort of terminal device it is
238 displayed on. See the documentation of `framep' for possible
239 return values. */)
240 (object)
241 Lisp_Object object;
243 return ((FRAMEP (object)
244 && FRAME_LIVE_P (XFRAME (object)))
245 ? Fframep (object)
246 : Qnil);
249 DEFUN ("window-system", Fwindow_system, Swindow_system, 0, 1, 0,
250 doc: /* The name of the window system that FRAME is displaying through.
251 The value is a symbol---for instance, 'x' for X windows.
252 The value is nil if Emacs is using a text-only terminal.
254 FRAME defaults to the currently selected frame. */)
255 (frame)
256 Lisp_Object frame;
258 Lisp_Object type;
259 if (NILP (frame))
260 frame = selected_frame;
262 type = Fframep (frame);
264 if (NILP (type))
265 wrong_type_argument (Qframep, frame);
267 if (EQ (type, Qt))
268 return Qnil;
269 else
270 return type;
273 struct frame *
274 make_frame (mini_p)
275 int mini_p;
277 Lisp_Object frame;
278 register struct frame *f;
279 register Lisp_Object root_window;
280 register Lisp_Object mini_window;
282 f = allocate_frame ();
283 XSETFRAME (frame, f);
285 f->desired_matrix = 0;
286 f->current_matrix = 0;
287 f->desired_pool = 0;
288 f->current_pool = 0;
289 f->glyphs_initialized_p = 0;
290 f->decode_mode_spec_buffer = 0;
291 f->visible = 0;
292 f->async_visible = 0;
293 f->output_data.nothing = 0;
294 f->iconified = 0;
295 f->async_iconified = 0;
296 f->wants_modeline = 1;
297 f->auto_raise = 0;
298 f->auto_lower = 0;
299 f->no_split = 0;
300 f->garbaged = 1;
301 f->has_minibuffer = mini_p;
302 f->focus_frame = Qnil;
303 f->explicit_name = 0;
304 f->can_have_scroll_bars = 0;
305 f->vertical_scroll_bar_type = vertical_scroll_bar_none;
306 f->param_alist = Qnil;
307 f->scroll_bars = Qnil;
308 f->condemned_scroll_bars = Qnil;
309 f->face_alist = Qnil;
310 f->face_cache = NULL;
311 f->menu_bar_items = Qnil;
312 f->menu_bar_vector = Qnil;
313 f->menu_bar_items_used = 0;
314 f->buffer_predicate = Qnil;
315 f->buffer_list = Qnil;
316 f->buried_buffer_list = Qnil;
317 f->namebuf = 0;
318 f->title = Qnil;
319 f->menu_bar_window = Qnil;
320 f->tool_bar_window = Qnil;
321 f->tool_bar_items = Qnil;
322 f->desired_tool_bar_string = f->current_tool_bar_string = Qnil;
323 f->n_tool_bar_items = 0;
324 f->left_fringe_width = f->right_fringe_width = 0;
325 f->fringe_cols = 0;
326 f->scroll_bar_actual_width = 0;
327 f->border_width = 0;
328 f->internal_border_width = 0;
329 f->column_width = 1; /* !FRAME_WINDOW_P value */
330 f->line_height = 1; /* !FRAME_WINDOW_P value */
331 f->x_pixels_diff = f->y_pixels_diff = 0;
332 #ifdef HAVE_WINDOW_SYSTEM
333 f->want_fullscreen = FULLSCREEN_NONE;
334 #endif
335 f->size_hint_flags = 0;
336 f->win_gravity = 0;
337 #ifdef USE_FONT_BACKEND
338 f->font_driver_list = NULL;
339 f->font_data_list = NULL;
340 #endif /* USE_FONT_BACKEND */
342 root_window = make_window ();
343 if (mini_p)
345 mini_window = make_window ();
346 XWINDOW (root_window)->next = mini_window;
347 XWINDOW (mini_window)->prev = root_window;
348 XWINDOW (mini_window)->mini_p = Qt;
349 XWINDOW (mini_window)->frame = frame;
350 f->minibuffer_window = mini_window;
352 else
354 mini_window = Qnil;
355 XWINDOW (root_window)->next = Qnil;
356 f->minibuffer_window = Qnil;
359 XWINDOW (root_window)->frame = frame;
361 /* 10 is arbitrary,
362 just so that there is "something there."
363 Correct size will be set up later with change_frame_size. */
365 SET_FRAME_COLS (f, 10);
366 FRAME_LINES (f) = 10;
368 XSETFASTINT (XWINDOW (root_window)->total_cols, 10);
369 XSETFASTINT (XWINDOW (root_window)->total_lines, (mini_p ? 9 : 10));
371 if (mini_p)
373 XSETFASTINT (XWINDOW (mini_window)->total_cols, 10);
374 XSETFASTINT (XWINDOW (mini_window)->top_line, 9);
375 XSETFASTINT (XWINDOW (mini_window)->total_lines, 1);
378 /* Choose a buffer for the frame's root window. */
380 Lisp_Object buf;
382 XWINDOW (root_window)->buffer = Qt;
383 buf = Fcurrent_buffer ();
384 /* If buf is a 'hidden' buffer (i.e. one whose name starts with
385 a space), try to find another one. */
386 if (SREF (Fbuffer_name (buf), 0) == ' ')
387 buf = Fother_buffer (buf, Qnil, Qnil);
389 /* Use set_window_buffer, not Fset_window_buffer, and don't let
390 hooks be run by it. The reason is that the whole frame/window
391 arrangement is not yet fully intialized at this point. Windows
392 don't have the right size, glyph matrices aren't initialized
393 etc. Running Lisp functions at this point surely ends in a
394 SEGV. */
395 set_window_buffer (root_window, buf, 0, 0);
396 f->buffer_list = Fcons (buf, Qnil);
399 if (mini_p)
401 XWINDOW (mini_window)->buffer = Qt;
402 set_window_buffer (mini_window,
403 (NILP (Vminibuffer_list)
404 ? get_minibuffer (0)
405 : Fcar (Vminibuffer_list)),
406 0, 0);
409 f->root_window = root_window;
410 f->selected_window = root_window;
411 /* Make sure this window seems more recently used than
412 a newly-created, never-selected window. */
413 ++window_select_count;
414 XSETFASTINT (XWINDOW (f->selected_window)->use_time, window_select_count);
416 f->default_face_done_p = 0;
418 return f;
421 #ifdef HAVE_WINDOW_SYSTEM
422 /* Make a frame using a separate minibuffer window on another frame.
423 MINI_WINDOW is the minibuffer window to use. nil means use the
424 default (the global minibuffer). */
426 struct frame *
427 make_frame_without_minibuffer (mini_window, kb, display)
428 register Lisp_Object mini_window;
429 KBOARD *kb;
430 Lisp_Object display;
432 register struct frame *f;
433 struct gcpro gcpro1;
435 if (!NILP (mini_window))
436 CHECK_LIVE_WINDOW (mini_window);
438 #ifdef MULTI_KBOARD
439 if (!NILP (mini_window)
440 && FRAME_KBOARD (XFRAME (XWINDOW (mini_window)->frame)) != kb)
441 error ("Frame and minibuffer must be on the same terminal");
442 #endif
444 /* Make a frame containing just a root window. */
445 f = make_frame (0);
447 if (NILP (mini_window))
449 /* Use default-minibuffer-frame if possible. */
450 if (!FRAMEP (kb->Vdefault_minibuffer_frame)
451 || ! FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame)))
453 Lisp_Object frame_dummy;
455 XSETFRAME (frame_dummy, f);
456 GCPRO1 (frame_dummy);
457 /* If there's no minibuffer frame to use, create one. */
458 kb->Vdefault_minibuffer_frame =
459 call1 (intern ("make-initial-minibuffer-frame"), display);
460 UNGCPRO;
463 mini_window = XFRAME (kb->Vdefault_minibuffer_frame)->minibuffer_window;
466 f->minibuffer_window = mini_window;
468 /* Make the chosen minibuffer window display the proper minibuffer,
469 unless it is already showing a minibuffer. */
470 if (NILP (Fmemq (XWINDOW (mini_window)->buffer, Vminibuffer_list)))
471 Fset_window_buffer (mini_window,
472 (NILP (Vminibuffer_list)
473 ? get_minibuffer (0)
474 : Fcar (Vminibuffer_list)), Qnil);
475 return f;
478 /* Make a frame containing only a minibuffer window. */
480 struct frame *
481 make_minibuffer_frame ()
483 /* First make a frame containing just a root window, no minibuffer. */
485 register struct frame *f = make_frame (0);
486 register Lisp_Object mini_window;
487 register Lisp_Object frame;
489 XSETFRAME (frame, f);
491 f->auto_raise = 0;
492 f->auto_lower = 0;
493 f->no_split = 1;
494 f->wants_modeline = 0;
495 f->has_minibuffer = 1;
497 /* Now label the root window as also being the minibuffer.
498 Avoid infinite looping on the window chain by marking next pointer
499 as nil. */
501 mini_window = f->minibuffer_window = f->root_window;
502 XWINDOW (mini_window)->mini_p = Qt;
503 XWINDOW (mini_window)->next = Qnil;
504 XWINDOW (mini_window)->prev = Qnil;
505 XWINDOW (mini_window)->frame = frame;
507 /* Put the proper buffer in that window. */
509 Fset_window_buffer (mini_window,
510 (NILP (Vminibuffer_list)
511 ? get_minibuffer (0)
512 : Fcar (Vminibuffer_list)), Qnil);
513 return f;
515 #endif /* HAVE_WINDOW_SYSTEM */
517 /* Construct a frame that refers to a terminal. */
519 static int tty_frame_count;
521 struct frame *
522 make_initial_frame (void)
524 struct frame *f;
525 struct terminal *terminal;
526 Lisp_Object frame;
528 eassert (initial_kboard);
530 /* The first call must initialize Vframe_list. */
531 if (! (NILP (Vframe_list) || CONSP (Vframe_list)))
532 Vframe_list = Qnil;
534 terminal = init_initial_terminal ();
536 f = make_frame (1);
537 XSETFRAME (frame, f);
539 Vframe_list = Fcons (frame, Vframe_list);
541 tty_frame_count = 1;
542 f->name = build_string ("F1");
544 f->visible = 1;
545 f->async_visible = 1;
547 f->output_method = terminal->type;
548 f->terminal = terminal;
549 f->terminal->reference_count++;
550 f->output_data.nothing = 0;
552 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
553 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
555 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
556 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
558 return f;
562 struct frame *
563 make_terminal_frame (struct terminal *terminal)
565 register struct frame *f;
566 Lisp_Object frame;
567 char name[20];
569 if (!terminal->name)
570 error ("Terminal is not live, can't create new frames on it");
572 f = make_frame (1);
574 XSETFRAME (frame, f);
575 Vframe_list = Fcons (frame, Vframe_list);
577 tty_frame_count++;
578 sprintf (name, "F%d", tty_frame_count);
579 f->name = build_string (name);
581 f->visible = 1; /* FRAME_SET_VISIBLE wd set frame_garbaged. */
582 f->async_visible = 1; /* Don't let visible be cleared later. */
583 #ifdef MSDOS
584 f->output_data.x = &the_only_x_display;
585 if (!inhibit_window_system
586 && (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame))
587 || XFRAME (selected_frame)->output_method == output_msdos_raw))
589 f->output_method = output_msdos_raw;
590 /* This initialization of foreground and background pixels is
591 only important for the initial frame created in temacs. If
592 we don't do that, we get black background and foreground in
593 the dumped Emacs because the_only_x_display is a static
594 variable, hence it is born all-zeroes, and zero is the code
595 for the black color. Other frames all inherit their pixels
596 from what's already in the_only_x_display. */
597 if ((!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
598 && FRAME_BACKGROUND_PIXEL (f) == 0
599 && FRAME_FOREGROUND_PIXEL (f) == 0)
601 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
602 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
605 else
606 f->output_method = output_termcap;
607 #else
609 f->output_method = output_termcap;
610 f->terminal = terminal;
611 f->terminal->reference_count++;
612 create_tty_output (f);
614 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
615 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
617 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
618 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
620 /* Set the top frame to the newly created frame. */
621 if (FRAMEP (FRAME_TTY (f)->top_frame)
622 && FRAME_LIVE_P (XFRAME (FRAME_TTY (f)->top_frame)))
623 XFRAME (FRAME_TTY (f)->top_frame)->async_visible = 2; /* obscured */
625 FRAME_TTY (f)->top_frame = frame;
628 #ifdef CANNOT_DUMP
629 FRAME_FOREGROUND_PIXEL(f) = FACE_TTY_DEFAULT_FG_COLOR;
630 FRAME_BACKGROUND_PIXEL(f) = FACE_TTY_DEFAULT_BG_COLOR;
631 #endif
632 #endif /* MSDOS */
634 if (!noninteractive)
635 init_frame_faces (f);
637 return f;
640 /* Get a suitable value for frame parameter PARAMETER for a newly
641 created frame, based on (1) the user-supplied frame parameter
642 alist SUPPLIED_PARMS, (2) CURRENT_VALUE, and finally, if all else
643 fails, (3) Vdefault_frame_alist. */
645 static Lisp_Object
646 get_future_frame_param (Lisp_Object parameter,
647 Lisp_Object supplied_parms,
648 char *current_value)
650 Lisp_Object result;
652 result = Fassq (parameter, supplied_parms);
653 if (NILP (result))
654 result = Fassq (parameter, XFRAME (selected_frame)->param_alist);
655 if (NILP (result) && current_value != NULL)
656 result = build_string (current_value);
657 if (NILP (result))
658 result = Fassq (parameter, Vdefault_frame_alist);
659 if (!NILP (result) && !STRINGP (result))
660 result = XCDR (result);
661 if (NILP (result) || !STRINGP (result))
662 result = Qnil;
664 return result;
667 DEFUN ("make-terminal-frame", Fmake_terminal_frame, Smake_terminal_frame,
668 1, 1, 0,
669 doc: /* Create an additional terminal frame, possibly on another terminal.
670 This function takes one argument, an alist specifying frame parameters.
672 You can create multiple frames on a single text-only terminal, but
673 only one of them (the selected terminal frame) is actually displayed.
675 In practice, generally you don't need to specify any parameters,
676 except when you want to create a new frame on another terminal.
677 In that case, the `tty' parameter specifies the device file to open,
678 and the `tty-type' parameter specifies the terminal type. Example:
680 (make-terminal-frame '((tty . "/dev/pts/5") (tty-type . "xterm")))
682 Note that changing the size of one terminal frame automatically
683 affects all frames on the same terminal device. */)
684 (parms)
685 Lisp_Object parms;
687 struct frame *f;
688 struct terminal *t = NULL;
689 Lisp_Object frame, tem;
690 struct frame *sf = SELECTED_FRAME ();
692 #ifdef MSDOS
693 if (sf->output_method != output_msdos_raw
694 && sf->output_method != output_termcap)
695 abort ();
696 #else /* not MSDOS */
698 #if 0
699 /* This can happen for multi-tty when using both terminal frames and
700 Carbon frames. */
701 if (sf->output_method != output_mac)
702 error ("Not running on a Macintosh screen; cannot make a new Macintosh frame");
703 #else
704 #if 0 /* This should work now! */
705 if (sf->output_method != output_termcap)
706 error ("Not using an ASCII terminal now; cannot make a new ASCII frame");
707 #endif
708 #endif
709 #endif /* not MSDOS */
712 Lisp_Object terminal;
714 terminal = Fassq (Qterminal, parms);
715 if (!NILP (terminal))
717 terminal = XCDR (terminal);
718 t = get_terminal (terminal, 1);
722 if (!t)
724 char *name = 0, *type = 0;
725 Lisp_Object tty, tty_type;
727 tty = get_future_frame_param
728 (Qtty, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
729 ? FRAME_TTY (XFRAME (selected_frame))->name
730 : NULL));
731 if (!NILP (tty))
733 name = (char *) alloca (SBYTES (tty) + 1);
734 strncpy (name, SDATA (tty), SBYTES (tty));
735 name[SBYTES (tty)] = 0;
738 tty_type = get_future_frame_param
739 (Qtty_type, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
740 ? FRAME_TTY (XFRAME (selected_frame))->type
741 : NULL));
742 if (!NILP (tty_type))
744 type = (char *) alloca (SBYTES (tty_type) + 1);
745 strncpy (type, SDATA (tty_type), SBYTES (tty_type));
746 type[SBYTES (tty_type)] = 0;
749 t = init_tty (name, type, 0); /* Errors are not fatal. */
752 f = make_terminal_frame (t);
755 int width, height;
756 get_tty_size (fileno (FRAME_TTY (f)->input), &width, &height);
757 change_frame_size (f, height, width, 0, 0, 0);
760 adjust_glyphs (f);
761 calculate_costs (f);
762 XSETFRAME (frame, f);
763 Fmodify_frame_parameters (frame, Vdefault_frame_alist);
764 Fmodify_frame_parameters (frame, parms);
765 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty_type,
766 build_string (t->display_info.tty->type)),
767 Qnil));
768 if (t->display_info.tty->name != NULL)
769 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty,
770 build_string (t->display_info.tty->name)),
771 Qnil));
772 else
773 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty, Qnil), Qnil));
775 /* Make the frame face alist be frame-specific, so that each
776 frame could change its face definitions independently. */
777 f->face_alist = Fcopy_alist (sf->face_alist);
778 /* Simple Fcopy_alist isn't enough, because we need the contents of
779 the vectors which are the CDRs of associations in face_alist to
780 be copied as well. */
781 for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem))
782 XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem))));
783 return frame;
787 /* Perform the switch to frame FRAME.
789 If FRAME is a switch-frame event `(switch-frame FRAME1)', use
790 FRAME1 as frame.
792 If TRACK is non-zero and the frame that currently has the focus
793 redirects its focus to the selected frame, redirect that focused
794 frame's focus to FRAME instead.
796 FOR_DELETION non-zero means that the selected frame is being
797 deleted, which includes the possibility that the frame's terminal
798 is dead. */
800 Lisp_Object
801 do_switch_frame (frame, track, for_deletion)
802 Lisp_Object frame;
803 int track, for_deletion;
805 struct frame *sf = SELECTED_FRAME ();
807 /* If FRAME is a switch-frame event, extract the frame we should
808 switch to. */
809 if (CONSP (frame)
810 && EQ (XCAR (frame), Qswitch_frame)
811 && CONSP (XCDR (frame)))
812 frame = XCAR (XCDR (frame));
814 /* This used to say CHECK_LIVE_FRAME, but apparently it's possible for
815 a switch-frame event to arrive after a frame is no longer live,
816 especially when deleting the initial frame during startup. */
817 CHECK_FRAME (frame);
818 if (! FRAME_LIVE_P (XFRAME (frame)))
819 return Qnil;
821 if (sf == XFRAME (frame))
822 return frame;
824 /* This is too greedy; it causes inappropriate focus redirection
825 that's hard to get rid of. */
826 #if 0
827 /* If a frame's focus has been redirected toward the currently
828 selected frame, we should change the redirection to point to the
829 newly selected frame. This means that if the focus is redirected
830 from a minibufferless frame to a surrogate minibuffer frame, we
831 can use `other-window' to switch between all the frames using
832 that minibuffer frame, and the focus redirection will follow us
833 around. */
834 if (track)
836 Lisp_Object tail;
838 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
840 Lisp_Object focus;
842 if (!FRAMEP (XCAR (tail)))
843 abort ();
845 focus = FRAME_FOCUS_FRAME (XFRAME (XCAR (tail)));
847 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
848 Fredirect_frame_focus (XCAR (tail), frame);
851 #else /* ! 0 */
852 /* Instead, apply it only to the frame we're pointing to. */
853 #ifdef HAVE_WINDOW_SYSTEM
854 if (track && FRAME_WINDOW_P (XFRAME (frame)))
856 Lisp_Object focus, xfocus;
858 xfocus = x_get_focus_frame (XFRAME (frame));
859 if (FRAMEP (xfocus))
861 focus = FRAME_FOCUS_FRAME (XFRAME (xfocus));
862 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
863 Fredirect_frame_focus (xfocus, frame);
866 #endif /* HAVE_X_WINDOWS */
867 #endif /* ! 0 */
869 if (!for_deletion && FRAME_HAS_MINIBUF_P (sf))
870 resize_mini_window (XWINDOW (FRAME_MINIBUF_WINDOW (sf)), 1);
872 if (FRAME_TERMCAP_P (XFRAME (frame)))
874 if (FRAMEP (FRAME_TTY (XFRAME (frame))->top_frame))
875 /* Mark previously displayed frame as now obscured. */
876 XFRAME (FRAME_TTY (XFRAME (frame))->top_frame)->async_visible = 2;
877 XFRAME (frame)->async_visible = 1;
878 FRAME_TTY (XFRAME (frame))->top_frame = frame;
881 selected_frame = frame;
882 if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
883 last_nonminibuf_frame = XFRAME (selected_frame);
885 Fselect_window (XFRAME (frame)->selected_window, Qnil);
887 /* We want to make sure that the next event generates a frame-switch
888 event to the appropriate frame. This seems kludgy to me, but
889 before you take it out, make sure that evaluating something like
890 (select-window (frame-root-window (new-frame))) doesn't end up
891 with your typing being interpreted in the new frame instead of
892 the one you're actually typing in. */
893 internal_last_event_frame = Qnil;
895 return frame;
898 DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 1, "e",
899 doc: /* Select the frame FRAME.
900 Subsequent editing commands apply to its selected window.
901 The selection of FRAME lasts until the next time the user does
902 something to select a different frame, or until the next time this
903 function is called. If you are using a window system, the previously
904 selected frame may be restored as the selected frame after return to
905 the command loop, because it still may have the window system's input
906 focus. On a text-only terminal, the next redisplay will display FRAME.
908 This function returns FRAME, or nil if FRAME has been deleted. */)
909 (frame)
910 Lisp_Object frame;
912 return do_switch_frame (frame, 1, 0);
916 DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 1, "e",
917 doc: /* Handle a switch-frame event EVENT.
918 Switch-frame events are usually bound to this function.
919 A switch-frame event tells Emacs that the window manager has requested
920 that the user's events be directed to the frame mentioned in the event.
921 This function selects the selected window of the frame of EVENT.
923 If EVENT is frame object, handle it as if it were a switch-frame event
924 to that frame. */)
925 (event)
926 Lisp_Object event;
928 /* Preserve prefix arg that the command loop just cleared. */
929 current_kboard->Vprefix_arg = Vcurrent_prefix_arg;
930 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
931 return do_switch_frame (event, 0, 0);
934 DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0,
935 doc: /* Return the frame that is now selected. */)
938 return selected_frame;
941 DEFUN ("window-frame", Fwindow_frame, Swindow_frame, 1, 1, 0,
942 doc: /* Return the frame object that window WINDOW is on. */)
943 (window)
944 Lisp_Object window;
946 CHECK_LIVE_WINDOW (window);
947 return XWINDOW (window)->frame;
950 DEFUN ("frame-first-window", Fframe_first_window, Sframe_first_window, 0, 1, 0,
951 doc: /* Returns the topmost, leftmost window of FRAME.
952 If omitted, FRAME defaults to the currently selected frame. */)
953 (frame)
954 Lisp_Object frame;
956 Lisp_Object w;
958 if (NILP (frame))
959 w = SELECTED_FRAME ()->root_window;
960 else
962 CHECK_LIVE_FRAME (frame);
963 w = XFRAME (frame)->root_window;
965 while (NILP (XWINDOW (w)->buffer))
967 if (! NILP (XWINDOW (w)->hchild))
968 w = XWINDOW (w)->hchild;
969 else if (! NILP (XWINDOW (w)->vchild))
970 w = XWINDOW (w)->vchild;
971 else
972 abort ();
974 return w;
977 DEFUN ("active-minibuffer-window", Factive_minibuffer_window,
978 Sactive_minibuffer_window, 0, 0, 0,
979 doc: /* Return the currently active minibuffer window, or nil if none. */)
982 return minibuf_level ? minibuf_window : Qnil;
985 DEFUN ("frame-root-window", Fframe_root_window, Sframe_root_window, 0, 1, 0,
986 doc: /* Returns the root-window of FRAME.
987 If omitted, FRAME defaults to the currently selected frame. */)
988 (frame)
989 Lisp_Object frame;
991 Lisp_Object window;
993 if (NILP (frame))
994 window = SELECTED_FRAME ()->root_window;
995 else
997 CHECK_LIVE_FRAME (frame);
998 window = XFRAME (frame)->root_window;
1001 return window;
1004 DEFUN ("frame-selected-window", Fframe_selected_window,
1005 Sframe_selected_window, 0, 1, 0,
1006 doc: /* Return the selected window of frame object FRAME.
1007 If omitted, FRAME defaults to the currently selected frame. */)
1008 (frame)
1009 Lisp_Object frame;
1011 Lisp_Object window;
1013 if (NILP (frame))
1014 window = SELECTED_FRAME ()->selected_window;
1015 else
1017 CHECK_LIVE_FRAME (frame);
1018 window = XFRAME (frame)->selected_window;
1021 return window;
1024 DEFUN ("set-frame-selected-window", Fset_frame_selected_window,
1025 Sset_frame_selected_window, 2, 2, 0,
1026 doc: /* Set the selected window of frame object FRAME to WINDOW.
1027 Return WINDOW.
1028 If FRAME is nil, the selected frame is used.
1029 If FRAME is the selected frame, this makes WINDOW the selected window. */)
1030 (frame, window)
1031 Lisp_Object frame, window;
1033 if (NILP (frame))
1034 frame = selected_frame;
1036 CHECK_LIVE_FRAME (frame);
1037 CHECK_LIVE_WINDOW (window);
1039 if (! EQ (frame, WINDOW_FRAME (XWINDOW (window))))
1040 error ("In `set-frame-selected-window', WINDOW is not on FRAME");
1042 if (EQ (frame, selected_frame))
1043 return Fselect_window (window, Qnil);
1045 return XFRAME (frame)->selected_window = window;
1049 DEFUN ("frame-list", Fframe_list, Sframe_list,
1050 0, 0, 0,
1051 doc: /* Return a list of all frames. */)
1054 Lisp_Object frames;
1055 frames = Fcopy_sequence (Vframe_list);
1056 #ifdef HAVE_WINDOW_SYSTEM
1057 if (FRAMEP (tip_frame))
1058 frames = Fdelq (tip_frame, frames);
1059 #endif
1060 return frames;
1063 /* Return the next frame in the frame list after FRAME.
1064 If MINIBUF is nil, exclude minibuffer-only frames.
1065 If MINIBUF is a window, include only its own frame
1066 and any frame now using that window as the minibuffer.
1067 If MINIBUF is `visible', include all visible frames.
1068 If MINIBUF is 0, include all visible and iconified frames.
1069 Otherwise, include all frames. */
1071 static Lisp_Object
1072 next_frame (frame, minibuf)
1073 Lisp_Object frame;
1074 Lisp_Object minibuf;
1076 Lisp_Object tail;
1077 int passed = 0;
1079 /* There must always be at least one frame in Vframe_list. */
1080 if (! CONSP (Vframe_list))
1081 abort ();
1083 /* If this frame is dead, it won't be in Vframe_list, and we'll loop
1084 forever. Forestall that. */
1085 CHECK_LIVE_FRAME (frame);
1087 while (1)
1088 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1090 Lisp_Object f;
1092 f = XCAR (tail);
1094 if (passed
1095 && ((!FRAME_TERMCAP_P (XFRAME (f)) && !FRAME_TERMCAP_P (XFRAME (frame))
1096 && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
1097 || (FRAME_TERMCAP_P (XFRAME (f)) && FRAME_TERMCAP_P (XFRAME (frame))
1098 && FRAME_TTY (XFRAME (f)) == FRAME_TTY (XFRAME (frame)))))
1100 /* Decide whether this frame is eligible to be returned. */
1102 /* If we've looped all the way around without finding any
1103 eligible frames, return the original frame. */
1104 if (EQ (f, frame))
1105 return f;
1107 /* Let minibuf decide if this frame is acceptable. */
1108 if (NILP (minibuf))
1110 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
1111 return f;
1113 else if (EQ (minibuf, Qvisible))
1115 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1116 if (FRAME_VISIBLE_P (XFRAME (f)))
1117 return f;
1119 else if (INTEGERP (minibuf) && XINT (minibuf) == 0)
1121 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1122 if (FRAME_VISIBLE_P (XFRAME (f))
1123 || FRAME_ICONIFIED_P (XFRAME (f)))
1124 return f;
1126 else if (WINDOWP (minibuf))
1128 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
1129 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
1130 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
1131 FRAME_FOCUS_FRAME (XFRAME (f))))
1132 return f;
1134 else
1135 return f;
1138 if (EQ (frame, f))
1139 passed++;
1143 /* Return the previous frame in the frame list before FRAME.
1144 If MINIBUF is nil, exclude minibuffer-only frames.
1145 If MINIBUF is a window, include only its own frame
1146 and any frame now using that window as the minibuffer.
1147 If MINIBUF is `visible', include all visible frames.
1148 If MINIBUF is 0, include all visible and iconified frames.
1149 Otherwise, include all frames. */
1151 static Lisp_Object
1152 prev_frame (frame, minibuf)
1153 Lisp_Object frame;
1154 Lisp_Object minibuf;
1156 Lisp_Object tail;
1157 Lisp_Object prev;
1159 /* There must always be at least one frame in Vframe_list. */
1160 if (! CONSP (Vframe_list))
1161 abort ();
1163 prev = Qnil;
1164 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1166 Lisp_Object f;
1168 f = XCAR (tail);
1169 if (!FRAMEP (f))
1170 abort ();
1172 if (EQ (frame, f) && !NILP (prev))
1173 return prev;
1175 if ((!FRAME_TERMCAP_P (XFRAME (f)) && !FRAME_TERMCAP_P (XFRAME (frame))
1176 && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
1177 || (FRAME_TERMCAP_P (XFRAME (f)) && FRAME_TERMCAP_P (XFRAME (frame))
1178 && FRAME_TTY (XFRAME (f)) == FRAME_TTY (XFRAME (frame))))
1180 /* Decide whether this frame is eligible to be returned,
1181 according to minibuf. */
1182 if (NILP (minibuf))
1184 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
1185 prev = f;
1187 else if (WINDOWP (minibuf))
1189 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
1190 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
1191 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
1192 FRAME_FOCUS_FRAME (XFRAME (f))))
1193 prev = f;
1195 else if (EQ (minibuf, Qvisible))
1197 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1198 if (FRAME_VISIBLE_P (XFRAME (f)))
1199 prev = f;
1201 else if (XFASTINT (minibuf) == 0)
1203 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1204 if (FRAME_VISIBLE_P (XFRAME (f))
1205 || FRAME_ICONIFIED_P (XFRAME (f)))
1206 prev = f;
1208 else
1209 prev = f;
1213 /* We've scanned the entire list. */
1214 if (NILP (prev))
1215 /* We went through the whole frame list without finding a single
1216 acceptable frame. Return the original frame. */
1217 return frame;
1218 else
1219 /* There were no acceptable frames in the list before FRAME; otherwise,
1220 we would have returned directly from the loop. Since PREV is the last
1221 acceptable frame in the list, return it. */
1222 return prev;
1226 DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0,
1227 doc: /* Return the next frame in the frame list after FRAME.
1228 It considers only frames on the same terminal as FRAME.
1229 By default, skip minibuffer-only frames.
1230 If omitted, FRAME defaults to the selected frame.
1231 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1232 If MINIFRAME is a window, include only its own frame
1233 and any frame now using that window as the minibuffer.
1234 If MINIFRAME is `visible', include all visible frames.
1235 If MINIFRAME is 0, include all visible and iconified frames.
1236 Otherwise, include all frames. */)
1237 (frame, miniframe)
1238 Lisp_Object frame, miniframe;
1240 if (NILP (frame))
1241 frame = selected_frame;
1243 CHECK_LIVE_FRAME (frame);
1244 return next_frame (frame, miniframe);
1247 DEFUN ("previous-frame", Fprevious_frame, Sprevious_frame, 0, 2, 0,
1248 doc: /* Return the previous frame in the frame list before FRAME.
1249 It considers only frames on the same terminal as FRAME.
1250 By default, skip minibuffer-only frames.
1251 If omitted, FRAME defaults to the selected frame.
1252 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1253 If MINIFRAME is a window, include only its own frame
1254 and any frame now using that window as the minibuffer.
1255 If MINIFRAME is `visible', include all visible frames.
1256 If MINIFRAME is 0, include all visible and iconified frames.
1257 Otherwise, include all frames. */)
1258 (frame, miniframe)
1259 Lisp_Object frame, miniframe;
1261 if (NILP (frame))
1262 frame = selected_frame;
1263 CHECK_LIVE_FRAME (frame);
1264 return prev_frame (frame, miniframe);
1267 /* Return 1 if it is ok to delete frame F;
1268 0 if all frames aside from F are invisible.
1269 (Exception: if F is the terminal frame, and we are using X, return 1.) */
1272 other_visible_frames (f)
1273 FRAME_PTR f;
1275 /* We know the selected frame is visible,
1276 so if F is some other frame, it can't be the sole visible one. */
1277 if (f == SELECTED_FRAME ())
1279 Lisp_Object frames;
1280 int count = 0;
1282 for (frames = Vframe_list;
1283 CONSP (frames);
1284 frames = XCDR (frames))
1286 Lisp_Object this;
1288 this = XCAR (frames);
1289 /* Verify that the frame's window still exists
1290 and we can still talk to it. And note any recent change
1291 in visibility. */
1292 #ifdef HAVE_WINDOW_SYSTEM
1293 if (FRAME_WINDOW_P (XFRAME (this)))
1295 x_sync (XFRAME (this));
1296 FRAME_SAMPLE_VISIBILITY (XFRAME (this));
1298 #endif
1300 if (FRAME_VISIBLE_P (XFRAME (this))
1301 || FRAME_ICONIFIED_P (XFRAME (this))
1302 /* Allow deleting the terminal frame when at least
1303 one X frame exists! */
1304 || (FRAME_WINDOW_P (XFRAME (this)) && !FRAME_WINDOW_P (f)))
1305 count++;
1307 return count > 1;
1309 return 1;
1312 /* Error handler for `delete-frame-functions'. */
1313 static Lisp_Object
1314 delete_frame_handler (Lisp_Object arg)
1316 add_to_log ("Error during `delete-frame': %s", arg, Qnil);
1317 return Qnil;
1320 extern Lisp_Object Qrun_hook_with_args;
1322 DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 2, "",
1323 doc: /* Delete FRAME, permanently eliminating it from use.
1324 If omitted, FRAME defaults to the selected frame.
1325 A frame may not be deleted if its minibuffer is used by other frames.
1326 Normally, you may not delete a frame if all other frames are invisible,
1327 but if the second optional argument FORCE is non-nil, you may do so.
1329 This function runs `delete-frame-functions' before actually deleting the
1330 frame, unless the frame is a tooltip.
1331 The functions are run with one arg, the frame to be deleted.
1332 But FORCE inhibits this too. */)
1333 /* FORCE is non-nil when handling a disconnected terminal. */
1334 (frame, force)
1335 Lisp_Object frame, force;
1337 struct frame *f;
1338 struct frame *sf = SELECTED_FRAME ();
1339 struct kboard *kb;
1341 int minibuffer_selected;
1343 if (EQ (frame, Qnil))
1345 f = sf;
1346 XSETFRAME (frame, f);
1348 else
1350 CHECK_FRAME (frame);
1351 f = XFRAME (frame);
1354 if (! FRAME_LIVE_P (f))
1355 return Qnil;
1357 if (NILP (force) && !other_visible_frames (f))
1358 error ("Attempt to delete the sole visible or iconified frame");
1360 #if 0
1361 /* This is a nice idea, but x_connection_closed needs to be able
1362 to delete the last frame, if it is gone. */
1363 if (NILP (XCDR (Vframe_list)))
1364 error ("Attempt to delete the only frame");
1365 #endif
1367 /* Does this frame have a minibuffer, and is it the surrogate
1368 minibuffer for any other frame? */
1369 if (FRAME_HAS_MINIBUF_P (XFRAME (frame)))
1371 Lisp_Object frames;
1373 for (frames = Vframe_list;
1374 CONSP (frames);
1375 frames = XCDR (frames))
1377 Lisp_Object this;
1378 this = XCAR (frames);
1380 if (! EQ (this, frame)
1381 && EQ (frame,
1382 WINDOW_FRAME (XWINDOW
1383 (FRAME_MINIBUF_WINDOW (XFRAME (this))))))
1385 /* If we MUST delete this frame, delete the other first. */
1386 if (!NILP (force))
1387 Fdelete_frame (this, force);
1388 else
1389 error ("Attempt to delete a surrogate minibuffer frame");
1394 /* Run `delete-frame-functions'
1395 unless FORCE is `noelisp' or frame is a tooltip.
1396 FORCE is set to `noelisp' when handling a disconnect from the terminal,
1397 so we don't dare call Lisp code. */
1398 if (NILP (Vrun_hooks) || !NILP (Fframe_parameter (frame, intern ("tooltip"))))
1400 if (EQ (force, Qnoelisp))
1401 pending_funcalls
1402 = Fcons (list3 (Qrun_hook_with_args, Qdelete_frame_functions, frame),
1403 pending_funcalls);
1404 else
1405 safe_call2 (Qrun_hook_with_args, Qdelete_frame_functions, frame);
1407 /* The hook may sometimes (indirectly) cause the frame to be deleted. */
1408 if (! FRAME_LIVE_P (f))
1409 return Qnil;
1411 /* At this point, we are committed to deleting the frame.
1412 There is no more chance for errors to prevent it. */
1414 minibuffer_selected = EQ (minibuf_window, selected_window);
1416 /* Don't let the frame remain selected. */
1417 if (f == sf)
1419 Lisp_Object tail, frame1;
1421 /* Look for another visible frame on the same terminal. */
1422 frame1 = next_frame (frame, Qvisible);
1424 /* If there is none, find *some* other frame. */
1425 if (NILP (frame1) || EQ (frame1, frame))
1427 FOR_EACH_FRAME (tail, frame1)
1429 if (! EQ (frame, frame1) && FRAME_LIVE_P (XFRAME (frame1)))
1430 break;
1434 do_switch_frame (frame1, 0, 1);
1435 sf = SELECTED_FRAME ();
1438 /* Don't allow minibuf_window to remain on a deleted frame. */
1439 if (EQ (f->minibuffer_window, minibuf_window))
1441 Fset_window_buffer (sf->minibuffer_window,
1442 XWINDOW (minibuf_window)->buffer, Qnil);
1443 minibuf_window = sf->minibuffer_window;
1445 /* If the dying minibuffer window was selected,
1446 select the new one. */
1447 if (minibuffer_selected)
1448 Fselect_window (minibuf_window, Qnil);
1451 /* Don't let echo_area_window to remain on a deleted frame. */
1452 if (EQ (f->minibuffer_window, echo_area_window))
1453 echo_area_window = sf->minibuffer_window;
1455 /* Clear any X selections for this frame. */
1456 #ifdef HAVE_X_WINDOWS
1457 if (FRAME_X_P (f))
1458 x_clear_frame_selections (f);
1459 #endif
1460 #ifdef MAC_OS
1461 if (FRAME_MAC_P (f))
1462 x_clear_frame_selections (f);
1463 #endif
1465 /* Free glyphs.
1466 This function must be called before the window tree of the
1467 frame is deleted because windows contain dynamically allocated
1468 memory. */
1469 free_glyphs (f);
1471 #ifdef USE_FONT_BACKEND
1472 /* Give chance to each font driver to free a frame specific data. */
1473 font_update_drivers (f, Qnil);
1474 #endif /* USE_FONT_BACKEND */
1476 /* Mark all the windows that used to be on FRAME as deleted, and then
1477 remove the reference to them. */
1478 delete_all_subwindows (XWINDOW (f->root_window));
1479 f->root_window = Qnil;
1481 Vframe_list = Fdelq (frame, Vframe_list);
1482 FRAME_SET_VISIBLE (f, 0);
1484 if (f->namebuf)
1485 xfree (f->namebuf);
1486 if (f->decode_mode_spec_buffer)
1487 xfree (f->decode_mode_spec_buffer);
1488 if (FRAME_INSERT_COST (f))
1489 xfree (FRAME_INSERT_COST (f));
1490 if (FRAME_DELETEN_COST (f))
1491 xfree (FRAME_DELETEN_COST (f));
1492 if (FRAME_INSERTN_COST (f))
1493 xfree (FRAME_INSERTN_COST (f));
1494 if (FRAME_DELETE_COST (f))
1495 xfree (FRAME_DELETE_COST (f));
1496 if (FRAME_MESSAGE_BUF (f))
1497 xfree (FRAME_MESSAGE_BUF (f));
1499 /* Since some events are handled at the interrupt level, we may get
1500 an event for f at any time; if we zero out the frame's terminal
1501 now, then we may trip up the event-handling code. Instead, we'll
1502 promise that the terminal of the frame must be valid until we
1503 have called the window-system-dependent frame destruction
1504 routine. */
1506 if (FRAME_TERMINAL (f)->delete_frame_hook)
1507 (*FRAME_TERMINAL (f)->delete_frame_hook) (f);
1510 struct terminal *terminal = FRAME_TERMINAL (f);
1511 f->output_data.nothing = 0;
1512 f->terminal = 0; /* Now the frame is dead. */
1514 /* If needed, delete the terminal that this frame was on.
1515 (This must be done after the frame is killed.) */
1516 terminal->reference_count--;
1517 if (terminal->reference_count == 0)
1519 Lisp_Object tmp;
1520 XSETTERMINAL (tmp, terminal);
1522 kb = NULL;
1523 Fdelete_terminal (tmp, NILP (force) ? Qt : force);
1525 #ifdef MULTI_KBOARD
1526 else
1527 kb = terminal->kboard;
1528 #endif
1531 /* If we've deleted the last_nonminibuf_frame, then try to find
1532 another one. */
1533 if (f == last_nonminibuf_frame)
1535 Lisp_Object frames;
1537 last_nonminibuf_frame = 0;
1539 for (frames = Vframe_list;
1540 CONSP (frames);
1541 frames = XCDR (frames))
1543 f = XFRAME (XCAR (frames));
1544 if (!FRAME_MINIBUF_ONLY_P (f))
1546 last_nonminibuf_frame = f;
1547 break;
1552 /* If there's no other frame on the same kboard, get out of
1553 single-kboard state if we're in it for this kboard. */
1554 if (kb != NULL)
1556 Lisp_Object frames;
1557 /* Some frame we found on the same kboard, or nil if there are none. */
1558 Lisp_Object frame_on_same_kboard;
1560 frame_on_same_kboard = Qnil;
1562 for (frames = Vframe_list;
1563 CONSP (frames);
1564 frames = XCDR (frames))
1566 Lisp_Object this;
1567 struct frame *f1;
1569 this = XCAR (frames);
1570 if (!FRAMEP (this))
1571 abort ();
1572 f1 = XFRAME (this);
1574 if (kb == FRAME_KBOARD (f1))
1575 frame_on_same_kboard = this;
1578 if (NILP (frame_on_same_kboard))
1579 not_single_kboard_state (kb);
1583 /* If we've deleted this keyboard's default_minibuffer_frame, try to
1584 find another one. Prefer minibuffer-only frames, but also notice
1585 frames with other windows. */
1586 if (kb != NULL && EQ (frame, kb->Vdefault_minibuffer_frame))
1588 Lisp_Object frames;
1590 /* The last frame we saw with a minibuffer, minibuffer-only or not. */
1591 Lisp_Object frame_with_minibuf;
1592 /* Some frame we found on the same kboard, or nil if there are none. */
1593 Lisp_Object frame_on_same_kboard;
1595 frame_on_same_kboard = Qnil;
1596 frame_with_minibuf = Qnil;
1598 for (frames = Vframe_list;
1599 CONSP (frames);
1600 frames = XCDR (frames))
1602 Lisp_Object this;
1603 struct frame *f1;
1605 this = XCAR (frames);
1606 if (!FRAMEP (this))
1607 abort ();
1608 f1 = XFRAME (this);
1610 /* Consider only frames on the same kboard
1611 and only those with minibuffers. */
1612 if (kb == FRAME_KBOARD (f1)
1613 && FRAME_HAS_MINIBUF_P (f1))
1615 frame_with_minibuf = this;
1616 if (FRAME_MINIBUF_ONLY_P (f1))
1617 break;
1620 if (kb == FRAME_KBOARD (f1))
1621 frame_on_same_kboard = this;
1624 if (!NILP (frame_on_same_kboard))
1626 /* We know that there must be some frame with a minibuffer out
1627 there. If this were not true, all of the frames present
1628 would have to be minibufferless, which implies that at some
1629 point their minibuffer frames must have been deleted, but
1630 that is prohibited at the top; you can't delete surrogate
1631 minibuffer frames. */
1632 if (NILP (frame_with_minibuf))
1633 abort ();
1635 kb->Vdefault_minibuffer_frame = frame_with_minibuf;
1637 else
1638 /* No frames left on this kboard--say no minibuffer either. */
1639 kb->Vdefault_minibuffer_frame = Qnil;
1642 /* Cause frame titles to update--necessary if we now have just one frame. */
1643 update_mode_lines = 1;
1645 return Qnil;
1648 /* Return mouse position in character cell units. */
1650 DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0,
1651 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1652 The position is given in character cells, where (0, 0) is the
1653 upper-left corner of the frame, X is the horizontal offset, and Y is
1654 the vertical offset.
1655 If Emacs is running on a mouseless terminal or hasn't been programmed
1656 to read the mouse position, it returns the selected frame for FRAME
1657 and nil for X and Y.
1658 If `mouse-position-function' is non-nil, `mouse-position' calls it,
1659 passing the normal return value to that function as an argument,
1660 and returns whatever that function returns. */)
1663 FRAME_PTR f;
1664 Lisp_Object lispy_dummy;
1665 enum scroll_bar_part party_dummy;
1666 Lisp_Object x, y, retval;
1667 int col, row;
1668 unsigned long long_dummy;
1669 struct gcpro gcpro1;
1671 f = SELECTED_FRAME ();
1672 x = y = Qnil;
1674 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
1675 /* It's okay for the hook to refrain from storing anything. */
1676 if (FRAME_TERMINAL (f)->mouse_position_hook)
1677 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1678 &lispy_dummy, &party_dummy,
1679 &x, &y,
1680 &long_dummy);
1681 if (! NILP (x))
1683 col = XINT (x);
1684 row = XINT (y);
1685 pixel_to_glyph_coords (f, col, row, &col, &row, NULL, 1);
1686 XSETINT (x, col);
1687 XSETINT (y, row);
1689 #endif
1690 XSETFRAME (lispy_dummy, f);
1691 retval = Fcons (lispy_dummy, Fcons (x, y));
1692 GCPRO1 (retval);
1693 if (!NILP (Vmouse_position_function))
1694 retval = call1 (Vmouse_position_function, retval);
1695 RETURN_UNGCPRO (retval);
1698 DEFUN ("mouse-pixel-position", Fmouse_pixel_position,
1699 Smouse_pixel_position, 0, 0, 0,
1700 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1701 The position is given in pixel units, where (0, 0) is the
1702 upper-left corner of the frame, X is the horizontal offset, and Y is
1703 the vertical offset.
1704 If Emacs is running on a mouseless terminal or hasn't been programmed
1705 to read the mouse position, it returns the selected frame for FRAME
1706 and nil for X and Y. */)
1709 FRAME_PTR f;
1710 Lisp_Object lispy_dummy;
1711 enum scroll_bar_part party_dummy;
1712 Lisp_Object x, y;
1713 unsigned long long_dummy;
1715 f = SELECTED_FRAME ();
1716 x = y = Qnil;
1718 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
1719 /* It's okay for the hook to refrain from storing anything. */
1720 if (FRAME_TERMINAL (f)->mouse_position_hook)
1721 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1722 &lispy_dummy, &party_dummy,
1723 &x, &y,
1724 &long_dummy);
1725 #endif
1726 XSETFRAME (lispy_dummy, f);
1727 return Fcons (lispy_dummy, Fcons (x, y));
1730 DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0,
1731 doc: /* Move the mouse pointer to the center of character cell (X,Y) in FRAME.
1732 Coordinates are relative to the frame, not a window,
1733 so the coordinates of the top left character in the frame
1734 may be nonzero due to left-hand scroll bars or the menu bar.
1736 The position is given in character cells, where (0, 0) is the
1737 upper-left corner of the frame, X is the horizontal offset, and Y is
1738 the vertical offset.
1740 This function is a no-op for an X frame that is not visible.
1741 If you have just created a frame, you must wait for it to become visible
1742 before calling this function on it, like this.
1743 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1744 (frame, x, y)
1745 Lisp_Object frame, x, y;
1747 CHECK_LIVE_FRAME (frame);
1748 CHECK_NUMBER (x);
1749 CHECK_NUMBER (y);
1751 /* I think this should be done with a hook. */
1752 #ifdef HAVE_WINDOW_SYSTEM
1753 if (FRAME_WINDOW_P (XFRAME (frame)))
1754 /* Warping the mouse will cause enternotify and focus events. */
1755 x_set_mouse_position (XFRAME (frame), XINT (x), XINT (y));
1756 #else
1757 #if defined (MSDOS) && defined (HAVE_MOUSE)
1758 if (FRAME_MSDOS_P (XFRAME (frame)))
1760 Fselect_frame (frame);
1761 mouse_moveto (XINT (x), XINT (y));
1763 #else
1764 #ifdef HAVE_GPM
1766 Fselect_frame (frame);
1767 term_mouse_moveto (XINT (x), XINT (y));
1769 #endif
1770 #endif
1771 #endif
1773 return Qnil;
1776 DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position,
1777 Sset_mouse_pixel_position, 3, 3, 0,
1778 doc: /* Move the mouse pointer to pixel position (X,Y) in FRAME.
1779 The position is given in pixels, where (0, 0) is the upper-left corner
1780 of the frame, X is the horizontal offset, and Y is the vertical offset.
1782 Note, this is a no-op for an X frame that is not visible.
1783 If you have just created a frame, you must wait for it to become visible
1784 before calling this function on it, like this.
1785 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1786 (frame, x, y)
1787 Lisp_Object frame, x, y;
1789 CHECK_LIVE_FRAME (frame);
1790 CHECK_NUMBER (x);
1791 CHECK_NUMBER (y);
1793 /* I think this should be done with a hook. */
1794 #ifdef HAVE_WINDOW_SYSTEM
1795 if (FRAME_WINDOW_P (XFRAME (frame)))
1796 /* Warping the mouse will cause enternotify and focus events. */
1797 x_set_mouse_pixel_position (XFRAME (frame), XINT (x), XINT (y));
1798 #else
1799 #if defined (MSDOS) && defined (HAVE_MOUSE)
1800 if (FRAME_MSDOS_P (XFRAME (frame)))
1802 Fselect_frame (frame);
1803 mouse_moveto (XINT (x), XINT (y));
1805 #else
1806 #ifdef HAVE_GPM
1808 Fselect_frame (frame);
1809 term_mouse_moveto (XINT (x), XINT (y));
1811 #endif
1812 #endif
1813 #endif
1815 return Qnil;
1818 static void make_frame_visible_1 P_ ((Lisp_Object));
1820 DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible,
1821 0, 1, "",
1822 doc: /* Make the frame FRAME visible (assuming it is an X window).
1823 If omitted, FRAME defaults to the currently selected frame. */)
1824 (frame)
1825 Lisp_Object frame;
1827 if (NILP (frame))
1828 frame = selected_frame;
1830 CHECK_LIVE_FRAME (frame);
1832 /* I think this should be done with a hook. */
1833 #ifdef HAVE_WINDOW_SYSTEM
1834 if (FRAME_WINDOW_P (XFRAME (frame)))
1836 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1837 x_make_frame_visible (XFRAME (frame));
1839 #endif
1841 make_frame_visible_1 (XFRAME (frame)->root_window);
1843 /* Make menu bar update for the Buffers and Frames menus. */
1844 windows_or_buffers_changed++;
1846 return frame;
1849 /* Update the display_time slot of the buffers shown in WINDOW
1850 and all its descendents. */
1852 static void
1853 make_frame_visible_1 (window)
1854 Lisp_Object window;
1856 struct window *w;
1858 for (;!NILP (window); window = w->next)
1860 w = XWINDOW (window);
1862 if (!NILP (w->buffer))
1863 XBUFFER (w->buffer)->display_time = Fcurrent_time ();
1865 if (!NILP (w->vchild))
1866 make_frame_visible_1 (w->vchild);
1867 if (!NILP (w->hchild))
1868 make_frame_visible_1 (w->hchild);
1872 DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible,
1873 0, 2, "",
1874 doc: /* Make the frame FRAME invisible (assuming it is an X window).
1875 If omitted, FRAME defaults to the currently selected frame.
1876 Normally you may not make FRAME invisible if all other frames are invisible,
1877 but if the second optional argument FORCE is non-nil, you may do so. */)
1878 (frame, force)
1879 Lisp_Object frame, force;
1881 if (NILP (frame))
1882 frame = selected_frame;
1884 CHECK_LIVE_FRAME (frame);
1886 if (NILP (force) && !other_visible_frames (XFRAME (frame)))
1887 error ("Attempt to make invisible the sole visible or iconified frame");
1889 #if 0 /* This isn't logically necessary, and it can do GC. */
1890 /* Don't let the frame remain selected. */
1891 if (EQ (frame, selected_frame))
1892 do_switch_frame (next_frame (frame, Qt), 0, 0)
1893 #endif
1895 /* Don't allow minibuf_window to remain on a deleted frame. */
1896 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1898 struct frame *sf = XFRAME (selected_frame);
1899 Fset_window_buffer (sf->minibuffer_window,
1900 XWINDOW (minibuf_window)->buffer, Qnil);
1901 minibuf_window = sf->minibuffer_window;
1904 /* I think this should be done with a hook. */
1905 #ifdef HAVE_WINDOW_SYSTEM
1906 if (FRAME_WINDOW_P (XFRAME (frame)))
1907 x_make_frame_invisible (XFRAME (frame));
1908 #endif
1910 /* Make menu bar update for the Buffers and Frames menus. */
1911 windows_or_buffers_changed++;
1913 return Qnil;
1916 DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame,
1917 0, 1, "",
1918 doc: /* Make the frame FRAME into an icon.
1919 If omitted, FRAME defaults to the currently selected frame. */)
1920 (frame)
1921 Lisp_Object frame;
1923 if (NILP (frame))
1924 frame = selected_frame;
1926 CHECK_LIVE_FRAME (frame);
1928 #if 0 /* This isn't logically necessary, and it can do GC. */
1929 /* Don't let the frame remain selected. */
1930 if (EQ (frame, selected_frame))
1931 Fhandle_switch_frame (next_frame (frame, Qt));
1932 #endif
1934 /* Don't allow minibuf_window to remain on a deleted frame. */
1935 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1937 struct frame *sf = XFRAME (selected_frame);
1938 Fset_window_buffer (sf->minibuffer_window,
1939 XWINDOW (minibuf_window)->buffer, Qnil);
1940 minibuf_window = sf->minibuffer_window;
1943 /* I think this should be done with a hook. */
1944 #ifdef HAVE_WINDOW_SYSTEM
1945 if (FRAME_WINDOW_P (XFRAME (frame)))
1946 x_iconify_frame (XFRAME (frame));
1947 #endif
1949 /* Make menu bar update for the Buffers and Frames menus. */
1950 windows_or_buffers_changed++;
1952 return Qnil;
1955 DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p,
1956 1, 1, 0,
1957 doc: /* Return t if FRAME is now \"visible\" (actually in use for display).
1958 A frame that is not \"visible\" is not updated and, if it works through
1959 a window system, it may not show at all.
1960 Return the symbol `icon' if frame is visible only as an icon.
1962 On a text-only terminal, all frames are considered visible, whether
1963 they are currently being displayed or not, and this function returns t
1964 for all frames. */)
1965 (frame)
1966 Lisp_Object frame;
1968 CHECK_LIVE_FRAME (frame);
1970 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1972 if (FRAME_VISIBLE_P (XFRAME (frame)))
1973 return Qt;
1974 if (FRAME_ICONIFIED_P (XFRAME (frame)))
1975 return Qicon;
1976 return Qnil;
1979 DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list,
1980 0, 0, 0,
1981 doc: /* Return a list of all frames now \"visible\" (being updated). */)
1984 Lisp_Object tail, frame;
1985 struct frame *f;
1986 Lisp_Object value;
1988 value = Qnil;
1989 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1991 frame = XCAR (tail);
1992 if (!FRAMEP (frame))
1993 continue;
1994 f = XFRAME (frame);
1995 if (FRAME_VISIBLE_P (f))
1996 value = Fcons (frame, value);
1998 return value;
2002 DEFUN ("raise-frame", Fraise_frame, Sraise_frame, 0, 1, "",
2003 doc: /* Bring FRAME to the front, so it occludes any frames it overlaps.
2004 If FRAME is invisible or iconified, make it visible.
2005 If you don't specify a frame, the selected frame is used.
2006 If Emacs is displaying on an ordinary terminal or some other device which
2007 doesn't support multiple overlapping frames, this function does nothing. */)
2008 (frame)
2009 Lisp_Object frame;
2011 struct frame *f;
2012 if (NILP (frame))
2013 frame = selected_frame;
2015 CHECK_LIVE_FRAME (frame);
2017 f = XFRAME (frame);
2019 /* Do like the documentation says. */
2020 Fmake_frame_visible (frame);
2022 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
2023 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 1);
2025 return Qnil;
2028 /* Should we have a corresponding function called Flower_Power? */
2029 DEFUN ("lower-frame", Flower_frame, Slower_frame, 0, 1, "",
2030 doc: /* Send FRAME to the back, so it is occluded by any frames that overlap it.
2031 If you don't specify a frame, the selected frame is used.
2032 If Emacs is displaying on an ordinary terminal or some other device which
2033 doesn't support multiple overlapping frames, this function does nothing. */)
2034 (frame)
2035 Lisp_Object frame;
2037 struct frame *f;
2039 if (NILP (frame))
2040 frame = selected_frame;
2042 CHECK_LIVE_FRAME (frame);
2044 f = XFRAME (frame);
2046 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
2047 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 0);
2049 return Qnil;
2053 DEFUN ("redirect-frame-focus", Fredirect_frame_focus, Sredirect_frame_focus,
2054 1, 2, 0,
2055 doc: /* Arrange for keystrokes typed at FRAME to be sent to FOCUS-FRAME.
2056 In other words, switch-frame events caused by events in FRAME will
2057 request a switch to FOCUS-FRAME, and `last-event-frame' will be
2058 FOCUS-FRAME after reading an event typed at FRAME.
2060 If FOCUS-FRAME is omitted or nil, any existing redirection is
2061 cancelled, and the frame again receives its own keystrokes.
2063 Focus redirection is useful for temporarily redirecting keystrokes to
2064 a surrogate minibuffer frame when a frame doesn't have its own
2065 minibuffer window.
2067 A frame's focus redirection can be changed by `select-frame'. If frame
2068 FOO is selected, and then a different frame BAR is selected, any
2069 frames redirecting their focus to FOO are shifted to redirect their
2070 focus to BAR. This allows focus redirection to work properly when the
2071 user switches from one frame to another using `select-window'.
2073 This means that a frame whose focus is redirected to itself is treated
2074 differently from a frame whose focus is redirected to nil; the former
2075 is affected by `select-frame', while the latter is not.
2077 The redirection lasts until `redirect-frame-focus' is called to change it. */)
2078 (frame, focus_frame)
2079 Lisp_Object frame, focus_frame;
2081 struct frame *f;
2083 /* Note that we don't check for a live frame here. It's reasonable
2084 to redirect the focus of a frame you're about to delete, if you
2085 know what other frame should receive those keystrokes. */
2086 CHECK_FRAME (frame);
2088 if (! NILP (focus_frame))
2089 CHECK_LIVE_FRAME (focus_frame);
2091 f = XFRAME (frame);
2093 f->focus_frame = focus_frame;
2095 if (FRAME_TERMINAL (f)->frame_rehighlight_hook)
2096 (*FRAME_TERMINAL (f)->frame_rehighlight_hook) (f);
2098 return Qnil;
2102 DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 1, 1, 0,
2103 doc: /* Return the frame to which FRAME's keystrokes are currently being sent.
2104 This returns nil if FRAME's focus is not redirected.
2105 See `redirect-frame-focus'. */)
2106 (frame)
2107 Lisp_Object frame;
2109 CHECK_LIVE_FRAME (frame);
2111 return FRAME_FOCUS_FRAME (XFRAME (frame));
2116 /* Return the value of frame parameter PROP in frame FRAME. */
2118 Lisp_Object
2119 get_frame_param (frame, prop)
2120 register struct frame *frame;
2121 Lisp_Object prop;
2123 register Lisp_Object tem;
2125 tem = Fassq (prop, frame->param_alist);
2126 if (EQ (tem, Qnil))
2127 return tem;
2128 return Fcdr (tem);
2131 /* Return the buffer-predicate of the selected frame. */
2133 Lisp_Object
2134 frame_buffer_predicate (frame)
2135 Lisp_Object frame;
2137 return XFRAME (frame)->buffer_predicate;
2140 /* Return the buffer-list of the selected frame. */
2142 Lisp_Object
2143 frame_buffer_list (frame)
2144 Lisp_Object frame;
2146 return XFRAME (frame)->buffer_list;
2149 /* Set the buffer-list of the selected frame. */
2151 void
2152 set_frame_buffer_list (frame, list)
2153 Lisp_Object frame, list;
2155 XFRAME (frame)->buffer_list = list;
2158 /* Discard BUFFER from the buffer-list and buried-buffer-list of each frame. */
2160 void
2161 frames_discard_buffer (buffer)
2162 Lisp_Object buffer;
2164 Lisp_Object frame, tail;
2166 FOR_EACH_FRAME (tail, frame)
2168 XFRAME (frame)->buffer_list
2169 = Fdelq (buffer, XFRAME (frame)->buffer_list);
2170 XFRAME (frame)->buried_buffer_list
2171 = Fdelq (buffer, XFRAME (frame)->buried_buffer_list);
2175 /* Modify the alist in *ALISTPTR to associate PROP with VAL.
2176 If the alist already has an element for PROP, we change it. */
2178 void
2179 store_in_alist (alistptr, prop, val)
2180 Lisp_Object *alistptr, val;
2181 Lisp_Object prop;
2183 register Lisp_Object tem;
2185 tem = Fassq (prop, *alistptr);
2186 if (EQ (tem, Qnil))
2187 *alistptr = Fcons (Fcons (prop, val), *alistptr);
2188 else
2189 Fsetcdr (tem, val);
2192 static int
2193 frame_name_fnn_p (str, len)
2194 char *str;
2195 EMACS_INT len;
2197 if (len > 1 && str[0] == 'F')
2199 char *end_ptr;
2201 strtol (str + 1, &end_ptr, 10);
2203 if (end_ptr == str + len)
2204 return 1;
2206 return 0;
2209 /* Set the name of the terminal frame. Also used by MSDOS frames.
2210 Modeled after x_set_name which is used for WINDOW frames. */
2212 static void
2213 set_term_frame_name (f, name)
2214 struct frame *f;
2215 Lisp_Object name;
2217 f->explicit_name = ! NILP (name);
2219 /* If NAME is nil, set the name to F<num>. */
2220 if (NILP (name))
2222 char namebuf[20];
2224 /* Check for no change needed in this very common case
2225 before we do any consing. */
2226 if (frame_name_fnn_p (SDATA (f->name),
2227 SBYTES (f->name)))
2228 return;
2230 tty_frame_count++;
2231 sprintf (namebuf, "F%d", tty_frame_count);
2232 name = build_string (namebuf);
2234 else
2236 CHECK_STRING (name);
2238 /* Don't change the name if it's already NAME. */
2239 if (! NILP (Fstring_equal (name, f->name)))
2240 return;
2242 /* Don't allow the user to set the frame name to F<num>, so it
2243 doesn't clash with the names we generate for terminal frames. */
2244 if (frame_name_fnn_p (SDATA (name), SBYTES (name)))
2245 error ("Frame names of the form F<num> are usurped by Emacs");
2248 f->name = name;
2249 update_mode_lines = 1;
2252 void
2253 store_frame_param (f, prop, val)
2254 struct frame *f;
2255 Lisp_Object prop, val;
2257 register Lisp_Object old_alist_elt;
2259 /* The buffer-list parameters are stored in a special place and not
2260 in the alist. */
2261 if (EQ (prop, Qbuffer_list))
2263 f->buffer_list = val;
2264 return;
2266 if (EQ (prop, Qburied_buffer_list))
2268 f->buried_buffer_list = val;
2269 return;
2272 /* If PROP is a symbol which is supposed to have frame-local values,
2273 and it is set up based on this frame, switch to the global
2274 binding. That way, we can create or alter the frame-local binding
2275 without messing up the symbol's status. */
2276 if (SYMBOLP (prop))
2278 Lisp_Object valcontents;
2279 valcontents = SYMBOL_VALUE (prop);
2280 if ((BUFFER_LOCAL_VALUEP (valcontents))
2281 && XBUFFER_LOCAL_VALUE (valcontents)->check_frame
2282 && XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame
2283 && XFRAME (XBUFFER_LOCAL_VALUE (valcontents)->frame) == f)
2284 swap_in_global_binding (prop);
2287 #ifndef WINDOWSNT
2288 /* The tty color needed to be set before the frame's parameter
2289 alist was updated with the new value. This is not true any more,
2290 but we still do this test early on. */
2291 if (FRAME_TERMCAP_P (f) && EQ (prop, Qtty_color_mode)
2292 && f == FRAME_TTY (f)->previous_frame)
2293 /* Force redisplay of this tty. */
2294 FRAME_TTY (f)->previous_frame = NULL;
2295 #endif
2297 /* Update the frame parameter alist. */
2298 old_alist_elt = Fassq (prop, f->param_alist);
2299 if (EQ (old_alist_elt, Qnil))
2300 f->param_alist = Fcons (Fcons (prop, val), f->param_alist);
2301 else
2302 Fsetcdr (old_alist_elt, val);
2304 /* Update some other special parameters in their special places
2305 in addition to the alist. */
2307 if (EQ (prop, Qbuffer_predicate))
2308 f->buffer_predicate = val;
2310 if (! FRAME_WINDOW_P (f))
2312 if (EQ (prop, Qmenu_bar_lines))
2313 set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f)));
2314 else if (EQ (prop, Qname))
2315 set_term_frame_name (f, val);
2318 if (EQ (prop, Qminibuffer) && WINDOWP (val))
2320 if (! MINI_WINDOW_P (XWINDOW (val)))
2321 error ("Surrogate minibuffer windows must be minibuffer windows");
2323 if ((FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
2324 && !EQ (val, f->minibuffer_window))
2325 error ("Can't change the surrogate minibuffer of a frame with its own minibuffer");
2327 /* Install the chosen minibuffer window, with proper buffer. */
2328 f->minibuffer_window = val;
2332 DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0,
2333 doc: /* Return the parameters-alist of frame FRAME.
2334 It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
2335 The meaningful PARMs depend on the kind of frame.
2336 If FRAME is omitted, return information on the currently selected frame. */)
2337 (frame)
2338 Lisp_Object frame;
2340 Lisp_Object alist;
2341 FRAME_PTR f;
2342 int height, width;
2343 struct gcpro gcpro1;
2345 if (NILP (frame))
2346 frame = selected_frame;
2348 CHECK_FRAME (frame);
2349 f = XFRAME (frame);
2351 if (!FRAME_LIVE_P (f))
2352 return Qnil;
2354 alist = Fcopy_alist (f->param_alist);
2355 GCPRO1 (alist);
2357 if (!FRAME_WINDOW_P (f))
2359 int fg = FRAME_FOREGROUND_PIXEL (f);
2360 int bg = FRAME_BACKGROUND_PIXEL (f);
2361 Lisp_Object elt;
2363 /* If the frame's parameter alist says the colors are
2364 unspecified and reversed, take the frame's background pixel
2365 for foreground and vice versa. */
2366 elt = Fassq (Qforeground_color, alist);
2367 if (CONSP (elt) && STRINGP (XCDR (elt)))
2369 if (strncmp (SDATA (XCDR (elt)),
2370 unspecified_bg,
2371 SCHARS (XCDR (elt))) == 0)
2372 store_in_alist (&alist, Qforeground_color, tty_color_name (f, bg));
2373 else if (strncmp (SDATA (XCDR (elt)),
2374 unspecified_fg,
2375 SCHARS (XCDR (elt))) == 0)
2376 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2378 else
2379 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2380 elt = Fassq (Qbackground_color, alist);
2381 if (CONSP (elt) && STRINGP (XCDR (elt)))
2383 if (strncmp (SDATA (XCDR (elt)),
2384 unspecified_fg,
2385 SCHARS (XCDR (elt))) == 0)
2386 store_in_alist (&alist, Qbackground_color, tty_color_name (f, fg));
2387 else if (strncmp (SDATA (XCDR (elt)),
2388 unspecified_bg,
2389 SCHARS (XCDR (elt))) == 0)
2390 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2392 else
2393 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2394 store_in_alist (&alist, intern ("font"),
2395 build_string (FRAME_MSDOS_P (f)
2396 ? "ms-dos"
2397 : FRAME_W32_P (f) ? "w32term"
2398 :"tty"));
2400 store_in_alist (&alist, Qname, f->name);
2401 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2402 store_in_alist (&alist, Qheight, make_number (height));
2403 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2404 store_in_alist (&alist, Qwidth, make_number (width));
2405 store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil));
2406 store_in_alist (&alist, Qminibuffer,
2407 (! FRAME_HAS_MINIBUF_P (f) ? Qnil
2408 : FRAME_MINIBUF_ONLY_P (f) ? Qonly
2409 : FRAME_MINIBUF_WINDOW (f)));
2410 store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
2411 store_in_alist (&alist, Qbuffer_list, frame_buffer_list (frame));
2412 store_in_alist (&alist, Qburied_buffer_list, XFRAME (frame)->buried_buffer_list);
2414 /* I think this should be done with a hook. */
2415 #ifdef HAVE_WINDOW_SYSTEM
2416 if (FRAME_WINDOW_P (f))
2417 x_report_frame_params (f, &alist);
2418 else
2419 #endif
2421 /* This ought to be correct in f->param_alist for an X frame. */
2422 Lisp_Object lines;
2423 XSETFASTINT (lines, FRAME_MENU_BAR_LINES (f));
2424 store_in_alist (&alist, Qmenu_bar_lines, lines);
2427 UNGCPRO;
2428 return alist;
2432 DEFUN ("frame-parameter", Fframe_parameter, Sframe_parameter, 2, 2, 0,
2433 doc: /* Return FRAME's value for parameter PARAMETER.
2434 If FRAME is nil, describe the currently selected frame. */)
2435 (frame, parameter)
2436 Lisp_Object frame, parameter;
2438 struct frame *f;
2439 Lisp_Object value;
2441 if (NILP (frame))
2442 frame = selected_frame;
2443 else
2444 CHECK_FRAME (frame);
2445 CHECK_SYMBOL (parameter);
2447 f = XFRAME (frame);
2448 value = Qnil;
2450 if (FRAME_LIVE_P (f))
2452 /* Avoid consing in frequent cases. */
2453 if (EQ (parameter, Qname))
2454 value = f->name;
2455 #ifdef HAVE_X_WINDOWS
2456 else if (EQ (parameter, Qdisplay) && FRAME_X_P (f))
2457 value = XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element);
2458 #endif /* HAVE_X_WINDOWS */
2459 else if (EQ (parameter, Qbackground_color)
2460 || EQ (parameter, Qforeground_color))
2462 value = Fassq (parameter, f->param_alist);
2463 if (CONSP (value))
2465 value = XCDR (value);
2466 /* Fframe_parameters puts the actual fg/bg color names,
2467 even if f->param_alist says otherwise. This is
2468 important when param_alist's notion of colors is
2469 "unspecified". We need to do the same here. */
2470 if (STRINGP (value) && !FRAME_WINDOW_P (f))
2472 const char *color_name;
2473 EMACS_INT csz;
2475 if (EQ (parameter, Qbackground_color))
2477 color_name = SDATA (value);
2478 csz = SCHARS (value);
2479 if (strncmp (color_name, unspecified_bg, csz) == 0)
2480 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2481 else if (strncmp (color_name, unspecified_fg, csz) == 0)
2482 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2484 else if (EQ (parameter, Qforeground_color))
2486 color_name = SDATA (value);
2487 csz = SCHARS (value);
2488 if (strncmp (color_name, unspecified_fg, csz) == 0)
2489 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2490 else if (strncmp (color_name, unspecified_bg, csz) == 0)
2491 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2495 else
2496 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2498 else if (EQ (parameter, Qdisplay_type)
2499 || EQ (parameter, Qbackground_mode))
2500 value = Fcdr (Fassq (parameter, f->param_alist));
2501 else
2502 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2505 return value;
2509 DEFUN ("modify-frame-parameters", Fmodify_frame_parameters,
2510 Smodify_frame_parameters, 2, 2, 0,
2511 doc: /* Modify the parameters of frame FRAME according to ALIST.
2512 If FRAME is nil, it defaults to the selected frame.
2513 ALIST is an alist of parameters to change and their new values.
2514 Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.
2515 The meaningful PARMs depend on the kind of frame.
2516 Undefined PARMs are ignored, but stored in the frame's parameter list
2517 so that `frame-parameters' will return them.
2519 The value of frame parameter FOO can also be accessed
2520 as a frame-local binding for the variable FOO, if you have
2521 enabled such bindings for that variable with `make-variable-frame-local'. */)
2522 (frame, alist)
2523 Lisp_Object frame, alist;
2525 FRAME_PTR f;
2526 register Lisp_Object tail, prop, val;
2528 if (EQ (frame, Qnil))
2529 frame = selected_frame;
2530 CHECK_LIVE_FRAME (frame);
2531 f = XFRAME (frame);
2533 /* I think this should be done with a hook. */
2534 #ifdef HAVE_WINDOW_SYSTEM
2535 if (FRAME_WINDOW_P (f))
2536 x_set_frame_parameters (f, alist);
2537 else
2538 #endif
2539 #ifdef MSDOS
2540 if (FRAME_MSDOS_P (f))
2541 IT_set_frame_parameters (f, alist);
2542 else
2543 #endif
2546 int length = XINT (Flength (alist));
2547 int i;
2548 Lisp_Object *parms
2549 = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
2550 Lisp_Object *values
2551 = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
2553 /* Extract parm names and values into those vectors. */
2555 i = 0;
2556 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2558 Lisp_Object elt;
2560 elt = XCAR (tail);
2561 parms[i] = Fcar (elt);
2562 values[i] = Fcdr (elt);
2563 i++;
2566 /* Now process them in reverse of specified order. */
2567 for (i--; i >= 0; i--)
2569 prop = parms[i];
2570 val = values[i];
2571 store_frame_param (f, prop, val);
2573 /* Changing the background color might change the background
2574 mode, so that we have to load new defface specs.
2575 Call frame-set-background-mode to do that. */
2576 if (EQ (prop, Qbackground_color))
2577 call1 (Qframe_set_background_mode, frame);
2580 return Qnil;
2583 DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height,
2584 0, 1, 0,
2585 doc: /* Height in pixels of a line in the font in frame FRAME.
2586 If FRAME is omitted, the selected frame is used.
2587 For a terminal frame, the value is always 1. */)
2588 (frame)
2589 Lisp_Object frame;
2591 struct frame *f;
2593 if (NILP (frame))
2594 frame = selected_frame;
2595 CHECK_FRAME (frame);
2596 f = XFRAME (frame);
2598 #ifdef HAVE_WINDOW_SYSTEM
2599 if (FRAME_WINDOW_P (f))
2600 return make_number (x_char_height (f));
2601 else
2602 #endif
2603 return make_number (1);
2607 DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width,
2608 0, 1, 0,
2609 doc: /* Width in pixels of characters in the font in frame FRAME.
2610 If FRAME is omitted, the selected frame is used.
2611 On a graphical screen, the width is the standard width of the default font.
2612 For a terminal screen, the value is always 1. */)
2613 (frame)
2614 Lisp_Object frame;
2616 struct frame *f;
2618 if (NILP (frame))
2619 frame = selected_frame;
2620 CHECK_FRAME (frame);
2621 f = XFRAME (frame);
2623 #ifdef HAVE_WINDOW_SYSTEM
2624 if (FRAME_WINDOW_P (f))
2625 return make_number (x_char_width (f));
2626 else
2627 #endif
2628 return make_number (1);
2631 DEFUN ("frame-pixel-height", Fframe_pixel_height,
2632 Sframe_pixel_height, 0, 1, 0,
2633 doc: /* Return a FRAME's height in pixels.
2634 This counts only the height available for text lines,
2635 not menu bars on window-system Emacs frames.
2636 For a terminal frame, the result really gives the height in characters.
2637 If FRAME is omitted, the selected frame is used. */)
2638 (frame)
2639 Lisp_Object frame;
2641 struct frame *f;
2643 if (NILP (frame))
2644 frame = selected_frame;
2645 CHECK_FRAME (frame);
2646 f = XFRAME (frame);
2648 #ifdef HAVE_WINDOW_SYSTEM
2649 if (FRAME_WINDOW_P (f))
2650 return make_number (x_pixel_height (f));
2651 else
2652 #endif
2653 return make_number (FRAME_LINES (f));
2656 DEFUN ("frame-pixel-width", Fframe_pixel_width,
2657 Sframe_pixel_width, 0, 1, 0,
2658 doc: /* Return FRAME's width in pixels.
2659 For a terminal frame, the result really gives the width in characters.
2660 If FRAME is omitted, the selected frame is used. */)
2661 (frame)
2662 Lisp_Object frame;
2664 struct frame *f;
2666 if (NILP (frame))
2667 frame = selected_frame;
2668 CHECK_FRAME (frame);
2669 f = XFRAME (frame);
2671 #ifdef HAVE_WINDOW_SYSTEM
2672 if (FRAME_WINDOW_P (f))
2673 return make_number (x_pixel_width (f));
2674 else
2675 #endif
2676 return make_number (FRAME_COLS (f));
2679 DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0,
2680 doc: /* Specify that the frame FRAME has LINES lines.
2681 Optional third arg non-nil means that redisplay should use LINES lines
2682 but that the idea of the actual height of the frame should not be changed. */)
2683 (frame, lines, pretend)
2684 Lisp_Object frame, lines, pretend;
2686 register struct frame *f;
2688 CHECK_NUMBER (lines);
2689 if (NILP (frame))
2690 frame = selected_frame;
2691 CHECK_LIVE_FRAME (frame);
2692 f = XFRAME (frame);
2694 /* I think this should be done with a hook. */
2695 #ifdef HAVE_WINDOW_SYSTEM
2696 if (FRAME_WINDOW_P (f))
2698 if (XINT (lines) != FRAME_LINES (f))
2699 x_set_window_size (f, 1, FRAME_COLS (f), XINT (lines));
2700 do_pending_window_change (0);
2702 else
2703 #endif
2704 change_frame_size (f, XINT (lines), 0, !NILP (pretend), 0, 0);
2705 return Qnil;
2708 DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 3, 0,
2709 doc: /* Specify that the frame FRAME has COLS columns.
2710 Optional third arg non-nil means that redisplay should use COLS columns
2711 but that the idea of the actual width of the frame should not be changed. */)
2712 (frame, cols, pretend)
2713 Lisp_Object frame, cols, pretend;
2715 register struct frame *f;
2716 CHECK_NUMBER (cols);
2717 if (NILP (frame))
2718 frame = selected_frame;
2719 CHECK_LIVE_FRAME (frame);
2720 f = XFRAME (frame);
2722 /* I think this should be done with a hook. */
2723 #ifdef HAVE_WINDOW_SYSTEM
2724 if (FRAME_WINDOW_P (f))
2726 if (XINT (cols) != FRAME_COLS (f))
2727 x_set_window_size (f, 1, XINT (cols), FRAME_LINES (f));
2728 do_pending_window_change (0);
2730 else
2731 #endif
2732 change_frame_size (f, 0, XINT (cols), !NILP (pretend), 0, 0);
2733 return Qnil;
2736 DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0,
2737 doc: /* Sets size of FRAME to COLS by ROWS, measured in characters. */)
2738 (frame, cols, rows)
2739 Lisp_Object frame, cols, rows;
2741 register struct frame *f;
2743 CHECK_LIVE_FRAME (frame);
2744 CHECK_NUMBER (cols);
2745 CHECK_NUMBER (rows);
2746 f = XFRAME (frame);
2748 /* I think this should be done with a hook. */
2749 #ifdef HAVE_WINDOW_SYSTEM
2750 if (FRAME_WINDOW_P (f))
2752 if (XINT (rows) != FRAME_LINES (f)
2753 || XINT (cols) != FRAME_COLS (f)
2754 || f->new_text_lines || f->new_text_cols)
2755 x_set_window_size (f, 1, XINT (cols), XINT (rows));
2756 do_pending_window_change (0);
2758 else
2759 #endif
2760 change_frame_size (f, XINT (rows), XINT (cols), 0, 0, 0);
2762 return Qnil;
2765 DEFUN ("set-frame-position", Fset_frame_position,
2766 Sset_frame_position, 3, 3, 0,
2767 doc: /* Sets position of FRAME in pixels to XOFFSET by YOFFSET.
2768 This is actually the position of the upper left corner of the frame.
2769 Negative values for XOFFSET or YOFFSET are interpreted relative to
2770 the rightmost or bottommost possible position (that stays within the screen). */)
2771 (frame, xoffset, yoffset)
2772 Lisp_Object frame, xoffset, yoffset;
2774 register struct frame *f;
2776 CHECK_LIVE_FRAME (frame);
2777 CHECK_NUMBER (xoffset);
2778 CHECK_NUMBER (yoffset);
2779 f = XFRAME (frame);
2781 /* I think this should be done with a hook. */
2782 #ifdef HAVE_WINDOW_SYSTEM
2783 if (FRAME_WINDOW_P (f))
2784 x_set_offset (f, XINT (xoffset), XINT (yoffset), 1);
2785 #endif
2787 return Qt;
2791 /***********************************************************************
2792 Frame Parameters
2793 ***********************************************************************/
2795 /* Connect the frame-parameter names for X frames
2796 to the ways of passing the parameter values to the window system.
2798 The name of a parameter, as a Lisp symbol,
2799 has an `x-frame-parameter' property which is an integer in Lisp
2800 that is an index in this table. */
2802 struct frame_parm_table {
2803 char *name;
2804 Lisp_Object *variable;
2807 static struct frame_parm_table frame_parms[] =
2809 {"auto-raise", &Qauto_raise},
2810 {"auto-lower", &Qauto_lower},
2811 {"background-color", 0},
2812 {"border-color", &Qborder_color},
2813 {"border-width", &Qborder_width},
2814 {"cursor-color", &Qcursor_color},
2815 {"cursor-type", &Qcursor_type},
2816 {"font", 0},
2817 {"foreground-color", 0},
2818 {"icon-name", &Qicon_name},
2819 {"icon-type", &Qicon_type},
2820 {"internal-border-width", &Qinternal_border_width},
2821 {"menu-bar-lines", &Qmenu_bar_lines},
2822 {"mouse-color", &Qmouse_color},
2823 {"name", &Qname},
2824 {"scroll-bar-width", &Qscroll_bar_width},
2825 {"title", &Qtitle},
2826 {"unsplittable", &Qunsplittable},
2827 {"vertical-scroll-bars", &Qvertical_scroll_bars},
2828 {"visibility", &Qvisibility},
2829 {"tool-bar-lines", &Qtool_bar_lines},
2830 {"scroll-bar-foreground", &Qscroll_bar_foreground},
2831 {"scroll-bar-background", &Qscroll_bar_background},
2832 {"screen-gamma", &Qscreen_gamma},
2833 {"line-spacing", &Qline_spacing},
2834 {"left-fringe", &Qleft_fringe},
2835 {"right-fringe", &Qright_fringe},
2836 {"wait-for-wm", &Qwait_for_wm},
2837 {"fullscreen", &Qfullscreen},
2838 #ifdef USE_FONT_BACKEND
2839 {"font-backend", &Qfont_backend}
2840 #endif /* USE_FONT_BACKEND */
2843 #ifdef HAVE_WINDOW_SYSTEM
2845 extern Lisp_Object Qbox;
2846 extern Lisp_Object Qtop;
2848 /* Calculate fullscreen size. Return in *TOP_POS and *LEFT_POS the
2849 wanted positions of the WM window (not Emacs window).
2850 Return in *WIDTH and *HEIGHT the wanted width and height of Emacs
2851 window (FRAME_X_WINDOW).
2854 void
2855 x_fullscreen_adjust (f, width, height, top_pos, left_pos)
2856 struct frame *f;
2857 int *width;
2858 int *height;
2859 int *top_pos;
2860 int *left_pos;
2862 int newwidth = FRAME_COLS (f);
2863 int newheight = FRAME_LINES (f);
2865 *top_pos = f->top_pos;
2866 *left_pos = f->left_pos;
2868 if (f->want_fullscreen & FULLSCREEN_HEIGHT)
2870 int ph;
2872 ph = FRAME_X_DISPLAY_INFO (f)->height;
2873 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2874 ph = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, newheight) - f->y_pixels_diff;
2875 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2876 *top_pos = 0;
2879 if (f->want_fullscreen & FULLSCREEN_WIDTH)
2881 int pw;
2883 pw = FRAME_X_DISPLAY_INFO (f)->width;
2884 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2885 pw = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, newwidth) - f->x_pixels_diff;
2886 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2887 *left_pos = 0;
2890 *width = newwidth;
2891 *height = newheight;
2895 /* Change the parameters of frame F as specified by ALIST.
2896 If a parameter is not specially recognized, do nothing special;
2897 otherwise call the `x_set_...' function for that parameter.
2898 Except for certain geometry properties, always call store_frame_param
2899 to store the new value in the parameter alist. */
2901 void
2902 x_set_frame_parameters (f, alist)
2903 FRAME_PTR f;
2904 Lisp_Object alist;
2906 Lisp_Object tail;
2908 /* If both of these parameters are present, it's more efficient to
2909 set them both at once. So we wait until we've looked at the
2910 entire list before we set them. */
2911 int width, height;
2913 /* Same here. */
2914 Lisp_Object left, top;
2916 /* Same with these. */
2917 Lisp_Object icon_left, icon_top;
2919 /* Record in these vectors all the parms specified. */
2920 Lisp_Object *parms;
2921 Lisp_Object *values;
2922 int i, p;
2923 int left_no_change = 0, top_no_change = 0;
2924 int icon_left_no_change = 0, icon_top_no_change = 0;
2925 int fullscreen_is_being_set = 0;
2927 struct gcpro gcpro1, gcpro2;
2929 i = 0;
2930 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
2931 i++;
2933 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
2934 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
2936 /* Extract parm names and values into those vectors. */
2938 i = 0;
2939 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2941 Lisp_Object elt;
2943 elt = XCAR (tail);
2944 parms[i] = Fcar (elt);
2945 values[i] = Fcdr (elt);
2946 i++;
2948 /* TAIL and ALIST are not used again below here. */
2949 alist = tail = Qnil;
2951 GCPRO2 (*parms, *values);
2952 gcpro1.nvars = i;
2953 gcpro2.nvars = i;
2955 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
2956 because their values appear in VALUES and strings are not valid. */
2957 top = left = Qunbound;
2958 icon_left = icon_top = Qunbound;
2960 /* Provide default values for HEIGHT and WIDTH. */
2961 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2962 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2964 /* Process foreground_color and background_color before anything else.
2965 They are independent of other properties, but other properties (e.g.,
2966 cursor_color) are dependent upon them. */
2967 /* Process default font as well, since fringe widths depends on it. */
2968 /* Also, process fullscreen, width and height depend upon that */
2969 for (p = 0; p < i; p++)
2971 Lisp_Object prop, val;
2973 prop = parms[p];
2974 val = values[p];
2975 if (EQ (prop, Qforeground_color)
2976 || EQ (prop, Qbackground_color)
2977 || EQ (prop, Qfont)
2978 || EQ (prop, Qfullscreen))
2980 register Lisp_Object param_index, old_value;
2981 int count = SPECPDL_INDEX ();
2983 old_value = get_frame_param (f, prop);
2984 fullscreen_is_being_set |= EQ (prop, Qfullscreen);
2986 if (NILP (Fequal (val, old_value)))
2988 /* For :font attributes, the frame_parm_handler
2989 x_set_font calls `face-set-after-frame-default'.
2990 Unless we bind inhibit-face-set-after-frame-default
2991 here, this would reset the :font attribute that we
2992 just applied to the default value for new faces. */
2993 specbind (Qinhibit_face_set_after_frame_default, Qt);
2995 store_frame_param (f, prop, val);
2997 param_index = Fget (prop, Qx_frame_parameter);
2998 if (NATNUMP (param_index)
2999 && (XFASTINT (param_index)
3000 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3001 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
3002 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
3003 unbind_to (count, Qnil);
3008 /* Now process them in reverse of specified order. */
3009 for (i--; i >= 0; i--)
3011 Lisp_Object prop, val;
3013 prop = parms[i];
3014 val = values[i];
3016 if (EQ (prop, Qwidth) && NATNUMP (val))
3017 width = XFASTINT (val);
3018 else if (EQ (prop, Qheight) && NATNUMP (val))
3019 height = XFASTINT (val);
3020 else if (EQ (prop, Qtop))
3021 top = val;
3022 else if (EQ (prop, Qleft))
3023 left = val;
3024 else if (EQ (prop, Qicon_top))
3025 icon_top = val;
3026 else if (EQ (prop, Qicon_left))
3027 icon_left = val;
3028 else if (EQ (prop, Qforeground_color)
3029 || EQ (prop, Qbackground_color)
3030 || EQ (prop, Qfont)
3031 || EQ (prop, Qfullscreen))
3032 /* Processed above. */
3033 continue;
3034 else
3036 register Lisp_Object param_index, old_value;
3038 old_value = get_frame_param (f, prop);
3040 store_frame_param (f, prop, val);
3042 param_index = Fget (prop, Qx_frame_parameter);
3043 if (NATNUMP (param_index)
3044 && (XFASTINT (param_index)
3045 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3046 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
3047 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
3051 /* Don't die if just one of these was set. */
3052 if (EQ (left, Qunbound))
3054 left_no_change = 1;
3055 if (f->left_pos < 0)
3056 left = Fcons (Qplus, Fcons (make_number (f->left_pos), Qnil));
3057 else
3058 XSETINT (left, f->left_pos);
3060 if (EQ (top, Qunbound))
3062 top_no_change = 1;
3063 if (f->top_pos < 0)
3064 top = Fcons (Qplus, Fcons (make_number (f->top_pos), Qnil));
3065 else
3066 XSETINT (top, f->top_pos);
3069 /* If one of the icon positions was not set, preserve or default it. */
3070 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
3072 icon_left_no_change = 1;
3073 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
3074 if (NILP (icon_left))
3075 XSETINT (icon_left, 0);
3077 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
3079 icon_top_no_change = 1;
3080 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
3081 if (NILP (icon_top))
3082 XSETINT (icon_top, 0);
3085 if (FRAME_VISIBLE_P (f) && fullscreen_is_being_set)
3087 /* If the frame is visible already and the fullscreen parameter is
3088 being set, it is too late to set WM manager hints to specify
3089 size and position.
3090 Here we first get the width, height and position that applies to
3091 fullscreen. We then move the frame to the appropriate
3092 position. Resize of the frame is taken care of in the code after
3093 this if-statement. */
3094 int new_left, new_top;
3096 x_fullscreen_adjust (f, &width, &height, &new_top, &new_left);
3097 if (new_top != f->top_pos || new_left != f->left_pos)
3098 x_set_offset (f, new_left, new_top, 1);
3101 /* Don't set these parameters unless they've been explicitly
3102 specified. The window might be mapped or resized while we're in
3103 this function, and we don't want to override that unless the lisp
3104 code has asked for it.
3106 Don't set these parameters unless they actually differ from the
3107 window's current parameters; the window may not actually exist
3108 yet. */
3110 Lisp_Object frame;
3112 check_frame_size (f, &height, &width);
3114 XSETFRAME (frame, f);
3116 if (width != FRAME_COLS (f)
3117 || height != FRAME_LINES (f)
3118 || f->new_text_lines || f->new_text_cols)
3119 Fset_frame_size (frame, make_number (width), make_number (height));
3121 if ((!NILP (left) || !NILP (top))
3122 && ! (left_no_change && top_no_change)
3123 && ! (NUMBERP (left) && XINT (left) == f->left_pos
3124 && NUMBERP (top) && XINT (top) == f->top_pos))
3126 int leftpos = 0;
3127 int toppos = 0;
3129 /* Record the signs. */
3130 f->size_hint_flags &= ~ (XNegative | YNegative);
3131 if (EQ (left, Qminus))
3132 f->size_hint_flags |= XNegative;
3133 else if (INTEGERP (left))
3135 leftpos = XINT (left);
3136 if (leftpos < 0)
3137 f->size_hint_flags |= XNegative;
3139 else if (CONSP (left) && EQ (XCAR (left), Qminus)
3140 && CONSP (XCDR (left))
3141 && INTEGERP (XCAR (XCDR (left))))
3143 leftpos = - XINT (XCAR (XCDR (left)));
3144 f->size_hint_flags |= XNegative;
3146 else if (CONSP (left) && EQ (XCAR (left), Qplus)
3147 && CONSP (XCDR (left))
3148 && INTEGERP (XCAR (XCDR (left))))
3150 leftpos = XINT (XCAR (XCDR (left)));
3153 if (EQ (top, Qminus))
3154 f->size_hint_flags |= YNegative;
3155 else if (INTEGERP (top))
3157 toppos = XINT (top);
3158 if (toppos < 0)
3159 f->size_hint_flags |= YNegative;
3161 else if (CONSP (top) && EQ (XCAR (top), Qminus)
3162 && CONSP (XCDR (top))
3163 && INTEGERP (XCAR (XCDR (top))))
3165 toppos = - XINT (XCAR (XCDR (top)));
3166 f->size_hint_flags |= YNegative;
3168 else if (CONSP (top) && EQ (XCAR (top), Qplus)
3169 && CONSP (XCDR (top))
3170 && INTEGERP (XCAR (XCDR (top))))
3172 toppos = XINT (XCAR (XCDR (top)));
3176 /* Store the numeric value of the position. */
3177 f->top_pos = toppos;
3178 f->left_pos = leftpos;
3180 f->win_gravity = NorthWestGravity;
3182 /* Actually set that position, and convert to absolute. */
3183 x_set_offset (f, leftpos, toppos, -1);
3186 if ((!NILP (icon_left) || !NILP (icon_top))
3187 && ! (icon_left_no_change && icon_top_no_change))
3188 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
3191 UNGCPRO;
3195 /* Insert a description of internally-recorded parameters of frame X
3196 into the parameter alist *ALISTPTR that is to be given to the user.
3197 Only parameters that are specific to the X window system
3198 and whose values are not correctly recorded in the frame's
3199 param_alist need to be considered here. */
3201 void
3202 x_report_frame_params (f, alistptr)
3203 struct frame *f;
3204 Lisp_Object *alistptr;
3206 char buf[16];
3207 Lisp_Object tem;
3209 /* Represent negative positions (off the top or left screen edge)
3210 in a way that Fmodify_frame_parameters will understand correctly. */
3211 XSETINT (tem, f->left_pos);
3212 if (f->left_pos >= 0)
3213 store_in_alist (alistptr, Qleft, tem);
3214 else
3215 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
3217 XSETINT (tem, f->top_pos);
3218 if (f->top_pos >= 0)
3219 store_in_alist (alistptr, Qtop, tem);
3220 else
3221 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
3223 store_in_alist (alistptr, Qborder_width,
3224 make_number (f->border_width));
3225 store_in_alist (alistptr, Qinternal_border_width,
3226 make_number (FRAME_INTERNAL_BORDER_WIDTH (f)));
3227 store_in_alist (alistptr, Qleft_fringe,
3228 make_number (FRAME_LEFT_FRINGE_WIDTH (f)));
3229 store_in_alist (alistptr, Qright_fringe,
3230 make_number (FRAME_RIGHT_FRINGE_WIDTH (f)));
3231 store_in_alist (alistptr, Qscroll_bar_width,
3232 (! FRAME_HAS_VERTICAL_SCROLL_BARS (f)
3233 ? make_number (0)
3234 : FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0
3235 ? make_number (FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3236 /* nil means "use default width"
3237 for non-toolkit scroll bar.
3238 ruler-mode.el depends on this. */
3239 : Qnil));
3240 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
3241 store_in_alist (alistptr, Qwindow_id,
3242 build_string (buf));
3243 #ifdef HAVE_X_WINDOWS
3244 #ifdef USE_X_TOOLKIT
3245 /* Tooltip frame may not have this widget. */
3246 if (FRAME_X_OUTPUT (f)->widget)
3247 #endif
3248 sprintf (buf, "%ld", (long) FRAME_OUTER_WINDOW (f));
3249 store_in_alist (alistptr, Qouter_window_id,
3250 build_string (buf));
3251 #endif
3252 store_in_alist (alistptr, Qicon_name, f->icon_name);
3253 FRAME_SAMPLE_VISIBILITY (f);
3254 store_in_alist (alistptr, Qvisibility,
3255 (FRAME_VISIBLE_P (f) ? Qt
3256 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
3257 store_in_alist (alistptr, Qdisplay,
3258 XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
3260 if (FRAME_X_OUTPUT (f)->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
3261 tem = Qnil;
3262 else
3263 XSETFASTINT (tem, FRAME_X_OUTPUT (f)->parent_desc);
3264 store_in_alist (alistptr, Qexplicit_name, (f->explicit_name ? Qt : Qnil));
3265 store_in_alist (alistptr, Qparent_id, tem);
3269 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
3270 the previous value of that parameter, NEW_VALUE is the new value. */
3272 void
3273 x_set_fullscreen (f, new_value, old_value)
3274 struct frame *f;
3275 Lisp_Object new_value, old_value;
3277 if (NILP (new_value))
3278 f->want_fullscreen = FULLSCREEN_NONE;
3279 else if (EQ (new_value, Qfullboth))
3280 f->want_fullscreen = FULLSCREEN_BOTH;
3281 else if (EQ (new_value, Qfullwidth))
3282 f->want_fullscreen = FULLSCREEN_WIDTH;
3283 else if (EQ (new_value, Qfullheight))
3284 f->want_fullscreen = FULLSCREEN_HEIGHT;
3286 if (FRAME_TERMINAL (f)->fullscreen_hook != NULL)
3287 FRAME_TERMINAL (f)->fullscreen_hook (f);
3291 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
3292 the previous value of that parameter, NEW_VALUE is the new value. */
3294 void
3295 x_set_line_spacing (f, new_value, old_value)
3296 struct frame *f;
3297 Lisp_Object new_value, old_value;
3299 if (NILP (new_value))
3300 f->extra_line_spacing = 0;
3301 else if (NATNUMP (new_value))
3302 f->extra_line_spacing = XFASTINT (new_value);
3303 else
3304 signal_error ("Invalid line-spacing", new_value);
3305 if (FRAME_VISIBLE_P (f))
3306 redraw_frame (f);
3310 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
3311 the previous value of that parameter, NEW_VALUE is the new value. */
3313 void
3314 x_set_screen_gamma (f, new_value, old_value)
3315 struct frame *f;
3316 Lisp_Object new_value, old_value;
3318 Lisp_Object bgcolor;
3320 if (NILP (new_value))
3321 f->gamma = 0;
3322 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
3323 /* The value 0.4545 is the normal viewing gamma. */
3324 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
3325 else
3326 signal_error ("Invalid screen-gamma", new_value);
3328 /* Apply the new gamma value to the frame background. */
3329 bgcolor = Fassq (Qbackground_color, f->param_alist);
3330 if (CONSP (bgcolor) && (bgcolor = XCDR (bgcolor), STRINGP (bgcolor)))
3332 Lisp_Object index = Fget (Qbackground_color, Qx_frame_parameter);
3333 if (NATNUMP (index)
3334 && (XFASTINT (index)
3335 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3336 && FRAME_RIF (f)->frame_parm_handlers[XFASTINT (index)])
3337 (*FRAME_RIF (f)->frame_parm_handlers[XFASTINT (index)])
3338 (f, bgcolor, Qnil);
3341 Fclear_face_cache (Qnil);
3345 void
3346 x_set_font (f, arg, oldval)
3347 struct frame *f;
3348 Lisp_Object arg, oldval;
3350 Lisp_Object result;
3351 Lisp_Object fontset_name;
3352 Lisp_Object frame;
3353 int old_fontset = FRAME_FONTSET(f);
3355 #ifdef USE_FONT_BACKEND
3356 if (enable_font_backend)
3358 int fontset = -1;
3359 Lisp_Object font_object;
3361 /* ARG is a fontset name, a font name, or a font object.
3362 In the last case, this function never fail. */
3363 if (STRINGP (arg))
3365 fontset = fs_query_fontset (arg, 0);
3366 if (fontset < 0)
3367 font_object = font_open_by_name (f, SDATA (arg));
3368 else if (fontset > 0)
3370 Lisp_Object ascii_font = fontset_ascii (fontset);
3372 font_object = font_open_by_name (f, SDATA (ascii_font));
3375 else
3376 font_object = arg;
3378 if (fontset < 0 && ! NILP (font_object))
3379 fontset = new_fontset_from_font (font_object);
3381 if (fontset == 0)
3382 /* Refuse the default fontset. */
3383 result = Qt;
3384 else if (NILP (font_object))
3385 result = Qnil;
3386 else
3387 result = x_new_fontset2 (f, fontset, font_object);
3389 else
3391 #endif /* USE_FONT_BACKEND */
3392 CHECK_STRING (arg);
3394 fontset_name = Fquery_fontset (arg, Qnil);
3396 BLOCK_INPUT;
3397 result = (STRINGP (fontset_name)
3398 ? x_new_fontset (f, fontset_name)
3399 : x_new_fontset (f, arg));
3400 UNBLOCK_INPUT;
3401 #ifdef USE_FONT_BACKEND
3403 #endif
3405 if (EQ (result, Qnil))
3406 error ("Font `%s' is not defined", SDATA (arg));
3407 else if (EQ (result, Qt))
3408 error ("The default fontset can't be used for a frame font");
3409 else if (STRINGP (result))
3411 set_default_ascii_font (result);
3412 if (STRINGP (fontset_name))
3414 /* Fontset names are built from ASCII font names, so the
3415 names may be equal despite there was a change. */
3416 if (old_fontset == FRAME_FONTSET (f))
3417 return;
3419 store_frame_param (f, Qfont, result);
3421 if (!NILP (Fequal (result, oldval)))
3422 return;
3424 /* Recalculate toolbar height. */
3425 f->n_tool_bar_rows = 0;
3426 /* Ensure we redraw it. */
3427 clear_current_matrices (f);
3429 recompute_basic_faces (f);
3431 else
3432 abort ();
3434 do_pending_window_change (0);
3436 /* Don't call `face-set-after-frame-default' when faces haven't been
3437 initialized yet. This is the case when called from
3438 Fx_create_frame. In that case, the X widget or window doesn't
3439 exist either, and we can end up in x_report_frame_params with a
3440 null widget which gives a segfault. */
3441 if (FRAME_FACE_CACHE (f))
3443 XSETFRAME (frame, f);
3444 call1 (Qface_set_after_frame_default, frame);
3449 #ifdef USE_FONT_BACKEND
3450 void
3451 x_set_font_backend (f, new_value, old_value)
3452 struct frame *f;
3453 Lisp_Object new_value, old_value;
3455 if (! NILP (new_value)
3456 && !CONSP (new_value))
3458 char *p0, *p1;
3460 CHECK_STRING (new_value);
3461 p0 = p1 = SDATA (new_value);
3462 new_value = Qnil;
3463 while (*p0)
3465 while (*p1 && *p1 != ',') p1++;
3466 if (p0 < p1)
3467 new_value = Fcons (Fintern (make_string (p0, p1 - p0), Qnil),
3468 new_value);
3469 if (*p1)
3470 p1++;
3471 p0 = p1;
3473 new_value = Fnreverse (new_value);
3476 if (! NILP (old_value) && ! NILP (Fequal (old_value, new_value)))
3477 return;
3479 if (FRAME_FONT_OBJECT (f))
3480 free_all_realized_faces (Qnil);
3482 new_value = font_update_drivers (f, NILP (new_value) ? Qt : new_value);
3483 if (NILP (new_value))
3485 if (NILP (old_value))
3486 error ("No font backend available");
3487 font_update_drivers (f, old_value);
3488 error ("None of specified font backends are available");
3490 store_frame_param (f, Qfont_backend, new_value);
3492 if (FRAME_FONT_OBJECT (f))
3494 Lisp_Object frame;
3496 XSETFRAME (frame, f);
3497 x_set_font (f, Fframe_parameter (frame, Qfont), Qnil);
3498 ++face_change_count;
3499 ++windows_or_buffers_changed;
3502 #endif /* USE_FONT_BACKEND */
3505 void
3506 x_set_fringe_width (f, new_value, old_value)
3507 struct frame *f;
3508 Lisp_Object new_value, old_value;
3510 compute_fringe_widths (f, 1);
3513 void
3514 x_set_border_width (f, arg, oldval)
3515 struct frame *f;
3516 Lisp_Object arg, oldval;
3518 CHECK_NUMBER (arg);
3520 if (XINT (arg) == f->border_width)
3521 return;
3523 if (FRAME_X_WINDOW (f) != 0)
3524 error ("Cannot change the border width of a frame");
3526 f->border_width = XINT (arg);
3529 void
3530 x_set_internal_border_width (f, arg, oldval)
3531 struct frame *f;
3532 Lisp_Object arg, oldval;
3534 int old = FRAME_INTERNAL_BORDER_WIDTH (f);
3536 CHECK_NUMBER (arg);
3537 FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
3538 if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
3539 FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
3541 #ifdef USE_X_TOOLKIT
3542 if (FRAME_X_OUTPUT (f)->edit_widget)
3543 widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
3544 #endif
3546 if (FRAME_INTERNAL_BORDER_WIDTH (f) == old)
3547 return;
3549 if (FRAME_X_WINDOW (f) != 0)
3551 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3552 SET_FRAME_GARBAGED (f);
3553 do_pending_window_change (0);
3555 else
3556 SET_FRAME_GARBAGED (f);
3559 void
3560 x_set_visibility (f, value, oldval)
3561 struct frame *f;
3562 Lisp_Object value, oldval;
3564 Lisp_Object frame;
3565 XSETFRAME (frame, f);
3567 if (NILP (value))
3568 Fmake_frame_invisible (frame, Qt);
3569 else if (EQ (value, Qicon))
3570 Ficonify_frame (frame);
3571 else
3572 Fmake_frame_visible (frame);
3575 void
3576 x_set_autoraise (f, arg, oldval)
3577 struct frame *f;
3578 Lisp_Object arg, oldval;
3580 f->auto_raise = !EQ (Qnil, arg);
3583 void
3584 x_set_autolower (f, arg, oldval)
3585 struct frame *f;
3586 Lisp_Object arg, oldval;
3588 f->auto_lower = !EQ (Qnil, arg);
3591 void
3592 x_set_unsplittable (f, arg, oldval)
3593 struct frame *f;
3594 Lisp_Object arg, oldval;
3596 f->no_split = !NILP (arg);
3599 void
3600 x_set_vertical_scroll_bars (f, arg, oldval)
3601 struct frame *f;
3602 Lisp_Object arg, oldval;
3604 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
3605 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
3606 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
3607 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
3609 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
3610 = (NILP (arg)
3611 ? vertical_scroll_bar_none
3612 : EQ (Qleft, arg)
3613 ? vertical_scroll_bar_left
3614 : EQ (Qright, arg)
3615 ? vertical_scroll_bar_right
3616 : EQ (Qleft, Vdefault_frame_scroll_bars)
3617 ? vertical_scroll_bar_left
3618 : EQ (Qright, Vdefault_frame_scroll_bars)
3619 ? vertical_scroll_bar_right
3620 : vertical_scroll_bar_none);
3622 /* We set this parameter before creating the X window for the
3623 frame, so we can get the geometry right from the start.
3624 However, if the window hasn't been created yet, we shouldn't
3625 call x_set_window_size. */
3626 if (FRAME_X_WINDOW (f))
3627 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3628 do_pending_window_change (0);
3632 void
3633 x_set_scroll_bar_width (f, arg, oldval)
3634 struct frame *f;
3635 Lisp_Object arg, oldval;
3637 int wid = FRAME_COLUMN_WIDTH (f);
3639 if (NILP (arg))
3641 x_set_scroll_bar_default_width (f);
3643 if (FRAME_X_WINDOW (f))
3644 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3645 do_pending_window_change (0);
3647 else if (INTEGERP (arg) && XINT (arg) > 0
3648 && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3650 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
3651 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
3653 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg);
3654 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
3655 if (FRAME_X_WINDOW (f))
3656 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3657 do_pending_window_change (0);
3660 change_frame_size (f, 0, FRAME_COLS (f), 0, 0, 0);
3661 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
3662 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
3667 /* Return non-nil if frame F wants a bitmap icon. */
3669 Lisp_Object
3670 x_icon_type (f)
3671 FRAME_PTR f;
3673 Lisp_Object tem;
3675 tem = assq_no_quit (Qicon_type, f->param_alist);
3676 if (CONSP (tem))
3677 return XCDR (tem);
3678 else
3679 return Qnil;
3683 /* Subroutines of creating an X frame. */
3685 /* Make sure that Vx_resource_name is set to a reasonable value.
3686 Fix it up, or set it to `emacs' if it is too hopeless. */
3688 void
3689 validate_x_resource_name ()
3691 int len = 0;
3692 /* Number of valid characters in the resource name. */
3693 int good_count = 0;
3694 /* Number of invalid characters in the resource name. */
3695 int bad_count = 0;
3696 Lisp_Object new;
3697 int i;
3699 if (!STRINGP (Vx_resource_class))
3700 Vx_resource_class = build_string (EMACS_CLASS);
3702 if (STRINGP (Vx_resource_name))
3704 unsigned char *p = SDATA (Vx_resource_name);
3705 int i;
3707 len = SBYTES (Vx_resource_name);
3709 /* Only letters, digits, - and _ are valid in resource names.
3710 Count the valid characters and count the invalid ones. */
3711 for (i = 0; i < len; i++)
3713 int c = p[i];
3714 if (! ((c >= 'a' && c <= 'z')
3715 || (c >= 'A' && c <= 'Z')
3716 || (c >= '0' && c <= '9')
3717 || c == '-' || c == '_'))
3718 bad_count++;
3719 else
3720 good_count++;
3723 else
3724 /* Not a string => completely invalid. */
3725 bad_count = 5, good_count = 0;
3727 /* If name is valid already, return. */
3728 if (bad_count == 0)
3729 return;
3731 /* If name is entirely invalid, or nearly so, use `emacs'. */
3732 if (good_count == 0
3733 || (good_count == 1 && bad_count > 0))
3735 Vx_resource_name = build_string ("emacs");
3736 return;
3739 /* Name is partly valid. Copy it and replace the invalid characters
3740 with underscores. */
3742 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
3744 for (i = 0; i < len; i++)
3746 int c = SREF (new, i);
3747 if (! ((c >= 'a' && c <= 'z')
3748 || (c >= 'A' && c <= 'Z')
3749 || (c >= '0' && c <= '9')
3750 || c == '-' || c == '_'))
3751 SSET (new, i, '_');
3756 extern char *x_get_string_resource P_ ((XrmDatabase, char *, char *));
3757 extern Display_Info *check_x_display_info P_ ((Lisp_Object));
3760 /* Get specified attribute from resource database RDB.
3761 See Fx_get_resource below for other parameters. */
3763 static Lisp_Object
3764 xrdb_get_resource (rdb, attribute, class, component, subclass)
3765 XrmDatabase rdb;
3766 Lisp_Object attribute, class, component, subclass;
3768 register char *value;
3769 char *name_key;
3770 char *class_key;
3772 CHECK_STRING (attribute);
3773 CHECK_STRING (class);
3775 if (!NILP (component))
3776 CHECK_STRING (component);
3777 if (!NILP (subclass))
3778 CHECK_STRING (subclass);
3779 if (NILP (component) != NILP (subclass))
3780 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3782 validate_x_resource_name ();
3784 /* Allocate space for the components, the dots which separate them,
3785 and the final '\0'. Make them big enough for the worst case. */
3786 name_key = (char *) alloca (SBYTES (Vx_resource_name)
3787 + (STRINGP (component)
3788 ? SBYTES (component) : 0)
3789 + SBYTES (attribute)
3790 + 3);
3792 class_key = (char *) alloca (SBYTES (Vx_resource_class)
3793 + SBYTES (class)
3794 + (STRINGP (subclass)
3795 ? SBYTES (subclass) : 0)
3796 + 3);
3798 /* Start with emacs.FRAMENAME for the name (the specific one)
3799 and with `Emacs' for the class key (the general one). */
3800 strcpy (name_key, SDATA (Vx_resource_name));
3801 strcpy (class_key, SDATA (Vx_resource_class));
3803 strcat (class_key, ".");
3804 strcat (class_key, SDATA (class));
3806 if (!NILP (component))
3808 strcat (class_key, ".");
3809 strcat (class_key, SDATA (subclass));
3811 strcat (name_key, ".");
3812 strcat (name_key, SDATA (component));
3815 strcat (name_key, ".");
3816 strcat (name_key, SDATA (attribute));
3818 value = x_get_string_resource (rdb, name_key, class_key);
3820 if (value != (char *) 0)
3821 return build_string (value);
3822 else
3823 return Qnil;
3827 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
3828 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
3829 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
3830 class, where INSTANCE is the name under which Emacs was invoked, or
3831 the name specified by the `-name' or `-rn' command-line arguments.
3833 The optional arguments COMPONENT and SUBCLASS add to the key and the
3834 class, respectively. You must specify both of them or neither.
3835 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
3836 and the class is `Emacs.CLASS.SUBCLASS'. */)
3837 (attribute, class, component, subclass)
3838 Lisp_Object attribute, class, component, subclass;
3840 #ifdef HAVE_X_WINDOWS
3841 check_x ();
3842 #endif
3844 return xrdb_get_resource (check_x_display_info (Qnil)->xrdb,
3845 attribute, class, component, subclass);
3848 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
3850 Lisp_Object
3851 display_x_get_resource (dpyinfo, attribute, class, component, subclass)
3852 Display_Info *dpyinfo;
3853 Lisp_Object attribute, class, component, subclass;
3855 return xrdb_get_resource (dpyinfo->xrdb,
3856 attribute, class, component, subclass);
3859 /* Used when C code wants a resource value. */
3861 char *
3862 x_get_resource_string (attribute, class)
3863 char *attribute, *class;
3865 char *name_key;
3866 char *class_key;
3867 struct frame *sf = SELECTED_FRAME ();
3869 /* Allocate space for the components, the dots which separate them,
3870 and the final '\0'. */
3871 name_key = (char *) alloca (SBYTES (Vinvocation_name)
3872 + strlen (attribute) + 2);
3873 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
3874 + strlen (class) + 2);
3876 sprintf (name_key, "%s.%s", SDATA (Vinvocation_name), attribute);
3877 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3879 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
3880 name_key, class_key);
3884 /* Return the value of parameter PARAM.
3886 First search ALIST, then Vdefault_frame_alist, then the X defaults
3887 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3889 Convert the resource to the type specified by desired_type.
3891 If no default is specified, return Qunbound. If you call
3892 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3893 and don't let it get stored in any Lisp-visible variables! */
3895 Lisp_Object
3896 x_get_arg (dpyinfo, alist, param, attribute, class, type)
3897 Display_Info *dpyinfo;
3898 Lisp_Object alist, param;
3899 char *attribute;
3900 char *class;
3901 enum resource_types type;
3903 register Lisp_Object tem;
3905 tem = Fassq (param, alist);
3907 if (!NILP (tem))
3909 /* If we find this parm in ALIST, clear it out
3910 so that it won't be "left over" at the end. */
3911 #ifndef WINDOWSNT /* w32fns.c has not yet been changed to cope with this. */
3912 Lisp_Object tail;
3913 XSETCAR (tem, Qnil);
3914 /* In case the parameter appears more than once in the alist,
3915 clear it out. */
3916 for (tail = alist; CONSP (tail); tail = XCDR (tail))
3917 if (CONSP (XCAR (tail))
3918 && EQ (XCAR (XCAR (tail)), param))
3919 XSETCAR (XCAR (tail), Qnil);
3920 #endif
3922 else
3923 tem = Fassq (param, Vdefault_frame_alist);
3925 /* If it wasn't specified in ALIST or the Lisp-level defaults,
3926 look in the X resources. */
3927 if (EQ (tem, Qnil))
3929 if (attribute)
3931 tem = display_x_get_resource (dpyinfo,
3932 build_string (attribute),
3933 build_string (class),
3934 Qnil, Qnil);
3936 if (NILP (tem))
3937 return Qunbound;
3939 switch (type)
3941 case RES_TYPE_NUMBER:
3942 return make_number (atoi (SDATA (tem)));
3944 case RES_TYPE_FLOAT:
3945 return make_float (atof (SDATA (tem)));
3947 case RES_TYPE_BOOLEAN:
3948 tem = Fdowncase (tem);
3949 if (!strcmp (SDATA (tem), "on")
3950 || !strcmp (SDATA (tem), "true"))
3951 return Qt;
3952 else
3953 return Qnil;
3955 case RES_TYPE_STRING:
3956 return tem;
3958 case RES_TYPE_SYMBOL:
3959 /* As a special case, we map the values `true' and `on'
3960 to Qt, and `false' and `off' to Qnil. */
3962 Lisp_Object lower;
3963 lower = Fdowncase (tem);
3964 if (!strcmp (SDATA (lower), "on")
3965 || !strcmp (SDATA (lower), "true"))
3966 return Qt;
3967 else if (!strcmp (SDATA (lower), "off")
3968 || !strcmp (SDATA (lower), "false"))
3969 return Qnil;
3970 else
3971 return Fintern (tem, Qnil);
3974 default:
3975 abort ();
3978 else
3979 return Qunbound;
3981 return Fcdr (tem);
3984 Lisp_Object
3985 x_frame_get_arg (f, alist, param, attribute, class, type)
3986 struct frame *f;
3987 Lisp_Object alist, param;
3988 char *attribute;
3989 char *class;
3990 enum resource_types type;
3992 return x_get_arg (FRAME_X_DISPLAY_INFO (f),
3993 alist, param, attribute, class, type);
3996 /* Like x_frame_get_arg, but also record the value in f->param_alist. */
3998 Lisp_Object
3999 x_frame_get_and_record_arg (f, alist, param, attribute, class, type)
4000 struct frame *f;
4001 Lisp_Object alist, param;
4002 char *attribute;
4003 char *class;
4004 enum resource_types type;
4006 Lisp_Object value;
4008 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
4009 attribute, class, type);
4010 if (! NILP (value) && ! EQ (value, Qunbound))
4011 store_frame_param (f, param, value);
4013 return value;
4017 /* Record in frame F the specified or default value according to ALIST
4018 of the parameter named PROP (a Lisp symbol).
4019 If no value is specified for PROP, look for an X default for XPROP
4020 on the frame named NAME.
4021 If that is not found either, use the value DEFLT. */
4023 Lisp_Object
4024 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
4025 struct frame *f;
4026 Lisp_Object alist;
4027 Lisp_Object prop;
4028 Lisp_Object deflt;
4029 char *xprop;
4030 char *xclass;
4031 enum resource_types type;
4033 Lisp_Object tem;
4035 tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type);
4036 if (EQ (tem, Qunbound))
4037 tem = deflt;
4038 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
4039 return tem;
4045 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
4046 doc: /* Parse an X-style geometry string STRING.
4047 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
4048 The properties returned may include `top', `left', `height', and `width'.
4049 The value of `left' or `top' may be an integer,
4050 or a list (+ N) meaning N pixels relative to top/left corner,
4051 or a list (- N) meaning -N pixels relative to bottom/right corner. */)
4052 (string)
4053 Lisp_Object string;
4055 int geometry, x, y;
4056 unsigned int width, height;
4057 Lisp_Object result;
4059 CHECK_STRING (string);
4061 geometry = XParseGeometry ((char *) SDATA (string),
4062 &x, &y, &width, &height);
4064 #if 0
4065 if (!!(geometry & XValue) != !!(geometry & YValue))
4066 error ("Must specify both x and y position, or neither");
4067 #endif
4069 result = Qnil;
4070 if (geometry & XValue)
4072 Lisp_Object element;
4074 if (x >= 0 && (geometry & XNegative))
4075 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
4076 else if (x < 0 && ! (geometry & XNegative))
4077 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
4078 else
4079 element = Fcons (Qleft, make_number (x));
4080 result = Fcons (element, result);
4083 if (geometry & YValue)
4085 Lisp_Object element;
4087 if (y >= 0 && (geometry & YNegative))
4088 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
4089 else if (y < 0 && ! (geometry & YNegative))
4090 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
4091 else
4092 element = Fcons (Qtop, make_number (y));
4093 result = Fcons (element, result);
4096 if (geometry & WidthValue)
4097 result = Fcons (Fcons (Qwidth, make_number (width)), result);
4098 if (geometry & HeightValue)
4099 result = Fcons (Fcons (Qheight, make_number (height)), result);
4101 return result;
4104 /* Calculate the desired size and position of frame F.
4105 Return the flags saying which aspects were specified.
4107 Also set the win_gravity and size_hint_flags of F.
4109 Adjust height for toolbar if TOOLBAR_P is 1.
4111 This function does not make the coordinates positive. */
4113 #define DEFAULT_ROWS 40
4114 #define DEFAULT_COLS 80
4117 x_figure_window_size (f, parms, toolbar_p)
4118 struct frame *f;
4119 Lisp_Object parms;
4120 int toolbar_p;
4122 register Lisp_Object tem0, tem1, tem2;
4123 long window_prompting = 0;
4124 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
4126 /* Default values if we fall through.
4127 Actually, if that happens we should get
4128 window manager prompting. */
4129 SET_FRAME_COLS (f, DEFAULT_COLS);
4130 FRAME_LINES (f) = DEFAULT_ROWS;
4131 /* Window managers expect that if program-specified
4132 positions are not (0,0), they're intentional, not defaults. */
4133 f->top_pos = 0;
4134 f->left_pos = 0;
4136 /* Ensure that old new_text_cols and new_text_lines will not override the
4137 values set here. */
4138 /* ++KFS: This was specific to W32, but seems ok for all platforms */
4139 f->new_text_cols = f->new_text_lines = 0;
4141 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
4142 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
4143 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
4144 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4146 if (!EQ (tem0, Qunbound))
4148 CHECK_NUMBER (tem0);
4149 FRAME_LINES (f) = XINT (tem0);
4151 if (!EQ (tem1, Qunbound))
4153 CHECK_NUMBER (tem1);
4154 SET_FRAME_COLS (f, XINT (tem1));
4156 if (!NILP (tem2) && !EQ (tem2, Qunbound))
4157 window_prompting |= USSize;
4158 else
4159 window_prompting |= PSize;
4162 f->scroll_bar_actual_width
4163 = FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f);
4165 /* This used to be done _before_ calling x_figure_window_size, but
4166 since the height is reset here, this was really a no-op. I
4167 assume that moving it here does what Gerd intended (although he
4168 no longer can remember what that was... ++KFS, 2003-03-25. */
4170 /* Add the tool-bar height to the initial frame height so that the
4171 user gets a text display area of the size he specified with -g or
4172 via .Xdefaults. Later changes of the tool-bar height don't
4173 change the frame size. This is done so that users can create
4174 tall Emacs frames without having to guess how tall the tool-bar
4175 will get. */
4176 if (toolbar_p && FRAME_TOOL_BAR_LINES (f))
4178 int margin, relief, bar_height;
4180 relief = (tool_bar_button_relief >= 0
4181 ? tool_bar_button_relief
4182 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
4184 if (INTEGERP (Vtool_bar_button_margin)
4185 && XINT (Vtool_bar_button_margin) > 0)
4186 margin = XFASTINT (Vtool_bar_button_margin);
4187 else if (CONSP (Vtool_bar_button_margin)
4188 && INTEGERP (XCDR (Vtool_bar_button_margin))
4189 && XINT (XCDR (Vtool_bar_button_margin)) > 0)
4190 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
4191 else
4192 margin = 0;
4194 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
4195 FRAME_LINES (f) += (bar_height + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f);
4198 compute_fringe_widths (f, 0);
4200 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, FRAME_COLS (f));
4201 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, FRAME_LINES (f));
4203 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
4204 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
4205 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
4206 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4208 if (EQ (tem0, Qminus))
4210 f->top_pos = 0;
4211 window_prompting |= YNegative;
4213 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
4214 && CONSP (XCDR (tem0))
4215 && INTEGERP (XCAR (XCDR (tem0))))
4217 f->top_pos = - XINT (XCAR (XCDR (tem0)));
4218 window_prompting |= YNegative;
4220 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
4221 && CONSP (XCDR (tem0))
4222 && INTEGERP (XCAR (XCDR (tem0))))
4224 f->top_pos = XINT (XCAR (XCDR (tem0)));
4226 else if (EQ (tem0, Qunbound))
4227 f->top_pos = 0;
4228 else
4230 CHECK_NUMBER (tem0);
4231 f->top_pos = XINT (tem0);
4232 if (f->top_pos < 0)
4233 window_prompting |= YNegative;
4236 if (EQ (tem1, Qminus))
4238 f->left_pos = 0;
4239 window_prompting |= XNegative;
4241 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
4242 && CONSP (XCDR (tem1))
4243 && INTEGERP (XCAR (XCDR (tem1))))
4245 f->left_pos = - XINT (XCAR (XCDR (tem1)));
4246 window_prompting |= XNegative;
4248 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
4249 && CONSP (XCDR (tem1))
4250 && INTEGERP (XCAR (XCDR (tem1))))
4252 f->left_pos = XINT (XCAR (XCDR (tem1)));
4254 else if (EQ (tem1, Qunbound))
4255 f->left_pos = 0;
4256 else
4258 CHECK_NUMBER (tem1);
4259 f->left_pos = XINT (tem1);
4260 if (f->left_pos < 0)
4261 window_prompting |= XNegative;
4264 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
4265 window_prompting |= USPosition;
4266 else
4267 window_prompting |= PPosition;
4270 if (f->want_fullscreen != FULLSCREEN_NONE)
4272 int left, top;
4273 int width, height;
4275 /* It takes both for some WM:s to place it where we want */
4276 window_prompting |= USPosition | PPosition;
4277 x_fullscreen_adjust (f, &width, &height, &top, &left);
4278 FRAME_COLS (f) = width;
4279 FRAME_LINES (f) = height;
4280 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, width);
4281 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, height);
4282 f->left_pos = left;
4283 f->top_pos = top;
4286 if (window_prompting & XNegative)
4288 if (window_prompting & YNegative)
4289 f->win_gravity = SouthEastGravity;
4290 else
4291 f->win_gravity = NorthEastGravity;
4293 else
4295 if (window_prompting & YNegative)
4296 f->win_gravity = SouthWestGravity;
4297 else
4298 f->win_gravity = NorthWestGravity;
4301 f->size_hint_flags = window_prompting;
4303 return window_prompting;
4308 #endif /* HAVE_WINDOW_SYSTEM */
4312 /***********************************************************************
4313 Initialization
4314 ***********************************************************************/
4316 void
4317 syms_of_frame ()
4319 Qframep = intern ("framep");
4320 staticpro (&Qframep);
4321 Qframe_live_p = intern ("frame-live-p");
4322 staticpro (&Qframe_live_p);
4323 Qexplicit_name = intern ("explicit-name");
4324 staticpro (&Qexplicit_name);
4325 Qheight = intern ("height");
4326 staticpro (&Qheight);
4327 Qicon = intern ("icon");
4328 staticpro (&Qicon);
4329 Qminibuffer = intern ("minibuffer");
4330 staticpro (&Qminibuffer);
4331 Qmodeline = intern ("modeline");
4332 staticpro (&Qmodeline);
4333 Qonly = intern ("only");
4334 staticpro (&Qonly);
4335 Qwidth = intern ("width");
4336 staticpro (&Qwidth);
4337 Qgeometry = intern ("geometry");
4338 staticpro (&Qgeometry);
4339 Qicon_left = intern ("icon-left");
4340 staticpro (&Qicon_left);
4341 Qicon_top = intern ("icon-top");
4342 staticpro (&Qicon_top);
4343 Qleft = intern ("left");
4344 staticpro (&Qleft);
4345 Qright = intern ("right");
4346 staticpro (&Qright);
4347 Quser_position = intern ("user-position");
4348 staticpro (&Quser_position);
4349 Quser_size = intern ("user-size");
4350 staticpro (&Quser_size);
4351 Qwindow_id = intern ("window-id");
4352 staticpro (&Qwindow_id);
4353 #ifdef HAVE_X_WINDOWS
4354 Qouter_window_id = intern ("outer-window-id");
4355 staticpro (&Qouter_window_id);
4356 #endif
4357 Qparent_id = intern ("parent-id");
4358 staticpro (&Qparent_id);
4359 Qx = intern ("x");
4360 staticpro (&Qx);
4361 Qw32 = intern ("w32");
4362 staticpro (&Qw32);
4363 Qpc = intern ("pc");
4364 staticpro (&Qpc);
4365 Qmac = intern ("mac");
4366 staticpro (&Qmac);
4367 Qvisible = intern ("visible");
4368 staticpro (&Qvisible);
4369 Qbuffer_predicate = intern ("buffer-predicate");
4370 staticpro (&Qbuffer_predicate);
4371 Qbuffer_list = intern ("buffer-list");
4372 staticpro (&Qbuffer_list);
4373 Qburied_buffer_list = intern ("buried-buffer-list");
4374 staticpro (&Qburied_buffer_list);
4375 Qdisplay_type = intern ("display-type");
4376 staticpro (&Qdisplay_type);
4377 Qbackground_mode = intern ("background-mode");
4378 staticpro (&Qbackground_mode);
4379 Qnoelisp = intern ("noelisp");
4380 staticpro (&Qnoelisp);
4381 Qtty_color_mode = intern ("tty-color-mode");
4382 staticpro (&Qtty_color_mode);
4383 Qtty = intern ("tty");
4384 staticpro (&Qtty);
4385 Qtty_type = intern ("tty-type");
4386 staticpro (&Qtty_type);
4388 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
4389 staticpro (&Qface_set_after_frame_default);
4391 Qinhibit_face_set_after_frame_default
4392 = intern ("inhibit-face-set-after-frame-default");
4393 staticpro (&Qinhibit_face_set_after_frame_default);
4395 Qfullwidth = intern ("fullwidth");
4396 staticpro (&Qfullwidth);
4397 Qfullheight = intern ("fullheight");
4398 staticpro (&Qfullheight);
4399 Qfullboth = intern ("fullboth");
4400 staticpro (&Qfullboth);
4401 Qx_resource_name = intern ("x-resource-name");
4402 staticpro (&Qx_resource_name);
4404 Qx_frame_parameter = intern ("x-frame-parameter");
4405 staticpro (&Qx_frame_parameter);
4407 Qterminal = intern ("terminal");
4408 staticpro (&Qterminal);
4409 Qterminal_live_p = intern ("terminal-live-p");
4410 staticpro (&Qterminal_live_p);
4413 int i;
4415 for (i = 0; i < sizeof (frame_parms) / sizeof (frame_parms[0]); i++)
4417 Lisp_Object v = intern (frame_parms[i].name);
4418 if (frame_parms[i].variable)
4420 *frame_parms[i].variable = v;
4421 staticpro (frame_parms[i].variable);
4423 Fput (v, Qx_frame_parameter, make_number (i));
4427 #ifdef HAVE_WINDOW_SYSTEM
4428 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
4429 doc: /* The name Emacs uses to look up X resources.
4430 `x-get-resource' uses this as the first component of the instance name
4431 when requesting resource values.
4432 Emacs initially sets `x-resource-name' to the name under which Emacs
4433 was invoked, or to the value specified with the `-name' or `-rn'
4434 switches, if present.
4436 It may be useful to bind this variable locally around a call
4437 to `x-get-resource'. See also the variable `x-resource-class'. */);
4438 Vx_resource_name = Qnil;
4440 DEFVAR_LISP ("x-resource-class", &Vx_resource_class,
4441 doc: /* The class Emacs uses to look up X resources.
4442 `x-get-resource' uses this as the first component of the instance class
4443 when requesting resource values.
4445 Emacs initially sets `x-resource-class' to "Emacs".
4447 Setting this variable permanently is not a reasonable thing to do,
4448 but binding this variable locally around a call to `x-get-resource'
4449 is a reasonable practice. See also the variable `x-resource-name'. */);
4450 Vx_resource_class = build_string (EMACS_CLASS);
4451 #endif
4453 DEFVAR_LISP ("default-frame-alist", &Vdefault_frame_alist,
4454 doc: /* Alist of default values for frame creation.
4455 These may be set in your init file, like this:
4456 (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1)))
4457 These override values given in window system configuration data,
4458 including X Windows' defaults database.
4459 For values specific to the first Emacs frame, see `initial-frame-alist'.
4460 For window-system specific values, see `window-system-default-frame-alist'.
4461 For values specific to the separate minibuffer frame, see
4462 `minibuffer-frame-alist'.
4463 The `menu-bar-lines' element of the list controls whether new frames
4464 have menu bars; `menu-bar-mode' works by altering this element.
4465 Setting this variable does not affect existing frames, only new ones. */);
4466 Vdefault_frame_alist = Qnil;
4468 DEFVAR_LISP ("default-frame-scroll-bars", &Vdefault_frame_scroll_bars,
4469 doc: /* Default position of scroll bars on this window-system. */);
4470 #ifdef HAVE_WINDOW_SYSTEM
4471 #if defined(HAVE_NTGUI) || defined(MAC_OS)
4472 /* MS-Windows has scroll bars on the right by default. */
4473 Vdefault_frame_scroll_bars = Qright;
4474 #else
4475 Vdefault_frame_scroll_bars = Qleft;
4476 #endif
4477 #else
4478 Vdefault_frame_scroll_bars = Qnil;
4479 #endif
4481 DEFVAR_LISP ("terminal-frame", &Vterminal_frame,
4482 doc: /* The initial frame-object, which represents Emacs's stdout. */);
4484 DEFVAR_LISP ("emacs-iconified", &Vemacs_iconified,
4485 doc: /* Non-nil if all of Emacs is iconified and frame updates are not needed. */);
4486 Vemacs_iconified = Qnil;
4488 DEFVAR_LISP ("mouse-position-function", &Vmouse_position_function,
4489 doc: /* If non-nil, function to transform normal value of `mouse-position'.
4490 `mouse-position' calls this function, passing its usual return value as
4491 argument, and returns whatever this function returns.
4492 This abnormal hook exists for the benefit of packages like `xt-mouse.el'
4493 which need to do mouse handling at the Lisp level. */);
4494 Vmouse_position_function = Qnil;
4496 DEFVAR_LISP ("mouse-highlight", &Vmouse_highlight,
4497 doc: /* If non-nil, clickable text is highlighted when mouse is over it.
4498 If the value is an integer, highlighting is only shown after moving the
4499 mouse, while keyboard input turns off the highlight even when the mouse
4500 is over the clickable text. However, the mouse shape still indicates
4501 when the mouse is over clickable text. */);
4502 Vmouse_highlight = Qt;
4504 DEFVAR_LISP ("delete-frame-functions", &Vdelete_frame_functions,
4505 doc: /* Functions to be run before deleting a frame.
4506 The functions are run with one arg, the frame to be deleted.
4507 See `delete-frame'.
4509 Note that functions in this list may be called just before the frame is
4510 actually deleted, or some time later (or even both when an earlier function
4511 in `delete-frame-functions' (indirectly) calls `delete-frame'
4512 recursively). */);
4513 Vdelete_frame_functions = Qnil;
4514 Qdelete_frame_functions = intern ("delete-frame-functions");
4515 staticpro (&Qdelete_frame_functions);
4517 DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
4518 doc: /* Minibufferless frames use this frame's minibuffer.
4520 Emacs cannot create minibufferless frames unless this is set to an
4521 appropriate surrogate.
4523 Emacs consults this variable only when creating minibufferless
4524 frames; once the frame is created, it sticks with its assigned
4525 minibuffer, no matter what this variable is set to. This means that
4526 this variable doesn't necessarily say anything meaningful about the
4527 current set of frames, or where the minibuffer is currently being
4528 displayed.
4530 This variable is local to the current terminal and cannot be buffer-local. */);
4532 DEFVAR_BOOL ("focus-follows-mouse", &focus_follows_mouse,
4533 doc: /* Non-nil if window system changes focus when you move the mouse.
4534 You should set this variable to tell Emacs how your window manager
4535 handles focus, since there is no way in general for Emacs to find out
4536 automatically. */);
4537 #ifdef HAVE_WINDOW_SYSTEM
4538 #if defined(HAVE_NTGUI) || defined(MAC_OS)
4539 focus_follows_mouse = 0;
4540 #else
4541 focus_follows_mouse = 1;
4542 #endif
4543 #else
4544 focus_follows_mouse = 0;
4545 #endif
4547 staticpro (&Vframe_list);
4549 defsubr (&Sactive_minibuffer_window);
4550 defsubr (&Sframep);
4551 defsubr (&Sframe_live_p);
4552 defsubr (&Swindow_system);
4553 defsubr (&Smake_terminal_frame);
4554 defsubr (&Shandle_switch_frame);
4555 defsubr (&Sselect_frame);
4556 defsubr (&Sselected_frame);
4557 defsubr (&Swindow_frame);
4558 defsubr (&Sframe_root_window);
4559 defsubr (&Sframe_first_window);
4560 defsubr (&Sframe_selected_window);
4561 defsubr (&Sset_frame_selected_window);
4562 defsubr (&Sframe_list);
4563 defsubr (&Snext_frame);
4564 defsubr (&Sprevious_frame);
4565 defsubr (&Sdelete_frame);
4566 defsubr (&Smouse_position);
4567 defsubr (&Smouse_pixel_position);
4568 defsubr (&Sset_mouse_position);
4569 defsubr (&Sset_mouse_pixel_position);
4570 #if 0
4571 defsubr (&Sframe_configuration);
4572 defsubr (&Srestore_frame_configuration);
4573 #endif
4574 defsubr (&Smake_frame_visible);
4575 defsubr (&Smake_frame_invisible);
4576 defsubr (&Siconify_frame);
4577 defsubr (&Sframe_visible_p);
4578 defsubr (&Svisible_frame_list);
4579 defsubr (&Sraise_frame);
4580 defsubr (&Slower_frame);
4581 defsubr (&Sredirect_frame_focus);
4582 defsubr (&Sframe_focus);
4583 defsubr (&Sframe_parameters);
4584 defsubr (&Sframe_parameter);
4585 defsubr (&Smodify_frame_parameters);
4586 defsubr (&Sframe_char_height);
4587 defsubr (&Sframe_char_width);
4588 defsubr (&Sframe_pixel_height);
4589 defsubr (&Sframe_pixel_width);
4590 defsubr (&Sset_frame_height);
4591 defsubr (&Sset_frame_width);
4592 defsubr (&Sset_frame_size);
4593 defsubr (&Sset_frame_position);
4595 #ifdef HAVE_WINDOW_SYSTEM
4596 defsubr (&Sx_get_resource);
4597 defsubr (&Sx_parse_geometry);
4598 #endif
4602 /* arch-tag: 7dbf2c69-9aad-45f8-8296-db893d6dd039
4603 (do not change this comment) */