Merge from trunk and apply standard C changes.
[emacs.git] / src / frame.c
blob736788fe9f84847e9f26b333b4c3b11abc3d0f56
1 /* Generic frame functions.
2 Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2002, 2003,
3 2004, 2005, 2006, 2007, 2008, 2009, 2010 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 Vmenu_bar_mode, Vtool_bar_mode;
124 Lisp_Object Qleft_fringe, Qright_fringe;
125 Lisp_Object Qbuffer_predicate, Qbuffer_list, Qburied_buffer_list;
126 Lisp_Object Qtty_color_mode;
127 Lisp_Object Qtty, Qtty_type;
129 Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth, Qmaximized;
130 Lisp_Object Qsticky;
131 Lisp_Object Qfont_backend;
132 Lisp_Object Qalpha;
134 Lisp_Object Qface_set_after_frame_default;
136 Lisp_Object Vterminal_frame;
137 Lisp_Object Vdefault_frame_alist;
138 Lisp_Object Vdefault_frame_scroll_bars;
139 Lisp_Object Vmouse_position_function;
140 Lisp_Object Vmouse_highlight;
141 static Lisp_Object Vdelete_frame_functions, Qdelete_frame_functions;
143 int focus_follows_mouse;
145 static void
146 set_menu_bar_lines_1 (Lisp_Object window, int n)
148 struct window *w = XWINDOW (window);
150 XSETFASTINT (w->last_modified, 0);
151 XSETFASTINT (w->top_line, XFASTINT (w->top_line) + n);
152 XSETFASTINT (w->total_lines, XFASTINT (w->total_lines) - n);
154 /* Handle just the top child in a vertical split. */
155 if (!NILP (w->vchild))
156 set_menu_bar_lines_1 (w->vchild, n);
158 /* Adjust all children in a horizontal split. */
159 for (window = w->hchild; !NILP (window); window = w->next)
161 w = XWINDOW (window);
162 set_menu_bar_lines_1 (window, n);
166 void
167 set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
169 int nlines;
170 int olines = FRAME_MENU_BAR_LINES (f);
172 /* Right now, menu bars don't work properly in minibuf-only frames;
173 most of the commands try to apply themselves to the minibuffer
174 frame itself, and get an error because you can't switch buffers
175 in or split the minibuffer window. */
176 if (FRAME_MINIBUF_ONLY_P (f))
177 return;
179 if (INTEGERP (value))
180 nlines = XINT (value);
181 else
182 nlines = 0;
184 if (nlines != olines)
186 windows_or_buffers_changed++;
187 FRAME_WINDOW_SIZES_CHANGED (f) = 1;
188 FRAME_MENU_BAR_LINES (f) = nlines;
189 set_menu_bar_lines_1 (f->root_window, nlines - olines);
190 adjust_glyphs (f);
194 Lisp_Object Vframe_list;
196 extern Lisp_Object Vminibuffer_list;
197 extern Lisp_Object get_minibuffer (int);
198 extern Lisp_Object Fhandle_switch_frame (Lisp_Object event);
199 extern Lisp_Object Fredirect_frame_focus (Lisp_Object frame, Lisp_Object focus_frame);
200 extern Lisp_Object x_get_focus_frame (struct frame *frame);
201 extern Lisp_Object QCname, Qfont_param;
204 DEFUN ("framep", Fframep, Sframep, 1, 1, 0,
205 doc: /* Return non-nil if OBJECT is a frame.
206 Value is t for a termcap frame (a character-only terminal),
207 `x' for an Emacs frame that is really an X window,
208 `w32' for an Emacs frame that is a window on MS-Windows display,
209 `ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
210 `pc' for a direct-write MS-DOS frame.
211 See also `frame-live-p'. */)
212 (Lisp_Object object)
214 if (!FRAMEP (object))
215 return Qnil;
216 switch (XFRAME (object)->output_method)
218 case output_initial: /* The initial frame is like a termcap frame. */
219 case output_termcap:
220 return Qt;
221 case output_x_window:
222 return Qx;
223 case output_w32:
224 return Qw32;
225 case output_msdos_raw:
226 return Qpc;
227 case output_mac:
228 return Qmac;
229 case output_ns:
230 return Qns;
231 default:
232 abort ();
236 DEFUN ("frame-live-p", Fframe_live_p, Sframe_live_p, 1, 1, 0,
237 doc: /* Return non-nil if OBJECT is a frame which has not been deleted.
238 Value is nil if OBJECT is not a live frame. If object is a live
239 frame, the return value indicates what sort of terminal device it is
240 displayed on. See the documentation of `framep' for possible
241 return values. */)
242 (Lisp_Object object)
244 return ((FRAMEP (object)
245 && FRAME_LIVE_P (XFRAME (object)))
246 ? Fframep (object)
247 : Qnil);
250 DEFUN ("window-system", Fwindow_system, Swindow_system, 0, 1, 0,
251 doc: /* The name of the window system that FRAME is displaying through.
252 The value is a symbol---for instance, 'x' for X windows.
253 The value is nil if Emacs is using a text-only terminal.
255 FRAME defaults to the currently selected frame. */)
256 (Lisp_Object frame)
258 Lisp_Object type;
259 if (NILP (frame))
260 frame = selected_frame;
262 type = Fframep (frame);
264 if (NILP (type))
265 wrong_type_argument (Qframep, frame);
267 if (EQ (type, Qt))
268 return Qnil;
269 else
270 return type;
273 struct frame *
274 make_frame (int mini_p)
276 Lisp_Object frame;
277 register struct frame *f;
278 register Lisp_Object root_window;
279 register Lisp_Object mini_window;
281 f = allocate_frame ();
282 XSETFRAME (frame, f);
284 f->desired_matrix = 0;
285 f->current_matrix = 0;
286 f->desired_pool = 0;
287 f->current_pool = 0;
288 f->glyphs_initialized_p = 0;
289 f->decode_mode_spec_buffer = 0;
290 f->visible = 0;
291 f->async_visible = 0;
292 f->output_data.nothing = 0;
293 f->iconified = 0;
294 f->async_iconified = 0;
295 f->wants_modeline = 1;
296 f->auto_raise = 0;
297 f->auto_lower = 0;
298 f->no_split = 0;
299 f->garbaged = 1;
300 f->has_minibuffer = mini_p;
301 f->focus_frame = Qnil;
302 f->explicit_name = 0;
303 f->can_have_scroll_bars = 0;
304 f->vertical_scroll_bar_type = vertical_scroll_bar_none;
305 f->param_alist = Qnil;
306 f->scroll_bars = Qnil;
307 f->condemned_scroll_bars = Qnil;
308 f->face_alist = Qnil;
309 f->face_cache = NULL;
310 f->menu_bar_items = Qnil;
311 f->menu_bar_vector = Qnil;
312 f->menu_bar_items_used = 0;
313 f->buffer_predicate = Qnil;
314 f->buffer_list = Qnil;
315 f->buried_buffer_list = Qnil;
316 f->namebuf = 0;
317 f->title = Qnil;
318 f->menu_bar_window = Qnil;
319 f->tool_bar_window = Qnil;
320 f->tool_bar_items = Qnil;
321 f->desired_tool_bar_string = f->current_tool_bar_string = Qnil;
322 f->n_tool_bar_items = 0;
323 f->left_fringe_width = f->right_fringe_width = 0;
324 f->fringe_cols = 0;
325 f->menu_bar_lines = 0;
326 f->tool_bar_lines = 0;
327 f->scroll_bar_actual_width = 0;
328 f->border_width = 0;
329 f->internal_border_width = 0;
330 f->column_width = 1; /* !FRAME_WINDOW_P value */
331 f->line_height = 1; /* !FRAME_WINDOW_P value */
332 f->x_pixels_diff = f->y_pixels_diff = 0;
333 #ifdef HAVE_WINDOW_SYSTEM
334 f->want_fullscreen = FULLSCREEN_NONE;
335 #endif
336 f->size_hint_flags = 0;
337 f->win_gravity = 0;
338 f->font_driver_list = NULL;
339 f->font_data_list = NULL;
341 root_window = make_window ();
342 if (mini_p)
344 mini_window = make_window ();
345 XWINDOW (root_window)->next = mini_window;
346 XWINDOW (mini_window)->prev = root_window;
347 XWINDOW (mini_window)->mini_p = Qt;
348 XWINDOW (mini_window)->frame = frame;
349 f->minibuffer_window = mini_window;
351 else
353 mini_window = Qnil;
354 XWINDOW (root_window)->next = Qnil;
355 f->minibuffer_window = Qnil;
358 XWINDOW (root_window)->frame = frame;
360 /* 10 is arbitrary,
361 just so that there is "something there."
362 Correct size will be set up later with change_frame_size. */
364 SET_FRAME_COLS (f, 10);
365 FRAME_LINES (f) = 10;
367 XSETFASTINT (XWINDOW (root_window)->total_cols, 10);
368 XSETFASTINT (XWINDOW (root_window)->total_lines, (mini_p ? 9 : 10));
370 if (mini_p)
372 XSETFASTINT (XWINDOW (mini_window)->total_cols, 10);
373 XSETFASTINT (XWINDOW (mini_window)->top_line, 9);
374 XSETFASTINT (XWINDOW (mini_window)->total_lines, 1);
377 /* Choose a buffer for the frame's root window. */
379 Lisp_Object buf;
381 XWINDOW (root_window)->buffer = Qt;
382 buf = Fcurrent_buffer ();
383 /* If buf is a 'hidden' buffer (i.e. one whose name starts with
384 a space), try to find another one. */
385 if (SREF (Fbuffer_name (buf), 0) == ' ')
386 buf = Fother_buffer (buf, Qnil, Qnil);
388 /* Use set_window_buffer, not Fset_window_buffer, and don't let
389 hooks be run by it. The reason is that the whole frame/window
390 arrangement is not yet fully intialized at this point. Windows
391 don't have the right size, glyph matrices aren't initialized
392 etc. Running Lisp functions at this point surely ends in a
393 SEGV. */
394 set_window_buffer (root_window, buf, 0, 0);
395 f->buffer_list = Fcons (buf, Qnil);
398 if (mini_p)
400 XWINDOW (mini_window)->buffer = Qt;
401 set_window_buffer (mini_window,
402 (NILP (Vminibuffer_list)
403 ? get_minibuffer (0)
404 : Fcar (Vminibuffer_list)),
405 0, 0);
408 f->root_window = root_window;
409 f->selected_window = root_window;
410 /* Make sure this window seems more recently used than
411 a newly-created, never-selected window. */
412 ++window_select_count;
413 XSETFASTINT (XWINDOW (f->selected_window)->use_time, window_select_count);
415 f->default_face_done_p = 0;
417 return f;
420 #ifdef HAVE_WINDOW_SYSTEM
421 /* Make a frame using a separate minibuffer window on another frame.
422 MINI_WINDOW is the minibuffer window to use. nil means use the
423 default (the global minibuffer). */
425 struct frame *
426 make_frame_without_minibuffer (register Lisp_Object mini_window, KBOARD *kb, Lisp_Object display)
428 register struct frame *f;
429 struct gcpro gcpro1;
431 if (!NILP (mini_window))
432 CHECK_LIVE_WINDOW (mini_window);
434 if (!NILP (mini_window)
435 && FRAME_KBOARD (XFRAME (XWINDOW (mini_window)->frame)) != kb)
436 error ("Frame and minibuffer must be on the same terminal");
438 /* Make a frame containing just a root window. */
439 f = make_frame (0);
441 if (NILP (mini_window))
443 /* Use default-minibuffer-frame if possible. */
444 if (!FRAMEP (kb->Vdefault_minibuffer_frame)
445 || ! FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame)))
447 Lisp_Object frame_dummy;
449 XSETFRAME (frame_dummy, f);
450 GCPRO1 (frame_dummy);
451 /* If there's no minibuffer frame to use, create one. */
452 kb->Vdefault_minibuffer_frame =
453 call1 (intern ("make-initial-minibuffer-frame"), display);
454 UNGCPRO;
457 mini_window = XFRAME (kb->Vdefault_minibuffer_frame)->minibuffer_window;
460 f->minibuffer_window = mini_window;
462 /* Make the chosen minibuffer window display the proper minibuffer,
463 unless it is already showing a minibuffer. */
464 if (NILP (Fmemq (XWINDOW (mini_window)->buffer, Vminibuffer_list)))
465 Fset_window_buffer (mini_window,
466 (NILP (Vminibuffer_list)
467 ? get_minibuffer (0)
468 : Fcar (Vminibuffer_list)), Qnil);
469 return f;
472 /* Make a frame containing only a minibuffer window. */
474 struct frame *
475 make_minibuffer_frame (void)
477 /* First make a frame containing just a root window, no minibuffer. */
479 register struct frame *f = make_frame (0);
480 register Lisp_Object mini_window;
481 register Lisp_Object frame;
483 XSETFRAME (frame, f);
485 f->auto_raise = 0;
486 f->auto_lower = 0;
487 f->no_split = 1;
488 f->wants_modeline = 0;
489 f->has_minibuffer = 1;
491 /* Now label the root window as also being the minibuffer.
492 Avoid infinite looping on the window chain by marking next pointer
493 as nil. */
495 mini_window = f->minibuffer_window = f->root_window;
496 XWINDOW (mini_window)->mini_p = Qt;
497 XWINDOW (mini_window)->next = Qnil;
498 XWINDOW (mini_window)->prev = Qnil;
499 XWINDOW (mini_window)->frame = frame;
501 /* Put the proper buffer in that window. */
503 Fset_window_buffer (mini_window,
504 (NILP (Vminibuffer_list)
505 ? get_minibuffer (0)
506 : Fcar (Vminibuffer_list)), Qnil);
507 return f;
509 #endif /* HAVE_WINDOW_SYSTEM */
511 /* Construct a frame that refers to a terminal. */
513 static int tty_frame_count;
515 struct frame *
516 make_initial_frame (void)
518 struct frame *f;
519 struct terminal *terminal;
520 Lisp_Object frame;
522 eassert (initial_kboard);
524 /* The first call must initialize Vframe_list. */
525 if (! (NILP (Vframe_list) || CONSP (Vframe_list)))
526 Vframe_list = Qnil;
528 terminal = init_initial_terminal ();
530 f = make_frame (1);
531 XSETFRAME (frame, f);
533 Vframe_list = Fcons (frame, Vframe_list);
535 tty_frame_count = 1;
536 f->name = make_pure_c_string ("F1");
538 f->visible = 1;
539 f->async_visible = 1;
541 f->output_method = terminal->type;
542 f->terminal = terminal;
543 f->terminal->reference_count++;
544 f->output_data.nothing = 0;
546 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
547 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
549 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
550 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
552 /* The default value of menu-bar-mode is t. */
553 set_menu_bar_lines (f, make_number (1), Qnil);
555 #ifdef CANNOT_DUMP
556 if (!noninteractive)
557 init_frame_faces (f);
558 #endif
560 return f;
564 struct frame *
565 make_terminal_frame (struct terminal *terminal)
567 register struct frame *f;
568 Lisp_Object frame;
569 char name[20];
571 if (!terminal->name)
572 error ("Terminal is not live, can't create new frames on it");
574 f = make_frame (1);
576 XSETFRAME (frame, f);
577 Vframe_list = Fcons (frame, Vframe_list);
579 tty_frame_count++;
580 sprintf (name, "F%d", tty_frame_count);
581 f->name = build_string (name);
583 f->visible = 1; /* FRAME_SET_VISIBLE wd set frame_garbaged. */
584 f->async_visible = 1; /* Don't let visible be cleared later. */
585 f->terminal = terminal;
586 f->terminal->reference_count++;
587 #ifdef MSDOS
588 f->output_data.tty->display_info = &the_only_display_info;
589 if (!inhibit_window_system
590 && (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame))
591 || XFRAME (selected_frame)->output_method == output_msdos_raw))
592 f->output_method = output_msdos_raw;
593 else
594 f->output_method = output_termcap;
595 #else /* not MSDOS */
596 f->output_method = output_termcap;
597 create_tty_output (f);
598 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
599 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
600 #endif /* not MSDOS */
602 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
603 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
604 FRAME_MENU_BAR_LINES(f) = NILP (Vmenu_bar_mode) ? 0 : 1;
606 /* Set the top frame to the newly created frame. */
607 if (FRAMEP (FRAME_TTY (f)->top_frame)
608 && FRAME_LIVE_P (XFRAME (FRAME_TTY (f)->top_frame)))
609 XFRAME (FRAME_TTY (f)->top_frame)->async_visible = 2; /* obscured */
611 FRAME_TTY (f)->top_frame = frame;
613 if (!noninteractive)
614 init_frame_faces (f);
616 return f;
619 /* Get a suitable value for frame parameter PARAMETER for a newly
620 created frame, based on (1) the user-supplied frame parameter
621 alist SUPPLIED_PARMS, and (2) CURRENT_VALUE. */
623 static Lisp_Object
624 get_future_frame_param (Lisp_Object parameter,
625 Lisp_Object supplied_parms,
626 char *current_value)
628 Lisp_Object result;
630 result = Fassq (parameter, supplied_parms);
631 if (NILP (result))
632 result = Fassq (parameter, XFRAME (selected_frame)->param_alist);
633 if (NILP (result) && current_value != NULL)
634 result = build_string (current_value);
635 if (!NILP (result) && !STRINGP (result))
636 result = XCDR (result);
637 if (NILP (result) || !STRINGP (result))
638 result = Qnil;
640 return result;
643 DEFUN ("make-terminal-frame", Fmake_terminal_frame, Smake_terminal_frame,
644 1, 1, 0,
645 doc: /* Create an additional terminal frame, possibly on another terminal.
646 This function takes one argument, an alist specifying frame parameters.
648 You can create multiple frames on a single text-only terminal, but
649 only one of them (the selected terminal frame) is actually displayed.
651 In practice, generally you don't need to specify any parameters,
652 except when you want to create a new frame on another terminal.
653 In that case, the `tty' parameter specifies the device file to open,
654 and the `tty-type' parameter specifies the terminal type. Example:
656 (make-terminal-frame '((tty . "/dev/pts/5") (tty-type . "xterm")))
658 Note that changing the size of one terminal frame automatically
659 affects all frames on the same terminal device. */)
660 (Lisp_Object parms)
662 struct frame *f;
663 struct terminal *t = NULL;
664 Lisp_Object frame, tem;
665 struct frame *sf = SELECTED_FRAME ();
667 #ifdef MSDOS
668 if (sf->output_method != output_msdos_raw
669 && sf->output_method != output_termcap)
670 abort ();
671 #else /* not MSDOS */
673 #ifdef WINDOWSNT /* This should work now! */
674 if (sf->output_method != output_termcap)
675 error ("Not using an ASCII terminal now; cannot make a new ASCII frame");
676 #endif
677 #endif /* not MSDOS */
680 Lisp_Object terminal;
682 terminal = Fassq (Qterminal, parms);
683 if (!NILP (terminal))
685 terminal = XCDR (terminal);
686 t = get_terminal (terminal, 1);
688 #ifdef MSDOS
689 if (t && t != the_only_display_info.terminal)
690 /* msdos.c assumes a single tty_display_info object. */
691 error ("Multiple terminals are not supported on this platform");
692 if (!t)
693 t = the_only_display_info.terminal;
694 #endif
697 if (!t)
699 char *name = 0, *type = 0;
700 Lisp_Object tty, tty_type;
702 tty = get_future_frame_param
703 (Qtty, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
704 ? FRAME_TTY (XFRAME (selected_frame))->name
705 : NULL));
706 if (!NILP (tty))
708 name = (char *) alloca (SBYTES (tty) + 1);
709 strncpy (name, SDATA (tty), SBYTES (tty));
710 name[SBYTES (tty)] = 0;
713 tty_type = get_future_frame_param
714 (Qtty_type, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
715 ? FRAME_TTY (XFRAME (selected_frame))->type
716 : NULL));
717 if (!NILP (tty_type))
719 type = (char *) alloca (SBYTES (tty_type) + 1);
720 strncpy (type, SDATA (tty_type), SBYTES (tty_type));
721 type[SBYTES (tty_type)] = 0;
724 t = init_tty (name, type, 0); /* Errors are not fatal. */
727 f = make_terminal_frame (t);
730 int width, height;
731 get_tty_size (fileno (FRAME_TTY (f)->input), &width, &height);
732 change_frame_size (f, height, width, 0, 0, 0);
735 adjust_glyphs (f);
736 calculate_costs (f);
737 XSETFRAME (frame, f);
738 Fmodify_frame_parameters (frame, parms);
739 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty_type,
740 build_string (t->display_info.tty->type)),
741 Qnil));
742 if (t->display_info.tty->name != NULL)
743 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty,
744 build_string (t->display_info.tty->name)),
745 Qnil));
746 else
747 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty, Qnil), Qnil));
749 /* Make the frame face alist be frame-specific, so that each
750 frame could change its face definitions independently. */
751 f->face_alist = Fcopy_alist (sf->face_alist);
752 /* Simple Fcopy_alist isn't enough, because we need the contents of
753 the vectors which are the CDRs of associations in face_alist to
754 be copied as well. */
755 for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem))
756 XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem))));
757 return frame;
761 /* Perform the switch to frame FRAME.
763 If FRAME is a switch-frame event `(switch-frame FRAME1)', use
764 FRAME1 as frame.
766 If TRACK is non-zero and the frame that currently has the focus
767 redirects its focus to the selected frame, redirect that focused
768 frame's focus to FRAME instead.
770 FOR_DELETION non-zero means that the selected frame is being
771 deleted, which includes the possibility that the frame's terminal
772 is dead.
774 The value of NORECORD is passed as argument to Fselect_window. */
776 Lisp_Object
777 do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object norecord)
779 struct frame *sf = SELECTED_FRAME ();
781 /* If FRAME is a switch-frame event, extract the frame we should
782 switch to. */
783 if (CONSP (frame)
784 && EQ (XCAR (frame), Qswitch_frame)
785 && CONSP (XCDR (frame)))
786 frame = XCAR (XCDR (frame));
788 /* This used to say CHECK_LIVE_FRAME, but apparently it's possible for
789 a switch-frame event to arrive after a frame is no longer live,
790 especially when deleting the initial frame during startup. */
791 CHECK_FRAME (frame);
792 if (! FRAME_LIVE_P (XFRAME (frame)))
793 return Qnil;
795 if (sf == XFRAME (frame))
796 return frame;
798 /* This is too greedy; it causes inappropriate focus redirection
799 that's hard to get rid of. */
800 #if 0
801 /* If a frame's focus has been redirected toward the currently
802 selected frame, we should change the redirection to point to the
803 newly selected frame. This means that if the focus is redirected
804 from a minibufferless frame to a surrogate minibuffer frame, we
805 can use `other-window' to switch between all the frames using
806 that minibuffer frame, and the focus redirection will follow us
807 around. */
808 if (track)
810 Lisp_Object tail;
812 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
814 Lisp_Object focus;
816 if (!FRAMEP (XCAR (tail)))
817 abort ();
819 focus = FRAME_FOCUS_FRAME (XFRAME (XCAR (tail)));
821 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
822 Fredirect_frame_focus (XCAR (tail), frame);
825 #else /* ! 0 */
826 /* Instead, apply it only to the frame we're pointing to. */
827 #ifdef HAVE_WINDOW_SYSTEM
828 if (track && FRAME_WINDOW_P (XFRAME (frame)))
830 Lisp_Object focus, xfocus;
832 xfocus = x_get_focus_frame (XFRAME (frame));
833 if (FRAMEP (xfocus))
835 focus = FRAME_FOCUS_FRAME (XFRAME (xfocus));
836 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
837 Fredirect_frame_focus (xfocus, frame);
840 #endif /* HAVE_X_WINDOWS */
841 #endif /* ! 0 */
843 if (!for_deletion && FRAME_HAS_MINIBUF_P (sf))
844 resize_mini_window (XWINDOW (FRAME_MINIBUF_WINDOW (sf)), 1);
846 if (FRAME_TERMCAP_P (XFRAME (frame)) || FRAME_MSDOS_P (XFRAME (frame)))
848 if (FRAMEP (FRAME_TTY (XFRAME (frame))->top_frame))
849 /* Mark previously displayed frame as now obscured. */
850 XFRAME (FRAME_TTY (XFRAME (frame))->top_frame)->async_visible = 2;
851 XFRAME (frame)->async_visible = 1;
852 FRAME_TTY (XFRAME (frame))->top_frame = frame;
855 selected_frame = frame;
856 if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
857 last_nonminibuf_frame = XFRAME (selected_frame);
859 Fselect_window (XFRAME (frame)->selected_window, norecord);
861 /* We want to make sure that the next event generates a frame-switch
862 event to the appropriate frame. This seems kludgy to me, but
863 before you take it out, make sure that evaluating something like
864 (select-window (frame-root-window (new-frame))) doesn't end up
865 with your typing being interpreted in the new frame instead of
866 the one you're actually typing in. */
867 internal_last_event_frame = Qnil;
869 return frame;
872 DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 2, "e",
873 doc: /* Select FRAME.
874 Subsequent editing commands apply to its selected window.
875 Optional argument NORECORD means to neither change the order of
876 recently selected windows nor the buffer list.
878 The selection of FRAME lasts until the next time the user does
879 something to select a different frame, or until the next time
880 this function is called. If you are using a window system, the
881 previously selected frame may be restored as the selected frame
882 when returning to the command loop, because it still may have
883 the window system's input focus. On a text-only terminal, the
884 next redisplay will display FRAME.
886 This function returns FRAME, or nil if FRAME has been deleted. */)
887 (Lisp_Object frame, Lisp_Object norecord)
889 return do_switch_frame (frame, 1, 0, norecord);
893 DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 1, "e",
894 doc: /* Handle a switch-frame event EVENT.
895 Switch-frame events are usually bound to this function.
896 A switch-frame event tells Emacs that the window manager has requested
897 that the user's events be directed to the frame mentioned in the event.
898 This function selects the selected window of the frame of EVENT.
900 If EVENT is frame object, handle it as if it were a switch-frame event
901 to that frame. */)
902 (Lisp_Object event)
904 /* Preserve prefix arg that the command loop just cleared. */
905 current_kboard->Vprefix_arg = Vcurrent_prefix_arg;
906 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
907 return do_switch_frame (event, 0, 0, Qnil);
910 DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0,
911 doc: /* Return the frame that is now selected. */)
912 (void)
914 return selected_frame;
917 DEFUN ("frame-list", Fframe_list, Sframe_list,
918 0, 0, 0,
919 doc: /* Return a list of all live frames. */)
920 (void)
922 Lisp_Object frames;
923 frames = Fcopy_sequence (Vframe_list);
924 #ifdef HAVE_WINDOW_SYSTEM
925 if (FRAMEP (tip_frame))
926 frames = Fdelq (tip_frame, frames);
927 #endif
928 return frames;
931 /* Return the next frame in the frame list after FRAME.
932 If MINIBUF is nil, exclude minibuffer-only frames.
933 If MINIBUF is a window, include only its own frame
934 and any frame now using that window as the minibuffer.
935 If MINIBUF is `visible', include all visible frames.
936 If MINIBUF is 0, include all visible and iconified frames.
937 Otherwise, include all frames. */
939 static Lisp_Object
940 next_frame (Lisp_Object frame, Lisp_Object minibuf)
942 Lisp_Object tail;
943 int passed = 0;
945 /* There must always be at least one frame in Vframe_list. */
946 if (! CONSP (Vframe_list))
947 abort ();
949 /* If this frame is dead, it won't be in Vframe_list, and we'll loop
950 forever. Forestall that. */
951 CHECK_LIVE_FRAME (frame);
953 while (1)
954 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
956 Lisp_Object f;
958 f = XCAR (tail);
960 if (passed
961 && ((!FRAME_TERMCAP_P (XFRAME (f)) && !FRAME_TERMCAP_P (XFRAME (frame))
962 && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
963 || (FRAME_TERMCAP_P (XFRAME (f)) && FRAME_TERMCAP_P (XFRAME (frame))
964 && FRAME_TTY (XFRAME (f)) == FRAME_TTY (XFRAME (frame)))))
966 /* Decide whether this frame is eligible to be returned. */
968 /* If we've looped all the way around without finding any
969 eligible frames, return the original frame. */
970 if (EQ (f, frame))
971 return f;
973 /* Let minibuf decide if this frame is acceptable. */
974 if (NILP (minibuf))
976 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
977 return f;
979 else if (EQ (minibuf, Qvisible))
981 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
982 if (FRAME_VISIBLE_P (XFRAME (f)))
983 return f;
985 else if (INTEGERP (minibuf) && XINT (minibuf) == 0)
987 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
988 if (FRAME_VISIBLE_P (XFRAME (f))
989 || FRAME_ICONIFIED_P (XFRAME (f)))
990 return f;
992 else if (WINDOWP (minibuf))
994 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
995 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
996 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
997 FRAME_FOCUS_FRAME (XFRAME (f))))
998 return f;
1000 else
1001 return f;
1004 if (EQ (frame, f))
1005 passed++;
1009 /* Return the previous frame in the frame list before FRAME.
1010 If MINIBUF is nil, exclude minibuffer-only frames.
1011 If MINIBUF is a window, include only its own frame
1012 and any frame now using that window as the minibuffer.
1013 If MINIBUF is `visible', include all visible frames.
1014 If MINIBUF is 0, include all visible and iconified frames.
1015 Otherwise, include all frames. */
1017 static Lisp_Object
1018 prev_frame (Lisp_Object frame, Lisp_Object minibuf)
1020 Lisp_Object tail;
1021 Lisp_Object prev;
1023 /* There must always be at least one frame in Vframe_list. */
1024 if (! CONSP (Vframe_list))
1025 abort ();
1027 prev = Qnil;
1028 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1030 Lisp_Object f;
1032 f = XCAR (tail);
1033 if (!FRAMEP (f))
1034 abort ();
1036 if (EQ (frame, f) && !NILP (prev))
1037 return prev;
1039 if ((!FRAME_TERMCAP_P (XFRAME (f)) && !FRAME_TERMCAP_P (XFRAME (frame))
1040 && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
1041 || (FRAME_TERMCAP_P (XFRAME (f)) && FRAME_TERMCAP_P (XFRAME (frame))
1042 && FRAME_TTY (XFRAME (f)) == FRAME_TTY (XFRAME (frame))))
1044 /* Decide whether this frame is eligible to be returned,
1045 according to minibuf. */
1046 if (NILP (minibuf))
1048 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
1049 prev = f;
1051 else if (WINDOWP (minibuf))
1053 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
1054 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
1055 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
1056 FRAME_FOCUS_FRAME (XFRAME (f))))
1057 prev = f;
1059 else if (EQ (minibuf, Qvisible))
1061 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1062 if (FRAME_VISIBLE_P (XFRAME (f)))
1063 prev = f;
1065 else if (XFASTINT (minibuf) == 0)
1067 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1068 if (FRAME_VISIBLE_P (XFRAME (f))
1069 || FRAME_ICONIFIED_P (XFRAME (f)))
1070 prev = f;
1072 else
1073 prev = f;
1077 /* We've scanned the entire list. */
1078 if (NILP (prev))
1079 /* We went through the whole frame list without finding a single
1080 acceptable frame. Return the original frame. */
1081 return frame;
1082 else
1083 /* There were no acceptable frames in the list before FRAME; otherwise,
1084 we would have returned directly from the loop. Since PREV is the last
1085 acceptable frame in the list, return it. */
1086 return prev;
1090 DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0,
1091 doc: /* Return the next frame in the frame list after FRAME.
1092 It considers only frames on the same terminal as FRAME.
1093 By default, skip minibuffer-only frames.
1094 If omitted, FRAME defaults to the selected frame.
1095 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1096 If MINIFRAME is a window, include only its own frame
1097 and any frame now using that window as the minibuffer.
1098 If MINIFRAME is `visible', include all visible frames.
1099 If MINIFRAME is 0, include all visible and iconified frames.
1100 Otherwise, include all frames. */)
1101 (Lisp_Object frame, Lisp_Object miniframe)
1103 if (NILP (frame))
1104 frame = selected_frame;
1106 CHECK_LIVE_FRAME (frame);
1107 return next_frame (frame, miniframe);
1110 DEFUN ("previous-frame", Fprevious_frame, Sprevious_frame, 0, 2, 0,
1111 doc: /* Return the previous frame in the frame list before FRAME.
1112 It considers only frames on the same terminal as FRAME.
1113 By default, skip minibuffer-only frames.
1114 If omitted, FRAME defaults to the selected frame.
1115 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1116 If MINIFRAME is a window, include only its own frame
1117 and any frame now using that window as the minibuffer.
1118 If MINIFRAME is `visible', include all visible frames.
1119 If MINIFRAME is 0, include all visible and iconified frames.
1120 Otherwise, include all frames. */)
1121 (Lisp_Object frame, Lisp_Object miniframe)
1123 if (NILP (frame))
1124 frame = selected_frame;
1125 CHECK_LIVE_FRAME (frame);
1126 return prev_frame (frame, miniframe);
1129 /* Return 1 if it is ok to delete frame F;
1130 0 if all frames aside from F are invisible.
1131 (Exception: if F is the terminal frame, and we are using X, return 1.) */
1134 other_visible_frames (FRAME_PTR f)
1136 /* We know the selected frame is visible,
1137 so if F is some other frame, it can't be the sole visible one. */
1138 if (f == SELECTED_FRAME ())
1140 Lisp_Object frames;
1141 int count = 0;
1143 for (frames = Vframe_list;
1144 CONSP (frames);
1145 frames = XCDR (frames))
1147 Lisp_Object this;
1149 this = XCAR (frames);
1150 /* Verify that the frame's window still exists
1151 and we can still talk to it. And note any recent change
1152 in visibility. */
1153 #ifdef HAVE_WINDOW_SYSTEM
1154 if (FRAME_WINDOW_P (XFRAME (this)))
1156 x_sync (XFRAME (this));
1157 FRAME_SAMPLE_VISIBILITY (XFRAME (this));
1159 #endif
1161 if (FRAME_VISIBLE_P (XFRAME (this))
1162 || FRAME_ICONIFIED_P (XFRAME (this))
1163 /* Allow deleting the terminal frame when at least
1164 one X frame exists! */
1165 || (FRAME_WINDOW_P (XFRAME (this)) && !FRAME_WINDOW_P (f)))
1166 count++;
1168 return count > 1;
1170 return 1;
1173 DEFUN ("other-visible-frames-p", Fother_visible_frames_p, Sother_visible_frames_p, 0, 1, 0,
1174 doc: /* Return t if there are other visible frames beside FRAME.
1175 FRAME defaults to the selected frame. */)
1176 (Lisp_Object frame)
1178 if (NILP (frame))
1179 frame = selected_frame;
1180 CHECK_LIVE_FRAME (frame);
1181 return other_visible_frames (XFRAME (frame)) ? Qt : Qnil;
1184 /* Error handler for `delete-frame-functions'. */
1185 static Lisp_Object
1186 delete_frame_handler (Lisp_Object arg)
1188 add_to_log ("Error during `delete-frame': %s", arg, Qnil);
1189 return Qnil;
1192 extern Lisp_Object Qrun_hook_with_args;
1194 /* Delete FRAME. When FORCE equals Qnoelisp, delete FRAME
1195 unconditionally. x_connection_closed and delete_terminal use
1196 this. Any other value of FORCE implements the semantics
1197 described for Fdelete_frame. */
1198 Lisp_Object
1199 delete_frame (Lisp_Object frame, Lisp_Object force)
1200 /* If we use `register' here, gcc-4.0.2 on amd64 using
1201 -DUSE_LISP_UNION_TYPE complains further down that we're getting the
1202 address of `force'. Go figure. */
1205 struct frame *f;
1206 struct frame *sf = SELECTED_FRAME ();
1207 struct kboard *kb;
1209 int minibuffer_selected, tooltip_frame;
1211 if (EQ (frame, Qnil))
1213 f = sf;
1214 XSETFRAME (frame, f);
1216 else
1218 CHECK_FRAME (frame);
1219 f = XFRAME (frame);
1222 if (! FRAME_LIVE_P (f))
1223 return Qnil;
1225 if (NILP (force) && !other_visible_frames (f))
1226 error ("Attempt to delete the sole visible or iconified frame");
1228 /* x_connection_closed must have set FORCE to `noelisp' in order
1229 to delete the last frame, if it is gone. */
1230 if (NILP (XCDR (Vframe_list)) && !EQ (force, Qnoelisp))
1231 error ("Attempt to delete the only frame");
1233 /* Does this frame have a minibuffer, and is it the surrogate
1234 minibuffer for any other frame? */
1235 if (FRAME_HAS_MINIBUF_P (XFRAME (frame)))
1237 Lisp_Object frames;
1239 for (frames = Vframe_list;
1240 CONSP (frames);
1241 frames = XCDR (frames))
1243 Lisp_Object this;
1244 this = XCAR (frames);
1246 if (! EQ (this, frame)
1247 && EQ (frame,
1248 WINDOW_FRAME (XWINDOW
1249 (FRAME_MINIBUF_WINDOW (XFRAME (this))))))
1251 /* If we MUST delete this frame, delete the other first.
1252 But do this only if FORCE equals `noelisp'. */
1253 if (EQ (force, Qnoelisp))
1254 delete_frame (this, Qnoelisp);
1255 else
1256 error ("Attempt to delete a surrogate minibuffer frame");
1261 tooltip_frame = !NILP (Fframe_parameter (frame, intern ("tooltip")));
1263 /* Run `delete-frame-functions' unless FORCE is `noelisp' or
1264 frame is a tooltip. FORCE is set to `noelisp' when handling
1265 a disconnect from the terminal, so we don't dare call Lisp
1266 code. */
1267 if (NILP (Vrun_hooks) || tooltip_frame)
1269 else if (EQ (force, Qnoelisp))
1270 pending_funcalls
1271 = Fcons (list3 (Qrun_hook_with_args, Qdelete_frame_functions, frame),
1272 pending_funcalls);
1273 else
1274 safe_call2 (Qrun_hook_with_args, Qdelete_frame_functions, frame);
1276 /* The hook may sometimes (indirectly) cause the frame to be deleted. */
1277 if (! FRAME_LIVE_P (f))
1278 return Qnil;
1280 /* At this point, we are committed to deleting the frame.
1281 There is no more chance for errors to prevent it. */
1283 minibuffer_selected = EQ (minibuf_window, selected_window);
1285 /* Don't let the frame remain selected. */
1286 if (f == sf)
1288 Lisp_Object tail, frame1;
1290 /* Look for another visible frame on the same terminal. */
1291 frame1 = next_frame (frame, Qvisible);
1293 /* If there is none, find *some* other frame. */
1294 if (NILP (frame1) || EQ (frame1, frame))
1296 FOR_EACH_FRAME (tail, frame1)
1298 if (! EQ (frame, frame1) && FRAME_LIVE_P (XFRAME (frame1)))
1299 break;
1302 #ifdef NS_IMPL_COCOA
1303 else
1304 /* Under NS, there is no system mechanism for choosing a new
1305 window to get focus -- it is left to application code.
1306 So the portion of THIS application interfacing with NS
1307 needs to know about it. We call Fraise_frame, but the
1308 purpose is really to transfer focus. */
1309 Fraise_frame (frame1);
1310 #endif
1312 do_switch_frame (frame1, 0, 1, Qnil);
1313 sf = SELECTED_FRAME ();
1316 /* Don't allow minibuf_window to remain on a deleted frame. */
1317 if (EQ (f->minibuffer_window, minibuf_window))
1319 Fset_window_buffer (sf->minibuffer_window,
1320 XWINDOW (minibuf_window)->buffer, Qnil);
1321 minibuf_window = sf->minibuffer_window;
1323 /* If the dying minibuffer window was selected,
1324 select the new one. */
1325 if (minibuffer_selected)
1326 Fselect_window (minibuf_window, Qnil);
1329 /* Don't let echo_area_window to remain on a deleted frame. */
1330 if (EQ (f->minibuffer_window, echo_area_window))
1331 echo_area_window = sf->minibuffer_window;
1333 /* Clear any X selections for this frame. */
1334 #ifdef HAVE_X_WINDOWS
1335 if (FRAME_X_P (f))
1336 x_clear_frame_selections (f);
1337 #endif
1339 /* Free glyphs.
1340 This function must be called before the window tree of the
1341 frame is deleted because windows contain dynamically allocated
1342 memory. */
1343 free_glyphs (f);
1345 #ifdef HAVE_WINDOW_SYSTEM
1346 /* Give chance to each font driver to free a frame specific data. */
1347 font_update_drivers (f, Qnil);
1348 #endif
1350 /* Mark all the windows that used to be on FRAME as deleted, and then
1351 remove the reference to them. */
1352 delete_all_subwindows (f->root_window);
1353 f->root_window = Qnil;
1355 Vframe_list = Fdelq (frame, Vframe_list);
1356 FRAME_SET_VISIBLE (f, 0);
1358 /* Allow the vector of menu bar contents to be freed in the next
1359 garbage collection. The frame object itself may not be garbage
1360 collected until much later, because recent_keys and other data
1361 structures can still refer to it. */
1362 f->menu_bar_vector = Qnil;
1364 free_font_driver_list (f);
1365 xfree (f->namebuf);
1366 xfree (f->decode_mode_spec_buffer);
1367 xfree (FRAME_INSERT_COST (f));
1368 xfree (FRAME_DELETEN_COST (f));
1369 xfree (FRAME_INSERTN_COST (f));
1370 xfree (FRAME_DELETE_COST (f));
1371 xfree (FRAME_MESSAGE_BUF (f));
1373 /* Since some events are handled at the interrupt level, we may get
1374 an event for f at any time; if we zero out the frame's terminal
1375 now, then we may trip up the event-handling code. Instead, we'll
1376 promise that the terminal of the frame must be valid until we
1377 have called the window-system-dependent frame destruction
1378 routine. */
1380 if (FRAME_TERMINAL (f)->delete_frame_hook)
1381 (*FRAME_TERMINAL (f)->delete_frame_hook) (f);
1384 struct terminal *terminal = FRAME_TERMINAL (f);
1385 f->output_data.nothing = 0;
1386 f->terminal = 0; /* Now the frame is dead. */
1388 /* If needed, delete the terminal that this frame was on.
1389 (This must be done after the frame is killed.) */
1390 terminal->reference_count--;
1391 if (terminal->reference_count == 0)
1393 Lisp_Object tmp;
1394 XSETTERMINAL (tmp, terminal);
1396 kb = NULL;
1397 Fdelete_terminal (tmp, NILP (force) ? Qt : force);
1399 else
1400 kb = terminal->kboard;
1403 /* If we've deleted the last_nonminibuf_frame, then try to find
1404 another one. */
1405 if (f == last_nonminibuf_frame)
1407 Lisp_Object frames;
1409 last_nonminibuf_frame = 0;
1411 for (frames = Vframe_list;
1412 CONSP (frames);
1413 frames = XCDR (frames))
1415 f = XFRAME (XCAR (frames));
1416 if (!FRAME_MINIBUF_ONLY_P (f))
1418 last_nonminibuf_frame = f;
1419 break;
1424 /* If there's no other frame on the same kboard, get out of
1425 single-kboard state if we're in it for this kboard. */
1426 if (kb != NULL)
1428 Lisp_Object frames;
1429 /* Some frame we found on the same kboard, or nil if there are none. */
1430 Lisp_Object frame_on_same_kboard;
1432 frame_on_same_kboard = Qnil;
1434 for (frames = Vframe_list;
1435 CONSP (frames);
1436 frames = XCDR (frames))
1438 Lisp_Object this;
1439 struct frame *f1;
1441 this = XCAR (frames);
1442 if (!FRAMEP (this))
1443 abort ();
1444 f1 = XFRAME (this);
1446 if (kb == FRAME_KBOARD (f1))
1447 frame_on_same_kboard = this;
1450 if (NILP (frame_on_same_kboard))
1451 not_single_kboard_state (kb);
1455 /* If we've deleted this keyboard's default_minibuffer_frame, try to
1456 find another one. Prefer minibuffer-only frames, but also notice
1457 frames with other windows. */
1458 if (kb != NULL && EQ (frame, kb->Vdefault_minibuffer_frame))
1460 Lisp_Object frames;
1462 /* The last frame we saw with a minibuffer, minibuffer-only or not. */
1463 Lisp_Object frame_with_minibuf;
1464 /* Some frame we found on the same kboard, or nil if there are none. */
1465 Lisp_Object frame_on_same_kboard;
1467 frame_on_same_kboard = Qnil;
1468 frame_with_minibuf = Qnil;
1470 for (frames = Vframe_list;
1471 CONSP (frames);
1472 frames = XCDR (frames))
1474 Lisp_Object this;
1475 struct frame *f1;
1477 this = XCAR (frames);
1478 if (!FRAMEP (this))
1479 abort ();
1480 f1 = XFRAME (this);
1482 /* Consider only frames on the same kboard
1483 and only those with minibuffers. */
1484 if (kb == FRAME_KBOARD (f1)
1485 && FRAME_HAS_MINIBUF_P (f1))
1487 frame_with_minibuf = this;
1488 if (FRAME_MINIBUF_ONLY_P (f1))
1489 break;
1492 if (kb == FRAME_KBOARD (f1))
1493 frame_on_same_kboard = this;
1496 if (!NILP (frame_on_same_kboard))
1498 /* We know that there must be some frame with a minibuffer out
1499 there. If this were not true, all of the frames present
1500 would have to be minibufferless, which implies that at some
1501 point their minibuffer frames must have been deleted, but
1502 that is prohibited at the top; you can't delete surrogate
1503 minibuffer frames. */
1504 if (NILP (frame_with_minibuf))
1505 abort ();
1507 kb->Vdefault_minibuffer_frame = frame_with_minibuf;
1509 else
1510 /* No frames left on this kboard--say no minibuffer either. */
1511 kb->Vdefault_minibuffer_frame = Qnil;
1514 /* Cause frame titles to update--necessary if we now have just one frame. */
1515 if (!tooltip_frame)
1516 update_mode_lines = 1;
1518 return Qnil;
1521 DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 2, "",
1522 doc: /* Delete FRAME, permanently eliminating it from use.
1523 FRAME defaults to the selected frame.
1525 A frame may not be deleted if its minibuffer is used by other frames.
1526 Normally, you may not delete a frame if all other frames are invisible,
1527 but if the second optional argument FORCE is non-nil, you may do so.
1529 This function runs `delete-frame-functions' before actually
1530 deleting the frame, unless the frame is a tooltip.
1531 The functions are run with one argument, the frame to be deleted. */)
1532 (Lisp_Object frame, Lisp_Object force)
1534 return delete_frame (frame, !NILP (force) ? Qt : Qnil);
1538 /* Return mouse position in character cell units. */
1540 DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0,
1541 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1542 The position is given in character cells, where (0, 0) is the
1543 upper-left corner of the frame, X is the horizontal offset, and Y is
1544 the vertical offset.
1545 If Emacs is running on a mouseless terminal or hasn't been programmed
1546 to read the mouse position, it returns the selected frame for FRAME
1547 and nil for X and Y.
1548 If `mouse-position-function' is non-nil, `mouse-position' calls it,
1549 passing the normal return value to that function as an argument,
1550 and returns whatever that function returns. */)
1551 (void)
1553 FRAME_PTR f;
1554 Lisp_Object lispy_dummy;
1555 enum scroll_bar_part party_dummy;
1556 Lisp_Object x, y, retval;
1557 int col, row;
1558 unsigned long long_dummy;
1559 struct gcpro gcpro1;
1561 f = SELECTED_FRAME ();
1562 x = y = Qnil;
1564 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
1565 /* It's okay for the hook to refrain from storing anything. */
1566 if (FRAME_TERMINAL (f)->mouse_position_hook)
1567 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1568 &lispy_dummy, &party_dummy,
1569 &x, &y,
1570 &long_dummy);
1571 if (! NILP (x))
1573 col = XINT (x);
1574 row = XINT (y);
1575 pixel_to_glyph_coords (f, col, row, &col, &row, NULL, 1);
1576 XSETINT (x, col);
1577 XSETINT (y, row);
1579 #endif
1580 XSETFRAME (lispy_dummy, f);
1581 retval = Fcons (lispy_dummy, Fcons (x, y));
1582 GCPRO1 (retval);
1583 if (!NILP (Vmouse_position_function))
1584 retval = call1 (Vmouse_position_function, retval);
1585 RETURN_UNGCPRO (retval);
1588 DEFUN ("mouse-pixel-position", Fmouse_pixel_position,
1589 Smouse_pixel_position, 0, 0, 0,
1590 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1591 The position is given in pixel units, where (0, 0) is the
1592 upper-left corner of the frame, X is the horizontal offset, and Y is
1593 the vertical offset.
1594 If Emacs is running on a mouseless terminal or hasn't been programmed
1595 to read the mouse position, it returns the selected frame for FRAME
1596 and nil for X and Y. */)
1597 (void)
1599 FRAME_PTR f;
1600 Lisp_Object lispy_dummy;
1601 enum scroll_bar_part party_dummy;
1602 Lisp_Object x, y;
1603 unsigned long long_dummy;
1605 f = SELECTED_FRAME ();
1606 x = y = Qnil;
1608 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
1609 /* It's okay for the hook to refrain from storing anything. */
1610 if (FRAME_TERMINAL (f)->mouse_position_hook)
1611 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1612 &lispy_dummy, &party_dummy,
1613 &x, &y,
1614 &long_dummy);
1615 #endif
1616 XSETFRAME (lispy_dummy, f);
1617 return Fcons (lispy_dummy, Fcons (x, y));
1620 DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0,
1621 doc: /* Move the mouse pointer to the center of character cell (X,Y) in FRAME.
1622 Coordinates are relative to the frame, not a window,
1623 so the coordinates of the top left character in the frame
1624 may be nonzero due to left-hand scroll bars or the menu bar.
1626 The position is given in character cells, where (0, 0) is the
1627 upper-left corner of the frame, X is the horizontal offset, and Y is
1628 the vertical offset.
1630 This function is a no-op for an X frame that is not visible.
1631 If you have just created a frame, you must wait for it to become visible
1632 before calling this function on it, like this.
1633 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1634 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1636 CHECK_LIVE_FRAME (frame);
1637 CHECK_NUMBER (x);
1638 CHECK_NUMBER (y);
1640 /* I think this should be done with a hook. */
1641 #ifdef HAVE_WINDOW_SYSTEM
1642 if (FRAME_WINDOW_P (XFRAME (frame)))
1643 /* Warping the mouse will cause enternotify and focus events. */
1644 x_set_mouse_position (XFRAME (frame), XINT (x), XINT (y));
1645 #else
1646 #if defined (MSDOS) && defined (HAVE_MOUSE)
1647 if (FRAME_MSDOS_P (XFRAME (frame)))
1649 Fselect_frame (frame, Qnil);
1650 mouse_moveto (XINT (x), XINT (y));
1652 #else
1653 #ifdef HAVE_GPM
1655 Fselect_frame (frame, Qnil);
1656 term_mouse_moveto (XINT (x), XINT (y));
1658 #endif
1659 #endif
1660 #endif
1662 return Qnil;
1665 DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position,
1666 Sset_mouse_pixel_position, 3, 3, 0,
1667 doc: /* Move the mouse pointer to pixel position (X,Y) in FRAME.
1668 The position is given in pixels, where (0, 0) is the upper-left corner
1669 of the frame, X is the horizontal offset, and Y is the vertical offset.
1671 Note, this is a no-op for an X frame that is not visible.
1672 If you have just created a frame, you must wait for it to become visible
1673 before calling this function on it, like this.
1674 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1675 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1677 CHECK_LIVE_FRAME (frame);
1678 CHECK_NUMBER (x);
1679 CHECK_NUMBER (y);
1681 /* I think this should be done with a hook. */
1682 #ifdef HAVE_WINDOW_SYSTEM
1683 if (FRAME_WINDOW_P (XFRAME (frame)))
1684 /* Warping the mouse will cause enternotify and focus events. */
1685 x_set_mouse_pixel_position (XFRAME (frame), XINT (x), XINT (y));
1686 #else
1687 #if defined (MSDOS) && defined (HAVE_MOUSE)
1688 if (FRAME_MSDOS_P (XFRAME (frame)))
1690 Fselect_frame (frame, Qnil);
1691 mouse_moveto (XINT (x), XINT (y));
1693 #else
1694 #ifdef HAVE_GPM
1696 Fselect_frame (frame, Qnil);
1697 term_mouse_moveto (XINT (x), XINT (y));
1699 #endif
1700 #endif
1701 #endif
1703 return Qnil;
1706 static void make_frame_visible_1 (Lisp_Object);
1708 DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible,
1709 0, 1, "",
1710 doc: /* Make the frame FRAME visible (assuming it is an X window).
1711 If omitted, FRAME defaults to the currently selected frame. */)
1712 (Lisp_Object frame)
1714 if (NILP (frame))
1715 frame = selected_frame;
1717 CHECK_LIVE_FRAME (frame);
1719 /* I think this should be done with a hook. */
1720 #ifdef HAVE_WINDOW_SYSTEM
1721 if (FRAME_WINDOW_P (XFRAME (frame)))
1723 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1724 x_make_frame_visible (XFRAME (frame));
1726 #endif
1728 make_frame_visible_1 (XFRAME (frame)->root_window);
1730 /* Make menu bar update for the Buffers and Frames menus. */
1731 windows_or_buffers_changed++;
1733 return frame;
1736 /* Update the display_time slot of the buffers shown in WINDOW
1737 and all its descendents. */
1739 static void
1740 make_frame_visible_1 (Lisp_Object window)
1742 struct window *w;
1744 for (;!NILP (window); window = w->next)
1746 w = XWINDOW (window);
1748 if (!NILP (w->buffer))
1749 XBUFFER (w->buffer)->display_time = Fcurrent_time ();
1751 if (!NILP (w->vchild))
1752 make_frame_visible_1 (w->vchild);
1753 if (!NILP (w->hchild))
1754 make_frame_visible_1 (w->hchild);
1758 DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible,
1759 0, 2, "",
1760 doc: /* Make the frame FRAME invisible.
1761 If omitted, FRAME defaults to the currently selected frame.
1762 On graphical displays, invisible frames are not updated and are
1763 usually not displayed at all, even in a window system's \"taskbar\".
1765 Normally you may not make FRAME invisible if all other frames are invisible,
1766 but if the second optional argument FORCE is non-nil, you may do so.
1768 This function has no effect on text-only terminal frames. Such frames
1769 are always considered visible, whether or not they are currently being
1770 displayed in the terminal. */)
1771 (Lisp_Object frame, Lisp_Object force)
1773 if (NILP (frame))
1774 frame = selected_frame;
1776 CHECK_LIVE_FRAME (frame);
1778 if (NILP (force) && !other_visible_frames (XFRAME (frame)))
1779 error ("Attempt to make invisible the sole visible or iconified frame");
1781 #if 0 /* This isn't logically necessary, and it can do GC. */
1782 /* Don't let the frame remain selected. */
1783 if (EQ (frame, selected_frame))
1784 do_switch_frame (next_frame (frame, Qt), 0, 0, Qnil)
1785 #endif
1787 /* Don't allow minibuf_window to remain on a deleted frame. */
1788 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1790 struct frame *sf = XFRAME (selected_frame);
1791 Fset_window_buffer (sf->minibuffer_window,
1792 XWINDOW (minibuf_window)->buffer, Qnil);
1793 minibuf_window = sf->minibuffer_window;
1796 /* I think this should be done with a hook. */
1797 #ifdef HAVE_WINDOW_SYSTEM
1798 if (FRAME_WINDOW_P (XFRAME (frame)))
1799 x_make_frame_invisible (XFRAME (frame));
1800 #endif
1802 /* Make menu bar update for the Buffers and Frames menus. */
1803 windows_or_buffers_changed++;
1805 return Qnil;
1808 DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame,
1809 0, 1, "",
1810 doc: /* Make the frame FRAME into an icon.
1811 If omitted, FRAME defaults to the currently selected frame. */)
1812 (Lisp_Object frame)
1814 if (NILP (frame))
1815 frame = selected_frame;
1817 CHECK_LIVE_FRAME (frame);
1819 #if 0 /* This isn't logically necessary, and it can do GC. */
1820 /* Don't let the frame remain selected. */
1821 if (EQ (frame, selected_frame))
1822 Fhandle_switch_frame (next_frame (frame, Qt));
1823 #endif
1825 /* Don't allow minibuf_window to remain on a deleted frame. */
1826 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1828 struct frame *sf = XFRAME (selected_frame);
1829 Fset_window_buffer (sf->minibuffer_window,
1830 XWINDOW (minibuf_window)->buffer, Qnil);
1831 minibuf_window = sf->minibuffer_window;
1834 /* I think this should be done with a hook. */
1835 #ifdef HAVE_WINDOW_SYSTEM
1836 if (FRAME_WINDOW_P (XFRAME (frame)))
1837 x_iconify_frame (XFRAME (frame));
1838 #endif
1840 /* Make menu bar update for the Buffers and Frames menus. */
1841 windows_or_buffers_changed++;
1843 return Qnil;
1846 DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p,
1847 1, 1, 0,
1848 doc: /* Return t if FRAME is \"visible\" (actually in use for display).
1849 Return the symbol `icon' if FRAME is iconified or \"minimized\".
1850 Return nil if FRAME was made invisible, via `make-frame-invisible'.
1851 On graphical displays, invisible frames are not updated and are
1852 usually not displayed at all, even in a window system's \"taskbar\".
1854 If FRAME is a text-only terminal frame, this always returns t.
1855 Such frames are always considered visible, whether or not they are
1856 currently being displayed on the terminal. */)
1857 (Lisp_Object frame)
1859 CHECK_LIVE_FRAME (frame);
1861 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1863 if (FRAME_VISIBLE_P (XFRAME (frame)))
1864 return Qt;
1865 if (FRAME_ICONIFIED_P (XFRAME (frame)))
1866 return Qicon;
1867 return Qnil;
1870 DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list,
1871 0, 0, 0,
1872 doc: /* Return a list of all frames now \"visible\" (being updated). */)
1873 (void)
1875 Lisp_Object tail, frame;
1876 struct frame *f;
1877 Lisp_Object value;
1879 value = Qnil;
1880 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1882 frame = XCAR (tail);
1883 if (!FRAMEP (frame))
1884 continue;
1885 f = XFRAME (frame);
1886 if (FRAME_VISIBLE_P (f))
1887 value = Fcons (frame, value);
1889 return value;
1893 DEFUN ("raise-frame", Fraise_frame, Sraise_frame, 0, 1, "",
1894 doc: /* Bring FRAME to the front, so it occludes any frames it overlaps.
1895 If FRAME is invisible or iconified, make it visible.
1896 If you don't specify a frame, the selected frame is used.
1897 If Emacs is displaying on an ordinary terminal or some other device which
1898 doesn't support multiple overlapping frames, this function selects FRAME. */)
1899 (Lisp_Object frame)
1901 struct frame *f;
1902 if (NILP (frame))
1903 frame = selected_frame;
1905 CHECK_LIVE_FRAME (frame);
1907 f = XFRAME (frame);
1909 if (FRAME_TERMCAP_P (f))
1910 /* On a text-only terminal select FRAME. */
1911 Fselect_frame (frame, Qnil);
1912 else
1913 /* Do like the documentation says. */
1914 Fmake_frame_visible (frame);
1916 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
1917 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 1);
1919 return Qnil;
1922 /* Should we have a corresponding function called Flower_Power? */
1923 DEFUN ("lower-frame", Flower_frame, Slower_frame, 0, 1, "",
1924 doc: /* Send FRAME to the back, so it is occluded by any frames that overlap it.
1925 If you don't specify a frame, the selected frame is used.
1926 If Emacs is displaying on an ordinary terminal or some other device which
1927 doesn't support multiple overlapping frames, this function does nothing. */)
1928 (Lisp_Object frame)
1930 struct frame *f;
1932 if (NILP (frame))
1933 frame = selected_frame;
1935 CHECK_LIVE_FRAME (frame);
1937 f = XFRAME (frame);
1939 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
1940 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 0);
1942 return Qnil;
1946 DEFUN ("redirect-frame-focus", Fredirect_frame_focus, Sredirect_frame_focus,
1947 1, 2, 0,
1948 doc: /* Arrange for keystrokes typed at FRAME to be sent to FOCUS-FRAME.
1949 In other words, switch-frame events caused by events in FRAME will
1950 request a switch to FOCUS-FRAME, and `last-event-frame' will be
1951 FOCUS-FRAME after reading an event typed at FRAME.
1953 If FOCUS-FRAME is omitted or nil, any existing redirection is
1954 cancelled, and the frame again receives its own keystrokes.
1956 Focus redirection is useful for temporarily redirecting keystrokes to
1957 a surrogate minibuffer frame when a frame doesn't have its own
1958 minibuffer window.
1960 A frame's focus redirection can be changed by `select-frame'. If frame
1961 FOO is selected, and then a different frame BAR is selected, any
1962 frames redirecting their focus to FOO are shifted to redirect their
1963 focus to BAR. This allows focus redirection to work properly when the
1964 user switches from one frame to another using `select-window'.
1966 This means that a frame whose focus is redirected to itself is treated
1967 differently from a frame whose focus is redirected to nil; the former
1968 is affected by `select-frame', while the latter is not.
1970 The redirection lasts until `redirect-frame-focus' is called to change it. */)
1971 (Lisp_Object frame, Lisp_Object focus_frame)
1973 struct frame *f;
1975 /* Note that we don't check for a live frame here. It's reasonable
1976 to redirect the focus of a frame you're about to delete, if you
1977 know what other frame should receive those keystrokes. */
1978 CHECK_FRAME (frame);
1980 if (! NILP (focus_frame))
1981 CHECK_LIVE_FRAME (focus_frame);
1983 f = XFRAME (frame);
1985 f->focus_frame = focus_frame;
1987 if (FRAME_TERMINAL (f)->frame_rehighlight_hook)
1988 (*FRAME_TERMINAL (f)->frame_rehighlight_hook) (f);
1990 return Qnil;
1994 DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 1, 1, 0,
1995 doc: /* Return the frame to which FRAME's keystrokes are currently being sent.
1996 This returns nil if FRAME's focus is not redirected.
1997 See `redirect-frame-focus'. */)
1998 (Lisp_Object frame)
2000 CHECK_LIVE_FRAME (frame);
2002 return FRAME_FOCUS_FRAME (XFRAME (frame));
2007 /* Return the value of frame parameter PROP in frame FRAME. */
2009 Lisp_Object
2010 get_frame_param (register struct frame *frame, Lisp_Object prop)
2012 register Lisp_Object tem;
2014 tem = Fassq (prop, frame->param_alist);
2015 if (EQ (tem, Qnil))
2016 return tem;
2017 return Fcdr (tem);
2020 /* Return the buffer-predicate of the selected frame. */
2022 Lisp_Object
2023 frame_buffer_predicate (Lisp_Object frame)
2025 return XFRAME (frame)->buffer_predicate;
2028 /* Return the buffer-list of the selected frame. */
2030 Lisp_Object
2031 frame_buffer_list (Lisp_Object frame)
2033 return XFRAME (frame)->buffer_list;
2036 /* Set the buffer-list of the selected frame. */
2038 void
2039 set_frame_buffer_list (Lisp_Object frame, Lisp_Object list)
2041 XFRAME (frame)->buffer_list = list;
2044 /* Discard BUFFER from the buffer-list and buried-buffer-list of each frame. */
2046 void
2047 frames_discard_buffer (Lisp_Object buffer)
2049 Lisp_Object frame, tail;
2051 FOR_EACH_FRAME (tail, frame)
2053 XFRAME (frame)->buffer_list
2054 = Fdelq (buffer, XFRAME (frame)->buffer_list);
2055 XFRAME (frame)->buried_buffer_list
2056 = Fdelq (buffer, XFRAME (frame)->buried_buffer_list);
2060 /* Modify the alist in *ALISTPTR to associate PROP with VAL.
2061 If the alist already has an element for PROP, we change it. */
2063 void
2064 store_in_alist (Lisp_Object *alistptr, Lisp_Object prop, Lisp_Object val)
2066 register Lisp_Object tem;
2068 tem = Fassq (prop, *alistptr);
2069 if (EQ (tem, Qnil))
2070 *alistptr = Fcons (Fcons (prop, val), *alistptr);
2071 else
2072 Fsetcdr (tem, val);
2075 static int
2076 frame_name_fnn_p (char *str, EMACS_INT len)
2078 if (len > 1 && str[0] == 'F')
2080 char *end_ptr;
2082 strtol (str + 1, &end_ptr, 10);
2084 if (end_ptr == str + len)
2085 return 1;
2087 return 0;
2090 /* Set the name of the terminal frame. Also used by MSDOS frames.
2091 Modeled after x_set_name which is used for WINDOW frames. */
2093 static void
2094 set_term_frame_name (struct frame *f, Lisp_Object name)
2096 f->explicit_name = ! NILP (name);
2098 /* If NAME is nil, set the name to F<num>. */
2099 if (NILP (name))
2101 char namebuf[20];
2103 /* Check for no change needed in this very common case
2104 before we do any consing. */
2105 if (frame_name_fnn_p (SDATA (f->name),
2106 SBYTES (f->name)))
2107 return;
2109 tty_frame_count++;
2110 sprintf (namebuf, "F%d", tty_frame_count);
2111 name = build_string (namebuf);
2113 else
2115 CHECK_STRING (name);
2117 /* Don't change the name if it's already NAME. */
2118 if (! NILP (Fstring_equal (name, f->name)))
2119 return;
2121 /* Don't allow the user to set the frame name to F<num>, so it
2122 doesn't clash with the names we generate for terminal frames. */
2123 if (frame_name_fnn_p (SDATA (name), SBYTES (name)))
2124 error ("Frame names of the form F<num> are usurped by Emacs");
2127 f->name = name;
2128 update_mode_lines = 1;
2131 void
2132 store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
2134 register Lisp_Object old_alist_elt;
2136 /* The buffer-list parameters are stored in a special place and not
2137 in the alist. */
2138 if (EQ (prop, Qbuffer_list))
2140 f->buffer_list = val;
2141 return;
2143 if (EQ (prop, Qburied_buffer_list))
2145 f->buried_buffer_list = val;
2146 return;
2149 /* If PROP is a symbol which is supposed to have frame-local values,
2150 and it is set up based on this frame, switch to the global
2151 binding. That way, we can create or alter the frame-local binding
2152 without messing up the symbol's status. */
2153 if (SYMBOLP (prop))
2155 struct Lisp_Symbol *sym = XSYMBOL (prop);
2156 start:
2157 switch (sym->redirect)
2159 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
2160 case SYMBOL_PLAINVAL: case SYMBOL_FORWARDED: break;
2161 case SYMBOL_LOCALIZED:
2162 { struct Lisp_Buffer_Local_Value *blv = sym->val.blv;
2163 if (blv->frame_local && BLV_FOUND (blv) && XFRAME (blv->where) == f)
2164 swap_in_global_binding (sym);
2165 break;
2167 default: abort ();
2171 /* The tty color needed to be set before the frame's parameter
2172 alist was updated with the new value. This is not true any more,
2173 but we still do this test early on. */
2174 if (FRAME_TERMCAP_P (f) && EQ (prop, Qtty_color_mode)
2175 && f == FRAME_TTY (f)->previous_frame)
2176 /* Force redisplay of this tty. */
2177 FRAME_TTY (f)->previous_frame = NULL;
2179 /* Update the frame parameter alist. */
2180 old_alist_elt = Fassq (prop, f->param_alist);
2181 if (EQ (old_alist_elt, Qnil))
2182 f->param_alist = Fcons (Fcons (prop, val), f->param_alist);
2183 else
2184 Fsetcdr (old_alist_elt, val);
2186 /* Update some other special parameters in their special places
2187 in addition to the alist. */
2189 if (EQ (prop, Qbuffer_predicate))
2190 f->buffer_predicate = val;
2192 if (! FRAME_WINDOW_P (f))
2194 if (EQ (prop, Qmenu_bar_lines))
2195 set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f)));
2196 else if (EQ (prop, Qname))
2197 set_term_frame_name (f, val);
2200 if (EQ (prop, Qminibuffer) && WINDOWP (val))
2202 if (! MINI_WINDOW_P (XWINDOW (val)))
2203 error ("Surrogate minibuffer windows must be minibuffer windows");
2205 if ((FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
2206 && !EQ (val, f->minibuffer_window))
2207 error ("Can't change the surrogate minibuffer of a frame with its own minibuffer");
2209 /* Install the chosen minibuffer window, with proper buffer. */
2210 f->minibuffer_window = val;
2214 DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0,
2215 doc: /* Return the parameters-alist of frame FRAME.
2216 It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
2217 The meaningful PARMs depend on the kind of frame.
2218 If FRAME is omitted, return information on the currently selected frame. */)
2219 (Lisp_Object frame)
2221 Lisp_Object alist;
2222 FRAME_PTR f;
2223 int height, width;
2224 struct gcpro gcpro1;
2226 if (NILP (frame))
2227 frame = selected_frame;
2229 CHECK_FRAME (frame);
2230 f = XFRAME (frame);
2232 if (!FRAME_LIVE_P (f))
2233 return Qnil;
2235 alist = Fcopy_alist (f->param_alist);
2236 GCPRO1 (alist);
2238 if (!FRAME_WINDOW_P (f))
2240 int fg = FRAME_FOREGROUND_PIXEL (f);
2241 int bg = FRAME_BACKGROUND_PIXEL (f);
2242 Lisp_Object elt;
2244 /* If the frame's parameter alist says the colors are
2245 unspecified and reversed, take the frame's background pixel
2246 for foreground and vice versa. */
2247 elt = Fassq (Qforeground_color, alist);
2248 if (CONSP (elt) && STRINGP (XCDR (elt)))
2250 if (strncmp (SDATA (XCDR (elt)),
2251 unspecified_bg,
2252 SCHARS (XCDR (elt))) == 0)
2253 store_in_alist (&alist, Qforeground_color, tty_color_name (f, bg));
2254 else if (strncmp (SDATA (XCDR (elt)),
2255 unspecified_fg,
2256 SCHARS (XCDR (elt))) == 0)
2257 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2259 else
2260 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2261 elt = Fassq (Qbackground_color, alist);
2262 if (CONSP (elt) && STRINGP (XCDR (elt)))
2264 if (strncmp (SDATA (XCDR (elt)),
2265 unspecified_fg,
2266 SCHARS (XCDR (elt))) == 0)
2267 store_in_alist (&alist, Qbackground_color, tty_color_name (f, fg));
2268 else if (strncmp (SDATA (XCDR (elt)),
2269 unspecified_bg,
2270 SCHARS (XCDR (elt))) == 0)
2271 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2273 else
2274 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2275 store_in_alist (&alist, intern ("font"),
2276 build_string (FRAME_MSDOS_P (f)
2277 ? "ms-dos"
2278 : FRAME_W32_P (f) ? "w32term"
2279 :"tty"));
2281 store_in_alist (&alist, Qname, f->name);
2282 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2283 store_in_alist (&alist, Qheight, make_number (height));
2284 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2285 store_in_alist (&alist, Qwidth, make_number (width));
2286 store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil));
2287 store_in_alist (&alist, Qminibuffer,
2288 (! FRAME_HAS_MINIBUF_P (f) ? Qnil
2289 : FRAME_MINIBUF_ONLY_P (f) ? Qonly
2290 : FRAME_MINIBUF_WINDOW (f)));
2291 store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
2292 store_in_alist (&alist, Qbuffer_list, frame_buffer_list (frame));
2293 store_in_alist (&alist, Qburied_buffer_list, XFRAME (frame)->buried_buffer_list);
2295 /* I think this should be done with a hook. */
2296 #ifdef HAVE_WINDOW_SYSTEM
2297 if (FRAME_WINDOW_P (f))
2298 x_report_frame_params (f, &alist);
2299 else
2300 #endif
2302 /* This ought to be correct in f->param_alist for an X frame. */
2303 Lisp_Object lines;
2304 XSETFASTINT (lines, FRAME_MENU_BAR_LINES (f));
2305 store_in_alist (&alist, Qmenu_bar_lines, lines);
2308 UNGCPRO;
2309 return alist;
2313 DEFUN ("frame-parameter", Fframe_parameter, Sframe_parameter, 2, 2, 0,
2314 doc: /* Return FRAME's value for parameter PARAMETER.
2315 If FRAME is nil, describe the currently selected frame. */)
2316 (Lisp_Object frame, Lisp_Object parameter)
2318 struct frame *f;
2319 Lisp_Object value;
2321 if (NILP (frame))
2322 frame = selected_frame;
2323 else
2324 CHECK_FRAME (frame);
2325 CHECK_SYMBOL (parameter);
2327 f = XFRAME (frame);
2328 value = Qnil;
2330 if (FRAME_LIVE_P (f))
2332 /* Avoid consing in frequent cases. */
2333 if (EQ (parameter, Qname))
2334 value = f->name;
2335 #ifdef HAVE_X_WINDOWS
2336 else if (EQ (parameter, Qdisplay) && FRAME_X_P (f))
2337 value = XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element);
2338 #endif /* HAVE_X_WINDOWS */
2339 else if (EQ (parameter, Qbackground_color)
2340 || EQ (parameter, Qforeground_color))
2342 value = Fassq (parameter, f->param_alist);
2343 if (CONSP (value))
2345 value = XCDR (value);
2346 /* Fframe_parameters puts the actual fg/bg color names,
2347 even if f->param_alist says otherwise. This is
2348 important when param_alist's notion of colors is
2349 "unspecified". We need to do the same here. */
2350 if (STRINGP (value) && !FRAME_WINDOW_P (f))
2352 const char *color_name;
2353 EMACS_INT csz;
2355 if (EQ (parameter, Qbackground_color))
2357 color_name = SDATA (value);
2358 csz = SCHARS (value);
2359 if (strncmp (color_name, unspecified_bg, csz) == 0)
2360 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2361 else if (strncmp (color_name, unspecified_fg, csz) == 0)
2362 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2364 else if (EQ (parameter, Qforeground_color))
2366 color_name = SDATA (value);
2367 csz = SCHARS (value);
2368 if (strncmp (color_name, unspecified_fg, csz) == 0)
2369 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2370 else if (strncmp (color_name, unspecified_bg, csz) == 0)
2371 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2375 else
2376 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2378 else if (EQ (parameter, Qdisplay_type)
2379 || EQ (parameter, Qbackground_mode))
2380 value = Fcdr (Fassq (parameter, f->param_alist));
2381 else
2382 /* FIXME: Avoid this code path at all (as well as code duplication)
2383 by sharing more code with Fframe_parameters. */
2384 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2387 return value;
2391 DEFUN ("modify-frame-parameters", Fmodify_frame_parameters,
2392 Smodify_frame_parameters, 2, 2, 0,
2393 doc: /* Modify the parameters of frame FRAME according to ALIST.
2394 If FRAME is nil, it defaults to the selected frame.
2395 ALIST is an alist of parameters to change and their new values.
2396 Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.
2397 The meaningful PARMs depend on the kind of frame.
2398 Undefined PARMs are ignored, but stored in the frame's parameter list
2399 so that `frame-parameters' will return them.
2401 The value of frame parameter FOO can also be accessed
2402 as a frame-local binding for the variable FOO, if you have
2403 enabled such bindings for that variable with `make-variable-frame-local'.
2404 Note that this functionality is obsolete as of Emacs 22.2, and its
2405 use is not recommended. Explicitly check for a frame-parameter instead. */)
2406 (Lisp_Object frame, Lisp_Object alist)
2408 FRAME_PTR f;
2409 register Lisp_Object tail, prop, val;
2411 if (EQ (frame, Qnil))
2412 frame = selected_frame;
2413 CHECK_LIVE_FRAME (frame);
2414 f = XFRAME (frame);
2416 /* I think this should be done with a hook. */
2417 #ifdef HAVE_WINDOW_SYSTEM
2418 if (FRAME_WINDOW_P (f))
2419 x_set_frame_parameters (f, alist);
2420 else
2421 #endif
2422 #ifdef MSDOS
2423 if (FRAME_MSDOS_P (f))
2424 IT_set_frame_parameters (f, alist);
2425 else
2426 #endif
2429 int length = XINT (Flength (alist));
2430 int i;
2431 Lisp_Object *parms
2432 = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
2433 Lisp_Object *values
2434 = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
2436 /* Extract parm names and values into those vectors. */
2438 i = 0;
2439 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2441 Lisp_Object elt;
2443 elt = XCAR (tail);
2444 parms[i] = Fcar (elt);
2445 values[i] = Fcdr (elt);
2446 i++;
2449 /* Now process them in reverse of specified order. */
2450 for (i--; i >= 0; i--)
2452 prop = parms[i];
2453 val = values[i];
2454 store_frame_param (f, prop, val);
2456 /* Changing the background color might change the background
2457 mode, so that we have to load new defface specs.
2458 Call frame-set-background-mode to do that. */
2459 if (EQ (prop, Qbackground_color))
2460 call1 (Qframe_set_background_mode, frame);
2463 return Qnil;
2466 DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height,
2467 0, 1, 0,
2468 doc: /* Height in pixels of a line in the font in frame FRAME.
2469 If FRAME is omitted, the selected frame is used.
2470 For a terminal frame, the value is always 1. */)
2471 (Lisp_Object frame)
2473 struct frame *f;
2475 if (NILP (frame))
2476 frame = selected_frame;
2477 CHECK_FRAME (frame);
2478 f = XFRAME (frame);
2480 #ifdef HAVE_WINDOW_SYSTEM
2481 if (FRAME_WINDOW_P (f))
2482 return make_number (x_char_height (f));
2483 else
2484 #endif
2485 return make_number (1);
2489 DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width,
2490 0, 1, 0,
2491 doc: /* Width in pixels of characters in the font in frame FRAME.
2492 If FRAME is omitted, the selected frame is used.
2493 On a graphical screen, the width is the standard width of the default font.
2494 For a terminal screen, the value is always 1. */)
2495 (Lisp_Object frame)
2497 struct frame *f;
2499 if (NILP (frame))
2500 frame = selected_frame;
2501 CHECK_FRAME (frame);
2502 f = XFRAME (frame);
2504 #ifdef HAVE_WINDOW_SYSTEM
2505 if (FRAME_WINDOW_P (f))
2506 return make_number (x_char_width (f));
2507 else
2508 #endif
2509 return make_number (1);
2512 DEFUN ("frame-pixel-height", Fframe_pixel_height,
2513 Sframe_pixel_height, 0, 1, 0,
2514 doc: /* Return a FRAME's height in pixels.
2515 If FRAME is omitted, the selected frame is used. The exact value
2516 of the result depends on the window-system and toolkit in use:
2518 In the Gtk+ version of Emacs, it includes only any window (including
2519 the minibuffer or eacho area), mode line, and header line. It does not
2520 include the tool bar or menu bar.
2522 With the Motif or Lucid toolkits, it also includes the tool bar (but
2523 not the menu bar).
2525 In a graphical version with no toolkit, it includes both the tool bar
2526 and menu bar.
2528 For a text-only terminal, it includes the menu bar. In this case, the
2529 result is really in characters rather than pixels (i.e., is identical
2530 to `frame-height'). */)
2531 (Lisp_Object frame)
2533 struct frame *f;
2535 if (NILP (frame))
2536 frame = selected_frame;
2537 CHECK_FRAME (frame);
2538 f = XFRAME (frame);
2540 #ifdef HAVE_WINDOW_SYSTEM
2541 if (FRAME_WINDOW_P (f))
2542 return make_number (x_pixel_height (f));
2543 else
2544 #endif
2545 return make_number (FRAME_LINES (f));
2548 DEFUN ("frame-pixel-width", Fframe_pixel_width,
2549 Sframe_pixel_width, 0, 1, 0,
2550 doc: /* Return FRAME's width in pixels.
2551 For a terminal frame, the result really gives the width in characters.
2552 If FRAME is omitted, the selected frame is used. */)
2553 (Lisp_Object frame)
2555 struct frame *f;
2557 if (NILP (frame))
2558 frame = selected_frame;
2559 CHECK_FRAME (frame);
2560 f = XFRAME (frame);
2562 #ifdef HAVE_WINDOW_SYSTEM
2563 if (FRAME_WINDOW_P (f))
2564 return make_number (x_pixel_width (f));
2565 else
2566 #endif
2567 return make_number (FRAME_COLS (f));
2570 DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0,
2571 doc: /* Specify that the frame FRAME has LINES lines.
2572 Optional third arg non-nil means that redisplay should use LINES lines
2573 but that the idea of the actual height of the frame should not be changed. */)
2574 (Lisp_Object frame, Lisp_Object lines, Lisp_Object pretend)
2576 register struct frame *f;
2578 CHECK_NUMBER (lines);
2579 if (NILP (frame))
2580 frame = selected_frame;
2581 CHECK_LIVE_FRAME (frame);
2582 f = XFRAME (frame);
2584 /* I think this should be done with a hook. */
2585 #ifdef HAVE_WINDOW_SYSTEM
2586 if (FRAME_WINDOW_P (f))
2588 if (XINT (lines) != FRAME_LINES (f))
2589 x_set_window_size (f, 1, FRAME_COLS (f), XINT (lines));
2590 do_pending_window_change (0);
2592 else
2593 #endif
2594 change_frame_size (f, XINT (lines), 0, !NILP (pretend), 0, 0);
2595 return Qnil;
2598 DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 3, 0,
2599 doc: /* Specify that the frame FRAME has COLS columns.
2600 Optional third arg non-nil means that redisplay should use COLS columns
2601 but that the idea of the actual width of the frame should not be changed. */)
2602 (Lisp_Object frame, Lisp_Object cols, Lisp_Object pretend)
2604 register struct frame *f;
2605 CHECK_NUMBER (cols);
2606 if (NILP (frame))
2607 frame = selected_frame;
2608 CHECK_LIVE_FRAME (frame);
2609 f = XFRAME (frame);
2611 /* I think this should be done with a hook. */
2612 #ifdef HAVE_WINDOW_SYSTEM
2613 if (FRAME_WINDOW_P (f))
2615 if (XINT (cols) != FRAME_COLS (f))
2616 x_set_window_size (f, 1, XINT (cols), FRAME_LINES (f));
2617 do_pending_window_change (0);
2619 else
2620 #endif
2621 change_frame_size (f, 0, XINT (cols), !NILP (pretend), 0, 0);
2622 return Qnil;
2625 DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0,
2626 doc: /* Sets size of FRAME to COLS by ROWS, measured in characters. */)
2627 (Lisp_Object frame, Lisp_Object cols, Lisp_Object rows)
2629 register struct frame *f;
2631 CHECK_LIVE_FRAME (frame);
2632 CHECK_NUMBER (cols);
2633 CHECK_NUMBER (rows);
2634 f = XFRAME (frame);
2636 /* I think this should be done with a hook. */
2637 #ifdef HAVE_WINDOW_SYSTEM
2638 if (FRAME_WINDOW_P (f))
2640 if (XINT (rows) != FRAME_LINES (f)
2641 || XINT (cols) != FRAME_COLS (f)
2642 || f->new_text_lines || f->new_text_cols)
2643 x_set_window_size (f, 1, XINT (cols), XINT (rows));
2644 do_pending_window_change (0);
2646 else
2647 #endif
2648 change_frame_size (f, XINT (rows), XINT (cols), 0, 0, 0);
2650 return Qnil;
2653 DEFUN ("set-frame-position", Fset_frame_position,
2654 Sset_frame_position, 3, 3, 0,
2655 doc: /* Sets position of FRAME in pixels to XOFFSET by YOFFSET.
2656 This is actually the position of the upper left corner of the frame.
2657 Negative values for XOFFSET or YOFFSET are interpreted relative to
2658 the rightmost or bottommost possible position (that stays within the screen). */)
2659 (Lisp_Object frame, Lisp_Object xoffset, Lisp_Object yoffset)
2661 register struct frame *f;
2663 CHECK_LIVE_FRAME (frame);
2664 CHECK_NUMBER (xoffset);
2665 CHECK_NUMBER (yoffset);
2666 f = XFRAME (frame);
2668 /* I think this should be done with a hook. */
2669 #ifdef HAVE_WINDOW_SYSTEM
2670 if (FRAME_WINDOW_P (f))
2671 x_set_offset (f, XINT (xoffset), XINT (yoffset), 1);
2672 #endif
2674 return Qt;
2678 /***********************************************************************
2679 Frame Parameters
2680 ***********************************************************************/
2682 /* Connect the frame-parameter names for X frames
2683 to the ways of passing the parameter values to the window system.
2685 The name of a parameter, as a Lisp symbol,
2686 has an `x-frame-parameter' property which is an integer in Lisp
2687 that is an index in this table. */
2689 struct frame_parm_table {
2690 char *name;
2691 Lisp_Object *variable;
2694 static struct frame_parm_table frame_parms[] =
2696 {"auto-raise", &Qauto_raise},
2697 {"auto-lower", &Qauto_lower},
2698 {"background-color", 0},
2699 {"border-color", &Qborder_color},
2700 {"border-width", &Qborder_width},
2701 {"cursor-color", &Qcursor_color},
2702 {"cursor-type", &Qcursor_type},
2703 {"font", 0},
2704 {"foreground-color", 0},
2705 {"icon-name", &Qicon_name},
2706 {"icon-type", &Qicon_type},
2707 {"internal-border-width", &Qinternal_border_width},
2708 {"menu-bar-lines", &Qmenu_bar_lines},
2709 {"mouse-color", &Qmouse_color},
2710 {"name", &Qname},
2711 {"scroll-bar-width", &Qscroll_bar_width},
2712 {"title", &Qtitle},
2713 {"unsplittable", &Qunsplittable},
2714 {"vertical-scroll-bars", &Qvertical_scroll_bars},
2715 {"visibility", &Qvisibility},
2716 {"tool-bar-lines", &Qtool_bar_lines},
2717 {"scroll-bar-foreground", &Qscroll_bar_foreground},
2718 {"scroll-bar-background", &Qscroll_bar_background},
2719 {"screen-gamma", &Qscreen_gamma},
2720 {"line-spacing", &Qline_spacing},
2721 {"left-fringe", &Qleft_fringe},
2722 {"right-fringe", &Qright_fringe},
2723 {"wait-for-wm", &Qwait_for_wm},
2724 {"fullscreen", &Qfullscreen},
2725 {"font-backend", &Qfont_backend},
2726 {"alpha", &Qalpha},
2727 {"sticky", &Qsticky},
2730 #ifdef HAVE_WINDOW_SYSTEM
2732 extern Lisp_Object Qbox;
2733 extern Lisp_Object Qtop;
2735 /* Calculate fullscreen size. Return in *TOP_POS and *LEFT_POS the
2736 wanted positions of the WM window (not Emacs window).
2737 Return in *WIDTH and *HEIGHT the wanted width and height of Emacs
2738 window (FRAME_X_WINDOW).
2741 void
2742 x_fullscreen_adjust (struct frame *f, int *width, int *height, int *top_pos, int *left_pos)
2744 int newwidth = FRAME_COLS (f);
2745 int newheight = FRAME_LINES (f);
2746 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2748 *top_pos = f->top_pos;
2749 *left_pos = f->left_pos;
2751 if (f->want_fullscreen & FULLSCREEN_HEIGHT)
2753 int ph;
2755 ph = x_display_pixel_height (dpyinfo);
2756 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2757 ph = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, newheight) - f->y_pixels_diff;
2758 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2759 *top_pos = 0;
2762 if (f->want_fullscreen & FULLSCREEN_WIDTH)
2764 int pw;
2766 pw = x_display_pixel_width (dpyinfo);
2767 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2768 pw = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, newwidth) - f->x_pixels_diff;
2769 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2770 *left_pos = 0;
2773 *width = newwidth;
2774 *height = newheight;
2778 /* Change the parameters of frame F as specified by ALIST.
2779 If a parameter is not specially recognized, do nothing special;
2780 otherwise call the `x_set_...' function for that parameter.
2781 Except for certain geometry properties, always call store_frame_param
2782 to store the new value in the parameter alist. */
2784 void
2785 x_set_frame_parameters (FRAME_PTR f, Lisp_Object alist)
2787 Lisp_Object tail;
2789 /* If both of these parameters are present, it's more efficient to
2790 set them both at once. So we wait until we've looked at the
2791 entire list before we set them. */
2792 int width, height;
2794 /* Same here. */
2795 Lisp_Object left, top;
2797 /* Same with these. */
2798 Lisp_Object icon_left, icon_top;
2800 /* Record in these vectors all the parms specified. */
2801 Lisp_Object *parms;
2802 Lisp_Object *values;
2803 int i, p;
2804 int left_no_change = 0, top_no_change = 0;
2805 int icon_left_no_change = 0, icon_top_no_change = 0;
2806 int size_changed = 0;
2807 struct gcpro gcpro1, gcpro2;
2809 i = 0;
2810 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
2811 i++;
2813 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
2814 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
2816 /* Extract parm names and values into those vectors. */
2818 i = 0;
2819 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2821 Lisp_Object elt;
2823 elt = XCAR (tail);
2824 parms[i] = Fcar (elt);
2825 values[i] = Fcdr (elt);
2826 i++;
2828 /* TAIL and ALIST are not used again below here. */
2829 alist = tail = Qnil;
2831 GCPRO2 (*parms, *values);
2832 gcpro1.nvars = i;
2833 gcpro2.nvars = i;
2835 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
2836 because their values appear in VALUES and strings are not valid. */
2837 top = left = Qunbound;
2838 icon_left = icon_top = Qunbound;
2840 /* Provide default values for HEIGHT and WIDTH. */
2841 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2842 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2844 /* Process foreground_color and background_color before anything else.
2845 They are independent of other properties, but other properties (e.g.,
2846 cursor_color) are dependent upon them. */
2847 /* Process default font as well, since fringe widths depends on it. */
2848 for (p = 0; p < i; p++)
2850 Lisp_Object prop, val;
2852 prop = parms[p];
2853 val = values[p];
2854 if (EQ (prop, Qforeground_color)
2855 || EQ (prop, Qbackground_color)
2856 || EQ (prop, Qfont))
2858 register Lisp_Object param_index, old_value;
2860 old_value = get_frame_param (f, prop);
2861 if (NILP (Fequal (val, old_value)))
2863 store_frame_param (f, prop, val);
2865 param_index = Fget (prop, Qx_frame_parameter);
2866 if (NATNUMP (param_index)
2867 && (XFASTINT (param_index)
2868 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2869 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
2870 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2875 /* Now process them in reverse of specified order. */
2876 for (i--; i >= 0; i--)
2878 Lisp_Object prop, val;
2880 prop = parms[i];
2881 val = values[i];
2883 if (EQ (prop, Qwidth) && NATNUMP (val))
2885 size_changed = 1;
2886 width = XFASTINT (val);
2888 else if (EQ (prop, Qheight) && NATNUMP (val))
2890 size_changed = 1;
2891 height = XFASTINT (val);
2893 else if (EQ (prop, Qtop))
2894 top = val;
2895 else if (EQ (prop, Qleft))
2896 left = val;
2897 else if (EQ (prop, Qicon_top))
2898 icon_top = val;
2899 else if (EQ (prop, Qicon_left))
2900 icon_left = val;
2901 else if (EQ (prop, Qforeground_color)
2902 || EQ (prop, Qbackground_color)
2903 || EQ (prop, Qfont))
2904 /* Processed above. */
2905 continue;
2906 else
2908 register Lisp_Object param_index, old_value;
2910 old_value = get_frame_param (f, prop);
2912 store_frame_param (f, prop, val);
2914 param_index = Fget (prop, Qx_frame_parameter);
2915 if (NATNUMP (param_index)
2916 && (XFASTINT (param_index)
2917 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2918 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
2919 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2923 /* Don't die if just one of these was set. */
2924 if (EQ (left, Qunbound))
2926 left_no_change = 1;
2927 if (f->left_pos < 0)
2928 left = Fcons (Qplus, Fcons (make_number (f->left_pos), Qnil));
2929 else
2930 XSETINT (left, f->left_pos);
2932 if (EQ (top, Qunbound))
2934 top_no_change = 1;
2935 if (f->top_pos < 0)
2936 top = Fcons (Qplus, Fcons (make_number (f->top_pos), Qnil));
2937 else
2938 XSETINT (top, f->top_pos);
2941 /* If one of the icon positions was not set, preserve or default it. */
2942 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
2944 icon_left_no_change = 1;
2945 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
2946 if (NILP (icon_left))
2947 XSETINT (icon_left, 0);
2949 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
2951 icon_top_no_change = 1;
2952 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
2953 if (NILP (icon_top))
2954 XSETINT (icon_top, 0);
2957 /* Don't set these parameters unless they've been explicitly
2958 specified. The window might be mapped or resized while we're in
2959 this function, and we don't want to override that unless the lisp
2960 code has asked for it.
2962 Don't set these parameters unless they actually differ from the
2963 window's current parameters; the window may not actually exist
2964 yet. */
2966 Lisp_Object frame;
2968 check_frame_size (f, &height, &width);
2970 XSETFRAME (frame, f);
2972 if (size_changed
2973 && (width != FRAME_COLS (f)
2974 || height != FRAME_LINES (f)
2975 || f->new_text_lines || f->new_text_cols))
2976 Fset_frame_size (frame, make_number (width), make_number (height));
2978 if ((!NILP (left) || !NILP (top))
2979 && ! (left_no_change && top_no_change)
2980 && ! (NUMBERP (left) && XINT (left) == f->left_pos
2981 && NUMBERP (top) && XINT (top) == f->top_pos))
2983 int leftpos = 0;
2984 int toppos = 0;
2986 /* Record the signs. */
2987 f->size_hint_flags &= ~ (XNegative | YNegative);
2988 if (EQ (left, Qminus))
2989 f->size_hint_flags |= XNegative;
2990 else if (INTEGERP (left))
2992 leftpos = XINT (left);
2993 if (leftpos < 0)
2994 f->size_hint_flags |= XNegative;
2996 else if (CONSP (left) && EQ (XCAR (left), Qminus)
2997 && CONSP (XCDR (left))
2998 && INTEGERP (XCAR (XCDR (left))))
3000 leftpos = - XINT (XCAR (XCDR (left)));
3001 f->size_hint_flags |= XNegative;
3003 else if (CONSP (left) && EQ (XCAR (left), Qplus)
3004 && CONSP (XCDR (left))
3005 && INTEGERP (XCAR (XCDR (left))))
3007 leftpos = XINT (XCAR (XCDR (left)));
3010 if (EQ (top, Qminus))
3011 f->size_hint_flags |= YNegative;
3012 else if (INTEGERP (top))
3014 toppos = XINT (top);
3015 if (toppos < 0)
3016 f->size_hint_flags |= YNegative;
3018 else if (CONSP (top) && EQ (XCAR (top), Qminus)
3019 && CONSP (XCDR (top))
3020 && INTEGERP (XCAR (XCDR (top))))
3022 toppos = - XINT (XCAR (XCDR (top)));
3023 f->size_hint_flags |= YNegative;
3025 else if (CONSP (top) && EQ (XCAR (top), Qplus)
3026 && CONSP (XCDR (top))
3027 && INTEGERP (XCAR (XCDR (top))))
3029 toppos = XINT (XCAR (XCDR (top)));
3033 /* Store the numeric value of the position. */
3034 f->top_pos = toppos;
3035 f->left_pos = leftpos;
3037 f->win_gravity = NorthWestGravity;
3039 /* Actually set that position, and convert to absolute. */
3040 x_set_offset (f, leftpos, toppos, -1);
3043 if ((!NILP (icon_left) || !NILP (icon_top))
3044 && ! (icon_left_no_change && icon_top_no_change))
3045 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
3048 UNGCPRO;
3052 /* Insert a description of internally-recorded parameters of frame X
3053 into the parameter alist *ALISTPTR that is to be given to the user.
3054 Only parameters that are specific to the X window system
3055 and whose values are not correctly recorded in the frame's
3056 param_alist need to be considered here. */
3058 void
3059 x_report_frame_params (struct frame *f, Lisp_Object *alistptr)
3061 char buf[16];
3062 Lisp_Object tem;
3064 /* Represent negative positions (off the top or left screen edge)
3065 in a way that Fmodify_frame_parameters will understand correctly. */
3066 XSETINT (tem, f->left_pos);
3067 if (f->left_pos >= 0)
3068 store_in_alist (alistptr, Qleft, tem);
3069 else
3070 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
3072 XSETINT (tem, f->top_pos);
3073 if (f->top_pos >= 0)
3074 store_in_alist (alistptr, Qtop, tem);
3075 else
3076 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
3078 store_in_alist (alistptr, Qborder_width,
3079 make_number (f->border_width));
3080 store_in_alist (alistptr, Qinternal_border_width,
3081 make_number (FRAME_INTERNAL_BORDER_WIDTH (f)));
3082 store_in_alist (alistptr, Qleft_fringe,
3083 make_number (FRAME_LEFT_FRINGE_WIDTH (f)));
3084 store_in_alist (alistptr, Qright_fringe,
3085 make_number (FRAME_RIGHT_FRINGE_WIDTH (f)));
3086 store_in_alist (alistptr, Qscroll_bar_width,
3087 (! FRAME_HAS_VERTICAL_SCROLL_BARS (f)
3088 ? make_number (0)
3089 : FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0
3090 ? make_number (FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3091 /* nil means "use default width"
3092 for non-toolkit scroll bar.
3093 ruler-mode.el depends on this. */
3094 : Qnil));
3095 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
3096 store_in_alist (alistptr, Qwindow_id,
3097 build_string (buf));
3098 #ifdef HAVE_X_WINDOWS
3099 #ifdef USE_X_TOOLKIT
3100 /* Tooltip frame may not have this widget. */
3101 if (FRAME_X_OUTPUT (f)->widget)
3102 #endif
3103 sprintf (buf, "%ld", (long) FRAME_OUTER_WINDOW (f));
3104 store_in_alist (alistptr, Qouter_window_id,
3105 build_string (buf));
3106 #endif
3107 store_in_alist (alistptr, Qicon_name, f->icon_name);
3108 FRAME_SAMPLE_VISIBILITY (f);
3109 store_in_alist (alistptr, Qvisibility,
3110 (FRAME_VISIBLE_P (f) ? Qt
3111 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
3112 store_in_alist (alistptr, Qdisplay,
3113 XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
3115 if (FRAME_X_OUTPUT (f)->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
3116 tem = Qnil;
3117 else
3118 XSETFASTINT (tem, FRAME_X_OUTPUT (f)->parent_desc);
3119 store_in_alist (alistptr, Qexplicit_name, (f->explicit_name ? Qt : Qnil));
3120 store_in_alist (alistptr, Qparent_id, tem);
3124 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
3125 the previous value of that parameter, NEW_VALUE is the new value. */
3127 void
3128 x_set_fullscreen (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3130 if (NILP (new_value))
3131 f->want_fullscreen = FULLSCREEN_NONE;
3132 else if (EQ (new_value, Qfullboth) || EQ (new_value, Qfullscreen))
3133 f->want_fullscreen = FULLSCREEN_BOTH;
3134 else if (EQ (new_value, Qfullwidth))
3135 f->want_fullscreen = FULLSCREEN_WIDTH;
3136 else if (EQ (new_value, Qfullheight))
3137 f->want_fullscreen = FULLSCREEN_HEIGHT;
3138 else if (EQ (new_value, Qmaximized))
3139 f->want_fullscreen = FULLSCREEN_MAXIMIZED;
3141 if (FRAME_TERMINAL (f)->fullscreen_hook != NULL)
3142 FRAME_TERMINAL (f)->fullscreen_hook (f);
3146 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
3147 the previous value of that parameter, NEW_VALUE is the new value. */
3149 void
3150 x_set_line_spacing (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3152 if (NILP (new_value))
3153 f->extra_line_spacing = 0;
3154 else if (NATNUMP (new_value))
3155 f->extra_line_spacing = XFASTINT (new_value);
3156 else
3157 signal_error ("Invalid line-spacing", new_value);
3158 if (FRAME_VISIBLE_P (f))
3159 redraw_frame (f);
3163 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
3164 the previous value of that parameter, NEW_VALUE is the new value. */
3166 void
3167 x_set_screen_gamma (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3169 Lisp_Object bgcolor;
3171 if (NILP (new_value))
3172 f->gamma = 0;
3173 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
3174 /* The value 0.4545 is the normal viewing gamma. */
3175 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
3176 else
3177 signal_error ("Invalid screen-gamma", new_value);
3179 /* Apply the new gamma value to the frame background. */
3180 bgcolor = Fassq (Qbackground_color, f->param_alist);
3181 if (CONSP (bgcolor) && (bgcolor = XCDR (bgcolor), STRINGP (bgcolor)))
3183 Lisp_Object index = Fget (Qbackground_color, Qx_frame_parameter);
3184 if (NATNUMP (index)
3185 && (XFASTINT (index)
3186 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3187 && FRAME_RIF (f)->frame_parm_handlers[XFASTINT (index)])
3188 (*FRAME_RIF (f)->frame_parm_handlers[XFASTINT (index)])
3189 (f, bgcolor, Qnil);
3192 Fclear_face_cache (Qnil);
3196 void
3197 x_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3199 Lisp_Object frame, font_object, font_param = Qnil;
3200 int fontset = -1;
3202 /* Set the frame parameter back to the old value because we may
3203 fail to use ARG as the new parameter value. */
3204 store_frame_param (f, Qfont, oldval);
3206 /* ARG is a fontset name, a font name, a cons of fontset name and a
3207 font object, or a font object. In the last case, this function
3208 never fail. */
3209 if (STRINGP (arg))
3211 font_param = arg;
3212 fontset = fs_query_fontset (arg, 0);
3213 if (fontset < 0)
3215 font_object = font_open_by_name (f, SDATA (arg));
3216 if (NILP (font_object))
3217 error ("Font `%s' is not defined", SDATA (arg));
3218 arg = AREF (font_object, FONT_NAME_INDEX);
3220 else if (fontset > 0)
3222 Lisp_Object ascii_font = fontset_ascii (fontset);
3224 font_object = font_open_by_name (f, SDATA (ascii_font));
3225 if (NILP (font_object))
3226 error ("Font `%s' is not defined", SDATA (arg));
3227 arg = AREF (font_object, FONT_NAME_INDEX);
3229 else
3230 error ("The default fontset can't be used for a frame font");
3232 else if (CONSP (arg) && STRINGP (XCAR (arg)) && FONT_OBJECT_P (XCDR (arg)))
3234 /* This is the case that the ASCII font of F's fontset XCAR
3235 (arg) is changed to the font XCDR (arg) by
3236 `set-fontset-font'. */
3237 fontset = fs_query_fontset (XCAR (arg), 0);
3238 if (fontset < 0)
3239 error ("Unknown fontset: %s", SDATA (XCAR (arg)));
3240 font_object = XCDR (arg);
3241 arg = AREF (font_object, FONT_NAME_INDEX);
3242 font_param = Ffont_get (font_object, QCname);
3244 else if (FONT_OBJECT_P (arg))
3246 font_object = arg;
3247 font_param = Ffont_get (font_object, QCname);
3248 /* This is to store the XLFD font name in the frame parameter for
3249 backward compatibility. We should store the font-object
3250 itself in the future. */
3251 arg = AREF (font_object, FONT_NAME_INDEX);
3252 fontset = FRAME_FONTSET (f);
3253 /* Check if we can use the current fontset. If not, set FONTSET
3254 to -1 to generate a new fontset from FONT-OBJECT. */
3255 if (fontset >= 0)
3257 Lisp_Object ascii_font = fontset_ascii (fontset);
3258 Lisp_Object spec = font_spec_from_name (ascii_font);
3260 if (! font_match_p (spec, font_object))
3261 fontset = -1;
3264 else
3265 signal_error ("Invalid font", arg);
3267 if (! NILP (Fequal (font_object, oldval)))
3268 return;
3270 x_new_font (f, font_object, fontset);
3271 store_frame_param (f, Qfont, arg);
3272 #ifdef HAVE_X_WINDOWS
3273 store_frame_param (f, Qfont_param, font_param);
3274 #endif
3275 /* Recalculate toolbar height. */
3276 f->n_tool_bar_rows = 0;
3277 /* Ensure we redraw it. */
3278 clear_current_matrices (f);
3280 recompute_basic_faces (f);
3282 do_pending_window_change (0);
3284 /* We used to call face-set-after-frame-default here, but it leads to
3285 recursive calls (since that function can set the `default' face's
3286 font which in turns changes the frame's `font' parameter).
3287 Also I don't know what this call is meant to do, but it seems the
3288 wrong way to do it anyway (it does a lot more work than what seems
3289 reasonable in response to a change to `font'). */
3293 void
3294 x_set_font_backend (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3296 if (! NILP (new_value)
3297 && !CONSP (new_value))
3299 char *p0, *p1;
3301 CHECK_STRING (new_value);
3302 p0 = p1 = SDATA (new_value);
3303 new_value = Qnil;
3304 while (*p0)
3306 while (*p1 && ! isspace (*p1) && *p1 != ',') p1++;
3307 if (p0 < p1)
3308 new_value = Fcons (Fintern (make_string (p0, p1 - p0), Qnil),
3309 new_value);
3310 if (*p1)
3312 int c;
3314 while ((c = *++p1) && isspace (c));
3316 p0 = p1;
3318 new_value = Fnreverse (new_value);
3321 if (! NILP (old_value) && ! NILP (Fequal (old_value, new_value)))
3322 return;
3324 if (FRAME_FONT (f))
3325 free_all_realized_faces (Qnil);
3327 new_value = font_update_drivers (f, NILP (new_value) ? Qt : new_value);
3328 if (NILP (new_value))
3330 if (NILP (old_value))
3331 error ("No font backend available");
3332 font_update_drivers (f, old_value);
3333 error ("None of specified font backends are available");
3335 store_frame_param (f, Qfont_backend, new_value);
3337 if (FRAME_FONT (f))
3339 Lisp_Object frame;
3341 XSETFRAME (frame, f);
3342 x_set_font (f, Fframe_parameter (frame, Qfont), Qnil);
3343 ++face_change_count;
3344 ++windows_or_buffers_changed;
3349 void
3350 x_set_fringe_width (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3352 compute_fringe_widths (f, 1);
3355 void
3356 x_set_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3358 CHECK_NUMBER (arg);
3360 if (XINT (arg) == f->border_width)
3361 return;
3363 if (FRAME_X_WINDOW (f) != 0)
3364 error ("Cannot change the border width of a frame");
3366 f->border_width = XINT (arg);
3369 void
3370 x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3372 int old = FRAME_INTERNAL_BORDER_WIDTH (f);
3374 CHECK_NUMBER (arg);
3375 FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
3376 if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
3377 FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
3379 #ifdef USE_X_TOOLKIT
3380 if (FRAME_X_OUTPUT (f)->edit_widget)
3381 widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
3382 #endif
3384 if (FRAME_INTERNAL_BORDER_WIDTH (f) == old)
3385 return;
3387 if (FRAME_X_WINDOW (f) != 0)
3389 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3390 SET_FRAME_GARBAGED (f);
3391 do_pending_window_change (0);
3393 else
3394 SET_FRAME_GARBAGED (f);
3397 void
3398 x_set_visibility (struct frame *f, Lisp_Object value, Lisp_Object oldval)
3400 Lisp_Object frame;
3401 XSETFRAME (frame, f);
3403 if (NILP (value))
3404 Fmake_frame_invisible (frame, Qt);
3405 else if (EQ (value, Qicon))
3406 Ficonify_frame (frame);
3407 else
3408 Fmake_frame_visible (frame);
3411 void
3412 x_set_autoraise (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3414 f->auto_raise = !EQ (Qnil, arg);
3417 void
3418 x_set_autolower (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3420 f->auto_lower = !EQ (Qnil, arg);
3423 void
3424 x_set_unsplittable (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3426 f->no_split = !NILP (arg);
3429 void
3430 x_set_vertical_scroll_bars (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3432 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
3433 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
3434 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
3435 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
3437 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
3438 = (NILP (arg)
3439 ? vertical_scroll_bar_none
3440 : EQ (Qleft, arg)
3441 ? vertical_scroll_bar_left
3442 : EQ (Qright, arg)
3443 ? vertical_scroll_bar_right
3444 : EQ (Qleft, Vdefault_frame_scroll_bars)
3445 ? vertical_scroll_bar_left
3446 : EQ (Qright, Vdefault_frame_scroll_bars)
3447 ? vertical_scroll_bar_right
3448 : vertical_scroll_bar_none);
3450 /* We set this parameter before creating the X window for the
3451 frame, so we can get the geometry right from the start.
3452 However, if the window hasn't been created yet, we shouldn't
3453 call x_set_window_size. */
3454 if (FRAME_X_WINDOW (f))
3455 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3456 do_pending_window_change (0);
3460 void
3461 x_set_scroll_bar_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3463 int wid = FRAME_COLUMN_WIDTH (f);
3465 if (NILP (arg))
3467 x_set_scroll_bar_default_width (f);
3469 if (FRAME_X_WINDOW (f))
3470 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3471 do_pending_window_change (0);
3473 else if (INTEGERP (arg) && XINT (arg) > 0
3474 && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3476 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
3477 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
3479 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg);
3480 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
3481 if (FRAME_X_WINDOW (f))
3482 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3483 do_pending_window_change (0);
3486 change_frame_size (f, 0, FRAME_COLS (f), 0, 0, 0);
3487 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
3488 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
3493 /* Return non-nil if frame F wants a bitmap icon. */
3495 Lisp_Object
3496 x_icon_type (FRAME_PTR f)
3498 Lisp_Object tem;
3500 tem = assq_no_quit (Qicon_type, f->param_alist);
3501 if (CONSP (tem))
3502 return XCDR (tem);
3503 else
3504 return Qnil;
3507 void
3508 x_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3510 double alpha = 1.0;
3511 double newval[2];
3512 int i, ialpha;
3513 Lisp_Object item;
3515 for (i = 0; i < 2; i++)
3517 newval[i] = 1.0;
3518 if (CONSP (arg))
3520 item = CAR (arg);
3521 arg = CDR (arg);
3523 else
3524 item = arg;
3526 if (NILP (item))
3527 alpha = - 1.0;
3528 else if (FLOATP (item))
3530 alpha = XFLOAT_DATA (item);
3531 if (alpha < 0.0 || 1.0 < alpha)
3532 args_out_of_range (make_float (0.0), make_float (1.0));
3534 else if (INTEGERP (item))
3536 ialpha = XINT (item);
3537 if (ialpha < 0 || 100 < ialpha)
3538 args_out_of_range (make_number (0), make_number (100));
3539 else
3540 alpha = ialpha / 100.0;
3542 else
3543 wrong_type_argument (Qnumberp, item);
3544 newval[i] = alpha;
3547 for (i = 0; i < 2; i++)
3548 f->alpha[i] = newval[i];
3550 #if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA)
3551 BLOCK_INPUT;
3552 x_set_frame_alpha (f);
3553 UNBLOCK_INPUT;
3554 #endif
3556 return;
3560 /* Subroutines of creating an X frame. */
3562 /* Make sure that Vx_resource_name is set to a reasonable value.
3563 Fix it up, or set it to `emacs' if it is too hopeless. */
3565 void
3566 validate_x_resource_name (void)
3568 int len = 0;
3569 /* Number of valid characters in the resource name. */
3570 int good_count = 0;
3571 /* Number of invalid characters in the resource name. */
3572 int bad_count = 0;
3573 Lisp_Object new;
3574 int i;
3576 if (!STRINGP (Vx_resource_class))
3577 Vx_resource_class = build_string (EMACS_CLASS);
3579 if (STRINGP (Vx_resource_name))
3581 unsigned char *p = SDATA (Vx_resource_name);
3582 int i;
3584 len = SBYTES (Vx_resource_name);
3586 /* Only letters, digits, - and _ are valid in resource names.
3587 Count the valid characters and count the invalid ones. */
3588 for (i = 0; i < len; i++)
3590 int c = p[i];
3591 if (! ((c >= 'a' && c <= 'z')
3592 || (c >= 'A' && c <= 'Z')
3593 || (c >= '0' && c <= '9')
3594 || c == '-' || c == '_'))
3595 bad_count++;
3596 else
3597 good_count++;
3600 else
3601 /* Not a string => completely invalid. */
3602 bad_count = 5, good_count = 0;
3604 /* If name is valid already, return. */
3605 if (bad_count == 0)
3606 return;
3608 /* If name is entirely invalid, or nearly so, use `emacs'. */
3609 if (good_count == 0
3610 || (good_count == 1 && bad_count > 0))
3612 Vx_resource_name = build_string ("emacs");
3613 return;
3616 /* Name is partly valid. Copy it and replace the invalid characters
3617 with underscores. */
3619 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
3621 for (i = 0; i < len; i++)
3623 int c = SREF (new, i);
3624 if (! ((c >= 'a' && c <= 'z')
3625 || (c >= 'A' && c <= 'Z')
3626 || (c >= '0' && c <= '9')
3627 || c == '-' || c == '_'))
3628 SSET (new, i, '_');
3633 extern char *x_get_string_resource (XrmDatabase, const char *, const char *);
3634 extern Display_Info *check_x_display_info (Lisp_Object);
3637 /* Get specified attribute from resource database RDB.
3638 See Fx_get_resource below for other parameters. */
3640 static Lisp_Object
3641 xrdb_get_resource (XrmDatabase rdb, Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3643 register char *value;
3644 char *name_key;
3645 char *class_key;
3647 CHECK_STRING (attribute);
3648 CHECK_STRING (class);
3650 if (!NILP (component))
3651 CHECK_STRING (component);
3652 if (!NILP (subclass))
3653 CHECK_STRING (subclass);
3654 if (NILP (component) != NILP (subclass))
3655 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3657 validate_x_resource_name ();
3659 /* Allocate space for the components, the dots which separate them,
3660 and the final '\0'. Make them big enough for the worst case. */
3661 name_key = (char *) alloca (SBYTES (Vx_resource_name)
3662 + (STRINGP (component)
3663 ? SBYTES (component) : 0)
3664 + SBYTES (attribute)
3665 + 3);
3667 class_key = (char *) alloca (SBYTES (Vx_resource_class)
3668 + SBYTES (class)
3669 + (STRINGP (subclass)
3670 ? SBYTES (subclass) : 0)
3671 + 3);
3673 /* Start with emacs.FRAMENAME for the name (the specific one)
3674 and with `Emacs' for the class key (the general one). */
3675 strcpy (name_key, SDATA (Vx_resource_name));
3676 strcpy (class_key, SDATA (Vx_resource_class));
3678 strcat (class_key, ".");
3679 strcat (class_key, SDATA (class));
3681 if (!NILP (component))
3683 strcat (class_key, ".");
3684 strcat (class_key, SDATA (subclass));
3686 strcat (name_key, ".");
3687 strcat (name_key, SDATA (component));
3690 strcat (name_key, ".");
3691 strcat (name_key, SDATA (attribute));
3693 value = x_get_string_resource (rdb, name_key, class_key);
3695 if (value != (char *) 0 && *value)
3696 return build_string (value);
3697 else
3698 return Qnil;
3702 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
3703 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
3704 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
3705 class, where INSTANCE is the name under which Emacs was invoked, or
3706 the name specified by the `-name' or `-rn' command-line arguments.
3708 The optional arguments COMPONENT and SUBCLASS add to the key and the
3709 class, respectively. You must specify both of them or neither.
3710 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
3711 and the class is `Emacs.CLASS.SUBCLASS'. */)
3712 (Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3714 #ifdef HAVE_X_WINDOWS
3715 check_x ();
3716 #endif
3718 return xrdb_get_resource (check_x_display_info (Qnil)->xrdb,
3719 attribute, class, component, subclass);
3722 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
3724 Lisp_Object
3725 display_x_get_resource (Display_Info *dpyinfo, Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3727 return xrdb_get_resource (dpyinfo->xrdb,
3728 attribute, class, component, subclass);
3731 #if defined HAVE_X_WINDOWS && !defined USE_X_TOOLKIT
3732 /* Used when C code wants a resource value. */
3733 /* Called from oldXMenu/Create.c. */
3734 char *
3735 x_get_resource_string (const char *attribute, const char *class)
3737 char *name_key;
3738 char *class_key;
3739 struct frame *sf = SELECTED_FRAME ();
3741 /* Allocate space for the components, the dots which separate them,
3742 and the final '\0'. */
3743 name_key = (char *) alloca (SBYTES (Vinvocation_name)
3744 + strlen (attribute) + 2);
3745 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
3746 + strlen (class) + 2);
3748 sprintf (name_key, "%s.%s", SDATA (Vinvocation_name), attribute);
3749 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3751 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
3752 name_key, class_key);
3754 #endif
3756 /* Return the value of parameter PARAM.
3758 First search ALIST, then Vdefault_frame_alist, then the X defaults
3759 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3761 Convert the resource to the type specified by desired_type.
3763 If no default is specified, return Qunbound. If you call
3764 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3765 and don't let it get stored in any Lisp-visible variables! */
3767 Lisp_Object
3768 x_get_arg (Display_Info *dpyinfo, Lisp_Object alist, Lisp_Object param,
3769 const char *attribute, const char *class, enum resource_types type)
3771 register Lisp_Object tem;
3773 tem = Fassq (param, alist);
3775 if (!NILP (tem))
3777 /* If we find this parm in ALIST, clear it out
3778 so that it won't be "left over" at the end. */
3779 Lisp_Object tail;
3780 XSETCAR (tem, Qnil);
3781 /* In case the parameter appears more than once in the alist,
3782 clear it out. */
3783 for (tail = alist; CONSP (tail); tail = XCDR (tail))
3784 if (CONSP (XCAR (tail))
3785 && EQ (XCAR (XCAR (tail)), param))
3786 XSETCAR (XCAR (tail), Qnil);
3788 else
3789 tem = Fassq (param, Vdefault_frame_alist);
3791 /* If it wasn't specified in ALIST or the Lisp-level defaults,
3792 look in the X resources. */
3793 if (EQ (tem, Qnil))
3795 if (attribute && dpyinfo)
3797 tem = display_x_get_resource (dpyinfo,
3798 build_string (attribute),
3799 build_string (class),
3800 Qnil, Qnil);
3802 if (NILP (tem))
3803 return Qunbound;
3805 switch (type)
3807 case RES_TYPE_NUMBER:
3808 return make_number (atoi (SDATA (tem)));
3810 case RES_TYPE_BOOLEAN_NUMBER:
3811 if (!strcmp (SDATA (tem), "on")
3812 || !strcmp (SDATA (tem), "true"))
3813 return make_number (1);
3814 return make_number (atoi (SDATA (tem)));
3815 break;
3817 case RES_TYPE_FLOAT:
3818 return make_float (atof (SDATA (tem)));
3820 case RES_TYPE_BOOLEAN:
3821 tem = Fdowncase (tem);
3822 if (!strcmp (SDATA (tem), "on")
3823 #ifdef HAVE_NS
3824 || !strcmp(SDATA(tem), "yes")
3825 #endif
3826 || !strcmp (SDATA (tem), "true"))
3827 return Qt;
3828 else
3829 return Qnil;
3831 case RES_TYPE_STRING:
3832 return tem;
3834 case RES_TYPE_SYMBOL:
3835 /* As a special case, we map the values `true' and `on'
3836 to Qt, and `false' and `off' to Qnil. */
3838 Lisp_Object lower;
3839 lower = Fdowncase (tem);
3840 if (!strcmp (SDATA (lower), "on")
3841 #ifdef HAVE_NS
3842 || !strcmp(SDATA(lower), "yes")
3843 #endif
3844 || !strcmp (SDATA (lower), "true"))
3845 return Qt;
3846 else if (!strcmp (SDATA (lower), "off")
3847 #ifdef HAVE_NS
3848 || !strcmp(SDATA(lower), "no")
3849 #endif
3850 || !strcmp (SDATA (lower), "false"))
3851 return Qnil;
3852 else
3853 return Fintern (tem, Qnil);
3856 default:
3857 abort ();
3860 else
3861 return Qunbound;
3863 return Fcdr (tem);
3866 Lisp_Object
3867 x_frame_get_arg (struct frame *f, Lisp_Object alist, Lisp_Object param,
3868 const char *attribute, const char *class,
3869 enum resource_types type)
3871 return x_get_arg (FRAME_X_DISPLAY_INFO (f),
3872 alist, param, attribute, class, type);
3875 /* Like x_frame_get_arg, but also record the value in f->param_alist. */
3877 Lisp_Object
3878 x_frame_get_and_record_arg (struct frame *f, Lisp_Object alist,
3879 Lisp_Object param,
3880 const char *attribute, const char *class,
3881 enum resource_types type)
3883 Lisp_Object value;
3885 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
3886 attribute, class, type);
3887 if (! NILP (value) && ! EQ (value, Qunbound))
3888 store_frame_param (f, param, value);
3890 return value;
3894 /* Record in frame F the specified or default value according to ALIST
3895 of the parameter named PROP (a Lisp symbol).
3896 If no value is specified for PROP, look for an X default for XPROP
3897 on the frame named NAME.
3898 If that is not found either, use the value DEFLT. */
3900 Lisp_Object
3901 x_default_parameter (struct frame *f, Lisp_Object alist, Lisp_Object prop,
3902 Lisp_Object deflt, const char *xprop, const char *xclass,
3903 enum resource_types type)
3905 Lisp_Object tem;
3907 tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type);
3908 if (EQ (tem, Qunbound))
3909 tem = deflt;
3910 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
3911 return tem;
3917 /* NS used to define x-parse-geometry in ns-win.el, but that confused
3918 make-docfile: the documentation string in ns-win.el was used for
3919 x-parse-geometry even in non-NS builds.
3921 With two definitions of x-parse-geometry in this file, various
3922 things still get confused (eg M-x apropos documentation), so that
3923 it is best if the two definitions just share the same doc-string.
3925 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
3926 doc: /* Parse a display geometry string STRING.
3927 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3928 The properties returned may include `top', `left', `height', and `width'.
3929 For X, the value of `left' or `top' may be an integer,
3930 or a list (+ N) meaning N pixels relative to top/left corner,
3931 or a list (- N) meaning -N pixels relative to bottom/right corner.
3932 On Nextstep, this just calls `ns-parse-geometry'. */)
3933 (Lisp_Object string)
3935 #ifdef HAVE_NS
3936 call1 (Qns_parse_geometry, string);
3937 #else
3938 int geometry, x, y;
3939 unsigned int width, height;
3940 Lisp_Object result;
3942 CHECK_STRING (string);
3944 geometry = XParseGeometry ((char *) SDATA (string),
3945 &x, &y, &width, &height);
3946 result = Qnil;
3947 if (geometry & XValue)
3949 Lisp_Object element;
3951 if (x >= 0 && (geometry & XNegative))
3952 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
3953 else if (x < 0 && ! (geometry & XNegative))
3954 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
3955 else
3956 element = Fcons (Qleft, make_number (x));
3957 result = Fcons (element, result);
3960 if (geometry & YValue)
3962 Lisp_Object element;
3964 if (y >= 0 && (geometry & YNegative))
3965 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
3966 else if (y < 0 && ! (geometry & YNegative))
3967 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
3968 else
3969 element = Fcons (Qtop, make_number (y));
3970 result = Fcons (element, result);
3973 if (geometry & WidthValue)
3974 result = Fcons (Fcons (Qwidth, make_number (width)), result);
3975 if (geometry & HeightValue)
3976 result = Fcons (Fcons (Qheight, make_number (height)), result);
3978 return result;
3979 #endif /* HAVE_NS */
3983 /* Calculate the desired size and position of frame F.
3984 Return the flags saying which aspects were specified.
3986 Also set the win_gravity and size_hint_flags of F.
3988 Adjust height for toolbar if TOOLBAR_P is 1.
3990 This function does not make the coordinates positive. */
3992 #define DEFAULT_ROWS 35
3993 #define DEFAULT_COLS 80
3996 x_figure_window_size (struct frame *f, Lisp_Object parms, int toolbar_p)
3998 register Lisp_Object tem0, tem1, tem2;
3999 long window_prompting = 0;
4000 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
4002 /* Default values if we fall through.
4003 Actually, if that happens we should get
4004 window manager prompting. */
4005 SET_FRAME_COLS (f, DEFAULT_COLS);
4006 FRAME_LINES (f) = DEFAULT_ROWS;
4007 /* Window managers expect that if program-specified
4008 positions are not (0,0), they're intentional, not defaults. */
4009 f->top_pos = 0;
4010 f->left_pos = 0;
4012 /* Ensure that old new_text_cols and new_text_lines will not override the
4013 values set here. */
4014 /* ++KFS: This was specific to W32, but seems ok for all platforms */
4015 f->new_text_cols = f->new_text_lines = 0;
4017 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
4018 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
4019 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
4020 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4022 if (!EQ (tem0, Qunbound))
4024 CHECK_NUMBER (tem0);
4025 FRAME_LINES (f) = XINT (tem0);
4027 if (!EQ (tem1, Qunbound))
4029 CHECK_NUMBER (tem1);
4030 SET_FRAME_COLS (f, XINT (tem1));
4032 if (!NILP (tem2) && !EQ (tem2, Qunbound))
4033 window_prompting |= USSize;
4034 else
4035 window_prompting |= PSize;
4038 f->scroll_bar_actual_width
4039 = FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f);
4041 /* This used to be done _before_ calling x_figure_window_size, but
4042 since the height is reset here, this was really a no-op. I
4043 assume that moving it here does what Gerd intended (although he
4044 no longer can remember what that was... ++KFS, 2003-03-25. */
4046 /* Add the tool-bar height to the initial frame height so that the
4047 user gets a text display area of the size he specified with -g or
4048 via .Xdefaults. Later changes of the tool-bar height don't
4049 change the frame size. This is done so that users can create
4050 tall Emacs frames without having to guess how tall the tool-bar
4051 will get. */
4052 if (toolbar_p && FRAME_TOOL_BAR_LINES (f))
4054 int margin, relief, bar_height;
4056 relief = (tool_bar_button_relief >= 0
4057 ? tool_bar_button_relief
4058 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
4060 if (INTEGERP (Vtool_bar_button_margin)
4061 && XINT (Vtool_bar_button_margin) > 0)
4062 margin = XFASTINT (Vtool_bar_button_margin);
4063 else if (CONSP (Vtool_bar_button_margin)
4064 && INTEGERP (XCDR (Vtool_bar_button_margin))
4065 && XINT (XCDR (Vtool_bar_button_margin)) > 0)
4066 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
4067 else
4068 margin = 0;
4070 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
4071 FRAME_LINES (f) += (bar_height + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f);
4074 compute_fringe_widths (f, 0);
4076 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, FRAME_COLS (f));
4077 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, FRAME_LINES (f));
4079 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
4080 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
4081 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
4082 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4084 if (EQ (tem0, Qminus))
4086 f->top_pos = 0;
4087 window_prompting |= YNegative;
4089 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
4090 && CONSP (XCDR (tem0))
4091 && INTEGERP (XCAR (XCDR (tem0))))
4093 f->top_pos = - XINT (XCAR (XCDR (tem0)));
4094 window_prompting |= YNegative;
4096 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
4097 && CONSP (XCDR (tem0))
4098 && INTEGERP (XCAR (XCDR (tem0))))
4100 f->top_pos = XINT (XCAR (XCDR (tem0)));
4102 else if (EQ (tem0, Qunbound))
4103 f->top_pos = 0;
4104 else
4106 CHECK_NUMBER (tem0);
4107 f->top_pos = XINT (tem0);
4108 if (f->top_pos < 0)
4109 window_prompting |= YNegative;
4112 if (EQ (tem1, Qminus))
4114 f->left_pos = 0;
4115 window_prompting |= XNegative;
4117 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
4118 && CONSP (XCDR (tem1))
4119 && INTEGERP (XCAR (XCDR (tem1))))
4121 f->left_pos = - XINT (XCAR (XCDR (tem1)));
4122 window_prompting |= XNegative;
4124 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
4125 && CONSP (XCDR (tem1))
4126 && INTEGERP (XCAR (XCDR (tem1))))
4128 f->left_pos = XINT (XCAR (XCDR (tem1)));
4130 else if (EQ (tem1, Qunbound))
4131 f->left_pos = 0;
4132 else
4134 CHECK_NUMBER (tem1);
4135 f->left_pos = XINT (tem1);
4136 if (f->left_pos < 0)
4137 window_prompting |= XNegative;
4140 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
4141 window_prompting |= USPosition;
4142 else
4143 window_prompting |= PPosition;
4146 if (window_prompting & XNegative)
4148 if (window_prompting & YNegative)
4149 f->win_gravity = SouthEastGravity;
4150 else
4151 f->win_gravity = NorthEastGravity;
4153 else
4155 if (window_prompting & YNegative)
4156 f->win_gravity = SouthWestGravity;
4157 else
4158 f->win_gravity = NorthWestGravity;
4161 f->size_hint_flags = window_prompting;
4163 return window_prompting;
4168 #endif /* HAVE_WINDOW_SYSTEM */
4170 void
4171 frame_make_pointer_invisible (void)
4173 if (! NILP (Vmake_pointer_invisible))
4175 struct frame *f;
4176 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4177 return;
4179 f = SELECTED_FRAME ();
4180 if (f && !f->pointer_invisible
4181 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4183 f->mouse_moved = 0;
4184 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 1);
4185 f->pointer_invisible = 1;
4190 void
4191 frame_make_pointer_visible (void)
4193 /* We don't check Vmake_pointer_invisible here in case the
4194 pointer was invisible when Vmake_pointer_invisible was set to nil. */
4195 struct frame *f;
4197 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4198 return;
4200 f = SELECTED_FRAME ();
4201 if (f && f->pointer_invisible && f->mouse_moved
4202 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4204 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 0);
4205 f->pointer_invisible = 0;
4211 /***********************************************************************
4212 Initialization
4213 ***********************************************************************/
4215 void
4216 syms_of_frame (void)
4218 Qframep = intern_c_string ("framep");
4219 staticpro (&Qframep);
4220 Qframe_live_p = intern_c_string ("frame-live-p");
4221 staticpro (&Qframe_live_p);
4222 Qexplicit_name = intern_c_string ("explicit-name");
4223 staticpro (&Qexplicit_name);
4224 Qheight = intern_c_string ("height");
4225 staticpro (&Qheight);
4226 Qicon = intern_c_string ("icon");
4227 staticpro (&Qicon);
4228 Qminibuffer = intern_c_string ("minibuffer");
4229 staticpro (&Qminibuffer);
4230 Qmodeline = intern_c_string ("modeline");
4231 staticpro (&Qmodeline);
4232 Qonly = intern_c_string ("only");
4233 staticpro (&Qonly);
4234 Qwidth = intern_c_string ("width");
4235 staticpro (&Qwidth);
4236 Qgeometry = intern_c_string ("geometry");
4237 staticpro (&Qgeometry);
4238 Qicon_left = intern_c_string ("icon-left");
4239 staticpro (&Qicon_left);
4240 Qicon_top = intern_c_string ("icon-top");
4241 staticpro (&Qicon_top);
4242 Qtooltip = intern_c_string ("tooltip");
4243 staticpro (&Qtooltip);
4244 Qleft = intern_c_string ("left");
4245 staticpro (&Qleft);
4246 Qright = intern_c_string ("right");
4247 staticpro (&Qright);
4248 Quser_position = intern_c_string ("user-position");
4249 staticpro (&Quser_position);
4250 Quser_size = intern_c_string ("user-size");
4251 staticpro (&Quser_size);
4252 Qwindow_id = intern_c_string ("window-id");
4253 staticpro (&Qwindow_id);
4254 #ifdef HAVE_X_WINDOWS
4255 Qouter_window_id = intern_c_string ("outer-window-id");
4256 staticpro (&Qouter_window_id);
4257 #endif
4258 Qparent_id = intern_c_string ("parent-id");
4259 staticpro (&Qparent_id);
4260 Qx = intern_c_string ("x");
4261 staticpro (&Qx);
4262 Qw32 = intern_c_string ("w32");
4263 staticpro (&Qw32);
4264 Qpc = intern_c_string ("pc");
4265 staticpro (&Qpc);
4266 Qmac = intern_c_string ("mac");
4267 staticpro (&Qmac);
4268 Qns = intern_c_string ("ns");
4269 staticpro (&Qns);
4270 Qvisible = intern_c_string ("visible");
4271 staticpro (&Qvisible);
4272 Qbuffer_predicate = intern_c_string ("buffer-predicate");
4273 staticpro (&Qbuffer_predicate);
4274 Qbuffer_list = intern_c_string ("buffer-list");
4275 staticpro (&Qbuffer_list);
4276 Qburied_buffer_list = intern_c_string ("buried-buffer-list");
4277 staticpro (&Qburied_buffer_list);
4278 Qdisplay_type = intern_c_string ("display-type");
4279 staticpro (&Qdisplay_type);
4280 Qbackground_mode = intern_c_string ("background-mode");
4281 staticpro (&Qbackground_mode);
4282 Qnoelisp = intern_c_string ("noelisp");
4283 staticpro (&Qnoelisp);
4284 Qtty_color_mode = intern_c_string ("tty-color-mode");
4285 staticpro (&Qtty_color_mode);
4286 Qtty = intern_c_string ("tty");
4287 staticpro (&Qtty);
4288 Qtty_type = intern_c_string ("tty-type");
4289 staticpro (&Qtty_type);
4291 Qface_set_after_frame_default = intern_c_string ("face-set-after-frame-default");
4292 staticpro (&Qface_set_after_frame_default);
4294 Qfullwidth = intern_c_string ("fullwidth");
4295 staticpro (&Qfullwidth);
4296 Qfullheight = intern_c_string ("fullheight");
4297 staticpro (&Qfullheight);
4298 Qfullboth = intern_c_string ("fullboth");
4299 staticpro (&Qfullboth);
4300 Qmaximized = intern_c_string ("maximized");
4301 staticpro (&Qmaximized);
4302 Qx_resource_name = intern_c_string ("x-resource-name");
4303 staticpro (&Qx_resource_name);
4305 Qx_frame_parameter = intern_c_string ("x-frame-parameter");
4306 staticpro (&Qx_frame_parameter);
4308 Qterminal = intern_c_string ("terminal");
4309 staticpro (&Qterminal);
4310 Qterminal_live_p = intern_c_string ("terminal-live-p");
4311 staticpro (&Qterminal_live_p);
4313 #ifdef HAVE_NS
4314 Qns_parse_geometry = intern_c_string ("ns-parse-geometry");
4315 staticpro (&Qns_parse_geometry);
4316 #endif
4319 int i;
4321 for (i = 0; i < sizeof (frame_parms) / sizeof (frame_parms[0]); i++)
4323 Lisp_Object v = intern_c_string (frame_parms[i].name);
4324 if (frame_parms[i].variable)
4326 *frame_parms[i].variable = v;
4327 staticpro (frame_parms[i].variable);
4329 Fput (v, Qx_frame_parameter, make_number (i));
4333 #ifdef HAVE_WINDOW_SYSTEM
4334 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
4335 doc: /* The name Emacs uses to look up X resources.
4336 `x-get-resource' uses this as the first component of the instance name
4337 when requesting resource values.
4338 Emacs initially sets `x-resource-name' to the name under which Emacs
4339 was invoked, or to the value specified with the `-name' or `-rn'
4340 switches, if present.
4342 It may be useful to bind this variable locally around a call
4343 to `x-get-resource'. See also the variable `x-resource-class'. */);
4344 Vx_resource_name = Qnil;
4346 DEFVAR_LISP ("x-resource-class", &Vx_resource_class,
4347 doc: /* The class Emacs uses to look up X resources.
4348 `x-get-resource' uses this as the first component of the instance class
4349 when requesting resource values.
4351 Emacs initially sets `x-resource-class' to "Emacs".
4353 Setting this variable permanently is not a reasonable thing to do,
4354 but binding this variable locally around a call to `x-get-resource'
4355 is a reasonable practice. See also the variable `x-resource-name'. */);
4356 Vx_resource_class = build_string (EMACS_CLASS);
4358 DEFVAR_LISP ("frame-alpha-lower-limit", &Vframe_alpha_lower_limit,
4359 doc: /* The lower limit of the frame opacity (alpha transparency).
4360 The value should range from 0 (invisible) to 100 (completely opaque).
4361 You can also use a floating number between 0.0 and 1.0.
4362 The default is 20. */);
4363 Vframe_alpha_lower_limit = make_number (20);
4364 #endif
4366 DEFVAR_LISP ("default-frame-alist", &Vdefault_frame_alist,
4367 doc: /* Alist of default values for frame creation.
4368 These may be set in your init file, like this:
4369 (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1)))
4370 These override values given in window system configuration data,
4371 including X Windows' defaults database.
4372 For values specific to the first Emacs frame, see `initial-frame-alist'.
4373 For window-system specific values, see `window-system-default-frame-alist'.
4374 For values specific to the separate minibuffer frame, see
4375 `minibuffer-frame-alist'.
4376 The `menu-bar-lines' element of the list controls whether new frames
4377 have menu bars; `menu-bar-mode' works by altering this element.
4378 Setting this variable does not affect existing frames, only new ones. */);
4379 Vdefault_frame_alist = Qnil;
4381 DEFVAR_LISP ("default-frame-scroll-bars", &Vdefault_frame_scroll_bars,
4382 doc: /* Default position of scroll bars on this window-system. */);
4383 #ifdef HAVE_WINDOW_SYSTEM
4384 #if defined(HAVE_NTGUI) || defined(NS_IMPL_COCOA) || (defined(USE_GTK) && defined(USE_TOOLKIT_SCROLL_BARS))
4385 /* MS-Windows, Mac OS X, and GTK have scroll bars on the right by
4386 default. */
4387 Vdefault_frame_scroll_bars = Qright;
4388 #else
4389 Vdefault_frame_scroll_bars = Qleft;
4390 #endif
4391 #else
4392 Vdefault_frame_scroll_bars = Qnil;
4393 #endif
4395 DEFVAR_LISP ("terminal-frame", &Vterminal_frame,
4396 doc: /* The initial frame-object, which represents Emacs's stdout. */);
4398 DEFVAR_LISP ("mouse-position-function", &Vmouse_position_function,
4399 doc: /* If non-nil, function to transform normal value of `mouse-position'.
4400 `mouse-position' calls this function, passing its usual return value as
4401 argument, and returns whatever this function returns.
4402 This abnormal hook exists for the benefit of packages like `xt-mouse.el'
4403 which need to do mouse handling at the Lisp level. */);
4404 Vmouse_position_function = Qnil;
4406 DEFVAR_LISP ("mouse-highlight", &Vmouse_highlight,
4407 doc: /* If non-nil, clickable text is highlighted when mouse is over it.
4408 If the value is an integer, highlighting is only shown after moving the
4409 mouse, while keyboard input turns off the highlight even when the mouse
4410 is over the clickable text. However, the mouse shape still indicates
4411 when the mouse is over clickable text. */);
4412 Vmouse_highlight = Qt;
4414 DEFVAR_LISP ("make-pointer-invisible", &Vmake_pointer_invisible,
4415 doc: /* If non-nil, make pointer invisible while typing.
4416 The pointer becomes visible again when the mouse is moved. */);
4417 Vmake_pointer_invisible = Qt;
4419 DEFVAR_LISP ("delete-frame-functions", &Vdelete_frame_functions,
4420 doc: /* Functions to be run before deleting a frame.
4421 The functions are run with one arg, the frame to be deleted.
4422 See `delete-frame'.
4424 Note that functions in this list may be called just before the frame is
4425 actually deleted, or some time later (or even both when an earlier function
4426 in `delete-frame-functions' (indirectly) calls `delete-frame'
4427 recursively). */);
4428 Vdelete_frame_functions = Qnil;
4429 Qdelete_frame_functions = intern_c_string ("delete-frame-functions");
4430 staticpro (&Qdelete_frame_functions);
4432 DEFVAR_LISP ("menu-bar-mode", &Vmenu_bar_mode,
4433 doc: /* Non-nil if Menu-Bar mode is enabled. */);
4434 Vmenu_bar_mode = Qt;
4436 DEFVAR_LISP ("tool-bar-mode", &Vtool_bar_mode,
4437 doc: /* Non-nil if Tool-Bar mode is enabled. */);
4438 Vtool_bar_mode = Qt;
4440 DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
4441 doc: /* Minibufferless frames use this frame's minibuffer.
4443 Emacs cannot create minibufferless frames unless this is set to an
4444 appropriate surrogate.
4446 Emacs consults this variable only when creating minibufferless
4447 frames; once the frame is created, it sticks with its assigned
4448 minibuffer, no matter what this variable is set to. This means that
4449 this variable doesn't necessarily say anything meaningful about the
4450 current set of frames, or where the minibuffer is currently being
4451 displayed.
4453 This variable is local to the current terminal and cannot be buffer-local. */);
4455 DEFVAR_BOOL ("focus-follows-mouse", &focus_follows_mouse,
4456 doc: /* Non-nil if window system changes focus when you move the mouse.
4457 You should set this variable to tell Emacs how your window manager
4458 handles focus, since there is no way in general for Emacs to find out
4459 automatically. See also `mouse-autoselect-window'. */);
4460 #ifdef HAVE_WINDOW_SYSTEM
4461 #if defined(HAVE_NTGUI) || defined(HAVE_NS)
4462 focus_follows_mouse = 0;
4463 #else
4464 focus_follows_mouse = 1;
4465 #endif
4466 #else
4467 focus_follows_mouse = 0;
4468 #endif
4470 staticpro (&Vframe_list);
4472 defsubr (&Sframep);
4473 defsubr (&Sframe_live_p);
4474 defsubr (&Swindow_system);
4475 defsubr (&Smake_terminal_frame);
4476 defsubr (&Shandle_switch_frame);
4477 defsubr (&Sselect_frame);
4478 defsubr (&Sselected_frame);
4479 defsubr (&Sframe_list);
4480 defsubr (&Snext_frame);
4481 defsubr (&Sprevious_frame);
4482 defsubr (&Sother_visible_frames_p);
4483 defsubr (&Sdelete_frame);
4484 defsubr (&Smouse_position);
4485 defsubr (&Smouse_pixel_position);
4486 defsubr (&Sset_mouse_position);
4487 defsubr (&Sset_mouse_pixel_position);
4488 #if 0
4489 defsubr (&Sframe_configuration);
4490 defsubr (&Srestore_frame_configuration);
4491 #endif
4492 defsubr (&Smake_frame_visible);
4493 defsubr (&Smake_frame_invisible);
4494 defsubr (&Siconify_frame);
4495 defsubr (&Sframe_visible_p);
4496 defsubr (&Svisible_frame_list);
4497 defsubr (&Sraise_frame);
4498 defsubr (&Slower_frame);
4499 defsubr (&Sredirect_frame_focus);
4500 defsubr (&Sframe_focus);
4501 defsubr (&Sframe_parameters);
4502 defsubr (&Sframe_parameter);
4503 defsubr (&Smodify_frame_parameters);
4504 defsubr (&Sframe_char_height);
4505 defsubr (&Sframe_char_width);
4506 defsubr (&Sframe_pixel_height);
4507 defsubr (&Sframe_pixel_width);
4508 defsubr (&Sset_frame_height);
4509 defsubr (&Sset_frame_width);
4510 defsubr (&Sset_frame_size);
4511 defsubr (&Sset_frame_position);
4513 #ifdef HAVE_WINDOW_SYSTEM
4514 defsubr (&Sx_get_resource);
4515 defsubr (&Sx_parse_geometry);
4516 #endif
4520 /* arch-tag: 7dbf2c69-9aad-45f8-8296-db893d6dd039
4521 (do not change this comment) */