New VC in the NEWS.
[emacs.git] / src / frame.c
blob3709b00dfd6eabcbd65dfca71090f946290bfd39
1 /* Generic frame functions.
2 Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2002, 2003,
3 2004, 2005, 2006, 2007 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 "charset.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 /* The name we're using in resource queries. Most often "emacs". */
59 Lisp_Object Vx_resource_name;
61 /* The application class we're using in resource queries.
62 Normally "Emacs". */
64 Lisp_Object Vx_resource_class;
66 #endif
68 Lisp_Object Qframep, Qframe_live_p;
69 Lisp_Object Qicon, Qmodeline;
70 Lisp_Object Qonly;
71 Lisp_Object Qx, Qw32, Qmac, Qpc;
72 Lisp_Object Qvisible;
73 Lisp_Object Qdisplay_type;
74 Lisp_Object Qbackground_mode;
76 Lisp_Object Qx_frame_parameter;
77 Lisp_Object Qx_resource_name;
78 Lisp_Object Qterminal;
79 Lisp_Object Qterminal_live_p;
81 /* Frame parameters (set or reported). */
83 Lisp_Object Qauto_raise, Qauto_lower;
84 Lisp_Object Qborder_color, Qborder_width;
85 Lisp_Object Qcursor_color, Qcursor_type;
86 Lisp_Object Qgeometry; /* Not used */
87 Lisp_Object Qheight, Qwidth;
88 Lisp_Object Qleft, Qright;
89 Lisp_Object Qicon_left, Qicon_top, Qicon_type, Qicon_name;
90 Lisp_Object Qinternal_border_width;
91 Lisp_Object Qmouse_color;
92 Lisp_Object Qminibuffer;
93 Lisp_Object Qscroll_bar_width, Qvertical_scroll_bars;
94 Lisp_Object Qvisibility;
95 Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
96 Lisp_Object Qscreen_gamma;
97 Lisp_Object Qline_spacing;
98 Lisp_Object Quser_position, Quser_size;
99 Lisp_Object Qwait_for_wm;
100 Lisp_Object Qwindow_id;
101 #ifdef HAVE_X_WINDOWS
102 Lisp_Object Qouter_window_id;
103 #endif
104 Lisp_Object Qparent_id;
105 Lisp_Object Qtitle, Qname;
106 Lisp_Object Qunsplittable;
107 Lisp_Object Qmenu_bar_lines, Qtool_bar_lines;
108 Lisp_Object Qleft_fringe, Qright_fringe;
109 Lisp_Object Qbuffer_predicate, Qbuffer_list, Qburied_buffer_list;
110 Lisp_Object Qtty_color_mode;
111 Lisp_Object Qtty, Qtty_type;
112 Lisp_Object Qwindow_system;
113 Lisp_Object Qenvironment;
115 Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth;
117 Lisp_Object Qinhibit_face_set_after_frame_default;
118 Lisp_Object Qface_set_after_frame_default;
120 Lisp_Object Vterminal_frame;
121 Lisp_Object Vdefault_frame_alist;
122 Lisp_Object Vdefault_frame_scroll_bars;
123 Lisp_Object Vmouse_position_function;
124 Lisp_Object Vmouse_highlight;
125 Lisp_Object Vdelete_frame_functions;
127 int focus_follows_mouse;
129 static void
130 set_menu_bar_lines_1 (window, n)
131 Lisp_Object window;
132 int n;
134 struct window *w = XWINDOW (window);
136 XSETFASTINT (w->last_modified, 0);
137 XSETFASTINT (w->top_line, XFASTINT (w->top_line) + n);
138 XSETFASTINT (w->total_lines, XFASTINT (w->total_lines) - n);
140 if (INTEGERP (w->orig_top_line))
141 XSETFASTINT (w->orig_top_line, XFASTINT (w->orig_top_line) + n);
142 if (INTEGERP (w->orig_total_lines))
143 XSETFASTINT (w->orig_total_lines, XFASTINT (w->orig_total_lines) - n);
145 /* Handle just the top child in a vertical split. */
146 if (!NILP (w->vchild))
147 set_menu_bar_lines_1 (w->vchild, n);
149 /* Adjust all children in a horizontal split. */
150 for (window = w->hchild; !NILP (window); window = w->next)
152 w = XWINDOW (window);
153 set_menu_bar_lines_1 (window, n);
157 void
158 set_menu_bar_lines (f, value, oldval)
159 struct frame *f;
160 Lisp_Object value, oldval;
162 int nlines;
163 int olines = FRAME_MENU_BAR_LINES (f);
165 /* Right now, menu bars don't work properly in minibuf-only frames;
166 most of the commands try to apply themselves to the minibuffer
167 frame itself, and get an error because you can't switch buffers
168 in or split the minibuffer window. */
169 if (FRAME_MINIBUF_ONLY_P (f))
170 return;
172 if (INTEGERP (value))
173 nlines = XINT (value);
174 else
175 nlines = 0;
177 if (nlines != olines)
179 windows_or_buffers_changed++;
180 FRAME_WINDOW_SIZES_CHANGED (f) = 1;
181 FRAME_MENU_BAR_LINES (f) = nlines;
182 set_menu_bar_lines_1 (f->root_window, nlines - olines);
183 adjust_glyphs (f);
187 Lisp_Object Vemacs_iconified;
188 Lisp_Object Vframe_list;
190 extern Lisp_Object Vminibuffer_list;
191 extern Lisp_Object get_minibuffer ();
192 extern Lisp_Object Fhandle_switch_frame ();
193 extern Lisp_Object Fredirect_frame_focus ();
194 extern Lisp_Object x_get_focus_frame ();
196 DEFUN ("framep", Fframep, Sframep, 1, 1, 0,
197 doc: /* Return non-nil if OBJECT is a frame.
198 Value is t for a termcap frame (a character-only terminal),
199 `x' for an Emacs frame that is really an X window,
200 `w32' for an Emacs frame that is a window on MS-Windows display,
201 `mac' for an Emacs frame on a Macintosh display,
202 `pc' for a direct-write MS-DOS frame.
203 See also `frame-live-p'. */)
204 (object)
205 Lisp_Object object;
207 if (!FRAMEP (object))
208 return Qnil;
209 switch (XFRAME (object)->output_method)
211 case output_initial: /* The initial frame is like a termcap frame. */
212 case output_termcap:
213 return Qt;
214 case output_x_window:
215 return Qx;
216 case output_w32:
217 return Qw32;
218 case output_msdos_raw:
219 return Qpc;
220 case output_mac:
221 return Qmac;
222 default:
223 abort ();
227 DEFUN ("frame-live-p", Fframe_live_p, Sframe_live_p, 1, 1, 0,
228 doc: /* Return non-nil if OBJECT is a frame which has not been deleted.
229 Value is nil if OBJECT is not a live frame. If object is a live
230 frame, the return value indicates what sort of terminal device it is
231 displayed on. See the documentation of `framep' for possible
232 return values. */)
233 (object)
234 Lisp_Object object;
236 return ((FRAMEP (object)
237 && FRAME_LIVE_P (XFRAME (object)))
238 ? Fframep (object)
239 : Qnil);
242 DEFUN ("window-system", Fwindow_system, Swindow_system, 0, 1, 0,
243 doc: /* The name of the window system that FRAME is displaying through.
244 The value is a symbol---for instance, 'x' for X windows.
245 The value is nil if Emacs is using a text-only terminal.
247 FRAME defaults to the currently selected frame. */)
248 (frame)
249 Lisp_Object frame;
251 Lisp_Object type;
252 if (NILP (frame))
253 frame = selected_frame;
255 type = Fframep (frame);
257 if (NILP (type))
258 wrong_type_argument (Qframep, frame);
260 if (EQ (type, Qt))
261 return Qnil;
262 else
263 return type;
266 struct frame *
267 make_frame (mini_p)
268 int mini_p;
270 Lisp_Object frame;
271 register struct frame *f;
272 register Lisp_Object root_window;
273 register Lisp_Object mini_window;
275 f = allocate_frame ();
276 XSETFRAME (frame, f);
278 f->desired_matrix = 0;
279 f->current_matrix = 0;
280 f->desired_pool = 0;
281 f->current_pool = 0;
282 f->glyphs_initialized_p = 0;
283 f->decode_mode_spec_buffer = 0;
284 f->visible = 0;
285 f->async_visible = 0;
286 f->output_data.nothing = 0;
287 f->iconified = 0;
288 f->async_iconified = 0;
289 f->wants_modeline = 1;
290 f->auto_raise = 0;
291 f->auto_lower = 0;
292 f->no_split = 0;
293 f->garbaged = 1;
294 f->has_minibuffer = mini_p;
295 f->focus_frame = Qnil;
296 f->explicit_name = 0;
297 f->can_have_scroll_bars = 0;
298 f->vertical_scroll_bar_type = vertical_scroll_bar_none;
299 f->param_alist = Qnil;
300 f->scroll_bars = Qnil;
301 f->condemned_scroll_bars = Qnil;
302 f->face_alist = Qnil;
303 f->face_cache = NULL;
304 f->menu_bar_items = Qnil;
305 f->menu_bar_vector = Qnil;
306 f->menu_bar_items_used = 0;
307 f->buffer_predicate = Qnil;
308 f->buffer_list = Qnil;
309 f->buried_buffer_list = Qnil;
310 f->namebuf = 0;
311 f->title = Qnil;
312 f->menu_bar_window = Qnil;
313 f->tool_bar_window = Qnil;
314 f->tool_bar_items = Qnil;
315 f->desired_tool_bar_string = f->current_tool_bar_string = Qnil;
316 f->n_tool_bar_items = 0;
317 f->left_fringe_width = f->right_fringe_width = 0;
318 f->fringe_cols = 0;
319 f->scroll_bar_actual_width = 0;
320 f->border_width = 0;
321 f->internal_border_width = 0;
322 f->column_width = 1; /* !FRAME_WINDOW_P value */
323 f->line_height = 1; /* !FRAME_WINDOW_P value */
324 f->x_pixels_diff = f->y_pixels_diff = 0;
325 #ifdef HAVE_WINDOW_SYSTEM
326 f->want_fullscreen = FULLSCREEN_NONE;
327 #endif
328 f->size_hint_flags = 0;
329 f->win_gravity = 0;
331 root_window = make_window ();
332 if (mini_p)
334 mini_window = make_window ();
335 XWINDOW (root_window)->next = mini_window;
336 XWINDOW (mini_window)->prev = root_window;
337 XWINDOW (mini_window)->mini_p = Qt;
338 XWINDOW (mini_window)->frame = frame;
339 f->minibuffer_window = mini_window;
341 else
343 mini_window = Qnil;
344 XWINDOW (root_window)->next = Qnil;
345 f->minibuffer_window = Qnil;
348 XWINDOW (root_window)->frame = frame;
350 /* 10 is arbitrary,
351 just so that there is "something there."
352 Correct size will be set up later with change_frame_size. */
354 SET_FRAME_COLS (f, 10);
355 FRAME_LINES (f) = 10;
357 XSETFASTINT (XWINDOW (root_window)->total_cols, 10);
358 XSETFASTINT (XWINDOW (root_window)->total_lines, (mini_p ? 9 : 10));
360 if (mini_p)
362 XSETFASTINT (XWINDOW (mini_window)->total_cols, 10);
363 XSETFASTINT (XWINDOW (mini_window)->top_line, 9);
364 XSETFASTINT (XWINDOW (mini_window)->total_lines, 1);
367 /* Choose a buffer for the frame's root window. */
369 Lisp_Object buf;
371 XWINDOW (root_window)->buffer = Qt;
372 buf = Fcurrent_buffer ();
373 /* If buf is a 'hidden' buffer (i.e. one whose name starts with
374 a space), try to find another one. */
375 if (SREF (Fbuffer_name (buf), 0) == ' ')
376 buf = Fother_buffer (buf, Qnil, Qnil);
378 /* Use set_window_buffer, not Fset_window_buffer, and don't let
379 hooks be run by it. The reason is that the whole frame/window
380 arrangement is not yet fully intialized at this point. Windows
381 don't have the right size, glyph matrices aren't initialized
382 etc. Running Lisp functions at this point surely ends in a
383 SEGV. */
384 set_window_buffer (root_window, buf, 0, 0);
385 f->buffer_list = Fcons (buf, Qnil);
388 if (mini_p)
390 XWINDOW (mini_window)->buffer = Qt;
391 set_window_buffer (mini_window,
392 (NILP (Vminibuffer_list)
393 ? get_minibuffer (0)
394 : Fcar (Vminibuffer_list)),
395 0, 0);
398 f->root_window = root_window;
399 f->selected_window = root_window;
400 /* Make sure this window seems more recently used than
401 a newly-created, never-selected window. */
402 ++window_select_count;
403 XSETFASTINT (XWINDOW (f->selected_window)->use_time, window_select_count);
405 f->default_face_done_p = 0;
407 return f;
410 #ifdef HAVE_WINDOW_SYSTEM
411 /* Make a frame using a separate minibuffer window on another frame.
412 MINI_WINDOW is the minibuffer window to use. nil means use the
413 default (the global minibuffer). */
415 struct frame *
416 make_frame_without_minibuffer (mini_window, kb, display)
417 register Lisp_Object mini_window;
418 KBOARD *kb;
419 Lisp_Object display;
421 register struct frame *f;
422 struct gcpro gcpro1;
424 if (!NILP (mini_window))
425 CHECK_LIVE_WINDOW (mini_window);
427 #ifdef MULTI_KBOARD
428 if (!NILP (mini_window)
429 && FRAME_KBOARD (XFRAME (XWINDOW (mini_window)->frame)) != kb)
430 error ("Frame and minibuffer must be on the same terminal");
431 #endif
433 /* Make a frame containing just a root window. */
434 f = make_frame (0);
436 if (NILP (mini_window))
438 /* Use default-minibuffer-frame if possible. */
439 if (!FRAMEP (kb->Vdefault_minibuffer_frame)
440 || ! FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame)))
442 Lisp_Object frame_dummy;
444 XSETFRAME (frame_dummy, f);
445 GCPRO1 (frame_dummy);
446 /* If there's no minibuffer frame to use, create one. */
447 kb->Vdefault_minibuffer_frame =
448 call1 (intern ("make-initial-minibuffer-frame"), display);
449 UNGCPRO;
452 mini_window = XFRAME (kb->Vdefault_minibuffer_frame)->minibuffer_window;
455 f->minibuffer_window = mini_window;
457 /* Make the chosen minibuffer window display the proper minibuffer,
458 unless it is already showing a minibuffer. */
459 if (NILP (Fmemq (XWINDOW (mini_window)->buffer, Vminibuffer_list)))
460 Fset_window_buffer (mini_window,
461 (NILP (Vminibuffer_list)
462 ? get_minibuffer (0)
463 : Fcar (Vminibuffer_list)), Qnil);
464 return f;
467 /* Make a frame containing only a minibuffer window. */
469 struct frame *
470 make_minibuffer_frame ()
472 /* First make a frame containing just a root window, no minibuffer. */
474 register struct frame *f = make_frame (0);
475 register Lisp_Object mini_window;
476 register Lisp_Object frame;
478 XSETFRAME (frame, f);
480 f->auto_raise = 0;
481 f->auto_lower = 0;
482 f->no_split = 1;
483 f->wants_modeline = 0;
484 f->has_minibuffer = 1;
486 /* Now label the root window as also being the minibuffer.
487 Avoid infinite looping on the window chain by marking next pointer
488 as nil. */
490 mini_window = f->minibuffer_window = f->root_window;
491 XWINDOW (mini_window)->mini_p = Qt;
492 XWINDOW (mini_window)->next = Qnil;
493 XWINDOW (mini_window)->prev = Qnil;
494 XWINDOW (mini_window)->frame = frame;
496 /* Put the proper buffer in that window. */
498 Fset_window_buffer (mini_window,
499 (NILP (Vminibuffer_list)
500 ? get_minibuffer (0)
501 : Fcar (Vminibuffer_list)), Qnil);
502 return f;
504 #endif /* HAVE_WINDOW_SYSTEM */
506 /* Construct a frame that refers to a terminal. */
508 static int tty_frame_count;
510 struct frame *
511 make_initial_frame (void)
513 struct frame *f;
514 struct terminal *terminal;
515 Lisp_Object frame;
517 #ifdef MULTI_KBOARD
518 /* Create the initial keyboard. */
519 if (!initial_kboard)
521 initial_kboard = (KBOARD *) xmalloc (sizeof (KBOARD));
522 init_kboard (initial_kboard);
523 initial_kboard->next_kboard = all_kboards;
524 all_kboards = initial_kboard;
526 #endif
528 /* The first call must initialize Vframe_list. */
529 if (! (NILP (Vframe_list) || CONSP (Vframe_list)))
530 Vframe_list = Qnil;
532 terminal = init_initial_terminal ();
534 f = make_frame (1);
535 XSETFRAME (frame, f);
537 Vframe_list = Fcons (frame, Vframe_list);
539 tty_frame_count = 1;
540 f->name = build_string ("F1");
542 f->visible = 1;
543 f->async_visible = 1;
545 f->output_method = terminal->type;
546 f->terminal = terminal;
547 f->terminal->reference_count++;
548 f->output_data.nothing = 0;
550 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
551 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
553 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
554 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
556 return f;
560 struct frame *
561 make_terminal_frame (struct terminal *terminal)
563 register struct frame *f;
564 Lisp_Object frame;
565 char name[20];
567 if (!terminal->name)
568 error ("Terminal is not live, can't create new frames on it");
570 f = make_frame (1);
572 XSETFRAME (frame, f);
573 Vframe_list = Fcons (frame, Vframe_list);
575 tty_frame_count++;
576 sprintf (name, "F%d", tty_frame_count);
577 f->name = build_string (name);
579 f->visible = 1; /* FRAME_SET_VISIBLE wd set frame_garbaged. */
580 f->async_visible = 1; /* Don't let visible be cleared later. */
581 #ifdef MSDOS
582 f->output_data.x = &the_only_x_display;
583 if (!inhibit_window_system
584 && (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame))
585 || XFRAME (selected_frame)->output_method == output_msdos_raw))
587 f->output_method = output_msdos_raw;
588 /* This initialization of foreground and background pixels is
589 only important for the initial frame created in temacs. If
590 we don't do that, we get black background and foreground in
591 the dumped Emacs because the_only_x_display is a static
592 variable, hence it is born all-zeroes, and zero is the code
593 for the black color. Other frames all inherit their pixels
594 from what's already in the_only_x_display. */
595 if ((!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
596 && FRAME_BACKGROUND_PIXEL (f) == 0
597 && FRAME_FOREGROUND_PIXEL (f) == 0)
599 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
600 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
603 else
604 f->output_method = output_termcap;
605 #else
606 #ifdef MAC_OS8
607 make_mac_terminal_frame (f);
608 #else
610 f->output_method = output_termcap;
611 f->terminal = terminal;
612 f->terminal->reference_count++;
613 create_tty_output (f);
615 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
616 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
618 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
619 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
621 /* Set the top frame to the newly created frame. */
622 if (FRAMEP (FRAME_TTY (f)->top_frame)
623 && FRAME_LIVE_P (XFRAME (FRAME_TTY (f)->top_frame)))
624 XFRAME (FRAME_TTY (f)->top_frame)->async_visible = 2; /* obscured */
626 FRAME_TTY (f)->top_frame = frame;
629 #ifdef CANNOT_DUMP
630 FRAME_FOREGROUND_PIXEL(f) = FACE_TTY_DEFAULT_FG_COLOR;
631 FRAME_BACKGROUND_PIXEL(f) = FACE_TTY_DEFAULT_BG_COLOR;
632 #endif
633 #endif /* MAC_OS8 */
634 #endif /* MSDOS */
636 if (!noninteractive)
637 init_frame_faces (f);
639 return f;
642 /* Get a suitable value for frame parameter PARAMETER for a newly
643 created frame, based on (1) the user-supplied frame parameter
644 alist SUPPLIED_PARMS, (2) CURRENT_VALUE, and finally, if all else
645 fails, (3) Vdefault_frame_alist. */
647 static Lisp_Object
648 get_future_frame_param (Lisp_Object parameter,
649 Lisp_Object supplied_parms,
650 char *current_value)
652 Lisp_Object result;
654 result = Fassq (parameter, supplied_parms);
655 if (NILP (result))
656 result = Fassq (parameter, XFRAME (selected_frame)->param_alist);
657 if (NILP (result) && current_value != NULL)
658 result = build_string (current_value);
659 if (NILP (result))
660 result = Fassq (parameter, Vdefault_frame_alist);
661 if (!NILP (result) && !STRINGP (result))
662 result = XCDR (result);
663 if (NILP (result) || !STRINGP (result))
664 result = Qnil;
666 return result;
669 DEFUN ("make-terminal-frame", Fmake_terminal_frame, Smake_terminal_frame,
670 1, 1, 0,
671 doc: /* Create an additional terminal frame, possibly on another terminal.
672 This function takes one argument, an alist specifying frame parameters.
674 You can create multiple frames on a single text-only terminal, but
675 only one of them (the selected terminal frame) is actually displayed.
677 In practice, generally you don't need to specify any parameters,
678 except when you want to create a new frame on another terminal.
679 In that case, the `tty' parameter specifies the device file to open,
680 and the `tty-type' parameter specifies the terminal type. Example:
682 (make-terminal-frame '((tty . "/dev/pts/5") (tty-type . "xterm")))
684 Note that changing the size of one terminal frame automatically
685 affects all frames on the same terminal device. */)
686 (parms)
687 Lisp_Object parms;
689 struct frame *f;
690 struct terminal *t = NULL;
691 Lisp_Object frame, tem;
692 struct frame *sf = SELECTED_FRAME ();
694 #ifdef MSDOS
695 if (sf->output_method != output_msdos_raw
696 && sf->output_method != output_termcap)
697 abort ();
698 #else /* not MSDOS */
700 #if 0 /* #ifdef MAC_OS */
701 /* This can happen for multi-tty when using both terminal frames and
702 Carbon frames. */
703 if (sf->output_method != output_mac)
704 error ("Not running on a Macintosh screen; cannot make a new Macintosh frame");
705 #else
706 #if 0 /* This should work now! */
707 if (sf->output_method != output_termcap)
708 error ("Not using an ASCII terminal now; cannot make a new ASCII frame");
709 #endif
710 #endif
711 #endif /* not MSDOS */
714 Lisp_Object terminal;
716 terminal = Fassq (Qterminal, parms);
717 if (!NILP (terminal))
719 terminal = XCDR (terminal);
720 t = get_terminal (terminal, 1);
724 if (!t)
726 char *name = 0, *type = 0;
727 Lisp_Object tty, tty_type;
729 tty = get_future_frame_param
730 (Qtty, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
731 ? FRAME_TTY (XFRAME (selected_frame))->name
732 : NULL));
733 if (!NILP (tty))
735 name = (char *) alloca (SBYTES (tty) + 1);
736 strncpy (name, SDATA (tty), SBYTES (tty));
737 name[SBYTES (tty)] = 0;
740 tty_type = get_future_frame_param
741 (Qtty_type, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
742 ? FRAME_TTY (XFRAME (selected_frame))->type
743 : NULL));
744 if (!NILP (tty_type))
746 type = (char *) alloca (SBYTES (tty_type) + 1);
747 strncpy (type, SDATA (tty_type), SBYTES (tty_type));
748 type[SBYTES (tty_type)] = 0;
751 t = init_tty (name, type, 0); /* Errors are not fatal. */
754 f = make_terminal_frame (t);
757 int width, height;
758 get_tty_size (fileno (FRAME_TTY (f)->input), &width, &height);
759 change_frame_size (f, height, width, 0, 0, 0);
762 adjust_glyphs (f);
763 calculate_costs (f);
764 XSETFRAME (frame, f);
765 Fmodify_frame_parameters (frame, Vdefault_frame_alist);
766 Fmodify_frame_parameters (frame, parms);
767 Fmodify_frame_parameters (frame, Fcons (Fcons (Qwindow_system, Qnil), Qnil));
768 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty_type,
769 build_string (t->display_info.tty->type)),
770 Qnil));
771 if (t->display_info.tty->name != NULL)
772 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty,
773 build_string (t->display_info.tty->name)),
774 Qnil));
775 else
776 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty, Qnil), Qnil));
778 /* Make the frame face alist be frame-specific, so that each
779 frame could change its face definitions independently. */
780 f->face_alist = Fcopy_alist (sf->face_alist);
781 /* Simple Fcopy_alist isn't enough, because we need the contents of
782 the vectors which are the CDRs of associations in face_alist to
783 be copied as well. */
784 for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem))
785 XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem))));
786 return frame;
790 /* Perform the switch to frame FRAME.
792 If FRAME is a switch-frame event `(switch-frame FRAME1)', use
793 FRAME1 as frame.
795 If TRACK is non-zero and the frame that currently has the focus
796 redirects its focus to the selected frame, redirect that focused
797 frame's focus to FRAME instead.
799 FOR_DELETION non-zero means that the selected frame is being
800 deleted, which includes the possibility that the frame's terminal
801 is dead. */
803 Lisp_Object
804 do_switch_frame (frame, track, for_deletion)
805 Lisp_Object frame;
806 int track, for_deletion;
808 struct frame *sf = SELECTED_FRAME ();
810 /* If FRAME is a switch-frame event, extract the frame we should
811 switch to. */
812 if (CONSP (frame)
813 && EQ (XCAR (frame), Qswitch_frame)
814 && CONSP (XCDR (frame)))
815 frame = XCAR (XCDR (frame));
817 /* This used to say CHECK_LIVE_FRAME, but apparently it's possible for
818 a switch-frame event to arrive after a frame is no longer live,
819 especially when deleting the initial frame during startup. */
820 CHECK_FRAME (frame);
821 if (! FRAME_LIVE_P (XFRAME (frame)))
822 return Qnil;
824 if (sf == XFRAME (frame))
825 return frame;
827 /* This is too greedy; it causes inappropriate focus redirection
828 that's hard to get rid of. */
829 #if 0
830 /* If a frame's focus has been redirected toward the currently
831 selected frame, we should change the redirection to point to the
832 newly selected frame. This means that if the focus is redirected
833 from a minibufferless frame to a surrogate minibuffer frame, we
834 can use `other-window' to switch between all the frames using
835 that minibuffer frame, and the focus redirection will follow us
836 around. */
837 if (track)
839 Lisp_Object tail;
841 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
843 Lisp_Object focus;
845 if (!FRAMEP (XCAR (tail)))
846 abort ();
848 focus = FRAME_FOCUS_FRAME (XFRAME (XCAR (tail)));
850 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
851 Fredirect_frame_focus (XCAR (tail), frame);
854 #else /* ! 0 */
855 /* Instead, apply it only to the frame we're pointing to. */
856 #ifdef HAVE_WINDOW_SYSTEM
857 if (track && FRAME_WINDOW_P (XFRAME (frame)))
859 Lisp_Object focus, xfocus;
861 xfocus = x_get_focus_frame (XFRAME (frame));
862 if (FRAMEP (xfocus))
864 focus = FRAME_FOCUS_FRAME (XFRAME (xfocus));
865 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
866 Fredirect_frame_focus (xfocus, frame);
869 #endif /* HAVE_X_WINDOWS */
870 #endif /* ! 0 */
872 if (!for_deletion && FRAME_HAS_MINIBUF_P (sf))
873 resize_mini_window (XWINDOW (FRAME_MINIBUF_WINDOW (sf)), 1);
875 if (FRAME_TERMCAP_P (XFRAME (selected_frame))
876 && FRAME_TERMCAP_P (XFRAME (frame))
877 && FRAME_TTY (XFRAME (selected_frame)) == FRAME_TTY (XFRAME (frame)))
879 XFRAME (selected_frame)->async_visible = 2; /* obscured */
880 XFRAME (frame)->async_visible = 1;
881 FRAME_TTY (XFRAME (frame))->top_frame = frame;
884 selected_frame = frame;
885 if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
886 last_nonminibuf_frame = XFRAME (selected_frame);
888 Fselect_window (XFRAME (frame)->selected_window, Qnil);
890 #ifndef WINDOWSNT
891 /* Make sure to switch the tty color mode to that of the newly
892 selected frame. */
893 sf = SELECTED_FRAME ();
894 if (FRAME_TERMCAP_P (sf))
896 Lisp_Object color_mode_spec, color_mode;
898 color_mode_spec = assq_no_quit (Qtty_color_mode, sf->param_alist);
899 if (CONSP (color_mode_spec))
900 color_mode = XCDR (color_mode_spec);
901 else
902 color_mode = make_number (0);
903 set_tty_color_mode (sf, color_mode);
905 #endif /* !WINDOWSNT */
907 /* We want to make sure that the next event generates a frame-switch
908 event to the appropriate frame. This seems kludgy to me, but
909 before you take it out, make sure that evaluating something like
910 (select-window (frame-root-window (new-frame))) doesn't end up
911 with your typing being interpreted in the new frame instead of
912 the one you're actually typing in. */
913 internal_last_event_frame = Qnil;
915 return frame;
918 DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 1, "e",
919 doc: /* Select the frame FRAME.
920 Subsequent editing commands apply to its selected window.
921 The selection of FRAME lasts until the next time the user does
922 something to select a different frame, or until the next time this
923 function is called. If you are using a window system, the previously
924 selected frame may be restored as the selected frame after return to
925 the command loop, because it still may have the window system's input
926 focus. On a text-only terminal, the next redisplay will display FRAME.
928 This function returns FRAME, or nil if FRAME has been deleted. */)
929 (frame)
930 Lisp_Object frame;
932 return do_switch_frame (frame, 1, 0);
936 DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 1, "e",
937 doc: /* Handle a switch-frame event EVENT.
938 Switch-frame events are usually bound to this function.
939 A switch-frame event tells Emacs that the window manager has requested
940 that the user's events be directed to the frame mentioned in the event.
941 This function selects the selected window of the frame of EVENT.
943 If EVENT is frame object, handle it as if it were a switch-frame event
944 to that frame. */)
945 (event)
946 Lisp_Object event;
948 /* Preserve prefix arg that the command loop just cleared. */
949 current_kboard->Vprefix_arg = Vcurrent_prefix_arg;
950 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
951 return do_switch_frame (event, 0, 0);
954 DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0,
955 doc: /* Return the frame that is now selected. */)
958 return selected_frame;
961 DEFUN ("window-frame", Fwindow_frame, Swindow_frame, 1, 1, 0,
962 doc: /* Return the frame object that window WINDOW is on. */)
963 (window)
964 Lisp_Object window;
966 CHECK_LIVE_WINDOW (window);
967 return XWINDOW (window)->frame;
970 DEFUN ("frame-first-window", Fframe_first_window, Sframe_first_window, 0, 1, 0,
971 doc: /* Returns the topmost, leftmost window of FRAME.
972 If omitted, FRAME defaults to the currently selected frame. */)
973 (frame)
974 Lisp_Object frame;
976 Lisp_Object w;
978 if (NILP (frame))
979 w = SELECTED_FRAME ()->root_window;
980 else
982 CHECK_LIVE_FRAME (frame);
983 w = XFRAME (frame)->root_window;
985 while (NILP (XWINDOW (w)->buffer))
987 if (! NILP (XWINDOW (w)->hchild))
988 w = XWINDOW (w)->hchild;
989 else if (! NILP (XWINDOW (w)->vchild))
990 w = XWINDOW (w)->vchild;
991 else
992 abort ();
994 return w;
997 DEFUN ("active-minibuffer-window", Factive_minibuffer_window,
998 Sactive_minibuffer_window, 0, 0, 0,
999 doc: /* Return the currently active minibuffer window, or nil if none. */)
1002 return minibuf_level ? minibuf_window : Qnil;
1005 DEFUN ("frame-root-window", Fframe_root_window, Sframe_root_window, 0, 1, 0,
1006 doc: /* Returns the root-window of 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 ()->root_window;
1015 else
1017 CHECK_LIVE_FRAME (frame);
1018 window = XFRAME (frame)->root_window;
1021 return window;
1024 DEFUN ("frame-selected-window", Fframe_selected_window,
1025 Sframe_selected_window, 0, 1, 0,
1026 doc: /* Return the selected window of frame object FRAME.
1027 If omitted, FRAME defaults to the currently selected frame. */)
1028 (frame)
1029 Lisp_Object frame;
1031 Lisp_Object window;
1033 if (NILP (frame))
1034 window = SELECTED_FRAME ()->selected_window;
1035 else
1037 CHECK_LIVE_FRAME (frame);
1038 window = XFRAME (frame)->selected_window;
1041 return window;
1044 DEFUN ("set-frame-selected-window", Fset_frame_selected_window,
1045 Sset_frame_selected_window, 2, 2, 0,
1046 doc: /* Set the selected window of frame object FRAME to WINDOW.
1047 Return WINDOW.
1048 If FRAME is nil, the selected frame is used.
1049 If FRAME is the selected frame, this makes WINDOW the selected window. */)
1050 (frame, window)
1051 Lisp_Object frame, window;
1053 if (NILP (frame))
1054 frame = selected_frame;
1056 CHECK_LIVE_FRAME (frame);
1057 CHECK_LIVE_WINDOW (window);
1059 if (! EQ (frame, WINDOW_FRAME (XWINDOW (window))))
1060 error ("In `set-frame-selected-window', WINDOW is not on FRAME");
1062 if (EQ (frame, selected_frame))
1063 return Fselect_window (window, Qnil);
1065 return XFRAME (frame)->selected_window = window;
1069 DEFUN ("frame-list", Fframe_list, Sframe_list,
1070 0, 0, 0,
1071 doc: /* Return a list of all frames. */)
1074 Lisp_Object frames;
1075 frames = Fcopy_sequence (Vframe_list);
1076 #ifdef HAVE_WINDOW_SYSTEM
1077 if (FRAMEP (tip_frame))
1078 frames = Fdelq (tip_frame, frames);
1079 #endif
1080 return frames;
1083 /* Return the next frame in the frame list after FRAME.
1084 If MINIBUF is nil, exclude minibuffer-only frames.
1085 If MINIBUF is a window, include only its own frame
1086 and any frame now using that window as the minibuffer.
1087 If MINIBUF is `visible', include all visible frames.
1088 If MINIBUF is 0, include all visible and iconified frames.
1089 Otherwise, include all frames. */
1091 static Lisp_Object
1092 next_frame (frame, minibuf)
1093 Lisp_Object frame;
1094 Lisp_Object minibuf;
1096 Lisp_Object tail;
1097 int passed = 0;
1099 /* There must always be at least one frame in Vframe_list. */
1100 if (! CONSP (Vframe_list))
1101 abort ();
1103 /* If this frame is dead, it won't be in Vframe_list, and we'll loop
1104 forever. Forestall that. */
1105 CHECK_LIVE_FRAME (frame);
1107 while (1)
1108 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1110 Lisp_Object f;
1112 f = XCAR (tail);
1114 if (passed
1115 && ((!FRAME_TERMCAP_P (XFRAME (f)) && !FRAME_TERMCAP_P (XFRAME (frame))
1116 && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
1117 || (FRAME_TERMCAP_P (XFRAME (f)) && FRAME_TERMCAP_P (XFRAME (frame))
1118 && FRAME_TTY (XFRAME (f)) == FRAME_TTY (XFRAME (frame)))))
1120 /* Decide whether this frame is eligible to be returned. */
1122 /* If we've looped all the way around without finding any
1123 eligible frames, return the original frame. */
1124 if (EQ (f, frame))
1125 return f;
1127 /* Let minibuf decide if this frame is acceptable. */
1128 if (NILP (minibuf))
1130 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
1131 return f;
1133 else if (EQ (minibuf, Qvisible))
1135 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1136 if (FRAME_VISIBLE_P (XFRAME (f)))
1137 return f;
1139 else if (INTEGERP (minibuf) && XINT (minibuf) == 0)
1141 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1142 if (FRAME_VISIBLE_P (XFRAME (f))
1143 || FRAME_ICONIFIED_P (XFRAME (f)))
1144 return f;
1146 else if (WINDOWP (minibuf))
1148 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
1149 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
1150 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
1151 FRAME_FOCUS_FRAME (XFRAME (f))))
1152 return f;
1154 else
1155 return f;
1158 if (EQ (frame, f))
1159 passed++;
1163 /* Return the previous frame in the frame list before FRAME.
1164 If MINIBUF is nil, exclude minibuffer-only frames.
1165 If MINIBUF is a window, include only its own frame
1166 and any frame now using that window as the minibuffer.
1167 If MINIBUF is `visible', include all visible frames.
1168 If MINIBUF is 0, include all visible and iconified frames.
1169 Otherwise, include all frames. */
1171 static Lisp_Object
1172 prev_frame (frame, minibuf)
1173 Lisp_Object frame;
1174 Lisp_Object minibuf;
1176 Lisp_Object tail;
1177 Lisp_Object prev;
1179 /* There must always be at least one frame in Vframe_list. */
1180 if (! CONSP (Vframe_list))
1181 abort ();
1183 prev = Qnil;
1184 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1186 Lisp_Object f;
1188 f = XCAR (tail);
1189 if (!FRAMEP (f))
1190 abort ();
1192 if (EQ (frame, f) && !NILP (prev))
1193 return prev;
1195 if ((!FRAME_TERMCAP_P (XFRAME (f)) && !FRAME_TERMCAP_P (XFRAME (frame))
1196 && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
1197 || (FRAME_TERMCAP_P (XFRAME (f)) && FRAME_TERMCAP_P (XFRAME (frame))
1198 && FRAME_TTY (XFRAME (f)) == FRAME_TTY (XFRAME (frame))))
1200 /* Decide whether this frame is eligible to be returned,
1201 according to minibuf. */
1202 if (NILP (minibuf))
1204 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
1205 prev = f;
1207 else if (WINDOWP (minibuf))
1209 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
1210 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
1211 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
1212 FRAME_FOCUS_FRAME (XFRAME (f))))
1213 prev = f;
1215 else if (EQ (minibuf, Qvisible))
1217 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1218 if (FRAME_VISIBLE_P (XFRAME (f)))
1219 prev = f;
1221 else if (XFASTINT (minibuf) == 0)
1223 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1224 if (FRAME_VISIBLE_P (XFRAME (f))
1225 || FRAME_ICONIFIED_P (XFRAME (f)))
1226 prev = f;
1228 else
1229 prev = f;
1233 /* We've scanned the entire list. */
1234 if (NILP (prev))
1235 /* We went through the whole frame list without finding a single
1236 acceptable frame. Return the original frame. */
1237 return frame;
1238 else
1239 /* There were no acceptable frames in the list before FRAME; otherwise,
1240 we would have returned directly from the loop. Since PREV is the last
1241 acceptable frame in the list, return it. */
1242 return prev;
1246 DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0,
1247 doc: /* Return the next frame in the frame list after FRAME.
1248 It considers only frames on the same terminal as FRAME.
1249 By default, skip minibuffer-only frames.
1250 If omitted, FRAME defaults to the selected frame.
1251 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1252 If MINIFRAME is a window, include only its own frame
1253 and any frame now using that window as the minibuffer.
1254 If MINIFRAME is `visible', include all visible frames.
1255 If MINIFRAME is 0, include all visible and iconified frames.
1256 Otherwise, include all frames. */)
1257 (frame, miniframe)
1258 Lisp_Object frame, miniframe;
1260 if (NILP (frame))
1261 frame = selected_frame;
1263 CHECK_LIVE_FRAME (frame);
1264 return next_frame (frame, miniframe);
1267 DEFUN ("previous-frame", Fprevious_frame, Sprevious_frame, 0, 2, 0,
1268 doc: /* Return the previous frame in the frame list before FRAME.
1269 It considers only frames on the same terminal as FRAME.
1270 By default, skip minibuffer-only frames.
1271 If omitted, FRAME defaults to the selected frame.
1272 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1273 If MINIFRAME is a window, include only its own frame
1274 and any frame now using that window as the minibuffer.
1275 If MINIFRAME is `visible', include all visible frames.
1276 If MINIFRAME is 0, include all visible and iconified frames.
1277 Otherwise, include all frames. */)
1278 (frame, miniframe)
1279 Lisp_Object frame, miniframe;
1281 if (NILP (frame))
1282 frame = selected_frame;
1283 CHECK_LIVE_FRAME (frame);
1284 return prev_frame (frame, miniframe);
1287 /* Return 1 if it is ok to delete frame F;
1288 0 if all frames aside from F are invisible.
1289 (Exception: if F is the terminal frame, and we are using X, return 1.) */
1292 other_visible_frames (f)
1293 FRAME_PTR f;
1295 /* We know the selected frame is visible,
1296 so if F is some other frame, it can't be the sole visible one. */
1297 if (f == SELECTED_FRAME ())
1299 Lisp_Object frames;
1300 int count = 0;
1302 for (frames = Vframe_list;
1303 CONSP (frames);
1304 frames = XCDR (frames))
1306 Lisp_Object this;
1308 this = XCAR (frames);
1309 /* Verify that the frame's window still exists
1310 and we can still talk to it. And note any recent change
1311 in visibility. */
1312 #ifdef HAVE_WINDOW_SYSTEM
1313 if (FRAME_WINDOW_P (XFRAME (this)))
1315 x_sync (XFRAME (this));
1316 FRAME_SAMPLE_VISIBILITY (XFRAME (this));
1318 #endif
1320 if (FRAME_VISIBLE_P (XFRAME (this))
1321 || FRAME_ICONIFIED_P (XFRAME (this))
1322 /* Allow deleting the terminal frame when at least
1323 one X frame exists! */
1324 || (FRAME_WINDOW_P (XFRAME (this)) && !FRAME_WINDOW_P (f)))
1325 count++;
1327 return count > 1;
1329 return 1;
1332 /* Error handler for `delete-frame-functions'. */
1333 static Lisp_Object
1334 delete_frame_handler (Lisp_Object arg)
1336 add_to_log ("Error during `delete-frame': %s", arg, Qnil);
1337 return Qnil;
1340 DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 2, "",
1341 doc: /* Delete FRAME, permanently eliminating it from use.
1342 If omitted, FRAME defaults to the selected frame.
1343 A frame may not be deleted if its minibuffer is used by other frames.
1344 Normally, you may not delete a frame if all other frames are invisible,
1345 but if the second optional argument FORCE is non-nil, you may do so.
1347 This function runs `delete-frame-functions' before actually deleting the
1348 frame, unless the frame is a tooltip.
1349 The functions are run with one arg, the frame to be deleted. */)
1350 (frame, force)
1351 Lisp_Object frame, force;
1353 struct frame *f;
1354 struct frame *sf = SELECTED_FRAME ();
1355 struct kboard *kb;
1357 int minibuffer_selected;
1359 if (EQ (frame, Qnil))
1361 f = sf;
1362 XSETFRAME (frame, f);
1364 else
1366 CHECK_FRAME (frame);
1367 f = XFRAME (frame);
1370 if (! FRAME_LIVE_P (f))
1371 return Qnil;
1373 if (NILP (force) && !other_visible_frames (f)
1374 #ifdef MAC_OS8
1375 /* Terminal frame deleted before any other visible frames are
1376 created. */
1377 && strcmp (SDATA (f->name), "F1") != 0
1378 #endif
1380 error ("Attempt to delete the sole visible or iconified frame");
1382 #if 0
1383 /* This is a nice idea, but x_connection_closed needs to be able
1384 to delete the last frame, if it is gone. */
1385 if (NILP (XCDR (Vframe_list)))
1386 error ("Attempt to delete the only frame");
1387 #endif
1389 /* Does this frame have a minibuffer, and is it the surrogate
1390 minibuffer for any other frame? */
1391 if (FRAME_HAS_MINIBUF_P (XFRAME (frame)))
1393 Lisp_Object frames;
1395 for (frames = Vframe_list;
1396 CONSP (frames);
1397 frames = XCDR (frames))
1399 Lisp_Object this;
1400 this = XCAR (frames);
1402 if (! EQ (this, frame)
1403 && EQ (frame,
1404 WINDOW_FRAME (XWINDOW
1405 (FRAME_MINIBUF_WINDOW (XFRAME (this))))))
1406 error ("Attempt to delete a surrogate minibuffer frame");
1410 /* Run `delete-frame-functions' unless frame is a tooltip. */
1411 if (!NILP (Vrun_hooks)
1412 && NILP (Fframe_parameter (frame, intern ("tooltip"))))
1414 Lisp_Object args[2];
1415 struct gcpro gcpro1, gcpro2;
1417 /* Don't let a rogue function in `delete-frame-functions'
1418 prevent the frame deletion. */
1419 GCPRO2 (args[0], args[1]);
1420 args[0] = intern ("delete-frame-functions");
1421 args[1] = frame;
1422 internal_condition_case_2 (Frun_hook_with_args, 2, args,
1423 Qt, delete_frame_handler);
1424 UNGCPRO;
1427 /* The hook may sometimes (indirectly) cause the frame to be deleted. */
1428 if (! FRAME_LIVE_P (f))
1429 return Qnil;
1431 minibuffer_selected = EQ (minibuf_window, selected_window);
1433 /* Don't let the frame remain selected. */
1434 if (f == sf)
1436 Lisp_Object tail, frame1;
1438 /* Look for another visible frame on the same terminal. */
1439 frame1 = next_frame (frame, Qvisible);
1441 /* If there is none, find *some* other frame. */
1442 if (NILP (frame1) || EQ (frame1, frame))
1444 FOR_EACH_FRAME (tail, frame1)
1446 if (! EQ (frame, frame1) && FRAME_LIVE_P (XFRAME (frame1)))
1447 break;
1451 do_switch_frame (frame1, 0, 1);
1452 sf = SELECTED_FRAME ();
1455 /* Don't allow minibuf_window to remain on a deleted frame. */
1456 if (EQ (f->minibuffer_window, minibuf_window))
1458 Fset_window_buffer (sf->minibuffer_window,
1459 XWINDOW (minibuf_window)->buffer, Qnil);
1460 minibuf_window = sf->minibuffer_window;
1462 /* If the dying minibuffer window was selected,
1463 select the new one. */
1464 if (minibuffer_selected)
1465 Fselect_window (minibuf_window, Qnil);
1468 /* Don't let echo_area_window to remain on a deleted frame. */
1469 if (EQ (f->minibuffer_window, echo_area_window))
1470 echo_area_window = sf->minibuffer_window;
1472 /* Don't allow other frames to refer to a deleted frame in their
1473 'environment parameter. */
1475 Lisp_Object tail, frame1;
1476 Lisp_Object env = get_frame_param (XFRAME (frame), Qenvironment);
1477 FOR_EACH_FRAME (tail, frame1)
1479 if (EQ (frame, frame1) || !FRAME_LIVE_P (XFRAME (frame1)))
1480 continue;
1481 if (EQ (frame, get_frame_param (XFRAME (frame1), Qenvironment)))
1483 store_frame_param (XFRAME (frame1), Qenvironment, env);
1484 if (!FRAMEP (env))
1485 env = frame1;
1490 /* Clear any X selections for this frame. */
1491 #ifdef HAVE_X_WINDOWS
1492 if (FRAME_X_P (f))
1493 x_clear_frame_selections (f);
1494 #endif
1495 #ifdef MAC_OS
1496 if (FRAME_MAC_P (f))
1497 x_clear_frame_selections (f);
1498 #endif
1500 /* Free glyphs.
1501 This function must be called before the window tree of the
1502 frame is deleted because windows contain dynamically allocated
1503 memory. */
1504 free_glyphs (f);
1506 /* Mark all the windows that used to be on FRAME as deleted, and then
1507 remove the reference to them. */
1508 delete_all_subwindows (XWINDOW (f->root_window));
1509 f->root_window = Qnil;
1511 Vframe_list = Fdelq (frame, Vframe_list);
1512 FRAME_SET_VISIBLE (f, 0);
1514 if (f->namebuf)
1515 xfree (f->namebuf);
1516 if (f->decode_mode_spec_buffer)
1517 xfree (f->decode_mode_spec_buffer);
1518 if (FRAME_INSERT_COST (f))
1519 xfree (FRAME_INSERT_COST (f));
1520 if (FRAME_DELETEN_COST (f))
1521 xfree (FRAME_DELETEN_COST (f));
1522 if (FRAME_INSERTN_COST (f))
1523 xfree (FRAME_INSERTN_COST (f));
1524 if (FRAME_DELETE_COST (f))
1525 xfree (FRAME_DELETE_COST (f));
1526 if (FRAME_MESSAGE_BUF (f))
1527 xfree (FRAME_MESSAGE_BUF (f));
1529 /* Since some events are handled at the interrupt level, we may get
1530 an event for f at any time; if we zero out the frame's terminal
1531 now, then we may trip up the event-handling code. Instead, we'll
1532 promise that the terminal of the frame must be valid until we
1533 have called the window-system-dependent frame destruction
1534 routine. */
1536 if (FRAME_TERMINAL (f)->delete_frame_hook)
1537 (*FRAME_TERMINAL (f)->delete_frame_hook) (f);
1540 struct terminal *terminal = FRAME_TERMINAL (f);
1541 f->output_data.nothing = 0;
1542 f->terminal = 0; /* Now the frame is dead. */
1544 /* If needed, delete the terminal that this frame was on.
1545 (This must be done after the frame is killed.) */
1546 terminal->reference_count--;
1547 if (terminal->reference_count == 0)
1549 kb = NULL;
1550 if (terminal->delete_terminal_hook)
1551 (*terminal->delete_terminal_hook) (terminal);
1552 else
1553 delete_terminal (terminal);
1555 #ifdef MULTI_KBOARD
1556 else
1557 kb = terminal->kboard;
1558 #endif
1561 /* If we've deleted the last_nonminibuf_frame, then try to find
1562 another one. */
1563 if (f == last_nonminibuf_frame)
1565 Lisp_Object frames;
1567 last_nonminibuf_frame = 0;
1569 for (frames = Vframe_list;
1570 CONSP (frames);
1571 frames = XCDR (frames))
1573 f = XFRAME (XCAR (frames));
1574 if (!FRAME_MINIBUF_ONLY_P (f))
1576 last_nonminibuf_frame = f;
1577 break;
1582 /* If there's no other frame on the same kboard, get out of
1583 single-kboard state if we're in it for this kboard. */
1584 if (kb != NULL)
1586 Lisp_Object frames;
1587 /* Some frame we found on the same kboard, or nil if there are none. */
1588 Lisp_Object frame_on_same_kboard;
1590 frame_on_same_kboard = Qnil;
1592 for (frames = Vframe_list;
1593 CONSP (frames);
1594 frames = XCDR (frames))
1596 Lisp_Object this;
1597 struct frame *f1;
1599 this = XCAR (frames);
1600 if (!FRAMEP (this))
1601 abort ();
1602 f1 = XFRAME (this);
1604 if (kb == FRAME_KBOARD (f1))
1605 frame_on_same_kboard = this;
1608 if (NILP (frame_on_same_kboard))
1609 not_single_kboard_state (kb);
1613 /* If we've deleted this keyboard's default_minibuffer_frame, try to
1614 find another one. Prefer minibuffer-only frames, but also notice
1615 frames with other windows. */
1616 if (kb != NULL && EQ (frame, kb->Vdefault_minibuffer_frame))
1618 Lisp_Object frames;
1620 /* The last frame we saw with a minibuffer, minibuffer-only or not. */
1621 Lisp_Object frame_with_minibuf;
1622 /* Some frame we found on the same kboard, or nil if there are none. */
1623 Lisp_Object frame_on_same_kboard;
1625 frame_on_same_kboard = Qnil;
1626 frame_with_minibuf = Qnil;
1628 for (frames = Vframe_list;
1629 CONSP (frames);
1630 frames = XCDR (frames))
1632 Lisp_Object this;
1633 struct frame *f1;
1635 this = XCAR (frames);
1636 if (!FRAMEP (this))
1637 abort ();
1638 f1 = XFRAME (this);
1640 /* Consider only frames on the same kboard
1641 and only those with minibuffers. */
1642 if (kb == FRAME_KBOARD (f1)
1643 && FRAME_HAS_MINIBUF_P (f1))
1645 frame_with_minibuf = this;
1646 if (FRAME_MINIBUF_ONLY_P (f1))
1647 break;
1650 if (kb == FRAME_KBOARD (f1))
1651 frame_on_same_kboard = this;
1654 if (!NILP (frame_on_same_kboard))
1656 /* We know that there must be some frame with a minibuffer out
1657 there. If this were not true, all of the frames present
1658 would have to be minibufferless, which implies that at some
1659 point their minibuffer frames must have been deleted, but
1660 that is prohibited at the top; you can't delete surrogate
1661 minibuffer frames. */
1662 if (NILP (frame_with_minibuf))
1663 abort ();
1665 kb->Vdefault_minibuffer_frame = frame_with_minibuf;
1667 else
1668 /* No frames left on this kboard--say no minibuffer either. */
1669 kb->Vdefault_minibuffer_frame = Qnil;
1672 /* Cause frame titles to update--necessary if we now have just one frame. */
1673 update_mode_lines = 1;
1675 return Qnil;
1678 /* Return mouse position in character cell units. */
1680 DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0,
1681 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1682 The position is given in character cells, where (0, 0) is the
1683 upper-left corner of the frame, X is the horizontal offset, and Y is
1684 the vertical offset.
1685 If Emacs is running on a mouseless terminal or hasn't been programmed
1686 to read the mouse position, it returns the selected frame for FRAME
1687 and nil for X and Y.
1688 If `mouse-position-function' is non-nil, `mouse-position' calls it,
1689 passing the normal return value to that function as an argument,
1690 and returns whatever that function returns. */)
1693 FRAME_PTR f;
1694 Lisp_Object lispy_dummy;
1695 enum scroll_bar_part party_dummy;
1696 Lisp_Object x, y, retval;
1697 int col, row;
1698 unsigned long long_dummy;
1699 struct gcpro gcpro1;
1701 f = SELECTED_FRAME ();
1702 x = y = Qnil;
1704 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
1705 /* It's okay for the hook to refrain from storing anything. */
1706 if (FRAME_TERMINAL (f)->mouse_position_hook)
1707 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1708 &lispy_dummy, &party_dummy,
1709 &x, &y,
1710 &long_dummy);
1711 if (! NILP (x))
1713 col = XINT (x);
1714 row = XINT (y);
1715 pixel_to_glyph_coords (f, col, row, &col, &row, NULL, 1);
1716 XSETINT (x, col);
1717 XSETINT (y, row);
1719 #endif
1720 XSETFRAME (lispy_dummy, f);
1721 retval = Fcons (lispy_dummy, Fcons (x, y));
1722 GCPRO1 (retval);
1723 if (!NILP (Vmouse_position_function))
1724 retval = call1 (Vmouse_position_function, retval);
1725 RETURN_UNGCPRO (retval);
1728 DEFUN ("mouse-pixel-position", Fmouse_pixel_position,
1729 Smouse_pixel_position, 0, 0, 0,
1730 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1731 The position is given in pixel units, where (0, 0) is the
1732 upper-left corner of the frame, X is the horizontal offset, and Y is
1733 the vertical offset.
1734 If Emacs is running on a mouseless terminal or hasn't been programmed
1735 to read the mouse position, it returns the selected frame for FRAME
1736 and nil for X and Y. */)
1739 FRAME_PTR f;
1740 Lisp_Object lispy_dummy;
1741 enum scroll_bar_part party_dummy;
1742 Lisp_Object x, y;
1743 unsigned long long_dummy;
1745 f = SELECTED_FRAME ();
1746 x = y = Qnil;
1748 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
1749 /* It's okay for the hook to refrain from storing anything. */
1750 if (FRAME_TERMINAL (f)->mouse_position_hook)
1751 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1752 &lispy_dummy, &party_dummy,
1753 &x, &y,
1754 &long_dummy);
1755 #endif
1756 XSETFRAME (lispy_dummy, f);
1757 return Fcons (lispy_dummy, Fcons (x, y));
1760 DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0,
1761 doc: /* Move the mouse pointer to the center of character cell (X,Y) in FRAME.
1762 Coordinates are relative to the frame, not a window,
1763 so the coordinates of the top left character in the frame
1764 may be nonzero due to left-hand scroll bars or the menu bar.
1766 The position is given in character cells, where (0, 0) is the
1767 upper-left corner of the frame, X is the horizontal offset, and Y is
1768 the vertical offset.
1770 This function is a no-op for an X frame that is not visible.
1771 If you have just created a frame, you must wait for it to become visible
1772 before calling this function on it, like this.
1773 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1774 (frame, x, y)
1775 Lisp_Object frame, x, y;
1777 CHECK_LIVE_FRAME (frame);
1778 CHECK_NUMBER (x);
1779 CHECK_NUMBER (y);
1781 /* I think this should be done with a hook. */
1782 #ifdef HAVE_WINDOW_SYSTEM
1783 if (FRAME_WINDOW_P (XFRAME (frame)))
1784 /* Warping the mouse will cause enternotify and focus events. */
1785 x_set_mouse_position (XFRAME (frame), XINT (x), XINT (y));
1786 #else
1787 #if defined (MSDOS) && defined (HAVE_MOUSE)
1788 if (FRAME_MSDOS_P (XFRAME (frame)))
1790 Fselect_frame (frame);
1791 mouse_moveto (XINT (x), XINT (y));
1793 #else
1794 #ifdef HAVE_GPM
1796 Fselect_frame (frame);
1797 term_mouse_moveto (XINT (x), XINT (y));
1799 #endif
1800 #endif
1801 #endif
1803 return Qnil;
1806 DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position,
1807 Sset_mouse_pixel_position, 3, 3, 0,
1808 doc: /* Move the mouse pointer to pixel position (X,Y) in FRAME.
1809 The position is given in pixels, where (0, 0) is the upper-left corner
1810 of the frame, X is the horizontal offset, and Y is the vertical offset.
1812 Note, this is a no-op for an X frame that is not visible.
1813 If you have just created a frame, you must wait for it to become visible
1814 before calling this function on it, like this.
1815 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1816 (frame, x, y)
1817 Lisp_Object frame, x, y;
1819 CHECK_LIVE_FRAME (frame);
1820 CHECK_NUMBER (x);
1821 CHECK_NUMBER (y);
1823 /* I think this should be done with a hook. */
1824 #ifdef HAVE_WINDOW_SYSTEM
1825 if (FRAME_WINDOW_P (XFRAME (frame)))
1826 /* Warping the mouse will cause enternotify and focus events. */
1827 x_set_mouse_pixel_position (XFRAME (frame), XINT (x), XINT (y));
1828 #else
1829 #if defined (MSDOS) && defined (HAVE_MOUSE)
1830 if (FRAME_MSDOS_P (XFRAME (frame)))
1832 Fselect_frame (frame);
1833 mouse_moveto (XINT (x), XINT (y));
1835 #else
1836 #ifdef HAVE_GPM
1838 Fselect_frame (frame);
1839 term_mouse_moveto (XINT (x), XINT (y));
1841 #endif
1842 #endif
1843 #endif
1845 return Qnil;
1848 static void make_frame_visible_1 P_ ((Lisp_Object));
1850 DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible,
1851 0, 1, "",
1852 doc: /* Make the frame FRAME visible (assuming it is an X window).
1853 If omitted, FRAME defaults to the currently selected frame. */)
1854 (frame)
1855 Lisp_Object frame;
1857 if (NILP (frame))
1858 frame = selected_frame;
1860 CHECK_LIVE_FRAME (frame);
1862 /* I think this should be done with a hook. */
1863 #ifdef HAVE_WINDOW_SYSTEM
1864 if (FRAME_WINDOW_P (XFRAME (frame)))
1866 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1867 x_make_frame_visible (XFRAME (frame));
1869 #endif
1871 make_frame_visible_1 (XFRAME (frame)->root_window);
1873 /* Make menu bar update for the Buffers and Frames menus. */
1874 windows_or_buffers_changed++;
1876 return frame;
1879 /* Update the display_time slot of the buffers shown in WINDOW
1880 and all its descendents. */
1882 static void
1883 make_frame_visible_1 (window)
1884 Lisp_Object window;
1886 struct window *w;
1888 for (;!NILP (window); window = w->next)
1890 w = XWINDOW (window);
1892 if (!NILP (w->buffer))
1893 XBUFFER (w->buffer)->display_time = Fcurrent_time ();
1895 if (!NILP (w->vchild))
1896 make_frame_visible_1 (w->vchild);
1897 if (!NILP (w->hchild))
1898 make_frame_visible_1 (w->hchild);
1902 DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible,
1903 0, 2, "",
1904 doc: /* Make the frame FRAME invisible (assuming it is an X window).
1905 If omitted, FRAME defaults to the currently selected frame.
1906 Normally you may not make FRAME invisible if all other frames are invisible,
1907 but if the second optional argument FORCE is non-nil, you may do so. */)
1908 (frame, force)
1909 Lisp_Object frame, force;
1911 if (NILP (frame))
1912 frame = selected_frame;
1914 CHECK_LIVE_FRAME (frame);
1916 if (NILP (force) && !other_visible_frames (XFRAME (frame)))
1917 error ("Attempt to make invisible the sole visible or iconified frame");
1919 #if 0 /* This isn't logically necessary, and it can do GC. */
1920 /* Don't let the frame remain selected. */
1921 if (EQ (frame, selected_frame))
1922 do_switch_frame (next_frame (frame, Qt), 0, 0)
1923 #endif
1925 /* Don't allow minibuf_window to remain on a deleted frame. */
1926 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1928 struct frame *sf = XFRAME (selected_frame);
1929 Fset_window_buffer (sf->minibuffer_window,
1930 XWINDOW (minibuf_window)->buffer, Qnil);
1931 minibuf_window = sf->minibuffer_window;
1934 /* I think this should be done with a hook. */
1935 #ifdef HAVE_WINDOW_SYSTEM
1936 if (FRAME_WINDOW_P (XFRAME (frame)))
1937 x_make_frame_invisible (XFRAME (frame));
1938 #endif
1940 /* Make menu bar update for the Buffers and Frames menus. */
1941 windows_or_buffers_changed++;
1943 return Qnil;
1946 DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame,
1947 0, 1, "",
1948 doc: /* Make the frame FRAME into an icon.
1949 If omitted, FRAME defaults to the currently selected frame. */)
1950 (frame)
1951 Lisp_Object frame;
1953 if (NILP (frame))
1954 frame = selected_frame;
1956 CHECK_LIVE_FRAME (frame);
1958 #if 0 /* This isn't logically necessary, and it can do GC. */
1959 /* Don't let the frame remain selected. */
1960 if (EQ (frame, selected_frame))
1961 Fhandle_switch_frame (next_frame (frame, Qt));
1962 #endif
1964 /* Don't allow minibuf_window to remain on a deleted frame. */
1965 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1967 struct frame *sf = XFRAME (selected_frame);
1968 Fset_window_buffer (sf->minibuffer_window,
1969 XWINDOW (minibuf_window)->buffer, Qnil);
1970 minibuf_window = sf->minibuffer_window;
1973 /* I think this should be done with a hook. */
1974 #ifdef HAVE_WINDOW_SYSTEM
1975 if (FRAME_WINDOW_P (XFRAME (frame)))
1976 x_iconify_frame (XFRAME (frame));
1977 #endif
1979 /* Make menu bar update for the Buffers and Frames menus. */
1980 windows_or_buffers_changed++;
1982 return Qnil;
1985 DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p,
1986 1, 1, 0,
1987 doc: /* Return t if FRAME is now \"visible\" (actually in use for display).
1988 A frame that is not \"visible\" is not updated and, if it works through
1989 a window system, it may not show at all.
1990 Return the symbol `icon' if frame is visible only as an icon.
1992 On a text-only terminal, all frames are considered visible, whether
1993 they are currently being displayed or not, and this function returns t
1994 for all frames. */)
1995 (frame)
1996 Lisp_Object frame;
1998 CHECK_LIVE_FRAME (frame);
2000 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
2002 if (FRAME_VISIBLE_P (XFRAME (frame)))
2003 return Qt;
2004 if (FRAME_ICONIFIED_P (XFRAME (frame)))
2005 return Qicon;
2006 return Qnil;
2009 DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list,
2010 0, 0, 0,
2011 doc: /* Return a list of all frames now \"visible\" (being updated). */)
2014 Lisp_Object tail, frame;
2015 struct frame *f;
2016 Lisp_Object value;
2018 value = Qnil;
2019 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
2021 frame = XCAR (tail);
2022 if (!FRAMEP (frame))
2023 continue;
2024 f = XFRAME (frame);
2025 if (FRAME_VISIBLE_P (f))
2026 value = Fcons (frame, value);
2028 return value;
2032 DEFUN ("raise-frame", Fraise_frame, Sraise_frame, 0, 1, "",
2033 doc: /* Bring FRAME to the front, so it occludes any frames it overlaps.
2034 If FRAME is invisible or iconified, make it visible.
2035 If you don't specify a frame, the selected frame is used.
2036 If Emacs is displaying on an ordinary terminal or some other device which
2037 doesn't support multiple overlapping frames, this function does nothing. */)
2038 (frame)
2039 Lisp_Object frame;
2041 struct frame *f;
2042 if (NILP (frame))
2043 frame = selected_frame;
2045 CHECK_LIVE_FRAME (frame);
2047 f = XFRAME (frame);
2049 /* Do like the documentation says. */
2050 Fmake_frame_visible (frame);
2052 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
2053 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 1);
2055 return Qnil;
2058 /* Should we have a corresponding function called Flower_Power? */
2059 DEFUN ("lower-frame", Flower_frame, Slower_frame, 0, 1, "",
2060 doc: /* Send FRAME to the back, so it is occluded by any frames that overlap it.
2061 If you don't specify a frame, the selected frame is used.
2062 If Emacs is displaying on an ordinary terminal or some other device which
2063 doesn't support multiple overlapping frames, this function does nothing. */)
2064 (frame)
2065 Lisp_Object frame;
2067 struct frame *f;
2069 if (NILP (frame))
2070 frame = selected_frame;
2072 CHECK_LIVE_FRAME (frame);
2074 f = XFRAME (frame);
2076 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
2077 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 0);
2079 return Qnil;
2083 DEFUN ("redirect-frame-focus", Fredirect_frame_focus, Sredirect_frame_focus,
2084 1, 2, 0,
2085 doc: /* Arrange for keystrokes typed at FRAME to be sent to FOCUS-FRAME.
2086 In other words, switch-frame events caused by events in FRAME will
2087 request a switch to FOCUS-FRAME, and `last-event-frame' will be
2088 FOCUS-FRAME after reading an event typed at FRAME.
2090 If FOCUS-FRAME is omitted or nil, any existing redirection is
2091 cancelled, and the frame again receives its own keystrokes.
2093 Focus redirection is useful for temporarily redirecting keystrokes to
2094 a surrogate minibuffer frame when a frame doesn't have its own
2095 minibuffer window.
2097 A frame's focus redirection can be changed by `select-frame'. If frame
2098 FOO is selected, and then a different frame BAR is selected, any
2099 frames redirecting their focus to FOO are shifted to redirect their
2100 focus to BAR. This allows focus redirection to work properly when the
2101 user switches from one frame to another using `select-window'.
2103 This means that a frame whose focus is redirected to itself is treated
2104 differently from a frame whose focus is redirected to nil; the former
2105 is affected by `select-frame', while the latter is not.
2107 The redirection lasts until `redirect-frame-focus' is called to change it. */)
2108 (frame, focus_frame)
2109 Lisp_Object frame, focus_frame;
2111 struct frame *f;
2113 /* Note that we don't check for a live frame here. It's reasonable
2114 to redirect the focus of a frame you're about to delete, if you
2115 know what other frame should receive those keystrokes. */
2116 CHECK_FRAME (frame);
2118 if (! NILP (focus_frame))
2119 CHECK_LIVE_FRAME (focus_frame);
2121 f = XFRAME (frame);
2123 f->focus_frame = focus_frame;
2125 if (FRAME_TERMINAL (f)->frame_rehighlight_hook)
2126 (*FRAME_TERMINAL (f)->frame_rehighlight_hook) (f);
2128 return Qnil;
2132 DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 1, 1, 0,
2133 doc: /* Return the frame to which FRAME's keystrokes are currently being sent.
2134 This returns nil if FRAME's focus is not redirected.
2135 See `redirect-frame-focus'. */)
2136 (frame)
2137 Lisp_Object frame;
2139 CHECK_LIVE_FRAME (frame);
2141 return FRAME_FOCUS_FRAME (XFRAME (frame));
2146 /* Return the value of frame parameter PROP in frame FRAME. */
2148 Lisp_Object
2149 get_frame_param (frame, prop)
2150 register struct frame *frame;
2151 Lisp_Object prop;
2153 register Lisp_Object tem;
2155 tem = Fassq (prop, frame->param_alist);
2156 if (EQ (tem, Qnil))
2157 return tem;
2158 return Fcdr (tem);
2161 /* Return the buffer-predicate of the selected frame. */
2163 Lisp_Object
2164 frame_buffer_predicate (frame)
2165 Lisp_Object frame;
2167 return XFRAME (frame)->buffer_predicate;
2170 /* Return the buffer-list of the selected frame. */
2172 Lisp_Object
2173 frame_buffer_list (frame)
2174 Lisp_Object frame;
2176 return XFRAME (frame)->buffer_list;
2179 /* Set the buffer-list of the selected frame. */
2181 void
2182 set_frame_buffer_list (frame, list)
2183 Lisp_Object frame, list;
2185 XFRAME (frame)->buffer_list = list;
2188 /* Discard BUFFER from the buffer-list and buried-buffer-list of each frame. */
2190 void
2191 frames_discard_buffer (buffer)
2192 Lisp_Object buffer;
2194 Lisp_Object frame, tail;
2196 FOR_EACH_FRAME (tail, frame)
2198 XFRAME (frame)->buffer_list
2199 = Fdelq (buffer, XFRAME (frame)->buffer_list);
2200 XFRAME (frame)->buried_buffer_list
2201 = Fdelq (buffer, XFRAME (frame)->buried_buffer_list);
2205 /* Modify the alist in *ALISTPTR to associate PROP with VAL.
2206 If the alist already has an element for PROP, we change it. */
2208 void
2209 store_in_alist (alistptr, prop, val)
2210 Lisp_Object *alistptr, val;
2211 Lisp_Object prop;
2213 register Lisp_Object tem;
2215 tem = Fassq (prop, *alistptr);
2216 if (EQ (tem, Qnil))
2217 *alistptr = Fcons (Fcons (prop, val), *alistptr);
2218 else
2219 Fsetcdr (tem, val);
2222 static int
2223 frame_name_fnn_p (str, len)
2224 char *str;
2225 int len;
2227 if (len > 1 && str[0] == 'F')
2229 char *end_ptr;
2231 strtol (str + 1, &end_ptr, 10);
2233 if (end_ptr == str + len)
2234 return 1;
2236 return 0;
2239 /* Set the name of the terminal frame. Also used by MSDOS frames.
2240 Modeled after x_set_name which is used for WINDOW frames. */
2242 static void
2243 set_term_frame_name (f, name)
2244 struct frame *f;
2245 Lisp_Object name;
2247 f->explicit_name = ! NILP (name);
2249 /* If NAME is nil, set the name to F<num>. */
2250 if (NILP (name))
2252 char namebuf[20];
2254 /* Check for no change needed in this very common case
2255 before we do any consing. */
2256 if (frame_name_fnn_p (SDATA (f->name),
2257 SBYTES (f->name)))
2258 return;
2260 tty_frame_count++;
2261 sprintf (namebuf, "F%d", tty_frame_count);
2262 name = build_string (namebuf);
2264 else
2266 CHECK_STRING (name);
2268 /* Don't change the name if it's already NAME. */
2269 if (! NILP (Fstring_equal (name, f->name)))
2270 return;
2272 /* Don't allow the user to set the frame name to F<num>, so it
2273 doesn't clash with the names we generate for terminal frames. */
2274 if (frame_name_fnn_p (SDATA (name), SBYTES (name)))
2275 error ("Frame names of the form F<num> are usurped by Emacs");
2278 f->name = name;
2279 update_mode_lines = 1;
2282 void
2283 store_frame_param (f, prop, val)
2284 struct frame *f;
2285 Lisp_Object prop, val;
2287 register Lisp_Object old_alist_elt;
2289 /* The buffer-list parameters are stored in a special place and not
2290 in the alist. */
2291 if (EQ (prop, Qbuffer_list))
2293 f->buffer_list = val;
2294 return;
2296 if (EQ (prop, Qburied_buffer_list))
2298 f->buried_buffer_list = val;
2299 return;
2302 /* If PROP is a symbol which is supposed to have frame-local values,
2303 and it is set up based on this frame, switch to the global
2304 binding. That way, we can create or alter the frame-local binding
2305 without messing up the symbol's status. */
2306 if (SYMBOLP (prop))
2308 Lisp_Object valcontents;
2309 valcontents = SYMBOL_VALUE (prop);
2310 if ((BUFFER_LOCAL_VALUEP (valcontents)
2311 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
2312 && XBUFFER_LOCAL_VALUE (valcontents)->check_frame
2313 && XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame
2314 && XFRAME (XBUFFER_LOCAL_VALUE (valcontents)->frame) == f)
2315 swap_in_global_binding (prop);
2318 #ifndef WINDOWSNT
2319 /* The tty color mode needs to be set before the frame's parameter
2320 alist is updated with the new value, because set_tty_color_mode
2321 wants to look at the old mode. */
2322 if (FRAME_TERMCAP_P (f) && EQ (prop, Qtty_color_mode))
2323 set_tty_color_mode (f, val);
2324 #endif
2326 /* Update the frame parameter alist. */
2327 old_alist_elt = Fassq (prop, f->param_alist);
2328 if (EQ (old_alist_elt, Qnil))
2329 f->param_alist = Fcons (Fcons (prop, val), f->param_alist);
2330 else
2331 Fsetcdr (old_alist_elt, val);
2333 /* Update some other special parameters in their special places
2334 in addition to the alist. */
2336 if (EQ (prop, Qbuffer_predicate))
2337 f->buffer_predicate = val;
2339 if (! FRAME_WINDOW_P (f))
2341 if (EQ (prop, Qmenu_bar_lines))
2342 set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f)));
2343 else if (EQ (prop, Qname))
2344 set_term_frame_name (f, val);
2347 if (EQ (prop, Qminibuffer) && WINDOWP (val))
2349 if (! MINI_WINDOW_P (XWINDOW (val)))
2350 error ("Surrogate minibuffer windows must be minibuffer windows");
2352 if ((FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
2353 && !EQ (val, f->minibuffer_window))
2354 error ("Can't change the surrogate minibuffer of a frame with its own minibuffer");
2356 /* Install the chosen minibuffer window, with proper buffer. */
2357 f->minibuffer_window = val;
2361 DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0,
2362 doc: /* Return the parameters-alist of frame FRAME.
2363 It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
2364 The meaningful PARMs depend on the kind of frame.
2365 If FRAME is omitted, return information on the currently selected frame. */)
2366 (frame)
2367 Lisp_Object frame;
2369 Lisp_Object alist;
2370 FRAME_PTR f;
2371 int height, width;
2372 struct gcpro gcpro1;
2374 if (NILP (frame))
2375 frame = selected_frame;
2377 CHECK_FRAME (frame);
2378 f = XFRAME (frame);
2380 if (!FRAME_LIVE_P (f))
2381 return Qnil;
2383 alist = Fcopy_alist (f->param_alist);
2384 GCPRO1 (alist);
2386 if (!FRAME_WINDOW_P (f))
2388 int fg = FRAME_FOREGROUND_PIXEL (f);
2389 int bg = FRAME_BACKGROUND_PIXEL (f);
2390 Lisp_Object elt;
2392 /* If the frame's parameter alist says the colors are
2393 unspecified and reversed, take the frame's background pixel
2394 for foreground and vice versa. */
2395 elt = Fassq (Qforeground_color, alist);
2396 if (CONSP (elt) && STRINGP (XCDR (elt)))
2398 if (strncmp (SDATA (XCDR (elt)),
2399 unspecified_bg,
2400 SCHARS (XCDR (elt))) == 0)
2401 store_in_alist (&alist, Qforeground_color, tty_color_name (f, bg));
2402 else if (strncmp (SDATA (XCDR (elt)),
2403 unspecified_fg,
2404 SCHARS (XCDR (elt))) == 0)
2405 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2407 else
2408 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2409 elt = Fassq (Qbackground_color, alist);
2410 if (CONSP (elt) && STRINGP (XCDR (elt)))
2412 if (strncmp (SDATA (XCDR (elt)),
2413 unspecified_fg,
2414 SCHARS (XCDR (elt))) == 0)
2415 store_in_alist (&alist, Qbackground_color, tty_color_name (f, fg));
2416 else if (strncmp (SDATA (XCDR (elt)),
2417 unspecified_bg,
2418 SCHARS (XCDR (elt))) == 0)
2419 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2421 else
2422 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2423 store_in_alist (&alist, intern ("font"),
2424 build_string (FRAME_MSDOS_P (f)
2425 ? "ms-dos"
2426 : FRAME_W32_P (f) ? "w32term"
2427 :"tty"));
2429 store_in_alist (&alist, Qname, f->name);
2430 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2431 store_in_alist (&alist, Qheight, make_number (height));
2432 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2433 store_in_alist (&alist, Qwidth, make_number (width));
2434 store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil));
2435 store_in_alist (&alist, Qminibuffer,
2436 (! FRAME_HAS_MINIBUF_P (f) ? Qnil
2437 : FRAME_MINIBUF_ONLY_P (f) ? Qonly
2438 : FRAME_MINIBUF_WINDOW (f)));
2439 store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
2440 store_in_alist (&alist, Qbuffer_list, frame_buffer_list (frame));
2441 store_in_alist (&alist, Qburied_buffer_list, XFRAME (frame)->buried_buffer_list);
2443 /* I think this should be done with a hook. */
2444 #ifdef HAVE_WINDOW_SYSTEM
2445 if (FRAME_WINDOW_P (f))
2446 x_report_frame_params (f, &alist);
2447 else
2448 #endif
2450 /* This ought to be correct in f->param_alist for an X frame. */
2451 Lisp_Object lines;
2452 XSETFASTINT (lines, FRAME_MENU_BAR_LINES (f));
2453 store_in_alist (&alist, Qmenu_bar_lines, lines);
2456 UNGCPRO;
2457 return alist;
2461 DEFUN ("frame-parameter", Fframe_parameter, Sframe_parameter, 2, 2, 0,
2462 doc: /* Return FRAME's value for parameter PARAMETER.
2463 If FRAME is nil, describe the currently selected frame. */)
2464 (frame, parameter)
2465 Lisp_Object frame, parameter;
2467 struct frame *f;
2468 Lisp_Object value;
2470 if (NILP (frame))
2471 frame = selected_frame;
2472 else
2473 CHECK_FRAME (frame);
2474 CHECK_SYMBOL (parameter);
2476 f = XFRAME (frame);
2477 value = Qnil;
2479 if (FRAME_LIVE_P (f))
2481 /* Avoid consing in frequent cases. */
2482 if (EQ (parameter, Qname))
2483 value = f->name;
2484 #ifdef HAVE_X_WINDOWS
2485 else if (EQ (parameter, Qdisplay) && FRAME_X_P (f))
2486 value = XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element);
2487 #endif /* HAVE_X_WINDOWS */
2488 else if (EQ (parameter, Qbackground_color)
2489 || EQ (parameter, Qforeground_color))
2491 value = Fassq (parameter, f->param_alist);
2492 if (CONSP (value))
2494 value = XCDR (value);
2495 /* Fframe_parameters puts the actual fg/bg color names,
2496 even if f->param_alist says otherwise. This is
2497 important when param_alist's notion of colors is
2498 "unspecified". We need to do the same here. */
2499 if (STRINGP (value) && !FRAME_WINDOW_P (f))
2501 const char *color_name;
2502 EMACS_INT csz;
2504 if (EQ (parameter, Qbackground_color))
2506 color_name = SDATA (value);
2507 csz = SCHARS (value);
2508 if (strncmp (color_name, unspecified_bg, csz) == 0)
2509 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2510 else if (strncmp (color_name, unspecified_fg, csz) == 0)
2511 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2513 else if (EQ (parameter, Qforeground_color))
2515 color_name = SDATA (value);
2516 csz = SCHARS (value);
2517 if (strncmp (color_name, unspecified_fg, csz) == 0)
2518 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2519 else if (strncmp (color_name, unspecified_bg, csz) == 0)
2520 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2524 else
2525 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2527 else if (EQ (parameter, Qdisplay_type)
2528 || EQ (parameter, Qbackground_mode))
2529 value = Fcdr (Fassq (parameter, f->param_alist));
2530 else
2531 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2534 return value;
2538 DEFUN ("modify-frame-parameters", Fmodify_frame_parameters,
2539 Smodify_frame_parameters, 2, 2, 0,
2540 doc: /* Modify the parameters of frame FRAME according to ALIST.
2541 If FRAME is nil, it defaults to the selected frame.
2542 ALIST is an alist of parameters to change and their new values.
2543 Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.
2544 The meaningful PARMs depend on the kind of frame.
2545 Undefined PARMs are ignored, but stored in the frame's parameter list
2546 so that `frame-parameters' will return them.
2548 The value of frame parameter FOO can also be accessed
2549 as a frame-local binding for the variable FOO, if you have
2550 enabled such bindings for that variable with `make-variable-frame-local'. */)
2551 (frame, alist)
2552 Lisp_Object frame, alist;
2554 FRAME_PTR f;
2555 register Lisp_Object tail, prop, val;
2557 if (EQ (frame, Qnil))
2558 frame = selected_frame;
2559 CHECK_LIVE_FRAME (frame);
2560 f = XFRAME (frame);
2562 /* I think this should be done with a hook. */
2563 #ifdef HAVE_WINDOW_SYSTEM
2564 if (FRAME_WINDOW_P (f))
2565 x_set_frame_parameters (f, alist);
2566 else
2567 #endif
2568 #ifdef MSDOS
2569 if (FRAME_MSDOS_P (f))
2570 IT_set_frame_parameters (f, alist);
2571 else
2572 #endif
2575 int length = XINT (Flength (alist));
2576 int i;
2577 Lisp_Object *parms
2578 = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
2579 Lisp_Object *values
2580 = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
2582 /* Extract parm names and values into those vectors. */
2584 i = 0;
2585 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
2587 Lisp_Object elt;
2589 elt = Fcar (tail);
2590 parms[i] = Fcar (elt);
2591 values[i] = Fcdr (elt);
2592 i++;
2595 /* Now process them in reverse of specified order. */
2596 for (i--; i >= 0; i--)
2598 prop = parms[i];
2599 val = values[i];
2600 store_frame_param (f, prop, val);
2602 /* Changing the background color might change the background
2603 mode, so that we have to load new defface specs.
2604 Call frame-set-background-mode to do that. */
2605 if (EQ (prop, Qbackground_color))
2606 call1 (Qframe_set_background_mode, frame);
2609 return Qnil;
2612 DEFUN ("frame-with-environment", Fframe_with_environment, Sframe_with_environment, 0, 1, 0,
2613 doc: /* Return the frame that has the environment variable list for FRAME.
2615 The frame-local environment variable list is normally shared between
2616 frames that were created in the same Emacsclient session. The
2617 environment list is stored in a single frame's 'environment parameter;
2618 the other frames' 'environment parameter is set to this frame. This
2619 function follows the chain of 'environment references to reach the
2620 frame that stores the actual local environment list, and returns that
2621 frame. */)
2622 (frame)
2623 Lisp_Object frame;
2625 Lisp_Object hare, tortoise;
2627 if (NILP (frame))
2628 frame = selected_frame;
2629 CHECK_FRAME (frame);
2631 hare = tortoise = get_frame_param (XFRAME (frame), Qenvironment);
2632 while (!NILP (hare) && FRAMEP (hare))
2634 frame = hare;
2635 hare = get_frame_param (XFRAME (hare), Qenvironment);
2636 if (NILP (hare) || !FRAMEP (hare))
2637 break;
2638 frame = hare;
2639 hare = get_frame_param (XFRAME (hare), Qenvironment);
2640 tortoise = get_frame_param (XFRAME (tortoise), Qenvironment);
2641 if (EQ (hare, tortoise))
2642 error ("Cyclic frame-local environment indirection");
2645 return frame;
2649 DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height,
2650 0, 1, 0,
2651 doc: /* Height in pixels of a line in the font in frame FRAME.
2652 If FRAME is omitted, the selected frame is used.
2653 For a terminal frame, the value is always 1. */)
2654 (frame)
2655 Lisp_Object frame;
2657 struct frame *f;
2659 if (NILP (frame))
2660 frame = selected_frame;
2661 CHECK_FRAME (frame);
2662 f = XFRAME (frame);
2664 #ifdef HAVE_WINDOW_SYSTEM
2665 if (FRAME_WINDOW_P (f))
2666 return make_number (x_char_height (f));
2667 else
2668 #endif
2669 return make_number (1);
2673 DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width,
2674 0, 1, 0,
2675 doc: /* Width in pixels of characters in the font in frame FRAME.
2676 If FRAME is omitted, the selected frame is used.
2677 On a graphical screen, the width is the standard width of the default font.
2678 For a terminal screen, the value is always 1. */)
2679 (frame)
2680 Lisp_Object frame;
2682 struct frame *f;
2684 if (NILP (frame))
2685 frame = selected_frame;
2686 CHECK_FRAME (frame);
2687 f = XFRAME (frame);
2689 #ifdef HAVE_WINDOW_SYSTEM
2690 if (FRAME_WINDOW_P (f))
2691 return make_number (x_char_width (f));
2692 else
2693 #endif
2694 return make_number (1);
2697 DEFUN ("frame-pixel-height", Fframe_pixel_height,
2698 Sframe_pixel_height, 0, 1, 0,
2699 doc: /* Return a FRAME's height in pixels.
2700 This counts only the height available for text lines,
2701 not menu bars on window-system Emacs frames.
2702 For a terminal frame, the result really gives the height in characters.
2703 If FRAME is omitted, the selected frame is used. */)
2704 (frame)
2705 Lisp_Object frame;
2707 struct frame *f;
2709 if (NILP (frame))
2710 frame = selected_frame;
2711 CHECK_FRAME (frame);
2712 f = XFRAME (frame);
2714 #ifdef HAVE_WINDOW_SYSTEM
2715 if (FRAME_WINDOW_P (f))
2716 return make_number (x_pixel_height (f));
2717 else
2718 #endif
2719 return make_number (FRAME_LINES (f));
2722 DEFUN ("frame-pixel-width", Fframe_pixel_width,
2723 Sframe_pixel_width, 0, 1, 0,
2724 doc: /* Return FRAME's width in pixels.
2725 For a terminal frame, the result really gives the width in characters.
2726 If FRAME is omitted, the selected frame is used. */)
2727 (frame)
2728 Lisp_Object frame;
2730 struct frame *f;
2732 if (NILP (frame))
2733 frame = selected_frame;
2734 CHECK_FRAME (frame);
2735 f = XFRAME (frame);
2737 #ifdef HAVE_WINDOW_SYSTEM
2738 if (FRAME_WINDOW_P (f))
2739 return make_number (x_pixel_width (f));
2740 else
2741 #endif
2742 return make_number (FRAME_COLS (f));
2745 DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0,
2746 doc: /* Specify that the frame FRAME has LINES lines.
2747 Optional third arg non-nil means that redisplay should use LINES lines
2748 but that the idea of the actual height of the frame should not be changed. */)
2749 (frame, lines, pretend)
2750 Lisp_Object frame, lines, pretend;
2752 register struct frame *f;
2754 CHECK_NUMBER (lines);
2755 if (NILP (frame))
2756 frame = selected_frame;
2757 CHECK_LIVE_FRAME (frame);
2758 f = XFRAME (frame);
2760 /* I think this should be done with a hook. */
2761 #ifdef HAVE_WINDOW_SYSTEM
2762 if (FRAME_WINDOW_P (f))
2764 if (XINT (lines) != FRAME_LINES (f))
2765 x_set_window_size (f, 1, FRAME_COLS (f), XINT (lines));
2766 do_pending_window_change (0);
2768 else
2769 #endif
2770 change_frame_size (f, XINT (lines), 0, !NILP (pretend), 0, 0);
2771 return Qnil;
2774 DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 3, 0,
2775 doc: /* Specify that the frame FRAME has COLS columns.
2776 Optional third arg non-nil means that redisplay should use COLS columns
2777 but that the idea of the actual width of the frame should not be changed. */)
2778 (frame, cols, pretend)
2779 Lisp_Object frame, cols, pretend;
2781 register struct frame *f;
2782 CHECK_NUMBER (cols);
2783 if (NILP (frame))
2784 frame = selected_frame;
2785 CHECK_LIVE_FRAME (frame);
2786 f = XFRAME (frame);
2788 /* I think this should be done with a hook. */
2789 #ifdef HAVE_WINDOW_SYSTEM
2790 if (FRAME_WINDOW_P (f))
2792 if (XINT (cols) != FRAME_COLS (f))
2793 x_set_window_size (f, 1, XINT (cols), FRAME_LINES (f));
2794 do_pending_window_change (0);
2796 else
2797 #endif
2798 change_frame_size (f, 0, XINT (cols), !NILP (pretend), 0, 0);
2799 return Qnil;
2802 DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0,
2803 doc: /* Sets size of FRAME to COLS by ROWS, measured in characters. */)
2804 (frame, cols, rows)
2805 Lisp_Object frame, cols, rows;
2807 register struct frame *f;
2809 CHECK_LIVE_FRAME (frame);
2810 CHECK_NUMBER (cols);
2811 CHECK_NUMBER (rows);
2812 f = XFRAME (frame);
2814 /* I think this should be done with a hook. */
2815 #ifdef HAVE_WINDOW_SYSTEM
2816 if (FRAME_WINDOW_P (f))
2818 if (XINT (rows) != FRAME_LINES (f)
2819 || XINT (cols) != FRAME_COLS (f)
2820 || f->new_text_lines || f->new_text_cols)
2821 x_set_window_size (f, 1, XINT (cols), XINT (rows));
2822 do_pending_window_change (0);
2824 else
2825 #endif
2826 change_frame_size (f, XINT (rows), XINT (cols), 0, 0, 0);
2828 return Qnil;
2831 DEFUN ("set-frame-position", Fset_frame_position,
2832 Sset_frame_position, 3, 3, 0,
2833 doc: /* Sets position of FRAME in pixels to XOFFSET by YOFFSET.
2834 This is actually the position of the upper left corner of the frame.
2835 Negative values for XOFFSET or YOFFSET are interpreted relative to
2836 the rightmost or bottommost possible position (that stays within the screen). */)
2837 (frame, xoffset, yoffset)
2838 Lisp_Object frame, xoffset, yoffset;
2840 register struct frame *f;
2842 CHECK_LIVE_FRAME (frame);
2843 CHECK_NUMBER (xoffset);
2844 CHECK_NUMBER (yoffset);
2845 f = XFRAME (frame);
2847 /* I think this should be done with a hook. */
2848 #ifdef HAVE_WINDOW_SYSTEM
2849 if (FRAME_WINDOW_P (f))
2850 x_set_offset (f, XINT (xoffset), XINT (yoffset), 1);
2851 #endif
2853 return Qt;
2857 /***********************************************************************
2858 Frame Parameters
2859 ***********************************************************************/
2861 /* Connect the frame-parameter names for X frames
2862 to the ways of passing the parameter values to the window system.
2864 The name of a parameter, as a Lisp symbol,
2865 has an `x-frame-parameter' property which is an integer in Lisp
2866 that is an index in this table. */
2868 struct frame_parm_table {
2869 char *name;
2870 Lisp_Object *variable;
2873 static struct frame_parm_table frame_parms[] =
2875 {"auto-raise", &Qauto_raise},
2876 {"auto-lower", &Qauto_lower},
2877 {"background-color", 0},
2878 {"border-color", &Qborder_color},
2879 {"border-width", &Qborder_width},
2880 {"cursor-color", &Qcursor_color},
2881 {"cursor-type", &Qcursor_type},
2882 {"font", 0},
2883 {"foreground-color", 0},
2884 {"icon-name", &Qicon_name},
2885 {"icon-type", &Qicon_type},
2886 {"internal-border-width", &Qinternal_border_width},
2887 {"menu-bar-lines", &Qmenu_bar_lines},
2888 {"mouse-color", &Qmouse_color},
2889 {"name", &Qname},
2890 {"scroll-bar-width", &Qscroll_bar_width},
2891 {"title", &Qtitle},
2892 {"unsplittable", &Qunsplittable},
2893 {"vertical-scroll-bars", &Qvertical_scroll_bars},
2894 {"visibility", &Qvisibility},
2895 {"tool-bar-lines", &Qtool_bar_lines},
2896 {"scroll-bar-foreground", &Qscroll_bar_foreground},
2897 {"scroll-bar-background", &Qscroll_bar_background},
2898 {"screen-gamma", &Qscreen_gamma},
2899 {"line-spacing", &Qline_spacing},
2900 {"left-fringe", &Qleft_fringe},
2901 {"right-fringe", &Qright_fringe},
2902 {"wait-for-wm", &Qwait_for_wm},
2903 {"fullscreen", &Qfullscreen},
2906 #ifdef HAVE_WINDOW_SYSTEM
2908 extern Lisp_Object Qbox;
2909 extern Lisp_Object Qtop;
2911 /* Calculate fullscreen size. Return in *TOP_POS and *LEFT_POS the
2912 wanted positions of the WM window (not Emacs window).
2913 Return in *WIDTH and *HEIGHT the wanted width and height of Emacs
2914 window (FRAME_X_WINDOW).
2917 void
2918 x_fullscreen_adjust (f, width, height, top_pos, left_pos)
2919 struct frame *f;
2920 int *width;
2921 int *height;
2922 int *top_pos;
2923 int *left_pos;
2925 int newwidth = FRAME_COLS (f);
2926 int newheight = FRAME_LINES (f);
2928 *top_pos = f->top_pos;
2929 *left_pos = f->left_pos;
2931 if (f->want_fullscreen & FULLSCREEN_HEIGHT)
2933 int ph;
2935 ph = FRAME_X_DISPLAY_INFO (f)->height;
2936 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2937 ph = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, newheight) - f->y_pixels_diff;
2938 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2939 *top_pos = 0;
2942 if (f->want_fullscreen & FULLSCREEN_WIDTH)
2944 int pw;
2946 pw = FRAME_X_DISPLAY_INFO (f)->width;
2947 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2948 pw = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, newwidth) - f->x_pixels_diff;
2949 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2950 *left_pos = 0;
2953 *width = newwidth;
2954 *height = newheight;
2958 /* Change the parameters of frame F as specified by ALIST.
2959 If a parameter is not specially recognized, do nothing special;
2960 otherwise call the `x_set_...' function for that parameter.
2961 Except for certain geometry properties, always call store_frame_param
2962 to store the new value in the parameter alist. */
2964 void
2965 x_set_frame_parameters (f, alist)
2966 FRAME_PTR f;
2967 Lisp_Object alist;
2969 Lisp_Object tail;
2971 /* If both of these parameters are present, it's more efficient to
2972 set them both at once. So we wait until we've looked at the
2973 entire list before we set them. */
2974 int width, height;
2976 /* Same here. */
2977 Lisp_Object left, top;
2979 /* Same with these. */
2980 Lisp_Object icon_left, icon_top;
2982 /* Record in these vectors all the parms specified. */
2983 Lisp_Object *parms;
2984 Lisp_Object *values;
2985 int i, p;
2986 int left_no_change = 0, top_no_change = 0;
2987 int icon_left_no_change = 0, icon_top_no_change = 0;
2988 int fullscreen_is_being_set = 0;
2990 struct gcpro gcpro1, gcpro2;
2992 i = 0;
2993 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
2994 i++;
2996 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
2997 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
2999 /* Extract parm names and values into those vectors. */
3001 i = 0;
3002 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
3004 Lisp_Object elt;
3006 elt = Fcar (tail);
3007 parms[i] = Fcar (elt);
3008 values[i] = Fcdr (elt);
3009 i++;
3011 /* TAIL and ALIST are not used again below here. */
3012 alist = tail = Qnil;
3014 GCPRO2 (*parms, *values);
3015 gcpro1.nvars = i;
3016 gcpro2.nvars = i;
3018 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
3019 because their values appear in VALUES and strings are not valid. */
3020 top = left = Qunbound;
3021 icon_left = icon_top = Qunbound;
3023 /* Provide default values for HEIGHT and WIDTH. */
3024 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
3025 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
3027 /* Process foreground_color and background_color before anything else.
3028 They are independent of other properties, but other properties (e.g.,
3029 cursor_color) are dependent upon them. */
3030 /* Process default font as well, since fringe widths depends on it. */
3031 /* Also, process fullscreen, width and height depend upon that */
3032 for (p = 0; p < i; p++)
3034 Lisp_Object prop, val;
3036 prop = parms[p];
3037 val = values[p];
3038 if (EQ (prop, Qforeground_color)
3039 || EQ (prop, Qbackground_color)
3040 || EQ (prop, Qfont)
3041 || EQ (prop, Qfullscreen))
3043 register Lisp_Object param_index, old_value;
3044 int count = SPECPDL_INDEX ();
3046 old_value = get_frame_param (f, prop);
3047 fullscreen_is_being_set |= EQ (prop, Qfullscreen);
3049 if (NILP (Fequal (val, old_value)))
3051 /* For :font attributes, the frame_parm_handler
3052 x_set_font calls `face-set-after-frame-default'.
3053 Unless we bind inhibit-face-set-after-frame-default
3054 here, this would reset the :font attribute that we
3055 just applied to the default value for new faces. */
3056 specbind (Qinhibit_face_set_after_frame_default, Qt);
3058 store_frame_param (f, prop, val);
3060 param_index = Fget (prop, Qx_frame_parameter);
3061 if (NATNUMP (param_index)
3062 && (XFASTINT (param_index)
3063 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3064 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
3065 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
3066 unbind_to (count, Qnil);
3071 /* Now process them in reverse of specified order. */
3072 for (i--; i >= 0; i--)
3074 Lisp_Object prop, val;
3076 prop = parms[i];
3077 val = values[i];
3079 if (EQ (prop, Qwidth) && NATNUMP (val))
3080 width = XFASTINT (val);
3081 else if (EQ (prop, Qheight) && NATNUMP (val))
3082 height = XFASTINT (val);
3083 else if (EQ (prop, Qtop))
3084 top = val;
3085 else if (EQ (prop, Qleft))
3086 left = val;
3087 else if (EQ (prop, Qicon_top))
3088 icon_top = val;
3089 else if (EQ (prop, Qicon_left))
3090 icon_left = val;
3091 else if (EQ (prop, Qforeground_color)
3092 || EQ (prop, Qbackground_color)
3093 || EQ (prop, Qfont)
3094 || EQ (prop, Qfullscreen))
3095 /* Processed above. */
3096 continue;
3097 else
3099 register Lisp_Object param_index, old_value;
3101 old_value = get_frame_param (f, prop);
3103 store_frame_param (f, prop, val);
3105 param_index = Fget (prop, Qx_frame_parameter);
3106 if (NATNUMP (param_index)
3107 && (XFASTINT (param_index)
3108 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3109 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
3110 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
3114 /* Don't die if just one of these was set. */
3115 if (EQ (left, Qunbound))
3117 left_no_change = 1;
3118 if (f->left_pos < 0)
3119 left = Fcons (Qplus, Fcons (make_number (f->left_pos), Qnil));
3120 else
3121 XSETINT (left, f->left_pos);
3123 if (EQ (top, Qunbound))
3125 top_no_change = 1;
3126 if (f->top_pos < 0)
3127 top = Fcons (Qplus, Fcons (make_number (f->top_pos), Qnil));
3128 else
3129 XSETINT (top, f->top_pos);
3132 /* If one of the icon positions was not set, preserve or default it. */
3133 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
3135 icon_left_no_change = 1;
3136 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
3137 if (NILP (icon_left))
3138 XSETINT (icon_left, 0);
3140 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
3142 icon_top_no_change = 1;
3143 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
3144 if (NILP (icon_top))
3145 XSETINT (icon_top, 0);
3148 if (FRAME_VISIBLE_P (f) && fullscreen_is_being_set)
3150 /* If the frame is visible already and the fullscreen parameter is
3151 being set, it is too late to set WM manager hints to specify
3152 size and position.
3153 Here we first get the width, height and position that applies to
3154 fullscreen. We then move the frame to the appropriate
3155 position. Resize of the frame is taken care of in the code after
3156 this if-statement. */
3157 int new_left, new_top;
3159 x_fullscreen_adjust (f, &width, &height, &new_top, &new_left);
3160 if (new_top != f->top_pos || new_left != f->left_pos)
3161 x_set_offset (f, new_left, new_top, 1);
3164 /* Don't set these parameters unless they've been explicitly
3165 specified. The window might be mapped or resized while we're in
3166 this function, and we don't want to override that unless the lisp
3167 code has asked for it.
3169 Don't set these parameters unless they actually differ from the
3170 window's current parameters; the window may not actually exist
3171 yet. */
3173 Lisp_Object frame;
3175 check_frame_size (f, &height, &width);
3177 XSETFRAME (frame, f);
3179 if (width != FRAME_COLS (f)
3180 || height != FRAME_LINES (f)
3181 || f->new_text_lines || f->new_text_cols)
3182 Fset_frame_size (frame, make_number (width), make_number (height));
3184 if ((!NILP (left) || !NILP (top))
3185 && ! (left_no_change && top_no_change)
3186 && ! (NUMBERP (left) && XINT (left) == f->left_pos
3187 && NUMBERP (top) && XINT (top) == f->top_pos))
3189 int leftpos = 0;
3190 int toppos = 0;
3192 /* Record the signs. */
3193 f->size_hint_flags &= ~ (XNegative | YNegative);
3194 if (EQ (left, Qminus))
3195 f->size_hint_flags |= XNegative;
3196 else if (INTEGERP (left))
3198 leftpos = XINT (left);
3199 if (leftpos < 0)
3200 f->size_hint_flags |= XNegative;
3202 else if (CONSP (left) && EQ (XCAR (left), Qminus)
3203 && CONSP (XCDR (left))
3204 && INTEGERP (XCAR (XCDR (left))))
3206 leftpos = - XINT (XCAR (XCDR (left)));
3207 f->size_hint_flags |= XNegative;
3209 else if (CONSP (left) && EQ (XCAR (left), Qplus)
3210 && CONSP (XCDR (left))
3211 && INTEGERP (XCAR (XCDR (left))))
3213 leftpos = XINT (XCAR (XCDR (left)));
3216 if (EQ (top, Qminus))
3217 f->size_hint_flags |= YNegative;
3218 else if (INTEGERP (top))
3220 toppos = XINT (top);
3221 if (toppos < 0)
3222 f->size_hint_flags |= YNegative;
3224 else if (CONSP (top) && EQ (XCAR (top), Qminus)
3225 && CONSP (XCDR (top))
3226 && INTEGERP (XCAR (XCDR (top))))
3228 toppos = - XINT (XCAR (XCDR (top)));
3229 f->size_hint_flags |= YNegative;
3231 else if (CONSP (top) && EQ (XCAR (top), Qplus)
3232 && CONSP (XCDR (top))
3233 && INTEGERP (XCAR (XCDR (top))))
3235 toppos = XINT (XCAR (XCDR (top)));
3239 /* Store the numeric value of the position. */
3240 f->top_pos = toppos;
3241 f->left_pos = leftpos;
3243 f->win_gravity = NorthWestGravity;
3245 /* Actually set that position, and convert to absolute. */
3246 x_set_offset (f, leftpos, toppos, -1);
3249 if ((!NILP (icon_left) || !NILP (icon_top))
3250 && ! (icon_left_no_change && icon_top_no_change))
3251 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
3254 UNGCPRO;
3258 /* Insert a description of internally-recorded parameters of frame X
3259 into the parameter alist *ALISTPTR that is to be given to the user.
3260 Only parameters that are specific to the X window system
3261 and whose values are not correctly recorded in the frame's
3262 param_alist need to be considered here. */
3264 void
3265 x_report_frame_params (f, alistptr)
3266 struct frame *f;
3267 Lisp_Object *alistptr;
3269 char buf[16];
3270 Lisp_Object tem;
3272 /* Represent negative positions (off the top or left screen edge)
3273 in a way that Fmodify_frame_parameters will understand correctly. */
3274 XSETINT (tem, f->left_pos);
3275 if (f->left_pos >= 0)
3276 store_in_alist (alistptr, Qleft, tem);
3277 else
3278 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
3280 XSETINT (tem, f->top_pos);
3281 if (f->top_pos >= 0)
3282 store_in_alist (alistptr, Qtop, tem);
3283 else
3284 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
3286 store_in_alist (alistptr, Qborder_width,
3287 make_number (f->border_width));
3288 store_in_alist (alistptr, Qinternal_border_width,
3289 make_number (FRAME_INTERNAL_BORDER_WIDTH (f)));
3290 store_in_alist (alistptr, Qleft_fringe,
3291 make_number (FRAME_LEFT_FRINGE_WIDTH (f)));
3292 store_in_alist (alistptr, Qright_fringe,
3293 make_number (FRAME_RIGHT_FRINGE_WIDTH (f)));
3294 store_in_alist (alistptr, Qscroll_bar_width,
3295 (! FRAME_HAS_VERTICAL_SCROLL_BARS (f)
3296 ? make_number (0)
3297 : FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0
3298 ? make_number (FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3299 /* nil means "use default width"
3300 for non-toolkit scroll bar.
3301 ruler-mode.el depends on this. */
3302 : Qnil));
3303 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
3304 store_in_alist (alistptr, Qwindow_id,
3305 build_string (buf));
3306 #ifdef HAVE_X_WINDOWS
3307 #ifdef USE_X_TOOLKIT
3308 /* Tooltip frame may not have this widget. */
3309 if (FRAME_X_OUTPUT (f)->widget)
3310 #endif
3311 sprintf (buf, "%ld", (long) FRAME_OUTER_WINDOW (f));
3312 store_in_alist (alistptr, Qouter_window_id,
3313 build_string (buf));
3314 #endif
3315 store_in_alist (alistptr, Qicon_name, f->icon_name);
3316 FRAME_SAMPLE_VISIBILITY (f);
3317 store_in_alist (alistptr, Qvisibility,
3318 (FRAME_VISIBLE_P (f) ? Qt
3319 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
3320 store_in_alist (alistptr, Qdisplay,
3321 XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
3323 if (FRAME_X_OUTPUT (f)->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
3324 tem = Qnil;
3325 else
3326 XSETFASTINT (tem, FRAME_X_OUTPUT (f)->parent_desc);
3327 store_in_alist (alistptr, Qparent_id, tem);
3331 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
3332 the previous value of that parameter, NEW_VALUE is the new value. */
3334 void
3335 x_set_fullscreen (f, new_value, old_value)
3336 struct frame *f;
3337 Lisp_Object new_value, old_value;
3339 if (NILP (new_value))
3340 f->want_fullscreen = FULLSCREEN_NONE;
3341 else if (EQ (new_value, Qfullboth))
3342 f->want_fullscreen = FULLSCREEN_BOTH;
3343 else if (EQ (new_value, Qfullwidth))
3344 f->want_fullscreen = FULLSCREEN_WIDTH;
3345 else if (EQ (new_value, Qfullheight))
3346 f->want_fullscreen = FULLSCREEN_HEIGHT;
3348 if (FRAME_TERMINAL (f)->fullscreen_hook != NULL)
3349 FRAME_TERMINAL (f)->fullscreen_hook (f);
3353 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
3354 the previous value of that parameter, NEW_VALUE is the new value. */
3356 void
3357 x_set_line_spacing (f, new_value, old_value)
3358 struct frame *f;
3359 Lisp_Object new_value, old_value;
3361 if (NILP (new_value))
3362 f->extra_line_spacing = 0;
3363 else if (NATNUMP (new_value))
3364 f->extra_line_spacing = XFASTINT (new_value);
3365 else
3366 signal_error ("Invalid line-spacing", new_value);
3367 if (FRAME_VISIBLE_P (f))
3368 redraw_frame (f);
3372 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
3373 the previous value of that parameter, NEW_VALUE is the new value. */
3375 void
3376 x_set_screen_gamma (f, new_value, old_value)
3377 struct frame *f;
3378 Lisp_Object new_value, old_value;
3380 Lisp_Object bgcolor;
3382 if (NILP (new_value))
3383 f->gamma = 0;
3384 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
3385 /* The value 0.4545 is the normal viewing gamma. */
3386 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
3387 else
3388 signal_error ("Invalid screen-gamma", new_value);
3390 /* Apply the new gamma value to the frame background. */
3391 bgcolor = Fassq (Qbackground_color, f->param_alist);
3392 if (CONSP (bgcolor) && (bgcolor = XCDR (bgcolor), STRINGP (bgcolor)))
3394 Lisp_Object index = Fget (Qbackground_color, Qx_frame_parameter);
3395 if (NATNUMP (index)
3396 && (XFASTINT (index)
3397 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3398 && FRAME_RIF (f)->frame_parm_handlers[XFASTINT (index)])
3399 (*FRAME_RIF (f)->frame_parm_handlers[XFASTINT (index)])
3400 (f, bgcolor, Qnil);
3403 Fclear_face_cache (Qnil);
3407 void
3408 x_set_font (f, arg, oldval)
3409 struct frame *f;
3410 Lisp_Object arg, oldval;
3412 Lisp_Object result;
3413 Lisp_Object fontset_name;
3414 Lisp_Object frame;
3415 int old_fontset = FRAME_FONTSET(f);
3417 CHECK_STRING (arg);
3419 fontset_name = Fquery_fontset (arg, Qnil);
3421 BLOCK_INPUT;
3422 result = (STRINGP (fontset_name)
3423 ? x_new_fontset (f, SDATA (fontset_name))
3424 : x_new_font (f, SDATA (arg)));
3425 UNBLOCK_INPUT;
3427 if (EQ (result, Qnil))
3428 error ("Font `%s' is not defined", SDATA (arg));
3429 else if (EQ (result, Qt))
3430 error ("The characters of the given font have varying widths");
3431 else if (STRINGP (result))
3433 set_default_ascii_font (result);
3434 if (STRINGP (fontset_name))
3436 /* Fontset names are built from ASCII font names, so the
3437 names may be equal despite there was a change. */
3438 if (old_fontset == FRAME_FONTSET (f))
3439 return;
3441 else if (!NILP (Fequal (result, oldval)))
3442 return;
3444 /* Recalculate toolbar height. */
3445 f->n_tool_bar_rows = 0;
3446 /* Ensure we redraw it. */
3447 clear_current_matrices (f);
3449 store_frame_param (f, Qfont, result);
3450 recompute_basic_faces (f);
3452 else
3453 abort ();
3455 do_pending_window_change (0);
3457 /* Don't call `face-set-after-frame-default' when faces haven't been
3458 initialized yet. This is the case when called from
3459 Fx_create_frame. In that case, the X widget or window doesn't
3460 exist either, and we can end up in x_report_frame_params with a
3461 null widget which gives a segfault. */
3462 if (FRAME_FACE_CACHE (f))
3464 XSETFRAME (frame, f);
3465 call1 (Qface_set_after_frame_default, frame);
3470 void
3471 x_set_fringe_width (f, new_value, old_value)
3472 struct frame *f;
3473 Lisp_Object new_value, old_value;
3475 compute_fringe_widths (f, 1);
3478 void
3479 x_set_border_width (f, arg, oldval)
3480 struct frame *f;
3481 Lisp_Object arg, oldval;
3483 CHECK_NUMBER (arg);
3485 if (XINT (arg) == f->border_width)
3486 return;
3488 if (FRAME_X_WINDOW (f) != 0)
3489 error ("Cannot change the border width of a frame");
3491 f->border_width = XINT (arg);
3494 void
3495 x_set_internal_border_width (f, arg, oldval)
3496 struct frame *f;
3497 Lisp_Object arg, oldval;
3499 int old = FRAME_INTERNAL_BORDER_WIDTH (f);
3501 CHECK_NUMBER (arg);
3502 FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
3503 if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
3504 FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
3506 #ifdef USE_X_TOOLKIT
3507 if (FRAME_X_OUTPUT (f)->edit_widget)
3508 widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
3509 #endif
3511 if (FRAME_INTERNAL_BORDER_WIDTH (f) == old)
3512 return;
3514 if (FRAME_X_WINDOW (f) != 0)
3516 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3517 SET_FRAME_GARBAGED (f);
3518 do_pending_window_change (0);
3520 else
3521 SET_FRAME_GARBAGED (f);
3524 void
3525 x_set_visibility (f, value, oldval)
3526 struct frame *f;
3527 Lisp_Object value, oldval;
3529 Lisp_Object frame;
3530 XSETFRAME (frame, f);
3532 if (NILP (value))
3533 Fmake_frame_invisible (frame, Qt);
3534 else if (EQ (value, Qicon))
3535 Ficonify_frame (frame);
3536 else
3537 Fmake_frame_visible (frame);
3540 void
3541 x_set_autoraise (f, arg, oldval)
3542 struct frame *f;
3543 Lisp_Object arg, oldval;
3545 f->auto_raise = !EQ (Qnil, arg);
3548 void
3549 x_set_autolower (f, arg, oldval)
3550 struct frame *f;
3551 Lisp_Object arg, oldval;
3553 f->auto_lower = !EQ (Qnil, arg);
3556 void
3557 x_set_unsplittable (f, arg, oldval)
3558 struct frame *f;
3559 Lisp_Object arg, oldval;
3561 f->no_split = !NILP (arg);
3564 void
3565 x_set_vertical_scroll_bars (f, arg, oldval)
3566 struct frame *f;
3567 Lisp_Object arg, oldval;
3569 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
3570 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
3571 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
3572 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
3574 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
3575 = (NILP (arg)
3576 ? vertical_scroll_bar_none
3577 : EQ (Qleft, arg)
3578 ? vertical_scroll_bar_left
3579 : EQ (Qright, arg)
3580 ? vertical_scroll_bar_right
3581 : EQ (Qleft, Vdefault_frame_scroll_bars)
3582 ? vertical_scroll_bar_left
3583 : EQ (Qright, Vdefault_frame_scroll_bars)
3584 ? vertical_scroll_bar_right
3585 : vertical_scroll_bar_none);
3587 /* We set this parameter before creating the X window for the
3588 frame, so we can get the geometry right from the start.
3589 However, if the window hasn't been created yet, we shouldn't
3590 call x_set_window_size. */
3591 if (FRAME_X_WINDOW (f))
3592 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3593 do_pending_window_change (0);
3597 void
3598 x_set_scroll_bar_width (f, arg, oldval)
3599 struct frame *f;
3600 Lisp_Object arg, oldval;
3602 int wid = FRAME_COLUMN_WIDTH (f);
3604 if (NILP (arg))
3606 x_set_scroll_bar_default_width (f);
3608 if (FRAME_X_WINDOW (f))
3609 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3610 do_pending_window_change (0);
3612 else if (INTEGERP (arg) && XINT (arg) > 0
3613 && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3615 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
3616 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
3618 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg);
3619 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
3620 if (FRAME_X_WINDOW (f))
3621 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3622 do_pending_window_change (0);
3625 change_frame_size (f, 0, FRAME_COLS (f), 0, 0, 0);
3626 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
3627 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
3632 /* Return non-nil if frame F wants a bitmap icon. */
3634 Lisp_Object
3635 x_icon_type (f)
3636 FRAME_PTR f;
3638 Lisp_Object tem;
3640 tem = assq_no_quit (Qicon_type, f->param_alist);
3641 if (CONSP (tem))
3642 return XCDR (tem);
3643 else
3644 return Qnil;
3648 /* Subroutines of creating an X frame. */
3650 /* Make sure that Vx_resource_name is set to a reasonable value.
3651 Fix it up, or set it to `emacs' if it is too hopeless. */
3653 void
3654 validate_x_resource_name ()
3656 int len = 0;
3657 /* Number of valid characters in the resource name. */
3658 int good_count = 0;
3659 /* Number of invalid characters in the resource name. */
3660 int bad_count = 0;
3661 Lisp_Object new;
3662 int i;
3664 if (!STRINGP (Vx_resource_class))
3665 Vx_resource_class = build_string (EMACS_CLASS);
3667 if (STRINGP (Vx_resource_name))
3669 unsigned char *p = SDATA (Vx_resource_name);
3670 int i;
3672 len = SBYTES (Vx_resource_name);
3674 /* Only letters, digits, - and _ are valid in resource names.
3675 Count the valid characters and count the invalid ones. */
3676 for (i = 0; i < len; i++)
3678 int c = p[i];
3679 if (! ((c >= 'a' && c <= 'z')
3680 || (c >= 'A' && c <= 'Z')
3681 || (c >= '0' && c <= '9')
3682 || c == '-' || c == '_'))
3683 bad_count++;
3684 else
3685 good_count++;
3688 else
3689 /* Not a string => completely invalid. */
3690 bad_count = 5, good_count = 0;
3692 /* If name is valid already, return. */
3693 if (bad_count == 0)
3694 return;
3696 /* If name is entirely invalid, or nearly so, use `emacs'. */
3697 if (good_count == 0
3698 || (good_count == 1 && bad_count > 0))
3700 Vx_resource_name = build_string ("emacs");
3701 return;
3704 /* Name is partly valid. Copy it and replace the invalid characters
3705 with underscores. */
3707 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
3709 for (i = 0; i < len; i++)
3711 int c = SREF (new, i);
3712 if (! ((c >= 'a' && c <= 'z')
3713 || (c >= 'A' && c <= 'Z')
3714 || (c >= '0' && c <= '9')
3715 || c == '-' || c == '_'))
3716 SSET (new, i, '_');
3721 extern char *x_get_string_resource P_ ((XrmDatabase, char *, char *));
3722 extern Display_Info *check_x_display_info P_ ((Lisp_Object));
3725 /* Get specified attribute from resource database RDB.
3726 See Fx_get_resource below for other parameters. */
3728 static Lisp_Object
3729 xrdb_get_resource (rdb, attribute, class, component, subclass)
3730 XrmDatabase rdb;
3731 Lisp_Object attribute, class, component, subclass;
3733 register char *value;
3734 char *name_key;
3735 char *class_key;
3737 CHECK_STRING (attribute);
3738 CHECK_STRING (class);
3740 if (!NILP (component))
3741 CHECK_STRING (component);
3742 if (!NILP (subclass))
3743 CHECK_STRING (subclass);
3744 if (NILP (component) != NILP (subclass))
3745 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3747 validate_x_resource_name ();
3749 /* Allocate space for the components, the dots which separate them,
3750 and the final '\0'. Make them big enough for the worst case. */
3751 name_key = (char *) alloca (SBYTES (Vx_resource_name)
3752 + (STRINGP (component)
3753 ? SBYTES (component) : 0)
3754 + SBYTES (attribute)
3755 + 3);
3757 class_key = (char *) alloca (SBYTES (Vx_resource_class)
3758 + SBYTES (class)
3759 + (STRINGP (subclass)
3760 ? SBYTES (subclass) : 0)
3761 + 3);
3763 /* Start with emacs.FRAMENAME for the name (the specific one)
3764 and with `Emacs' for the class key (the general one). */
3765 strcpy (name_key, SDATA (Vx_resource_name));
3766 strcpy (class_key, SDATA (Vx_resource_class));
3768 strcat (class_key, ".");
3769 strcat (class_key, SDATA (class));
3771 if (!NILP (component))
3773 strcat (class_key, ".");
3774 strcat (class_key, SDATA (subclass));
3776 strcat (name_key, ".");
3777 strcat (name_key, SDATA (component));
3780 strcat (name_key, ".");
3781 strcat (name_key, SDATA (attribute));
3783 value = x_get_string_resource (rdb, name_key, class_key);
3785 if (value != (char *) 0)
3786 return build_string (value);
3787 else
3788 return Qnil;
3792 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
3793 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
3794 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
3795 class, where INSTANCE is the name under which Emacs was invoked, or
3796 the name specified by the `-name' or `-rn' command-line arguments.
3798 The optional arguments COMPONENT and SUBCLASS add to the key and the
3799 class, respectively. You must specify both of them or neither.
3800 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
3801 and the class is `Emacs.CLASS.SUBCLASS'. */)
3802 (attribute, class, component, subclass)
3803 Lisp_Object attribute, class, component, subclass;
3805 #ifdef HAVE_X_WINDOWS
3806 check_x ();
3807 #endif
3809 return xrdb_get_resource (check_x_display_info (Qnil)->xrdb,
3810 attribute, class, component, subclass);
3813 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
3815 Lisp_Object
3816 display_x_get_resource (dpyinfo, attribute, class, component, subclass)
3817 Display_Info *dpyinfo;
3818 Lisp_Object attribute, class, component, subclass;
3820 return xrdb_get_resource (dpyinfo->xrdb,
3821 attribute, class, component, subclass);
3824 /* Used when C code wants a resource value. */
3826 char *
3827 x_get_resource_string (attribute, class)
3828 char *attribute, *class;
3830 char *name_key;
3831 char *class_key;
3832 struct frame *sf = SELECTED_FRAME ();
3834 /* Allocate space for the components, the dots which separate them,
3835 and the final '\0'. */
3836 name_key = (char *) alloca (SBYTES (Vinvocation_name)
3837 + strlen (attribute) + 2);
3838 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
3839 + strlen (class) + 2);
3841 sprintf (name_key, "%s.%s", SDATA (Vinvocation_name), attribute);
3842 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3844 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
3845 name_key, class_key);
3849 /* Return the value of parameter PARAM.
3851 First search ALIST, then Vdefault_frame_alist, then the X defaults
3852 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3854 Convert the resource to the type specified by desired_type.
3856 If no default is specified, return Qunbound. If you call
3857 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3858 and don't let it get stored in any Lisp-visible variables! */
3860 Lisp_Object
3861 x_get_arg (dpyinfo, alist, param, attribute, class, type)
3862 Display_Info *dpyinfo;
3863 Lisp_Object alist, param;
3864 char *attribute;
3865 char *class;
3866 enum resource_types type;
3868 register Lisp_Object tem;
3870 tem = Fassq (param, alist);
3872 if (!NILP (tem))
3874 /* If we find this parm in ALIST, clear it out
3875 so that it won't be "left over" at the end. */
3876 #ifndef WINDOWSNT /* w32fns.c has not yet been changed to cope with this. */
3877 Lisp_Object tail;
3878 XSETCAR (tem, Qnil);
3879 /* In case the parameter appears more than once in the alist,
3880 clear it out. */
3881 for (tail = alist; CONSP (tail); tail = XCDR (tail))
3882 if (CONSP (XCAR (tail))
3883 && EQ (XCAR (XCAR (tail)), param))
3884 XSETCAR (XCAR (tail), Qnil);
3885 #endif
3887 else
3888 tem = Fassq (param, Vdefault_frame_alist);
3890 /* If it wasn't specified in ALIST or the Lisp-level defaults,
3891 look in the X resources. */
3892 if (EQ (tem, Qnil))
3894 if (attribute)
3896 tem = display_x_get_resource (dpyinfo,
3897 build_string (attribute),
3898 build_string (class),
3899 Qnil, Qnil);
3901 if (NILP (tem))
3902 return Qunbound;
3904 switch (type)
3906 case RES_TYPE_NUMBER:
3907 return make_number (atoi (SDATA (tem)));
3909 case RES_TYPE_FLOAT:
3910 return make_float (atof (SDATA (tem)));
3912 case RES_TYPE_BOOLEAN:
3913 tem = Fdowncase (tem);
3914 if (!strcmp (SDATA (tem), "on")
3915 || !strcmp (SDATA (tem), "true"))
3916 return Qt;
3917 else
3918 return Qnil;
3920 case RES_TYPE_STRING:
3921 return tem;
3923 case RES_TYPE_SYMBOL:
3924 /* As a special case, we map the values `true' and `on'
3925 to Qt, and `false' and `off' to Qnil. */
3927 Lisp_Object lower;
3928 lower = Fdowncase (tem);
3929 if (!strcmp (SDATA (lower), "on")
3930 || !strcmp (SDATA (lower), "true"))
3931 return Qt;
3932 else if (!strcmp (SDATA (lower), "off")
3933 || !strcmp (SDATA (lower), "false"))
3934 return Qnil;
3935 else
3936 return Fintern (tem, Qnil);
3939 default:
3940 abort ();
3943 else
3944 return Qunbound;
3946 return Fcdr (tem);
3949 Lisp_Object
3950 x_frame_get_arg (f, alist, param, attribute, class, type)
3951 struct frame *f;
3952 Lisp_Object alist, param;
3953 char *attribute;
3954 char *class;
3955 enum resource_types type;
3957 return x_get_arg (FRAME_X_DISPLAY_INFO (f),
3958 alist, param, attribute, class, type);
3961 /* Like x_frame_get_arg, but also record the value in f->param_alist. */
3963 Lisp_Object
3964 x_frame_get_and_record_arg (f, alist, param, attribute, class, type)
3965 struct frame *f;
3966 Lisp_Object alist, param;
3967 char *attribute;
3968 char *class;
3969 enum resource_types type;
3971 Lisp_Object value;
3973 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
3974 attribute, class, type);
3975 if (! NILP (value) && ! EQ (value, Qunbound))
3976 store_frame_param (f, param, value);
3978 return value;
3982 /* Record in frame F the specified or default value according to ALIST
3983 of the parameter named PROP (a Lisp symbol).
3984 If no value is specified for PROP, look for an X default for XPROP
3985 on the frame named NAME.
3986 If that is not found either, use the value DEFLT. */
3988 Lisp_Object
3989 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
3990 struct frame *f;
3991 Lisp_Object alist;
3992 Lisp_Object prop;
3993 Lisp_Object deflt;
3994 char *xprop;
3995 char *xclass;
3996 enum resource_types type;
3998 Lisp_Object tem;
4000 tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type);
4001 if (EQ (tem, Qunbound))
4002 tem = deflt;
4003 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
4004 return tem;
4010 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
4011 doc: /* Parse an X-style geometry string STRING.
4012 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
4013 The properties returned may include `top', `left', `height', and `width'.
4014 The value of `left' or `top' may be an integer,
4015 or a list (+ N) meaning N pixels relative to top/left corner,
4016 or a list (- N) meaning -N pixels relative to bottom/right corner. */)
4017 (string)
4018 Lisp_Object string;
4020 int geometry, x, y;
4021 unsigned int width, height;
4022 Lisp_Object result;
4024 CHECK_STRING (string);
4026 geometry = XParseGeometry ((char *) SDATA (string),
4027 &x, &y, &width, &height);
4029 #if 0
4030 if (!!(geometry & XValue) != !!(geometry & YValue))
4031 error ("Must specify both x and y position, or neither");
4032 #endif
4034 result = Qnil;
4035 if (geometry & XValue)
4037 Lisp_Object element;
4039 if (x >= 0 && (geometry & XNegative))
4040 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
4041 else if (x < 0 && ! (geometry & XNegative))
4042 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
4043 else
4044 element = Fcons (Qleft, make_number (x));
4045 result = Fcons (element, result);
4048 if (geometry & YValue)
4050 Lisp_Object element;
4052 if (y >= 0 && (geometry & YNegative))
4053 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
4054 else if (y < 0 && ! (geometry & YNegative))
4055 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
4056 else
4057 element = Fcons (Qtop, make_number (y));
4058 result = Fcons (element, result);
4061 if (geometry & WidthValue)
4062 result = Fcons (Fcons (Qwidth, make_number (width)), result);
4063 if (geometry & HeightValue)
4064 result = Fcons (Fcons (Qheight, make_number (height)), result);
4066 return result;
4069 /* Calculate the desired size and position of frame F.
4070 Return the flags saying which aspects were specified.
4072 Also set the win_gravity and size_hint_flags of F.
4074 Adjust height for toolbar if TOOLBAR_P is 1.
4076 This function does not make the coordinates positive. */
4078 #define DEFAULT_ROWS 40
4079 #define DEFAULT_COLS 80
4082 x_figure_window_size (f, parms, toolbar_p)
4083 struct frame *f;
4084 Lisp_Object parms;
4085 int toolbar_p;
4087 register Lisp_Object tem0, tem1, tem2;
4088 long window_prompting = 0;
4089 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
4091 /* Default values if we fall through.
4092 Actually, if that happens we should get
4093 window manager prompting. */
4094 SET_FRAME_COLS (f, DEFAULT_COLS);
4095 FRAME_LINES (f) = DEFAULT_ROWS;
4096 /* Window managers expect that if program-specified
4097 positions are not (0,0), they're intentional, not defaults. */
4098 f->top_pos = 0;
4099 f->left_pos = 0;
4101 /* Ensure that old new_text_cols and new_text_lines will not override the
4102 values set here. */
4103 /* ++KFS: This was specific to W32, but seems ok for all platforms */
4104 f->new_text_cols = f->new_text_lines = 0;
4106 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
4107 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
4108 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
4109 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4111 if (!EQ (tem0, Qunbound))
4113 CHECK_NUMBER (tem0);
4114 FRAME_LINES (f) = XINT (tem0);
4116 if (!EQ (tem1, Qunbound))
4118 CHECK_NUMBER (tem1);
4119 SET_FRAME_COLS (f, XINT (tem1));
4121 if (!NILP (tem2) && !EQ (tem2, Qunbound))
4122 window_prompting |= USSize;
4123 else
4124 window_prompting |= PSize;
4127 f->scroll_bar_actual_width
4128 = FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f);
4130 /* This used to be done _before_ calling x_figure_window_size, but
4131 since the height is reset here, this was really a no-op. I
4132 assume that moving it here does what Gerd intended (although he
4133 no longer can remember what that was... ++KFS, 2003-03-25. */
4135 /* Add the tool-bar height to the initial frame height so that the
4136 user gets a text display area of the size he specified with -g or
4137 via .Xdefaults. Later changes of the tool-bar height don't
4138 change the frame size. This is done so that users can create
4139 tall Emacs frames without having to guess how tall the tool-bar
4140 will get. */
4141 if (toolbar_p && FRAME_TOOL_BAR_LINES (f))
4143 int margin, relief, bar_height;
4145 relief = (tool_bar_button_relief >= 0
4146 ? tool_bar_button_relief
4147 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
4149 if (INTEGERP (Vtool_bar_button_margin)
4150 && XINT (Vtool_bar_button_margin) > 0)
4151 margin = XFASTINT (Vtool_bar_button_margin);
4152 else if (CONSP (Vtool_bar_button_margin)
4153 && INTEGERP (XCDR (Vtool_bar_button_margin))
4154 && XINT (XCDR (Vtool_bar_button_margin)) > 0)
4155 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
4156 else
4157 margin = 0;
4159 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
4160 FRAME_LINES (f) += (bar_height + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f);
4163 compute_fringe_widths (f, 0);
4165 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, FRAME_COLS (f));
4166 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, FRAME_LINES (f));
4168 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
4169 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
4170 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
4171 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4173 if (EQ (tem0, Qminus))
4175 f->top_pos = 0;
4176 window_prompting |= YNegative;
4178 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
4179 && CONSP (XCDR (tem0))
4180 && INTEGERP (XCAR (XCDR (tem0))))
4182 f->top_pos = - XINT (XCAR (XCDR (tem0)));
4183 window_prompting |= YNegative;
4185 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
4186 && CONSP (XCDR (tem0))
4187 && INTEGERP (XCAR (XCDR (tem0))))
4189 f->top_pos = XINT (XCAR (XCDR (tem0)));
4191 else if (EQ (tem0, Qunbound))
4192 f->top_pos = 0;
4193 else
4195 CHECK_NUMBER (tem0);
4196 f->top_pos = XINT (tem0);
4197 if (f->top_pos < 0)
4198 window_prompting |= YNegative;
4201 if (EQ (tem1, Qminus))
4203 f->left_pos = 0;
4204 window_prompting |= XNegative;
4206 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
4207 && CONSP (XCDR (tem1))
4208 && INTEGERP (XCAR (XCDR (tem1))))
4210 f->left_pos = - XINT (XCAR (XCDR (tem1)));
4211 window_prompting |= XNegative;
4213 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
4214 && CONSP (XCDR (tem1))
4215 && INTEGERP (XCAR (XCDR (tem1))))
4217 f->left_pos = XINT (XCAR (XCDR (tem1)));
4219 else if (EQ (tem1, Qunbound))
4220 f->left_pos = 0;
4221 else
4223 CHECK_NUMBER (tem1);
4224 f->left_pos = XINT (tem1);
4225 if (f->left_pos < 0)
4226 window_prompting |= XNegative;
4229 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
4230 window_prompting |= USPosition;
4231 else
4232 window_prompting |= PPosition;
4235 if (f->want_fullscreen != FULLSCREEN_NONE)
4237 int left, top;
4238 int width, height;
4240 /* It takes both for some WM:s to place it where we want */
4241 window_prompting = USPosition | PPosition;
4242 x_fullscreen_adjust (f, &width, &height, &top, &left);
4243 FRAME_COLS (f) = width;
4244 FRAME_LINES (f) = height;
4245 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, width);
4246 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, height);
4247 f->left_pos = left;
4248 f->top_pos = top;
4251 if (window_prompting & XNegative)
4253 if (window_prompting & YNegative)
4254 f->win_gravity = SouthEastGravity;
4255 else
4256 f->win_gravity = NorthEastGravity;
4258 else
4260 if (window_prompting & YNegative)
4261 f->win_gravity = SouthWestGravity;
4262 else
4263 f->win_gravity = NorthWestGravity;
4266 f->size_hint_flags = window_prompting;
4268 return window_prompting;
4273 #endif /* HAVE_WINDOW_SYSTEM */
4277 /***********************************************************************
4278 Initialization
4279 ***********************************************************************/
4281 void
4282 syms_of_frame ()
4284 Qframep = intern ("framep");
4285 staticpro (&Qframep);
4286 Qframe_live_p = intern ("frame-live-p");
4287 staticpro (&Qframe_live_p);
4288 Qheight = intern ("height");
4289 staticpro (&Qheight);
4290 Qicon = intern ("icon");
4291 staticpro (&Qicon);
4292 Qminibuffer = intern ("minibuffer");
4293 staticpro (&Qminibuffer);
4294 Qmodeline = intern ("modeline");
4295 staticpro (&Qmodeline);
4296 Qonly = intern ("only");
4297 staticpro (&Qonly);
4298 Qwidth = intern ("width");
4299 staticpro (&Qwidth);
4300 Qgeometry = intern ("geometry");
4301 staticpro (&Qgeometry);
4302 Qicon_left = intern ("icon-left");
4303 staticpro (&Qicon_left);
4304 Qicon_top = intern ("icon-top");
4305 staticpro (&Qicon_top);
4306 Qleft = intern ("left");
4307 staticpro (&Qleft);
4308 Qright = intern ("right");
4309 staticpro (&Qright);
4310 Quser_position = intern ("user-position");
4311 staticpro (&Quser_position);
4312 Quser_size = intern ("user-size");
4313 staticpro (&Quser_size);
4314 Qwindow_id = intern ("window-id");
4315 staticpro (&Qwindow_id);
4316 #ifdef HAVE_X_WINDOWS
4317 Qouter_window_id = intern ("outer-window-id");
4318 staticpro (&Qouter_window_id);
4319 #endif
4320 Qparent_id = intern ("parent-id");
4321 staticpro (&Qparent_id);
4322 Qx = intern ("x");
4323 staticpro (&Qx);
4324 Qw32 = intern ("w32");
4325 staticpro (&Qw32);
4326 Qpc = intern ("pc");
4327 staticpro (&Qpc);
4328 Qmac = intern ("mac");
4329 staticpro (&Qmac);
4330 Qvisible = intern ("visible");
4331 staticpro (&Qvisible);
4332 Qbuffer_predicate = intern ("buffer-predicate");
4333 staticpro (&Qbuffer_predicate);
4334 Qbuffer_list = intern ("buffer-list");
4335 staticpro (&Qbuffer_list);
4336 Qburied_buffer_list = intern ("buried-buffer-list");
4337 staticpro (&Qburied_buffer_list);
4338 Qdisplay_type = intern ("display-type");
4339 staticpro (&Qdisplay_type);
4340 Qbackground_mode = intern ("background-mode");
4341 staticpro (&Qbackground_mode);
4342 Qtty_color_mode = intern ("tty-color-mode");
4343 staticpro (&Qtty_color_mode);
4344 Qtty = intern ("tty");
4345 staticpro (&Qtty);
4346 Qtty_type = intern ("tty-type");
4347 staticpro (&Qtty_type);
4348 Qwindow_system = intern ("window-system");
4349 staticpro (&Qwindow_system);
4350 Qenvironment = intern ("environment");
4351 staticpro (&Qenvironment);
4353 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
4354 staticpro (&Qface_set_after_frame_default);
4356 Qinhibit_face_set_after_frame_default
4357 = intern ("inhibit-face-set-after-frame-default");
4358 staticpro (&Qinhibit_face_set_after_frame_default);
4360 Qfullwidth = intern ("fullwidth");
4361 staticpro (&Qfullwidth);
4362 Qfullheight = intern ("fullheight");
4363 staticpro (&Qfullheight);
4364 Qfullboth = intern ("fullboth");
4365 staticpro (&Qfullboth);
4366 Qx_resource_name = intern ("x-resource-name");
4367 staticpro (&Qx_resource_name);
4369 Qx_frame_parameter = intern ("x-frame-parameter");
4370 staticpro (&Qx_frame_parameter);
4372 Qterminal = intern ("terminal");
4373 staticpro (&Qterminal);
4374 Qterminal_live_p = intern ("terminal-live-p");
4375 staticpro (&Qterminal_live_p);
4378 int i;
4380 for (i = 0; i < sizeof (frame_parms) / sizeof (frame_parms[0]); i++)
4382 Lisp_Object v = intern (frame_parms[i].name);
4383 if (frame_parms[i].variable)
4385 *frame_parms[i].variable = v;
4386 staticpro (frame_parms[i].variable);
4388 Fput (v, Qx_frame_parameter, make_number (i));
4392 #ifdef HAVE_WINDOW_SYSTEM
4393 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
4394 doc: /* The name Emacs uses to look up X resources.
4395 `x-get-resource' uses this as the first component of the instance name
4396 when requesting resource values.
4397 Emacs initially sets `x-resource-name' to the name under which Emacs
4398 was invoked, or to the value specified with the `-name' or `-rn'
4399 switches, if present.
4401 It may be useful to bind this variable locally around a call
4402 to `x-get-resource'. See also the variable `x-resource-class'. */);
4403 Vx_resource_name = Qnil;
4405 DEFVAR_LISP ("x-resource-class", &Vx_resource_class,
4406 doc: /* The class Emacs uses to look up X resources.
4407 `x-get-resource' uses this as the first component of the instance class
4408 when requesting resource values.
4410 Emacs initially sets `x-resource-class' to "Emacs".
4412 Setting this variable permanently is not a reasonable thing to do,
4413 but binding this variable locally around a call to `x-get-resource'
4414 is a reasonable practice. See also the variable `x-resource-name'. */);
4415 Vx_resource_class = build_string (EMACS_CLASS);
4416 #endif
4418 DEFVAR_LISP ("default-frame-alist", &Vdefault_frame_alist,
4419 doc: /* Alist of default values for frame creation.
4420 These may be set in your init file, like this:
4421 (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1)))
4422 These override values given in window system configuration data,
4423 including X Windows' defaults database.
4424 For values specific to the first Emacs frame, see `initial-frame-alist'.
4425 For window-system specific values, see `window-system-default-frame-alist'.
4426 For values specific to the separate minibuffer frame, see
4427 `minibuffer-frame-alist'.
4428 The `menu-bar-lines' element of the list controls whether new frames
4429 have menu bars; `menu-bar-mode' works by altering this element.
4430 Setting this variable does not affect existing frames, only new ones. */);
4431 Vdefault_frame_alist = Qnil;
4433 DEFVAR_LISP ("default-frame-scroll-bars", &Vdefault_frame_scroll_bars,
4434 doc: /* Default position of scroll bars on this window-system. */);
4435 #ifdef HAVE_WINDOW_SYSTEM
4436 #if defined(HAVE_NTGUI) || defined(MAC_OS)
4437 /* MS-Windows has scroll bars on the right by default. */
4438 Vdefault_frame_scroll_bars = Qright;
4439 #else
4440 Vdefault_frame_scroll_bars = Qleft;
4441 #endif
4442 #else
4443 Vdefault_frame_scroll_bars = Qnil;
4444 #endif
4446 DEFVAR_LISP ("terminal-frame", &Vterminal_frame,
4447 doc: /* The initial frame-object, which represents Emacs's stdout. */);
4449 DEFVAR_LISP ("emacs-iconified", &Vemacs_iconified,
4450 doc: /* Non-nil if all of Emacs is iconified and frame updates are not needed. */);
4451 Vemacs_iconified = Qnil;
4453 DEFVAR_LISP ("mouse-position-function", &Vmouse_position_function,
4454 doc: /* If non-nil, function to transform normal value of `mouse-position'.
4455 `mouse-position' calls this function, passing its usual return value as
4456 argument, and returns whatever this function returns.
4457 This abnormal hook exists for the benefit of packages like `xt-mouse.el'
4458 which need to do mouse handling at the Lisp level. */);
4459 Vmouse_position_function = Qnil;
4461 DEFVAR_LISP ("mouse-highlight", &Vmouse_highlight,
4462 doc: /* If non-nil, clickable text is highlighted when mouse is over it.
4463 If the value is an integer, highlighting is only shown after moving the
4464 mouse, while keyboard input turns off the highlight even when the mouse
4465 is over the clickable text. However, the mouse shape still indicates
4466 when the mouse is over clickable text. */);
4467 Vmouse_highlight = Qt;
4469 DEFVAR_LISP ("delete-frame-functions", &Vdelete_frame_functions,
4470 doc: /* Functions to be run before deleting a frame.
4471 The functions are run with one arg, the frame to be deleted.
4472 See `delete-frame'.
4474 Note that functions in this list may be called twice on the same
4475 frame. In the second invocation, the frame is already deleted, and
4476 the function should do nothing. (You can use `frame-live-p' to check
4477 for this.) This wrinkle happens when an earlier function in
4478 `delete-frame-functions' (indirectly) calls delete-frame
4479 recursively. */);
4480 Vdelete_frame_functions = Qnil;
4482 DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
4483 doc: /* Minibufferless frames use this frame's minibuffer.
4485 Emacs cannot create minibufferless frames unless this is set to an
4486 appropriate surrogate.
4488 Emacs consults this variable only when creating minibufferless
4489 frames; once the frame is created, it sticks with its assigned
4490 minibuffer, no matter what this variable is set to. This means that
4491 this variable doesn't necessarily say anything meaningful about the
4492 current set of frames, or where the minibuffer is currently being
4493 displayed.
4495 This variable is local to the current terminal and cannot be buffer-local. */);
4497 DEFVAR_BOOL ("focus-follows-mouse", &focus_follows_mouse,
4498 doc: /* Non-nil if window system changes focus when you move the mouse.
4499 You should set this variable to tell Emacs how your window manager
4500 handles focus, since there is no way in general for Emacs to find out
4501 automatically. */);
4502 #ifdef HAVE_WINDOW_SYSTEM
4503 #if defined(HAVE_NTGUI) || defined(MAC_OS)
4504 focus_follows_mouse = 0;
4505 #else
4506 focus_follows_mouse = 1;
4507 #endif
4508 #else
4509 focus_follows_mouse = 0;
4510 #endif
4512 staticpro (&Vframe_list);
4514 defsubr (&Sactive_minibuffer_window);
4515 defsubr (&Sframep);
4516 defsubr (&Sframe_live_p);
4517 defsubr (&Swindow_system);
4518 defsubr (&Smake_terminal_frame);
4519 defsubr (&Shandle_switch_frame);
4520 defsubr (&Sselect_frame);
4521 defsubr (&Sselected_frame);
4522 defsubr (&Swindow_frame);
4523 defsubr (&Sframe_root_window);
4524 defsubr (&Sframe_first_window);
4525 defsubr (&Sframe_selected_window);
4526 defsubr (&Sset_frame_selected_window);
4527 defsubr (&Sframe_list);
4528 defsubr (&Snext_frame);
4529 defsubr (&Sprevious_frame);
4530 defsubr (&Sdelete_frame);
4531 defsubr (&Smouse_position);
4532 defsubr (&Smouse_pixel_position);
4533 defsubr (&Sset_mouse_position);
4534 defsubr (&Sset_mouse_pixel_position);
4535 #if 0
4536 defsubr (&Sframe_configuration);
4537 defsubr (&Srestore_frame_configuration);
4538 #endif
4539 defsubr (&Smake_frame_visible);
4540 defsubr (&Smake_frame_invisible);
4541 defsubr (&Siconify_frame);
4542 defsubr (&Sframe_visible_p);
4543 defsubr (&Svisible_frame_list);
4544 defsubr (&Sraise_frame);
4545 defsubr (&Slower_frame);
4546 defsubr (&Sredirect_frame_focus);
4547 defsubr (&Sframe_focus);
4548 defsubr (&Sframe_parameters);
4549 defsubr (&Sframe_parameter);
4550 defsubr (&Smodify_frame_parameters);
4551 defsubr (&Sframe_with_environment);
4552 defsubr (&Sframe_char_height);
4553 defsubr (&Sframe_char_width);
4554 defsubr (&Sframe_pixel_height);
4555 defsubr (&Sframe_pixel_width);
4556 defsubr (&Sset_frame_height);
4557 defsubr (&Sset_frame_width);
4558 defsubr (&Sset_frame_size);
4559 defsubr (&Sset_frame_position);
4561 #ifdef HAVE_WINDOW_SYSTEM
4562 defsubr (&Sx_get_resource);
4563 defsubr (&Sx_parse_geometry);
4564 #endif
4568 /* arch-tag: 7dbf2c69-9aad-45f8-8296-db893d6dd039
4569 (do not change this comment) */