lisp/net/gnutls.el (gnutls-errorp): Declare before first use.
[emacs.git] / src / frame.c
blob9024a2fb5e22353fe1b4294c462babcf622c7a21
1 /* Generic frame functions.
3 Copyright (C) 1993-1995, 1997, 1999-2011 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20 #include <config.h>
22 #include <stdio.h>
23 #include <ctype.h>
24 #include <errno.h>
25 #include <limits.h>
26 #include <setjmp.h>
27 #include "lisp.h"
28 #include "character.h"
29 #ifdef HAVE_X_WINDOWS
30 #include "xterm.h"
31 #endif
32 #ifdef WINDOWSNT
33 #include "w32term.h"
34 #endif
35 #ifdef HAVE_NS
36 #include "nsterm.h"
37 #endif
38 #include "buffer.h"
39 /* These help us bind and responding to switch-frame events. */
40 #include "commands.h"
41 #include "keyboard.h"
42 #include "frame.h"
43 #include "blockinput.h"
44 #include "termchar.h"
45 #include "termhooks.h"
46 #include "dispextern.h"
47 #include "window.h"
48 #include "font.h"
49 #ifdef HAVE_WINDOW_SYSTEM
50 #include "fontset.h"
51 #endif
52 #ifdef MSDOS
53 #include "msdos.h"
54 #include "dosfns.h"
55 #endif
58 #ifdef HAVE_WINDOW_SYSTEM
60 #endif
62 #ifdef HAVE_NS
63 Lisp_Object Qns_parse_geometry;
64 #endif
66 Lisp_Object Qframep, Qframe_live_p;
67 Lisp_Object Qicon, Qmodeline;
68 Lisp_Object Qonly;
69 Lisp_Object Qx, Qw32, Qmac, Qpc, Qns;
70 Lisp_Object Qvisible;
71 Lisp_Object Qdisplay_type;
72 static Lisp_Object Qbackground_mode;
73 Lisp_Object Qnoelisp;
75 static Lisp_Object Qx_frame_parameter;
76 Lisp_Object Qx_resource_name;
77 Lisp_Object Qterminal;
78 Lisp_Object Qterminal_live_p;
80 /* Frame parameters (set or reported). */
82 Lisp_Object Qauto_raise, Qauto_lower;
83 Lisp_Object Qborder_color, Qborder_width;
84 Lisp_Object Qcursor_color, Qcursor_type;
85 static Lisp_Object Qgeometry; /* Not used */
86 Lisp_Object Qheight, Qwidth;
87 Lisp_Object Qleft, Qright;
88 Lisp_Object Qicon_left, Qicon_top, Qicon_type, Qicon_name;
89 Lisp_Object Qtooltip;
90 Lisp_Object Qinternal_border_width;
91 Lisp_Object Qmouse_color;
92 Lisp_Object Qminibuffer;
93 Lisp_Object Qscroll_bar_width, Qvertical_scroll_bars;
94 Lisp_Object Qvisibility;
95 Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
96 Lisp_Object Qscreen_gamma;
97 Lisp_Object Qline_spacing;
98 static Lisp_Object Quser_position, Quser_size;
99 Lisp_Object Qwait_for_wm;
100 static Lisp_Object Qwindow_id;
101 #ifdef HAVE_X_WINDOWS
102 static Lisp_Object Qouter_window_id;
103 #endif
104 Lisp_Object Qparent_id;
105 Lisp_Object Qtitle, Qname;
106 static Lisp_Object Qexplicit_name;
107 Lisp_Object Qunsplittable;
108 Lisp_Object Qmenu_bar_lines, Qtool_bar_lines, Qtool_bar_position;
109 Lisp_Object Qleft_fringe, Qright_fringe;
110 Lisp_Object Qbuffer_predicate;
111 static Lisp_Object Qbuffer_list, Qburied_buffer_list;
112 Lisp_Object Qtty_color_mode;
113 Lisp_Object Qtty, Qtty_type;
115 Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth, Qmaximized;
116 Lisp_Object Qsticky;
117 Lisp_Object Qfont_backend;
118 Lisp_Object Qalpha;
120 Lisp_Object Qface_set_after_frame_default;
122 static Lisp_Object Qdelete_frame_functions;
124 #ifdef HAVE_WINDOW_SYSTEM
125 static void x_report_frame_params (struct frame *, Lisp_Object *);
126 #endif
129 static void
130 set_menu_bar_lines_1 (Lisp_Object window, int n)
132 struct window *w = XWINDOW (window);
134 XSETFASTINT (w->last_modified, 0);
135 XSETFASTINT (w->top_line, XFASTINT (w->top_line) + n);
136 XSETFASTINT (w->total_lines, XFASTINT (w->total_lines) - n);
138 if (INTEGERP (w->orig_top_line))
139 XSETFASTINT (w->orig_top_line, XFASTINT (w->orig_top_line) + n);
140 if (INTEGERP (w->orig_total_lines))
141 XSETFASTINT (w->orig_total_lines, XFASTINT (w->orig_total_lines) - n);
143 /* Handle just the top child in a vertical split. */
144 if (!NILP (w->vchild))
145 set_menu_bar_lines_1 (w->vchild, n);
147 /* Adjust all children in a horizontal split. */
148 for (window = w->hchild; !NILP (window); window = w->next)
150 w = XWINDOW (window);
151 set_menu_bar_lines_1 (window, n);
155 void
156 set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
158 int nlines;
159 int olines = FRAME_MENU_BAR_LINES (f);
161 /* Right now, menu bars don't work properly in minibuf-only frames;
162 most of the commands try to apply themselves to the minibuffer
163 frame itself, and get an error because you can't switch buffers
164 in or split the minibuffer window. */
165 if (FRAME_MINIBUF_ONLY_P (f))
166 return;
168 if (INTEGERP (value))
169 nlines = XINT (value);
170 else
171 nlines = 0;
173 if (nlines != olines)
175 windows_or_buffers_changed++;
176 FRAME_WINDOW_SIZES_CHANGED (f) = 1;
177 FRAME_MENU_BAR_LINES (f) = nlines;
178 set_menu_bar_lines_1 (f->root_window, nlines - olines);
179 adjust_glyphs (f);
183 Lisp_Object Vframe_list;
186 DEFUN ("framep", Fframep, Sframep, 1, 1, 0,
187 doc: /* Return non-nil if OBJECT is a frame.
188 Value is:
189 t for a termcap frame (a character-only terminal),
190 'x' for an Emacs frame that is really an X window,
191 'w32' for an Emacs frame that is a window on MS-Windows display,
192 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
193 'pc' for a direct-write MS-DOS frame.
194 See also `frame-live-p'. */)
195 (Lisp_Object object)
197 if (!FRAMEP (object))
198 return Qnil;
199 switch (XFRAME (object)->output_method)
201 case output_initial: /* The initial frame is like a termcap frame. */
202 case output_termcap:
203 return Qt;
204 case output_x_window:
205 return Qx;
206 case output_w32:
207 return Qw32;
208 case output_msdos_raw:
209 return Qpc;
210 case output_mac:
211 return Qmac;
212 case output_ns:
213 return Qns;
214 default:
215 abort ();
219 DEFUN ("frame-live-p", Fframe_live_p, Sframe_live_p, 1, 1, 0,
220 doc: /* Return non-nil if OBJECT is a frame which has not been deleted.
221 Value is nil if OBJECT is not a live frame. If object is a live
222 frame, the return value indicates what sort of terminal device it is
223 displayed on. See the documentation of `framep' for possible
224 return values. */)
225 (Lisp_Object object)
227 return ((FRAMEP (object)
228 && FRAME_LIVE_P (XFRAME (object)))
229 ? Fframep (object)
230 : Qnil);
233 DEFUN ("window-system", Fwindow_system, Swindow_system, 0, 1, 0,
234 doc: /* The name of the window system that FRAME is displaying through.
235 The value is a symbol:
236 nil for a termcap frame (a character-only terminal),
237 'x' for an Emacs frame that is really an X window,
238 'w32' for an Emacs frame that is a window on MS-Windows display,
239 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
240 'pc' for a direct-write MS-DOS frame.
242 FRAME defaults to the currently selected frame.
244 Use of this function as a predicate is deprecated. Instead,
245 use `display-graphic-p' or any of the other `display-*-p'
246 predicates which report frame's specific UI-related capabilities. */)
247 (Lisp_Object frame)
249 Lisp_Object type;
250 if (NILP (frame))
251 frame = selected_frame;
253 type = Fframep (frame);
255 if (NILP (type))
256 wrong_type_argument (Qframep, frame);
258 if (EQ (type, Qt))
259 return Qnil;
260 else
261 return type;
264 struct frame *
265 make_frame (int mini_p)
267 Lisp_Object frame;
268 register struct frame *f;
269 register Lisp_Object root_window;
270 register Lisp_Object mini_window;
272 f = allocate_frame ();
273 XSETFRAME (frame, f);
275 f->desired_matrix = 0;
276 f->current_matrix = 0;
277 f->desired_pool = 0;
278 f->current_pool = 0;
279 f->glyphs_initialized_p = 0;
280 f->decode_mode_spec_buffer = 0;
281 f->visible = 0;
282 f->async_visible = 0;
283 f->output_data.nothing = 0;
284 f->iconified = 0;
285 f->async_iconified = 0;
286 f->wants_modeline = 1;
287 f->auto_raise = 0;
288 f->auto_lower = 0;
289 f->no_split = 0;
290 f->garbaged = 1;
291 f->has_minibuffer = mini_p;
292 f->focus_frame = Qnil;
293 f->explicit_name = 0;
294 f->can_have_scroll_bars = 0;
295 f->vertical_scroll_bar_type = vertical_scroll_bar_none;
296 f->param_alist = Qnil;
297 f->scroll_bars = Qnil;
298 f->condemned_scroll_bars = Qnil;
299 f->face_alist = Qnil;
300 f->face_cache = NULL;
301 f->menu_bar_items = Qnil;
302 f->menu_bar_vector = Qnil;
303 f->menu_bar_items_used = 0;
304 f->buffer_predicate = Qnil;
305 f->buffer_list = Qnil;
306 f->buried_buffer_list = Qnil;
307 f->namebuf = 0;
308 f->title = Qnil;
309 f->menu_bar_window = Qnil;
310 f->tool_bar_window = Qnil;
311 f->tool_bar_items = Qnil;
312 f->tool_bar_position = Qtop;
313 f->desired_tool_bar_string = f->current_tool_bar_string = Qnil;
314 f->n_tool_bar_items = 0;
315 f->left_fringe_width = f->right_fringe_width = 0;
316 f->fringe_cols = 0;
317 f->menu_bar_lines = 0;
318 f->tool_bar_lines = 0;
319 f->scroll_bar_actual_width = 0;
320 f->border_width = 0;
321 f->internal_border_width = 0;
322 f->column_width = 1; /* !FRAME_WINDOW_P value */
323 f->line_height = 1; /* !FRAME_WINDOW_P value */
324 f->x_pixels_diff = f->y_pixels_diff = 0;
325 #ifdef HAVE_WINDOW_SYSTEM
326 f->want_fullscreen = FULLSCREEN_NONE;
327 #endif
328 f->size_hint_flags = 0;
329 f->win_gravity = 0;
330 f->font_driver_list = NULL;
331 f->font_data_list = NULL;
333 root_window = make_window ();
334 if (mini_p)
336 mini_window = make_window ();
337 XWINDOW (root_window)->next = mini_window;
338 XWINDOW (mini_window)->prev = root_window;
339 XWINDOW (mini_window)->mini_p = Qt;
340 XWINDOW (mini_window)->frame = frame;
341 f->minibuffer_window = mini_window;
343 else
345 mini_window = Qnil;
346 XWINDOW (root_window)->next = Qnil;
347 f->minibuffer_window = Qnil;
350 XWINDOW (root_window)->frame = frame;
352 /* 10 is arbitrary,
353 just so that there is "something there."
354 Correct size will be set up later with change_frame_size. */
356 SET_FRAME_COLS (f, 10);
357 FRAME_LINES (f) = 10;
359 XSETFASTINT (XWINDOW (root_window)->total_cols, 10);
360 XSETFASTINT (XWINDOW (root_window)->total_lines, (mini_p ? 9 : 10));
362 if (mini_p)
364 XSETFASTINT (XWINDOW (mini_window)->total_cols, 10);
365 XSETFASTINT (XWINDOW (mini_window)->top_line, 9);
366 XSETFASTINT (XWINDOW (mini_window)->total_lines, 1);
369 /* Choose a buffer for the frame's root window. */
371 Lisp_Object buf;
373 XWINDOW (root_window)->buffer = Qt;
374 buf = Fcurrent_buffer ();
375 /* If buf is a 'hidden' buffer (i.e. one whose name starts with
376 a space), try to find another one. */
377 if (SREF (Fbuffer_name (buf), 0) == ' ')
378 buf = Fother_buffer (buf, Qnil, Qnil);
380 /* Use set_window_buffer, not Fset_window_buffer, and don't let
381 hooks be run by it. The reason is that the whole frame/window
382 arrangement is not yet fully intialized at this point. Windows
383 don't have the right size, glyph matrices aren't initialized
384 etc. Running Lisp functions at this point surely ends in a
385 SEGV. */
386 set_window_buffer (root_window, buf, 0, 0);
387 f->buffer_list = Fcons (buf, Qnil);
390 if (mini_p)
392 XWINDOW (mini_window)->buffer = Qt;
393 set_window_buffer (mini_window,
394 (NILP (Vminibuffer_list)
395 ? get_minibuffer (0)
396 : Fcar (Vminibuffer_list)),
397 0, 0);
400 f->root_window = root_window;
401 f->selected_window = root_window;
402 /* Make sure this window seems more recently used than
403 a newly-created, never-selected window. */
404 ++window_select_count;
405 XSETFASTINT (XWINDOW (f->selected_window)->use_time, window_select_count);
407 f->default_face_done_p = 0;
409 return f;
412 #ifdef HAVE_WINDOW_SYSTEM
413 /* Make a frame using a separate minibuffer window on another frame.
414 MINI_WINDOW is the minibuffer window to use. nil means use the
415 default (the global minibuffer). */
417 struct frame *
418 make_frame_without_minibuffer (register Lisp_Object mini_window, KBOARD *kb, Lisp_Object display)
420 register struct frame *f;
421 struct gcpro gcpro1;
423 if (!NILP (mini_window))
424 CHECK_LIVE_WINDOW (mini_window);
426 if (!NILP (mini_window)
427 && FRAME_KBOARD (XFRAME (XWINDOW (mini_window)->frame)) != kb)
428 error ("Frame and minibuffer must be on the same terminal");
430 /* Make a frame containing just a root window. */
431 f = make_frame (0);
433 if (NILP (mini_window))
435 /* Use default-minibuffer-frame if possible. */
436 if (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
437 || ! FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))
439 Lisp_Object frame_dummy;
441 XSETFRAME (frame_dummy, f);
442 GCPRO1 (frame_dummy);
443 /* If there's no minibuffer frame to use, create one. */
444 KVAR (kb, Vdefault_minibuffer_frame) =
445 call1 (intern ("make-initial-minibuffer-frame"), display);
446 UNGCPRO;
449 mini_window = XFRAME (KVAR (kb, Vdefault_minibuffer_frame))->minibuffer_window;
452 f->minibuffer_window = mini_window;
454 /* Make the chosen minibuffer window display the proper minibuffer,
455 unless it is already showing a minibuffer. */
456 if (NILP (Fmemq (XWINDOW (mini_window)->buffer, Vminibuffer_list)))
457 Fset_window_buffer (mini_window,
458 (NILP (Vminibuffer_list)
459 ? get_minibuffer (0)
460 : Fcar (Vminibuffer_list)), Qnil);
461 return f;
464 /* Make a frame containing only a minibuffer window. */
466 struct frame *
467 make_minibuffer_frame (void)
469 /* First make a frame containing just a root window, no minibuffer. */
471 register struct frame *f = make_frame (0);
472 register Lisp_Object mini_window;
473 register Lisp_Object frame;
475 XSETFRAME (frame, f);
477 f->auto_raise = 0;
478 f->auto_lower = 0;
479 f->no_split = 1;
480 f->wants_modeline = 0;
481 f->has_minibuffer = 1;
483 /* Now label the root window as also being the minibuffer.
484 Avoid infinite looping on the window chain by marking next pointer
485 as nil. */
487 mini_window = f->minibuffer_window = f->root_window;
488 XWINDOW (mini_window)->mini_p = Qt;
489 XWINDOW (mini_window)->next = Qnil;
490 XWINDOW (mini_window)->prev = Qnil;
491 XWINDOW (mini_window)->frame = frame;
493 /* Put the proper buffer in that window. */
495 Fset_window_buffer (mini_window,
496 (NILP (Vminibuffer_list)
497 ? get_minibuffer (0)
498 : Fcar (Vminibuffer_list)), Qnil);
499 return f;
501 #endif /* HAVE_WINDOW_SYSTEM */
503 /* Construct a frame that refers to a terminal. */
505 static int tty_frame_count;
507 struct frame *
508 make_initial_frame (void)
510 struct frame *f;
511 struct terminal *terminal;
512 Lisp_Object frame;
514 eassert (initial_kboard);
516 /* The first call must initialize Vframe_list. */
517 if (! (NILP (Vframe_list) || CONSP (Vframe_list)))
518 Vframe_list = Qnil;
520 terminal = init_initial_terminal ();
522 f = make_frame (1);
523 XSETFRAME (frame, f);
525 Vframe_list = Fcons (frame, Vframe_list);
527 tty_frame_count = 1;
528 f->name = make_pure_c_string ("F1");
530 f->visible = 1;
531 f->async_visible = 1;
533 f->output_method = terminal->type;
534 f->terminal = terminal;
535 f->terminal->reference_count++;
536 f->output_data.nothing = 0;
538 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
539 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
541 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
542 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
544 /* The default value of menu-bar-mode is t. */
545 set_menu_bar_lines (f, make_number (1), Qnil);
547 #ifdef CANNOT_DUMP
548 if (!noninteractive)
549 init_frame_faces (f);
550 #endif
552 return f;
556 static struct frame *
557 make_terminal_frame (struct terminal *terminal)
559 register struct frame *f;
560 Lisp_Object frame;
561 char name[20];
563 if (!terminal->name)
564 error ("Terminal is not live, can't create new frames on it");
566 f = make_frame (1);
568 XSETFRAME (frame, f);
569 Vframe_list = Fcons (frame, Vframe_list);
571 tty_frame_count++;
572 sprintf (name, "F%d", tty_frame_count);
573 f->name = build_string (name);
575 f->visible = 1; /* FRAME_SET_VISIBLE wd set frame_garbaged. */
576 f->async_visible = 1; /* Don't let visible be cleared later. */
577 f->terminal = terminal;
578 f->terminal->reference_count++;
579 #ifdef MSDOS
580 f->output_data.tty->display_info = &the_only_display_info;
581 if (!inhibit_window_system
582 && (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame))
583 || XFRAME (selected_frame)->output_method == output_msdos_raw))
584 f->output_method = output_msdos_raw;
585 else
586 f->output_method = output_termcap;
587 #else /* not MSDOS */
588 f->output_method = output_termcap;
589 create_tty_output (f);
590 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
591 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
592 #endif /* not MSDOS */
594 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
595 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
596 FRAME_MENU_BAR_LINES(f) = NILP (Vmenu_bar_mode) ? 0 : 1;
598 /* Set the top frame to the newly created frame. */
599 if (FRAMEP (FRAME_TTY (f)->top_frame)
600 && FRAME_LIVE_P (XFRAME (FRAME_TTY (f)->top_frame)))
601 XFRAME (FRAME_TTY (f)->top_frame)->async_visible = 2; /* obscured */
603 FRAME_TTY (f)->top_frame = frame;
605 if (!noninteractive)
606 init_frame_faces (f);
608 return f;
611 /* Get a suitable value for frame parameter PARAMETER for a newly
612 created frame, based on (1) the user-supplied frame parameter
613 alist SUPPLIED_PARMS, and (2) CURRENT_VALUE. */
615 static Lisp_Object
616 get_future_frame_param (Lisp_Object parameter,
617 Lisp_Object supplied_parms,
618 char *current_value)
620 Lisp_Object result;
622 result = Fassq (parameter, supplied_parms);
623 if (NILP (result))
624 result = Fassq (parameter, XFRAME (selected_frame)->param_alist);
625 if (NILP (result) && current_value != NULL)
626 result = build_string (current_value);
627 if (!NILP (result) && !STRINGP (result))
628 result = XCDR (result);
629 if (NILP (result) || !STRINGP (result))
630 result = Qnil;
632 return result;
635 DEFUN ("make-terminal-frame", Fmake_terminal_frame, Smake_terminal_frame,
636 1, 1, 0,
637 doc: /* Create an additional terminal frame, possibly on another terminal.
638 This function takes one argument, an alist specifying frame parameters.
640 You can create multiple frames on a single text-only terminal, but
641 only one of them (the selected terminal frame) is actually displayed.
643 In practice, generally you don't need to specify any parameters,
644 except when you want to create a new frame on another terminal.
645 In that case, the `tty' parameter specifies the device file to open,
646 and the `tty-type' parameter specifies the terminal type. Example:
648 (make-terminal-frame '((tty . "/dev/pts/5") (tty-type . "xterm")))
650 Note that changing the size of one terminal frame automatically
651 affects all frames on the same terminal device. */)
652 (Lisp_Object parms)
654 struct frame *f;
655 struct terminal *t = NULL;
656 Lisp_Object frame, tem;
657 struct frame *sf = SELECTED_FRAME ();
659 #ifdef MSDOS
660 if (sf->output_method != output_msdos_raw
661 && sf->output_method != output_termcap)
662 abort ();
663 #else /* not MSDOS */
665 #ifdef WINDOWSNT /* This should work now! */
666 if (sf->output_method != output_termcap)
667 error ("Not using an ASCII terminal now; cannot make a new ASCII frame");
668 #endif
669 #endif /* not MSDOS */
672 Lisp_Object terminal;
674 terminal = Fassq (Qterminal, parms);
675 if (!NILP (terminal))
677 terminal = XCDR (terminal);
678 t = get_terminal (terminal, 1);
680 #ifdef MSDOS
681 if (t && t != the_only_display_info.terminal)
682 /* msdos.c assumes a single tty_display_info object. */
683 error ("Multiple terminals are not supported on this platform");
684 if (!t)
685 t = the_only_display_info.terminal;
686 #endif
689 if (!t)
691 char *name = 0, *type = 0;
692 Lisp_Object tty, tty_type;
694 tty = get_future_frame_param
695 (Qtty, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
696 ? FRAME_TTY (XFRAME (selected_frame))->name
697 : NULL));
698 if (!NILP (tty))
700 name = (char *) alloca (SBYTES (tty) + 1);
701 strncpy (name, SSDATA (tty), SBYTES (tty));
702 name[SBYTES (tty)] = 0;
705 tty_type = get_future_frame_param
706 (Qtty_type, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
707 ? FRAME_TTY (XFRAME (selected_frame))->type
708 : NULL));
709 if (!NILP (tty_type))
711 type = (char *) alloca (SBYTES (tty_type) + 1);
712 strncpy (type, SSDATA (tty_type), SBYTES (tty_type));
713 type[SBYTES (tty_type)] = 0;
716 t = init_tty (name, type, 0); /* Errors are not fatal. */
719 f = make_terminal_frame (t);
722 int width, height;
723 get_tty_size (fileno (FRAME_TTY (f)->input), &width, &height);
724 change_frame_size (f, height, width, 0, 0, 0);
727 adjust_glyphs (f);
728 calculate_costs (f);
729 XSETFRAME (frame, f);
730 Fmodify_frame_parameters (frame, parms);
731 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty_type,
732 build_string (t->display_info.tty->type)),
733 Qnil));
734 if (t->display_info.tty->name != NULL)
735 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty,
736 build_string (t->display_info.tty->name)),
737 Qnil));
738 else
739 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty, Qnil), Qnil));
741 /* Make the frame face alist be frame-specific, so that each
742 frame could change its face definitions independently. */
743 f->face_alist = Fcopy_alist (sf->face_alist);
744 /* Simple Fcopy_alist isn't enough, because we need the contents of
745 the vectors which are the CDRs of associations in face_alist to
746 be copied as well. */
747 for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem))
748 XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem))));
749 return frame;
753 /* Perform the switch to frame FRAME.
755 If FRAME is a switch-frame event `(switch-frame FRAME1)', use
756 FRAME1 as frame.
758 If TRACK is non-zero and the frame that currently has the focus
759 redirects its focus to the selected frame, redirect that focused
760 frame's focus to FRAME instead.
762 FOR_DELETION non-zero means that the selected frame is being
763 deleted, which includes the possibility that the frame's terminal
764 is dead.
766 The value of NORECORD is passed as argument to Fselect_window. */
768 Lisp_Object
769 do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object norecord)
771 struct frame *sf = SELECTED_FRAME ();
773 /* If FRAME is a switch-frame event, extract the frame we should
774 switch to. */
775 if (CONSP (frame)
776 && EQ (XCAR (frame), Qswitch_frame)
777 && CONSP (XCDR (frame)))
778 frame = XCAR (XCDR (frame));
780 /* This used to say CHECK_LIVE_FRAME, but apparently it's possible for
781 a switch-frame event to arrive after a frame is no longer live,
782 especially when deleting the initial frame during startup. */
783 CHECK_FRAME (frame);
784 if (! FRAME_LIVE_P (XFRAME (frame)))
785 return Qnil;
787 if (sf == XFRAME (frame))
788 return frame;
790 /* This is too greedy; it causes inappropriate focus redirection
791 that's hard to get rid of. */
792 #if 0
793 /* If a frame's focus has been redirected toward the currently
794 selected frame, we should change the redirection to point to the
795 newly selected frame. This means that if the focus is redirected
796 from a minibufferless frame to a surrogate minibuffer frame, we
797 can use `other-window' to switch between all the frames using
798 that minibuffer frame, and the focus redirection will follow us
799 around. */
800 if (track)
802 Lisp_Object tail;
804 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
806 Lisp_Object focus;
808 if (!FRAMEP (XCAR (tail)))
809 abort ();
811 focus = FRAME_FOCUS_FRAME (XFRAME (XCAR (tail)));
813 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
814 Fredirect_frame_focus (XCAR (tail), frame);
817 #else /* ! 0 */
818 /* Instead, apply it only to the frame we're pointing to. */
819 #ifdef HAVE_WINDOW_SYSTEM
820 if (track && FRAME_WINDOW_P (XFRAME (frame)))
822 Lisp_Object focus, xfocus;
824 xfocus = x_get_focus_frame (XFRAME (frame));
825 if (FRAMEP (xfocus))
827 focus = FRAME_FOCUS_FRAME (XFRAME (xfocus));
828 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
829 Fredirect_frame_focus (xfocus, frame);
832 #endif /* HAVE_X_WINDOWS */
833 #endif /* ! 0 */
835 if (!for_deletion && FRAME_HAS_MINIBUF_P (sf))
836 resize_mini_window (XWINDOW (FRAME_MINIBUF_WINDOW (sf)), 1);
838 if (FRAME_TERMCAP_P (XFRAME (frame)) || FRAME_MSDOS_P (XFRAME (frame)))
840 if (FRAMEP (FRAME_TTY (XFRAME (frame))->top_frame))
841 /* Mark previously displayed frame as now obscured. */
842 XFRAME (FRAME_TTY (XFRAME (frame))->top_frame)->async_visible = 2;
843 XFRAME (frame)->async_visible = 1;
844 FRAME_TTY (XFRAME (frame))->top_frame = frame;
847 selected_frame = frame;
848 if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
849 last_nonminibuf_frame = XFRAME (selected_frame);
851 Fselect_window (XFRAME (frame)->selected_window, norecord);
853 /* We want to make sure that the next event generates a frame-switch
854 event to the appropriate frame. This seems kludgy to me, but
855 before you take it out, make sure that evaluating something like
856 (select-window (frame-root-window (new-frame))) doesn't end up
857 with your typing being interpreted in the new frame instead of
858 the one you're actually typing in. */
859 internal_last_event_frame = Qnil;
861 return frame;
864 DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 2, "e",
865 doc: /* Select FRAME.
866 Subsequent editing commands apply to its selected window.
867 Optional argument NORECORD means to neither change the order of
868 recently selected windows nor the buffer list.
870 The selection of FRAME lasts until the next time the user does
871 something to select a different frame, or until the next time
872 this function is called. If you are using a window system, the
873 previously selected frame may be restored as the selected frame
874 when returning to the command loop, because it still may have
875 the window system's input focus. On a text-only terminal, the
876 next redisplay will display FRAME.
878 This function returns FRAME, or nil if FRAME has been deleted. */)
879 (Lisp_Object frame, Lisp_Object norecord)
881 return do_switch_frame (frame, 1, 0, norecord);
885 DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 1, "e",
886 doc: /* Handle a switch-frame event EVENT.
887 Switch-frame events are usually bound to this function.
888 A switch-frame event tells Emacs that the window manager has requested
889 that the user's events be directed to the frame mentioned in the event.
890 This function selects the selected window of the frame of EVENT.
892 If EVENT is frame object, handle it as if it were a switch-frame event
893 to that frame. */)
894 (Lisp_Object event)
896 /* Preserve prefix arg that the command loop just cleared. */
897 KVAR (current_kboard, Vprefix_arg) = Vcurrent_prefix_arg;
898 Frun_hooks (1, &Qmouse_leave_buffer_hook);
899 return do_switch_frame (event, 0, 0, Qnil);
902 DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0,
903 doc: /* Return the frame that is now selected. */)
904 (void)
906 return selected_frame;
909 DEFUN ("window-frame", Fwindow_frame, Swindow_frame, 1, 1, 0,
910 doc: /* Return the frame object that window WINDOW is on. */)
911 (Lisp_Object window)
913 CHECK_LIVE_WINDOW (window);
914 return XWINDOW (window)->frame;
917 DEFUN ("frame-first-window", Fframe_first_window, Sframe_first_window, 0, 1, 0,
918 doc: /* Returns the topmost, leftmost window of FRAME.
919 If omitted, FRAME defaults to the currently selected frame. */)
920 (Lisp_Object frame)
922 Lisp_Object w;
924 if (NILP (frame))
925 w = SELECTED_FRAME ()->root_window;
926 else
928 CHECK_LIVE_FRAME (frame);
929 w = XFRAME (frame)->root_window;
931 while (NILP (XWINDOW (w)->buffer))
933 if (! NILP (XWINDOW (w)->hchild))
934 w = XWINDOW (w)->hchild;
935 else if (! NILP (XWINDOW (w)->vchild))
936 w = XWINDOW (w)->vchild;
937 else
938 abort ();
940 return w;
943 DEFUN ("active-minibuffer-window", Factive_minibuffer_window,
944 Sactive_minibuffer_window, 0, 0, 0,
945 doc: /* Return the currently active minibuffer window, or nil if none. */)
946 (void)
948 return minibuf_level ? minibuf_window : Qnil;
951 DEFUN ("frame-root-window", Fframe_root_window, Sframe_root_window, 0, 1, 0,
952 doc: /* Returns the root-window of FRAME.
953 If omitted, FRAME defaults to the currently selected frame. */)
954 (Lisp_Object frame)
956 Lisp_Object window;
958 if (NILP (frame))
959 window = SELECTED_FRAME ()->root_window;
960 else
962 CHECK_LIVE_FRAME (frame);
963 window = XFRAME (frame)->root_window;
966 return window;
969 DEFUN ("frame-selected-window", Fframe_selected_window,
970 Sframe_selected_window, 0, 1, 0,
971 doc: /* Return the selected window of FRAME.
972 FRAME defaults to the currently selected frame. */)
973 (Lisp_Object frame)
975 Lisp_Object window;
977 if (NILP (frame))
978 window = SELECTED_FRAME ()->selected_window;
979 else
981 CHECK_LIVE_FRAME (frame);
982 window = XFRAME (frame)->selected_window;
985 return window;
988 DEFUN ("set-frame-selected-window", Fset_frame_selected_window,
989 Sset_frame_selected_window, 2, 3, 0,
990 doc: /* Set selected window of FRAME to WINDOW.
991 If FRAME is nil, use the selected frame. If FRAME is the
992 selected frame, this makes WINDOW the selected window.
993 Optional argument NORECORD non-nil means to neither change the
994 order of recently selected windows nor the buffer list.
995 Return WINDOW. */)
996 (Lisp_Object frame, Lisp_Object window, Lisp_Object norecord)
998 if (NILP (frame))
999 frame = selected_frame;
1001 CHECK_LIVE_FRAME (frame);
1002 CHECK_LIVE_WINDOW (window);
1004 if (! EQ (frame, WINDOW_FRAME (XWINDOW (window))))
1005 error ("In `set-frame-selected-window', WINDOW is not on FRAME");
1007 if (EQ (frame, selected_frame))
1008 return Fselect_window (window, norecord);
1010 return XFRAME (frame)->selected_window = window;
1014 DEFUN ("frame-list", Fframe_list, Sframe_list,
1015 0, 0, 0,
1016 doc: /* Return a list of all live frames. */)
1017 (void)
1019 Lisp_Object frames;
1020 frames = Fcopy_sequence (Vframe_list);
1021 #ifdef HAVE_WINDOW_SYSTEM
1022 if (FRAMEP (tip_frame))
1023 frames = Fdelq (tip_frame, frames);
1024 #endif
1025 return frames;
1028 /* Return the next frame in the frame list after FRAME.
1029 If MINIBUF is nil, exclude minibuffer-only frames.
1030 If MINIBUF is a window, include only its own frame
1031 and any frame now using that window as the minibuffer.
1032 If MINIBUF is `visible', include all visible frames.
1033 If MINIBUF is 0, include all visible and iconified frames.
1034 Otherwise, include all frames. */
1036 static Lisp_Object
1037 next_frame (Lisp_Object frame, Lisp_Object minibuf)
1039 Lisp_Object tail;
1040 int passed = 0;
1042 /* There must always be at least one frame in Vframe_list. */
1043 if (! CONSP (Vframe_list))
1044 abort ();
1046 /* If this frame is dead, it won't be in Vframe_list, and we'll loop
1047 forever. Forestall that. */
1048 CHECK_LIVE_FRAME (frame);
1050 while (1)
1051 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1053 Lisp_Object f;
1055 f = XCAR (tail);
1057 if (passed
1058 && ((!FRAME_TERMCAP_P (XFRAME (f)) && !FRAME_TERMCAP_P (XFRAME (frame))
1059 && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
1060 || (FRAME_TERMCAP_P (XFRAME (f)) && FRAME_TERMCAP_P (XFRAME (frame))
1061 && FRAME_TTY (XFRAME (f)) == FRAME_TTY (XFRAME (frame)))))
1063 /* Decide whether this frame is eligible to be returned. */
1065 /* If we've looped all the way around without finding any
1066 eligible frames, return the original frame. */
1067 if (EQ (f, frame))
1068 return f;
1070 /* Let minibuf decide if this frame is acceptable. */
1071 if (NILP (minibuf))
1073 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
1074 return f;
1076 else if (EQ (minibuf, Qvisible))
1078 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1079 if (FRAME_VISIBLE_P (XFRAME (f)))
1080 return f;
1082 else if (INTEGERP (minibuf) && XINT (minibuf) == 0)
1084 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1085 if (FRAME_VISIBLE_P (XFRAME (f))
1086 || FRAME_ICONIFIED_P (XFRAME (f)))
1087 return f;
1089 else if (WINDOWP (minibuf))
1091 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
1092 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
1093 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
1094 FRAME_FOCUS_FRAME (XFRAME (f))))
1095 return f;
1097 else
1098 return f;
1101 if (EQ (frame, f))
1102 passed++;
1106 /* Return the previous frame in the frame list before FRAME.
1107 If MINIBUF is nil, exclude minibuffer-only frames.
1108 If MINIBUF is a window, include only its own frame
1109 and any frame now using that window as the minibuffer.
1110 If MINIBUF is `visible', include all visible frames.
1111 If MINIBUF is 0, include all visible and iconified frames.
1112 Otherwise, include all frames. */
1114 static Lisp_Object
1115 prev_frame (Lisp_Object frame, Lisp_Object minibuf)
1117 Lisp_Object tail;
1118 Lisp_Object prev;
1120 /* There must always be at least one frame in Vframe_list. */
1121 if (! CONSP (Vframe_list))
1122 abort ();
1124 prev = Qnil;
1125 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1127 Lisp_Object f;
1129 f = XCAR (tail);
1130 if (!FRAMEP (f))
1131 abort ();
1133 if (EQ (frame, f) && !NILP (prev))
1134 return prev;
1136 if ((!FRAME_TERMCAP_P (XFRAME (f)) && !FRAME_TERMCAP_P (XFRAME (frame))
1137 && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
1138 || (FRAME_TERMCAP_P (XFRAME (f)) && FRAME_TERMCAP_P (XFRAME (frame))
1139 && FRAME_TTY (XFRAME (f)) == FRAME_TTY (XFRAME (frame))))
1141 /* Decide whether this frame is eligible to be returned,
1142 according to minibuf. */
1143 if (NILP (minibuf))
1145 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
1146 prev = f;
1148 else if (WINDOWP (minibuf))
1150 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
1151 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
1152 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
1153 FRAME_FOCUS_FRAME (XFRAME (f))))
1154 prev = f;
1156 else if (EQ (minibuf, Qvisible))
1158 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1159 if (FRAME_VISIBLE_P (XFRAME (f)))
1160 prev = f;
1162 else if (XFASTINT (minibuf) == 0)
1164 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1165 if (FRAME_VISIBLE_P (XFRAME (f))
1166 || FRAME_ICONIFIED_P (XFRAME (f)))
1167 prev = f;
1169 else
1170 prev = f;
1174 /* We've scanned the entire list. */
1175 if (NILP (prev))
1176 /* We went through the whole frame list without finding a single
1177 acceptable frame. Return the original frame. */
1178 return frame;
1179 else
1180 /* There were no acceptable frames in the list before FRAME; otherwise,
1181 we would have returned directly from the loop. Since PREV is the last
1182 acceptable frame in the list, return it. */
1183 return prev;
1187 DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0,
1188 doc: /* Return the next frame in the frame list after FRAME.
1189 It considers only frames on the same terminal as FRAME.
1190 By default, skip minibuffer-only frames.
1191 If omitted, FRAME defaults to the selected frame.
1192 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1193 If MINIFRAME is a window, include only its own frame
1194 and any frame now using that window as the minibuffer.
1195 If MINIFRAME is `visible', include all visible frames.
1196 If MINIFRAME is 0, include all visible and iconified frames.
1197 Otherwise, include all frames. */)
1198 (Lisp_Object frame, Lisp_Object miniframe)
1200 if (NILP (frame))
1201 frame = selected_frame;
1203 CHECK_LIVE_FRAME (frame);
1204 return next_frame (frame, miniframe);
1207 DEFUN ("previous-frame", Fprevious_frame, Sprevious_frame, 0, 2, 0,
1208 doc: /* Return the previous frame in the frame list before FRAME.
1209 It considers only frames on the same terminal as FRAME.
1210 By default, skip minibuffer-only frames.
1211 If omitted, FRAME defaults to the selected frame.
1212 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1213 If MINIFRAME is a window, include only its own frame
1214 and any frame now using that window as the minibuffer.
1215 If MINIFRAME is `visible', include all visible frames.
1216 If MINIFRAME is 0, include all visible and iconified frames.
1217 Otherwise, include all frames. */)
1218 (Lisp_Object frame, Lisp_Object miniframe)
1220 if (NILP (frame))
1221 frame = selected_frame;
1222 CHECK_LIVE_FRAME (frame);
1223 return prev_frame (frame, miniframe);
1226 /* Return 1 if it is ok to delete frame F;
1227 0 if all frames aside from F are invisible.
1228 (Exception: if F is the terminal frame, and we are using X, return 1.) */
1231 other_visible_frames (FRAME_PTR f)
1233 /* We know the selected frame is visible,
1234 so if F is some other frame, it can't be the sole visible one. */
1235 if (f == SELECTED_FRAME ())
1237 Lisp_Object frames;
1238 int count = 0;
1240 for (frames = Vframe_list;
1241 CONSP (frames);
1242 frames = XCDR (frames))
1244 Lisp_Object this;
1246 this = XCAR (frames);
1247 /* Verify that the frame's window still exists
1248 and we can still talk to it. And note any recent change
1249 in visibility. */
1250 #ifdef HAVE_WINDOW_SYSTEM
1251 if (FRAME_WINDOW_P (XFRAME (this)))
1253 x_sync (XFRAME (this));
1254 FRAME_SAMPLE_VISIBILITY (XFRAME (this));
1256 #endif
1258 if (FRAME_VISIBLE_P (XFRAME (this))
1259 || FRAME_ICONIFIED_P (XFRAME (this))
1260 /* Allow deleting the terminal frame when at least
1261 one X frame exists! */
1262 || (FRAME_WINDOW_P (XFRAME (this)) && !FRAME_WINDOW_P (f)))
1263 count++;
1265 return count > 1;
1267 return 1;
1270 /* Delete FRAME. When FORCE equals Qnoelisp, delete FRAME
1271 unconditionally. x_connection_closed and delete_terminal use
1272 this. Any other value of FORCE implements the semantics
1273 described for Fdelete_frame. */
1274 Lisp_Object
1275 delete_frame (Lisp_Object frame, Lisp_Object force)
1276 /* If we use `register' here, gcc-4.0.2 on amd64 using
1277 -DUSE_LISP_UNION_TYPE complains further down that we're getting the
1278 address of `force'. Go figure. */
1281 struct frame *f;
1282 struct frame *sf = SELECTED_FRAME ();
1283 struct kboard *kb;
1285 int minibuffer_selected, tooltip_frame;
1287 if (EQ (frame, Qnil))
1289 f = sf;
1290 XSETFRAME (frame, f);
1292 else
1294 CHECK_FRAME (frame);
1295 f = XFRAME (frame);
1298 if (! FRAME_LIVE_P (f))
1299 return Qnil;
1301 if (NILP (force) && !other_visible_frames (f))
1302 error ("Attempt to delete the sole visible or iconified frame");
1304 /* x_connection_closed must have set FORCE to `noelisp' in order
1305 to delete the last frame, if it is gone. */
1306 if (NILP (XCDR (Vframe_list)) && !EQ (force, Qnoelisp))
1307 error ("Attempt to delete the only frame");
1309 /* Does this frame have a minibuffer, and is it the surrogate
1310 minibuffer for any other frame? */
1311 if (FRAME_HAS_MINIBUF_P (XFRAME (frame)))
1313 Lisp_Object frames;
1315 for (frames = Vframe_list;
1316 CONSP (frames);
1317 frames = XCDR (frames))
1319 Lisp_Object this;
1320 this = XCAR (frames);
1322 if (! EQ (this, frame)
1323 && EQ (frame,
1324 WINDOW_FRAME (XWINDOW
1325 (FRAME_MINIBUF_WINDOW (XFRAME (this))))))
1327 /* If we MUST delete this frame, delete the other first.
1328 But do this only if FORCE equals `noelisp'. */
1329 if (EQ (force, Qnoelisp))
1330 delete_frame (this, Qnoelisp);
1331 else
1332 error ("Attempt to delete a surrogate minibuffer frame");
1337 tooltip_frame = !NILP (Fframe_parameter (frame, intern ("tooltip")));
1339 /* Run `delete-frame-functions' unless FORCE is `noelisp' or
1340 frame is a tooltip. FORCE is set to `noelisp' when handling
1341 a disconnect from the terminal, so we don't dare call Lisp
1342 code. */
1343 if (NILP (Vrun_hooks) || tooltip_frame)
1345 else if (EQ (force, Qnoelisp))
1346 pending_funcalls
1347 = Fcons (list3 (Qrun_hook_with_args, Qdelete_frame_functions, frame),
1348 pending_funcalls);
1349 else
1350 safe_call2 (Qrun_hook_with_args, Qdelete_frame_functions, frame);
1352 /* The hook may sometimes (indirectly) cause the frame to be deleted. */
1353 if (! FRAME_LIVE_P (f))
1354 return Qnil;
1356 /* At this point, we are committed to deleting the frame.
1357 There is no more chance for errors to prevent it. */
1359 minibuffer_selected = EQ (minibuf_window, selected_window);
1361 /* Don't let the frame remain selected. */
1362 if (f == sf)
1364 Lisp_Object tail, frame1;
1366 /* Look for another visible frame on the same terminal. */
1367 frame1 = next_frame (frame, Qvisible);
1369 /* If there is none, find *some* other frame. */
1370 if (NILP (frame1) || EQ (frame1, frame))
1372 FOR_EACH_FRAME (tail, frame1)
1374 if (! EQ (frame, frame1) && FRAME_LIVE_P (XFRAME (frame1)))
1375 break;
1378 #ifdef NS_IMPL_COCOA
1379 else
1380 /* Under NS, there is no system mechanism for choosing a new
1381 window to get focus -- it is left to application code.
1382 So the portion of THIS application interfacing with NS
1383 needs to know about it. We call Fraise_frame, but the
1384 purpose is really to transfer focus. */
1385 Fraise_frame (frame1);
1386 #endif
1388 do_switch_frame (frame1, 0, 1, Qnil);
1389 sf = SELECTED_FRAME ();
1392 /* Don't allow minibuf_window to remain on a deleted frame. */
1393 if (EQ (f->minibuffer_window, minibuf_window))
1395 Fset_window_buffer (sf->minibuffer_window,
1396 XWINDOW (minibuf_window)->buffer, Qnil);
1397 minibuf_window = sf->minibuffer_window;
1399 /* If the dying minibuffer window was selected,
1400 select the new one. */
1401 if (minibuffer_selected)
1402 Fselect_window (minibuf_window, Qnil);
1405 /* Don't let echo_area_window to remain on a deleted frame. */
1406 if (EQ (f->minibuffer_window, echo_area_window))
1407 echo_area_window = sf->minibuffer_window;
1409 /* Clear any X selections for this frame. */
1410 #ifdef HAVE_X_WINDOWS
1411 if (FRAME_X_P (f))
1412 x_clear_frame_selections (f);
1413 #endif
1415 /* Free glyphs.
1416 This function must be called before the window tree of the
1417 frame is deleted because windows contain dynamically allocated
1418 memory. */
1419 free_glyphs (f);
1421 #ifdef HAVE_WINDOW_SYSTEM
1422 /* Give chance to each font driver to free a frame specific data. */
1423 font_update_drivers (f, Qnil);
1424 #endif
1426 /* Mark all the windows that used to be on FRAME as deleted, and then
1427 remove the reference to them. */
1428 delete_all_subwindows (XWINDOW (f->root_window));
1429 f->root_window = Qnil;
1431 Vframe_list = Fdelq (frame, Vframe_list);
1432 FRAME_SET_VISIBLE (f, 0);
1434 /* Allow the vector of menu bar contents to be freed in the next
1435 garbage collection. The frame object itself may not be garbage
1436 collected until much later, because recent_keys and other data
1437 structures can still refer to it. */
1438 f->menu_bar_vector = Qnil;
1440 free_font_driver_list (f);
1441 xfree (f->namebuf);
1442 xfree (f->decode_mode_spec_buffer);
1443 xfree (FRAME_INSERT_COST (f));
1444 xfree (FRAME_DELETEN_COST (f));
1445 xfree (FRAME_INSERTN_COST (f));
1446 xfree (FRAME_DELETE_COST (f));
1447 xfree (FRAME_MESSAGE_BUF (f));
1449 /* Since some events are handled at the interrupt level, we may get
1450 an event for f at any time; if we zero out the frame's terminal
1451 now, then we may trip up the event-handling code. Instead, we'll
1452 promise that the terminal of the frame must be valid until we
1453 have called the window-system-dependent frame destruction
1454 routine. */
1456 if (FRAME_TERMINAL (f)->delete_frame_hook)
1457 (*FRAME_TERMINAL (f)->delete_frame_hook) (f);
1460 struct terminal *terminal = FRAME_TERMINAL (f);
1461 f->output_data.nothing = 0;
1462 f->terminal = 0; /* Now the frame is dead. */
1464 /* If needed, delete the terminal that this frame was on.
1465 (This must be done after the frame is killed.) */
1466 terminal->reference_count--;
1467 if (terminal->reference_count == 0)
1469 Lisp_Object tmp;
1470 XSETTERMINAL (tmp, terminal);
1472 kb = NULL;
1473 Fdelete_terminal (tmp, NILP (force) ? Qt : force);
1475 else
1476 kb = terminal->kboard;
1479 /* If we've deleted the last_nonminibuf_frame, then try to find
1480 another one. */
1481 if (f == last_nonminibuf_frame)
1483 Lisp_Object frames;
1485 last_nonminibuf_frame = 0;
1487 for (frames = Vframe_list;
1488 CONSP (frames);
1489 frames = XCDR (frames))
1491 f = XFRAME (XCAR (frames));
1492 if (!FRAME_MINIBUF_ONLY_P (f))
1494 last_nonminibuf_frame = f;
1495 break;
1500 /* If there's no other frame on the same kboard, get out of
1501 single-kboard state if we're in it for this kboard. */
1502 if (kb != NULL)
1504 Lisp_Object frames;
1505 /* Some frame we found on the same kboard, or nil if there are none. */
1506 Lisp_Object frame_on_same_kboard;
1508 frame_on_same_kboard = Qnil;
1510 for (frames = Vframe_list;
1511 CONSP (frames);
1512 frames = XCDR (frames))
1514 Lisp_Object this;
1515 struct frame *f1;
1517 this = XCAR (frames);
1518 if (!FRAMEP (this))
1519 abort ();
1520 f1 = XFRAME (this);
1522 if (kb == FRAME_KBOARD (f1))
1523 frame_on_same_kboard = this;
1526 if (NILP (frame_on_same_kboard))
1527 not_single_kboard_state (kb);
1531 /* If we've deleted this keyboard's default_minibuffer_frame, try to
1532 find another one. Prefer minibuffer-only frames, but also notice
1533 frames with other windows. */
1534 if (kb != NULL && EQ (frame, KVAR (kb, Vdefault_minibuffer_frame)))
1536 Lisp_Object frames;
1538 /* The last frame we saw with a minibuffer, minibuffer-only or not. */
1539 Lisp_Object frame_with_minibuf;
1540 /* Some frame we found on the same kboard, or nil if there are none. */
1541 Lisp_Object frame_on_same_kboard;
1543 frame_on_same_kboard = Qnil;
1544 frame_with_minibuf = Qnil;
1546 for (frames = Vframe_list;
1547 CONSP (frames);
1548 frames = XCDR (frames))
1550 Lisp_Object this;
1551 struct frame *f1;
1553 this = XCAR (frames);
1554 if (!FRAMEP (this))
1555 abort ();
1556 f1 = XFRAME (this);
1558 /* Consider only frames on the same kboard
1559 and only those with minibuffers. */
1560 if (kb == FRAME_KBOARD (f1)
1561 && FRAME_HAS_MINIBUF_P (f1))
1563 frame_with_minibuf = this;
1564 if (FRAME_MINIBUF_ONLY_P (f1))
1565 break;
1568 if (kb == FRAME_KBOARD (f1))
1569 frame_on_same_kboard = this;
1572 if (!NILP (frame_on_same_kboard))
1574 /* We know that there must be some frame with a minibuffer out
1575 there. If this were not true, all of the frames present
1576 would have to be minibufferless, which implies that at some
1577 point their minibuffer frames must have been deleted, but
1578 that is prohibited at the top; you can't delete surrogate
1579 minibuffer frames. */
1580 if (NILP (frame_with_minibuf))
1581 abort ();
1583 KVAR (kb, Vdefault_minibuffer_frame) = frame_with_minibuf;
1585 else
1586 /* No frames left on this kboard--say no minibuffer either. */
1587 KVAR (kb, Vdefault_minibuffer_frame) = Qnil;
1590 /* Cause frame titles to update--necessary if we now have just one frame. */
1591 if (!tooltip_frame)
1592 update_mode_lines = 1;
1594 return Qnil;
1597 DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 2, "",
1598 doc: /* Delete FRAME, permanently eliminating it from use.
1599 FRAME defaults to the selected frame.
1601 A frame may not be deleted if its minibuffer is used by other frames.
1602 Normally, you may not delete a frame if all other frames are invisible,
1603 but if the second optional argument FORCE is non-nil, you may do so.
1605 This function runs `delete-frame-functions' before actually
1606 deleting the frame, unless the frame is a tooltip.
1607 The functions are run with one argument, the frame to be deleted. */)
1608 (Lisp_Object frame, Lisp_Object force)
1610 return delete_frame (frame, !NILP (force) ? Qt : Qnil);
1614 /* Return mouse position in character cell units. */
1616 DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0,
1617 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1618 The position is given in character cells, where (0, 0) is the
1619 upper-left corner of the frame, X is the horizontal offset, and Y is
1620 the vertical offset.
1621 If Emacs is running on a mouseless terminal or hasn't been programmed
1622 to read the mouse position, it returns the selected frame for FRAME
1623 and nil for X and Y.
1624 If `mouse-position-function' is non-nil, `mouse-position' calls it,
1625 passing the normal return value to that function as an argument,
1626 and returns whatever that function returns. */)
1627 (void)
1629 FRAME_PTR f;
1630 Lisp_Object lispy_dummy;
1631 enum scroll_bar_part party_dummy;
1632 Lisp_Object x, y, retval;
1633 int col, row;
1634 unsigned long long_dummy;
1635 struct gcpro gcpro1;
1637 f = SELECTED_FRAME ();
1638 x = y = Qnil;
1640 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
1641 /* It's okay for the hook to refrain from storing anything. */
1642 if (FRAME_TERMINAL (f)->mouse_position_hook)
1643 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1644 &lispy_dummy, &party_dummy,
1645 &x, &y,
1646 &long_dummy);
1647 if (! NILP (x))
1649 col = XINT (x);
1650 row = XINT (y);
1651 pixel_to_glyph_coords (f, col, row, &col, &row, NULL, 1);
1652 XSETINT (x, col);
1653 XSETINT (y, row);
1655 #endif
1656 XSETFRAME (lispy_dummy, f);
1657 retval = Fcons (lispy_dummy, Fcons (x, y));
1658 GCPRO1 (retval);
1659 if (!NILP (Vmouse_position_function))
1660 retval = call1 (Vmouse_position_function, retval);
1661 RETURN_UNGCPRO (retval);
1664 DEFUN ("mouse-pixel-position", Fmouse_pixel_position,
1665 Smouse_pixel_position, 0, 0, 0,
1666 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1667 The position is given in pixel units, where (0, 0) is the
1668 upper-left corner of the frame, X is the horizontal offset, and Y is
1669 the vertical offset.
1670 If Emacs is running on a mouseless terminal or hasn't been programmed
1671 to read the mouse position, it returns the selected frame for FRAME
1672 and nil for X and Y. */)
1673 (void)
1675 FRAME_PTR f;
1676 Lisp_Object lispy_dummy;
1677 enum scroll_bar_part party_dummy;
1678 Lisp_Object x, y;
1679 unsigned long long_dummy;
1681 f = SELECTED_FRAME ();
1682 x = y = Qnil;
1684 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
1685 /* It's okay for the hook to refrain from storing anything. */
1686 if (FRAME_TERMINAL (f)->mouse_position_hook)
1687 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1688 &lispy_dummy, &party_dummy,
1689 &x, &y,
1690 &long_dummy);
1691 #endif
1692 XSETFRAME (lispy_dummy, f);
1693 return Fcons (lispy_dummy, Fcons (x, y));
1696 DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0,
1697 doc: /* Move the mouse pointer to the center of character cell (X,Y) in FRAME.
1698 Coordinates are relative to the frame, not a window,
1699 so the coordinates of the top left character in the frame
1700 may be nonzero due to left-hand scroll bars or the menu bar.
1702 The position is given in character cells, where (0, 0) is the
1703 upper-left corner of the frame, X is the horizontal offset, and Y is
1704 the vertical offset.
1706 This function is a no-op for an X frame that is not visible.
1707 If you have just created a frame, you must wait for it to become visible
1708 before calling this function on it, like this.
1709 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1710 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1712 CHECK_LIVE_FRAME (frame);
1713 CHECK_NUMBER (x);
1714 CHECK_NUMBER (y);
1716 /* I think this should be done with a hook. */
1717 #ifdef HAVE_WINDOW_SYSTEM
1718 if (FRAME_WINDOW_P (XFRAME (frame)))
1719 /* Warping the mouse will cause enternotify and focus events. */
1720 x_set_mouse_position (XFRAME (frame), XINT (x), XINT (y));
1721 #else
1722 #if defined (MSDOS) && defined (HAVE_MOUSE)
1723 if (FRAME_MSDOS_P (XFRAME (frame)))
1725 Fselect_frame (frame, Qnil);
1726 mouse_moveto (XINT (x), XINT (y));
1728 #else
1729 #ifdef HAVE_GPM
1731 Fselect_frame (frame, Qnil);
1732 term_mouse_moveto (XINT (x), XINT (y));
1734 #endif
1735 #endif
1736 #endif
1738 return Qnil;
1741 DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position,
1742 Sset_mouse_pixel_position, 3, 3, 0,
1743 doc: /* Move the mouse pointer to pixel position (X,Y) in FRAME.
1744 The position is given in pixels, where (0, 0) is the upper-left corner
1745 of the frame, X is the horizontal offset, and Y is the vertical offset.
1747 Note, this is a no-op for an X frame that is not visible.
1748 If you have just created a frame, you must wait for it to become visible
1749 before calling this function on it, like this.
1750 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1751 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1753 CHECK_LIVE_FRAME (frame);
1754 CHECK_NUMBER (x);
1755 CHECK_NUMBER (y);
1757 /* I think this should be done with a hook. */
1758 #ifdef HAVE_WINDOW_SYSTEM
1759 if (FRAME_WINDOW_P (XFRAME (frame)))
1760 /* Warping the mouse will cause enternotify and focus events. */
1761 x_set_mouse_pixel_position (XFRAME (frame), XINT (x), XINT (y));
1762 #else
1763 #if defined (MSDOS) && defined (HAVE_MOUSE)
1764 if (FRAME_MSDOS_P (XFRAME (frame)))
1766 Fselect_frame (frame, Qnil);
1767 mouse_moveto (XINT (x), XINT (y));
1769 #else
1770 #ifdef HAVE_GPM
1772 Fselect_frame (frame, Qnil);
1773 term_mouse_moveto (XINT (x), XINT (y));
1775 #endif
1776 #endif
1777 #endif
1779 return Qnil;
1782 static void make_frame_visible_1 (Lisp_Object);
1784 DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible,
1785 0, 1, "",
1786 doc: /* Make the frame FRAME visible (assuming it is an X window).
1787 If omitted, FRAME defaults to the currently selected frame. */)
1788 (Lisp_Object frame)
1790 if (NILP (frame))
1791 frame = selected_frame;
1793 CHECK_LIVE_FRAME (frame);
1795 /* I think this should be done with a hook. */
1796 #ifdef HAVE_WINDOW_SYSTEM
1797 if (FRAME_WINDOW_P (XFRAME (frame)))
1799 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1800 x_make_frame_visible (XFRAME (frame));
1802 #endif
1804 make_frame_visible_1 (XFRAME (frame)->root_window);
1806 /* Make menu bar update for the Buffers and Frames menus. */
1807 windows_or_buffers_changed++;
1809 return frame;
1812 /* Update the display_time slot of the buffers shown in WINDOW
1813 and all its descendents. */
1815 static void
1816 make_frame_visible_1 (Lisp_Object window)
1818 struct window *w;
1820 for (;!NILP (window); window = w->next)
1822 w = XWINDOW (window);
1824 if (!NILP (w->buffer))
1825 BVAR (XBUFFER (w->buffer), display_time) = Fcurrent_time ();
1827 if (!NILP (w->vchild))
1828 make_frame_visible_1 (w->vchild);
1829 if (!NILP (w->hchild))
1830 make_frame_visible_1 (w->hchild);
1834 DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible,
1835 0, 2, "",
1836 doc: /* Make the frame FRAME invisible.
1837 If omitted, FRAME defaults to the currently selected frame.
1838 On graphical displays, invisible frames are not updated and are
1839 usually not displayed at all, even in a window system's \"taskbar\".
1841 Normally you may not make FRAME invisible if all other frames are invisible,
1842 but if the second optional argument FORCE is non-nil, you may do so.
1844 This function has no effect on text-only terminal frames. Such frames
1845 are always considered visible, whether or not they are currently being
1846 displayed in the terminal. */)
1847 (Lisp_Object frame, Lisp_Object force)
1849 if (NILP (frame))
1850 frame = selected_frame;
1852 CHECK_LIVE_FRAME (frame);
1854 if (NILP (force) && !other_visible_frames (XFRAME (frame)))
1855 error ("Attempt to make invisible the sole visible or iconified frame");
1857 #if 0 /* This isn't logically necessary, and it can do GC. */
1858 /* Don't let the frame remain selected. */
1859 if (EQ (frame, selected_frame))
1860 do_switch_frame (next_frame (frame, Qt), 0, 0, Qnil)
1861 #endif
1863 /* Don't allow minibuf_window to remain on a deleted frame. */
1864 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1866 struct frame *sf = XFRAME (selected_frame);
1867 Fset_window_buffer (sf->minibuffer_window,
1868 XWINDOW (minibuf_window)->buffer, Qnil);
1869 minibuf_window = sf->minibuffer_window;
1872 /* I think this should be done with a hook. */
1873 #ifdef HAVE_WINDOW_SYSTEM
1874 if (FRAME_WINDOW_P (XFRAME (frame)))
1875 x_make_frame_invisible (XFRAME (frame));
1876 #endif
1878 /* Make menu bar update for the Buffers and Frames menus. */
1879 windows_or_buffers_changed++;
1881 return Qnil;
1884 DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame,
1885 0, 1, "",
1886 doc: /* Make the frame FRAME into an icon.
1887 If omitted, FRAME defaults to the currently selected frame. */)
1888 (Lisp_Object frame)
1890 if (NILP (frame))
1891 frame = selected_frame;
1893 CHECK_LIVE_FRAME (frame);
1895 #if 0 /* This isn't logically necessary, and it can do GC. */
1896 /* Don't let the frame remain selected. */
1897 if (EQ (frame, selected_frame))
1898 Fhandle_switch_frame (next_frame (frame, Qt));
1899 #endif
1901 /* Don't allow minibuf_window to remain on a deleted frame. */
1902 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1904 struct frame *sf = XFRAME (selected_frame);
1905 Fset_window_buffer (sf->minibuffer_window,
1906 XWINDOW (minibuf_window)->buffer, Qnil);
1907 minibuf_window = sf->minibuffer_window;
1910 /* I think this should be done with a hook. */
1911 #ifdef HAVE_WINDOW_SYSTEM
1912 if (FRAME_WINDOW_P (XFRAME (frame)))
1913 x_iconify_frame (XFRAME (frame));
1914 #endif
1916 /* Make menu bar update for the Buffers and Frames menus. */
1917 windows_or_buffers_changed++;
1919 return Qnil;
1922 DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p,
1923 1, 1, 0,
1924 doc: /* Return t if FRAME is \"visible\" (actually in use for display).
1925 Return the symbol `icon' if FRAME is iconified or \"minimized\".
1926 Return nil if FRAME was made invisible, via `make-frame-invisible'.
1927 On graphical displays, invisible frames are not updated and are
1928 usually not displayed at all, even in a window system's \"taskbar\".
1930 If FRAME is a text-only terminal frame, this always returns t.
1931 Such frames are always considered visible, whether or not they are
1932 currently being displayed on the terminal. */)
1933 (Lisp_Object frame)
1935 CHECK_LIVE_FRAME (frame);
1937 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1939 if (FRAME_VISIBLE_P (XFRAME (frame)))
1940 return Qt;
1941 if (FRAME_ICONIFIED_P (XFRAME (frame)))
1942 return Qicon;
1943 return Qnil;
1946 DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list,
1947 0, 0, 0,
1948 doc: /* Return a list of all frames now \"visible\" (being updated). */)
1949 (void)
1951 Lisp_Object tail, frame;
1952 struct frame *f;
1953 Lisp_Object value;
1955 value = Qnil;
1956 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1958 frame = XCAR (tail);
1959 if (!FRAMEP (frame))
1960 continue;
1961 f = XFRAME (frame);
1962 if (FRAME_VISIBLE_P (f))
1963 value = Fcons (frame, value);
1965 return value;
1969 DEFUN ("raise-frame", Fraise_frame, Sraise_frame, 0, 1, "",
1970 doc: /* Bring FRAME to the front, so it occludes any frames it overlaps.
1971 If FRAME is invisible or iconified, make it visible.
1972 If you don't specify a frame, the selected frame is used.
1973 If Emacs is displaying on an ordinary terminal or some other device which
1974 doesn't support multiple overlapping frames, this function selects FRAME. */)
1975 (Lisp_Object frame)
1977 struct frame *f;
1978 if (NILP (frame))
1979 frame = selected_frame;
1981 CHECK_LIVE_FRAME (frame);
1983 f = XFRAME (frame);
1985 if (FRAME_TERMCAP_P (f))
1986 /* On a text-only terminal select FRAME. */
1987 Fselect_frame (frame, Qnil);
1988 else
1989 /* Do like the documentation says. */
1990 Fmake_frame_visible (frame);
1992 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
1993 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 1);
1995 return Qnil;
1998 /* Should we have a corresponding function called Flower_Power? */
1999 DEFUN ("lower-frame", Flower_frame, Slower_frame, 0, 1, "",
2000 doc: /* Send FRAME to the back, so it is occluded by any frames that overlap it.
2001 If you don't specify a frame, the selected frame is used.
2002 If Emacs is displaying on an ordinary terminal or some other device which
2003 doesn't support multiple overlapping frames, this function does nothing. */)
2004 (Lisp_Object frame)
2006 struct frame *f;
2008 if (NILP (frame))
2009 frame = selected_frame;
2011 CHECK_LIVE_FRAME (frame);
2013 f = XFRAME (frame);
2015 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
2016 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 0);
2018 return Qnil;
2022 DEFUN ("redirect-frame-focus", Fredirect_frame_focus, Sredirect_frame_focus,
2023 1, 2, 0,
2024 doc: /* Arrange for keystrokes typed at FRAME to be sent to FOCUS-FRAME.
2025 In other words, switch-frame events caused by events in FRAME will
2026 request a switch to FOCUS-FRAME, and `last-event-frame' will be
2027 FOCUS-FRAME after reading an event typed at FRAME.
2029 If FOCUS-FRAME is omitted or nil, any existing redirection is
2030 cancelled, and the frame again receives its own keystrokes.
2032 Focus redirection is useful for temporarily redirecting keystrokes to
2033 a surrogate minibuffer frame when a frame doesn't have its own
2034 minibuffer window.
2036 A frame's focus redirection can be changed by `select-frame'. If frame
2037 FOO is selected, and then a different frame BAR is selected, any
2038 frames redirecting their focus to FOO are shifted to redirect their
2039 focus to BAR. This allows focus redirection to work properly when the
2040 user switches from one frame to another using `select-window'.
2042 This means that a frame whose focus is redirected to itself is treated
2043 differently from a frame whose focus is redirected to nil; the former
2044 is affected by `select-frame', while the latter is not.
2046 The redirection lasts until `redirect-frame-focus' is called to change it. */)
2047 (Lisp_Object frame, Lisp_Object focus_frame)
2049 struct frame *f;
2051 /* Note that we don't check for a live frame here. It's reasonable
2052 to redirect the focus of a frame you're about to delete, if you
2053 know what other frame should receive those keystrokes. */
2054 CHECK_FRAME (frame);
2056 if (! NILP (focus_frame))
2057 CHECK_LIVE_FRAME (focus_frame);
2059 f = XFRAME (frame);
2061 f->focus_frame = focus_frame;
2063 if (FRAME_TERMINAL (f)->frame_rehighlight_hook)
2064 (*FRAME_TERMINAL (f)->frame_rehighlight_hook) (f);
2066 return Qnil;
2070 DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 1, 1, 0,
2071 doc: /* Return the frame to which FRAME's keystrokes are currently being sent.
2072 This returns nil if FRAME's focus is not redirected.
2073 See `redirect-frame-focus'. */)
2074 (Lisp_Object frame)
2076 CHECK_LIVE_FRAME (frame);
2078 return FRAME_FOCUS_FRAME (XFRAME (frame));
2083 /* Return the value of frame parameter PROP in frame FRAME. */
2085 #if !HAVE_NS
2086 static
2087 #endif
2088 Lisp_Object
2089 get_frame_param (register struct frame *frame, Lisp_Object prop)
2091 register Lisp_Object tem;
2093 tem = Fassq (prop, frame->param_alist);
2094 if (EQ (tem, Qnil))
2095 return tem;
2096 return Fcdr (tem);
2099 /* Return the buffer-predicate of the selected frame. */
2101 Lisp_Object
2102 frame_buffer_predicate (Lisp_Object frame)
2104 return XFRAME (frame)->buffer_predicate;
2107 /* Return the buffer-list of the selected frame. */
2109 Lisp_Object
2110 frame_buffer_list (Lisp_Object frame)
2112 return XFRAME (frame)->buffer_list;
2115 /* Set the buffer-list of the selected frame. */
2117 void
2118 set_frame_buffer_list (Lisp_Object frame, Lisp_Object list)
2120 XFRAME (frame)->buffer_list = list;
2123 /* Discard BUFFER from the buffer-list and buried-buffer-list of each frame. */
2125 void
2126 frames_discard_buffer (Lisp_Object buffer)
2128 Lisp_Object frame, tail;
2130 FOR_EACH_FRAME (tail, frame)
2132 XFRAME (frame)->buffer_list
2133 = Fdelq (buffer, XFRAME (frame)->buffer_list);
2134 XFRAME (frame)->buried_buffer_list
2135 = Fdelq (buffer, XFRAME (frame)->buried_buffer_list);
2139 /* Modify the alist in *ALISTPTR to associate PROP with VAL.
2140 If the alist already has an element for PROP, we change it. */
2142 void
2143 store_in_alist (Lisp_Object *alistptr, Lisp_Object prop, Lisp_Object val)
2145 register Lisp_Object tem;
2147 tem = Fassq (prop, *alistptr);
2148 if (EQ (tem, Qnil))
2149 *alistptr = Fcons (Fcons (prop, val), *alistptr);
2150 else
2151 Fsetcdr (tem, val);
2154 static int
2155 frame_name_fnn_p (char *str, EMACS_INT len)
2157 if (len > 1 && str[0] == 'F')
2159 char *end_ptr;
2160 long int n;
2161 errno = 0;
2162 n = strtol (str + 1, &end_ptr, 10);
2164 if (end_ptr == str + len
2165 && INT_MIN <= n && n <= INT_MAX
2166 && ((LONG_MIN < n && n < LONG_MAX) || errno != ERANGE))
2167 return 1;
2169 return 0;
2172 /* Set the name of the terminal frame. Also used by MSDOS frames.
2173 Modeled after x_set_name which is used for WINDOW frames. */
2175 static void
2176 set_term_frame_name (struct frame *f, Lisp_Object name)
2178 f->explicit_name = ! NILP (name);
2180 /* If NAME is nil, set the name to F<num>. */
2181 if (NILP (name))
2183 char namebuf[20];
2185 /* Check for no change needed in this very common case
2186 before we do any consing. */
2187 if (frame_name_fnn_p (SSDATA (f->name),
2188 SBYTES (f->name)))
2189 return;
2191 tty_frame_count++;
2192 sprintf (namebuf, "F%d", tty_frame_count);
2193 name = build_string (namebuf);
2195 else
2197 CHECK_STRING (name);
2199 /* Don't change the name if it's already NAME. */
2200 if (! NILP (Fstring_equal (name, f->name)))
2201 return;
2203 /* Don't allow the user to set the frame name to F<num>, so it
2204 doesn't clash with the names we generate for terminal frames. */
2205 if (frame_name_fnn_p (SSDATA (name), SBYTES (name)))
2206 error ("Frame names of the form F<num> are usurped by Emacs");
2209 f->name = name;
2210 update_mode_lines = 1;
2213 void
2214 store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
2216 register Lisp_Object old_alist_elt;
2218 /* The buffer-list parameters are stored in a special place and not
2219 in the alist. All buffers must be live. */
2220 if (EQ (prop, Qbuffer_list))
2222 Lisp_Object list = Qnil;
2223 for (; CONSP (val); val = XCDR (val))
2224 if (!NILP (Fbuffer_live_p (XCAR (val))))
2225 list = Fcons (XCAR (val), list);
2226 f->buffer_list = Fnreverse (list);
2227 return;
2229 if (EQ (prop, Qburied_buffer_list))
2231 Lisp_Object list = Qnil;
2232 for (; CONSP (val); val = XCDR (val))
2233 if (!NILP (Fbuffer_live_p (XCAR (val))))
2234 list = Fcons (XCAR (val), list);
2235 f->buried_buffer_list = Fnreverse (list);
2236 return;
2239 /* If PROP is a symbol which is supposed to have frame-local values,
2240 and it is set up based on this frame, switch to the global
2241 binding. That way, we can create or alter the frame-local binding
2242 without messing up the symbol's status. */
2243 if (SYMBOLP (prop))
2245 struct Lisp_Symbol *sym = XSYMBOL (prop);
2246 start:
2247 switch (sym->redirect)
2249 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
2250 case SYMBOL_PLAINVAL: case SYMBOL_FORWARDED: break;
2251 case SYMBOL_LOCALIZED:
2252 { struct Lisp_Buffer_Local_Value *blv = sym->val.blv;
2253 if (blv->frame_local && BLV_FOUND (blv) && XFRAME (blv->where) == f)
2254 swap_in_global_binding (sym);
2255 break;
2257 default: abort ();
2261 /* The tty color needed to be set before the frame's parameter
2262 alist was updated with the new value. This is not true any more,
2263 but we still do this test early on. */
2264 if (FRAME_TERMCAP_P (f) && EQ (prop, Qtty_color_mode)
2265 && f == FRAME_TTY (f)->previous_frame)
2266 /* Force redisplay of this tty. */
2267 FRAME_TTY (f)->previous_frame = NULL;
2269 /* Update the frame parameter alist. */
2270 old_alist_elt = Fassq (prop, f->param_alist);
2271 if (EQ (old_alist_elt, Qnil))
2272 f->param_alist = Fcons (Fcons (prop, val), f->param_alist);
2273 else
2274 Fsetcdr (old_alist_elt, val);
2276 /* Update some other special parameters in their special places
2277 in addition to the alist. */
2279 if (EQ (prop, Qbuffer_predicate))
2280 f->buffer_predicate = val;
2282 if (! FRAME_WINDOW_P (f))
2284 if (EQ (prop, Qmenu_bar_lines))
2285 set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f)));
2286 else if (EQ (prop, Qname))
2287 set_term_frame_name (f, val);
2290 if (EQ (prop, Qminibuffer) && WINDOWP (val))
2292 if (! MINI_WINDOW_P (XWINDOW (val)))
2293 error ("Surrogate minibuffer windows must be minibuffer windows");
2295 if ((FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
2296 && !EQ (val, f->minibuffer_window))
2297 error ("Can't change the surrogate minibuffer of a frame with its own minibuffer");
2299 /* Install the chosen minibuffer window, with proper buffer. */
2300 f->minibuffer_window = val;
2304 DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0,
2305 doc: /* Return the parameters-alist of frame FRAME.
2306 It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
2307 The meaningful PARMs depend on the kind of frame.
2308 If FRAME is omitted, return information on the currently selected frame. */)
2309 (Lisp_Object frame)
2311 Lisp_Object alist;
2312 FRAME_PTR f;
2313 int height, width;
2314 struct gcpro gcpro1;
2316 if (NILP (frame))
2317 frame = selected_frame;
2319 CHECK_FRAME (frame);
2320 f = XFRAME (frame);
2322 if (!FRAME_LIVE_P (f))
2323 return Qnil;
2325 alist = Fcopy_alist (f->param_alist);
2326 GCPRO1 (alist);
2328 if (!FRAME_WINDOW_P (f))
2330 int fg = FRAME_FOREGROUND_PIXEL (f);
2331 int bg = FRAME_BACKGROUND_PIXEL (f);
2332 Lisp_Object elt;
2334 /* If the frame's parameter alist says the colors are
2335 unspecified and reversed, take the frame's background pixel
2336 for foreground and vice versa. */
2337 elt = Fassq (Qforeground_color, alist);
2338 if (CONSP (elt) && STRINGP (XCDR (elt)))
2340 if (strncmp (SSDATA (XCDR (elt)),
2341 unspecified_bg,
2342 SCHARS (XCDR (elt))) == 0)
2343 store_in_alist (&alist, Qforeground_color, tty_color_name (f, bg));
2344 else if (strncmp (SSDATA (XCDR (elt)),
2345 unspecified_fg,
2346 SCHARS (XCDR (elt))) == 0)
2347 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2349 else
2350 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2351 elt = Fassq (Qbackground_color, alist);
2352 if (CONSP (elt) && STRINGP (XCDR (elt)))
2354 if (strncmp (SSDATA (XCDR (elt)),
2355 unspecified_fg,
2356 SCHARS (XCDR (elt))) == 0)
2357 store_in_alist (&alist, Qbackground_color, tty_color_name (f, fg));
2358 else if (strncmp (SSDATA (XCDR (elt)),
2359 unspecified_bg,
2360 SCHARS (XCDR (elt))) == 0)
2361 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2363 else
2364 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2365 store_in_alist (&alist, intern ("font"),
2366 build_string (FRAME_MSDOS_P (f)
2367 ? "ms-dos"
2368 : FRAME_W32_P (f) ? "w32term"
2369 :"tty"));
2371 store_in_alist (&alist, Qname, f->name);
2372 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2373 store_in_alist (&alist, Qheight, make_number (height));
2374 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2375 store_in_alist (&alist, Qwidth, make_number (width));
2376 store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil));
2377 store_in_alist (&alist, Qminibuffer,
2378 (! FRAME_HAS_MINIBUF_P (f) ? Qnil
2379 : FRAME_MINIBUF_ONLY_P (f) ? Qonly
2380 : FRAME_MINIBUF_WINDOW (f)));
2381 store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
2382 store_in_alist (&alist, Qbuffer_list, frame_buffer_list (frame));
2383 store_in_alist (&alist, Qburied_buffer_list, XFRAME (frame)->buried_buffer_list);
2385 /* I think this should be done with a hook. */
2386 #ifdef HAVE_WINDOW_SYSTEM
2387 if (FRAME_WINDOW_P (f))
2388 x_report_frame_params (f, &alist);
2389 else
2390 #endif
2392 /* This ought to be correct in f->param_alist for an X frame. */
2393 Lisp_Object lines;
2394 XSETFASTINT (lines, FRAME_MENU_BAR_LINES (f));
2395 store_in_alist (&alist, Qmenu_bar_lines, lines);
2398 UNGCPRO;
2399 return alist;
2403 DEFUN ("frame-parameter", Fframe_parameter, Sframe_parameter, 2, 2, 0,
2404 doc: /* Return FRAME's value for parameter PARAMETER.
2405 If FRAME is nil, describe the currently selected frame. */)
2406 (Lisp_Object frame, Lisp_Object parameter)
2408 struct frame *f;
2409 Lisp_Object value;
2411 if (NILP (frame))
2412 frame = selected_frame;
2413 else
2414 CHECK_FRAME (frame);
2415 CHECK_SYMBOL (parameter);
2417 f = XFRAME (frame);
2418 value = Qnil;
2420 if (FRAME_LIVE_P (f))
2422 /* Avoid consing in frequent cases. */
2423 if (EQ (parameter, Qname))
2424 value = f->name;
2425 #ifdef HAVE_X_WINDOWS
2426 else if (EQ (parameter, Qdisplay) && FRAME_X_P (f))
2427 value = XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element);
2428 #endif /* HAVE_X_WINDOWS */
2429 else if (EQ (parameter, Qbackground_color)
2430 || EQ (parameter, Qforeground_color))
2432 value = Fassq (parameter, f->param_alist);
2433 if (CONSP (value))
2435 value = XCDR (value);
2436 /* Fframe_parameters puts the actual fg/bg color names,
2437 even if f->param_alist says otherwise. This is
2438 important when param_alist's notion of colors is
2439 "unspecified". We need to do the same here. */
2440 if (STRINGP (value) && !FRAME_WINDOW_P (f))
2442 const char *color_name;
2443 EMACS_INT csz;
2445 if (EQ (parameter, Qbackground_color))
2447 color_name = SSDATA (value);
2448 csz = SCHARS (value);
2449 if (strncmp (color_name, unspecified_bg, csz) == 0)
2450 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2451 else if (strncmp (color_name, unspecified_fg, csz) == 0)
2452 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2454 else if (EQ (parameter, Qforeground_color))
2456 color_name = SSDATA (value);
2457 csz = SCHARS (value);
2458 if (strncmp (color_name, unspecified_fg, csz) == 0)
2459 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2460 else if (strncmp (color_name, unspecified_bg, csz) == 0)
2461 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2465 else
2466 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2468 else if (EQ (parameter, Qdisplay_type)
2469 || EQ (parameter, Qbackground_mode))
2470 value = Fcdr (Fassq (parameter, f->param_alist));
2471 else
2472 /* FIXME: Avoid this code path at all (as well as code duplication)
2473 by sharing more code with Fframe_parameters. */
2474 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2477 return value;
2481 DEFUN ("modify-frame-parameters", Fmodify_frame_parameters,
2482 Smodify_frame_parameters, 2, 2, 0,
2483 doc: /* Modify the parameters of frame FRAME according to ALIST.
2484 If FRAME is nil, it defaults to the selected frame.
2485 ALIST is an alist of parameters to change and their new values.
2486 Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.
2487 The meaningful PARMs depend on the kind of frame.
2488 Undefined PARMs are ignored, but stored in the frame's parameter list
2489 so that `frame-parameters' will return them.
2491 The value of frame parameter FOO can also be accessed
2492 as a frame-local binding for the variable FOO, if you have
2493 enabled such bindings for that variable with `make-variable-frame-local'.
2494 Note that this functionality is obsolete as of Emacs 22.2, and its
2495 use is not recommended. Explicitly check for a frame-parameter instead. */)
2496 (Lisp_Object frame, Lisp_Object alist)
2498 FRAME_PTR f;
2499 register Lisp_Object tail, prop, val;
2501 if (EQ (frame, Qnil))
2502 frame = selected_frame;
2503 CHECK_LIVE_FRAME (frame);
2504 f = XFRAME (frame);
2506 /* I think this should be done with a hook. */
2507 #ifdef HAVE_WINDOW_SYSTEM
2508 if (FRAME_WINDOW_P (f))
2509 x_set_frame_parameters (f, alist);
2510 else
2511 #endif
2512 #ifdef MSDOS
2513 if (FRAME_MSDOS_P (f))
2514 IT_set_frame_parameters (f, alist);
2515 else
2516 #endif
2519 int length = XINT (Flength (alist));
2520 int i;
2521 Lisp_Object *parms
2522 = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
2523 Lisp_Object *values
2524 = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
2526 /* Extract parm names and values into those vectors. */
2528 i = 0;
2529 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2531 Lisp_Object elt;
2533 elt = XCAR (tail);
2534 parms[i] = Fcar (elt);
2535 values[i] = Fcdr (elt);
2536 i++;
2539 /* Now process them in reverse of specified order. */
2540 while (--i >= 0)
2542 prop = parms[i];
2543 val = values[i];
2544 store_frame_param (f, prop, val);
2546 /* Changing the background color might change the background
2547 mode, so that we have to load new defface specs.
2548 Call frame-set-background-mode to do that. */
2549 if (EQ (prop, Qbackground_color))
2550 call1 (Qframe_set_background_mode, frame);
2553 return Qnil;
2556 DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height,
2557 0, 1, 0,
2558 doc: /* Height in pixels of a line in the font in frame FRAME.
2559 If FRAME is omitted, the selected frame is used.
2560 For a terminal frame, the value is always 1. */)
2561 (Lisp_Object frame)
2563 struct frame *f;
2565 if (NILP (frame))
2566 frame = selected_frame;
2567 CHECK_FRAME (frame);
2568 f = XFRAME (frame);
2570 #ifdef HAVE_WINDOW_SYSTEM
2571 if (FRAME_WINDOW_P (f))
2572 return make_number (x_char_height (f));
2573 else
2574 #endif
2575 return make_number (1);
2579 DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width,
2580 0, 1, 0,
2581 doc: /* Width in pixels of characters in the font in frame FRAME.
2582 If FRAME is omitted, the selected frame is used.
2583 On a graphical screen, the width is the standard width of the default font.
2584 For a terminal screen, the value is always 1. */)
2585 (Lisp_Object frame)
2587 struct frame *f;
2589 if (NILP (frame))
2590 frame = selected_frame;
2591 CHECK_FRAME (frame);
2592 f = XFRAME (frame);
2594 #ifdef HAVE_WINDOW_SYSTEM
2595 if (FRAME_WINDOW_P (f))
2596 return make_number (x_char_width (f));
2597 else
2598 #endif
2599 return make_number (1);
2602 DEFUN ("frame-pixel-height", Fframe_pixel_height,
2603 Sframe_pixel_height, 0, 1, 0,
2604 doc: /* Return a FRAME's height in pixels.
2605 If FRAME is omitted, the selected frame is used. The exact value
2606 of the result depends on the window-system and toolkit in use:
2608 In the Gtk+ version of Emacs, it includes only any window (including
2609 the minibuffer or eacho area), mode line, and header line. It does not
2610 include the tool bar or menu bar.
2612 With the Motif or Lucid toolkits, it also includes the tool bar (but
2613 not the menu bar).
2615 In a graphical version with no toolkit, it includes both the tool bar
2616 and menu bar.
2618 For a text-only terminal, it includes the menu bar. In this case, the
2619 result is really in characters rather than pixels (i.e., is identical
2620 to `frame-height'). */)
2621 (Lisp_Object frame)
2623 struct frame *f;
2625 if (NILP (frame))
2626 frame = selected_frame;
2627 CHECK_FRAME (frame);
2628 f = XFRAME (frame);
2630 #ifdef HAVE_WINDOW_SYSTEM
2631 if (FRAME_WINDOW_P (f))
2632 return make_number (x_pixel_height (f));
2633 else
2634 #endif
2635 return make_number (FRAME_LINES (f));
2638 DEFUN ("frame-pixel-width", Fframe_pixel_width,
2639 Sframe_pixel_width, 0, 1, 0,
2640 doc: /* Return FRAME's width in pixels.
2641 For a terminal frame, the result really gives the width in characters.
2642 If FRAME is omitted, the selected frame is used. */)
2643 (Lisp_Object frame)
2645 struct frame *f;
2647 if (NILP (frame))
2648 frame = selected_frame;
2649 CHECK_FRAME (frame);
2650 f = XFRAME (frame);
2652 #ifdef HAVE_WINDOW_SYSTEM
2653 if (FRAME_WINDOW_P (f))
2654 return make_number (x_pixel_width (f));
2655 else
2656 #endif
2657 return make_number (FRAME_COLS (f));
2660 DEFUN ("tool-bar-pixel-width", Ftool_bar_pixel_width,
2661 Stool_bar_pixel_width, 0, 1, 0,
2662 doc: /* Return width in pixels of FRAME's tool bar.
2663 The result is greater than zero only when the tool bar is on the left
2664 or right side of FRAME. If FRAME is omitted, the selected frame is
2665 used. */)
2666 (Lisp_Object frame)
2668 struct frame *f;
2670 if (NILP (frame))
2671 frame = selected_frame;
2672 CHECK_FRAME (frame);
2673 f = XFRAME (frame);
2675 #ifdef FRAME_TOOLBAR_WIDTH
2676 if (FRAME_WINDOW_P (f))
2677 return make_number (FRAME_TOOLBAR_WIDTH (f));
2678 #endif
2679 return make_number (0);
2682 DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0,
2683 doc: /* Specify that the frame FRAME has LINES lines.
2684 Optional third arg non-nil means that redisplay should use LINES lines
2685 but that the idea of the actual height of the frame should not be changed. */)
2686 (Lisp_Object frame, Lisp_Object lines, Lisp_Object pretend)
2688 register struct frame *f;
2690 CHECK_NUMBER (lines);
2691 if (NILP (frame))
2692 frame = selected_frame;
2693 CHECK_LIVE_FRAME (frame);
2694 f = XFRAME (frame);
2696 /* I think this should be done with a hook. */
2697 #ifdef HAVE_WINDOW_SYSTEM
2698 if (FRAME_WINDOW_P (f))
2700 if (XINT (lines) != FRAME_LINES (f))
2701 x_set_window_size (f, 1, FRAME_COLS (f), XINT (lines));
2702 do_pending_window_change (0);
2704 else
2705 #endif
2706 change_frame_size (f, XINT (lines), 0, !NILP (pretend), 0, 0);
2707 return Qnil;
2710 DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 3, 0,
2711 doc: /* Specify that the frame FRAME has COLS columns.
2712 Optional third arg non-nil means that redisplay should use COLS columns
2713 but that the idea of the actual width of the frame should not be changed. */)
2714 (Lisp_Object frame, Lisp_Object cols, Lisp_Object pretend)
2716 register struct frame *f;
2717 CHECK_NUMBER (cols);
2718 if (NILP (frame))
2719 frame = selected_frame;
2720 CHECK_LIVE_FRAME (frame);
2721 f = XFRAME (frame);
2723 /* I think this should be done with a hook. */
2724 #ifdef HAVE_WINDOW_SYSTEM
2725 if (FRAME_WINDOW_P (f))
2727 if (XINT (cols) != FRAME_COLS (f))
2728 x_set_window_size (f, 1, XINT (cols), FRAME_LINES (f));
2729 do_pending_window_change (0);
2731 else
2732 #endif
2733 change_frame_size (f, 0, XINT (cols), !NILP (pretend), 0, 0);
2734 return Qnil;
2737 DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0,
2738 doc: /* Sets size of FRAME to COLS by ROWS, measured in characters. */)
2739 (Lisp_Object frame, Lisp_Object cols, Lisp_Object rows)
2741 register struct frame *f;
2743 CHECK_LIVE_FRAME (frame);
2744 CHECK_NUMBER (cols);
2745 CHECK_NUMBER (rows);
2746 f = XFRAME (frame);
2748 /* I think this should be done with a hook. */
2749 #ifdef HAVE_WINDOW_SYSTEM
2750 if (FRAME_WINDOW_P (f))
2752 if (XINT (rows) != FRAME_LINES (f)
2753 || XINT (cols) != FRAME_COLS (f)
2754 || f->new_text_lines || f->new_text_cols)
2755 x_set_window_size (f, 1, XINT (cols), XINT (rows));
2756 do_pending_window_change (0);
2758 else
2759 #endif
2760 change_frame_size (f, XINT (rows), XINT (cols), 0, 0, 0);
2762 return Qnil;
2765 DEFUN ("set-frame-position", Fset_frame_position,
2766 Sset_frame_position, 3, 3, 0,
2767 doc: /* Sets position of FRAME in pixels to XOFFSET by YOFFSET.
2768 This is actually the position of the upper left corner of the frame.
2769 Negative values for XOFFSET or YOFFSET are interpreted relative to
2770 the rightmost or bottommost possible position (that stays within the screen). */)
2771 (Lisp_Object frame, Lisp_Object xoffset, Lisp_Object yoffset)
2773 register struct frame *f;
2775 CHECK_LIVE_FRAME (frame);
2776 CHECK_NUMBER (xoffset);
2777 CHECK_NUMBER (yoffset);
2778 f = XFRAME (frame);
2780 /* I think this should be done with a hook. */
2781 #ifdef HAVE_WINDOW_SYSTEM
2782 if (FRAME_WINDOW_P (f))
2783 x_set_offset (f, XINT (xoffset), XINT (yoffset), 1);
2784 #endif
2786 return Qt;
2790 /***********************************************************************
2791 Frame Parameters
2792 ***********************************************************************/
2794 /* Connect the frame-parameter names for X frames
2795 to the ways of passing the parameter values to the window system.
2797 The name of a parameter, as a Lisp symbol,
2798 has an `x-frame-parameter' property which is an integer in Lisp
2799 that is an index in this table. */
2801 struct frame_parm_table {
2802 const char *name;
2803 Lisp_Object *variable;
2806 static const struct frame_parm_table frame_parms[] =
2808 {"auto-raise", &Qauto_raise},
2809 {"auto-lower", &Qauto_lower},
2810 {"background-color", 0},
2811 {"border-color", &Qborder_color},
2812 {"border-width", &Qborder_width},
2813 {"cursor-color", &Qcursor_color},
2814 {"cursor-type", &Qcursor_type},
2815 {"font", 0},
2816 {"foreground-color", 0},
2817 {"icon-name", &Qicon_name},
2818 {"icon-type", &Qicon_type},
2819 {"internal-border-width", &Qinternal_border_width},
2820 {"menu-bar-lines", &Qmenu_bar_lines},
2821 {"mouse-color", &Qmouse_color},
2822 {"name", &Qname},
2823 {"scroll-bar-width", &Qscroll_bar_width},
2824 {"title", &Qtitle},
2825 {"unsplittable", &Qunsplittable},
2826 {"vertical-scroll-bars", &Qvertical_scroll_bars},
2827 {"visibility", &Qvisibility},
2828 {"tool-bar-lines", &Qtool_bar_lines},
2829 {"scroll-bar-foreground", &Qscroll_bar_foreground},
2830 {"scroll-bar-background", &Qscroll_bar_background},
2831 {"screen-gamma", &Qscreen_gamma},
2832 {"line-spacing", &Qline_spacing},
2833 {"left-fringe", &Qleft_fringe},
2834 {"right-fringe", &Qright_fringe},
2835 {"wait-for-wm", &Qwait_for_wm},
2836 {"fullscreen", &Qfullscreen},
2837 {"font-backend", &Qfont_backend},
2838 {"alpha", &Qalpha},
2839 {"sticky", &Qsticky},
2840 {"tool-bar-position", &Qtool_bar_position},
2843 #ifdef WINDOWSNT
2845 /* Calculate fullscreen size. Return in *TOP_POS and *LEFT_POS the
2846 wanted positions of the WM window (not Emacs window).
2847 Return in *WIDTH and *HEIGHT the wanted width and height of Emacs
2848 window (FRAME_X_WINDOW).
2851 void
2852 x_fullscreen_adjust (struct frame *f, int *width, int *height, int *top_pos, int *left_pos)
2854 int newwidth = FRAME_COLS (f);
2855 int newheight = FRAME_LINES (f);
2856 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2858 *top_pos = f->top_pos;
2859 *left_pos = f->left_pos;
2861 if (f->want_fullscreen & FULLSCREEN_HEIGHT)
2863 int ph;
2865 ph = x_display_pixel_height (dpyinfo);
2866 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2867 ph = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, newheight) - f->y_pixels_diff;
2868 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2869 *top_pos = 0;
2872 if (f->want_fullscreen & FULLSCREEN_WIDTH)
2874 int pw;
2876 pw = x_display_pixel_width (dpyinfo);
2877 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2878 pw = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, newwidth) - f->x_pixels_diff;
2879 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2880 *left_pos = 0;
2883 *width = newwidth;
2884 *height = newheight;
2887 #endif /* WINDOWSNT */
2889 #ifdef HAVE_WINDOW_SYSTEM
2891 /* Change the parameters of frame F as specified by ALIST.
2892 If a parameter is not specially recognized, do nothing special;
2893 otherwise call the `x_set_...' function for that parameter.
2894 Except for certain geometry properties, always call store_frame_param
2895 to store the new value in the parameter alist. */
2897 void
2898 x_set_frame_parameters (FRAME_PTR f, Lisp_Object alist)
2900 Lisp_Object tail;
2902 /* If both of these parameters are present, it's more efficient to
2903 set them both at once. So we wait until we've looked at the
2904 entire list before we set them. */
2905 int width, height;
2907 /* Same here. */
2908 Lisp_Object left, top;
2910 /* Same with these. */
2911 Lisp_Object icon_left, icon_top;
2913 /* Record in these vectors all the parms specified. */
2914 Lisp_Object *parms;
2915 Lisp_Object *values;
2916 size_t i, p;
2917 int left_no_change = 0, top_no_change = 0;
2918 int icon_left_no_change = 0, icon_top_no_change = 0;
2919 int size_changed = 0;
2920 struct gcpro gcpro1, gcpro2;
2922 i = 0;
2923 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
2924 i++;
2926 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
2927 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
2929 /* Extract parm names and values into those vectors. */
2931 i = 0;
2932 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2934 Lisp_Object elt;
2936 elt = XCAR (tail);
2937 parms[i] = Fcar (elt);
2938 values[i] = Fcdr (elt);
2939 i++;
2941 /* TAIL and ALIST are not used again below here. */
2942 alist = tail = Qnil;
2944 GCPRO2 (*parms, *values);
2945 gcpro1.nvars = i;
2946 gcpro2.nvars = i;
2948 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
2949 because their values appear in VALUES and strings are not valid. */
2950 top = left = Qunbound;
2951 icon_left = icon_top = Qunbound;
2953 /* Provide default values for HEIGHT and WIDTH. */
2954 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2955 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2957 /* Process foreground_color and background_color before anything else.
2958 They are independent of other properties, but other properties (e.g.,
2959 cursor_color) are dependent upon them. */
2960 /* Process default font as well, since fringe widths depends on it. */
2961 for (p = 0; p < i; p++)
2963 Lisp_Object prop, val;
2965 prop = parms[p];
2966 val = values[p];
2967 if (EQ (prop, Qforeground_color)
2968 || EQ (prop, Qbackground_color)
2969 || EQ (prop, Qfont))
2971 register Lisp_Object param_index, old_value;
2973 old_value = get_frame_param (f, prop);
2974 if (NILP (Fequal (val, old_value)))
2976 store_frame_param (f, prop, val);
2978 param_index = Fget (prop, Qx_frame_parameter);
2979 if (NATNUMP (param_index)
2980 && (XFASTINT (param_index)
2981 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2982 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
2983 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2988 /* Now process them in reverse of specified order. */
2989 while (i-- != 0)
2991 Lisp_Object prop, val;
2993 prop = parms[i];
2994 val = values[i];
2996 if (EQ (prop, Qwidth) && NATNUMP (val))
2998 size_changed = 1;
2999 width = XFASTINT (val);
3001 else if (EQ (prop, Qheight) && NATNUMP (val))
3003 size_changed = 1;
3004 height = XFASTINT (val);
3006 else if (EQ (prop, Qtop))
3007 top = val;
3008 else if (EQ (prop, Qleft))
3009 left = val;
3010 else if (EQ (prop, Qicon_top))
3011 icon_top = val;
3012 else if (EQ (prop, Qicon_left))
3013 icon_left = val;
3014 else if (EQ (prop, Qforeground_color)
3015 || EQ (prop, Qbackground_color)
3016 || EQ (prop, Qfont))
3017 /* Processed above. */
3018 continue;
3019 else
3021 register Lisp_Object param_index, old_value;
3023 old_value = get_frame_param (f, prop);
3025 store_frame_param (f, prop, val);
3027 param_index = Fget (prop, Qx_frame_parameter);
3028 if (NATNUMP (param_index)
3029 && (XFASTINT (param_index)
3030 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3031 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
3032 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
3036 /* Don't die if just one of these was set. */
3037 if (EQ (left, Qunbound))
3039 left_no_change = 1;
3040 if (f->left_pos < 0)
3041 left = Fcons (Qplus, Fcons (make_number (f->left_pos), Qnil));
3042 else
3043 XSETINT (left, f->left_pos);
3045 if (EQ (top, Qunbound))
3047 top_no_change = 1;
3048 if (f->top_pos < 0)
3049 top = Fcons (Qplus, Fcons (make_number (f->top_pos), Qnil));
3050 else
3051 XSETINT (top, f->top_pos);
3054 /* If one of the icon positions was not set, preserve or default it. */
3055 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
3057 icon_left_no_change = 1;
3058 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
3059 if (NILP (icon_left))
3060 XSETINT (icon_left, 0);
3062 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
3064 icon_top_no_change = 1;
3065 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
3066 if (NILP (icon_top))
3067 XSETINT (icon_top, 0);
3070 /* Don't set these parameters unless they've been explicitly
3071 specified. The window might be mapped or resized while we're in
3072 this function, and we don't want to override that unless the lisp
3073 code has asked for it.
3075 Don't set these parameters unless they actually differ from the
3076 window's current parameters; the window may not actually exist
3077 yet. */
3079 Lisp_Object frame;
3081 check_frame_size (f, &height, &width);
3083 XSETFRAME (frame, f);
3085 if (size_changed
3086 && (width != FRAME_COLS (f)
3087 || height != FRAME_LINES (f)
3088 || f->new_text_lines || f->new_text_cols))
3089 Fset_frame_size (frame, make_number (width), make_number (height));
3091 if ((!NILP (left) || !NILP (top))
3092 && ! (left_no_change && top_no_change)
3093 && ! (NUMBERP (left) && XINT (left) == f->left_pos
3094 && NUMBERP (top) && XINT (top) == f->top_pos))
3096 int leftpos = 0;
3097 int toppos = 0;
3099 /* Record the signs. */
3100 f->size_hint_flags &= ~ (XNegative | YNegative);
3101 if (EQ (left, Qminus))
3102 f->size_hint_flags |= XNegative;
3103 else if (INTEGERP (left))
3105 leftpos = XINT (left);
3106 if (leftpos < 0)
3107 f->size_hint_flags |= XNegative;
3109 else if (CONSP (left) && EQ (XCAR (left), Qminus)
3110 && CONSP (XCDR (left))
3111 && INTEGERP (XCAR (XCDR (left))))
3113 leftpos = - XINT (XCAR (XCDR (left)));
3114 f->size_hint_flags |= XNegative;
3116 else if (CONSP (left) && EQ (XCAR (left), Qplus)
3117 && CONSP (XCDR (left))
3118 && INTEGERP (XCAR (XCDR (left))))
3120 leftpos = XINT (XCAR (XCDR (left)));
3123 if (EQ (top, Qminus))
3124 f->size_hint_flags |= YNegative;
3125 else if (INTEGERP (top))
3127 toppos = XINT (top);
3128 if (toppos < 0)
3129 f->size_hint_flags |= YNegative;
3131 else if (CONSP (top) && EQ (XCAR (top), Qminus)
3132 && CONSP (XCDR (top))
3133 && INTEGERP (XCAR (XCDR (top))))
3135 toppos = - XINT (XCAR (XCDR (top)));
3136 f->size_hint_flags |= YNegative;
3138 else if (CONSP (top) && EQ (XCAR (top), Qplus)
3139 && CONSP (XCDR (top))
3140 && INTEGERP (XCAR (XCDR (top))))
3142 toppos = XINT (XCAR (XCDR (top)));
3146 /* Store the numeric value of the position. */
3147 f->top_pos = toppos;
3148 f->left_pos = leftpos;
3150 f->win_gravity = NorthWestGravity;
3152 /* Actually set that position, and convert to absolute. */
3153 x_set_offset (f, leftpos, toppos, -1);
3156 if ((!NILP (icon_left) || !NILP (icon_top))
3157 && ! (icon_left_no_change && icon_top_no_change))
3158 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
3161 UNGCPRO;
3165 /* Insert a description of internally-recorded parameters of frame X
3166 into the parameter alist *ALISTPTR that is to be given to the user.
3167 Only parameters that are specific to the X window system
3168 and whose values are not correctly recorded in the frame's
3169 param_alist need to be considered here. */
3171 void
3172 x_report_frame_params (struct frame *f, Lisp_Object *alistptr)
3174 char buf[16];
3175 Lisp_Object tem;
3177 /* Represent negative positions (off the top or left screen edge)
3178 in a way that Fmodify_frame_parameters will understand correctly. */
3179 XSETINT (tem, f->left_pos);
3180 if (f->left_pos >= 0)
3181 store_in_alist (alistptr, Qleft, tem);
3182 else
3183 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
3185 XSETINT (tem, f->top_pos);
3186 if (f->top_pos >= 0)
3187 store_in_alist (alistptr, Qtop, tem);
3188 else
3189 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
3191 store_in_alist (alistptr, Qborder_width,
3192 make_number (f->border_width));
3193 store_in_alist (alistptr, Qinternal_border_width,
3194 make_number (FRAME_INTERNAL_BORDER_WIDTH (f)));
3195 store_in_alist (alistptr, Qleft_fringe,
3196 make_number (FRAME_LEFT_FRINGE_WIDTH (f)));
3197 store_in_alist (alistptr, Qright_fringe,
3198 make_number (FRAME_RIGHT_FRINGE_WIDTH (f)));
3199 store_in_alist (alistptr, Qscroll_bar_width,
3200 (! FRAME_HAS_VERTICAL_SCROLL_BARS (f)
3201 ? make_number (0)
3202 : FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0
3203 ? make_number (FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3204 /* nil means "use default width"
3205 for non-toolkit scroll bar.
3206 ruler-mode.el depends on this. */
3207 : Qnil));
3208 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
3209 store_in_alist (alistptr, Qwindow_id,
3210 build_string (buf));
3211 #ifdef HAVE_X_WINDOWS
3212 #ifdef USE_X_TOOLKIT
3213 /* Tooltip frame may not have this widget. */
3214 if (FRAME_X_OUTPUT (f)->widget)
3215 #endif
3216 sprintf (buf, "%ld", (long) FRAME_OUTER_WINDOW (f));
3217 store_in_alist (alistptr, Qouter_window_id,
3218 build_string (buf));
3219 #endif
3220 store_in_alist (alistptr, Qicon_name, f->icon_name);
3221 FRAME_SAMPLE_VISIBILITY (f);
3222 store_in_alist (alistptr, Qvisibility,
3223 (FRAME_VISIBLE_P (f) ? Qt
3224 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
3225 store_in_alist (alistptr, Qdisplay,
3226 XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
3228 if (FRAME_X_OUTPUT (f)->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
3229 tem = Qnil;
3230 else
3231 XSETFASTINT (tem, FRAME_X_OUTPUT (f)->parent_desc);
3232 store_in_alist (alistptr, Qexplicit_name, (f->explicit_name ? Qt : Qnil));
3233 store_in_alist (alistptr, Qparent_id, tem);
3234 store_in_alist (alistptr, Qtool_bar_position, f->tool_bar_position);
3238 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
3239 the previous value of that parameter, NEW_VALUE is the new value. */
3241 void
3242 x_set_fullscreen (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3244 if (NILP (new_value))
3245 f->want_fullscreen = FULLSCREEN_NONE;
3246 else if (EQ (new_value, Qfullboth) || EQ (new_value, Qfullscreen))
3247 f->want_fullscreen = FULLSCREEN_BOTH;
3248 else if (EQ (new_value, Qfullwidth))
3249 f->want_fullscreen = FULLSCREEN_WIDTH;
3250 else if (EQ (new_value, Qfullheight))
3251 f->want_fullscreen = FULLSCREEN_HEIGHT;
3252 else if (EQ (new_value, Qmaximized))
3253 f->want_fullscreen = FULLSCREEN_MAXIMIZED;
3255 if (FRAME_TERMINAL (f)->fullscreen_hook != NULL)
3256 FRAME_TERMINAL (f)->fullscreen_hook (f);
3260 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
3261 the previous value of that parameter, NEW_VALUE is the new value. */
3263 void
3264 x_set_line_spacing (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3266 if (NILP (new_value))
3267 f->extra_line_spacing = 0;
3268 else if (NATNUMP (new_value))
3269 f->extra_line_spacing = XFASTINT (new_value);
3270 else
3271 signal_error ("Invalid line-spacing", new_value);
3272 if (FRAME_VISIBLE_P (f))
3273 redraw_frame (f);
3277 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
3278 the previous value of that parameter, NEW_VALUE is the new value. */
3280 void
3281 x_set_screen_gamma (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3283 Lisp_Object bgcolor;
3285 if (NILP (new_value))
3286 f->gamma = 0;
3287 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
3288 /* The value 0.4545 is the normal viewing gamma. */
3289 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
3290 else
3291 signal_error ("Invalid screen-gamma", new_value);
3293 /* Apply the new gamma value to the frame background. */
3294 bgcolor = Fassq (Qbackground_color, f->param_alist);
3295 if (CONSP (bgcolor) && (bgcolor = XCDR (bgcolor), STRINGP (bgcolor)))
3297 Lisp_Object parm_index = Fget (Qbackground_color, Qx_frame_parameter);
3298 if (NATNUMP (parm_index)
3299 && (XFASTINT (parm_index)
3300 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3301 && FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
3302 (*FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
3303 (f, bgcolor, Qnil);
3306 Fclear_face_cache (Qnil);
3310 void
3311 x_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3313 Lisp_Object font_object, font_param = Qnil;
3314 int fontset = -1;
3316 /* Set the frame parameter back to the old value because we may
3317 fail to use ARG as the new parameter value. */
3318 store_frame_param (f, Qfont, oldval);
3320 /* ARG is a fontset name, a font name, a cons of fontset name and a
3321 font object, or a font object. In the last case, this function
3322 never fail. */
3323 if (STRINGP (arg))
3325 font_param = arg;
3326 fontset = fs_query_fontset (arg, 0);
3327 if (fontset < 0)
3329 font_object = font_open_by_name (f, SSDATA (arg));
3330 if (NILP (font_object))
3331 error ("Font `%s' is not defined", SSDATA (arg));
3332 arg = AREF (font_object, FONT_NAME_INDEX);
3334 else if (fontset > 0)
3336 Lisp_Object ascii_font = fontset_ascii (fontset);
3338 font_object = font_open_by_name (f, SSDATA (ascii_font));
3339 if (NILP (font_object))
3340 error ("Font `%s' is not defined", SDATA (arg));
3341 arg = AREF (font_object, FONT_NAME_INDEX);
3343 else
3344 error ("The default fontset can't be used for a frame font");
3346 else if (CONSP (arg) && STRINGP (XCAR (arg)) && FONT_OBJECT_P (XCDR (arg)))
3348 /* This is the case that the ASCII font of F's fontset XCAR
3349 (arg) is changed to the font XCDR (arg) by
3350 `set-fontset-font'. */
3351 fontset = fs_query_fontset (XCAR (arg), 0);
3352 if (fontset < 0)
3353 error ("Unknown fontset: %s", SDATA (XCAR (arg)));
3354 font_object = XCDR (arg);
3355 arg = AREF (font_object, FONT_NAME_INDEX);
3356 font_param = Ffont_get (font_object, QCname);
3358 else if (FONT_OBJECT_P (arg))
3360 font_object = arg;
3361 font_param = Ffont_get (font_object, QCname);
3362 /* This is to store the XLFD font name in the frame parameter for
3363 backward compatibility. We should store the font-object
3364 itself in the future. */
3365 arg = AREF (font_object, FONT_NAME_INDEX);
3366 fontset = FRAME_FONTSET (f);
3367 /* Check if we can use the current fontset. If not, set FONTSET
3368 to -1 to generate a new fontset from FONT-OBJECT. */
3369 if (fontset >= 0)
3371 Lisp_Object ascii_font = fontset_ascii (fontset);
3372 Lisp_Object spec = font_spec_from_name (ascii_font);
3374 if (! font_match_p (spec, font_object))
3375 fontset = -1;
3378 else
3379 signal_error ("Invalid font", arg);
3381 if (! NILP (Fequal (font_object, oldval)))
3382 return;
3384 x_new_font (f, font_object, fontset);
3385 store_frame_param (f, Qfont, arg);
3386 #ifdef HAVE_X_WINDOWS
3387 store_frame_param (f, Qfont_param, font_param);
3388 #endif
3389 /* Recalculate toolbar height. */
3390 f->n_tool_bar_rows = 0;
3391 /* Ensure we redraw it. */
3392 clear_current_matrices (f);
3394 recompute_basic_faces (f);
3396 do_pending_window_change (0);
3398 /* We used to call face-set-after-frame-default here, but it leads to
3399 recursive calls (since that function can set the `default' face's
3400 font which in turns changes the frame's `font' parameter).
3401 Also I don't know what this call is meant to do, but it seems the
3402 wrong way to do it anyway (it does a lot more work than what seems
3403 reasonable in response to a change to `font'). */
3407 void
3408 x_set_font_backend (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3410 if (! NILP (new_value)
3411 && !CONSP (new_value))
3413 char *p0, *p1;
3415 CHECK_STRING (new_value);
3416 p0 = p1 = SSDATA (new_value);
3417 new_value = Qnil;
3418 while (*p0)
3420 while (*p1 && ! isspace (*p1) && *p1 != ',') p1++;
3421 if (p0 < p1)
3422 new_value = Fcons (Fintern (make_string (p0, p1 - p0), Qnil),
3423 new_value);
3424 if (*p1)
3426 int c;
3428 while ((c = *++p1) && isspace (c));
3430 p0 = p1;
3432 new_value = Fnreverse (new_value);
3435 if (! NILP (old_value) && ! NILP (Fequal (old_value, new_value)))
3436 return;
3438 if (FRAME_FONT (f))
3439 free_all_realized_faces (Qnil);
3441 new_value = font_update_drivers (f, NILP (new_value) ? Qt : new_value);
3442 if (NILP (new_value))
3444 if (NILP (old_value))
3445 error ("No font backend available");
3446 font_update_drivers (f, old_value);
3447 error ("None of specified font backends are available");
3449 store_frame_param (f, Qfont_backend, new_value);
3451 if (FRAME_FONT (f))
3453 Lisp_Object frame;
3455 XSETFRAME (frame, f);
3456 x_set_font (f, Fframe_parameter (frame, Qfont), Qnil);
3457 ++face_change_count;
3458 ++windows_or_buffers_changed;
3463 void
3464 x_set_fringe_width (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3466 compute_fringe_widths (f, 1);
3467 #ifdef HAVE_X_WINDOWS
3468 /* Must adjust this so window managers report correct number of columns. */
3469 if (FRAME_X_WINDOW (f) != 0)
3470 x_wm_set_size_hint (f, 0, 0);
3471 #endif
3474 void
3475 x_set_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3477 CHECK_NUMBER (arg);
3479 if (XINT (arg) == f->border_width)
3480 return;
3482 if (FRAME_X_WINDOW (f) != 0)
3483 error ("Cannot change the border width of a frame");
3485 f->border_width = XINT (arg);
3488 void
3489 x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3491 int old = FRAME_INTERNAL_BORDER_WIDTH (f);
3493 CHECK_NUMBER (arg);
3494 FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
3495 if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
3496 FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
3498 #ifdef USE_X_TOOLKIT
3499 if (FRAME_X_OUTPUT (f)->edit_widget)
3500 widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
3501 #endif
3503 if (FRAME_INTERNAL_BORDER_WIDTH (f) == old)
3504 return;
3506 if (FRAME_X_WINDOW (f) != 0)
3508 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3509 SET_FRAME_GARBAGED (f);
3510 do_pending_window_change (0);
3512 else
3513 SET_FRAME_GARBAGED (f);
3516 void
3517 x_set_visibility (struct frame *f, Lisp_Object value, Lisp_Object oldval)
3519 Lisp_Object frame;
3520 XSETFRAME (frame, f);
3522 if (NILP (value))
3523 Fmake_frame_invisible (frame, Qt);
3524 else if (EQ (value, Qicon))
3525 Ficonify_frame (frame);
3526 else
3527 Fmake_frame_visible (frame);
3530 void
3531 x_set_autoraise (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3533 f->auto_raise = !EQ (Qnil, arg);
3536 void
3537 x_set_autolower (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3539 f->auto_lower = !EQ (Qnil, arg);
3542 void
3543 x_set_unsplittable (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3545 f->no_split = !NILP (arg);
3548 void
3549 x_set_vertical_scroll_bars (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3551 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
3552 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
3553 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
3554 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
3556 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
3557 = (NILP (arg)
3558 ? vertical_scroll_bar_none
3559 : EQ (Qleft, arg)
3560 ? vertical_scroll_bar_left
3561 : EQ (Qright, arg)
3562 ? vertical_scroll_bar_right
3563 : EQ (Qleft, Vdefault_frame_scroll_bars)
3564 ? vertical_scroll_bar_left
3565 : EQ (Qright, Vdefault_frame_scroll_bars)
3566 ? vertical_scroll_bar_right
3567 : vertical_scroll_bar_none);
3569 /* We set this parameter before creating the X window for the
3570 frame, so we can get the geometry right from the start.
3571 However, if the window hasn't been created yet, we shouldn't
3572 call x_set_window_size. */
3573 if (FRAME_X_WINDOW (f))
3574 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3575 do_pending_window_change (0);
3579 void
3580 x_set_scroll_bar_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3582 int wid = FRAME_COLUMN_WIDTH (f);
3584 if (NILP (arg))
3586 x_set_scroll_bar_default_width (f);
3588 if (FRAME_X_WINDOW (f))
3589 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3590 do_pending_window_change (0);
3592 else if (INTEGERP (arg) && XINT (arg) > 0
3593 && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3595 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
3596 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
3598 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg);
3599 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
3600 if (FRAME_X_WINDOW (f))
3601 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3602 do_pending_window_change (0);
3605 change_frame_size (f, 0, FRAME_COLS (f), 0, 0, 0);
3606 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
3607 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
3612 /* Return non-nil if frame F wants a bitmap icon. */
3614 Lisp_Object
3615 x_icon_type (FRAME_PTR f)
3617 Lisp_Object tem;
3619 tem = assq_no_quit (Qicon_type, f->param_alist);
3620 if (CONSP (tem))
3621 return XCDR (tem);
3622 else
3623 return Qnil;
3626 void
3627 x_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3629 double alpha = 1.0;
3630 double newval[2];
3631 int i, ialpha;
3632 Lisp_Object item;
3634 for (i = 0; i < 2; i++)
3636 newval[i] = 1.0;
3637 if (CONSP (arg))
3639 item = CAR (arg);
3640 arg = CDR (arg);
3642 else
3643 item = arg;
3645 if (NILP (item))
3646 alpha = - 1.0;
3647 else if (FLOATP (item))
3649 alpha = XFLOAT_DATA (item);
3650 if (alpha < 0.0 || 1.0 < alpha)
3651 args_out_of_range (make_float (0.0), make_float (1.0));
3653 else if (INTEGERP (item))
3655 ialpha = XINT (item);
3656 if (ialpha < 0 || 100 < ialpha)
3657 args_out_of_range (make_number (0), make_number (100));
3658 else
3659 alpha = ialpha / 100.0;
3661 else
3662 wrong_type_argument (Qnumberp, item);
3663 newval[i] = alpha;
3666 for (i = 0; i < 2; i++)
3667 f->alpha[i] = newval[i];
3669 #if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA)
3670 BLOCK_INPUT;
3671 x_set_frame_alpha (f);
3672 UNBLOCK_INPUT;
3673 #endif
3675 return;
3679 /* Subroutines of creating an X frame. */
3681 /* Make sure that Vx_resource_name is set to a reasonable value.
3682 Fix it up, or set it to `emacs' if it is too hopeless. */
3684 void
3685 validate_x_resource_name (void)
3687 int len = 0;
3688 /* Number of valid characters in the resource name. */
3689 int good_count = 0;
3690 /* Number of invalid characters in the resource name. */
3691 int bad_count = 0;
3692 Lisp_Object new;
3693 int i;
3695 if (!STRINGP (Vx_resource_class))
3696 Vx_resource_class = build_string (EMACS_CLASS);
3698 if (STRINGP (Vx_resource_name))
3700 unsigned char *p = SDATA (Vx_resource_name);
3702 len = SBYTES (Vx_resource_name);
3704 /* Only letters, digits, - and _ are valid in resource names.
3705 Count the valid characters and count the invalid ones. */
3706 for (i = 0; i < len; i++)
3708 int c = p[i];
3709 if (! ((c >= 'a' && c <= 'z')
3710 || (c >= 'A' && c <= 'Z')
3711 || (c >= '0' && c <= '9')
3712 || c == '-' || c == '_'))
3713 bad_count++;
3714 else
3715 good_count++;
3718 else
3719 /* Not a string => completely invalid. */
3720 bad_count = 5, good_count = 0;
3722 /* If name is valid already, return. */
3723 if (bad_count == 0)
3724 return;
3726 /* If name is entirely invalid, or nearly so, use `emacs'. */
3727 if (good_count < 2)
3729 Vx_resource_name = build_string ("emacs");
3730 return;
3733 /* Name is partly valid. Copy it and replace the invalid characters
3734 with underscores. */
3736 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
3738 for (i = 0; i < len; i++)
3740 int c = SREF (new, i);
3741 if (! ((c >= 'a' && c <= 'z')
3742 || (c >= 'A' && c <= 'Z')
3743 || (c >= '0' && c <= '9')
3744 || c == '-' || c == '_'))
3745 SSET (new, i, '_');
3750 extern char *x_get_string_resource (XrmDatabase, const char *, const char *);
3751 extern Display_Info *check_x_display_info (Lisp_Object);
3754 /* Get specified attribute from resource database RDB.
3755 See Fx_get_resource below for other parameters. */
3757 static Lisp_Object
3758 xrdb_get_resource (XrmDatabase rdb, Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3760 register char *value;
3761 char *name_key;
3762 char *class_key;
3764 CHECK_STRING (attribute);
3765 CHECK_STRING (class);
3767 if (!NILP (component))
3768 CHECK_STRING (component);
3769 if (!NILP (subclass))
3770 CHECK_STRING (subclass);
3771 if (NILP (component) != NILP (subclass))
3772 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3774 validate_x_resource_name ();
3776 /* Allocate space for the components, the dots which separate them,
3777 and the final '\0'. Make them big enough for the worst case. */
3778 name_key = (char *) alloca (SBYTES (Vx_resource_name)
3779 + (STRINGP (component)
3780 ? SBYTES (component) : 0)
3781 + SBYTES (attribute)
3782 + 3);
3784 class_key = (char *) alloca (SBYTES (Vx_resource_class)
3785 + SBYTES (class)
3786 + (STRINGP (subclass)
3787 ? SBYTES (subclass) : 0)
3788 + 3);
3790 /* Start with emacs.FRAMENAME for the name (the specific one)
3791 and with `Emacs' for the class key (the general one). */
3792 strcpy (name_key, SSDATA (Vx_resource_name));
3793 strcpy (class_key, SSDATA (Vx_resource_class));
3795 strcat (class_key, ".");
3796 strcat (class_key, SSDATA (class));
3798 if (!NILP (component))
3800 strcat (class_key, ".");
3801 strcat (class_key, SSDATA (subclass));
3803 strcat (name_key, ".");
3804 strcat (name_key, SSDATA (component));
3807 strcat (name_key, ".");
3808 strcat (name_key, SSDATA (attribute));
3810 value = x_get_string_resource (rdb, name_key, class_key);
3812 if (value != (char *) 0 && *value)
3813 return build_string (value);
3814 else
3815 return Qnil;
3819 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
3820 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
3821 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
3822 class, where INSTANCE is the name under which Emacs was invoked, or
3823 the name specified by the `-name' or `-rn' command-line arguments.
3825 The optional arguments COMPONENT and SUBCLASS add to the key and the
3826 class, respectively. You must specify both of them or neither.
3827 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
3828 and the class is `Emacs.CLASS.SUBCLASS'. */)
3829 (Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3831 #ifdef HAVE_X_WINDOWS
3832 check_x ();
3833 #endif
3835 return xrdb_get_resource (check_x_display_info (Qnil)->xrdb,
3836 attribute, class, component, subclass);
3839 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
3841 Lisp_Object
3842 display_x_get_resource (Display_Info *dpyinfo, Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3844 return xrdb_get_resource (dpyinfo->xrdb,
3845 attribute, class, component, subclass);
3848 #if defined HAVE_X_WINDOWS && !defined USE_X_TOOLKIT
3849 /* Used when C code wants a resource value. */
3850 /* Called from oldXMenu/Create.c. */
3851 char *
3852 x_get_resource_string (const char *attribute, const char *class)
3854 char *name_key;
3855 char *class_key;
3856 struct frame *sf = SELECTED_FRAME ();
3858 /* Allocate space for the components, the dots which separate them,
3859 and the final '\0'. */
3860 name_key = (char *) alloca (SBYTES (Vinvocation_name)
3861 + strlen (attribute) + 2);
3862 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
3863 + strlen (class) + 2);
3865 sprintf (name_key, "%s.%s", SSDATA (Vinvocation_name), attribute);
3866 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3868 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
3869 name_key, class_key);
3871 #endif
3873 /* Return the value of parameter PARAM.
3875 First search ALIST, then Vdefault_frame_alist, then the X defaults
3876 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3878 Convert the resource to the type specified by desired_type.
3880 If no default is specified, return Qunbound. If you call
3881 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3882 and don't let it get stored in any Lisp-visible variables! */
3884 Lisp_Object
3885 x_get_arg (Display_Info *dpyinfo, Lisp_Object alist, Lisp_Object param,
3886 const char *attribute, const char *class, enum resource_types type)
3888 register Lisp_Object tem;
3890 tem = Fassq (param, alist);
3892 if (!NILP (tem))
3894 /* If we find this parm in ALIST, clear it out
3895 so that it won't be "left over" at the end. */
3896 Lisp_Object tail;
3897 XSETCAR (tem, Qnil);
3898 /* In case the parameter appears more than once in the alist,
3899 clear it out. */
3900 for (tail = alist; CONSP (tail); tail = XCDR (tail))
3901 if (CONSP (XCAR (tail))
3902 && EQ (XCAR (XCAR (tail)), param))
3903 XSETCAR (XCAR (tail), Qnil);
3905 else
3906 tem = Fassq (param, Vdefault_frame_alist);
3908 /* If it wasn't specified in ALIST or the Lisp-level defaults,
3909 look in the X resources. */
3910 if (EQ (tem, Qnil))
3912 if (attribute && dpyinfo)
3914 tem = display_x_get_resource (dpyinfo,
3915 build_string (attribute),
3916 build_string (class),
3917 Qnil, Qnil);
3919 if (NILP (tem))
3920 return Qunbound;
3922 switch (type)
3924 case RES_TYPE_NUMBER:
3925 return make_number (atoi (SSDATA (tem)));
3927 case RES_TYPE_BOOLEAN_NUMBER:
3928 if (!strcmp (SSDATA (tem), "on")
3929 || !strcmp (SSDATA (tem), "true"))
3930 return make_number (1);
3931 return make_number (atoi (SSDATA (tem)));
3932 break;
3934 case RES_TYPE_FLOAT:
3935 return make_float (atof (SSDATA (tem)));
3937 case RES_TYPE_BOOLEAN:
3938 tem = Fdowncase (tem);
3939 if (!strcmp (SSDATA (tem), "on")
3940 #ifdef HAVE_NS
3941 || !strcmp (SSDATA (tem), "yes")
3942 #endif
3943 || !strcmp (SSDATA (tem), "true"))
3944 return Qt;
3945 else
3946 return Qnil;
3948 case RES_TYPE_STRING:
3949 return tem;
3951 case RES_TYPE_SYMBOL:
3952 /* As a special case, we map the values `true' and `on'
3953 to Qt, and `false' and `off' to Qnil. */
3955 Lisp_Object lower;
3956 lower = Fdowncase (tem);
3957 if (!strcmp (SSDATA (lower), "on")
3958 #ifdef HAVE_NS
3959 || !strcmp (SSDATA (lower), "yes")
3960 #endif
3961 || !strcmp (SSDATA (lower), "true"))
3962 return Qt;
3963 else if (!strcmp (SSDATA (lower), "off")
3964 #ifdef HAVE_NS
3965 || !strcmp (SSDATA (lower), "no")
3966 #endif
3967 || !strcmp (SSDATA (lower), "false"))
3968 return Qnil;
3969 else
3970 return Fintern (tem, Qnil);
3973 default:
3974 abort ();
3977 else
3978 return Qunbound;
3980 return Fcdr (tem);
3983 static Lisp_Object
3984 x_frame_get_arg (struct frame *f, Lisp_Object alist, Lisp_Object param,
3985 const char *attribute, const char *class,
3986 enum resource_types type)
3988 return x_get_arg (FRAME_X_DISPLAY_INFO (f),
3989 alist, param, attribute, class, type);
3992 /* Like x_frame_get_arg, but also record the value in f->param_alist. */
3994 Lisp_Object
3995 x_frame_get_and_record_arg (struct frame *f, Lisp_Object alist,
3996 Lisp_Object param,
3997 const char *attribute, const char *class,
3998 enum resource_types type)
4000 Lisp_Object value;
4002 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
4003 attribute, class, type);
4004 if (! NILP (value) && ! EQ (value, Qunbound))
4005 store_frame_param (f, param, value);
4007 return value;
4011 /* Record in frame F the specified or default value according to ALIST
4012 of the parameter named PROP (a Lisp symbol).
4013 If no value is specified for PROP, look for an X default for XPROP
4014 on the frame named NAME.
4015 If that is not found either, use the value DEFLT. */
4017 Lisp_Object
4018 x_default_parameter (struct frame *f, Lisp_Object alist, Lisp_Object prop,
4019 Lisp_Object deflt, const char *xprop, const char *xclass,
4020 enum resource_types type)
4022 Lisp_Object tem;
4024 tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type);
4025 if (EQ (tem, Qunbound))
4026 tem = deflt;
4027 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
4028 return tem;
4034 /* NS used to define x-parse-geometry in ns-win.el, but that confused
4035 make-docfile: the documentation string in ns-win.el was used for
4036 x-parse-geometry even in non-NS builds.
4038 With two definitions of x-parse-geometry in this file, various
4039 things still get confused (eg M-x apropos documentation), so that
4040 it is best if the two definitions just share the same doc-string.
4042 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
4043 doc: /* Parse a display geometry string STRING.
4044 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
4045 The properties returned may include `top', `left', `height', and `width'.
4046 For X, the value of `left' or `top' may be an integer,
4047 or a list (+ N) meaning N pixels relative to top/left corner,
4048 or a list (- N) meaning -N pixels relative to bottom/right corner.
4049 On Nextstep, this just calls `ns-parse-geometry'. */)
4050 (Lisp_Object string)
4052 #ifdef HAVE_NS
4053 call1 (Qns_parse_geometry, string);
4054 #else
4055 int geometry, x, y;
4056 unsigned int width, height;
4057 Lisp_Object result;
4059 CHECK_STRING (string);
4061 geometry = XParseGeometry (SSDATA (string),
4062 &x, &y, &width, &height);
4063 result = Qnil;
4064 if (geometry & XValue)
4066 Lisp_Object element;
4068 if (x >= 0 && (geometry & XNegative))
4069 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
4070 else if (x < 0 && ! (geometry & XNegative))
4071 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
4072 else
4073 element = Fcons (Qleft, make_number (x));
4074 result = Fcons (element, result);
4077 if (geometry & YValue)
4079 Lisp_Object element;
4081 if (y >= 0 && (geometry & YNegative))
4082 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
4083 else if (y < 0 && ! (geometry & YNegative))
4084 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
4085 else
4086 element = Fcons (Qtop, make_number (y));
4087 result = Fcons (element, result);
4090 if (geometry & WidthValue)
4091 result = Fcons (Fcons (Qwidth, make_number (width)), result);
4092 if (geometry & HeightValue)
4093 result = Fcons (Fcons (Qheight, make_number (height)), result);
4095 return result;
4096 #endif /* HAVE_NS */
4100 /* Calculate the desired size and position of frame F.
4101 Return the flags saying which aspects were specified.
4103 Also set the win_gravity and size_hint_flags of F.
4105 Adjust height for toolbar if TOOLBAR_P is 1.
4107 This function does not make the coordinates positive. */
4109 #define DEFAULT_ROWS 35
4110 #define DEFAULT_COLS 80
4113 x_figure_window_size (struct frame *f, Lisp_Object parms, int toolbar_p)
4115 register Lisp_Object tem0, tem1, tem2;
4116 long window_prompting = 0;
4117 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
4119 /* Default values if we fall through.
4120 Actually, if that happens we should get
4121 window manager prompting. */
4122 SET_FRAME_COLS (f, DEFAULT_COLS);
4123 FRAME_LINES (f) = DEFAULT_ROWS;
4124 /* Window managers expect that if program-specified
4125 positions are not (0,0), they're intentional, not defaults. */
4126 f->top_pos = 0;
4127 f->left_pos = 0;
4129 /* Ensure that old new_text_cols and new_text_lines will not override the
4130 values set here. */
4131 /* ++KFS: This was specific to W32, but seems ok for all platforms */
4132 f->new_text_cols = f->new_text_lines = 0;
4134 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
4135 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
4136 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
4137 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4139 if (!EQ (tem0, Qunbound))
4141 CHECK_NUMBER (tem0);
4142 FRAME_LINES (f) = XINT (tem0);
4144 if (!EQ (tem1, Qunbound))
4146 CHECK_NUMBER (tem1);
4147 SET_FRAME_COLS (f, XINT (tem1));
4149 if (!NILP (tem2) && !EQ (tem2, Qunbound))
4150 window_prompting |= USSize;
4151 else
4152 window_prompting |= PSize;
4155 f->scroll_bar_actual_width
4156 = FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f);
4158 /* This used to be done _before_ calling x_figure_window_size, but
4159 since the height is reset here, this was really a no-op. I
4160 assume that moving it here does what Gerd intended (although he
4161 no longer can remember what that was... ++KFS, 2003-03-25. */
4163 /* Add the tool-bar height to the initial frame height so that the
4164 user gets a text display area of the size he specified with -g or
4165 via .Xdefaults. Later changes of the tool-bar height don't
4166 change the frame size. This is done so that users can create
4167 tall Emacs frames without having to guess how tall the tool-bar
4168 will get. */
4169 if (toolbar_p && FRAME_TOOL_BAR_LINES (f))
4171 int margin, relief, bar_height;
4173 relief = (tool_bar_button_relief >= 0
4174 ? tool_bar_button_relief
4175 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
4177 if (INTEGERP (Vtool_bar_button_margin)
4178 && XINT (Vtool_bar_button_margin) > 0)
4179 margin = XFASTINT (Vtool_bar_button_margin);
4180 else if (CONSP (Vtool_bar_button_margin)
4181 && INTEGERP (XCDR (Vtool_bar_button_margin))
4182 && XINT (XCDR (Vtool_bar_button_margin)) > 0)
4183 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
4184 else
4185 margin = 0;
4187 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
4188 FRAME_LINES (f) += (bar_height + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f);
4191 compute_fringe_widths (f, 0);
4193 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, FRAME_COLS (f));
4194 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, FRAME_LINES (f));
4196 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
4197 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
4198 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
4199 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4201 if (EQ (tem0, Qminus))
4203 f->top_pos = 0;
4204 window_prompting |= YNegative;
4206 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
4207 && CONSP (XCDR (tem0))
4208 && INTEGERP (XCAR (XCDR (tem0))))
4210 f->top_pos = - XINT (XCAR (XCDR (tem0)));
4211 window_prompting |= YNegative;
4213 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
4214 && CONSP (XCDR (tem0))
4215 && INTEGERP (XCAR (XCDR (tem0))))
4217 f->top_pos = XINT (XCAR (XCDR (tem0)));
4219 else if (EQ (tem0, Qunbound))
4220 f->top_pos = 0;
4221 else
4223 CHECK_NUMBER (tem0);
4224 f->top_pos = XINT (tem0);
4225 if (f->top_pos < 0)
4226 window_prompting |= YNegative;
4229 if (EQ (tem1, Qminus))
4231 f->left_pos = 0;
4232 window_prompting |= XNegative;
4234 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
4235 && CONSP (XCDR (tem1))
4236 && INTEGERP (XCAR (XCDR (tem1))))
4238 f->left_pos = - XINT (XCAR (XCDR (tem1)));
4239 window_prompting |= XNegative;
4241 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
4242 && CONSP (XCDR (tem1))
4243 && INTEGERP (XCAR (XCDR (tem1))))
4245 f->left_pos = XINT (XCAR (XCDR (tem1)));
4247 else if (EQ (tem1, Qunbound))
4248 f->left_pos = 0;
4249 else
4251 CHECK_NUMBER (tem1);
4252 f->left_pos = XINT (tem1);
4253 if (f->left_pos < 0)
4254 window_prompting |= XNegative;
4257 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
4258 window_prompting |= USPosition;
4259 else
4260 window_prompting |= PPosition;
4263 if (window_prompting & XNegative)
4265 if (window_prompting & YNegative)
4266 f->win_gravity = SouthEastGravity;
4267 else
4268 f->win_gravity = NorthEastGravity;
4270 else
4272 if (window_prompting & YNegative)
4273 f->win_gravity = SouthWestGravity;
4274 else
4275 f->win_gravity = NorthWestGravity;
4278 f->size_hint_flags = window_prompting;
4280 return window_prompting;
4285 #endif /* HAVE_WINDOW_SYSTEM */
4287 void
4288 frame_make_pointer_invisible (void)
4290 if (! NILP (Vmake_pointer_invisible))
4292 struct frame *f;
4293 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4294 return;
4296 f = SELECTED_FRAME ();
4297 if (f && !f->pointer_invisible
4298 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4300 f->mouse_moved = 0;
4301 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 1);
4302 f->pointer_invisible = 1;
4307 void
4308 frame_make_pointer_visible (void)
4310 /* We don't check Vmake_pointer_invisible here in case the
4311 pointer was invisible when Vmake_pointer_invisible was set to nil. */
4312 struct frame *f;
4314 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4315 return;
4317 f = SELECTED_FRAME ();
4318 if (f && f->pointer_invisible && f->mouse_moved
4319 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4321 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 0);
4322 f->pointer_invisible = 0;
4326 DEFUN ("frame-pointer-visible-p", Fframe_pointer_visible_p,
4327 Sframe_pointer_visible_p, 0, 1, 0,
4328 doc: /* Return t if the mouse pointer displayed on FRAME is visible.
4329 Otherwise it returns nil. FRAME omitted or nil means the
4330 selected frame. This is useful when `make-pointer-invisible' is set. */)
4331 (Lisp_Object frame)
4333 if (NILP (frame))
4334 frame = selected_frame;
4336 CHECK_FRAME (frame);
4338 return (XFRAME (frame)->pointer_invisible ? Qnil : Qt);
4342 /***********************************************************************
4343 Initialization
4344 ***********************************************************************/
4346 void
4347 syms_of_frame (void)
4349 Qframep = intern_c_string ("framep");
4350 staticpro (&Qframep);
4351 Qframe_live_p = intern_c_string ("frame-live-p");
4352 staticpro (&Qframe_live_p);
4353 Qexplicit_name = intern_c_string ("explicit-name");
4354 staticpro (&Qexplicit_name);
4355 Qheight = intern_c_string ("height");
4356 staticpro (&Qheight);
4357 Qicon = intern_c_string ("icon");
4358 staticpro (&Qicon);
4359 Qminibuffer = intern_c_string ("minibuffer");
4360 staticpro (&Qminibuffer);
4361 Qmodeline = intern_c_string ("modeline");
4362 staticpro (&Qmodeline);
4363 Qonly = intern_c_string ("only");
4364 staticpro (&Qonly);
4365 Qwidth = intern_c_string ("width");
4366 staticpro (&Qwidth);
4367 Qgeometry = intern_c_string ("geometry");
4368 staticpro (&Qgeometry);
4369 Qicon_left = intern_c_string ("icon-left");
4370 staticpro (&Qicon_left);
4371 Qicon_top = intern_c_string ("icon-top");
4372 staticpro (&Qicon_top);
4373 Qtooltip = intern_c_string ("tooltip");
4374 staticpro (&Qtooltip);
4375 Qleft = intern_c_string ("left");
4376 staticpro (&Qleft);
4377 Qright = intern_c_string ("right");
4378 staticpro (&Qright);
4379 Quser_position = intern_c_string ("user-position");
4380 staticpro (&Quser_position);
4381 Quser_size = intern_c_string ("user-size");
4382 staticpro (&Quser_size);
4383 Qwindow_id = intern_c_string ("window-id");
4384 staticpro (&Qwindow_id);
4385 #ifdef HAVE_X_WINDOWS
4386 Qouter_window_id = intern_c_string ("outer-window-id");
4387 staticpro (&Qouter_window_id);
4388 #endif
4389 Qparent_id = intern_c_string ("parent-id");
4390 staticpro (&Qparent_id);
4391 Qx = intern_c_string ("x");
4392 staticpro (&Qx);
4393 Qw32 = intern_c_string ("w32");
4394 staticpro (&Qw32);
4395 Qpc = intern_c_string ("pc");
4396 staticpro (&Qpc);
4397 Qmac = intern_c_string ("mac");
4398 staticpro (&Qmac);
4399 Qns = intern_c_string ("ns");
4400 staticpro (&Qns);
4401 Qvisible = intern_c_string ("visible");
4402 staticpro (&Qvisible);
4403 Qbuffer_predicate = intern_c_string ("buffer-predicate");
4404 staticpro (&Qbuffer_predicate);
4405 Qbuffer_list = intern_c_string ("buffer-list");
4406 staticpro (&Qbuffer_list);
4407 Qburied_buffer_list = intern_c_string ("buried-buffer-list");
4408 staticpro (&Qburied_buffer_list);
4409 Qdisplay_type = intern_c_string ("display-type");
4410 staticpro (&Qdisplay_type);
4411 Qbackground_mode = intern_c_string ("background-mode");
4412 staticpro (&Qbackground_mode);
4413 Qnoelisp = intern_c_string ("noelisp");
4414 staticpro (&Qnoelisp);
4415 Qtty_color_mode = intern_c_string ("tty-color-mode");
4416 staticpro (&Qtty_color_mode);
4417 Qtty = intern_c_string ("tty");
4418 staticpro (&Qtty);
4419 Qtty_type = intern_c_string ("tty-type");
4420 staticpro (&Qtty_type);
4422 Qface_set_after_frame_default = intern_c_string ("face-set-after-frame-default");
4423 staticpro (&Qface_set_after_frame_default);
4425 Qfullwidth = intern_c_string ("fullwidth");
4426 staticpro (&Qfullwidth);
4427 Qfullheight = intern_c_string ("fullheight");
4428 staticpro (&Qfullheight);
4429 Qfullboth = intern_c_string ("fullboth");
4430 staticpro (&Qfullboth);
4431 Qmaximized = intern_c_string ("maximized");
4432 staticpro (&Qmaximized);
4433 Qx_resource_name = intern_c_string ("x-resource-name");
4434 staticpro (&Qx_resource_name);
4436 Qx_frame_parameter = intern_c_string ("x-frame-parameter");
4437 staticpro (&Qx_frame_parameter);
4439 Qterminal = intern_c_string ("terminal");
4440 staticpro (&Qterminal);
4441 Qterminal_live_p = intern_c_string ("terminal-live-p");
4442 staticpro (&Qterminal_live_p);
4444 #ifdef HAVE_NS
4445 Qns_parse_geometry = intern_c_string ("ns-parse-geometry");
4446 staticpro (&Qns_parse_geometry);
4447 #endif
4450 int i;
4452 for (i = 0; i < sizeof (frame_parms) / sizeof (frame_parms[0]); i++)
4454 Lisp_Object v = intern_c_string (frame_parms[i].name);
4455 if (frame_parms[i].variable)
4457 *frame_parms[i].variable = v;
4458 staticpro (frame_parms[i].variable);
4460 Fput (v, Qx_frame_parameter, make_number (i));
4464 #ifdef HAVE_WINDOW_SYSTEM
4465 DEFVAR_LISP ("x-resource-name", Vx_resource_name,
4466 doc: /* The name Emacs uses to look up X resources.
4467 `x-get-resource' uses this as the first component of the instance name
4468 when requesting resource values.
4469 Emacs initially sets `x-resource-name' to the name under which Emacs
4470 was invoked, or to the value specified with the `-name' or `-rn'
4471 switches, if present.
4473 It may be useful to bind this variable locally around a call
4474 to `x-get-resource'. See also the variable `x-resource-class'. */);
4475 Vx_resource_name = Qnil;
4477 DEFVAR_LISP ("x-resource-class", Vx_resource_class,
4478 doc: /* The class Emacs uses to look up X resources.
4479 `x-get-resource' uses this as the first component of the instance class
4480 when requesting resource values.
4482 Emacs initially sets `x-resource-class' to "Emacs".
4484 Setting this variable permanently is not a reasonable thing to do,
4485 but binding this variable locally around a call to `x-get-resource'
4486 is a reasonable practice. See also the variable `x-resource-name'. */);
4487 Vx_resource_class = build_string (EMACS_CLASS);
4489 DEFVAR_LISP ("frame-alpha-lower-limit", Vframe_alpha_lower_limit,
4490 doc: /* The lower limit of the frame opacity (alpha transparency).
4491 The value should range from 0 (invisible) to 100 (completely opaque).
4492 You can also use a floating number between 0.0 and 1.0.
4493 The default is 20. */);
4494 Vframe_alpha_lower_limit = make_number (20);
4495 #endif
4497 DEFVAR_LISP ("default-frame-alist", Vdefault_frame_alist,
4498 doc: /* Alist of default values for frame creation.
4499 These may be set in your init file, like this:
4500 (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1)))
4501 These override values given in window system configuration data,
4502 including X Windows' defaults database.
4503 For values specific to the first Emacs frame, see `initial-frame-alist'.
4504 For window-system specific values, see `window-system-default-frame-alist'.
4505 For values specific to the separate minibuffer frame, see
4506 `minibuffer-frame-alist'.
4507 The `menu-bar-lines' element of the list controls whether new frames
4508 have menu bars; `menu-bar-mode' works by altering this element.
4509 Setting this variable does not affect existing frames, only new ones. */);
4510 Vdefault_frame_alist = Qnil;
4512 DEFVAR_LISP ("default-frame-scroll-bars", Vdefault_frame_scroll_bars,
4513 doc: /* Default position of scroll bars on this window-system. */);
4514 #ifdef HAVE_WINDOW_SYSTEM
4515 #if defined(HAVE_NTGUI) || defined(NS_IMPL_COCOA) || (defined(USE_GTK) && defined(USE_TOOLKIT_SCROLL_BARS))
4516 /* MS-Windows, Mac OS X, and GTK have scroll bars on the right by
4517 default. */
4518 Vdefault_frame_scroll_bars = Qright;
4519 #else
4520 Vdefault_frame_scroll_bars = Qleft;
4521 #endif
4522 #else
4523 Vdefault_frame_scroll_bars = Qnil;
4524 #endif
4526 DEFVAR_LISP ("terminal-frame", Vterminal_frame,
4527 doc: /* The initial frame-object, which represents Emacs's stdout. */);
4529 DEFVAR_LISP ("mouse-position-function", Vmouse_position_function,
4530 doc: /* If non-nil, function to transform normal value of `mouse-position'.
4531 `mouse-position' calls this function, passing its usual return value as
4532 argument, and returns whatever this function returns.
4533 This abnormal hook exists for the benefit of packages like `xt-mouse.el'
4534 which need to do mouse handling at the Lisp level. */);
4535 Vmouse_position_function = Qnil;
4537 DEFVAR_LISP ("mouse-highlight", Vmouse_highlight,
4538 doc: /* If non-nil, clickable text is highlighted when mouse is over it.
4539 If the value is an integer, highlighting is only shown after moving the
4540 mouse, while keyboard input turns off the highlight even when the mouse
4541 is over the clickable text. However, the mouse shape still indicates
4542 when the mouse is over clickable text. */);
4543 Vmouse_highlight = Qt;
4545 DEFVAR_LISP ("make-pointer-invisible", Vmake_pointer_invisible,
4546 doc: /* If non-nil, make pointer invisible while typing.
4547 The pointer becomes visible again when the mouse is moved. */);
4548 Vmake_pointer_invisible = Qt;
4550 DEFVAR_LISP ("delete-frame-functions", Vdelete_frame_functions,
4551 doc: /* Functions to be run before deleting a frame.
4552 The functions are run with one arg, the frame to be deleted.
4553 See `delete-frame'.
4555 Note that functions in this list may be called just before the frame is
4556 actually deleted, or some time later (or even both when an earlier function
4557 in `delete-frame-functions' (indirectly) calls `delete-frame'
4558 recursively). */);
4559 Vdelete_frame_functions = Qnil;
4560 Qdelete_frame_functions = intern_c_string ("delete-frame-functions");
4561 staticpro (&Qdelete_frame_functions);
4563 DEFVAR_LISP ("menu-bar-mode", Vmenu_bar_mode,
4564 doc: /* Non-nil if Menu-Bar mode is enabled.
4565 See the command `menu-bar-mode' for a description of this minor mode.
4566 Setting this variable directly does not take effect;
4567 either customize it (see the info node `Easy Customization')
4568 or call the function `menu-bar-mode'. */);
4569 Vmenu_bar_mode = Qt;
4571 DEFVAR_LISP ("tool-bar-mode", Vtool_bar_mode,
4572 doc: /* Non-nil if Tool-Bar mode is enabled.
4573 See the command `tool-bar-mode' for a description of this minor mode.
4574 Setting this variable directly does not take effect;
4575 either customize it (see the info node `Easy Customization')
4576 or call the function `tool-bar-mode'. */);
4577 #ifdef HAVE_WINDOW_SYSTEM
4578 Vtool_bar_mode = Qt;
4579 #else
4580 Vtool_bar_mode = Qnil;
4581 #endif
4583 DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
4584 doc: /* Minibufferless frames use this frame's minibuffer.
4586 Emacs cannot create minibufferless frames unless this is set to an
4587 appropriate surrogate.
4589 Emacs consults this variable only when creating minibufferless
4590 frames; once the frame is created, it sticks with its assigned
4591 minibuffer, no matter what this variable is set to. This means that
4592 this variable doesn't necessarily say anything meaningful about the
4593 current set of frames, or where the minibuffer is currently being
4594 displayed.
4596 This variable is local to the current terminal and cannot be buffer-local. */);
4598 DEFVAR_BOOL ("focus-follows-mouse", focus_follows_mouse,
4599 doc: /* Non-nil if window system changes focus when you move the mouse.
4600 You should set this variable to tell Emacs how your window manager
4601 handles focus, since there is no way in general for Emacs to find out
4602 automatically. See also `mouse-autoselect-window'. */);
4603 focus_follows_mouse = 0;
4605 staticpro (&Vframe_list);
4607 defsubr (&Sactive_minibuffer_window);
4608 defsubr (&Sframep);
4609 defsubr (&Sframe_live_p);
4610 defsubr (&Swindow_system);
4611 defsubr (&Smake_terminal_frame);
4612 defsubr (&Shandle_switch_frame);
4613 defsubr (&Sselect_frame);
4614 defsubr (&Sselected_frame);
4615 defsubr (&Swindow_frame);
4616 defsubr (&Sframe_root_window);
4617 defsubr (&Sframe_first_window);
4618 defsubr (&Sframe_selected_window);
4619 defsubr (&Sset_frame_selected_window);
4620 defsubr (&Sframe_list);
4621 defsubr (&Snext_frame);
4622 defsubr (&Sprevious_frame);
4623 defsubr (&Sdelete_frame);
4624 defsubr (&Smouse_position);
4625 defsubr (&Smouse_pixel_position);
4626 defsubr (&Sset_mouse_position);
4627 defsubr (&Sset_mouse_pixel_position);
4628 #if 0
4629 defsubr (&Sframe_configuration);
4630 defsubr (&Srestore_frame_configuration);
4631 #endif
4632 defsubr (&Smake_frame_visible);
4633 defsubr (&Smake_frame_invisible);
4634 defsubr (&Siconify_frame);
4635 defsubr (&Sframe_visible_p);
4636 defsubr (&Svisible_frame_list);
4637 defsubr (&Sraise_frame);
4638 defsubr (&Slower_frame);
4639 defsubr (&Sredirect_frame_focus);
4640 defsubr (&Sframe_focus);
4641 defsubr (&Sframe_parameters);
4642 defsubr (&Sframe_parameter);
4643 defsubr (&Smodify_frame_parameters);
4644 defsubr (&Sframe_char_height);
4645 defsubr (&Sframe_char_width);
4646 defsubr (&Sframe_pixel_height);
4647 defsubr (&Sframe_pixel_width);
4648 defsubr (&Stool_bar_pixel_width);
4649 defsubr (&Sset_frame_height);
4650 defsubr (&Sset_frame_width);
4651 defsubr (&Sset_frame_size);
4652 defsubr (&Sset_frame_position);
4653 defsubr (&Sframe_pointer_visible_p);
4655 #ifdef HAVE_WINDOW_SYSTEM
4656 defsubr (&Sx_get_resource);
4657 defsubr (&Sx_parse_geometry);
4658 #endif