Fix more GCC strict-aliasing warnings.
[emacs.git] / src / frame.c
blobf1cc0ce019dffdc56a9ee7336a3a8fe08d4996ea
1 /* Generic frame functions.
2 Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2002, 2003,
3 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20 #include <config.h>
22 #include <stdio.h>
23 #include <ctype.h>
24 #include <setjmp.h>
25 #include "lisp.h"
26 #include "character.h"
27 #ifdef HAVE_X_WINDOWS
28 #include "xterm.h"
29 #endif
30 #ifdef WINDOWSNT
31 #include "w32term.h"
32 #endif
33 #ifdef HAVE_NS
34 #include "nsterm.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 #include "blockinput.h"
42 #include "termchar.h"
43 #include "termhooks.h"
44 #include "dispextern.h"
45 #include "window.h"
46 #include "font.h"
47 #ifdef HAVE_WINDOW_SYSTEM
48 #include "fontset.h"
49 #endif
50 #ifdef MSDOS
51 #include "msdos.h"
52 #include "dosfns.h"
53 #endif
56 /* If we shall make pointer invisible when typing or not. */
57 Lisp_Object Vmake_pointer_invisible;
59 #ifdef HAVE_WINDOW_SYSTEM
61 /* The name we're using in resource queries. Most often "emacs". */
63 Lisp_Object Vx_resource_name;
65 /* The application class we're using in resource queries.
66 Normally "Emacs". */
68 Lisp_Object Vx_resource_class;
70 /* Lower limit value of the frame opacity (alpha transparency). */
72 Lisp_Object Vframe_alpha_lower_limit;
74 #endif
76 #ifdef HAVE_NS
77 Lisp_Object Qns_parse_geometry;
78 #endif
80 Lisp_Object Qframep, Qframe_live_p;
81 Lisp_Object Qicon, Qmodeline;
82 Lisp_Object Qonly;
83 Lisp_Object Qx, Qw32, Qmac, Qpc, Qns;
84 Lisp_Object Qvisible;
85 Lisp_Object Qdisplay_type;
86 Lisp_Object Qbackground_mode;
87 Lisp_Object Qnoelisp;
89 Lisp_Object Qx_frame_parameter;
90 Lisp_Object Qx_resource_name;
91 Lisp_Object Qterminal;
92 Lisp_Object Qterminal_live_p;
94 /* Frame parameters (set or reported). */
96 Lisp_Object Qauto_raise, Qauto_lower;
97 Lisp_Object Qborder_color, Qborder_width;
98 Lisp_Object Qcursor_color, Qcursor_type;
99 Lisp_Object Qgeometry; /* Not used */
100 Lisp_Object Qheight, Qwidth;
101 Lisp_Object Qleft, Qright;
102 Lisp_Object Qicon_left, Qicon_top, Qicon_type, Qicon_name;
103 Lisp_Object Qtooltip;
104 Lisp_Object Qinternal_border_width;
105 Lisp_Object Qmouse_color;
106 Lisp_Object Qminibuffer;
107 Lisp_Object Qscroll_bar_width, Qvertical_scroll_bars;
108 Lisp_Object Qvisibility;
109 Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
110 Lisp_Object Qscreen_gamma;
111 Lisp_Object Qline_spacing;
112 Lisp_Object Quser_position, Quser_size;
113 Lisp_Object Qwait_for_wm;
114 Lisp_Object Qwindow_id;
115 #ifdef HAVE_X_WINDOWS
116 Lisp_Object Qouter_window_id;
117 #endif
118 Lisp_Object Qparent_id;
119 Lisp_Object Qtitle, Qname;
120 Lisp_Object Qexplicit_name;
121 Lisp_Object Qunsplittable;
122 Lisp_Object Qmenu_bar_lines, Qtool_bar_lines;
123 Lisp_Object Qleft_fringe, Qright_fringe;
124 Lisp_Object Qbuffer_predicate, Qbuffer_list, Qburied_buffer_list;
125 Lisp_Object Qtty_color_mode;
126 Lisp_Object Qtty, Qtty_type;
128 Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth, Qmaximized;
129 Lisp_Object Qsticky;
130 Lisp_Object Qfont_backend;
131 Lisp_Object Qalpha;
133 Lisp_Object Qface_set_after_frame_default;
135 Lisp_Object Vterminal_frame;
136 Lisp_Object Vdefault_frame_alist;
137 Lisp_Object Vdefault_frame_scroll_bars;
138 Lisp_Object Vmouse_position_function;
139 Lisp_Object Vmouse_highlight;
140 static Lisp_Object Vdelete_frame_functions, Qdelete_frame_functions;
142 int focus_follows_mouse;
144 static void
145 set_menu_bar_lines_1 (window, n)
146 Lisp_Object window;
147 int n;
149 struct window *w = XWINDOW (window);
151 XSETFASTINT (w->last_modified, 0);
152 XSETFASTINT (w->top_line, XFASTINT (w->top_line) + n);
153 XSETFASTINT (w->total_lines, XFASTINT (w->total_lines) - n);
155 if (INTEGERP (w->orig_top_line))
156 XSETFASTINT (w->orig_top_line, XFASTINT (w->orig_top_line) + n);
157 if (INTEGERP (w->orig_total_lines))
158 XSETFASTINT (w->orig_total_lines, XFASTINT (w->orig_total_lines) - n);
160 /* Handle just the top child in a vertical split. */
161 if (!NILP (w->vchild))
162 set_menu_bar_lines_1 (w->vchild, n);
164 /* Adjust all children in a horizontal split. */
165 for (window = w->hchild; !NILP (window); window = w->next)
167 w = XWINDOW (window);
168 set_menu_bar_lines_1 (window, n);
172 void
173 set_menu_bar_lines (f, value, oldval)
174 struct frame *f;
175 Lisp_Object value, oldval;
177 int nlines;
178 int olines = FRAME_MENU_BAR_LINES (f);
180 /* Right now, menu bars don't work properly in minibuf-only frames;
181 most of the commands try to apply themselves to the minibuffer
182 frame itself, and get an error because you can't switch buffers
183 in or split the minibuffer window. */
184 if (FRAME_MINIBUF_ONLY_P (f))
185 return;
187 if (INTEGERP (value))
188 nlines = XINT (value);
189 else
190 nlines = 0;
192 if (nlines != olines)
194 windows_or_buffers_changed++;
195 FRAME_WINDOW_SIZES_CHANGED (f) = 1;
196 FRAME_MENU_BAR_LINES (f) = nlines;
197 set_menu_bar_lines_1 (f->root_window, nlines - olines);
198 adjust_glyphs (f);
202 Lisp_Object Vframe_list;
204 extern Lisp_Object Vminibuffer_list;
205 extern Lisp_Object get_minibuffer ();
206 extern Lisp_Object Fhandle_switch_frame ();
207 extern Lisp_Object Fredirect_frame_focus ();
208 extern Lisp_Object x_get_focus_frame ();
209 extern Lisp_Object QCname, Qfont_param;
212 DEFUN ("framep", Fframep, Sframep, 1, 1, 0,
213 doc: /* Return non-nil if OBJECT is a frame.
214 Value is:
215 t for a termcap frame (a character-only terminal),
216 'x' for an Emacs frame that is really an X window,
217 'w32' for an Emacs frame that is a window on MS-Windows display,
218 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
219 'pc' for a direct-write MS-DOS frame.
220 See also `frame-live-p'. */)
221 (object)
222 Lisp_Object object;
224 if (!FRAMEP (object))
225 return Qnil;
226 switch (XFRAME (object)->output_method)
228 case output_initial: /* The initial frame is like a termcap frame. */
229 case output_termcap:
230 return Qt;
231 case output_x_window:
232 return Qx;
233 case output_w32:
234 return Qw32;
235 case output_msdos_raw:
236 return Qpc;
237 case output_mac:
238 return Qmac;
239 case output_ns:
240 return Qns;
241 default:
242 abort ();
246 DEFUN ("frame-live-p", Fframe_live_p, Sframe_live_p, 1, 1, 0,
247 doc: /* Return non-nil if OBJECT is a frame which has not been deleted.
248 Value is nil if OBJECT is not a live frame. If object is a live
249 frame, the return value indicates what sort of terminal device it is
250 displayed on. See the documentation of `framep' for possible
251 return values. */)
252 (object)
253 Lisp_Object object;
255 return ((FRAMEP (object)
256 && FRAME_LIVE_P (XFRAME (object)))
257 ? Fframep (object)
258 : Qnil);
261 DEFUN ("window-system", Fwindow_system, Swindow_system, 0, 1, 0,
262 doc: /* The name of the window system that FRAME is displaying through.
263 The value is a symbol:
264 nil for a termcap frame (a character-only terminal),
265 'x' for an Emacs frame that is really an X window,
266 'w32' for an Emacs frame that is a window on MS-Windows display,
267 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
268 'pc' for a direct-write MS-DOS frame.
270 FRAME defaults to the currently selected frame.
272 Use of this function as a predicate is deprecated. Instead,
273 use `display-graphic-p' or any of the other `display-*-p'
274 predicates which report frame's specific UI-related capabilities. */)
275 (frame)
276 Lisp_Object frame;
278 Lisp_Object type;
279 if (NILP (frame))
280 frame = selected_frame;
282 type = Fframep (frame);
284 if (NILP (type))
285 wrong_type_argument (Qframep, frame);
287 if (EQ (type, Qt))
288 return Qnil;
289 else
290 return type;
293 struct frame *
294 make_frame (mini_p)
295 int mini_p;
297 Lisp_Object frame;
298 register struct frame *f;
299 register Lisp_Object root_window;
300 register Lisp_Object mini_window;
302 f = allocate_frame ();
303 XSETFRAME (frame, f);
305 f->desired_matrix = 0;
306 f->current_matrix = 0;
307 f->desired_pool = 0;
308 f->current_pool = 0;
309 f->glyphs_initialized_p = 0;
310 f->decode_mode_spec_buffer = 0;
311 f->visible = 0;
312 f->async_visible = 0;
313 f->output_data.nothing = 0;
314 f->iconified = 0;
315 f->async_iconified = 0;
316 f->wants_modeline = 1;
317 f->auto_raise = 0;
318 f->auto_lower = 0;
319 f->no_split = 0;
320 f->garbaged = 1;
321 f->has_minibuffer = mini_p;
322 f->focus_frame = Qnil;
323 f->explicit_name = 0;
324 f->can_have_scroll_bars = 0;
325 f->vertical_scroll_bar_type = vertical_scroll_bar_none;
326 f->param_alist = Qnil;
327 f->scroll_bars = Qnil;
328 f->condemned_scroll_bars = Qnil;
329 f->face_alist = Qnil;
330 f->face_cache = NULL;
331 f->menu_bar_items = Qnil;
332 f->menu_bar_vector = Qnil;
333 f->menu_bar_items_used = 0;
334 f->buffer_predicate = Qnil;
335 f->buffer_list = Qnil;
336 f->buried_buffer_list = Qnil;
337 f->namebuf = 0;
338 f->title = Qnil;
339 f->menu_bar_window = Qnil;
340 f->tool_bar_window = Qnil;
341 f->tool_bar_items = Qnil;
342 f->desired_tool_bar_string = f->current_tool_bar_string = Qnil;
343 f->n_tool_bar_items = 0;
344 f->left_fringe_width = f->right_fringe_width = 0;
345 f->fringe_cols = 0;
346 f->scroll_bar_actual_width = 0;
347 f->border_width = 0;
348 f->internal_border_width = 0;
349 f->column_width = 1; /* !FRAME_WINDOW_P value */
350 f->line_height = 1; /* !FRAME_WINDOW_P value */
351 f->x_pixels_diff = f->y_pixels_diff = 0;
352 #ifdef HAVE_WINDOW_SYSTEM
353 f->want_fullscreen = FULLSCREEN_NONE;
354 #endif
355 f->size_hint_flags = 0;
356 f->win_gravity = 0;
357 f->font_driver_list = NULL;
358 f->font_data_list = NULL;
360 root_window = make_window ();
361 if (mini_p)
363 mini_window = make_window ();
364 XWINDOW (root_window)->next = mini_window;
365 XWINDOW (mini_window)->prev = root_window;
366 XWINDOW (mini_window)->mini_p = Qt;
367 XWINDOW (mini_window)->frame = frame;
368 f->minibuffer_window = mini_window;
370 else
372 mini_window = Qnil;
373 XWINDOW (root_window)->next = Qnil;
374 f->minibuffer_window = Qnil;
377 XWINDOW (root_window)->frame = frame;
379 /* 10 is arbitrary,
380 just so that there is "something there."
381 Correct size will be set up later with change_frame_size. */
383 SET_FRAME_COLS (f, 10);
384 FRAME_LINES (f) = 10;
386 XSETFASTINT (XWINDOW (root_window)->total_cols, 10);
387 XSETFASTINT (XWINDOW (root_window)->total_lines, (mini_p ? 9 : 10));
389 if (mini_p)
391 XSETFASTINT (XWINDOW (mini_window)->total_cols, 10);
392 XSETFASTINT (XWINDOW (mini_window)->top_line, 9);
393 XSETFASTINT (XWINDOW (mini_window)->total_lines, 1);
396 /* Choose a buffer for the frame's root window. */
398 Lisp_Object buf;
400 XWINDOW (root_window)->buffer = Qt;
401 buf = Fcurrent_buffer ();
402 /* If buf is a 'hidden' buffer (i.e. one whose name starts with
403 a space), try to find another one. */
404 if (SREF (Fbuffer_name (buf), 0) == ' ')
405 buf = Fother_buffer (buf, Qnil, Qnil);
407 /* Use set_window_buffer, not Fset_window_buffer, and don't let
408 hooks be run by it. The reason is that the whole frame/window
409 arrangement is not yet fully intialized at this point. Windows
410 don't have the right size, glyph matrices aren't initialized
411 etc. Running Lisp functions at this point surely ends in a
412 SEGV. */
413 set_window_buffer (root_window, buf, 0, 0);
414 f->buffer_list = Fcons (buf, Qnil);
417 if (mini_p)
419 XWINDOW (mini_window)->buffer = Qt;
420 set_window_buffer (mini_window,
421 (NILP (Vminibuffer_list)
422 ? get_minibuffer (0)
423 : Fcar (Vminibuffer_list)),
424 0, 0);
427 f->root_window = root_window;
428 f->selected_window = root_window;
429 /* Make sure this window seems more recently used than
430 a newly-created, never-selected window. */
431 ++window_select_count;
432 XSETFASTINT (XWINDOW (f->selected_window)->use_time, window_select_count);
434 f->default_face_done_p = 0;
436 return f;
439 #ifdef HAVE_WINDOW_SYSTEM
440 /* Make a frame using a separate minibuffer window on another frame.
441 MINI_WINDOW is the minibuffer window to use. nil means use the
442 default (the global minibuffer). */
444 struct frame *
445 make_frame_without_minibuffer (mini_window, kb, display)
446 register Lisp_Object mini_window;
447 KBOARD *kb;
448 Lisp_Object display;
450 register struct frame *f;
451 struct gcpro gcpro1;
453 if (!NILP (mini_window))
454 CHECK_LIVE_WINDOW (mini_window);
456 if (!NILP (mini_window)
457 && FRAME_KBOARD (XFRAME (XWINDOW (mini_window)->frame)) != kb)
458 error ("Frame and minibuffer must be on the same terminal");
460 /* Make a frame containing just a root window. */
461 f = make_frame (0);
463 if (NILP (mini_window))
465 /* Use default-minibuffer-frame if possible. */
466 if (!FRAMEP (kb->Vdefault_minibuffer_frame)
467 || ! FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame)))
469 Lisp_Object frame_dummy;
471 XSETFRAME (frame_dummy, f);
472 GCPRO1 (frame_dummy);
473 /* If there's no minibuffer frame to use, create one. */
474 kb->Vdefault_minibuffer_frame =
475 call1 (intern ("make-initial-minibuffer-frame"), display);
476 UNGCPRO;
479 mini_window = XFRAME (kb->Vdefault_minibuffer_frame)->minibuffer_window;
482 f->minibuffer_window = mini_window;
484 /* Make the chosen minibuffer window display the proper minibuffer,
485 unless it is already showing a minibuffer. */
486 if (NILP (Fmemq (XWINDOW (mini_window)->buffer, Vminibuffer_list)))
487 Fset_window_buffer (mini_window,
488 (NILP (Vminibuffer_list)
489 ? get_minibuffer (0)
490 : Fcar (Vminibuffer_list)), Qnil);
491 return f;
494 /* Make a frame containing only a minibuffer window. */
496 struct frame *
497 make_minibuffer_frame ()
499 /* First make a frame containing just a root window, no minibuffer. */
501 register struct frame *f = make_frame (0);
502 register Lisp_Object mini_window;
503 register Lisp_Object frame;
505 XSETFRAME (frame, f);
507 f->auto_raise = 0;
508 f->auto_lower = 0;
509 f->no_split = 1;
510 f->wants_modeline = 0;
511 f->has_minibuffer = 1;
513 /* Now label the root window as also being the minibuffer.
514 Avoid infinite looping on the window chain by marking next pointer
515 as nil. */
517 mini_window = f->minibuffer_window = f->root_window;
518 XWINDOW (mini_window)->mini_p = Qt;
519 XWINDOW (mini_window)->next = Qnil;
520 XWINDOW (mini_window)->prev = Qnil;
521 XWINDOW (mini_window)->frame = frame;
523 /* Put the proper buffer in that window. */
525 Fset_window_buffer (mini_window,
526 (NILP (Vminibuffer_list)
527 ? get_minibuffer (0)
528 : Fcar (Vminibuffer_list)), Qnil);
529 return f;
531 #endif /* HAVE_WINDOW_SYSTEM */
533 /* Construct a frame that refers to a terminal. */
535 static int tty_frame_count;
537 struct frame *
538 make_initial_frame (void)
540 struct frame *f;
541 struct terminal *terminal;
542 Lisp_Object frame;
544 eassert (initial_kboard);
546 /* The first call must initialize Vframe_list. */
547 if (! (NILP (Vframe_list) || CONSP (Vframe_list)))
548 Vframe_list = Qnil;
550 terminal = init_initial_terminal ();
552 f = make_frame (1);
553 XSETFRAME (frame, f);
555 Vframe_list = Fcons (frame, Vframe_list);
557 tty_frame_count = 1;
558 f->name = make_pure_c_string ("F1");
560 f->visible = 1;
561 f->async_visible = 1;
563 f->output_method = terminal->type;
564 f->terminal = terminal;
565 f->terminal->reference_count++;
566 f->output_data.nothing = 0;
568 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
569 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
571 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
572 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
574 #ifdef CANNOT_DUMP
575 if (!noninteractive)
576 init_frame_faces (f);
577 #endif
579 return f;
583 struct frame *
584 make_terminal_frame (struct terminal *terminal)
586 register struct frame *f;
587 Lisp_Object frame;
588 char name[20];
590 if (!terminal->name)
591 error ("Terminal is not live, can't create new frames on it");
593 f = make_frame (1);
595 XSETFRAME (frame, f);
596 Vframe_list = Fcons (frame, Vframe_list);
598 tty_frame_count++;
599 sprintf (name, "F%d", tty_frame_count);
600 f->name = build_string (name);
602 f->visible = 1; /* FRAME_SET_VISIBLE wd set frame_garbaged. */
603 f->async_visible = 1; /* Don't let visible be cleared later. */
604 f->terminal = terminal;
605 f->terminal->reference_count++;
606 #ifdef MSDOS
607 f->output_data.tty->display_info = &the_only_display_info;
608 if (!inhibit_window_system
609 && (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame))
610 || XFRAME (selected_frame)->output_method == output_msdos_raw))
611 f->output_method = output_msdos_raw;
612 else
613 f->output_method = output_termcap;
614 #else /* not MSDOS */
615 f->output_method = output_termcap;
616 create_tty_output (f);
617 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
618 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
619 #endif /* not MSDOS */
621 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
622 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
624 /* Set the top frame to the newly created frame. */
625 if (FRAMEP (FRAME_TTY (f)->top_frame)
626 && FRAME_LIVE_P (XFRAME (FRAME_TTY (f)->top_frame)))
627 XFRAME (FRAME_TTY (f)->top_frame)->async_visible = 2; /* obscured */
629 FRAME_TTY (f)->top_frame = frame;
631 if (!noninteractive)
632 init_frame_faces (f);
634 return f;
637 /* Get a suitable value for frame parameter PARAMETER for a newly
638 created frame, based on (1) the user-supplied frame parameter
639 alist SUPPLIED_PARMS, (2) CURRENT_VALUE, and finally, if all else
640 fails, (3) Vdefault_frame_alist. */
642 static Lisp_Object
643 get_future_frame_param (Lisp_Object parameter,
644 Lisp_Object supplied_parms,
645 char *current_value)
647 Lisp_Object result;
649 result = Fassq (parameter, supplied_parms);
650 if (NILP (result))
651 result = Fassq (parameter, XFRAME (selected_frame)->param_alist);
652 if (NILP (result) && current_value != NULL)
653 result = build_string (current_value);
654 if (NILP (result))
655 result = Fassq (parameter, Vdefault_frame_alist);
656 if (!NILP (result) && !STRINGP (result))
657 result = XCDR (result);
658 if (NILP (result) || !STRINGP (result))
659 result = Qnil;
661 return result;
664 DEFUN ("make-terminal-frame", Fmake_terminal_frame, Smake_terminal_frame,
665 1, 1, 0,
666 doc: /* Create an additional terminal frame, possibly on another terminal.
667 This function takes one argument, an alist specifying frame parameters.
669 You can create multiple frames on a single text-only terminal, but
670 only one of them (the selected terminal frame) is actually displayed.
672 In practice, generally you don't need to specify any parameters,
673 except when you want to create a new frame on another terminal.
674 In that case, the `tty' parameter specifies the device file to open,
675 and the `tty-type' parameter specifies the terminal type. Example:
677 (make-terminal-frame '((tty . "/dev/pts/5") (tty-type . "xterm")))
679 Note that changing the size of one terminal frame automatically
680 affects all frames on the same terminal device. */)
681 (parms)
682 Lisp_Object parms;
684 struct frame *f;
685 struct terminal *t = NULL;
686 Lisp_Object frame, tem;
687 struct frame *sf = SELECTED_FRAME ();
689 #ifdef MSDOS
690 if (sf->output_method != output_msdos_raw
691 && sf->output_method != output_termcap)
692 abort ();
693 #else /* not MSDOS */
695 #ifdef WINDOWSNT /* This should work now! */
696 if (sf->output_method != output_termcap)
697 error ("Not using an ASCII terminal now; cannot make a new ASCII frame");
698 #endif
699 #endif /* not MSDOS */
702 Lisp_Object terminal;
704 terminal = Fassq (Qterminal, parms);
705 if (!NILP (terminal))
707 terminal = XCDR (terminal);
708 t = get_terminal (terminal, 1);
710 #ifdef MSDOS
711 if (t && t != the_only_display_info.terminal)
712 /* msdos.c assumes a single tty_display_info object. */
713 error ("Multiple terminals are not supported on this platform");
714 if (!t)
715 t = the_only_display_info.terminal;
716 #endif
719 if (!t)
721 char *name = 0, *type = 0;
722 Lisp_Object tty, tty_type;
724 tty = get_future_frame_param
725 (Qtty, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
726 ? FRAME_TTY (XFRAME (selected_frame))->name
727 : NULL));
728 if (!NILP (tty))
730 name = (char *) alloca (SBYTES (tty) + 1);
731 strncpy (name, SDATA (tty), SBYTES (tty));
732 name[SBYTES (tty)] = 0;
735 tty_type = get_future_frame_param
736 (Qtty_type, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
737 ? FRAME_TTY (XFRAME (selected_frame))->type
738 : NULL));
739 if (!NILP (tty_type))
741 type = (char *) alloca (SBYTES (tty_type) + 1);
742 strncpy (type, SDATA (tty_type), SBYTES (tty_type));
743 type[SBYTES (tty_type)] = 0;
746 t = init_tty (name, type, 0); /* Errors are not fatal. */
749 f = make_terminal_frame (t);
752 int width, height;
753 get_tty_size (fileno (FRAME_TTY (f)->input), &width, &height);
754 change_frame_size (f, height, width, 0, 0, 0);
757 adjust_glyphs (f);
758 calculate_costs (f);
759 XSETFRAME (frame, f);
760 Fmodify_frame_parameters (frame, Vdefault_frame_alist);
761 Fmodify_frame_parameters (frame, parms);
762 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty_type,
763 build_string (t->display_info.tty->type)),
764 Qnil));
765 if (t->display_info.tty->name != NULL)
766 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty,
767 build_string (t->display_info.tty->name)),
768 Qnil));
769 else
770 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty, Qnil), Qnil));
772 /* Make the frame face alist be frame-specific, so that each
773 frame could change its face definitions independently. */
774 f->face_alist = Fcopy_alist (sf->face_alist);
775 /* Simple Fcopy_alist isn't enough, because we need the contents of
776 the vectors which are the CDRs of associations in face_alist to
777 be copied as well. */
778 for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem))
779 XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem))));
780 return frame;
784 /* Perform the switch to frame FRAME.
786 If FRAME is a switch-frame event `(switch-frame FRAME1)', use
787 FRAME1 as frame.
789 If TRACK is non-zero and the frame that currently has the focus
790 redirects its focus to the selected frame, redirect that focused
791 frame's focus to FRAME instead.
793 FOR_DELETION non-zero means that the selected frame is being
794 deleted, which includes the possibility that the frame's terminal
795 is dead.
797 The value of NORECORD is passed as argument to Fselect_window. */
799 Lisp_Object
800 do_switch_frame (frame, track, for_deletion, norecord)
801 Lisp_Object frame, norecord;
802 int track, for_deletion;
804 struct frame *sf = SELECTED_FRAME ();
806 /* If FRAME is a switch-frame event, extract the frame we should
807 switch to. */
808 if (CONSP (frame)
809 && EQ (XCAR (frame), Qswitch_frame)
810 && CONSP (XCDR (frame)))
811 frame = XCAR (XCDR (frame));
813 /* This used to say CHECK_LIVE_FRAME, but apparently it's possible for
814 a switch-frame event to arrive after a frame is no longer live,
815 especially when deleting the initial frame during startup. */
816 CHECK_FRAME (frame);
817 if (! FRAME_LIVE_P (XFRAME (frame)))
818 return Qnil;
820 if (sf == XFRAME (frame))
821 return frame;
823 /* This is too greedy; it causes inappropriate focus redirection
824 that's hard to get rid of. */
825 #if 0
826 /* If a frame's focus has been redirected toward the currently
827 selected frame, we should change the redirection to point to the
828 newly selected frame. This means that if the focus is redirected
829 from a minibufferless frame to a surrogate minibuffer frame, we
830 can use `other-window' to switch between all the frames using
831 that minibuffer frame, and the focus redirection will follow us
832 around. */
833 if (track)
835 Lisp_Object tail;
837 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
839 Lisp_Object focus;
841 if (!FRAMEP (XCAR (tail)))
842 abort ();
844 focus = FRAME_FOCUS_FRAME (XFRAME (XCAR (tail)));
846 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
847 Fredirect_frame_focus (XCAR (tail), frame);
850 #else /* ! 0 */
851 /* Instead, apply it only to the frame we're pointing to. */
852 #ifdef HAVE_WINDOW_SYSTEM
853 if (track && FRAME_WINDOW_P (XFRAME (frame)))
855 Lisp_Object focus, xfocus;
857 xfocus = x_get_focus_frame (XFRAME (frame));
858 if (FRAMEP (xfocus))
860 focus = FRAME_FOCUS_FRAME (XFRAME (xfocus));
861 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
862 Fredirect_frame_focus (xfocus, frame);
865 #endif /* HAVE_X_WINDOWS */
866 #endif /* ! 0 */
868 if (!for_deletion && FRAME_HAS_MINIBUF_P (sf))
869 resize_mini_window (XWINDOW (FRAME_MINIBUF_WINDOW (sf)), 1);
871 if (FRAME_TERMCAP_P (XFRAME (frame)) || FRAME_MSDOS_P (XFRAME (frame)))
873 if (FRAMEP (FRAME_TTY (XFRAME (frame))->top_frame))
874 /* Mark previously displayed frame as now obscured. */
875 XFRAME (FRAME_TTY (XFRAME (frame))->top_frame)->async_visible = 2;
876 XFRAME (frame)->async_visible = 1;
877 FRAME_TTY (XFRAME (frame))->top_frame = frame;
880 selected_frame = frame;
881 if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
882 last_nonminibuf_frame = XFRAME (selected_frame);
884 Fselect_window (XFRAME (frame)->selected_window, norecord);
886 /* We want to make sure that the next event generates a frame-switch
887 event to the appropriate frame. This seems kludgy to me, but
888 before you take it out, make sure that evaluating something like
889 (select-window (frame-root-window (new-frame))) doesn't end up
890 with your typing being interpreted in the new frame instead of
891 the one you're actually typing in. */
892 internal_last_event_frame = Qnil;
894 return frame;
897 DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 2, "e",
898 doc: /* Select FRAME.
899 Subsequent editing commands apply to its selected window.
900 Optional argument NORECORD means to neither change the order of
901 recently selected windows nor the buffer list.
903 The selection of FRAME lasts until the next time the user does
904 something to select a different frame, or until the next time
905 this function is called. If you are using a window system, the
906 previously selected frame may be restored as the selected frame
907 when returning to the command loop, because it still may have
908 the window system's input focus. On a text-only terminal, the
909 next redisplay will display FRAME.
911 This function returns FRAME, or nil if FRAME has been deleted. */)
912 (frame, norecord)
913 Lisp_Object frame, norecord;
915 return do_switch_frame (frame, 1, 0, norecord);
919 DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 1, "e",
920 doc: /* Handle a switch-frame event EVENT.
921 Switch-frame events are usually bound to this function.
922 A switch-frame event tells Emacs that the window manager has requested
923 that the user's events be directed to the frame mentioned in the event.
924 This function selects the selected window of the frame of EVENT.
926 If EVENT is frame object, handle it as if it were a switch-frame event
927 to that frame. */)
928 (event)
929 Lisp_Object event;
931 /* Preserve prefix arg that the command loop just cleared. */
932 current_kboard->Vprefix_arg = Vcurrent_prefix_arg;
933 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
934 return do_switch_frame (event, 0, 0, Qnil);
937 DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0,
938 doc: /* Return the frame that is now selected. */)
941 return selected_frame;
944 DEFUN ("window-frame", Fwindow_frame, Swindow_frame, 1, 1, 0,
945 doc: /* Return the frame object that window WINDOW is on. */)
946 (window)
947 Lisp_Object window;
949 CHECK_LIVE_WINDOW (window);
950 return XWINDOW (window)->frame;
953 DEFUN ("frame-first-window", Fframe_first_window, Sframe_first_window, 0, 1, 0,
954 doc: /* Returns the topmost, leftmost window of FRAME.
955 If omitted, FRAME defaults to the currently selected frame. */)
956 (frame)
957 Lisp_Object frame;
959 Lisp_Object w;
961 if (NILP (frame))
962 w = SELECTED_FRAME ()->root_window;
963 else
965 CHECK_LIVE_FRAME (frame);
966 w = XFRAME (frame)->root_window;
968 while (NILP (XWINDOW (w)->buffer))
970 if (! NILP (XWINDOW (w)->hchild))
971 w = XWINDOW (w)->hchild;
972 else if (! NILP (XWINDOW (w)->vchild))
973 w = XWINDOW (w)->vchild;
974 else
975 abort ();
977 return w;
980 DEFUN ("active-minibuffer-window", Factive_minibuffer_window,
981 Sactive_minibuffer_window, 0, 0, 0,
982 doc: /* Return the currently active minibuffer window, or nil if none. */)
985 return minibuf_level ? minibuf_window : Qnil;
988 DEFUN ("frame-root-window", Fframe_root_window, Sframe_root_window, 0, 1, 0,
989 doc: /* Returns the root-window of FRAME.
990 If omitted, FRAME defaults to the currently selected frame. */)
991 (frame)
992 Lisp_Object frame;
994 Lisp_Object window;
996 if (NILP (frame))
997 window = SELECTED_FRAME ()->root_window;
998 else
1000 CHECK_LIVE_FRAME (frame);
1001 window = XFRAME (frame)->root_window;
1004 return window;
1007 DEFUN ("frame-selected-window", Fframe_selected_window,
1008 Sframe_selected_window, 0, 1, 0,
1009 doc: /* Return the selected window of FRAME.
1010 FRAME defaults to the currently selected frame. */)
1011 (frame)
1012 Lisp_Object frame;
1014 Lisp_Object window;
1016 if (NILP (frame))
1017 window = SELECTED_FRAME ()->selected_window;
1018 else
1020 CHECK_LIVE_FRAME (frame);
1021 window = XFRAME (frame)->selected_window;
1024 return window;
1027 DEFUN ("set-frame-selected-window", Fset_frame_selected_window,
1028 Sset_frame_selected_window, 2, 3, 0,
1029 doc: /* Set selected window of FRAME to WINDOW.
1030 If FRAME is nil, use the selected frame. If FRAME is the
1031 selected frame, this makes WINDOW the selected window.
1032 Optional argument NORECORD non-nil means to neither change the
1033 order of recently selected windows nor the buffer list.
1034 Return WINDOW. */)
1035 (frame, window, norecord)
1036 Lisp_Object frame, window, norecord;
1038 if (NILP (frame))
1039 frame = selected_frame;
1041 CHECK_LIVE_FRAME (frame);
1042 CHECK_LIVE_WINDOW (window);
1044 if (! EQ (frame, WINDOW_FRAME (XWINDOW (window))))
1045 error ("In `set-frame-selected-window', WINDOW is not on FRAME");
1047 if (EQ (frame, selected_frame))
1048 return Fselect_window (window, norecord);
1050 return XFRAME (frame)->selected_window = window;
1054 DEFUN ("frame-list", Fframe_list, Sframe_list,
1055 0, 0, 0,
1056 doc: /* Return a list of all live frames. */)
1059 Lisp_Object frames;
1060 frames = Fcopy_sequence (Vframe_list);
1061 #ifdef HAVE_WINDOW_SYSTEM
1062 if (FRAMEP (tip_frame))
1063 frames = Fdelq (tip_frame, frames);
1064 #endif
1065 return frames;
1068 /* Return the next frame in the frame list after FRAME.
1069 If MINIBUF is nil, exclude minibuffer-only frames.
1070 If MINIBUF is a window, include only its own frame
1071 and any frame now using that window as the minibuffer.
1072 If MINIBUF is `visible', include all visible frames.
1073 If MINIBUF is 0, include all visible and iconified frames.
1074 Otherwise, include all frames. */
1076 static Lisp_Object
1077 next_frame (frame, minibuf)
1078 Lisp_Object frame;
1079 Lisp_Object minibuf;
1081 Lisp_Object tail;
1082 int passed = 0;
1084 /* There must always be at least one frame in Vframe_list. */
1085 if (! CONSP (Vframe_list))
1086 abort ();
1088 /* If this frame is dead, it won't be in Vframe_list, and we'll loop
1089 forever. Forestall that. */
1090 CHECK_LIVE_FRAME (frame);
1092 while (1)
1093 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1095 Lisp_Object f;
1097 f = XCAR (tail);
1099 if (passed
1100 && ((!FRAME_TERMCAP_P (XFRAME (f)) && !FRAME_TERMCAP_P (XFRAME (frame))
1101 && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
1102 || (FRAME_TERMCAP_P (XFRAME (f)) && FRAME_TERMCAP_P (XFRAME (frame))
1103 && FRAME_TTY (XFRAME (f)) == FRAME_TTY (XFRAME (frame)))))
1105 /* Decide whether this frame is eligible to be returned. */
1107 /* If we've looped all the way around without finding any
1108 eligible frames, return the original frame. */
1109 if (EQ (f, frame))
1110 return f;
1112 /* Let minibuf decide if this frame is acceptable. */
1113 if (NILP (minibuf))
1115 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
1116 return f;
1118 else if (EQ (minibuf, Qvisible))
1120 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1121 if (FRAME_VISIBLE_P (XFRAME (f)))
1122 return f;
1124 else if (INTEGERP (minibuf) && XINT (minibuf) == 0)
1126 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1127 if (FRAME_VISIBLE_P (XFRAME (f))
1128 || FRAME_ICONIFIED_P (XFRAME (f)))
1129 return f;
1131 else if (WINDOWP (minibuf))
1133 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
1134 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
1135 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
1136 FRAME_FOCUS_FRAME (XFRAME (f))))
1137 return f;
1139 else
1140 return f;
1143 if (EQ (frame, f))
1144 passed++;
1148 /* Return the previous frame in the frame list before FRAME.
1149 If MINIBUF is nil, exclude minibuffer-only frames.
1150 If MINIBUF is a window, include only its own frame
1151 and any frame now using that window as the minibuffer.
1152 If MINIBUF is `visible', include all visible frames.
1153 If MINIBUF is 0, include all visible and iconified frames.
1154 Otherwise, include all frames. */
1156 static Lisp_Object
1157 prev_frame (frame, minibuf)
1158 Lisp_Object frame;
1159 Lisp_Object minibuf;
1161 Lisp_Object tail;
1162 Lisp_Object prev;
1164 /* There must always be at least one frame in Vframe_list. */
1165 if (! CONSP (Vframe_list))
1166 abort ();
1168 prev = Qnil;
1169 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1171 Lisp_Object f;
1173 f = XCAR (tail);
1174 if (!FRAMEP (f))
1175 abort ();
1177 if (EQ (frame, f) && !NILP (prev))
1178 return prev;
1180 if ((!FRAME_TERMCAP_P (XFRAME (f)) && !FRAME_TERMCAP_P (XFRAME (frame))
1181 && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
1182 || (FRAME_TERMCAP_P (XFRAME (f)) && FRAME_TERMCAP_P (XFRAME (frame))
1183 && FRAME_TTY (XFRAME (f)) == FRAME_TTY (XFRAME (frame))))
1185 /* Decide whether this frame is eligible to be returned,
1186 according to minibuf. */
1187 if (NILP (minibuf))
1189 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
1190 prev = f;
1192 else if (WINDOWP (minibuf))
1194 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
1195 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
1196 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
1197 FRAME_FOCUS_FRAME (XFRAME (f))))
1198 prev = f;
1200 else if (EQ (minibuf, Qvisible))
1202 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1203 if (FRAME_VISIBLE_P (XFRAME (f)))
1204 prev = f;
1206 else if (XFASTINT (minibuf) == 0)
1208 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1209 if (FRAME_VISIBLE_P (XFRAME (f))
1210 || FRAME_ICONIFIED_P (XFRAME (f)))
1211 prev = f;
1213 else
1214 prev = f;
1218 /* We've scanned the entire list. */
1219 if (NILP (prev))
1220 /* We went through the whole frame list without finding a single
1221 acceptable frame. Return the original frame. */
1222 return frame;
1223 else
1224 /* There were no acceptable frames in the list before FRAME; otherwise,
1225 we would have returned directly from the loop. Since PREV is the last
1226 acceptable frame in the list, return it. */
1227 return prev;
1231 DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0,
1232 doc: /* Return the next frame in the frame list after FRAME.
1233 It considers only frames on the same terminal as FRAME.
1234 By default, skip minibuffer-only frames.
1235 If omitted, FRAME defaults to the selected frame.
1236 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1237 If MINIFRAME is a window, include only its own frame
1238 and any frame now using that window as the minibuffer.
1239 If MINIFRAME is `visible', include all visible frames.
1240 If MINIFRAME is 0, include all visible and iconified frames.
1241 Otherwise, include all frames. */)
1242 (frame, miniframe)
1243 Lisp_Object frame, miniframe;
1245 if (NILP (frame))
1246 frame = selected_frame;
1248 CHECK_LIVE_FRAME (frame);
1249 return next_frame (frame, miniframe);
1252 DEFUN ("previous-frame", Fprevious_frame, Sprevious_frame, 0, 2, 0,
1253 doc: /* Return the previous frame in the frame list before FRAME.
1254 It considers only frames on the same terminal as FRAME.
1255 By default, skip minibuffer-only frames.
1256 If omitted, FRAME defaults to the selected frame.
1257 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1258 If MINIFRAME is a window, include only its own frame
1259 and any frame now using that window as the minibuffer.
1260 If MINIFRAME is `visible', include all visible frames.
1261 If MINIFRAME is 0, include all visible and iconified frames.
1262 Otherwise, include all frames. */)
1263 (frame, miniframe)
1264 Lisp_Object frame, miniframe;
1266 if (NILP (frame))
1267 frame = selected_frame;
1268 CHECK_LIVE_FRAME (frame);
1269 return prev_frame (frame, miniframe);
1272 /* Return 1 if it is ok to delete frame F;
1273 0 if all frames aside from F are invisible.
1274 (Exception: if F is the terminal frame, and we are using X, return 1.) */
1277 other_visible_frames (f)
1278 FRAME_PTR f;
1280 /* We know the selected frame is visible,
1281 so if F is some other frame, it can't be the sole visible one. */
1282 if (f == SELECTED_FRAME ())
1284 Lisp_Object frames;
1285 int count = 0;
1287 for (frames = Vframe_list;
1288 CONSP (frames);
1289 frames = XCDR (frames))
1291 Lisp_Object this;
1293 this = XCAR (frames);
1294 /* Verify that the frame's window still exists
1295 and we can still talk to it. And note any recent change
1296 in visibility. */
1297 #ifdef HAVE_WINDOW_SYSTEM
1298 if (FRAME_WINDOW_P (XFRAME (this)))
1300 x_sync (XFRAME (this));
1301 FRAME_SAMPLE_VISIBILITY (XFRAME (this));
1303 #endif
1305 if (FRAME_VISIBLE_P (XFRAME (this))
1306 || FRAME_ICONIFIED_P (XFRAME (this))
1307 /* Allow deleting the terminal frame when at least
1308 one X frame exists! */
1309 || (FRAME_WINDOW_P (XFRAME (this)) && !FRAME_WINDOW_P (f)))
1310 count++;
1312 return count > 1;
1314 return 1;
1317 /* Error handler for `delete-frame-functions'. */
1318 static Lisp_Object
1319 delete_frame_handler (Lisp_Object arg)
1321 add_to_log ("Error during `delete-frame': %s", arg, Qnil);
1322 return Qnil;
1325 extern Lisp_Object Qrun_hook_with_args;
1327 /* Delete FRAME. When FORCE equals Qnoelisp, delete FRAME
1328 unconditionally. x_connection_closed and delete_terminal use
1329 this. Any other value of FORCE implements the semantics
1330 described for Fdelete_frame. */
1331 Lisp_Object
1332 delete_frame (frame, force)
1333 /* If we use `register' here, gcc-4.0.2 on amd64 using
1334 -DUSE_LISP_UNION_TYPE complains further down that we're getting the
1335 address of `force'. Go figure. */
1336 Lisp_Object frame, force;
1338 struct frame *f;
1339 struct frame *sf = SELECTED_FRAME ();
1340 struct kboard *kb;
1342 int minibuffer_selected, tooltip_frame;
1344 if (EQ (frame, Qnil))
1346 f = sf;
1347 XSETFRAME (frame, f);
1349 else
1351 CHECK_FRAME (frame);
1352 f = XFRAME (frame);
1355 if (! FRAME_LIVE_P (f))
1356 return Qnil;
1358 if (NILP (force) && !other_visible_frames (f))
1359 error ("Attempt to delete the sole visible or iconified frame");
1361 /* x_connection_closed must have set FORCE to `noelisp' in order
1362 to delete the last frame, if it is gone. */
1363 if (NILP (XCDR (Vframe_list)) && !EQ (force, Qnoelisp))
1364 error ("Attempt to delete the only frame");
1366 /* Does this frame have a minibuffer, and is it the surrogate
1367 minibuffer for any other frame? */
1368 if (FRAME_HAS_MINIBUF_P (XFRAME (frame)))
1370 Lisp_Object frames;
1372 for (frames = Vframe_list;
1373 CONSP (frames);
1374 frames = XCDR (frames))
1376 Lisp_Object this;
1377 this = XCAR (frames);
1379 if (! EQ (this, frame)
1380 && EQ (frame,
1381 WINDOW_FRAME (XWINDOW
1382 (FRAME_MINIBUF_WINDOW (XFRAME (this))))))
1384 /* If we MUST delete this frame, delete the other first.
1385 But do this only if FORCE equals `noelisp'. */
1386 if (EQ (force, Qnoelisp))
1387 delete_frame (this, Qnoelisp);
1388 else
1389 error ("Attempt to delete a surrogate minibuffer frame");
1394 tooltip_frame = !NILP (Fframe_parameter (frame, intern ("tooltip")));
1396 /* Run `delete-frame-functions' unless FORCE is `noelisp' or
1397 frame is a tooltip. FORCE is set to `noelisp' when handling
1398 a disconnect from the terminal, so we don't dare call Lisp
1399 code. */
1400 if (NILP (Vrun_hooks) || tooltip_frame)
1402 else if (EQ (force, Qnoelisp))
1403 pending_funcalls
1404 = Fcons (list3 (Qrun_hook_with_args, Qdelete_frame_functions, frame),
1405 pending_funcalls);
1406 else
1407 safe_call2 (Qrun_hook_with_args, Qdelete_frame_functions, frame);
1409 /* The hook may sometimes (indirectly) cause the frame to be deleted. */
1410 if (! FRAME_LIVE_P (f))
1411 return Qnil;
1413 /* At this point, we are committed to deleting the frame.
1414 There is no more chance for errors to prevent it. */
1416 minibuffer_selected = EQ (minibuf_window, selected_window);
1418 /* Don't let the frame remain selected. */
1419 if (f == sf)
1421 Lisp_Object tail, frame1;
1423 /* Look for another visible frame on the same terminal. */
1424 frame1 = next_frame (frame, Qvisible);
1426 /* If there is none, find *some* other frame. */
1427 if (NILP (frame1) || EQ (frame1, frame))
1429 FOR_EACH_FRAME (tail, frame1)
1431 if (! EQ (frame, frame1) && FRAME_LIVE_P (XFRAME (frame1)))
1432 break;
1435 #ifdef NS_IMPL_COCOA
1436 else
1437 /* Under NS, there is no system mechanism for choosing a new
1438 window to get focus -- it is left to application code.
1439 So the portion of THIS application interfacing with NS
1440 needs to know about it. We call Fraise_frame, but the
1441 purpose is really to transfer focus. */
1442 Fraise_frame (frame1);
1443 #endif
1445 do_switch_frame (frame1, 0, 1, Qnil);
1446 sf = SELECTED_FRAME ();
1449 /* Don't allow minibuf_window to remain on a deleted frame. */
1450 if (EQ (f->minibuffer_window, minibuf_window))
1452 Fset_window_buffer (sf->minibuffer_window,
1453 XWINDOW (minibuf_window)->buffer, Qnil);
1454 minibuf_window = sf->minibuffer_window;
1456 /* If the dying minibuffer window was selected,
1457 select the new one. */
1458 if (minibuffer_selected)
1459 Fselect_window (minibuf_window, Qnil);
1462 /* Don't let echo_area_window to remain on a deleted frame. */
1463 if (EQ (f->minibuffer_window, echo_area_window))
1464 echo_area_window = sf->minibuffer_window;
1466 /* Clear any X selections for this frame. */
1467 #ifdef HAVE_X_WINDOWS
1468 if (FRAME_X_P (f))
1469 x_clear_frame_selections (f);
1470 #endif
1472 /* Free glyphs.
1473 This function must be called before the window tree of the
1474 frame is deleted because windows contain dynamically allocated
1475 memory. */
1476 free_glyphs (f);
1478 #ifdef HAVE_WINDOW_SYSTEM
1479 /* Give chance to each font driver to free a frame specific data. */
1480 font_update_drivers (f, Qnil);
1481 #endif
1483 /* Mark all the windows that used to be on FRAME as deleted, and then
1484 remove the reference to them. */
1485 delete_all_subwindows (XWINDOW (f->root_window));
1486 f->root_window = Qnil;
1488 Vframe_list = Fdelq (frame, Vframe_list);
1489 FRAME_SET_VISIBLE (f, 0);
1491 /* Allow the vector of menu bar contents to be freed in the next
1492 garbage collection. The frame object itself may not be garbage
1493 collected until much later, because recent_keys and other data
1494 structures can still refer to it. */
1495 f->menu_bar_vector = Qnil;
1497 free_font_driver_list (f);
1498 xfree (f->namebuf);
1499 xfree (f->decode_mode_spec_buffer);
1500 xfree (FRAME_INSERT_COST (f));
1501 xfree (FRAME_DELETEN_COST (f));
1502 xfree (FRAME_INSERTN_COST (f));
1503 xfree (FRAME_DELETE_COST (f));
1504 xfree (FRAME_MESSAGE_BUF (f));
1506 /* Since some events are handled at the interrupt level, we may get
1507 an event for f at any time; if we zero out the frame's terminal
1508 now, then we may trip up the event-handling code. Instead, we'll
1509 promise that the terminal of the frame must be valid until we
1510 have called the window-system-dependent frame destruction
1511 routine. */
1513 if (FRAME_TERMINAL (f)->delete_frame_hook)
1514 (*FRAME_TERMINAL (f)->delete_frame_hook) (f);
1517 struct terminal *terminal = FRAME_TERMINAL (f);
1518 f->output_data.nothing = 0;
1519 f->terminal = 0; /* Now the frame is dead. */
1521 /* If needed, delete the terminal that this frame was on.
1522 (This must be done after the frame is killed.) */
1523 terminal->reference_count--;
1524 if (terminal->reference_count == 0)
1526 Lisp_Object tmp;
1527 XSETTERMINAL (tmp, terminal);
1529 kb = NULL;
1530 Fdelete_terminal (tmp, NILP (force) ? Qt : force);
1532 else
1533 kb = terminal->kboard;
1536 /* If we've deleted the last_nonminibuf_frame, then try to find
1537 another one. */
1538 if (f == last_nonminibuf_frame)
1540 Lisp_Object frames;
1542 last_nonminibuf_frame = 0;
1544 for (frames = Vframe_list;
1545 CONSP (frames);
1546 frames = XCDR (frames))
1548 f = XFRAME (XCAR (frames));
1549 if (!FRAME_MINIBUF_ONLY_P (f))
1551 last_nonminibuf_frame = f;
1552 break;
1557 /* If there's no other frame on the same kboard, get out of
1558 single-kboard state if we're in it for this kboard. */
1559 if (kb != NULL)
1561 Lisp_Object frames;
1562 /* Some frame we found on the same kboard, or nil if there are none. */
1563 Lisp_Object frame_on_same_kboard;
1565 frame_on_same_kboard = Qnil;
1567 for (frames = Vframe_list;
1568 CONSP (frames);
1569 frames = XCDR (frames))
1571 Lisp_Object this;
1572 struct frame *f1;
1574 this = XCAR (frames);
1575 if (!FRAMEP (this))
1576 abort ();
1577 f1 = XFRAME (this);
1579 if (kb == FRAME_KBOARD (f1))
1580 frame_on_same_kboard = this;
1583 if (NILP (frame_on_same_kboard))
1584 not_single_kboard_state (kb);
1588 /* If we've deleted this keyboard's default_minibuffer_frame, try to
1589 find another one. Prefer minibuffer-only frames, but also notice
1590 frames with other windows. */
1591 if (kb != NULL && EQ (frame, kb->Vdefault_minibuffer_frame))
1593 Lisp_Object frames;
1595 /* The last frame we saw with a minibuffer, minibuffer-only or not. */
1596 Lisp_Object frame_with_minibuf;
1597 /* Some frame we found on the same kboard, or nil if there are none. */
1598 Lisp_Object frame_on_same_kboard;
1600 frame_on_same_kboard = Qnil;
1601 frame_with_minibuf = Qnil;
1603 for (frames = Vframe_list;
1604 CONSP (frames);
1605 frames = XCDR (frames))
1607 Lisp_Object this;
1608 struct frame *f1;
1610 this = XCAR (frames);
1611 if (!FRAMEP (this))
1612 abort ();
1613 f1 = XFRAME (this);
1615 /* Consider only frames on the same kboard
1616 and only those with minibuffers. */
1617 if (kb == FRAME_KBOARD (f1)
1618 && FRAME_HAS_MINIBUF_P (f1))
1620 frame_with_minibuf = this;
1621 if (FRAME_MINIBUF_ONLY_P (f1))
1622 break;
1625 if (kb == FRAME_KBOARD (f1))
1626 frame_on_same_kboard = this;
1629 if (!NILP (frame_on_same_kboard))
1631 /* We know that there must be some frame with a minibuffer out
1632 there. If this were not true, all of the frames present
1633 would have to be minibufferless, which implies that at some
1634 point their minibuffer frames must have been deleted, but
1635 that is prohibited at the top; you can't delete surrogate
1636 minibuffer frames. */
1637 if (NILP (frame_with_minibuf))
1638 abort ();
1640 kb->Vdefault_minibuffer_frame = frame_with_minibuf;
1642 else
1643 /* No frames left on this kboard--say no minibuffer either. */
1644 kb->Vdefault_minibuffer_frame = Qnil;
1647 /* Cause frame titles to update--necessary if we now have just one frame. */
1648 if (!tooltip_frame)
1649 update_mode_lines = 1;
1651 return Qnil;
1654 DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 2, "",
1655 doc: /* Delete FRAME, permanently eliminating it from use.
1656 FRAME defaults to the selected frame.
1658 A frame may not be deleted if its minibuffer is used by other frames.
1659 Normally, you may not delete a frame if all other frames are invisible,
1660 but if the second optional argument FORCE is non-nil, you may do so.
1662 This function runs `delete-frame-functions' before actually
1663 deleting the frame, unless the frame is a tooltip.
1664 The functions are run with one argument, the frame to be deleted. */)
1665 (frame, force)
1666 Lisp_Object frame, force;
1668 return delete_frame (frame, !NILP (force) ? Qt : Qnil);
1672 /* Return mouse position in character cell units. */
1674 DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0,
1675 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1676 The position is given in character cells, where (0, 0) is the
1677 upper-left corner of the frame, X is the horizontal offset, and Y is
1678 the vertical offset.
1679 If Emacs is running on a mouseless terminal or hasn't been programmed
1680 to read the mouse position, it returns the selected frame for FRAME
1681 and nil for X and Y.
1682 If `mouse-position-function' is non-nil, `mouse-position' calls it,
1683 passing the normal return value to that function as an argument,
1684 and returns whatever that function returns. */)
1687 FRAME_PTR f;
1688 Lisp_Object lispy_dummy;
1689 enum scroll_bar_part party_dummy;
1690 Lisp_Object x, y, retval;
1691 int col, row;
1692 unsigned long long_dummy;
1693 struct gcpro gcpro1;
1695 f = SELECTED_FRAME ();
1696 x = y = Qnil;
1698 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
1699 /* It's okay for the hook to refrain from storing anything. */
1700 if (FRAME_TERMINAL (f)->mouse_position_hook)
1701 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1702 &lispy_dummy, &party_dummy,
1703 &x, &y,
1704 &long_dummy);
1705 if (! NILP (x))
1707 col = XINT (x);
1708 row = XINT (y);
1709 pixel_to_glyph_coords (f, col, row, &col, &row, NULL, 1);
1710 XSETINT (x, col);
1711 XSETINT (y, row);
1713 #endif
1714 XSETFRAME (lispy_dummy, f);
1715 retval = Fcons (lispy_dummy, Fcons (x, y));
1716 GCPRO1 (retval);
1717 if (!NILP (Vmouse_position_function))
1718 retval = call1 (Vmouse_position_function, retval);
1719 RETURN_UNGCPRO (retval);
1722 DEFUN ("mouse-pixel-position", Fmouse_pixel_position,
1723 Smouse_pixel_position, 0, 0, 0,
1724 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1725 The position is given in pixel units, where (0, 0) is the
1726 upper-left corner of the frame, X is the horizontal offset, and Y is
1727 the vertical offset.
1728 If Emacs is running on a mouseless terminal or hasn't been programmed
1729 to read the mouse position, it returns the selected frame for FRAME
1730 and nil for X and Y. */)
1733 FRAME_PTR f;
1734 Lisp_Object lispy_dummy;
1735 enum scroll_bar_part party_dummy;
1736 Lisp_Object x, y;
1737 unsigned long long_dummy;
1739 f = SELECTED_FRAME ();
1740 x = y = Qnil;
1742 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
1743 /* It's okay for the hook to refrain from storing anything. */
1744 if (FRAME_TERMINAL (f)->mouse_position_hook)
1745 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1746 &lispy_dummy, &party_dummy,
1747 &x, &y,
1748 &long_dummy);
1749 #endif
1750 XSETFRAME (lispy_dummy, f);
1751 return Fcons (lispy_dummy, Fcons (x, y));
1754 DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0,
1755 doc: /* Move the mouse pointer to the center of character cell (X,Y) in FRAME.
1756 Coordinates are relative to the frame, not a window,
1757 so the coordinates of the top left character in the frame
1758 may be nonzero due to left-hand scroll bars or the menu bar.
1760 The position is given in character cells, where (0, 0) is the
1761 upper-left corner of the frame, X is the horizontal offset, and Y is
1762 the vertical offset.
1764 This function is a no-op for an X frame that is not visible.
1765 If you have just created a frame, you must wait for it to become visible
1766 before calling this function on it, like this.
1767 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1768 (frame, x, y)
1769 Lisp_Object frame, x, y;
1771 CHECK_LIVE_FRAME (frame);
1772 CHECK_NUMBER (x);
1773 CHECK_NUMBER (y);
1775 /* I think this should be done with a hook. */
1776 #ifdef HAVE_WINDOW_SYSTEM
1777 if (FRAME_WINDOW_P (XFRAME (frame)))
1778 /* Warping the mouse will cause enternotify and focus events. */
1779 x_set_mouse_position (XFRAME (frame), XINT (x), XINT (y));
1780 #else
1781 #if defined (MSDOS) && defined (HAVE_MOUSE)
1782 if (FRAME_MSDOS_P (XFRAME (frame)))
1784 Fselect_frame (frame, Qnil);
1785 mouse_moveto (XINT (x), XINT (y));
1787 #else
1788 #ifdef HAVE_GPM
1790 Fselect_frame (frame, Qnil);
1791 term_mouse_moveto (XINT (x), XINT (y));
1793 #endif
1794 #endif
1795 #endif
1797 return Qnil;
1800 DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position,
1801 Sset_mouse_pixel_position, 3, 3, 0,
1802 doc: /* Move the mouse pointer to pixel position (X,Y) in FRAME.
1803 The position is given in pixels, where (0, 0) is the upper-left corner
1804 of the frame, X is the horizontal offset, and Y is the vertical offset.
1806 Note, this is a no-op for an X frame that is not visible.
1807 If you have just created a frame, you must wait for it to become visible
1808 before calling this function on it, like this.
1809 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1810 (frame, x, y)
1811 Lisp_Object frame, x, y;
1813 CHECK_LIVE_FRAME (frame);
1814 CHECK_NUMBER (x);
1815 CHECK_NUMBER (y);
1817 /* I think this should be done with a hook. */
1818 #ifdef HAVE_WINDOW_SYSTEM
1819 if (FRAME_WINDOW_P (XFRAME (frame)))
1820 /* Warping the mouse will cause enternotify and focus events. */
1821 x_set_mouse_pixel_position (XFRAME (frame), XINT (x), XINT (y));
1822 #else
1823 #if defined (MSDOS) && defined (HAVE_MOUSE)
1824 if (FRAME_MSDOS_P (XFRAME (frame)))
1826 Fselect_frame (frame, Qnil);
1827 mouse_moveto (XINT (x), XINT (y));
1829 #else
1830 #ifdef HAVE_GPM
1832 Fselect_frame (frame, Qnil);
1833 term_mouse_moveto (XINT (x), XINT (y));
1835 #endif
1836 #endif
1837 #endif
1839 return Qnil;
1842 static void make_frame_visible_1 P_ ((Lisp_Object));
1844 DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible,
1845 0, 1, "",
1846 doc: /* Make the frame FRAME visible (assuming it is an X window).
1847 If omitted, FRAME defaults to the currently selected frame. */)
1848 (frame)
1849 Lisp_Object frame;
1851 if (NILP (frame))
1852 frame = selected_frame;
1854 CHECK_LIVE_FRAME (frame);
1856 /* I think this should be done with a hook. */
1857 #ifdef HAVE_WINDOW_SYSTEM
1858 if (FRAME_WINDOW_P (XFRAME (frame)))
1860 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1861 x_make_frame_visible (XFRAME (frame));
1863 #endif
1865 make_frame_visible_1 (XFRAME (frame)->root_window);
1867 /* Make menu bar update for the Buffers and Frames menus. */
1868 windows_or_buffers_changed++;
1870 return frame;
1873 /* Update the display_time slot of the buffers shown in WINDOW
1874 and all its descendents. */
1876 static void
1877 make_frame_visible_1 (window)
1878 Lisp_Object window;
1880 struct window *w;
1882 for (;!NILP (window); window = w->next)
1884 w = XWINDOW (window);
1886 if (!NILP (w->buffer))
1887 XBUFFER (w->buffer)->display_time = Fcurrent_time ();
1889 if (!NILP (w->vchild))
1890 make_frame_visible_1 (w->vchild);
1891 if (!NILP (w->hchild))
1892 make_frame_visible_1 (w->hchild);
1896 DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible,
1897 0, 2, "",
1898 doc: /* Make the frame FRAME invisible.
1899 If omitted, FRAME defaults to the currently selected frame.
1900 On graphical displays, invisible frames are not updated and are
1901 usually not displayed at all, even in a window system's \"taskbar\".
1903 Normally you may not make FRAME invisible if all other frames are invisible,
1904 but if the second optional argument FORCE is non-nil, you may do so.
1906 This function has no effect on text-only terminal frames. Such frames
1907 are always considered visible, whether or not they are currently being
1908 displayed in the terminal. */)
1909 (frame, force)
1910 Lisp_Object frame, force;
1912 if (NILP (frame))
1913 frame = selected_frame;
1915 CHECK_LIVE_FRAME (frame);
1917 if (NILP (force) && !other_visible_frames (XFRAME (frame)))
1918 error ("Attempt to make invisible the sole visible or iconified frame");
1920 #if 0 /* This isn't logically necessary, and it can do GC. */
1921 /* Don't let the frame remain selected. */
1922 if (EQ (frame, selected_frame))
1923 do_switch_frame (next_frame (frame, Qt), 0, 0, Qnil)
1924 #endif
1926 /* Don't allow minibuf_window to remain on a deleted frame. */
1927 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1929 struct frame *sf = XFRAME (selected_frame);
1930 Fset_window_buffer (sf->minibuffer_window,
1931 XWINDOW (minibuf_window)->buffer, Qnil);
1932 minibuf_window = sf->minibuffer_window;
1935 /* I think this should be done with a hook. */
1936 #ifdef HAVE_WINDOW_SYSTEM
1937 if (FRAME_WINDOW_P (XFRAME (frame)))
1938 x_make_frame_invisible (XFRAME (frame));
1939 #endif
1941 /* Make menu bar update for the Buffers and Frames menus. */
1942 windows_or_buffers_changed++;
1944 return Qnil;
1947 DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame,
1948 0, 1, "",
1949 doc: /* Make the frame FRAME into an icon.
1950 If omitted, FRAME defaults to the currently selected frame. */)
1951 (frame)
1952 Lisp_Object frame;
1954 if (NILP (frame))
1955 frame = selected_frame;
1957 CHECK_LIVE_FRAME (frame);
1959 #if 0 /* This isn't logically necessary, and it can do GC. */
1960 /* Don't let the frame remain selected. */
1961 if (EQ (frame, selected_frame))
1962 Fhandle_switch_frame (next_frame (frame, Qt));
1963 #endif
1965 /* Don't allow minibuf_window to remain on a deleted frame. */
1966 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1968 struct frame *sf = XFRAME (selected_frame);
1969 Fset_window_buffer (sf->minibuffer_window,
1970 XWINDOW (minibuf_window)->buffer, Qnil);
1971 minibuf_window = sf->minibuffer_window;
1974 /* I think this should be done with a hook. */
1975 #ifdef HAVE_WINDOW_SYSTEM
1976 if (FRAME_WINDOW_P (XFRAME (frame)))
1977 x_iconify_frame (XFRAME (frame));
1978 #endif
1980 /* Make menu bar update for the Buffers and Frames menus. */
1981 windows_or_buffers_changed++;
1983 return Qnil;
1986 DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p,
1987 1, 1, 0,
1988 doc: /* Return t if FRAME is \"visible\" (actually in use for display).
1989 Return the symbol `icon' if FRAME is iconified or \"minimized\".
1990 Return nil if FRAME was made invisible, via `make-frame-invisible'.
1991 On graphical displays, invisible frames are not updated and are
1992 usually not displayed at all, even in a window system's \"taskbar\".
1994 If FRAME is a text-only terminal frame, this always returns t.
1995 Such frames are always considered visible, whether or not they are
1996 currently being displayed on the terminal. */)
1997 (frame)
1998 Lisp_Object frame;
2000 CHECK_LIVE_FRAME (frame);
2002 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
2004 if (FRAME_VISIBLE_P (XFRAME (frame)))
2005 return Qt;
2006 if (FRAME_ICONIFIED_P (XFRAME (frame)))
2007 return Qicon;
2008 return Qnil;
2011 DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list,
2012 0, 0, 0,
2013 doc: /* Return a list of all frames now \"visible\" (being updated). */)
2016 Lisp_Object tail, frame;
2017 struct frame *f;
2018 Lisp_Object value;
2020 value = Qnil;
2021 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
2023 frame = XCAR (tail);
2024 if (!FRAMEP (frame))
2025 continue;
2026 f = XFRAME (frame);
2027 if (FRAME_VISIBLE_P (f))
2028 value = Fcons (frame, value);
2030 return value;
2034 DEFUN ("raise-frame", Fraise_frame, Sraise_frame, 0, 1, "",
2035 doc: /* Bring FRAME to the front, so it occludes any frames it overlaps.
2036 If FRAME is invisible or iconified, make it visible.
2037 If you don't specify a frame, the selected frame is used.
2038 If Emacs is displaying on an ordinary terminal or some other device which
2039 doesn't support multiple overlapping frames, this function selects FRAME. */)
2040 (frame)
2041 Lisp_Object frame;
2043 struct frame *f;
2044 if (NILP (frame))
2045 frame = selected_frame;
2047 CHECK_LIVE_FRAME (frame);
2049 f = XFRAME (frame);
2051 if (FRAME_TERMCAP_P (f))
2052 /* On a text-only terminal select FRAME. */
2053 Fselect_frame (frame, Qnil);
2054 else
2055 /* Do like the documentation says. */
2056 Fmake_frame_visible (frame);
2058 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
2059 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 1);
2061 return Qnil;
2064 /* Should we have a corresponding function called Flower_Power? */
2065 DEFUN ("lower-frame", Flower_frame, Slower_frame, 0, 1, "",
2066 doc: /* Send FRAME to the back, so it is occluded by any frames that overlap it.
2067 If you don't specify a frame, the selected frame is used.
2068 If Emacs is displaying on an ordinary terminal or some other device which
2069 doesn't support multiple overlapping frames, this function does nothing. */)
2070 (frame)
2071 Lisp_Object frame;
2073 struct frame *f;
2075 if (NILP (frame))
2076 frame = selected_frame;
2078 CHECK_LIVE_FRAME (frame);
2080 f = XFRAME (frame);
2082 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
2083 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 0);
2085 return Qnil;
2089 DEFUN ("redirect-frame-focus", Fredirect_frame_focus, Sredirect_frame_focus,
2090 1, 2, 0,
2091 doc: /* Arrange for keystrokes typed at FRAME to be sent to FOCUS-FRAME.
2092 In other words, switch-frame events caused by events in FRAME will
2093 request a switch to FOCUS-FRAME, and `last-event-frame' will be
2094 FOCUS-FRAME after reading an event typed at FRAME.
2096 If FOCUS-FRAME is omitted or nil, any existing redirection is
2097 cancelled, and the frame again receives its own keystrokes.
2099 Focus redirection is useful for temporarily redirecting keystrokes to
2100 a surrogate minibuffer frame when a frame doesn't have its own
2101 minibuffer window.
2103 A frame's focus redirection can be changed by `select-frame'. If frame
2104 FOO is selected, and then a different frame BAR is selected, any
2105 frames redirecting their focus to FOO are shifted to redirect their
2106 focus to BAR. This allows focus redirection to work properly when the
2107 user switches from one frame to another using `select-window'.
2109 This means that a frame whose focus is redirected to itself is treated
2110 differently from a frame whose focus is redirected to nil; the former
2111 is affected by `select-frame', while the latter is not.
2113 The redirection lasts until `redirect-frame-focus' is called to change it. */)
2114 (frame, focus_frame)
2115 Lisp_Object frame, focus_frame;
2117 struct frame *f;
2119 /* Note that we don't check for a live frame here. It's reasonable
2120 to redirect the focus of a frame you're about to delete, if you
2121 know what other frame should receive those keystrokes. */
2122 CHECK_FRAME (frame);
2124 if (! NILP (focus_frame))
2125 CHECK_LIVE_FRAME (focus_frame);
2127 f = XFRAME (frame);
2129 f->focus_frame = focus_frame;
2131 if (FRAME_TERMINAL (f)->frame_rehighlight_hook)
2132 (*FRAME_TERMINAL (f)->frame_rehighlight_hook) (f);
2134 return Qnil;
2138 DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 1, 1, 0,
2139 doc: /* Return the frame to which FRAME's keystrokes are currently being sent.
2140 This returns nil if FRAME's focus is not redirected.
2141 See `redirect-frame-focus'. */)
2142 (frame)
2143 Lisp_Object frame;
2145 CHECK_LIVE_FRAME (frame);
2147 return FRAME_FOCUS_FRAME (XFRAME (frame));
2152 /* Return the value of frame parameter PROP in frame FRAME. */
2154 Lisp_Object
2155 get_frame_param (frame, prop)
2156 register struct frame *frame;
2157 Lisp_Object prop;
2159 register Lisp_Object tem;
2161 tem = Fassq (prop, frame->param_alist);
2162 if (EQ (tem, Qnil))
2163 return tem;
2164 return Fcdr (tem);
2167 /* Return the buffer-predicate of the selected frame. */
2169 Lisp_Object
2170 frame_buffer_predicate (frame)
2171 Lisp_Object frame;
2173 return XFRAME (frame)->buffer_predicate;
2176 /* Return the buffer-list of the selected frame. */
2178 Lisp_Object
2179 frame_buffer_list (frame)
2180 Lisp_Object frame;
2182 return XFRAME (frame)->buffer_list;
2185 /* Set the buffer-list of the selected frame. */
2187 void
2188 set_frame_buffer_list (frame, list)
2189 Lisp_Object frame, list;
2191 XFRAME (frame)->buffer_list = list;
2194 /* Discard BUFFER from the buffer-list and buried-buffer-list of each frame. */
2196 void
2197 frames_discard_buffer (buffer)
2198 Lisp_Object buffer;
2200 Lisp_Object frame, tail;
2202 FOR_EACH_FRAME (tail, frame)
2204 XFRAME (frame)->buffer_list
2205 = Fdelq (buffer, XFRAME (frame)->buffer_list);
2206 XFRAME (frame)->buried_buffer_list
2207 = Fdelq (buffer, XFRAME (frame)->buried_buffer_list);
2211 /* Modify the alist in *ALISTPTR to associate PROP with VAL.
2212 If the alist already has an element for PROP, we change it. */
2214 void
2215 store_in_alist (alistptr, prop, val)
2216 Lisp_Object *alistptr, val;
2217 Lisp_Object prop;
2219 register Lisp_Object tem;
2221 tem = Fassq (prop, *alistptr);
2222 if (EQ (tem, Qnil))
2223 *alistptr = Fcons (Fcons (prop, val), *alistptr);
2224 else
2225 Fsetcdr (tem, val);
2228 static int
2229 frame_name_fnn_p (str, len)
2230 char *str;
2231 EMACS_INT len;
2233 if (len > 1 && str[0] == 'F')
2235 char *end_ptr;
2237 strtol (str + 1, &end_ptr, 10);
2239 if (end_ptr == str + len)
2240 return 1;
2242 return 0;
2245 /* Set the name of the terminal frame. Also used by MSDOS frames.
2246 Modeled after x_set_name which is used for WINDOW frames. */
2248 static void
2249 set_term_frame_name (f, name)
2250 struct frame *f;
2251 Lisp_Object name;
2253 f->explicit_name = ! NILP (name);
2255 /* If NAME is nil, set the name to F<num>. */
2256 if (NILP (name))
2258 char namebuf[20];
2260 /* Check for no change needed in this very common case
2261 before we do any consing. */
2262 if (frame_name_fnn_p (SDATA (f->name),
2263 SBYTES (f->name)))
2264 return;
2266 tty_frame_count++;
2267 sprintf (namebuf, "F%d", tty_frame_count);
2268 name = build_string (namebuf);
2270 else
2272 CHECK_STRING (name);
2274 /* Don't change the name if it's already NAME. */
2275 if (! NILP (Fstring_equal (name, f->name)))
2276 return;
2278 /* Don't allow the user to set the frame name to F<num>, so it
2279 doesn't clash with the names we generate for terminal frames. */
2280 if (frame_name_fnn_p (SDATA (name), SBYTES (name)))
2281 error ("Frame names of the form F<num> are usurped by Emacs");
2284 f->name = name;
2285 update_mode_lines = 1;
2288 void
2289 store_frame_param (f, prop, val)
2290 struct frame *f;
2291 Lisp_Object prop, val;
2293 register Lisp_Object old_alist_elt;
2295 /* The buffer-list parameters are stored in a special place and not
2296 in the alist. */
2297 if (EQ (prop, Qbuffer_list))
2299 f->buffer_list = val;
2300 return;
2302 if (EQ (prop, Qburied_buffer_list))
2304 f->buried_buffer_list = val;
2305 return;
2308 /* If PROP is a symbol which is supposed to have frame-local values,
2309 and it is set up based on this frame, switch to the global
2310 binding. That way, we can create or alter the frame-local binding
2311 without messing up the symbol's status. */
2312 if (SYMBOLP (prop))
2314 Lisp_Object valcontents;
2315 valcontents = SYMBOL_VALUE (prop);
2316 if ((BUFFER_LOCAL_VALUEP (valcontents))
2317 && XBUFFER_LOCAL_VALUE (valcontents)->check_frame
2318 && XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame
2319 && XFRAME (XBUFFER_LOCAL_VALUE (valcontents)->frame) == f)
2320 swap_in_global_binding (prop);
2323 /* The tty color needed to be set before the frame's parameter
2324 alist was updated with the new value. This is not true any more,
2325 but we still do this test early on. */
2326 if (FRAME_TERMCAP_P (f) && EQ (prop, Qtty_color_mode)
2327 && f == FRAME_TTY (f)->previous_frame)
2328 /* Force redisplay of this tty. */
2329 FRAME_TTY (f)->previous_frame = NULL;
2331 /* Update the frame parameter alist. */
2332 old_alist_elt = Fassq (prop, f->param_alist);
2333 if (EQ (old_alist_elt, Qnil))
2334 f->param_alist = Fcons (Fcons (prop, val), f->param_alist);
2335 else
2336 Fsetcdr (old_alist_elt, val);
2338 /* Update some other special parameters in their special places
2339 in addition to the alist. */
2341 if (EQ (prop, Qbuffer_predicate))
2342 f->buffer_predicate = val;
2344 if (! FRAME_WINDOW_P (f))
2346 if (EQ (prop, Qmenu_bar_lines))
2347 set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f)));
2348 else if (EQ (prop, Qname))
2349 set_term_frame_name (f, val);
2352 if (EQ (prop, Qminibuffer) && WINDOWP (val))
2354 if (! MINI_WINDOW_P (XWINDOW (val)))
2355 error ("Surrogate minibuffer windows must be minibuffer windows");
2357 if ((FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
2358 && !EQ (val, f->minibuffer_window))
2359 error ("Can't change the surrogate minibuffer of a frame with its own minibuffer");
2361 /* Install the chosen minibuffer window, with proper buffer. */
2362 f->minibuffer_window = val;
2366 DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0,
2367 doc: /* Return the parameters-alist of frame FRAME.
2368 It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
2369 The meaningful PARMs depend on the kind of frame.
2370 If FRAME is omitted, return information on the currently selected frame. */)
2371 (frame)
2372 Lisp_Object frame;
2374 Lisp_Object alist;
2375 FRAME_PTR f;
2376 int height, width;
2377 struct gcpro gcpro1;
2379 if (NILP (frame))
2380 frame = selected_frame;
2382 CHECK_FRAME (frame);
2383 f = XFRAME (frame);
2385 if (!FRAME_LIVE_P (f))
2386 return Qnil;
2388 alist = Fcopy_alist (f->param_alist);
2389 GCPRO1 (alist);
2391 if (!FRAME_WINDOW_P (f))
2393 int fg = FRAME_FOREGROUND_PIXEL (f);
2394 int bg = FRAME_BACKGROUND_PIXEL (f);
2395 Lisp_Object elt;
2397 /* If the frame's parameter alist says the colors are
2398 unspecified and reversed, take the frame's background pixel
2399 for foreground and vice versa. */
2400 elt = Fassq (Qforeground_color, alist);
2401 if (CONSP (elt) && STRINGP (XCDR (elt)))
2403 if (strncmp (SDATA (XCDR (elt)),
2404 unspecified_bg,
2405 SCHARS (XCDR (elt))) == 0)
2406 store_in_alist (&alist, Qforeground_color, tty_color_name (f, bg));
2407 else if (strncmp (SDATA (XCDR (elt)),
2408 unspecified_fg,
2409 SCHARS (XCDR (elt))) == 0)
2410 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2412 else
2413 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2414 elt = Fassq (Qbackground_color, alist);
2415 if (CONSP (elt) && STRINGP (XCDR (elt)))
2417 if (strncmp (SDATA (XCDR (elt)),
2418 unspecified_fg,
2419 SCHARS (XCDR (elt))) == 0)
2420 store_in_alist (&alist, Qbackground_color, tty_color_name (f, fg));
2421 else if (strncmp (SDATA (XCDR (elt)),
2422 unspecified_bg,
2423 SCHARS (XCDR (elt))) == 0)
2424 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2426 else
2427 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2428 store_in_alist (&alist, intern ("font"),
2429 build_string (FRAME_MSDOS_P (f)
2430 ? "ms-dos"
2431 : FRAME_W32_P (f) ? "w32term"
2432 :"tty"));
2434 store_in_alist (&alist, Qname, f->name);
2435 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2436 store_in_alist (&alist, Qheight, make_number (height));
2437 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2438 store_in_alist (&alist, Qwidth, make_number (width));
2439 store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil));
2440 store_in_alist (&alist, Qminibuffer,
2441 (! FRAME_HAS_MINIBUF_P (f) ? Qnil
2442 : FRAME_MINIBUF_ONLY_P (f) ? Qonly
2443 : FRAME_MINIBUF_WINDOW (f)));
2444 store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
2445 store_in_alist (&alist, Qbuffer_list, frame_buffer_list (frame));
2446 store_in_alist (&alist, Qburied_buffer_list, XFRAME (frame)->buried_buffer_list);
2448 /* I think this should be done with a hook. */
2449 #ifdef HAVE_WINDOW_SYSTEM
2450 if (FRAME_WINDOW_P (f))
2451 x_report_frame_params (f, &alist);
2452 else
2453 #endif
2455 /* This ought to be correct in f->param_alist for an X frame. */
2456 Lisp_Object lines;
2457 XSETFASTINT (lines, FRAME_MENU_BAR_LINES (f));
2458 store_in_alist (&alist, Qmenu_bar_lines, lines);
2461 UNGCPRO;
2462 return alist;
2466 DEFUN ("frame-parameter", Fframe_parameter, Sframe_parameter, 2, 2, 0,
2467 doc: /* Return FRAME's value for parameter PARAMETER.
2468 If FRAME is nil, describe the currently selected frame. */)
2469 (frame, parameter)
2470 Lisp_Object frame, parameter;
2472 struct frame *f;
2473 Lisp_Object value;
2475 if (NILP (frame))
2476 frame = selected_frame;
2477 else
2478 CHECK_FRAME (frame);
2479 CHECK_SYMBOL (parameter);
2481 f = XFRAME (frame);
2482 value = Qnil;
2484 if (FRAME_LIVE_P (f))
2486 /* Avoid consing in frequent cases. */
2487 if (EQ (parameter, Qname))
2488 value = f->name;
2489 #ifdef HAVE_X_WINDOWS
2490 else if (EQ (parameter, Qdisplay) && FRAME_X_P (f))
2491 value = XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element);
2492 #endif /* HAVE_X_WINDOWS */
2493 else if (EQ (parameter, Qbackground_color)
2494 || EQ (parameter, Qforeground_color))
2496 value = Fassq (parameter, f->param_alist);
2497 if (CONSP (value))
2499 value = XCDR (value);
2500 /* Fframe_parameters puts the actual fg/bg color names,
2501 even if f->param_alist says otherwise. This is
2502 important when param_alist's notion of colors is
2503 "unspecified". We need to do the same here. */
2504 if (STRINGP (value) && !FRAME_WINDOW_P (f))
2506 const char *color_name;
2507 EMACS_INT csz;
2509 if (EQ (parameter, Qbackground_color))
2511 color_name = SDATA (value);
2512 csz = SCHARS (value);
2513 if (strncmp (color_name, unspecified_bg, csz) == 0)
2514 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2515 else if (strncmp (color_name, unspecified_fg, csz) == 0)
2516 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2518 else if (EQ (parameter, Qforeground_color))
2520 color_name = SDATA (value);
2521 csz = SCHARS (value);
2522 if (strncmp (color_name, unspecified_fg, csz) == 0)
2523 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2524 else if (strncmp (color_name, unspecified_bg, csz) == 0)
2525 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2529 else
2530 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2532 else if (EQ (parameter, Qdisplay_type)
2533 || EQ (parameter, Qbackground_mode))
2534 value = Fcdr (Fassq (parameter, f->param_alist));
2535 else
2536 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2539 return value;
2543 DEFUN ("modify-frame-parameters", Fmodify_frame_parameters,
2544 Smodify_frame_parameters, 2, 2, 0,
2545 doc: /* Modify the parameters of frame FRAME according to ALIST.
2546 If FRAME is nil, it defaults to the selected frame.
2547 ALIST is an alist of parameters to change and their new values.
2548 Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.
2549 The meaningful PARMs depend on the kind of frame.
2550 Undefined PARMs are ignored, but stored in the frame's parameter list
2551 so that `frame-parameters' will return them.
2553 The value of frame parameter FOO can also be accessed
2554 as a frame-local binding for the variable FOO, if you have
2555 enabled such bindings for that variable with `make-variable-frame-local'.
2556 Note that this functionality is obsolete as of Emacs 22.2, and its
2557 use is not recommended. Explicitly check for a frame-parameter instead. */)
2558 (frame, alist)
2559 Lisp_Object frame, alist;
2561 FRAME_PTR f;
2562 register Lisp_Object tail, prop, val;
2564 if (EQ (frame, Qnil))
2565 frame = selected_frame;
2566 CHECK_LIVE_FRAME (frame);
2567 f = XFRAME (frame);
2569 /* I think this should be done with a hook. */
2570 #ifdef HAVE_WINDOW_SYSTEM
2571 if (FRAME_WINDOW_P (f))
2572 x_set_frame_parameters (f, alist);
2573 else
2574 #endif
2575 #ifdef MSDOS
2576 if (FRAME_MSDOS_P (f))
2577 IT_set_frame_parameters (f, alist);
2578 else
2579 #endif
2582 int length = XINT (Flength (alist));
2583 int i;
2584 Lisp_Object *parms
2585 = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
2586 Lisp_Object *values
2587 = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
2589 /* Extract parm names and values into those vectors. */
2591 i = 0;
2592 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2594 Lisp_Object elt;
2596 elt = XCAR (tail);
2597 parms[i] = Fcar (elt);
2598 values[i] = Fcdr (elt);
2599 i++;
2602 /* Now process them in reverse of specified order. */
2603 for (i--; i >= 0; i--)
2605 prop = parms[i];
2606 val = values[i];
2607 store_frame_param (f, prop, val);
2609 /* Changing the background color might change the background
2610 mode, so that we have to load new defface specs.
2611 Call frame-set-background-mode to do that. */
2612 if (EQ (prop, Qbackground_color))
2613 call1 (Qframe_set_background_mode, frame);
2616 return Qnil;
2619 DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height,
2620 0, 1, 0,
2621 doc: /* Height in pixels of a line in the font in frame FRAME.
2622 If FRAME is omitted, the selected frame is used.
2623 For a terminal frame, the value is always 1. */)
2624 (frame)
2625 Lisp_Object frame;
2627 struct frame *f;
2629 if (NILP (frame))
2630 frame = selected_frame;
2631 CHECK_FRAME (frame);
2632 f = XFRAME (frame);
2634 #ifdef HAVE_WINDOW_SYSTEM
2635 if (FRAME_WINDOW_P (f))
2636 return make_number (x_char_height (f));
2637 else
2638 #endif
2639 return make_number (1);
2643 DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width,
2644 0, 1, 0,
2645 doc: /* Width in pixels of characters in the font in frame FRAME.
2646 If FRAME is omitted, the selected frame is used.
2647 On a graphical screen, the width is the standard width of the default font.
2648 For a terminal screen, the value is always 1. */)
2649 (frame)
2650 Lisp_Object frame;
2652 struct frame *f;
2654 if (NILP (frame))
2655 frame = selected_frame;
2656 CHECK_FRAME (frame);
2657 f = XFRAME (frame);
2659 #ifdef HAVE_WINDOW_SYSTEM
2660 if (FRAME_WINDOW_P (f))
2661 return make_number (x_char_width (f));
2662 else
2663 #endif
2664 return make_number (1);
2667 DEFUN ("frame-pixel-height", Fframe_pixel_height,
2668 Sframe_pixel_height, 0, 1, 0,
2669 doc: /* Return a FRAME's height in pixels.
2670 If FRAME is omitted, the selected frame is used. The exact value
2671 of the result depends on the window-system and toolkit in use:
2673 In the Gtk+ version of Emacs, it includes only any window (including
2674 the minibuffer or eacho area), mode line, and header line. It does not
2675 include the tool bar or menu bar.
2677 With the Motif or Lucid toolkits, it also includes the tool bar (but
2678 not the menu bar).
2680 In a graphical version with no toolkit, it includes both the tool bar
2681 and menu bar.
2683 For a text-only terminal, it includes the menu bar. In this case, the
2684 result is really in characters rather than pixels (i.e., is identical
2685 to `frame-height'). */)
2686 (frame)
2687 Lisp_Object frame;
2689 struct frame *f;
2691 if (NILP (frame))
2692 frame = selected_frame;
2693 CHECK_FRAME (frame);
2694 f = XFRAME (frame);
2696 #ifdef HAVE_WINDOW_SYSTEM
2697 if (FRAME_WINDOW_P (f))
2698 return make_number (x_pixel_height (f));
2699 else
2700 #endif
2701 return make_number (FRAME_LINES (f));
2704 DEFUN ("frame-pixel-width", Fframe_pixel_width,
2705 Sframe_pixel_width, 0, 1, 0,
2706 doc: /* Return FRAME's width in pixels.
2707 For a terminal frame, the result really gives the width in characters.
2708 If FRAME is omitted, the selected frame is used. */)
2709 (frame)
2710 Lisp_Object frame;
2712 struct frame *f;
2714 if (NILP (frame))
2715 frame = selected_frame;
2716 CHECK_FRAME (frame);
2717 f = XFRAME (frame);
2719 #ifdef HAVE_WINDOW_SYSTEM
2720 if (FRAME_WINDOW_P (f))
2721 return make_number (x_pixel_width (f));
2722 else
2723 #endif
2724 return make_number (FRAME_COLS (f));
2727 DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0,
2728 doc: /* Specify that the frame FRAME has LINES lines.
2729 Optional third arg non-nil means that redisplay should use LINES lines
2730 but that the idea of the actual height of the frame should not be changed. */)
2731 (frame, lines, pretend)
2732 Lisp_Object frame, lines, pretend;
2734 register struct frame *f;
2736 CHECK_NUMBER (lines);
2737 if (NILP (frame))
2738 frame = selected_frame;
2739 CHECK_LIVE_FRAME (frame);
2740 f = XFRAME (frame);
2742 /* I think this should be done with a hook. */
2743 #ifdef HAVE_WINDOW_SYSTEM
2744 if (FRAME_WINDOW_P (f))
2746 if (XINT (lines) != FRAME_LINES (f))
2747 x_set_window_size (f, 1, FRAME_COLS (f), XINT (lines));
2748 do_pending_window_change (0);
2750 else
2751 #endif
2752 change_frame_size (f, XINT (lines), 0, !NILP (pretend), 0, 0);
2753 return Qnil;
2756 DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 3, 0,
2757 doc: /* Specify that the frame FRAME has COLS columns.
2758 Optional third arg non-nil means that redisplay should use COLS columns
2759 but that the idea of the actual width of the frame should not be changed. */)
2760 (frame, cols, pretend)
2761 Lisp_Object frame, cols, pretend;
2763 register struct frame *f;
2764 CHECK_NUMBER (cols);
2765 if (NILP (frame))
2766 frame = selected_frame;
2767 CHECK_LIVE_FRAME (frame);
2768 f = XFRAME (frame);
2770 /* I think this should be done with a hook. */
2771 #ifdef HAVE_WINDOW_SYSTEM
2772 if (FRAME_WINDOW_P (f))
2774 if (XINT (cols) != FRAME_COLS (f))
2775 x_set_window_size (f, 1, XINT (cols), FRAME_LINES (f));
2776 do_pending_window_change (0);
2778 else
2779 #endif
2780 change_frame_size (f, 0, XINT (cols), !NILP (pretend), 0, 0);
2781 return Qnil;
2784 DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0,
2785 doc: /* Sets size of FRAME to COLS by ROWS, measured in characters. */)
2786 (frame, cols, rows)
2787 Lisp_Object frame, cols, rows;
2789 register struct frame *f;
2791 CHECK_LIVE_FRAME (frame);
2792 CHECK_NUMBER (cols);
2793 CHECK_NUMBER (rows);
2794 f = XFRAME (frame);
2796 /* I think this should be done with a hook. */
2797 #ifdef HAVE_WINDOW_SYSTEM
2798 if (FRAME_WINDOW_P (f))
2800 if (XINT (rows) != FRAME_LINES (f)
2801 || XINT (cols) != FRAME_COLS (f)
2802 || f->new_text_lines || f->new_text_cols)
2803 x_set_window_size (f, 1, XINT (cols), XINT (rows));
2804 do_pending_window_change (0);
2806 else
2807 #endif
2808 change_frame_size (f, XINT (rows), XINT (cols), 0, 0, 0);
2810 return Qnil;
2813 DEFUN ("set-frame-position", Fset_frame_position,
2814 Sset_frame_position, 3, 3, 0,
2815 doc: /* Sets position of FRAME in pixels to XOFFSET by YOFFSET.
2816 This is actually the position of the upper left corner of the frame.
2817 Negative values for XOFFSET or YOFFSET are interpreted relative to
2818 the rightmost or bottommost possible position (that stays within the screen). */)
2819 (frame, xoffset, yoffset)
2820 Lisp_Object frame, xoffset, yoffset;
2822 register struct frame *f;
2824 CHECK_LIVE_FRAME (frame);
2825 CHECK_NUMBER (xoffset);
2826 CHECK_NUMBER (yoffset);
2827 f = XFRAME (frame);
2829 /* I think this should be done with a hook. */
2830 #ifdef HAVE_WINDOW_SYSTEM
2831 if (FRAME_WINDOW_P (f))
2832 x_set_offset (f, XINT (xoffset), XINT (yoffset), 1);
2833 #endif
2835 return Qt;
2839 /***********************************************************************
2840 Frame Parameters
2841 ***********************************************************************/
2843 /* Connect the frame-parameter names for X frames
2844 to the ways of passing the parameter values to the window system.
2846 The name of a parameter, as a Lisp symbol,
2847 has an `x-frame-parameter' property which is an integer in Lisp
2848 that is an index in this table. */
2850 struct frame_parm_table {
2851 char *name;
2852 Lisp_Object *variable;
2855 static struct frame_parm_table frame_parms[] =
2857 {"auto-raise", &Qauto_raise},
2858 {"auto-lower", &Qauto_lower},
2859 {"background-color", 0},
2860 {"border-color", &Qborder_color},
2861 {"border-width", &Qborder_width},
2862 {"cursor-color", &Qcursor_color},
2863 {"cursor-type", &Qcursor_type},
2864 {"font", 0},
2865 {"foreground-color", 0},
2866 {"icon-name", &Qicon_name},
2867 {"icon-type", &Qicon_type},
2868 {"internal-border-width", &Qinternal_border_width},
2869 {"menu-bar-lines", &Qmenu_bar_lines},
2870 {"mouse-color", &Qmouse_color},
2871 {"name", &Qname},
2872 {"scroll-bar-width", &Qscroll_bar_width},
2873 {"title", &Qtitle},
2874 {"unsplittable", &Qunsplittable},
2875 {"vertical-scroll-bars", &Qvertical_scroll_bars},
2876 {"visibility", &Qvisibility},
2877 {"tool-bar-lines", &Qtool_bar_lines},
2878 {"scroll-bar-foreground", &Qscroll_bar_foreground},
2879 {"scroll-bar-background", &Qscroll_bar_background},
2880 {"screen-gamma", &Qscreen_gamma},
2881 {"line-spacing", &Qline_spacing},
2882 {"left-fringe", &Qleft_fringe},
2883 {"right-fringe", &Qright_fringe},
2884 {"wait-for-wm", &Qwait_for_wm},
2885 {"fullscreen", &Qfullscreen},
2886 {"font-backend", &Qfont_backend},
2887 {"alpha", &Qalpha},
2888 {"sticky", &Qsticky},
2891 #ifdef HAVE_WINDOW_SYSTEM
2893 extern Lisp_Object Qbox;
2894 extern Lisp_Object Qtop;
2896 /* Calculate fullscreen size. Return in *TOP_POS and *LEFT_POS the
2897 wanted positions of the WM window (not Emacs window).
2898 Return in *WIDTH and *HEIGHT the wanted width and height of Emacs
2899 window (FRAME_X_WINDOW).
2902 void
2903 x_fullscreen_adjust (f, width, height, top_pos, left_pos)
2904 struct frame *f;
2905 int *width;
2906 int *height;
2907 int *top_pos;
2908 int *left_pos;
2910 int newwidth = FRAME_COLS (f);
2911 int newheight = FRAME_LINES (f);
2912 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2914 *top_pos = f->top_pos;
2915 *left_pos = f->left_pos;
2917 if (f->want_fullscreen & FULLSCREEN_HEIGHT)
2919 int ph;
2921 ph = x_display_pixel_height (dpyinfo);
2922 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2923 ph = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, newheight) - f->y_pixels_diff;
2924 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2925 *top_pos = 0;
2928 if (f->want_fullscreen & FULLSCREEN_WIDTH)
2930 int pw;
2932 pw = x_display_pixel_width (dpyinfo);
2933 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2934 pw = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, newwidth) - f->x_pixels_diff;
2935 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2936 *left_pos = 0;
2939 *width = newwidth;
2940 *height = newheight;
2944 /* Change the parameters of frame F as specified by ALIST.
2945 If a parameter is not specially recognized, do nothing special;
2946 otherwise call the `x_set_...' function for that parameter.
2947 Except for certain geometry properties, always call store_frame_param
2948 to store the new value in the parameter alist. */
2950 void
2951 x_set_frame_parameters (f, alist)
2952 FRAME_PTR f;
2953 Lisp_Object alist;
2955 Lisp_Object tail;
2957 /* If both of these parameters are present, it's more efficient to
2958 set them both at once. So we wait until we've looked at the
2959 entire list before we set them. */
2960 int width, height;
2962 /* Same here. */
2963 Lisp_Object left, top;
2965 /* Same with these. */
2966 Lisp_Object icon_left, icon_top;
2968 /* Record in these vectors all the parms specified. */
2969 Lisp_Object *parms;
2970 Lisp_Object *values;
2971 int i, p;
2972 int left_no_change = 0, top_no_change = 0;
2973 int icon_left_no_change = 0, icon_top_no_change = 0;
2974 int size_changed = 0;
2975 struct gcpro gcpro1, gcpro2;
2977 i = 0;
2978 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
2979 i++;
2981 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
2982 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
2984 /* Extract parm names and values into those vectors. */
2986 i = 0;
2987 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2989 Lisp_Object elt;
2991 elt = XCAR (tail);
2992 parms[i] = Fcar (elt);
2993 values[i] = Fcdr (elt);
2994 i++;
2996 /* TAIL and ALIST are not used again below here. */
2997 alist = tail = Qnil;
2999 GCPRO2 (*parms, *values);
3000 gcpro1.nvars = i;
3001 gcpro2.nvars = i;
3003 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
3004 because their values appear in VALUES and strings are not valid. */
3005 top = left = Qunbound;
3006 icon_left = icon_top = Qunbound;
3008 /* Provide default values for HEIGHT and WIDTH. */
3009 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
3010 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
3012 /* Process foreground_color and background_color before anything else.
3013 They are independent of other properties, but other properties (e.g.,
3014 cursor_color) are dependent upon them. */
3015 /* Process default font as well, since fringe widths depends on it. */
3016 for (p = 0; p < i; p++)
3018 Lisp_Object prop, val;
3020 prop = parms[p];
3021 val = values[p];
3022 if (EQ (prop, Qforeground_color)
3023 || EQ (prop, Qbackground_color)
3024 || EQ (prop, Qfont))
3026 register Lisp_Object param_index, old_value;
3028 old_value = get_frame_param (f, prop);
3029 if (NILP (Fequal (val, old_value)))
3031 store_frame_param (f, prop, val);
3033 param_index = Fget (prop, Qx_frame_parameter);
3034 if (NATNUMP (param_index)
3035 && (XFASTINT (param_index)
3036 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3037 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
3038 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
3043 /* Now process them in reverse of specified order. */
3044 for (i--; i >= 0; i--)
3046 Lisp_Object prop, val;
3048 prop = parms[i];
3049 val = values[i];
3051 if (EQ (prop, Qwidth) && NATNUMP (val))
3053 size_changed = 1;
3054 width = XFASTINT (val);
3056 else if (EQ (prop, Qheight) && NATNUMP (val))
3058 size_changed = 1;
3059 height = XFASTINT (val);
3061 else if (EQ (prop, Qtop))
3062 top = val;
3063 else if (EQ (prop, Qleft))
3064 left = val;
3065 else if (EQ (prop, Qicon_top))
3066 icon_top = val;
3067 else if (EQ (prop, Qicon_left))
3068 icon_left = val;
3069 else if (EQ (prop, Qforeground_color)
3070 || EQ (prop, Qbackground_color)
3071 || EQ (prop, Qfont))
3072 /* Processed above. */
3073 continue;
3074 else
3076 register Lisp_Object param_index, old_value;
3078 old_value = get_frame_param (f, prop);
3080 store_frame_param (f, prop, val);
3082 param_index = Fget (prop, Qx_frame_parameter);
3083 if (NATNUMP (param_index)
3084 && (XFASTINT (param_index)
3085 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3086 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
3087 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
3091 /* Don't die if just one of these was set. */
3092 if (EQ (left, Qunbound))
3094 left_no_change = 1;
3095 if (f->left_pos < 0)
3096 left = Fcons (Qplus, Fcons (make_number (f->left_pos), Qnil));
3097 else
3098 XSETINT (left, f->left_pos);
3100 if (EQ (top, Qunbound))
3102 top_no_change = 1;
3103 if (f->top_pos < 0)
3104 top = Fcons (Qplus, Fcons (make_number (f->top_pos), Qnil));
3105 else
3106 XSETINT (top, f->top_pos);
3109 /* If one of the icon positions was not set, preserve or default it. */
3110 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
3112 icon_left_no_change = 1;
3113 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
3114 if (NILP (icon_left))
3115 XSETINT (icon_left, 0);
3117 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
3119 icon_top_no_change = 1;
3120 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
3121 if (NILP (icon_top))
3122 XSETINT (icon_top, 0);
3125 /* Don't set these parameters unless they've been explicitly
3126 specified. The window might be mapped or resized while we're in
3127 this function, and we don't want to override that unless the lisp
3128 code has asked for it.
3130 Don't set these parameters unless they actually differ from the
3131 window's current parameters; the window may not actually exist
3132 yet. */
3134 Lisp_Object frame;
3136 check_frame_size (f, &height, &width);
3138 XSETFRAME (frame, f);
3140 if (size_changed
3141 && (width != FRAME_COLS (f)
3142 || height != FRAME_LINES (f)
3143 || f->new_text_lines || f->new_text_cols))
3144 Fset_frame_size (frame, make_number (width), make_number (height));
3146 if ((!NILP (left) || !NILP (top))
3147 && ! (left_no_change && top_no_change)
3148 && ! (NUMBERP (left) && XINT (left) == f->left_pos
3149 && NUMBERP (top) && XINT (top) == f->top_pos))
3151 int leftpos = 0;
3152 int toppos = 0;
3154 /* Record the signs. */
3155 f->size_hint_flags &= ~ (XNegative | YNegative);
3156 if (EQ (left, Qminus))
3157 f->size_hint_flags |= XNegative;
3158 else if (INTEGERP (left))
3160 leftpos = XINT (left);
3161 if (leftpos < 0)
3162 f->size_hint_flags |= XNegative;
3164 else if (CONSP (left) && EQ (XCAR (left), Qminus)
3165 && CONSP (XCDR (left))
3166 && INTEGERP (XCAR (XCDR (left))))
3168 leftpos = - XINT (XCAR (XCDR (left)));
3169 f->size_hint_flags |= XNegative;
3171 else if (CONSP (left) && EQ (XCAR (left), Qplus)
3172 && CONSP (XCDR (left))
3173 && INTEGERP (XCAR (XCDR (left))))
3175 leftpos = XINT (XCAR (XCDR (left)));
3178 if (EQ (top, Qminus))
3179 f->size_hint_flags |= YNegative;
3180 else if (INTEGERP (top))
3182 toppos = XINT (top);
3183 if (toppos < 0)
3184 f->size_hint_flags |= YNegative;
3186 else if (CONSP (top) && EQ (XCAR (top), Qminus)
3187 && CONSP (XCDR (top))
3188 && INTEGERP (XCAR (XCDR (top))))
3190 toppos = - XINT (XCAR (XCDR (top)));
3191 f->size_hint_flags |= YNegative;
3193 else if (CONSP (top) && EQ (XCAR (top), Qplus)
3194 && CONSP (XCDR (top))
3195 && INTEGERP (XCAR (XCDR (top))))
3197 toppos = XINT (XCAR (XCDR (top)));
3201 /* Store the numeric value of the position. */
3202 f->top_pos = toppos;
3203 f->left_pos = leftpos;
3205 f->win_gravity = NorthWestGravity;
3207 /* Actually set that position, and convert to absolute. */
3208 x_set_offset (f, leftpos, toppos, -1);
3211 if ((!NILP (icon_left) || !NILP (icon_top))
3212 && ! (icon_left_no_change && icon_top_no_change))
3213 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
3216 UNGCPRO;
3220 /* Insert a description of internally-recorded parameters of frame X
3221 into the parameter alist *ALISTPTR that is to be given to the user.
3222 Only parameters that are specific to the X window system
3223 and whose values are not correctly recorded in the frame's
3224 param_alist need to be considered here. */
3226 void
3227 x_report_frame_params (f, alistptr)
3228 struct frame *f;
3229 Lisp_Object *alistptr;
3231 char buf[16];
3232 Lisp_Object tem;
3234 /* Represent negative positions (off the top or left screen edge)
3235 in a way that Fmodify_frame_parameters will understand correctly. */
3236 XSETINT (tem, f->left_pos);
3237 if (f->left_pos >= 0)
3238 store_in_alist (alistptr, Qleft, tem);
3239 else
3240 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
3242 XSETINT (tem, f->top_pos);
3243 if (f->top_pos >= 0)
3244 store_in_alist (alistptr, Qtop, tem);
3245 else
3246 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
3248 store_in_alist (alistptr, Qborder_width,
3249 make_number (f->border_width));
3250 store_in_alist (alistptr, Qinternal_border_width,
3251 make_number (FRAME_INTERNAL_BORDER_WIDTH (f)));
3252 store_in_alist (alistptr, Qleft_fringe,
3253 make_number (FRAME_LEFT_FRINGE_WIDTH (f)));
3254 store_in_alist (alistptr, Qright_fringe,
3255 make_number (FRAME_RIGHT_FRINGE_WIDTH (f)));
3256 store_in_alist (alistptr, Qscroll_bar_width,
3257 (! FRAME_HAS_VERTICAL_SCROLL_BARS (f)
3258 ? make_number (0)
3259 : FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0
3260 ? make_number (FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3261 /* nil means "use default width"
3262 for non-toolkit scroll bar.
3263 ruler-mode.el depends on this. */
3264 : Qnil));
3265 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
3266 store_in_alist (alistptr, Qwindow_id,
3267 build_string (buf));
3268 #ifdef HAVE_X_WINDOWS
3269 #ifdef USE_X_TOOLKIT
3270 /* Tooltip frame may not have this widget. */
3271 if (FRAME_X_OUTPUT (f)->widget)
3272 #endif
3273 sprintf (buf, "%ld", (long) FRAME_OUTER_WINDOW (f));
3274 store_in_alist (alistptr, Qouter_window_id,
3275 build_string (buf));
3276 #endif
3277 store_in_alist (alistptr, Qicon_name, f->icon_name);
3278 FRAME_SAMPLE_VISIBILITY (f);
3279 store_in_alist (alistptr, Qvisibility,
3280 (FRAME_VISIBLE_P (f) ? Qt
3281 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
3282 store_in_alist (alistptr, Qdisplay,
3283 XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
3285 if (FRAME_X_OUTPUT (f)->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
3286 tem = Qnil;
3287 else
3288 XSETFASTINT (tem, FRAME_X_OUTPUT (f)->parent_desc);
3289 store_in_alist (alistptr, Qexplicit_name, (f->explicit_name ? Qt : Qnil));
3290 store_in_alist (alistptr, Qparent_id, tem);
3294 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
3295 the previous value of that parameter, NEW_VALUE is the new value. */
3297 void
3298 x_set_fullscreen (f, new_value, old_value)
3299 struct frame *f;
3300 Lisp_Object new_value, old_value;
3302 if (NILP (new_value))
3303 f->want_fullscreen = FULLSCREEN_NONE;
3304 else if (EQ (new_value, Qfullboth) || EQ (new_value, Qfullscreen))
3305 f->want_fullscreen = FULLSCREEN_BOTH;
3306 else if (EQ (new_value, Qfullwidth))
3307 f->want_fullscreen = FULLSCREEN_WIDTH;
3308 else if (EQ (new_value, Qfullheight))
3309 f->want_fullscreen = FULLSCREEN_HEIGHT;
3310 else if (EQ (new_value, Qmaximized))
3311 f->want_fullscreen = FULLSCREEN_MAXIMIZED;
3313 if (FRAME_TERMINAL (f)->fullscreen_hook != NULL)
3314 FRAME_TERMINAL (f)->fullscreen_hook (f);
3318 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
3319 the previous value of that parameter, NEW_VALUE is the new value. */
3321 void
3322 x_set_line_spacing (f, new_value, old_value)
3323 struct frame *f;
3324 Lisp_Object new_value, old_value;
3326 if (NILP (new_value))
3327 f->extra_line_spacing = 0;
3328 else if (NATNUMP (new_value))
3329 f->extra_line_spacing = XFASTINT (new_value);
3330 else
3331 signal_error ("Invalid line-spacing", new_value);
3332 if (FRAME_VISIBLE_P (f))
3333 redraw_frame (f);
3337 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
3338 the previous value of that parameter, NEW_VALUE is the new value. */
3340 void
3341 x_set_screen_gamma (f, new_value, old_value)
3342 struct frame *f;
3343 Lisp_Object new_value, old_value;
3345 Lisp_Object bgcolor;
3347 if (NILP (new_value))
3348 f->gamma = 0;
3349 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
3350 /* The value 0.4545 is the normal viewing gamma. */
3351 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
3352 else
3353 signal_error ("Invalid screen-gamma", new_value);
3355 /* Apply the new gamma value to the frame background. */
3356 bgcolor = Fassq (Qbackground_color, f->param_alist);
3357 if (CONSP (bgcolor) && (bgcolor = XCDR (bgcolor), STRINGP (bgcolor)))
3359 Lisp_Object index = Fget (Qbackground_color, Qx_frame_parameter);
3360 if (NATNUMP (index)
3361 && (XFASTINT (index)
3362 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3363 && FRAME_RIF (f)->frame_parm_handlers[XFASTINT (index)])
3364 (*FRAME_RIF (f)->frame_parm_handlers[XFASTINT (index)])
3365 (f, bgcolor, Qnil);
3368 Fclear_face_cache (Qnil);
3372 void
3373 x_set_font (f, arg, oldval)
3374 struct frame *f;
3375 Lisp_Object arg, oldval;
3377 Lisp_Object frame, font_object, font_param = Qnil;
3378 int fontset = -1;
3380 /* Set the frame parameter back to the old value because we may
3381 fail to use ARG as the new parameter value. */
3382 store_frame_param (f, Qfont, oldval);
3384 /* ARG is a fontset name, a font name, a cons of fontset name and a
3385 font object, or a font object. In the last case, this function
3386 never fail. */
3387 if (STRINGP (arg))
3389 font_param = arg;
3390 fontset = fs_query_fontset (arg, 0);
3391 if (fontset < 0)
3393 font_object = font_open_by_name (f, SDATA (arg));
3394 if (NILP (font_object))
3395 error ("Font `%s' is not defined", SDATA (arg));
3396 arg = AREF (font_object, FONT_NAME_INDEX);
3398 else if (fontset > 0)
3400 Lisp_Object ascii_font = fontset_ascii (fontset);
3402 font_object = font_open_by_name (f, SDATA (ascii_font));
3403 if (NILP (font_object))
3404 error ("Font `%s' is not defined", SDATA (arg));
3405 arg = AREF (font_object, FONT_NAME_INDEX);
3407 else
3408 error ("The default fontset can't be used for a frame font");
3410 else if (CONSP (arg) && STRINGP (XCAR (arg)) && FONT_OBJECT_P (XCDR (arg)))
3412 /* This is the case that the ASCII font of F's fontset XCAR
3413 (arg) is changed to the font XCDR (arg) by
3414 `set-fontset-font'. */
3415 fontset = fs_query_fontset (XCAR (arg), 0);
3416 if (fontset < 0)
3417 error ("Unknown fontset: %s", SDATA (XCAR (arg)));
3418 font_object = XCDR (arg);
3419 arg = AREF (font_object, FONT_NAME_INDEX);
3420 font_param = Ffont_get (font_object, QCname);
3422 else if (FONT_OBJECT_P (arg))
3424 font_object = arg;
3425 font_param = Ffont_get (font_object, QCname);
3426 /* This is to store the XLFD font name in the frame parameter for
3427 backward compatibility. We should store the font-object
3428 itself in the future. */
3429 arg = AREF (font_object, FONT_NAME_INDEX);
3430 fontset = FRAME_FONTSET (f);
3431 /* Check if we can use the current fontset. If not, set FONTSET
3432 to -1 to generate a new fontset from FONT-OBJECT. */
3433 if (fontset >= 0)
3435 Lisp_Object ascii_font = fontset_ascii (fontset);
3436 Lisp_Object spec = font_spec_from_name (ascii_font);
3438 if (! font_match_p (spec, font_object))
3439 fontset = -1;
3442 else
3443 signal_error ("Invalid font", arg);
3445 if (! NILP (Fequal (font_object, oldval)))
3446 return;
3448 x_new_font (f, font_object, fontset);
3449 store_frame_param (f, Qfont, arg);
3450 #ifdef HAVE_X_WINDOWS
3451 store_frame_param (f, Qfont_param, font_param);
3452 #endif
3453 /* Recalculate toolbar height. */
3454 f->n_tool_bar_rows = 0;
3455 /* Ensure we redraw it. */
3456 clear_current_matrices (f);
3458 recompute_basic_faces (f);
3460 do_pending_window_change (0);
3462 /* We used to call face-set-after-frame-default here, but it leads to
3463 recursive calls (since that function can set the `default' face's
3464 font which in turns changes the frame's `font' parameter).
3465 Also I don't know what this call is meant to do, but it seems the
3466 wrong way to do it anyway (it does a lot more work than what seems
3467 reasonable in response to a change to `font'). */
3471 void
3472 x_set_font_backend (f, new_value, old_value)
3473 struct frame *f;
3474 Lisp_Object new_value, old_value;
3476 if (! NILP (new_value)
3477 && !CONSP (new_value))
3479 char *p0, *p1;
3481 CHECK_STRING (new_value);
3482 p0 = p1 = SDATA (new_value);
3483 new_value = Qnil;
3484 while (*p0)
3486 while (*p1 && ! isspace (*p1) && *p1 != ',') p1++;
3487 if (p0 < p1)
3488 new_value = Fcons (Fintern (make_string (p0, p1 - p0), Qnil),
3489 new_value);
3490 if (*p1)
3492 int c;
3494 while ((c = *++p1) && isspace (c));
3496 p0 = p1;
3498 new_value = Fnreverse (new_value);
3501 if (! NILP (old_value) && ! NILP (Fequal (old_value, new_value)))
3502 return;
3504 if (FRAME_FONT (f))
3505 free_all_realized_faces (Qnil);
3507 new_value = font_update_drivers (f, NILP (new_value) ? Qt : new_value);
3508 if (NILP (new_value))
3510 if (NILP (old_value))
3511 error ("No font backend available");
3512 font_update_drivers (f, old_value);
3513 error ("None of specified font backends are available");
3515 store_frame_param (f, Qfont_backend, new_value);
3517 if (FRAME_FONT (f))
3519 Lisp_Object frame;
3521 XSETFRAME (frame, f);
3522 x_set_font (f, Fframe_parameter (frame, Qfont), Qnil);
3523 ++face_change_count;
3524 ++windows_or_buffers_changed;
3529 void
3530 x_set_fringe_width (f, new_value, old_value)
3531 struct frame *f;
3532 Lisp_Object new_value, old_value;
3534 compute_fringe_widths (f, 1);
3537 void
3538 x_set_border_width (f, arg, oldval)
3539 struct frame *f;
3540 Lisp_Object arg, oldval;
3542 CHECK_NUMBER (arg);
3544 if (XINT (arg) == f->border_width)
3545 return;
3547 if (FRAME_X_WINDOW (f) != 0)
3548 error ("Cannot change the border width of a frame");
3550 f->border_width = XINT (arg);
3553 void
3554 x_set_internal_border_width (f, arg, oldval)
3555 struct frame *f;
3556 Lisp_Object arg, oldval;
3558 int old = FRAME_INTERNAL_BORDER_WIDTH (f);
3560 CHECK_NUMBER (arg);
3561 FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
3562 if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
3563 FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
3565 #ifdef USE_X_TOOLKIT
3566 if (FRAME_X_OUTPUT (f)->edit_widget)
3567 widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
3568 #endif
3570 if (FRAME_INTERNAL_BORDER_WIDTH (f) == old)
3571 return;
3573 if (FRAME_X_WINDOW (f) != 0)
3575 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3576 SET_FRAME_GARBAGED (f);
3577 do_pending_window_change (0);
3579 else
3580 SET_FRAME_GARBAGED (f);
3583 void
3584 x_set_visibility (f, value, oldval)
3585 struct frame *f;
3586 Lisp_Object value, oldval;
3588 Lisp_Object frame;
3589 XSETFRAME (frame, f);
3591 if (NILP (value))
3592 Fmake_frame_invisible (frame, Qt);
3593 else if (EQ (value, Qicon))
3594 Ficonify_frame (frame);
3595 else
3596 Fmake_frame_visible (frame);
3599 void
3600 x_set_autoraise (f, arg, oldval)
3601 struct frame *f;
3602 Lisp_Object arg, oldval;
3604 f->auto_raise = !EQ (Qnil, arg);
3607 void
3608 x_set_autolower (f, arg, oldval)
3609 struct frame *f;
3610 Lisp_Object arg, oldval;
3612 f->auto_lower = !EQ (Qnil, arg);
3615 void
3616 x_set_unsplittable (f, arg, oldval)
3617 struct frame *f;
3618 Lisp_Object arg, oldval;
3620 f->no_split = !NILP (arg);
3623 void
3624 x_set_vertical_scroll_bars (f, arg, oldval)
3625 struct frame *f;
3626 Lisp_Object arg, oldval;
3628 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
3629 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
3630 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
3631 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
3633 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
3634 = (NILP (arg)
3635 ? vertical_scroll_bar_none
3636 : EQ (Qleft, arg)
3637 ? vertical_scroll_bar_left
3638 : EQ (Qright, arg)
3639 ? vertical_scroll_bar_right
3640 : EQ (Qleft, Vdefault_frame_scroll_bars)
3641 ? vertical_scroll_bar_left
3642 : EQ (Qright, Vdefault_frame_scroll_bars)
3643 ? vertical_scroll_bar_right
3644 : vertical_scroll_bar_none);
3646 /* We set this parameter before creating the X window for the
3647 frame, so we can get the geometry right from the start.
3648 However, if the window hasn't been created yet, we shouldn't
3649 call x_set_window_size. */
3650 if (FRAME_X_WINDOW (f))
3651 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3652 do_pending_window_change (0);
3656 void
3657 x_set_scroll_bar_width (f, arg, oldval)
3658 struct frame *f;
3659 Lisp_Object arg, oldval;
3661 int wid = FRAME_COLUMN_WIDTH (f);
3663 if (NILP (arg))
3665 x_set_scroll_bar_default_width (f);
3667 if (FRAME_X_WINDOW (f))
3668 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3669 do_pending_window_change (0);
3671 else if (INTEGERP (arg) && XINT (arg) > 0
3672 && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3674 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
3675 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
3677 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg);
3678 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
3679 if (FRAME_X_WINDOW (f))
3680 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3681 do_pending_window_change (0);
3684 change_frame_size (f, 0, FRAME_COLS (f), 0, 0, 0);
3685 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
3686 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
3691 /* Return non-nil if frame F wants a bitmap icon. */
3693 Lisp_Object
3694 x_icon_type (f)
3695 FRAME_PTR f;
3697 Lisp_Object tem;
3699 tem = assq_no_quit (Qicon_type, f->param_alist);
3700 if (CONSP (tem))
3701 return XCDR (tem);
3702 else
3703 return Qnil;
3706 void
3707 x_set_alpha (f, arg, oldval)
3708 struct frame *f;
3709 Lisp_Object arg, oldval;
3711 double alpha = 1.0;
3712 double newval[2];
3713 int i, ialpha;
3714 Lisp_Object item;
3716 for (i = 0; i < 2; i++)
3718 newval[i] = 1.0;
3719 if (CONSP (arg))
3721 item = CAR (arg);
3722 arg = CDR (arg);
3724 else
3725 item = arg;
3727 if (NILP (item))
3728 alpha = - 1.0;
3729 else if (FLOATP (item))
3731 alpha = XFLOAT_DATA (item);
3732 if (alpha < 0.0 || 1.0 < alpha)
3733 args_out_of_range (make_float (0.0), make_float (1.0));
3735 else if (INTEGERP (item))
3737 ialpha = XINT (item);
3738 if (ialpha < 0 || 100 < ialpha)
3739 args_out_of_range (make_number (0), make_number (100));
3740 else
3741 alpha = ialpha / 100.0;
3743 else
3744 wrong_type_argument (Qnumberp, item);
3745 newval[i] = alpha;
3748 for (i = 0; i < 2; i++)
3749 f->alpha[i] = newval[i];
3751 #if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA)
3752 BLOCK_INPUT;
3753 x_set_frame_alpha (f);
3754 UNBLOCK_INPUT;
3755 #endif
3757 return;
3761 /* Subroutines of creating an X frame. */
3763 /* Make sure that Vx_resource_name is set to a reasonable value.
3764 Fix it up, or set it to `emacs' if it is too hopeless. */
3766 void
3767 validate_x_resource_name ()
3769 int len = 0;
3770 /* Number of valid characters in the resource name. */
3771 int good_count = 0;
3772 /* Number of invalid characters in the resource name. */
3773 int bad_count = 0;
3774 Lisp_Object new;
3775 int i;
3777 if (!STRINGP (Vx_resource_class))
3778 Vx_resource_class = build_string (EMACS_CLASS);
3780 if (STRINGP (Vx_resource_name))
3782 unsigned char *p = SDATA (Vx_resource_name);
3783 int i;
3785 len = SBYTES (Vx_resource_name);
3787 /* Only letters, digits, - and _ are valid in resource names.
3788 Count the valid characters and count the invalid ones. */
3789 for (i = 0; i < len; i++)
3791 int c = p[i];
3792 if (! ((c >= 'a' && c <= 'z')
3793 || (c >= 'A' && c <= 'Z')
3794 || (c >= '0' && c <= '9')
3795 || c == '-' || c == '_'))
3796 bad_count++;
3797 else
3798 good_count++;
3801 else
3802 /* Not a string => completely invalid. */
3803 bad_count = 5, good_count = 0;
3805 /* If name is valid already, return. */
3806 if (bad_count == 0)
3807 return;
3809 /* If name is entirely invalid, or nearly so, use `emacs'. */
3810 if (good_count == 0
3811 || (good_count == 1 && bad_count > 0))
3813 Vx_resource_name = build_string ("emacs");
3814 return;
3817 /* Name is partly valid. Copy it and replace the invalid characters
3818 with underscores. */
3820 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
3822 for (i = 0; i < len; i++)
3824 int c = SREF (new, i);
3825 if (! ((c >= 'a' && c <= 'z')
3826 || (c >= 'A' && c <= 'Z')
3827 || (c >= '0' && c <= '9')
3828 || c == '-' || c == '_'))
3829 SSET (new, i, '_');
3834 extern char *x_get_string_resource P_ ((XrmDatabase, char *, char *));
3835 extern Display_Info *check_x_display_info P_ ((Lisp_Object));
3838 /* Get specified attribute from resource database RDB.
3839 See Fx_get_resource below for other parameters. */
3841 static Lisp_Object
3842 xrdb_get_resource (rdb, attribute, class, component, subclass)
3843 XrmDatabase rdb;
3844 Lisp_Object attribute, class, component, subclass;
3846 register char *value;
3847 char *name_key;
3848 char *class_key;
3850 CHECK_STRING (attribute);
3851 CHECK_STRING (class);
3853 if (!NILP (component))
3854 CHECK_STRING (component);
3855 if (!NILP (subclass))
3856 CHECK_STRING (subclass);
3857 if (NILP (component) != NILP (subclass))
3858 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3860 validate_x_resource_name ();
3862 /* Allocate space for the components, the dots which separate them,
3863 and the final '\0'. Make them big enough for the worst case. */
3864 name_key = (char *) alloca (SBYTES (Vx_resource_name)
3865 + (STRINGP (component)
3866 ? SBYTES (component) : 0)
3867 + SBYTES (attribute)
3868 + 3);
3870 class_key = (char *) alloca (SBYTES (Vx_resource_class)
3871 + SBYTES (class)
3872 + (STRINGP (subclass)
3873 ? SBYTES (subclass) : 0)
3874 + 3);
3876 /* Start with emacs.FRAMENAME for the name (the specific one)
3877 and with `Emacs' for the class key (the general one). */
3878 strcpy (name_key, SDATA (Vx_resource_name));
3879 strcpy (class_key, SDATA (Vx_resource_class));
3881 strcat (class_key, ".");
3882 strcat (class_key, SDATA (class));
3884 if (!NILP (component))
3886 strcat (class_key, ".");
3887 strcat (class_key, SDATA (subclass));
3889 strcat (name_key, ".");
3890 strcat (name_key, SDATA (component));
3893 strcat (name_key, ".");
3894 strcat (name_key, SDATA (attribute));
3896 value = x_get_string_resource (rdb, name_key, class_key);
3898 if (value != (char *) 0 && *value)
3899 return build_string (value);
3900 else
3901 return Qnil;
3905 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
3906 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
3907 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
3908 class, where INSTANCE is the name under which Emacs was invoked, or
3909 the name specified by the `-name' or `-rn' command-line arguments.
3911 The optional arguments COMPONENT and SUBCLASS add to the key and the
3912 class, respectively. You must specify both of them or neither.
3913 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
3914 and the class is `Emacs.CLASS.SUBCLASS'. */)
3915 (attribute, class, component, subclass)
3916 Lisp_Object attribute, class, component, subclass;
3918 #ifdef HAVE_X_WINDOWS
3919 check_x ();
3920 #endif
3922 return xrdb_get_resource (check_x_display_info (Qnil)->xrdb,
3923 attribute, class, component, subclass);
3926 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
3928 Lisp_Object
3929 display_x_get_resource (dpyinfo, attribute, class, component, subclass)
3930 Display_Info *dpyinfo;
3931 Lisp_Object attribute, class, component, subclass;
3933 return xrdb_get_resource (dpyinfo->xrdb,
3934 attribute, class, component, subclass);
3937 #if defined HAVE_X_WINDOWS && !defined USE_X_TOOLKIT
3938 /* Used when C code wants a resource value. */
3939 /* Called from oldXMenu/Create.c. */
3940 char *
3941 x_get_resource_string (attribute, class)
3942 char *attribute, *class;
3944 char *name_key;
3945 char *class_key;
3946 struct frame *sf = SELECTED_FRAME ();
3948 /* Allocate space for the components, the dots which separate them,
3949 and the final '\0'. */
3950 name_key = (char *) alloca (SBYTES (Vinvocation_name)
3951 + strlen (attribute) + 2);
3952 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
3953 + strlen (class) + 2);
3955 sprintf (name_key, "%s.%s", SDATA (Vinvocation_name), attribute);
3956 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3958 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
3959 name_key, class_key);
3961 #endif
3963 /* Return the value of parameter PARAM.
3965 First search ALIST, then Vdefault_frame_alist, then the X defaults
3966 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3968 Convert the resource to the type specified by desired_type.
3970 If no default is specified, return Qunbound. If you call
3971 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3972 and don't let it get stored in any Lisp-visible variables! */
3974 Lisp_Object
3975 x_get_arg (dpyinfo, alist, param, attribute, class, type)
3976 Display_Info *dpyinfo;
3977 Lisp_Object alist, param;
3978 char *attribute;
3979 char *class;
3980 enum resource_types type;
3982 register Lisp_Object tem;
3984 tem = Fassq (param, alist);
3986 if (!NILP (tem))
3988 /* If we find this parm in ALIST, clear it out
3989 so that it won't be "left over" at the end. */
3990 Lisp_Object tail;
3991 XSETCAR (tem, Qnil);
3992 /* In case the parameter appears more than once in the alist,
3993 clear it out. */
3994 for (tail = alist; CONSP (tail); tail = XCDR (tail))
3995 if (CONSP (XCAR (tail))
3996 && EQ (XCAR (XCAR (tail)), param))
3997 XSETCAR (XCAR (tail), Qnil);
3999 else
4000 tem = Fassq (param, Vdefault_frame_alist);
4002 /* If it wasn't specified in ALIST or the Lisp-level defaults,
4003 look in the X resources. */
4004 if (EQ (tem, Qnil))
4006 if (attribute && dpyinfo)
4008 tem = display_x_get_resource (dpyinfo,
4009 build_string (attribute),
4010 build_string (class),
4011 Qnil, Qnil);
4013 if (NILP (tem))
4014 return Qunbound;
4016 switch (type)
4018 case RES_TYPE_NUMBER:
4019 return make_number (atoi (SDATA (tem)));
4021 case RES_TYPE_BOOLEAN_NUMBER:
4022 if (!strcmp (SDATA (tem), "on")
4023 || !strcmp (SDATA (tem), "true"))
4024 return make_number (1);
4025 return make_number (atoi (SDATA (tem)));
4026 break;
4028 case RES_TYPE_FLOAT:
4029 return make_float (atof (SDATA (tem)));
4031 case RES_TYPE_BOOLEAN:
4032 tem = Fdowncase (tem);
4033 if (!strcmp (SDATA (tem), "on")
4034 #ifdef HAVE_NS
4035 || !strcmp(SDATA(tem), "yes")
4036 #endif
4037 || !strcmp (SDATA (tem), "true"))
4038 return Qt;
4039 else
4040 return Qnil;
4042 case RES_TYPE_STRING:
4043 return tem;
4045 case RES_TYPE_SYMBOL:
4046 /* As a special case, we map the values `true' and `on'
4047 to Qt, and `false' and `off' to Qnil. */
4049 Lisp_Object lower;
4050 lower = Fdowncase (tem);
4051 if (!strcmp (SDATA (lower), "on")
4052 #ifdef HAVE_NS
4053 || !strcmp(SDATA(lower), "yes")
4054 #endif
4055 || !strcmp (SDATA (lower), "true"))
4056 return Qt;
4057 else if (!strcmp (SDATA (lower), "off")
4058 #ifdef HAVE_NS
4059 || !strcmp(SDATA(lower), "no")
4060 #endif
4061 || !strcmp (SDATA (lower), "false"))
4062 return Qnil;
4063 else
4064 return Fintern (tem, Qnil);
4067 default:
4068 abort ();
4071 else
4072 return Qunbound;
4074 return Fcdr (tem);
4077 Lisp_Object
4078 x_frame_get_arg (f, alist, param, attribute, class, type)
4079 struct frame *f;
4080 Lisp_Object alist, param;
4081 char *attribute;
4082 char *class;
4083 enum resource_types type;
4085 return x_get_arg (FRAME_X_DISPLAY_INFO (f),
4086 alist, param, attribute, class, type);
4089 /* Like x_frame_get_arg, but also record the value in f->param_alist. */
4091 Lisp_Object
4092 x_frame_get_and_record_arg (f, alist, param, attribute, class, type)
4093 struct frame *f;
4094 Lisp_Object alist, param;
4095 char *attribute;
4096 char *class;
4097 enum resource_types type;
4099 Lisp_Object value;
4101 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
4102 attribute, class, type);
4103 if (! NILP (value) && ! EQ (value, Qunbound))
4104 store_frame_param (f, param, value);
4106 return value;
4110 /* Record in frame F the specified or default value according to ALIST
4111 of the parameter named PROP (a Lisp symbol).
4112 If no value is specified for PROP, look for an X default for XPROP
4113 on the frame named NAME.
4114 If that is not found either, use the value DEFLT. */
4116 Lisp_Object
4117 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
4118 struct frame *f;
4119 Lisp_Object alist;
4120 Lisp_Object prop;
4121 Lisp_Object deflt;
4122 char *xprop;
4123 char *xclass;
4124 enum resource_types type;
4126 Lisp_Object tem;
4128 tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type);
4129 if (EQ (tem, Qunbound))
4130 tem = deflt;
4131 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
4132 return tem;
4138 /* NS used to define x-parse-geometry in ns-win.el, but that confused
4139 make-docfile: the documentation string in ns-win.el was used for
4140 x-parse-geometry even in non-NS builds.
4142 With two definitions of x-parse-geometry in this file, various
4143 things still get confused (eg M-x apropos documentation), so that
4144 it is best if the two definitions just share the same doc-string.
4146 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
4147 doc: /* Parse a display geometry string STRING.
4148 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
4149 The properties returned may include `top', `left', `height', and `width'.
4150 For X, the value of `left' or `top' may be an integer,
4151 or a list (+ N) meaning N pixels relative to top/left corner,
4152 or a list (- N) meaning -N pixels relative to bottom/right corner.
4153 On Nextstep, this just calls `ns-parse-geometry'. */)
4154 (string)
4155 Lisp_Object string;
4157 #ifdef HAVE_NS
4158 call1 (Qns_parse_geometry, string);
4159 #else
4160 int geometry, x, y;
4161 unsigned int width, height;
4162 Lisp_Object result;
4164 CHECK_STRING (string);
4166 geometry = XParseGeometry ((char *) SDATA (string),
4167 &x, &y, &width, &height);
4168 result = Qnil;
4169 if (geometry & XValue)
4171 Lisp_Object element;
4173 if (x >= 0 && (geometry & XNegative))
4174 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
4175 else if (x < 0 && ! (geometry & XNegative))
4176 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
4177 else
4178 element = Fcons (Qleft, make_number (x));
4179 result = Fcons (element, result);
4182 if (geometry & YValue)
4184 Lisp_Object element;
4186 if (y >= 0 && (geometry & YNegative))
4187 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
4188 else if (y < 0 && ! (geometry & YNegative))
4189 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
4190 else
4191 element = Fcons (Qtop, make_number (y));
4192 result = Fcons (element, result);
4195 if (geometry & WidthValue)
4196 result = Fcons (Fcons (Qwidth, make_number (width)), result);
4197 if (geometry & HeightValue)
4198 result = Fcons (Fcons (Qheight, make_number (height)), result);
4200 return result;
4201 #endif /* HAVE_NS */
4205 /* Calculate the desired size and position of frame F.
4206 Return the flags saying which aspects were specified.
4208 Also set the win_gravity and size_hint_flags of F.
4210 Adjust height for toolbar if TOOLBAR_P is 1.
4212 This function does not make the coordinates positive. */
4214 #define DEFAULT_ROWS 35
4215 #define DEFAULT_COLS 80
4218 x_figure_window_size (f, parms, toolbar_p)
4219 struct frame *f;
4220 Lisp_Object parms;
4221 int toolbar_p;
4223 register Lisp_Object tem0, tem1, tem2;
4224 long window_prompting = 0;
4225 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
4227 /* Default values if we fall through.
4228 Actually, if that happens we should get
4229 window manager prompting. */
4230 SET_FRAME_COLS (f, DEFAULT_COLS);
4231 FRAME_LINES (f) = DEFAULT_ROWS;
4232 /* Window managers expect that if program-specified
4233 positions are not (0,0), they're intentional, not defaults. */
4234 f->top_pos = 0;
4235 f->left_pos = 0;
4237 /* Ensure that old new_text_cols and new_text_lines will not override the
4238 values set here. */
4239 /* ++KFS: This was specific to W32, but seems ok for all platforms */
4240 f->new_text_cols = f->new_text_lines = 0;
4242 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
4243 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
4244 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
4245 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4247 if (!EQ (tem0, Qunbound))
4249 CHECK_NUMBER (tem0);
4250 FRAME_LINES (f) = XINT (tem0);
4252 if (!EQ (tem1, Qunbound))
4254 CHECK_NUMBER (tem1);
4255 SET_FRAME_COLS (f, XINT (tem1));
4257 if (!NILP (tem2) && !EQ (tem2, Qunbound))
4258 window_prompting |= USSize;
4259 else
4260 window_prompting |= PSize;
4263 f->scroll_bar_actual_width
4264 = FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f);
4266 /* This used to be done _before_ calling x_figure_window_size, but
4267 since the height is reset here, this was really a no-op. I
4268 assume that moving it here does what Gerd intended (although he
4269 no longer can remember what that was... ++KFS, 2003-03-25. */
4271 /* Add the tool-bar height to the initial frame height so that the
4272 user gets a text display area of the size he specified with -g or
4273 via .Xdefaults. Later changes of the tool-bar height don't
4274 change the frame size. This is done so that users can create
4275 tall Emacs frames without having to guess how tall the tool-bar
4276 will get. */
4277 if (toolbar_p && FRAME_TOOL_BAR_LINES (f))
4279 int margin, relief, bar_height;
4281 relief = (tool_bar_button_relief >= 0
4282 ? tool_bar_button_relief
4283 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
4285 if (INTEGERP (Vtool_bar_button_margin)
4286 && XINT (Vtool_bar_button_margin) > 0)
4287 margin = XFASTINT (Vtool_bar_button_margin);
4288 else if (CONSP (Vtool_bar_button_margin)
4289 && INTEGERP (XCDR (Vtool_bar_button_margin))
4290 && XINT (XCDR (Vtool_bar_button_margin)) > 0)
4291 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
4292 else
4293 margin = 0;
4295 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
4296 FRAME_LINES (f) += (bar_height + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f);
4299 compute_fringe_widths (f, 0);
4301 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, FRAME_COLS (f));
4302 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, FRAME_LINES (f));
4304 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
4305 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
4306 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
4307 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4309 if (EQ (tem0, Qminus))
4311 f->top_pos = 0;
4312 window_prompting |= YNegative;
4314 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
4315 && CONSP (XCDR (tem0))
4316 && INTEGERP (XCAR (XCDR (tem0))))
4318 f->top_pos = - XINT (XCAR (XCDR (tem0)));
4319 window_prompting |= YNegative;
4321 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
4322 && CONSP (XCDR (tem0))
4323 && INTEGERP (XCAR (XCDR (tem0))))
4325 f->top_pos = XINT (XCAR (XCDR (tem0)));
4327 else if (EQ (tem0, Qunbound))
4328 f->top_pos = 0;
4329 else
4331 CHECK_NUMBER (tem0);
4332 f->top_pos = XINT (tem0);
4333 if (f->top_pos < 0)
4334 window_prompting |= YNegative;
4337 if (EQ (tem1, Qminus))
4339 f->left_pos = 0;
4340 window_prompting |= XNegative;
4342 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
4343 && CONSP (XCDR (tem1))
4344 && INTEGERP (XCAR (XCDR (tem1))))
4346 f->left_pos = - XINT (XCAR (XCDR (tem1)));
4347 window_prompting |= XNegative;
4349 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
4350 && CONSP (XCDR (tem1))
4351 && INTEGERP (XCAR (XCDR (tem1))))
4353 f->left_pos = XINT (XCAR (XCDR (tem1)));
4355 else if (EQ (tem1, Qunbound))
4356 f->left_pos = 0;
4357 else
4359 CHECK_NUMBER (tem1);
4360 f->left_pos = XINT (tem1);
4361 if (f->left_pos < 0)
4362 window_prompting |= XNegative;
4365 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
4366 window_prompting |= USPosition;
4367 else
4368 window_prompting |= PPosition;
4371 if (window_prompting & XNegative)
4373 if (window_prompting & YNegative)
4374 f->win_gravity = SouthEastGravity;
4375 else
4376 f->win_gravity = NorthEastGravity;
4378 else
4380 if (window_prompting & YNegative)
4381 f->win_gravity = SouthWestGravity;
4382 else
4383 f->win_gravity = NorthWestGravity;
4386 f->size_hint_flags = window_prompting;
4388 return window_prompting;
4393 #endif /* HAVE_WINDOW_SYSTEM */
4395 void
4396 frame_make_pointer_invisible ()
4398 if (! NILP (Vmake_pointer_invisible))
4400 struct frame *f;
4401 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4402 return;
4404 f = SELECTED_FRAME ();
4405 if (f && !f->pointer_invisible
4406 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4408 f->mouse_moved = 0;
4409 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 1);
4410 f->pointer_invisible = 1;
4415 void
4416 frame_make_pointer_visible ()
4418 /* We don't check Vmake_pointer_invisible here in case the
4419 pointer was invisible when Vmake_pointer_invisible was set to nil. */
4420 struct frame *f;
4422 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4423 return;
4425 f = SELECTED_FRAME ();
4426 if (f && f->pointer_invisible && f->mouse_moved
4427 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4429 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 0);
4430 f->pointer_invisible = 0;
4436 /***********************************************************************
4437 Initialization
4438 ***********************************************************************/
4440 void
4441 syms_of_frame ()
4443 Qframep = intern_c_string ("framep");
4444 staticpro (&Qframep);
4445 Qframe_live_p = intern_c_string ("frame-live-p");
4446 staticpro (&Qframe_live_p);
4447 Qexplicit_name = intern_c_string ("explicit-name");
4448 staticpro (&Qexplicit_name);
4449 Qheight = intern_c_string ("height");
4450 staticpro (&Qheight);
4451 Qicon = intern_c_string ("icon");
4452 staticpro (&Qicon);
4453 Qminibuffer = intern_c_string ("minibuffer");
4454 staticpro (&Qminibuffer);
4455 Qmodeline = intern_c_string ("modeline");
4456 staticpro (&Qmodeline);
4457 Qonly = intern_c_string ("only");
4458 staticpro (&Qonly);
4459 Qwidth = intern_c_string ("width");
4460 staticpro (&Qwidth);
4461 Qgeometry = intern_c_string ("geometry");
4462 staticpro (&Qgeometry);
4463 Qicon_left = intern_c_string ("icon-left");
4464 staticpro (&Qicon_left);
4465 Qicon_top = intern_c_string ("icon-top");
4466 staticpro (&Qicon_top);
4467 Qtooltip = intern_c_string ("tooltip");
4468 staticpro (&Qtooltip);
4469 Qleft = intern_c_string ("left");
4470 staticpro (&Qleft);
4471 Qright = intern_c_string ("right");
4472 staticpro (&Qright);
4473 Quser_position = intern_c_string ("user-position");
4474 staticpro (&Quser_position);
4475 Quser_size = intern_c_string ("user-size");
4476 staticpro (&Quser_size);
4477 Qwindow_id = intern_c_string ("window-id");
4478 staticpro (&Qwindow_id);
4479 #ifdef HAVE_X_WINDOWS
4480 Qouter_window_id = intern_c_string ("outer-window-id");
4481 staticpro (&Qouter_window_id);
4482 #endif
4483 Qparent_id = intern_c_string ("parent-id");
4484 staticpro (&Qparent_id);
4485 Qx = intern_c_string ("x");
4486 staticpro (&Qx);
4487 Qw32 = intern_c_string ("w32");
4488 staticpro (&Qw32);
4489 Qpc = intern_c_string ("pc");
4490 staticpro (&Qpc);
4491 Qmac = intern_c_string ("mac");
4492 staticpro (&Qmac);
4493 Qns = intern_c_string ("ns");
4494 staticpro (&Qns);
4495 Qvisible = intern_c_string ("visible");
4496 staticpro (&Qvisible);
4497 Qbuffer_predicate = intern_c_string ("buffer-predicate");
4498 staticpro (&Qbuffer_predicate);
4499 Qbuffer_list = intern_c_string ("buffer-list");
4500 staticpro (&Qbuffer_list);
4501 Qburied_buffer_list = intern_c_string ("buried-buffer-list");
4502 staticpro (&Qburied_buffer_list);
4503 Qdisplay_type = intern_c_string ("display-type");
4504 staticpro (&Qdisplay_type);
4505 Qbackground_mode = intern_c_string ("background-mode");
4506 staticpro (&Qbackground_mode);
4507 Qnoelisp = intern_c_string ("noelisp");
4508 staticpro (&Qnoelisp);
4509 Qtty_color_mode = intern_c_string ("tty-color-mode");
4510 staticpro (&Qtty_color_mode);
4511 Qtty = intern_c_string ("tty");
4512 staticpro (&Qtty);
4513 Qtty_type = intern_c_string ("tty-type");
4514 staticpro (&Qtty_type);
4516 Qface_set_after_frame_default = intern_c_string ("face-set-after-frame-default");
4517 staticpro (&Qface_set_after_frame_default);
4519 Qfullwidth = intern_c_string ("fullwidth");
4520 staticpro (&Qfullwidth);
4521 Qfullheight = intern_c_string ("fullheight");
4522 staticpro (&Qfullheight);
4523 Qfullboth = intern_c_string ("fullboth");
4524 staticpro (&Qfullboth);
4525 Qmaximized = intern_c_string ("maximized");
4526 staticpro (&Qmaximized);
4527 Qx_resource_name = intern_c_string ("x-resource-name");
4528 staticpro (&Qx_resource_name);
4530 Qx_frame_parameter = intern_c_string ("x-frame-parameter");
4531 staticpro (&Qx_frame_parameter);
4533 Qterminal = intern_c_string ("terminal");
4534 staticpro (&Qterminal);
4535 Qterminal_live_p = intern_c_string ("terminal-live-p");
4536 staticpro (&Qterminal_live_p);
4538 #ifdef HAVE_NS
4539 Qns_parse_geometry = intern_c_string ("ns-parse-geometry");
4540 staticpro (&Qns_parse_geometry);
4541 #endif
4544 int i;
4546 for (i = 0; i < sizeof (frame_parms) / sizeof (frame_parms[0]); i++)
4548 Lisp_Object v = intern_c_string (frame_parms[i].name);
4549 if (frame_parms[i].variable)
4551 *frame_parms[i].variable = v;
4552 staticpro (frame_parms[i].variable);
4554 Fput (v, Qx_frame_parameter, make_number (i));
4558 #ifdef HAVE_WINDOW_SYSTEM
4559 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
4560 doc: /* The name Emacs uses to look up X resources.
4561 `x-get-resource' uses this as the first component of the instance name
4562 when requesting resource values.
4563 Emacs initially sets `x-resource-name' to the name under which Emacs
4564 was invoked, or to the value specified with the `-name' or `-rn'
4565 switches, if present.
4567 It may be useful to bind this variable locally around a call
4568 to `x-get-resource'. See also the variable `x-resource-class'. */);
4569 Vx_resource_name = Qnil;
4571 DEFVAR_LISP ("x-resource-class", &Vx_resource_class,
4572 doc: /* The class Emacs uses to look up X resources.
4573 `x-get-resource' uses this as the first component of the instance class
4574 when requesting resource values.
4576 Emacs initially sets `x-resource-class' to "Emacs".
4578 Setting this variable permanently is not a reasonable thing to do,
4579 but binding this variable locally around a call to `x-get-resource'
4580 is a reasonable practice. See also the variable `x-resource-name'. */);
4581 Vx_resource_class = build_string (EMACS_CLASS);
4583 DEFVAR_LISP ("frame-alpha-lower-limit", &Vframe_alpha_lower_limit,
4584 doc: /* The lower limit of the frame opacity (alpha transparency).
4585 The value should range from 0 (invisible) to 100 (completely opaque).
4586 You can also use a floating number between 0.0 and 1.0.
4587 The default is 20. */);
4588 Vframe_alpha_lower_limit = make_number (20);
4589 #endif
4591 DEFVAR_LISP ("default-frame-alist", &Vdefault_frame_alist,
4592 doc: /* Alist of default values for frame creation.
4593 These may be set in your init file, like this:
4594 (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1)))
4595 These override values given in window system configuration data,
4596 including X Windows' defaults database.
4597 For values specific to the first Emacs frame, see `initial-frame-alist'.
4598 For window-system specific values, see `window-system-default-frame-alist'.
4599 For values specific to the separate minibuffer frame, see
4600 `minibuffer-frame-alist'.
4601 The `menu-bar-lines' element of the list controls whether new frames
4602 have menu bars; `menu-bar-mode' works by altering this element.
4603 Setting this variable does not affect existing frames, only new ones. */);
4604 Vdefault_frame_alist = Qnil;
4606 DEFVAR_LISP ("default-frame-scroll-bars", &Vdefault_frame_scroll_bars,
4607 doc: /* Default position of scroll bars on this window-system. */);
4608 #ifdef HAVE_WINDOW_SYSTEM
4609 #if defined(HAVE_NTGUI) || defined(NS_IMPL_COCOA)
4610 /* MS-Windows and Mac OS X have scroll bars on the right by default. */
4611 Vdefault_frame_scroll_bars = Qright;
4612 #else
4613 Vdefault_frame_scroll_bars = Qleft;
4614 #endif
4615 #else
4616 Vdefault_frame_scroll_bars = Qnil;
4617 #endif
4619 DEFVAR_LISP ("terminal-frame", &Vterminal_frame,
4620 doc: /* The initial frame-object, which represents Emacs's stdout. */);
4622 DEFVAR_LISP ("mouse-position-function", &Vmouse_position_function,
4623 doc: /* If non-nil, function to transform normal value of `mouse-position'.
4624 `mouse-position' calls this function, passing its usual return value as
4625 argument, and returns whatever this function returns.
4626 This abnormal hook exists for the benefit of packages like `xt-mouse.el'
4627 which need to do mouse handling at the Lisp level. */);
4628 Vmouse_position_function = Qnil;
4630 DEFVAR_LISP ("mouse-highlight", &Vmouse_highlight,
4631 doc: /* If non-nil, clickable text is highlighted when mouse is over it.
4632 If the value is an integer, highlighting is only shown after moving the
4633 mouse, while keyboard input turns off the highlight even when the mouse
4634 is over the clickable text. However, the mouse shape still indicates
4635 when the mouse is over clickable text. */);
4636 Vmouse_highlight = Qt;
4638 DEFVAR_LISP ("make-pointer-invisible", &Vmake_pointer_invisible,
4639 doc: /* If non-nil, make pointer invisible while typing.
4640 The pointer becomes visible again when the mouse is moved. */);
4641 Vmake_pointer_invisible = Qt;
4643 DEFVAR_LISP ("delete-frame-functions", &Vdelete_frame_functions,
4644 doc: /* Functions to be run before deleting a frame.
4645 The functions are run with one arg, the frame to be deleted.
4646 See `delete-frame'.
4648 Note that functions in this list may be called just before the frame is
4649 actually deleted, or some time later (or even both when an earlier function
4650 in `delete-frame-functions' (indirectly) calls `delete-frame'
4651 recursively). */);
4652 Vdelete_frame_functions = Qnil;
4653 Qdelete_frame_functions = intern_c_string ("delete-frame-functions");
4654 staticpro (&Qdelete_frame_functions);
4656 DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
4657 doc: /* Minibufferless frames use this frame's minibuffer.
4659 Emacs cannot create minibufferless frames unless this is set to an
4660 appropriate surrogate.
4662 Emacs consults this variable only when creating minibufferless
4663 frames; once the frame is created, it sticks with its assigned
4664 minibuffer, no matter what this variable is set to. This means that
4665 this variable doesn't necessarily say anything meaningful about the
4666 current set of frames, or where the minibuffer is currently being
4667 displayed.
4669 This variable is local to the current terminal and cannot be buffer-local. */);
4671 DEFVAR_BOOL ("focus-follows-mouse", &focus_follows_mouse,
4672 doc: /* Non-nil if window system changes focus when you move the mouse.
4673 You should set this variable to tell Emacs how your window manager
4674 handles focus, since there is no way in general for Emacs to find out
4675 automatically. See also `mouse-autoselect-window'. */);
4676 #ifdef HAVE_WINDOW_SYSTEM
4677 #if defined(HAVE_NTGUI) || defined(HAVE_NS)
4678 focus_follows_mouse = 0;
4679 #else
4680 focus_follows_mouse = 1;
4681 #endif
4682 #else
4683 focus_follows_mouse = 0;
4684 #endif
4686 staticpro (&Vframe_list);
4688 defsubr (&Sactive_minibuffer_window);
4689 defsubr (&Sframep);
4690 defsubr (&Sframe_live_p);
4691 defsubr (&Swindow_system);
4692 defsubr (&Smake_terminal_frame);
4693 defsubr (&Shandle_switch_frame);
4694 defsubr (&Sselect_frame);
4695 defsubr (&Sselected_frame);
4696 defsubr (&Swindow_frame);
4697 defsubr (&Sframe_root_window);
4698 defsubr (&Sframe_first_window);
4699 defsubr (&Sframe_selected_window);
4700 defsubr (&Sset_frame_selected_window);
4701 defsubr (&Sframe_list);
4702 defsubr (&Snext_frame);
4703 defsubr (&Sprevious_frame);
4704 defsubr (&Sdelete_frame);
4705 defsubr (&Smouse_position);
4706 defsubr (&Smouse_pixel_position);
4707 defsubr (&Sset_mouse_position);
4708 defsubr (&Sset_mouse_pixel_position);
4709 #if 0
4710 defsubr (&Sframe_configuration);
4711 defsubr (&Srestore_frame_configuration);
4712 #endif
4713 defsubr (&Smake_frame_visible);
4714 defsubr (&Smake_frame_invisible);
4715 defsubr (&Siconify_frame);
4716 defsubr (&Sframe_visible_p);
4717 defsubr (&Svisible_frame_list);
4718 defsubr (&Sraise_frame);
4719 defsubr (&Slower_frame);
4720 defsubr (&Sredirect_frame_focus);
4721 defsubr (&Sframe_focus);
4722 defsubr (&Sframe_parameters);
4723 defsubr (&Sframe_parameter);
4724 defsubr (&Smodify_frame_parameters);
4725 defsubr (&Sframe_char_height);
4726 defsubr (&Sframe_char_width);
4727 defsubr (&Sframe_pixel_height);
4728 defsubr (&Sframe_pixel_width);
4729 defsubr (&Sset_frame_height);
4730 defsubr (&Sset_frame_width);
4731 defsubr (&Sset_frame_size);
4732 defsubr (&Sset_frame_position);
4734 #ifdef HAVE_WINDOW_SYSTEM
4735 defsubr (&Sx_get_resource);
4736 defsubr (&Sx_parse_geometry);
4737 #endif
4741 /* arch-tag: 7dbf2c69-9aad-45f8-8296-db893d6dd039
4742 (do not change this comment) */