* leim/quail/ipa-praat.el: New input method.
[emacs.git] / src / frame.c
blob74e222f85fce3e2c02b1b489e7d599d5227dcfab
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
1351 #ifdef HAVE_X_WINDOWS
1352 /* Also, save clipboard to the the clipboard manager. */
1353 x_clipboard_manager_save_frame (frame);
1354 #endif
1356 safe_call2 (Qrun_hook_with_args, Qdelete_frame_functions, frame);
1359 /* The hook may sometimes (indirectly) cause the frame to be deleted. */
1360 if (! FRAME_LIVE_P (f))
1361 return Qnil;
1363 /* At this point, we are committed to deleting the frame.
1364 There is no more chance for errors to prevent it. */
1366 minibuffer_selected = EQ (minibuf_window, selected_window);
1368 /* Don't let the frame remain selected. */
1369 if (f == sf)
1371 Lisp_Object tail, frame1;
1373 /* Look for another visible frame on the same terminal. */
1374 frame1 = next_frame (frame, Qvisible);
1376 /* If there is none, find *some* other frame. */
1377 if (NILP (frame1) || EQ (frame1, frame))
1379 FOR_EACH_FRAME (tail, frame1)
1381 if (! EQ (frame, frame1) && FRAME_LIVE_P (XFRAME (frame1)))
1382 break;
1385 #ifdef NS_IMPL_COCOA
1386 else
1387 /* Under NS, there is no system mechanism for choosing a new
1388 window to get focus -- it is left to application code.
1389 So the portion of THIS application interfacing with NS
1390 needs to know about it. We call Fraise_frame, but the
1391 purpose is really to transfer focus. */
1392 Fraise_frame (frame1);
1393 #endif
1395 do_switch_frame (frame1, 0, 1, Qnil);
1396 sf = SELECTED_FRAME ();
1399 /* Don't allow minibuf_window to remain on a deleted frame. */
1400 if (EQ (f->minibuffer_window, minibuf_window))
1402 Fset_window_buffer (sf->minibuffer_window,
1403 XWINDOW (minibuf_window)->buffer, Qnil);
1404 minibuf_window = sf->minibuffer_window;
1406 /* If the dying minibuffer window was selected,
1407 select the new one. */
1408 if (minibuffer_selected)
1409 Fselect_window (minibuf_window, Qnil);
1412 /* Don't let echo_area_window to remain on a deleted frame. */
1413 if (EQ (f->minibuffer_window, echo_area_window))
1414 echo_area_window = sf->minibuffer_window;
1416 /* Clear any X selections for this frame. */
1417 #ifdef HAVE_X_WINDOWS
1418 if (FRAME_X_P (f))
1419 x_clear_frame_selections (f);
1420 #endif
1422 /* Free glyphs.
1423 This function must be called before the window tree of the
1424 frame is deleted because windows contain dynamically allocated
1425 memory. */
1426 free_glyphs (f);
1428 #ifdef HAVE_WINDOW_SYSTEM
1429 /* Give chance to each font driver to free a frame specific data. */
1430 font_update_drivers (f, Qnil);
1431 #endif
1433 /* Mark all the windows that used to be on FRAME as deleted, and then
1434 remove the reference to them. */
1435 delete_all_subwindows (XWINDOW (f->root_window));
1436 f->root_window = Qnil;
1438 Vframe_list = Fdelq (frame, Vframe_list);
1439 FRAME_SET_VISIBLE (f, 0);
1441 /* Allow the vector of menu bar contents to be freed in the next
1442 garbage collection. The frame object itself may not be garbage
1443 collected until much later, because recent_keys and other data
1444 structures can still refer to it. */
1445 f->menu_bar_vector = Qnil;
1447 free_font_driver_list (f);
1448 xfree (f->namebuf);
1449 xfree (f->decode_mode_spec_buffer);
1450 xfree (FRAME_INSERT_COST (f));
1451 xfree (FRAME_DELETEN_COST (f));
1452 xfree (FRAME_INSERTN_COST (f));
1453 xfree (FRAME_DELETE_COST (f));
1454 xfree (FRAME_MESSAGE_BUF (f));
1456 /* Since some events are handled at the interrupt level, we may get
1457 an event for f at any time; if we zero out the frame's terminal
1458 now, then we may trip up the event-handling code. Instead, we'll
1459 promise that the terminal of the frame must be valid until we
1460 have called the window-system-dependent frame destruction
1461 routine. */
1463 if (FRAME_TERMINAL (f)->delete_frame_hook)
1464 (*FRAME_TERMINAL (f)->delete_frame_hook) (f);
1467 struct terminal *terminal = FRAME_TERMINAL (f);
1468 f->output_data.nothing = 0;
1469 f->terminal = 0; /* Now the frame is dead. */
1471 /* If needed, delete the terminal that this frame was on.
1472 (This must be done after the frame is killed.) */
1473 terminal->reference_count--;
1474 if (terminal->reference_count == 0)
1476 Lisp_Object tmp;
1477 XSETTERMINAL (tmp, terminal);
1479 kb = NULL;
1480 Fdelete_terminal (tmp, NILP (force) ? Qt : force);
1482 else
1483 kb = terminal->kboard;
1486 /* If we've deleted the last_nonminibuf_frame, then try to find
1487 another one. */
1488 if (f == last_nonminibuf_frame)
1490 Lisp_Object frames;
1492 last_nonminibuf_frame = 0;
1494 for (frames = Vframe_list;
1495 CONSP (frames);
1496 frames = XCDR (frames))
1498 f = XFRAME (XCAR (frames));
1499 if (!FRAME_MINIBUF_ONLY_P (f))
1501 last_nonminibuf_frame = f;
1502 break;
1507 /* If there's no other frame on the same kboard, get out of
1508 single-kboard state if we're in it for this kboard. */
1509 if (kb != NULL)
1511 Lisp_Object frames;
1512 /* Some frame we found on the same kboard, or nil if there are none. */
1513 Lisp_Object frame_on_same_kboard;
1515 frame_on_same_kboard = Qnil;
1517 for (frames = Vframe_list;
1518 CONSP (frames);
1519 frames = XCDR (frames))
1521 Lisp_Object this;
1522 struct frame *f1;
1524 this = XCAR (frames);
1525 if (!FRAMEP (this))
1526 abort ();
1527 f1 = XFRAME (this);
1529 if (kb == FRAME_KBOARD (f1))
1530 frame_on_same_kboard = this;
1533 if (NILP (frame_on_same_kboard))
1534 not_single_kboard_state (kb);
1538 /* If we've deleted this keyboard's default_minibuffer_frame, try to
1539 find another one. Prefer minibuffer-only frames, but also notice
1540 frames with other windows. */
1541 if (kb != NULL && EQ (frame, KVAR (kb, Vdefault_minibuffer_frame)))
1543 Lisp_Object frames;
1545 /* The last frame we saw with a minibuffer, minibuffer-only or not. */
1546 Lisp_Object frame_with_minibuf;
1547 /* Some frame we found on the same kboard, or nil if there are none. */
1548 Lisp_Object frame_on_same_kboard;
1550 frame_on_same_kboard = Qnil;
1551 frame_with_minibuf = Qnil;
1553 for (frames = Vframe_list;
1554 CONSP (frames);
1555 frames = XCDR (frames))
1557 Lisp_Object this;
1558 struct frame *f1;
1560 this = XCAR (frames);
1561 if (!FRAMEP (this))
1562 abort ();
1563 f1 = XFRAME (this);
1565 /* Consider only frames on the same kboard
1566 and only those with minibuffers. */
1567 if (kb == FRAME_KBOARD (f1)
1568 && FRAME_HAS_MINIBUF_P (f1))
1570 frame_with_minibuf = this;
1571 if (FRAME_MINIBUF_ONLY_P (f1))
1572 break;
1575 if (kb == FRAME_KBOARD (f1))
1576 frame_on_same_kboard = this;
1579 if (!NILP (frame_on_same_kboard))
1581 /* We know that there must be some frame with a minibuffer out
1582 there. If this were not true, all of the frames present
1583 would have to be minibufferless, which implies that at some
1584 point their minibuffer frames must have been deleted, but
1585 that is prohibited at the top; you can't delete surrogate
1586 minibuffer frames. */
1587 if (NILP (frame_with_minibuf))
1588 abort ();
1590 KVAR (kb, Vdefault_minibuffer_frame) = frame_with_minibuf;
1592 else
1593 /* No frames left on this kboard--say no minibuffer either. */
1594 KVAR (kb, Vdefault_minibuffer_frame) = Qnil;
1597 /* Cause frame titles to update--necessary if we now have just one frame. */
1598 if (!tooltip_frame)
1599 update_mode_lines = 1;
1601 return Qnil;
1604 DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 2, "",
1605 doc: /* Delete FRAME, permanently eliminating it from use.
1606 FRAME defaults to the selected frame.
1608 A frame may not be deleted if its minibuffer is used by other frames.
1609 Normally, you may not delete a frame if all other frames are invisible,
1610 but if the second optional argument FORCE is non-nil, you may do so.
1612 This function runs `delete-frame-functions' before actually
1613 deleting the frame, unless the frame is a tooltip.
1614 The functions are run with one argument, the frame to be deleted. */)
1615 (Lisp_Object frame, Lisp_Object force)
1617 return delete_frame (frame, !NILP (force) ? Qt : Qnil);
1621 /* Return mouse position in character cell units. */
1623 DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0,
1624 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1625 The position is given in character cells, where (0, 0) is the
1626 upper-left corner of the frame, X is the horizontal offset, and Y is
1627 the vertical offset.
1628 If Emacs is running on a mouseless terminal or hasn't been programmed
1629 to read the mouse position, it returns the selected frame for FRAME
1630 and nil for X and Y.
1631 If `mouse-position-function' is non-nil, `mouse-position' calls it,
1632 passing the normal return value to that function as an argument,
1633 and returns whatever that function returns. */)
1634 (void)
1636 FRAME_PTR f;
1637 Lisp_Object lispy_dummy;
1638 enum scroll_bar_part party_dummy;
1639 Lisp_Object x, y, retval;
1640 int col, row;
1641 Time long_dummy;
1642 struct gcpro gcpro1;
1644 f = SELECTED_FRAME ();
1645 x = y = Qnil;
1647 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
1648 /* It's okay for the hook to refrain from storing anything. */
1649 if (FRAME_TERMINAL (f)->mouse_position_hook)
1650 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1651 &lispy_dummy, &party_dummy,
1652 &x, &y,
1653 &long_dummy);
1654 if (! NILP (x))
1656 col = XINT (x);
1657 row = XINT (y);
1658 pixel_to_glyph_coords (f, col, row, &col, &row, NULL, 1);
1659 XSETINT (x, col);
1660 XSETINT (y, row);
1662 #endif
1663 XSETFRAME (lispy_dummy, f);
1664 retval = Fcons (lispy_dummy, Fcons (x, y));
1665 GCPRO1 (retval);
1666 if (!NILP (Vmouse_position_function))
1667 retval = call1 (Vmouse_position_function, retval);
1668 RETURN_UNGCPRO (retval);
1671 DEFUN ("mouse-pixel-position", Fmouse_pixel_position,
1672 Smouse_pixel_position, 0, 0, 0,
1673 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1674 The position is given in pixel units, where (0, 0) is the
1675 upper-left corner of the frame, X is the horizontal offset, and Y is
1676 the vertical offset.
1677 If Emacs is running on a mouseless terminal or hasn't been programmed
1678 to read the mouse position, it returns the selected frame for FRAME
1679 and nil for X and Y. */)
1680 (void)
1682 FRAME_PTR f;
1683 Lisp_Object lispy_dummy;
1684 enum scroll_bar_part party_dummy;
1685 Lisp_Object x, y;
1686 Time long_dummy;
1688 f = SELECTED_FRAME ();
1689 x = y = Qnil;
1691 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
1692 /* It's okay for the hook to refrain from storing anything. */
1693 if (FRAME_TERMINAL (f)->mouse_position_hook)
1694 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1695 &lispy_dummy, &party_dummy,
1696 &x, &y,
1697 &long_dummy);
1698 #endif
1699 XSETFRAME (lispy_dummy, f);
1700 return Fcons (lispy_dummy, Fcons (x, y));
1703 DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0,
1704 doc: /* Move the mouse pointer to the center of character cell (X,Y) in FRAME.
1705 Coordinates are relative to the frame, not a window,
1706 so the coordinates of the top left character in the frame
1707 may be nonzero due to left-hand scroll bars or the menu bar.
1709 The position is given in character cells, where (0, 0) is the
1710 upper-left corner of the frame, X is the horizontal offset, and Y is
1711 the vertical offset.
1713 This function is a no-op for an X frame that is not visible.
1714 If you have just created a frame, you must wait for it to become visible
1715 before calling this function on it, like this.
1716 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1717 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1719 CHECK_LIVE_FRAME (frame);
1720 CHECK_NUMBER (x);
1721 CHECK_NUMBER (y);
1723 /* I think this should be done with a hook. */
1724 #ifdef HAVE_WINDOW_SYSTEM
1725 if (FRAME_WINDOW_P (XFRAME (frame)))
1726 /* Warping the mouse will cause enternotify and focus events. */
1727 x_set_mouse_position (XFRAME (frame), XINT (x), XINT (y));
1728 #else
1729 #if defined (MSDOS) && defined (HAVE_MOUSE)
1730 if (FRAME_MSDOS_P (XFRAME (frame)))
1732 Fselect_frame (frame, Qnil);
1733 mouse_moveto (XINT (x), XINT (y));
1735 #else
1736 #ifdef HAVE_GPM
1738 Fselect_frame (frame, Qnil);
1739 term_mouse_moveto (XINT (x), XINT (y));
1741 #endif
1742 #endif
1743 #endif
1745 return Qnil;
1748 DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position,
1749 Sset_mouse_pixel_position, 3, 3, 0,
1750 doc: /* Move the mouse pointer to pixel position (X,Y) in FRAME.
1751 The position is given in pixels, where (0, 0) is the upper-left corner
1752 of the frame, X is the horizontal offset, and Y is the vertical offset.
1754 Note, this is a no-op for an X frame that is not visible.
1755 If you have just created a frame, you must wait for it to become visible
1756 before calling this function on it, like this.
1757 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1758 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1760 CHECK_LIVE_FRAME (frame);
1761 CHECK_NUMBER (x);
1762 CHECK_NUMBER (y);
1764 /* I think this should be done with a hook. */
1765 #ifdef HAVE_WINDOW_SYSTEM
1766 if (FRAME_WINDOW_P (XFRAME (frame)))
1767 /* Warping the mouse will cause enternotify and focus events. */
1768 x_set_mouse_pixel_position (XFRAME (frame), XINT (x), XINT (y));
1769 #else
1770 #if defined (MSDOS) && defined (HAVE_MOUSE)
1771 if (FRAME_MSDOS_P (XFRAME (frame)))
1773 Fselect_frame (frame, Qnil);
1774 mouse_moveto (XINT (x), XINT (y));
1776 #else
1777 #ifdef HAVE_GPM
1779 Fselect_frame (frame, Qnil);
1780 term_mouse_moveto (XINT (x), XINT (y));
1782 #endif
1783 #endif
1784 #endif
1786 return Qnil;
1789 static void make_frame_visible_1 (Lisp_Object);
1791 DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible,
1792 0, 1, "",
1793 doc: /* Make the frame FRAME visible (assuming it is an X window).
1794 If omitted, FRAME defaults to the currently selected frame. */)
1795 (Lisp_Object frame)
1797 if (NILP (frame))
1798 frame = selected_frame;
1800 CHECK_LIVE_FRAME (frame);
1802 /* I think this should be done with a hook. */
1803 #ifdef HAVE_WINDOW_SYSTEM
1804 if (FRAME_WINDOW_P (XFRAME (frame)))
1806 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1807 x_make_frame_visible (XFRAME (frame));
1809 #endif
1811 make_frame_visible_1 (XFRAME (frame)->root_window);
1813 /* Make menu bar update for the Buffers and Frames menus. */
1814 windows_or_buffers_changed++;
1816 return frame;
1819 /* Update the display_time slot of the buffers shown in WINDOW
1820 and all its descendents. */
1822 static void
1823 make_frame_visible_1 (Lisp_Object window)
1825 struct window *w;
1827 for (;!NILP (window); window = w->next)
1829 w = XWINDOW (window);
1831 if (!NILP (w->buffer))
1832 BVAR (XBUFFER (w->buffer), display_time) = Fcurrent_time ();
1834 if (!NILP (w->vchild))
1835 make_frame_visible_1 (w->vchild);
1836 if (!NILP (w->hchild))
1837 make_frame_visible_1 (w->hchild);
1841 DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible,
1842 0, 2, "",
1843 doc: /* Make the frame FRAME invisible.
1844 If omitted, FRAME defaults to the currently selected frame.
1845 On graphical displays, invisible frames are not updated and are
1846 usually not displayed at all, even in a window system's \"taskbar\".
1848 Normally you may not make FRAME invisible if all other frames are invisible,
1849 but if the second optional argument FORCE is non-nil, you may do so.
1851 This function has no effect on text-only terminal frames. Such frames
1852 are always considered visible, whether or not they are currently being
1853 displayed in the terminal. */)
1854 (Lisp_Object frame, Lisp_Object force)
1856 if (NILP (frame))
1857 frame = selected_frame;
1859 CHECK_LIVE_FRAME (frame);
1861 if (NILP (force) && !other_visible_frames (XFRAME (frame)))
1862 error ("Attempt to make invisible the sole visible or iconified frame");
1864 #if 0 /* This isn't logically necessary, and it can do GC. */
1865 /* Don't let the frame remain selected. */
1866 if (EQ (frame, selected_frame))
1867 do_switch_frame (next_frame (frame, Qt), 0, 0, Qnil)
1868 #endif
1870 /* Don't allow minibuf_window to remain on a deleted frame. */
1871 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1873 struct frame *sf = XFRAME (selected_frame);
1874 Fset_window_buffer (sf->minibuffer_window,
1875 XWINDOW (minibuf_window)->buffer, Qnil);
1876 minibuf_window = sf->minibuffer_window;
1879 /* I think this should be done with a hook. */
1880 #ifdef HAVE_WINDOW_SYSTEM
1881 if (FRAME_WINDOW_P (XFRAME (frame)))
1882 x_make_frame_invisible (XFRAME (frame));
1883 #endif
1885 /* Make menu bar update for the Buffers and Frames menus. */
1886 windows_or_buffers_changed++;
1888 return Qnil;
1891 DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame,
1892 0, 1, "",
1893 doc: /* Make the frame FRAME into an icon.
1894 If omitted, FRAME defaults to the currently selected frame. */)
1895 (Lisp_Object frame)
1897 if (NILP (frame))
1898 frame = selected_frame;
1900 CHECK_LIVE_FRAME (frame);
1902 #if 0 /* This isn't logically necessary, and it can do GC. */
1903 /* Don't let the frame remain selected. */
1904 if (EQ (frame, selected_frame))
1905 Fhandle_switch_frame (next_frame (frame, Qt));
1906 #endif
1908 /* Don't allow minibuf_window to remain on a deleted frame. */
1909 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1911 struct frame *sf = XFRAME (selected_frame);
1912 Fset_window_buffer (sf->minibuffer_window,
1913 XWINDOW (minibuf_window)->buffer, Qnil);
1914 minibuf_window = sf->minibuffer_window;
1917 /* I think this should be done with a hook. */
1918 #ifdef HAVE_WINDOW_SYSTEM
1919 if (FRAME_WINDOW_P (XFRAME (frame)))
1920 x_iconify_frame (XFRAME (frame));
1921 #endif
1923 /* Make menu bar update for the Buffers and Frames menus. */
1924 windows_or_buffers_changed++;
1926 return Qnil;
1929 DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p,
1930 1, 1, 0,
1931 doc: /* Return t if FRAME is \"visible\" (actually in use for display).
1932 Return the symbol `icon' if FRAME is iconified or \"minimized\".
1933 Return nil if FRAME was made invisible, via `make-frame-invisible'.
1934 On graphical displays, invisible frames are not updated and are
1935 usually not displayed at all, even in a window system's \"taskbar\".
1937 If FRAME is a text-only terminal frame, this always returns t.
1938 Such frames are always considered visible, whether or not they are
1939 currently being displayed on the terminal. */)
1940 (Lisp_Object frame)
1942 CHECK_LIVE_FRAME (frame);
1944 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1946 if (FRAME_VISIBLE_P (XFRAME (frame)))
1947 return Qt;
1948 if (FRAME_ICONIFIED_P (XFRAME (frame)))
1949 return Qicon;
1950 return Qnil;
1953 DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list,
1954 0, 0, 0,
1955 doc: /* Return a list of all frames now \"visible\" (being updated). */)
1956 (void)
1958 Lisp_Object tail, frame;
1959 struct frame *f;
1960 Lisp_Object value;
1962 value = Qnil;
1963 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1965 frame = XCAR (tail);
1966 if (!FRAMEP (frame))
1967 continue;
1968 f = XFRAME (frame);
1969 if (FRAME_VISIBLE_P (f))
1970 value = Fcons (frame, value);
1972 return value;
1976 DEFUN ("raise-frame", Fraise_frame, Sraise_frame, 0, 1, "",
1977 doc: /* Bring FRAME to the front, so it occludes any frames it overlaps.
1978 If FRAME is invisible or iconified, make it visible.
1979 If you don't specify a frame, the selected frame is used.
1980 If Emacs is displaying on an ordinary terminal or some other device which
1981 doesn't support multiple overlapping frames, this function selects FRAME. */)
1982 (Lisp_Object frame)
1984 struct frame *f;
1985 if (NILP (frame))
1986 frame = selected_frame;
1988 CHECK_LIVE_FRAME (frame);
1990 f = XFRAME (frame);
1992 if (FRAME_TERMCAP_P (f))
1993 /* On a text-only terminal select FRAME. */
1994 Fselect_frame (frame, Qnil);
1995 else
1996 /* Do like the documentation says. */
1997 Fmake_frame_visible (frame);
1999 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
2000 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 1);
2002 return Qnil;
2005 /* Should we have a corresponding function called Flower_Power? */
2006 DEFUN ("lower-frame", Flower_frame, Slower_frame, 0, 1, "",
2007 doc: /* Send FRAME to the back, so it is occluded by any frames that overlap it.
2008 If you don't specify a frame, the selected frame is used.
2009 If Emacs is displaying on an ordinary terminal or some other device which
2010 doesn't support multiple overlapping frames, this function does nothing. */)
2011 (Lisp_Object frame)
2013 struct frame *f;
2015 if (NILP (frame))
2016 frame = selected_frame;
2018 CHECK_LIVE_FRAME (frame);
2020 f = XFRAME (frame);
2022 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
2023 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 0);
2025 return Qnil;
2029 DEFUN ("redirect-frame-focus", Fredirect_frame_focus, Sredirect_frame_focus,
2030 1, 2, 0,
2031 doc: /* Arrange for keystrokes typed at FRAME to be sent to FOCUS-FRAME.
2032 In other words, switch-frame events caused by events in FRAME will
2033 request a switch to FOCUS-FRAME, and `last-event-frame' will be
2034 FOCUS-FRAME after reading an event typed at FRAME.
2036 If FOCUS-FRAME is omitted or nil, any existing redirection is
2037 cancelled, and the frame again receives its own keystrokes.
2039 Focus redirection is useful for temporarily redirecting keystrokes to
2040 a surrogate minibuffer frame when a frame doesn't have its own
2041 minibuffer window.
2043 A frame's focus redirection can be changed by `select-frame'. If frame
2044 FOO is selected, and then a different frame BAR is selected, any
2045 frames redirecting their focus to FOO are shifted to redirect their
2046 focus to BAR. This allows focus redirection to work properly when the
2047 user switches from one frame to another using `select-window'.
2049 This means that a frame whose focus is redirected to itself is treated
2050 differently from a frame whose focus is redirected to nil; the former
2051 is affected by `select-frame', while the latter is not.
2053 The redirection lasts until `redirect-frame-focus' is called to change it. */)
2054 (Lisp_Object frame, Lisp_Object focus_frame)
2056 struct frame *f;
2058 /* Note that we don't check for a live frame here. It's reasonable
2059 to redirect the focus of a frame you're about to delete, if you
2060 know what other frame should receive those keystrokes. */
2061 CHECK_FRAME (frame);
2063 if (! NILP (focus_frame))
2064 CHECK_LIVE_FRAME (focus_frame);
2066 f = XFRAME (frame);
2068 f->focus_frame = focus_frame;
2070 if (FRAME_TERMINAL (f)->frame_rehighlight_hook)
2071 (*FRAME_TERMINAL (f)->frame_rehighlight_hook) (f);
2073 return Qnil;
2077 DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 1, 1, 0,
2078 doc: /* Return the frame to which FRAME's keystrokes are currently being sent.
2079 This returns nil if FRAME's focus is not redirected.
2080 See `redirect-frame-focus'. */)
2081 (Lisp_Object frame)
2083 CHECK_LIVE_FRAME (frame);
2085 return FRAME_FOCUS_FRAME (XFRAME (frame));
2090 /* Return the value of frame parameter PROP in frame FRAME. */
2092 #if !HAVE_NS
2093 static
2094 #endif
2095 Lisp_Object
2096 get_frame_param (register struct frame *frame, Lisp_Object prop)
2098 register Lisp_Object tem;
2100 tem = Fassq (prop, frame->param_alist);
2101 if (EQ (tem, Qnil))
2102 return tem;
2103 return Fcdr (tem);
2106 /* Return the buffer-predicate of the selected frame. */
2108 Lisp_Object
2109 frame_buffer_predicate (Lisp_Object frame)
2111 return XFRAME (frame)->buffer_predicate;
2114 /* Return the buffer-list of the selected frame. */
2116 Lisp_Object
2117 frame_buffer_list (Lisp_Object frame)
2119 return XFRAME (frame)->buffer_list;
2122 /* Set the buffer-list of the selected frame. */
2124 void
2125 set_frame_buffer_list (Lisp_Object frame, Lisp_Object list)
2127 XFRAME (frame)->buffer_list = list;
2130 /* Discard BUFFER from the buffer-list and buried-buffer-list of each frame. */
2132 void
2133 frames_discard_buffer (Lisp_Object buffer)
2135 Lisp_Object frame, tail;
2137 FOR_EACH_FRAME (tail, frame)
2139 XFRAME (frame)->buffer_list
2140 = Fdelq (buffer, XFRAME (frame)->buffer_list);
2141 XFRAME (frame)->buried_buffer_list
2142 = Fdelq (buffer, XFRAME (frame)->buried_buffer_list);
2146 /* Modify the alist in *ALISTPTR to associate PROP with VAL.
2147 If the alist already has an element for PROP, we change it. */
2149 void
2150 store_in_alist (Lisp_Object *alistptr, Lisp_Object prop, Lisp_Object val)
2152 register Lisp_Object tem;
2154 tem = Fassq (prop, *alistptr);
2155 if (EQ (tem, Qnil))
2156 *alistptr = Fcons (Fcons (prop, val), *alistptr);
2157 else
2158 Fsetcdr (tem, val);
2161 static int
2162 frame_name_fnn_p (char *str, EMACS_INT len)
2164 if (len > 1 && str[0] == 'F' && '0' <= str[1] && str[1] <= '9')
2166 char *p = str + 2;
2167 while ('0' <= *p && *p <= '9')
2168 p++;
2169 if (p == str + len)
2170 return 1;
2172 return 0;
2175 /* Set the name of the terminal frame. Also used by MSDOS frames.
2176 Modeled after x_set_name which is used for WINDOW frames. */
2178 static void
2179 set_term_frame_name (struct frame *f, Lisp_Object name)
2181 f->explicit_name = ! NILP (name);
2183 /* If NAME is nil, set the name to F<num>. */
2184 if (NILP (name))
2186 char namebuf[20];
2188 /* Check for no change needed in this very common case
2189 before we do any consing. */
2190 if (frame_name_fnn_p (SSDATA (f->name),
2191 SBYTES (f->name)))
2192 return;
2194 tty_frame_count++;
2195 sprintf (namebuf, "F%d", tty_frame_count);
2196 name = build_string (namebuf);
2198 else
2200 CHECK_STRING (name);
2202 /* Don't change the name if it's already NAME. */
2203 if (! NILP (Fstring_equal (name, f->name)))
2204 return;
2206 /* Don't allow the user to set the frame name to F<num>, so it
2207 doesn't clash with the names we generate for terminal frames. */
2208 if (frame_name_fnn_p (SSDATA (name), SBYTES (name)))
2209 error ("Frame names of the form F<num> are usurped by Emacs");
2212 f->name = name;
2213 update_mode_lines = 1;
2216 void
2217 store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
2219 register Lisp_Object old_alist_elt;
2221 /* The buffer-list parameters are stored in a special place and not
2222 in the alist. All buffers must be live. */
2223 if (EQ (prop, Qbuffer_list))
2225 Lisp_Object list = Qnil;
2226 for (; CONSP (val); val = XCDR (val))
2227 if (!NILP (Fbuffer_live_p (XCAR (val))))
2228 list = Fcons (XCAR (val), list);
2229 f->buffer_list = Fnreverse (list);
2230 return;
2232 if (EQ (prop, Qburied_buffer_list))
2234 Lisp_Object list = Qnil;
2235 for (; CONSP (val); val = XCDR (val))
2236 if (!NILP (Fbuffer_live_p (XCAR (val))))
2237 list = Fcons (XCAR (val), list);
2238 f->buried_buffer_list = Fnreverse (list);
2239 return;
2242 /* If PROP is a symbol which is supposed to have frame-local values,
2243 and it is set up based on this frame, switch to the global
2244 binding. That way, we can create or alter the frame-local binding
2245 without messing up the symbol's status. */
2246 if (SYMBOLP (prop))
2248 struct Lisp_Symbol *sym = XSYMBOL (prop);
2249 start:
2250 switch (sym->redirect)
2252 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
2253 case SYMBOL_PLAINVAL: case SYMBOL_FORWARDED: break;
2254 case SYMBOL_LOCALIZED:
2255 { struct Lisp_Buffer_Local_Value *blv = sym->val.blv;
2256 if (blv->frame_local && BLV_FOUND (blv) && XFRAME (blv->where) == f)
2257 swap_in_global_binding (sym);
2258 break;
2260 default: abort ();
2264 /* The tty color needed to be set before the frame's parameter
2265 alist was updated with the new value. This is not true any more,
2266 but we still do this test early on. */
2267 if (FRAME_TERMCAP_P (f) && EQ (prop, Qtty_color_mode)
2268 && f == FRAME_TTY (f)->previous_frame)
2269 /* Force redisplay of this tty. */
2270 FRAME_TTY (f)->previous_frame = NULL;
2272 /* Update the frame parameter alist. */
2273 old_alist_elt = Fassq (prop, f->param_alist);
2274 if (EQ (old_alist_elt, Qnil))
2275 f->param_alist = Fcons (Fcons (prop, val), f->param_alist);
2276 else
2277 Fsetcdr (old_alist_elt, val);
2279 /* Update some other special parameters in their special places
2280 in addition to the alist. */
2282 if (EQ (prop, Qbuffer_predicate))
2283 f->buffer_predicate = val;
2285 if (! FRAME_WINDOW_P (f))
2287 if (EQ (prop, Qmenu_bar_lines))
2288 set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f)));
2289 else if (EQ (prop, Qname))
2290 set_term_frame_name (f, val);
2293 if (EQ (prop, Qminibuffer) && WINDOWP (val))
2295 if (! MINI_WINDOW_P (XWINDOW (val)))
2296 error ("Surrogate minibuffer windows must be minibuffer windows");
2298 if ((FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
2299 && !EQ (val, f->minibuffer_window))
2300 error ("Can't change the surrogate minibuffer of a frame with its own minibuffer");
2302 /* Install the chosen minibuffer window, with proper buffer. */
2303 f->minibuffer_window = val;
2307 DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0,
2308 doc: /* Return the parameters-alist of frame FRAME.
2309 It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
2310 The meaningful PARMs depend on the kind of frame.
2311 If FRAME is omitted, return information on the currently selected frame. */)
2312 (Lisp_Object frame)
2314 Lisp_Object alist;
2315 FRAME_PTR f;
2316 int height, width;
2317 struct gcpro gcpro1;
2319 if (NILP (frame))
2320 frame = selected_frame;
2322 CHECK_FRAME (frame);
2323 f = XFRAME (frame);
2325 if (!FRAME_LIVE_P (f))
2326 return Qnil;
2328 alist = Fcopy_alist (f->param_alist);
2329 GCPRO1 (alist);
2331 if (!FRAME_WINDOW_P (f))
2333 int fg = FRAME_FOREGROUND_PIXEL (f);
2334 int bg = FRAME_BACKGROUND_PIXEL (f);
2335 Lisp_Object elt;
2337 /* If the frame's parameter alist says the colors are
2338 unspecified and reversed, take the frame's background pixel
2339 for foreground and vice versa. */
2340 elt = Fassq (Qforeground_color, alist);
2341 if (CONSP (elt) && STRINGP (XCDR (elt)))
2343 if (strncmp (SSDATA (XCDR (elt)),
2344 unspecified_bg,
2345 SCHARS (XCDR (elt))) == 0)
2346 store_in_alist (&alist, Qforeground_color, tty_color_name (f, bg));
2347 else if (strncmp (SSDATA (XCDR (elt)),
2348 unspecified_fg,
2349 SCHARS (XCDR (elt))) == 0)
2350 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2352 else
2353 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2354 elt = Fassq (Qbackground_color, alist);
2355 if (CONSP (elt) && STRINGP (XCDR (elt)))
2357 if (strncmp (SSDATA (XCDR (elt)),
2358 unspecified_fg,
2359 SCHARS (XCDR (elt))) == 0)
2360 store_in_alist (&alist, Qbackground_color, tty_color_name (f, fg));
2361 else if (strncmp (SSDATA (XCDR (elt)),
2362 unspecified_bg,
2363 SCHARS (XCDR (elt))) == 0)
2364 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2366 else
2367 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2368 store_in_alist (&alist, intern ("font"),
2369 build_string (FRAME_MSDOS_P (f)
2370 ? "ms-dos"
2371 : FRAME_W32_P (f) ? "w32term"
2372 :"tty"));
2374 store_in_alist (&alist, Qname, f->name);
2375 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2376 store_in_alist (&alist, Qheight, make_number (height));
2377 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2378 store_in_alist (&alist, Qwidth, make_number (width));
2379 store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil));
2380 store_in_alist (&alist, Qminibuffer,
2381 (! FRAME_HAS_MINIBUF_P (f) ? Qnil
2382 : FRAME_MINIBUF_ONLY_P (f) ? Qonly
2383 : FRAME_MINIBUF_WINDOW (f)));
2384 store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
2385 store_in_alist (&alist, Qbuffer_list, frame_buffer_list (frame));
2386 store_in_alist (&alist, Qburied_buffer_list, XFRAME (frame)->buried_buffer_list);
2388 /* I think this should be done with a hook. */
2389 #ifdef HAVE_WINDOW_SYSTEM
2390 if (FRAME_WINDOW_P (f))
2391 x_report_frame_params (f, &alist);
2392 else
2393 #endif
2395 /* This ought to be correct in f->param_alist for an X frame. */
2396 Lisp_Object lines;
2397 XSETFASTINT (lines, FRAME_MENU_BAR_LINES (f));
2398 store_in_alist (&alist, Qmenu_bar_lines, lines);
2401 UNGCPRO;
2402 return alist;
2406 DEFUN ("frame-parameter", Fframe_parameter, Sframe_parameter, 2, 2, 0,
2407 doc: /* Return FRAME's value for parameter PARAMETER.
2408 If FRAME is nil, describe the currently selected frame. */)
2409 (Lisp_Object frame, Lisp_Object parameter)
2411 struct frame *f;
2412 Lisp_Object value;
2414 if (NILP (frame))
2415 frame = selected_frame;
2416 else
2417 CHECK_FRAME (frame);
2418 CHECK_SYMBOL (parameter);
2420 f = XFRAME (frame);
2421 value = Qnil;
2423 if (FRAME_LIVE_P (f))
2425 /* Avoid consing in frequent cases. */
2426 if (EQ (parameter, Qname))
2427 value = f->name;
2428 #ifdef HAVE_X_WINDOWS
2429 else if (EQ (parameter, Qdisplay) && FRAME_X_P (f))
2430 value = XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element);
2431 #endif /* HAVE_X_WINDOWS */
2432 else if (EQ (parameter, Qbackground_color)
2433 || EQ (parameter, Qforeground_color))
2435 value = Fassq (parameter, f->param_alist);
2436 if (CONSP (value))
2438 value = XCDR (value);
2439 /* Fframe_parameters puts the actual fg/bg color names,
2440 even if f->param_alist says otherwise. This is
2441 important when param_alist's notion of colors is
2442 "unspecified". We need to do the same here. */
2443 if (STRINGP (value) && !FRAME_WINDOW_P (f))
2445 const char *color_name;
2446 EMACS_INT csz;
2448 if (EQ (parameter, Qbackground_color))
2450 color_name = SSDATA (value);
2451 csz = SCHARS (value);
2452 if (strncmp (color_name, unspecified_bg, csz) == 0)
2453 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2454 else if (strncmp (color_name, unspecified_fg, csz) == 0)
2455 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2457 else if (EQ (parameter, Qforeground_color))
2459 color_name = SSDATA (value);
2460 csz = SCHARS (value);
2461 if (strncmp (color_name, unspecified_fg, csz) == 0)
2462 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2463 else if (strncmp (color_name, unspecified_bg, csz) == 0)
2464 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2468 else
2469 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2471 else if (EQ (parameter, Qdisplay_type)
2472 || EQ (parameter, Qbackground_mode))
2473 value = Fcdr (Fassq (parameter, f->param_alist));
2474 else
2475 /* FIXME: Avoid this code path at all (as well as code duplication)
2476 by sharing more code with Fframe_parameters. */
2477 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2480 return value;
2484 DEFUN ("modify-frame-parameters", Fmodify_frame_parameters,
2485 Smodify_frame_parameters, 2, 2, 0,
2486 doc: /* Modify the parameters of frame FRAME according to ALIST.
2487 If FRAME is nil, it defaults to the selected frame.
2488 ALIST is an alist of parameters to change and their new values.
2489 Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.
2490 The meaningful PARMs depend on the kind of frame.
2491 Undefined PARMs are ignored, but stored in the frame's parameter list
2492 so that `frame-parameters' will return them.
2494 The value of frame parameter FOO can also be accessed
2495 as a frame-local binding for the variable FOO, if you have
2496 enabled such bindings for that variable with `make-variable-frame-local'.
2497 Note that this functionality is obsolete as of Emacs 22.2, and its
2498 use is not recommended. Explicitly check for a frame-parameter instead. */)
2499 (Lisp_Object frame, Lisp_Object alist)
2501 FRAME_PTR f;
2502 register Lisp_Object tail, prop, val;
2504 if (EQ (frame, Qnil))
2505 frame = selected_frame;
2506 CHECK_LIVE_FRAME (frame);
2507 f = XFRAME (frame);
2509 /* I think this should be done with a hook. */
2510 #ifdef HAVE_WINDOW_SYSTEM
2511 if (FRAME_WINDOW_P (f))
2512 x_set_frame_parameters (f, alist);
2513 else
2514 #endif
2515 #ifdef MSDOS
2516 if (FRAME_MSDOS_P (f))
2517 IT_set_frame_parameters (f, alist);
2518 else
2519 #endif
2522 int length = XINT (Flength (alist));
2523 int i;
2524 Lisp_Object *parms
2525 = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
2526 Lisp_Object *values
2527 = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
2529 /* Extract parm names and values into those vectors. */
2531 i = 0;
2532 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2534 Lisp_Object elt;
2536 elt = XCAR (tail);
2537 parms[i] = Fcar (elt);
2538 values[i] = Fcdr (elt);
2539 i++;
2542 /* Now process them in reverse of specified order. */
2543 while (--i >= 0)
2545 prop = parms[i];
2546 val = values[i];
2547 store_frame_param (f, prop, val);
2549 /* Changing the background color might change the background
2550 mode, so that we have to load new defface specs.
2551 Call frame-set-background-mode to do that. */
2552 if (EQ (prop, Qbackground_color))
2553 call1 (Qframe_set_background_mode, frame);
2556 return Qnil;
2559 DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height,
2560 0, 1, 0,
2561 doc: /* Height in pixels of a line in the font in frame FRAME.
2562 If FRAME is omitted, the selected frame is used.
2563 For a terminal frame, the value is always 1. */)
2564 (Lisp_Object frame)
2566 struct frame *f;
2568 if (NILP (frame))
2569 frame = selected_frame;
2570 CHECK_FRAME (frame);
2571 f = XFRAME (frame);
2573 #ifdef HAVE_WINDOW_SYSTEM
2574 if (FRAME_WINDOW_P (f))
2575 return make_number (x_char_height (f));
2576 else
2577 #endif
2578 return make_number (1);
2582 DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width,
2583 0, 1, 0,
2584 doc: /* Width in pixels of characters in the font in frame FRAME.
2585 If FRAME is omitted, the selected frame is used.
2586 On a graphical screen, the width is the standard width of the default font.
2587 For a terminal screen, the value is always 1. */)
2588 (Lisp_Object frame)
2590 struct frame *f;
2592 if (NILP (frame))
2593 frame = selected_frame;
2594 CHECK_FRAME (frame);
2595 f = XFRAME (frame);
2597 #ifdef HAVE_WINDOW_SYSTEM
2598 if (FRAME_WINDOW_P (f))
2599 return make_number (x_char_width (f));
2600 else
2601 #endif
2602 return make_number (1);
2605 DEFUN ("frame-pixel-height", Fframe_pixel_height,
2606 Sframe_pixel_height, 0, 1, 0,
2607 doc: /* Return a FRAME's height in pixels.
2608 If FRAME is omitted, the selected frame is used. The exact value
2609 of the result depends on the window-system and toolkit in use:
2611 In the Gtk+ version of Emacs, it includes only any window (including
2612 the minibuffer or eacho area), mode line, and header line. It does not
2613 include the tool bar or menu bar.
2615 With the Motif or Lucid toolkits, it also includes the tool bar (but
2616 not the menu bar).
2618 In a graphical version with no toolkit, it includes both the tool bar
2619 and menu bar.
2621 For a text-only terminal, it includes the menu bar. In this case, the
2622 result is really in characters rather than pixels (i.e., is identical
2623 to `frame-height'). */)
2624 (Lisp_Object frame)
2626 struct frame *f;
2628 if (NILP (frame))
2629 frame = selected_frame;
2630 CHECK_FRAME (frame);
2631 f = XFRAME (frame);
2633 #ifdef HAVE_WINDOW_SYSTEM
2634 if (FRAME_WINDOW_P (f))
2635 return make_number (x_pixel_height (f));
2636 else
2637 #endif
2638 return make_number (FRAME_LINES (f));
2641 DEFUN ("frame-pixel-width", Fframe_pixel_width,
2642 Sframe_pixel_width, 0, 1, 0,
2643 doc: /* Return FRAME's width in pixels.
2644 For a terminal frame, the result really gives the width in characters.
2645 If FRAME is omitted, the selected frame is used. */)
2646 (Lisp_Object frame)
2648 struct frame *f;
2650 if (NILP (frame))
2651 frame = selected_frame;
2652 CHECK_FRAME (frame);
2653 f = XFRAME (frame);
2655 #ifdef HAVE_WINDOW_SYSTEM
2656 if (FRAME_WINDOW_P (f))
2657 return make_number (x_pixel_width (f));
2658 else
2659 #endif
2660 return make_number (FRAME_COLS (f));
2663 DEFUN ("tool-bar-pixel-width", Ftool_bar_pixel_width,
2664 Stool_bar_pixel_width, 0, 1, 0,
2665 doc: /* Return width in pixels of FRAME's tool bar.
2666 The result is greater than zero only when the tool bar is on the left
2667 or right side of FRAME. If FRAME is omitted, the selected frame is
2668 used. */)
2669 (Lisp_Object frame)
2671 struct frame *f;
2673 if (NILP (frame))
2674 frame = selected_frame;
2675 CHECK_FRAME (frame);
2676 f = XFRAME (frame);
2678 #ifdef FRAME_TOOLBAR_WIDTH
2679 if (FRAME_WINDOW_P (f))
2680 return make_number (FRAME_TOOLBAR_WIDTH (f));
2681 #endif
2682 return make_number (0);
2685 DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0,
2686 doc: /* Specify that the frame FRAME has LINES lines.
2687 Optional third arg non-nil means that redisplay should use LINES lines
2688 but that the idea of the actual height of the frame should not be changed. */)
2689 (Lisp_Object frame, Lisp_Object lines, Lisp_Object pretend)
2691 register struct frame *f;
2693 CHECK_NUMBER (lines);
2694 if (NILP (frame))
2695 frame = selected_frame;
2696 CHECK_LIVE_FRAME (frame);
2697 f = XFRAME (frame);
2699 /* I think this should be done with a hook. */
2700 #ifdef HAVE_WINDOW_SYSTEM
2701 if (FRAME_WINDOW_P (f))
2703 if (XINT (lines) != FRAME_LINES (f))
2704 x_set_window_size (f, 1, FRAME_COLS (f), XINT (lines));
2705 do_pending_window_change (0);
2707 else
2708 #endif
2709 change_frame_size (f, XINT (lines), 0, !NILP (pretend), 0, 0);
2710 return Qnil;
2713 DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 3, 0,
2714 doc: /* Specify that the frame FRAME has COLS columns.
2715 Optional third arg non-nil means that redisplay should use COLS columns
2716 but that the idea of the actual width of the frame should not be changed. */)
2717 (Lisp_Object frame, Lisp_Object cols, Lisp_Object pretend)
2719 register struct frame *f;
2720 CHECK_NUMBER (cols);
2721 if (NILP (frame))
2722 frame = selected_frame;
2723 CHECK_LIVE_FRAME (frame);
2724 f = XFRAME (frame);
2726 /* I think this should be done with a hook. */
2727 #ifdef HAVE_WINDOW_SYSTEM
2728 if (FRAME_WINDOW_P (f))
2730 if (XINT (cols) != FRAME_COLS (f))
2731 x_set_window_size (f, 1, XINT (cols), FRAME_LINES (f));
2732 do_pending_window_change (0);
2734 else
2735 #endif
2736 change_frame_size (f, 0, XINT (cols), !NILP (pretend), 0, 0);
2737 return Qnil;
2740 DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0,
2741 doc: /* Sets size of FRAME to COLS by ROWS, measured in characters. */)
2742 (Lisp_Object frame, Lisp_Object cols, Lisp_Object rows)
2744 register struct frame *f;
2746 CHECK_LIVE_FRAME (frame);
2747 CHECK_NUMBER (cols);
2748 CHECK_NUMBER (rows);
2749 f = XFRAME (frame);
2751 /* I think this should be done with a hook. */
2752 #ifdef HAVE_WINDOW_SYSTEM
2753 if (FRAME_WINDOW_P (f))
2755 if (XINT (rows) != FRAME_LINES (f)
2756 || XINT (cols) != FRAME_COLS (f)
2757 || f->new_text_lines || f->new_text_cols)
2758 x_set_window_size (f, 1, XINT (cols), XINT (rows));
2759 do_pending_window_change (0);
2761 else
2762 #endif
2763 change_frame_size (f, XINT (rows), XINT (cols), 0, 0, 0);
2765 return Qnil;
2768 DEFUN ("set-frame-position", Fset_frame_position,
2769 Sset_frame_position, 3, 3, 0,
2770 doc: /* Sets position of FRAME in pixels to XOFFSET by YOFFSET.
2771 This is actually the position of the upper left corner of the frame.
2772 Negative values for XOFFSET or YOFFSET are interpreted relative to
2773 the rightmost or bottommost possible position (that stays within the screen). */)
2774 (Lisp_Object frame, Lisp_Object xoffset, Lisp_Object yoffset)
2776 register struct frame *f;
2778 CHECK_LIVE_FRAME (frame);
2779 CHECK_NUMBER (xoffset);
2780 CHECK_NUMBER (yoffset);
2781 f = XFRAME (frame);
2783 /* I think this should be done with a hook. */
2784 #ifdef HAVE_WINDOW_SYSTEM
2785 if (FRAME_WINDOW_P (f))
2786 x_set_offset (f, XINT (xoffset), XINT (yoffset), 1);
2787 #endif
2789 return Qt;
2793 /***********************************************************************
2794 Frame Parameters
2795 ***********************************************************************/
2797 /* Connect the frame-parameter names for X frames
2798 to the ways of passing the parameter values to the window system.
2800 The name of a parameter, as a Lisp symbol,
2801 has an `x-frame-parameter' property which is an integer in Lisp
2802 that is an index in this table. */
2804 struct frame_parm_table {
2805 const char *name;
2806 Lisp_Object *variable;
2809 static const struct frame_parm_table frame_parms[] =
2811 {"auto-raise", &Qauto_raise},
2812 {"auto-lower", &Qauto_lower},
2813 {"background-color", 0},
2814 {"border-color", &Qborder_color},
2815 {"border-width", &Qborder_width},
2816 {"cursor-color", &Qcursor_color},
2817 {"cursor-type", &Qcursor_type},
2818 {"font", 0},
2819 {"foreground-color", 0},
2820 {"icon-name", &Qicon_name},
2821 {"icon-type", &Qicon_type},
2822 {"internal-border-width", &Qinternal_border_width},
2823 {"menu-bar-lines", &Qmenu_bar_lines},
2824 {"mouse-color", &Qmouse_color},
2825 {"name", &Qname},
2826 {"scroll-bar-width", &Qscroll_bar_width},
2827 {"title", &Qtitle},
2828 {"unsplittable", &Qunsplittable},
2829 {"vertical-scroll-bars", &Qvertical_scroll_bars},
2830 {"visibility", &Qvisibility},
2831 {"tool-bar-lines", &Qtool_bar_lines},
2832 {"scroll-bar-foreground", &Qscroll_bar_foreground},
2833 {"scroll-bar-background", &Qscroll_bar_background},
2834 {"screen-gamma", &Qscreen_gamma},
2835 {"line-spacing", &Qline_spacing},
2836 {"left-fringe", &Qleft_fringe},
2837 {"right-fringe", &Qright_fringe},
2838 {"wait-for-wm", &Qwait_for_wm},
2839 {"fullscreen", &Qfullscreen},
2840 {"font-backend", &Qfont_backend},
2841 {"alpha", &Qalpha},
2842 {"sticky", &Qsticky},
2843 {"tool-bar-position", &Qtool_bar_position},
2846 #ifdef WINDOWSNT
2848 /* Calculate fullscreen size. Return in *TOP_POS and *LEFT_POS the
2849 wanted positions of the WM window (not Emacs window).
2850 Return in *WIDTH and *HEIGHT the wanted width and height of Emacs
2851 window (FRAME_X_WINDOW).
2854 void
2855 x_fullscreen_adjust (struct frame *f, int *width, int *height, int *top_pos, int *left_pos)
2857 int newwidth = FRAME_COLS (f);
2858 int newheight = FRAME_LINES (f);
2859 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2861 *top_pos = f->top_pos;
2862 *left_pos = f->left_pos;
2864 if (f->want_fullscreen & FULLSCREEN_HEIGHT)
2866 int ph;
2868 ph = x_display_pixel_height (dpyinfo);
2869 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2870 ph = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, newheight) - f->y_pixels_diff;
2871 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2872 *top_pos = 0;
2875 if (f->want_fullscreen & FULLSCREEN_WIDTH)
2877 int pw;
2879 pw = x_display_pixel_width (dpyinfo);
2880 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2881 pw = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, newwidth) - f->x_pixels_diff;
2882 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2883 *left_pos = 0;
2886 *width = newwidth;
2887 *height = newheight;
2890 #endif /* WINDOWSNT */
2892 #ifdef HAVE_WINDOW_SYSTEM
2894 /* Change the parameters of frame F as specified by ALIST.
2895 If a parameter is not specially recognized, do nothing special;
2896 otherwise call the `x_set_...' function for that parameter.
2897 Except for certain geometry properties, always call store_frame_param
2898 to store the new value in the parameter alist. */
2900 void
2901 x_set_frame_parameters (FRAME_PTR f, Lisp_Object alist)
2903 Lisp_Object tail;
2905 /* If both of these parameters are present, it's more efficient to
2906 set them both at once. So we wait until we've looked at the
2907 entire list before we set them. */
2908 int width, height;
2910 /* Same here. */
2911 Lisp_Object left, top;
2913 /* Same with these. */
2914 Lisp_Object icon_left, icon_top;
2916 /* Record in these vectors all the parms specified. */
2917 Lisp_Object *parms;
2918 Lisp_Object *values;
2919 size_t i, p;
2920 int left_no_change = 0, top_no_change = 0;
2921 int icon_left_no_change = 0, icon_top_no_change = 0;
2922 int size_changed = 0;
2923 struct gcpro gcpro1, gcpro2;
2925 i = 0;
2926 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
2927 i++;
2929 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
2930 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
2932 /* Extract parm names and values into those vectors. */
2934 i = 0;
2935 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2937 Lisp_Object elt;
2939 elt = XCAR (tail);
2940 parms[i] = Fcar (elt);
2941 values[i] = Fcdr (elt);
2942 i++;
2944 /* TAIL and ALIST are not used again below here. */
2945 alist = tail = Qnil;
2947 GCPRO2 (*parms, *values);
2948 gcpro1.nvars = i;
2949 gcpro2.nvars = i;
2951 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
2952 because their values appear in VALUES and strings are not valid. */
2953 top = left = Qunbound;
2954 icon_left = icon_top = Qunbound;
2956 /* Provide default values for HEIGHT and WIDTH. */
2957 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2958 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2960 /* Process foreground_color and background_color before anything else.
2961 They are independent of other properties, but other properties (e.g.,
2962 cursor_color) are dependent upon them. */
2963 /* Process default font as well, since fringe widths depends on it. */
2964 for (p = 0; p < i; p++)
2966 Lisp_Object prop, val;
2968 prop = parms[p];
2969 val = values[p];
2970 if (EQ (prop, Qforeground_color)
2971 || EQ (prop, Qbackground_color)
2972 || EQ (prop, Qfont))
2974 register Lisp_Object param_index, old_value;
2976 old_value = get_frame_param (f, prop);
2977 if (NILP (Fequal (val, old_value)))
2979 store_frame_param (f, prop, val);
2981 param_index = Fget (prop, Qx_frame_parameter);
2982 if (NATNUMP (param_index)
2983 && (XFASTINT (param_index)
2984 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2985 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
2986 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2991 /* Now process them in reverse of specified order. */
2992 while (i-- != 0)
2994 Lisp_Object prop, val;
2996 prop = parms[i];
2997 val = values[i];
2999 if (EQ (prop, Qwidth) && NATNUMP (val))
3001 size_changed = 1;
3002 width = XFASTINT (val);
3004 else if (EQ (prop, Qheight) && NATNUMP (val))
3006 size_changed = 1;
3007 height = XFASTINT (val);
3009 else if (EQ (prop, Qtop))
3010 top = val;
3011 else if (EQ (prop, Qleft))
3012 left = val;
3013 else if (EQ (prop, Qicon_top))
3014 icon_top = val;
3015 else if (EQ (prop, Qicon_left))
3016 icon_left = val;
3017 else if (EQ (prop, Qforeground_color)
3018 || EQ (prop, Qbackground_color)
3019 || EQ (prop, Qfont))
3020 /* Processed above. */
3021 continue;
3022 else
3024 register Lisp_Object param_index, old_value;
3026 old_value = get_frame_param (f, prop);
3028 store_frame_param (f, prop, val);
3030 param_index = Fget (prop, Qx_frame_parameter);
3031 if (NATNUMP (param_index)
3032 && (XFASTINT (param_index)
3033 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3034 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
3035 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
3039 /* Don't die if just one of these was set. */
3040 if (EQ (left, Qunbound))
3042 left_no_change = 1;
3043 if (f->left_pos < 0)
3044 left = Fcons (Qplus, Fcons (make_number (f->left_pos), Qnil));
3045 else
3046 XSETINT (left, f->left_pos);
3048 if (EQ (top, Qunbound))
3050 top_no_change = 1;
3051 if (f->top_pos < 0)
3052 top = Fcons (Qplus, Fcons (make_number (f->top_pos), Qnil));
3053 else
3054 XSETINT (top, f->top_pos);
3057 /* If one of the icon positions was not set, preserve or default it. */
3058 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
3060 icon_left_no_change = 1;
3061 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
3062 if (NILP (icon_left))
3063 XSETINT (icon_left, 0);
3065 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
3067 icon_top_no_change = 1;
3068 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
3069 if (NILP (icon_top))
3070 XSETINT (icon_top, 0);
3073 /* Don't set these parameters unless they've been explicitly
3074 specified. The window might be mapped or resized while we're in
3075 this function, and we don't want to override that unless the lisp
3076 code has asked for it.
3078 Don't set these parameters unless they actually differ from the
3079 window's current parameters; the window may not actually exist
3080 yet. */
3082 Lisp_Object frame;
3084 check_frame_size (f, &height, &width);
3086 XSETFRAME (frame, f);
3088 if (size_changed
3089 && (width != FRAME_COLS (f)
3090 || height != FRAME_LINES (f)
3091 || f->new_text_lines || f->new_text_cols))
3092 Fset_frame_size (frame, make_number (width), make_number (height));
3094 if ((!NILP (left) || !NILP (top))
3095 && ! (left_no_change && top_no_change)
3096 && ! (NUMBERP (left) && XINT (left) == f->left_pos
3097 && NUMBERP (top) && XINT (top) == f->top_pos))
3099 int leftpos = 0;
3100 int toppos = 0;
3102 /* Record the signs. */
3103 f->size_hint_flags &= ~ (XNegative | YNegative);
3104 if (EQ (left, Qminus))
3105 f->size_hint_flags |= XNegative;
3106 else if (INTEGERP (left))
3108 leftpos = XINT (left);
3109 if (leftpos < 0)
3110 f->size_hint_flags |= XNegative;
3112 else if (CONSP (left) && EQ (XCAR (left), Qminus)
3113 && CONSP (XCDR (left))
3114 && INTEGERP (XCAR (XCDR (left))))
3116 leftpos = - XINT (XCAR (XCDR (left)));
3117 f->size_hint_flags |= XNegative;
3119 else if (CONSP (left) && EQ (XCAR (left), Qplus)
3120 && CONSP (XCDR (left))
3121 && INTEGERP (XCAR (XCDR (left))))
3123 leftpos = XINT (XCAR (XCDR (left)));
3126 if (EQ (top, Qminus))
3127 f->size_hint_flags |= YNegative;
3128 else if (INTEGERP (top))
3130 toppos = XINT (top);
3131 if (toppos < 0)
3132 f->size_hint_flags |= YNegative;
3134 else if (CONSP (top) && EQ (XCAR (top), Qminus)
3135 && CONSP (XCDR (top))
3136 && INTEGERP (XCAR (XCDR (top))))
3138 toppos = - XINT (XCAR (XCDR (top)));
3139 f->size_hint_flags |= YNegative;
3141 else if (CONSP (top) && EQ (XCAR (top), Qplus)
3142 && CONSP (XCDR (top))
3143 && INTEGERP (XCAR (XCDR (top))))
3145 toppos = XINT (XCAR (XCDR (top)));
3149 /* Store the numeric value of the position. */
3150 f->top_pos = toppos;
3151 f->left_pos = leftpos;
3153 f->win_gravity = NorthWestGravity;
3155 /* Actually set that position, and convert to absolute. */
3156 x_set_offset (f, leftpos, toppos, -1);
3159 if ((!NILP (icon_left) || !NILP (icon_top))
3160 && ! (icon_left_no_change && icon_top_no_change))
3161 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
3164 UNGCPRO;
3168 /* Insert a description of internally-recorded parameters of frame X
3169 into the parameter alist *ALISTPTR that is to be given to the user.
3170 Only parameters that are specific to the X window system
3171 and whose values are not correctly recorded in the frame's
3172 param_alist need to be considered here. */
3174 void
3175 x_report_frame_params (struct frame *f, Lisp_Object *alistptr)
3177 char buf[16];
3178 Lisp_Object tem;
3180 /* Represent negative positions (off the top or left screen edge)
3181 in a way that Fmodify_frame_parameters will understand correctly. */
3182 XSETINT (tem, f->left_pos);
3183 if (f->left_pos >= 0)
3184 store_in_alist (alistptr, Qleft, tem);
3185 else
3186 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
3188 XSETINT (tem, f->top_pos);
3189 if (f->top_pos >= 0)
3190 store_in_alist (alistptr, Qtop, tem);
3191 else
3192 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
3194 store_in_alist (alistptr, Qborder_width,
3195 make_number (f->border_width));
3196 store_in_alist (alistptr, Qinternal_border_width,
3197 make_number (FRAME_INTERNAL_BORDER_WIDTH (f)));
3198 store_in_alist (alistptr, Qleft_fringe,
3199 make_number (FRAME_LEFT_FRINGE_WIDTH (f)));
3200 store_in_alist (alistptr, Qright_fringe,
3201 make_number (FRAME_RIGHT_FRINGE_WIDTH (f)));
3202 store_in_alist (alistptr, Qscroll_bar_width,
3203 (! FRAME_HAS_VERTICAL_SCROLL_BARS (f)
3204 ? make_number (0)
3205 : FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0
3206 ? make_number (FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3207 /* nil means "use default width"
3208 for non-toolkit scroll bar.
3209 ruler-mode.el depends on this. */
3210 : Qnil));
3211 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
3212 store_in_alist (alistptr, Qwindow_id,
3213 build_string (buf));
3214 #ifdef HAVE_X_WINDOWS
3215 #ifdef USE_X_TOOLKIT
3216 /* Tooltip frame may not have this widget. */
3217 if (FRAME_X_OUTPUT (f)->widget)
3218 #endif
3219 sprintf (buf, "%ld", (long) FRAME_OUTER_WINDOW (f));
3220 store_in_alist (alistptr, Qouter_window_id,
3221 build_string (buf));
3222 #endif
3223 store_in_alist (alistptr, Qicon_name, f->icon_name);
3224 FRAME_SAMPLE_VISIBILITY (f);
3225 store_in_alist (alistptr, Qvisibility,
3226 (FRAME_VISIBLE_P (f) ? Qt
3227 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
3228 store_in_alist (alistptr, Qdisplay,
3229 XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
3231 if (FRAME_X_OUTPUT (f)->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
3232 tem = Qnil;
3233 else
3234 XSETFASTINT (tem, FRAME_X_OUTPUT (f)->parent_desc);
3235 store_in_alist (alistptr, Qexplicit_name, (f->explicit_name ? Qt : Qnil));
3236 store_in_alist (alistptr, Qparent_id, tem);
3237 store_in_alist (alistptr, Qtool_bar_position, f->tool_bar_position);
3241 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
3242 the previous value of that parameter, NEW_VALUE is the new value. */
3244 void
3245 x_set_fullscreen (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3247 if (NILP (new_value))
3248 f->want_fullscreen = FULLSCREEN_NONE;
3249 else if (EQ (new_value, Qfullboth) || EQ (new_value, Qfullscreen))
3250 f->want_fullscreen = FULLSCREEN_BOTH;
3251 else if (EQ (new_value, Qfullwidth))
3252 f->want_fullscreen = FULLSCREEN_WIDTH;
3253 else if (EQ (new_value, Qfullheight))
3254 f->want_fullscreen = FULLSCREEN_HEIGHT;
3255 else if (EQ (new_value, Qmaximized))
3256 f->want_fullscreen = FULLSCREEN_MAXIMIZED;
3258 if (FRAME_TERMINAL (f)->fullscreen_hook != NULL)
3259 FRAME_TERMINAL (f)->fullscreen_hook (f);
3263 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
3264 the previous value of that parameter, NEW_VALUE is the new value. */
3266 void
3267 x_set_line_spacing (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3269 if (NILP (new_value))
3270 f->extra_line_spacing = 0;
3271 else if (NATNUMP (new_value))
3272 f->extra_line_spacing = XFASTINT (new_value);
3273 else
3274 signal_error ("Invalid line-spacing", new_value);
3275 if (FRAME_VISIBLE_P (f))
3276 redraw_frame (f);
3280 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
3281 the previous value of that parameter, NEW_VALUE is the new value. */
3283 void
3284 x_set_screen_gamma (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3286 Lisp_Object bgcolor;
3288 if (NILP (new_value))
3289 f->gamma = 0;
3290 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
3291 /* The value 0.4545 is the normal viewing gamma. */
3292 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
3293 else
3294 signal_error ("Invalid screen-gamma", new_value);
3296 /* Apply the new gamma value to the frame background. */
3297 bgcolor = Fassq (Qbackground_color, f->param_alist);
3298 if (CONSP (bgcolor) && (bgcolor = XCDR (bgcolor), STRINGP (bgcolor)))
3300 Lisp_Object parm_index = Fget (Qbackground_color, Qx_frame_parameter);
3301 if (NATNUMP (parm_index)
3302 && (XFASTINT (parm_index)
3303 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3304 && FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
3305 (*FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
3306 (f, bgcolor, Qnil);
3309 Fclear_face_cache (Qnil);
3313 void
3314 x_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3316 Lisp_Object font_object, font_param = Qnil;
3317 int fontset = -1;
3319 /* Set the frame parameter back to the old value because we may
3320 fail to use ARG as the new parameter value. */
3321 store_frame_param (f, Qfont, oldval);
3323 /* ARG is a fontset name, a font name, a cons of fontset name and a
3324 font object, or a font object. In the last case, this function
3325 never fail. */
3326 if (STRINGP (arg))
3328 font_param = arg;
3329 fontset = fs_query_fontset (arg, 0);
3330 if (fontset < 0)
3332 font_object = font_open_by_name (f, SSDATA (arg));
3333 if (NILP (font_object))
3334 error ("Font `%s' is not defined", SSDATA (arg));
3335 arg = AREF (font_object, FONT_NAME_INDEX);
3337 else if (fontset > 0)
3339 Lisp_Object ascii_font = fontset_ascii (fontset);
3341 font_object = font_open_by_name (f, SSDATA (ascii_font));
3342 if (NILP (font_object))
3343 error ("Font `%s' is not defined", SDATA (arg));
3344 arg = AREF (font_object, FONT_NAME_INDEX);
3346 else
3347 error ("The default fontset can't be used for a frame font");
3349 else if (CONSP (arg) && STRINGP (XCAR (arg)) && FONT_OBJECT_P (XCDR (arg)))
3351 /* This is the case that the ASCII font of F's fontset XCAR
3352 (arg) is changed to the font XCDR (arg) by
3353 `set-fontset-font'. */
3354 fontset = fs_query_fontset (XCAR (arg), 0);
3355 if (fontset < 0)
3356 error ("Unknown fontset: %s", SDATA (XCAR (arg)));
3357 font_object = XCDR (arg);
3358 arg = AREF (font_object, FONT_NAME_INDEX);
3359 font_param = Ffont_get (font_object, QCname);
3361 else if (FONT_OBJECT_P (arg))
3363 font_object = arg;
3364 font_param = Ffont_get (font_object, QCname);
3365 /* This is to store the XLFD font name in the frame parameter for
3366 backward compatibility. We should store the font-object
3367 itself in the future. */
3368 arg = AREF (font_object, FONT_NAME_INDEX);
3369 fontset = FRAME_FONTSET (f);
3370 /* Check if we can use the current fontset. If not, set FONTSET
3371 to -1 to generate a new fontset from FONT-OBJECT. */
3372 if (fontset >= 0)
3374 Lisp_Object ascii_font = fontset_ascii (fontset);
3375 Lisp_Object spec = font_spec_from_name (ascii_font);
3377 if (! font_match_p (spec, font_object))
3378 fontset = -1;
3381 else
3382 signal_error ("Invalid font", arg);
3384 if (! NILP (Fequal (font_object, oldval)))
3385 return;
3387 x_new_font (f, font_object, fontset);
3388 store_frame_param (f, Qfont, arg);
3389 #ifdef HAVE_X_WINDOWS
3390 store_frame_param (f, Qfont_param, font_param);
3391 #endif
3392 /* Recalculate toolbar height. */
3393 f->n_tool_bar_rows = 0;
3394 /* Ensure we redraw it. */
3395 clear_current_matrices (f);
3397 recompute_basic_faces (f);
3399 do_pending_window_change (0);
3401 /* We used to call face-set-after-frame-default here, but it leads to
3402 recursive calls (since that function can set the `default' face's
3403 font which in turns changes the frame's `font' parameter).
3404 Also I don't know what this call is meant to do, but it seems the
3405 wrong way to do it anyway (it does a lot more work than what seems
3406 reasonable in response to a change to `font'). */
3410 void
3411 x_set_font_backend (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3413 if (! NILP (new_value)
3414 && !CONSP (new_value))
3416 char *p0, *p1;
3418 CHECK_STRING (new_value);
3419 p0 = p1 = SSDATA (new_value);
3420 new_value = Qnil;
3421 while (*p0)
3423 while (*p1 && ! isspace (*p1) && *p1 != ',') p1++;
3424 if (p0 < p1)
3425 new_value = Fcons (Fintern (make_string (p0, p1 - p0), Qnil),
3426 new_value);
3427 if (*p1)
3429 int c;
3431 while ((c = *++p1) && isspace (c));
3433 p0 = p1;
3435 new_value = Fnreverse (new_value);
3438 if (! NILP (old_value) && ! NILP (Fequal (old_value, new_value)))
3439 return;
3441 if (FRAME_FONT (f))
3442 free_all_realized_faces (Qnil);
3444 new_value = font_update_drivers (f, NILP (new_value) ? Qt : new_value);
3445 if (NILP (new_value))
3447 if (NILP (old_value))
3448 error ("No font backend available");
3449 font_update_drivers (f, old_value);
3450 error ("None of specified font backends are available");
3452 store_frame_param (f, Qfont_backend, new_value);
3454 if (FRAME_FONT (f))
3456 Lisp_Object frame;
3458 XSETFRAME (frame, f);
3459 x_set_font (f, Fframe_parameter (frame, Qfont), Qnil);
3460 ++face_change_count;
3461 ++windows_or_buffers_changed;
3466 void
3467 x_set_fringe_width (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3469 compute_fringe_widths (f, 1);
3470 #ifdef HAVE_X_WINDOWS
3471 /* Must adjust this so window managers report correct number of columns. */
3472 if (FRAME_X_WINDOW (f) != 0)
3473 x_wm_set_size_hint (f, 0, 0);
3474 #endif
3477 void
3478 x_set_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3480 CHECK_NUMBER (arg);
3482 if (XINT (arg) == f->border_width)
3483 return;
3485 if (FRAME_X_WINDOW (f) != 0)
3486 error ("Cannot change the border width of a frame");
3488 f->border_width = XINT (arg);
3491 void
3492 x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3494 int old = FRAME_INTERNAL_BORDER_WIDTH (f);
3496 CHECK_NUMBER (arg);
3497 FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
3498 if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
3499 FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
3501 #ifdef USE_X_TOOLKIT
3502 if (FRAME_X_OUTPUT (f)->edit_widget)
3503 widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
3504 #endif
3506 if (FRAME_INTERNAL_BORDER_WIDTH (f) == old)
3507 return;
3509 if (FRAME_X_WINDOW (f) != 0)
3511 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3512 SET_FRAME_GARBAGED (f);
3513 do_pending_window_change (0);
3515 else
3516 SET_FRAME_GARBAGED (f);
3519 void
3520 x_set_visibility (struct frame *f, Lisp_Object value, Lisp_Object oldval)
3522 Lisp_Object frame;
3523 XSETFRAME (frame, f);
3525 if (NILP (value))
3526 Fmake_frame_invisible (frame, Qt);
3527 else if (EQ (value, Qicon))
3528 Ficonify_frame (frame);
3529 else
3530 Fmake_frame_visible (frame);
3533 void
3534 x_set_autoraise (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3536 f->auto_raise = !EQ (Qnil, arg);
3539 void
3540 x_set_autolower (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3542 f->auto_lower = !EQ (Qnil, arg);
3545 void
3546 x_set_unsplittable (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3548 f->no_split = !NILP (arg);
3551 void
3552 x_set_vertical_scroll_bars (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3554 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
3555 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
3556 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
3557 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
3559 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
3560 = (NILP (arg)
3561 ? vertical_scroll_bar_none
3562 : EQ (Qleft, arg)
3563 ? vertical_scroll_bar_left
3564 : EQ (Qright, arg)
3565 ? vertical_scroll_bar_right
3566 : EQ (Qleft, Vdefault_frame_scroll_bars)
3567 ? vertical_scroll_bar_left
3568 : EQ (Qright, Vdefault_frame_scroll_bars)
3569 ? vertical_scroll_bar_right
3570 : vertical_scroll_bar_none);
3572 /* We set this parameter before creating the X window for the
3573 frame, so we can get the geometry right from the start.
3574 However, if the window hasn't been created yet, we shouldn't
3575 call x_set_window_size. */
3576 if (FRAME_X_WINDOW (f))
3577 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3578 do_pending_window_change (0);
3582 void
3583 x_set_scroll_bar_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3585 int wid = FRAME_COLUMN_WIDTH (f);
3587 if (NILP (arg))
3589 x_set_scroll_bar_default_width (f);
3591 if (FRAME_X_WINDOW (f))
3592 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3593 do_pending_window_change (0);
3595 else if (INTEGERP (arg) && XINT (arg) > 0
3596 && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3598 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
3599 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
3601 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg);
3602 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
3603 if (FRAME_X_WINDOW (f))
3604 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3605 do_pending_window_change (0);
3608 change_frame_size (f, 0, FRAME_COLS (f), 0, 0, 0);
3609 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
3610 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
3615 /* Return non-nil if frame F wants a bitmap icon. */
3617 Lisp_Object
3618 x_icon_type (FRAME_PTR f)
3620 Lisp_Object tem;
3622 tem = assq_no_quit (Qicon_type, f->param_alist);
3623 if (CONSP (tem))
3624 return XCDR (tem);
3625 else
3626 return Qnil;
3629 void
3630 x_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3632 double alpha = 1.0;
3633 double newval[2];
3634 int i, ialpha;
3635 Lisp_Object item;
3637 for (i = 0; i < 2; i++)
3639 newval[i] = 1.0;
3640 if (CONSP (arg))
3642 item = CAR (arg);
3643 arg = CDR (arg);
3645 else
3646 item = arg;
3648 if (NILP (item))
3649 alpha = - 1.0;
3650 else if (FLOATP (item))
3652 alpha = XFLOAT_DATA (item);
3653 if (alpha < 0.0 || 1.0 < alpha)
3654 args_out_of_range (make_float (0.0), make_float (1.0));
3656 else if (INTEGERP (item))
3658 ialpha = XINT (item);
3659 if (ialpha < 0 || 100 < ialpha)
3660 args_out_of_range (make_number (0), make_number (100));
3661 else
3662 alpha = ialpha / 100.0;
3664 else
3665 wrong_type_argument (Qnumberp, item);
3666 newval[i] = alpha;
3669 for (i = 0; i < 2; i++)
3670 f->alpha[i] = newval[i];
3672 #if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA)
3673 BLOCK_INPUT;
3674 x_set_frame_alpha (f);
3675 UNBLOCK_INPUT;
3676 #endif
3678 return;
3682 /* Subroutines of creating an X frame. */
3684 /* Make sure that Vx_resource_name is set to a reasonable value.
3685 Fix it up, or set it to `emacs' if it is too hopeless. */
3687 void
3688 validate_x_resource_name (void)
3690 int len = 0;
3691 /* Number of valid characters in the resource name. */
3692 int good_count = 0;
3693 /* Number of invalid characters in the resource name. */
3694 int bad_count = 0;
3695 Lisp_Object new;
3696 int i;
3698 if (!STRINGP (Vx_resource_class))
3699 Vx_resource_class = build_string (EMACS_CLASS);
3701 if (STRINGP (Vx_resource_name))
3703 unsigned char *p = SDATA (Vx_resource_name);
3705 len = SBYTES (Vx_resource_name);
3707 /* Only letters, digits, - and _ are valid in resource names.
3708 Count the valid characters and count the invalid ones. */
3709 for (i = 0; i < len; i++)
3711 int c = p[i];
3712 if (! ((c >= 'a' && c <= 'z')
3713 || (c >= 'A' && c <= 'Z')
3714 || (c >= '0' && c <= '9')
3715 || c == '-' || c == '_'))
3716 bad_count++;
3717 else
3718 good_count++;
3721 else
3722 /* Not a string => completely invalid. */
3723 bad_count = 5, good_count = 0;
3725 /* If name is valid already, return. */
3726 if (bad_count == 0)
3727 return;
3729 /* If name is entirely invalid, or nearly so, use `emacs'. */
3730 if (good_count < 2)
3732 Vx_resource_name = build_string ("emacs");
3733 return;
3736 /* Name is partly valid. Copy it and replace the invalid characters
3737 with underscores. */
3739 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
3741 for (i = 0; i < len; i++)
3743 int c = SREF (new, i);
3744 if (! ((c >= 'a' && c <= 'z')
3745 || (c >= 'A' && c <= 'Z')
3746 || (c >= '0' && c <= '9')
3747 || c == '-' || c == '_'))
3748 SSET (new, i, '_');
3753 extern char *x_get_string_resource (XrmDatabase, const char *, const char *);
3754 extern Display_Info *check_x_display_info (Lisp_Object);
3757 /* Get specified attribute from resource database RDB.
3758 See Fx_get_resource below for other parameters. */
3760 static Lisp_Object
3761 xrdb_get_resource (XrmDatabase rdb, Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3763 register char *value;
3764 char *name_key;
3765 char *class_key;
3767 CHECK_STRING (attribute);
3768 CHECK_STRING (class);
3770 if (!NILP (component))
3771 CHECK_STRING (component);
3772 if (!NILP (subclass))
3773 CHECK_STRING (subclass);
3774 if (NILP (component) != NILP (subclass))
3775 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3777 validate_x_resource_name ();
3779 /* Allocate space for the components, the dots which separate them,
3780 and the final '\0'. Make them big enough for the worst case. */
3781 name_key = (char *) alloca (SBYTES (Vx_resource_name)
3782 + (STRINGP (component)
3783 ? SBYTES (component) : 0)
3784 + SBYTES (attribute)
3785 + 3);
3787 class_key = (char *) alloca (SBYTES (Vx_resource_class)
3788 + SBYTES (class)
3789 + (STRINGP (subclass)
3790 ? SBYTES (subclass) : 0)
3791 + 3);
3793 /* Start with emacs.FRAMENAME for the name (the specific one)
3794 and with `Emacs' for the class key (the general one). */
3795 strcpy (name_key, SSDATA (Vx_resource_name));
3796 strcpy (class_key, SSDATA (Vx_resource_class));
3798 strcat (class_key, ".");
3799 strcat (class_key, SSDATA (class));
3801 if (!NILP (component))
3803 strcat (class_key, ".");
3804 strcat (class_key, SSDATA (subclass));
3806 strcat (name_key, ".");
3807 strcat (name_key, SSDATA (component));
3810 strcat (name_key, ".");
3811 strcat (name_key, SSDATA (attribute));
3813 value = x_get_string_resource (rdb, name_key, class_key);
3815 if (value != (char *) 0 && *value)
3816 return build_string (value);
3817 else
3818 return Qnil;
3822 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
3823 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
3824 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
3825 class, where INSTANCE is the name under which Emacs was invoked, or
3826 the name specified by the `-name' or `-rn' command-line arguments.
3828 The optional arguments COMPONENT and SUBCLASS add to the key and the
3829 class, respectively. You must specify both of them or neither.
3830 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
3831 and the class is `Emacs.CLASS.SUBCLASS'. */)
3832 (Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3834 #ifdef HAVE_X_WINDOWS
3835 check_x ();
3836 #endif
3838 return xrdb_get_resource (check_x_display_info (Qnil)->xrdb,
3839 attribute, class, component, subclass);
3842 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
3844 Lisp_Object
3845 display_x_get_resource (Display_Info *dpyinfo, Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3847 return xrdb_get_resource (dpyinfo->xrdb,
3848 attribute, class, component, subclass);
3851 #if defined HAVE_X_WINDOWS && !defined USE_X_TOOLKIT
3852 /* Used when C code wants a resource value. */
3853 /* Called from oldXMenu/Create.c. */
3854 char *
3855 x_get_resource_string (const char *attribute, const char *class)
3857 char *name_key;
3858 char *class_key;
3859 struct frame *sf = SELECTED_FRAME ();
3861 /* Allocate space for the components, the dots which separate them,
3862 and the final '\0'. */
3863 name_key = (char *) alloca (SBYTES (Vinvocation_name)
3864 + strlen (attribute) + 2);
3865 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
3866 + strlen (class) + 2);
3868 sprintf (name_key, "%s.%s", SSDATA (Vinvocation_name), attribute);
3869 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3871 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
3872 name_key, class_key);
3874 #endif
3876 /* Return the value of parameter PARAM.
3878 First search ALIST, then Vdefault_frame_alist, then the X defaults
3879 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3881 Convert the resource to the type specified by desired_type.
3883 If no default is specified, return Qunbound. If you call
3884 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3885 and don't let it get stored in any Lisp-visible variables! */
3887 Lisp_Object
3888 x_get_arg (Display_Info *dpyinfo, Lisp_Object alist, Lisp_Object param,
3889 const char *attribute, const char *class, enum resource_types type)
3891 register Lisp_Object tem;
3893 tem = Fassq (param, alist);
3895 if (!NILP (tem))
3897 /* If we find this parm in ALIST, clear it out
3898 so that it won't be "left over" at the end. */
3899 Lisp_Object tail;
3900 XSETCAR (tem, Qnil);
3901 /* In case the parameter appears more than once in the alist,
3902 clear it out. */
3903 for (tail = alist; CONSP (tail); tail = XCDR (tail))
3904 if (CONSP (XCAR (tail))
3905 && EQ (XCAR (XCAR (tail)), param))
3906 XSETCAR (XCAR (tail), Qnil);
3908 else
3909 tem = Fassq (param, Vdefault_frame_alist);
3911 /* If it wasn't specified in ALIST or the Lisp-level defaults,
3912 look in the X resources. */
3913 if (EQ (tem, Qnil))
3915 if (attribute && dpyinfo)
3917 tem = display_x_get_resource (dpyinfo,
3918 build_string (attribute),
3919 build_string (class),
3920 Qnil, Qnil);
3922 if (NILP (tem))
3923 return Qunbound;
3925 switch (type)
3927 case RES_TYPE_NUMBER:
3928 return make_number (atoi (SSDATA (tem)));
3930 case RES_TYPE_BOOLEAN_NUMBER:
3931 if (!strcmp (SSDATA (tem), "on")
3932 || !strcmp (SSDATA (tem), "true"))
3933 return make_number (1);
3934 return make_number (atoi (SSDATA (tem)));
3935 break;
3937 case RES_TYPE_FLOAT:
3938 return make_float (atof (SSDATA (tem)));
3940 case RES_TYPE_BOOLEAN:
3941 tem = Fdowncase (tem);
3942 if (!strcmp (SSDATA (tem), "on")
3943 #ifdef HAVE_NS
3944 || !strcmp (SSDATA (tem), "yes")
3945 #endif
3946 || !strcmp (SSDATA (tem), "true"))
3947 return Qt;
3948 else
3949 return Qnil;
3951 case RES_TYPE_STRING:
3952 return tem;
3954 case RES_TYPE_SYMBOL:
3955 /* As a special case, we map the values `true' and `on'
3956 to Qt, and `false' and `off' to Qnil. */
3958 Lisp_Object lower;
3959 lower = Fdowncase (tem);
3960 if (!strcmp (SSDATA (lower), "on")
3961 #ifdef HAVE_NS
3962 || !strcmp (SSDATA (lower), "yes")
3963 #endif
3964 || !strcmp (SSDATA (lower), "true"))
3965 return Qt;
3966 else if (!strcmp (SSDATA (lower), "off")
3967 #ifdef HAVE_NS
3968 || !strcmp (SSDATA (lower), "no")
3969 #endif
3970 || !strcmp (SSDATA (lower), "false"))
3971 return Qnil;
3972 else
3973 return Fintern (tem, Qnil);
3976 default:
3977 abort ();
3980 else
3981 return Qunbound;
3983 return Fcdr (tem);
3986 static Lisp_Object
3987 x_frame_get_arg (struct frame *f, Lisp_Object alist, Lisp_Object param,
3988 const char *attribute, const char *class,
3989 enum resource_types type)
3991 return x_get_arg (FRAME_X_DISPLAY_INFO (f),
3992 alist, param, attribute, class, type);
3995 /* Like x_frame_get_arg, but also record the value in f->param_alist. */
3997 Lisp_Object
3998 x_frame_get_and_record_arg (struct frame *f, Lisp_Object alist,
3999 Lisp_Object param,
4000 const char *attribute, const char *class,
4001 enum resource_types type)
4003 Lisp_Object value;
4005 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
4006 attribute, class, type);
4007 if (! NILP (value) && ! EQ (value, Qunbound))
4008 store_frame_param (f, param, value);
4010 return value;
4014 /* Record in frame F the specified or default value according to ALIST
4015 of the parameter named PROP (a Lisp symbol).
4016 If no value is specified for PROP, look for an X default for XPROP
4017 on the frame named NAME.
4018 If that is not found either, use the value DEFLT. */
4020 Lisp_Object
4021 x_default_parameter (struct frame *f, Lisp_Object alist, Lisp_Object prop,
4022 Lisp_Object deflt, const char *xprop, const char *xclass,
4023 enum resource_types type)
4025 Lisp_Object tem;
4027 tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type);
4028 if (EQ (tem, Qunbound))
4029 tem = deflt;
4030 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
4031 return tem;
4037 /* NS used to define x-parse-geometry in ns-win.el, but that confused
4038 make-docfile: the documentation string in ns-win.el was used for
4039 x-parse-geometry even in non-NS builds.
4041 With two definitions of x-parse-geometry in this file, various
4042 things still get confused (eg M-x apropos documentation), so that
4043 it is best if the two definitions just share the same doc-string.
4045 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
4046 doc: /* Parse a display geometry string STRING.
4047 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
4048 The properties returned may include `top', `left', `height', and `width'.
4049 For X, the value of `left' or `top' may be an integer,
4050 or a list (+ N) meaning N pixels relative to top/left corner,
4051 or a list (- N) meaning -N pixels relative to bottom/right corner.
4052 On Nextstep, this just calls `ns-parse-geometry'. */)
4053 (Lisp_Object string)
4055 #ifdef HAVE_NS
4056 call1 (Qns_parse_geometry, string);
4057 #else
4058 int geometry, x, y;
4059 unsigned int width, height;
4060 Lisp_Object result;
4062 CHECK_STRING (string);
4064 geometry = XParseGeometry (SSDATA (string),
4065 &x, &y, &width, &height);
4066 result = Qnil;
4067 if (geometry & XValue)
4069 Lisp_Object element;
4071 if (x >= 0 && (geometry & XNegative))
4072 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
4073 else if (x < 0 && ! (geometry & XNegative))
4074 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
4075 else
4076 element = Fcons (Qleft, make_number (x));
4077 result = Fcons (element, result);
4080 if (geometry & YValue)
4082 Lisp_Object element;
4084 if (y >= 0 && (geometry & YNegative))
4085 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
4086 else if (y < 0 && ! (geometry & YNegative))
4087 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
4088 else
4089 element = Fcons (Qtop, make_number (y));
4090 result = Fcons (element, result);
4093 if (geometry & WidthValue)
4094 result = Fcons (Fcons (Qwidth, make_number (width)), result);
4095 if (geometry & HeightValue)
4096 result = Fcons (Fcons (Qheight, make_number (height)), result);
4098 return result;
4099 #endif /* HAVE_NS */
4103 /* Calculate the desired size and position of frame F.
4104 Return the flags saying which aspects were specified.
4106 Also set the win_gravity and size_hint_flags of F.
4108 Adjust height for toolbar if TOOLBAR_P is 1.
4110 This function does not make the coordinates positive. */
4112 #define DEFAULT_ROWS 35
4113 #define DEFAULT_COLS 80
4116 x_figure_window_size (struct frame *f, Lisp_Object parms, int toolbar_p)
4118 register Lisp_Object tem0, tem1, tem2;
4119 long window_prompting = 0;
4120 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
4122 /* Default values if we fall through.
4123 Actually, if that happens we should get
4124 window manager prompting. */
4125 SET_FRAME_COLS (f, DEFAULT_COLS);
4126 FRAME_LINES (f) = DEFAULT_ROWS;
4127 /* Window managers expect that if program-specified
4128 positions are not (0,0), they're intentional, not defaults. */
4129 f->top_pos = 0;
4130 f->left_pos = 0;
4132 /* Ensure that old new_text_cols and new_text_lines will not override the
4133 values set here. */
4134 /* ++KFS: This was specific to W32, but seems ok for all platforms */
4135 f->new_text_cols = f->new_text_lines = 0;
4137 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
4138 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
4139 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
4140 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4142 if (!EQ (tem0, Qunbound))
4144 CHECK_NUMBER (tem0);
4145 FRAME_LINES (f) = XINT (tem0);
4147 if (!EQ (tem1, Qunbound))
4149 CHECK_NUMBER (tem1);
4150 SET_FRAME_COLS (f, XINT (tem1));
4152 if (!NILP (tem2) && !EQ (tem2, Qunbound))
4153 window_prompting |= USSize;
4154 else
4155 window_prompting |= PSize;
4158 f->scroll_bar_actual_width
4159 = FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f);
4161 /* This used to be done _before_ calling x_figure_window_size, but
4162 since the height is reset here, this was really a no-op. I
4163 assume that moving it here does what Gerd intended (although he
4164 no longer can remember what that was... ++KFS, 2003-03-25. */
4166 /* Add the tool-bar height to the initial frame height so that the
4167 user gets a text display area of the size he specified with -g or
4168 via .Xdefaults. Later changes of the tool-bar height don't
4169 change the frame size. This is done so that users can create
4170 tall Emacs frames without having to guess how tall the tool-bar
4171 will get. */
4172 if (toolbar_p && FRAME_TOOL_BAR_LINES (f))
4174 int margin, relief, bar_height;
4176 relief = (tool_bar_button_relief >= 0
4177 ? tool_bar_button_relief
4178 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
4180 if (INTEGERP (Vtool_bar_button_margin)
4181 && XINT (Vtool_bar_button_margin) > 0)
4182 margin = XFASTINT (Vtool_bar_button_margin);
4183 else if (CONSP (Vtool_bar_button_margin)
4184 && INTEGERP (XCDR (Vtool_bar_button_margin))
4185 && XINT (XCDR (Vtool_bar_button_margin)) > 0)
4186 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
4187 else
4188 margin = 0;
4190 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
4191 FRAME_LINES (f) += (bar_height + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f);
4194 compute_fringe_widths (f, 0);
4196 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, FRAME_COLS (f));
4197 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, FRAME_LINES (f));
4199 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
4200 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
4201 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
4202 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4204 if (EQ (tem0, Qminus))
4206 f->top_pos = 0;
4207 window_prompting |= YNegative;
4209 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
4210 && CONSP (XCDR (tem0))
4211 && INTEGERP (XCAR (XCDR (tem0))))
4213 f->top_pos = - XINT (XCAR (XCDR (tem0)));
4214 window_prompting |= YNegative;
4216 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
4217 && CONSP (XCDR (tem0))
4218 && INTEGERP (XCAR (XCDR (tem0))))
4220 f->top_pos = XINT (XCAR (XCDR (tem0)));
4222 else if (EQ (tem0, Qunbound))
4223 f->top_pos = 0;
4224 else
4226 CHECK_NUMBER (tem0);
4227 f->top_pos = XINT (tem0);
4228 if (f->top_pos < 0)
4229 window_prompting |= YNegative;
4232 if (EQ (tem1, Qminus))
4234 f->left_pos = 0;
4235 window_prompting |= XNegative;
4237 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
4238 && CONSP (XCDR (tem1))
4239 && INTEGERP (XCAR (XCDR (tem1))))
4241 f->left_pos = - XINT (XCAR (XCDR (tem1)));
4242 window_prompting |= XNegative;
4244 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
4245 && CONSP (XCDR (tem1))
4246 && INTEGERP (XCAR (XCDR (tem1))))
4248 f->left_pos = XINT (XCAR (XCDR (tem1)));
4250 else if (EQ (tem1, Qunbound))
4251 f->left_pos = 0;
4252 else
4254 CHECK_NUMBER (tem1);
4255 f->left_pos = XINT (tem1);
4256 if (f->left_pos < 0)
4257 window_prompting |= XNegative;
4260 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
4261 window_prompting |= USPosition;
4262 else
4263 window_prompting |= PPosition;
4266 if (window_prompting & XNegative)
4268 if (window_prompting & YNegative)
4269 f->win_gravity = SouthEastGravity;
4270 else
4271 f->win_gravity = NorthEastGravity;
4273 else
4275 if (window_prompting & YNegative)
4276 f->win_gravity = SouthWestGravity;
4277 else
4278 f->win_gravity = NorthWestGravity;
4281 f->size_hint_flags = window_prompting;
4283 return window_prompting;
4288 #endif /* HAVE_WINDOW_SYSTEM */
4290 void
4291 frame_make_pointer_invisible (void)
4293 if (! NILP (Vmake_pointer_invisible))
4295 struct frame *f;
4296 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4297 return;
4299 f = SELECTED_FRAME ();
4300 if (f && !f->pointer_invisible
4301 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4303 f->mouse_moved = 0;
4304 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 1);
4305 f->pointer_invisible = 1;
4310 void
4311 frame_make_pointer_visible (void)
4313 /* We don't check Vmake_pointer_invisible here in case the
4314 pointer was invisible when Vmake_pointer_invisible was set to nil. */
4315 struct frame *f;
4317 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4318 return;
4320 f = SELECTED_FRAME ();
4321 if (f && f->pointer_invisible && f->mouse_moved
4322 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4324 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 0);
4325 f->pointer_invisible = 0;
4329 DEFUN ("frame-pointer-visible-p", Fframe_pointer_visible_p,
4330 Sframe_pointer_visible_p, 0, 1, 0,
4331 doc: /* Return t if the mouse pointer displayed on FRAME is visible.
4332 Otherwise it returns nil. FRAME omitted or nil means the
4333 selected frame. This is useful when `make-pointer-invisible' is set. */)
4334 (Lisp_Object frame)
4336 if (NILP (frame))
4337 frame = selected_frame;
4339 CHECK_FRAME (frame);
4341 return (XFRAME (frame)->pointer_invisible ? Qnil : Qt);
4345 /***********************************************************************
4346 Initialization
4347 ***********************************************************************/
4349 void
4350 syms_of_frame (void)
4352 Qframep = intern_c_string ("framep");
4353 staticpro (&Qframep);
4354 Qframe_live_p = intern_c_string ("frame-live-p");
4355 staticpro (&Qframe_live_p);
4356 Qexplicit_name = intern_c_string ("explicit-name");
4357 staticpro (&Qexplicit_name);
4358 Qheight = intern_c_string ("height");
4359 staticpro (&Qheight);
4360 Qicon = intern_c_string ("icon");
4361 staticpro (&Qicon);
4362 Qminibuffer = intern_c_string ("minibuffer");
4363 staticpro (&Qminibuffer);
4364 Qmodeline = intern_c_string ("modeline");
4365 staticpro (&Qmodeline);
4366 Qonly = intern_c_string ("only");
4367 staticpro (&Qonly);
4368 Qwidth = intern_c_string ("width");
4369 staticpro (&Qwidth);
4370 Qgeometry = intern_c_string ("geometry");
4371 staticpro (&Qgeometry);
4372 Qicon_left = intern_c_string ("icon-left");
4373 staticpro (&Qicon_left);
4374 Qicon_top = intern_c_string ("icon-top");
4375 staticpro (&Qicon_top);
4376 Qtooltip = intern_c_string ("tooltip");
4377 staticpro (&Qtooltip);
4378 Qleft = intern_c_string ("left");
4379 staticpro (&Qleft);
4380 Qright = intern_c_string ("right");
4381 staticpro (&Qright);
4382 Quser_position = intern_c_string ("user-position");
4383 staticpro (&Quser_position);
4384 Quser_size = intern_c_string ("user-size");
4385 staticpro (&Quser_size);
4386 Qwindow_id = intern_c_string ("window-id");
4387 staticpro (&Qwindow_id);
4388 #ifdef HAVE_X_WINDOWS
4389 Qouter_window_id = intern_c_string ("outer-window-id");
4390 staticpro (&Qouter_window_id);
4391 #endif
4392 Qparent_id = intern_c_string ("parent-id");
4393 staticpro (&Qparent_id);
4394 Qx = intern_c_string ("x");
4395 staticpro (&Qx);
4396 Qw32 = intern_c_string ("w32");
4397 staticpro (&Qw32);
4398 Qpc = intern_c_string ("pc");
4399 staticpro (&Qpc);
4400 Qmac = intern_c_string ("mac");
4401 staticpro (&Qmac);
4402 Qns = intern_c_string ("ns");
4403 staticpro (&Qns);
4404 Qvisible = intern_c_string ("visible");
4405 staticpro (&Qvisible);
4406 Qbuffer_predicate = intern_c_string ("buffer-predicate");
4407 staticpro (&Qbuffer_predicate);
4408 Qbuffer_list = intern_c_string ("buffer-list");
4409 staticpro (&Qbuffer_list);
4410 Qburied_buffer_list = intern_c_string ("buried-buffer-list");
4411 staticpro (&Qburied_buffer_list);
4412 Qdisplay_type = intern_c_string ("display-type");
4413 staticpro (&Qdisplay_type);
4414 Qbackground_mode = intern_c_string ("background-mode");
4415 staticpro (&Qbackground_mode);
4416 Qnoelisp = intern_c_string ("noelisp");
4417 staticpro (&Qnoelisp);
4418 Qtty_color_mode = intern_c_string ("tty-color-mode");
4419 staticpro (&Qtty_color_mode);
4420 Qtty = intern_c_string ("tty");
4421 staticpro (&Qtty);
4422 Qtty_type = intern_c_string ("tty-type");
4423 staticpro (&Qtty_type);
4425 Qface_set_after_frame_default = intern_c_string ("face-set-after-frame-default");
4426 staticpro (&Qface_set_after_frame_default);
4428 Qfullwidth = intern_c_string ("fullwidth");
4429 staticpro (&Qfullwidth);
4430 Qfullheight = intern_c_string ("fullheight");
4431 staticpro (&Qfullheight);
4432 Qfullboth = intern_c_string ("fullboth");
4433 staticpro (&Qfullboth);
4434 Qmaximized = intern_c_string ("maximized");
4435 staticpro (&Qmaximized);
4436 Qx_resource_name = intern_c_string ("x-resource-name");
4437 staticpro (&Qx_resource_name);
4439 Qx_frame_parameter = intern_c_string ("x-frame-parameter");
4440 staticpro (&Qx_frame_parameter);
4442 Qterminal = intern_c_string ("terminal");
4443 staticpro (&Qterminal);
4444 Qterminal_live_p = intern_c_string ("terminal-live-p");
4445 staticpro (&Qterminal_live_p);
4447 #ifdef HAVE_NS
4448 Qns_parse_geometry = intern_c_string ("ns-parse-geometry");
4449 staticpro (&Qns_parse_geometry);
4450 #endif
4453 int i;
4455 for (i = 0; i < sizeof (frame_parms) / sizeof (frame_parms[0]); i++)
4457 Lisp_Object v = intern_c_string (frame_parms[i].name);
4458 if (frame_parms[i].variable)
4460 *frame_parms[i].variable = v;
4461 staticpro (frame_parms[i].variable);
4463 Fput (v, Qx_frame_parameter, make_number (i));
4467 #ifdef HAVE_WINDOW_SYSTEM
4468 DEFVAR_LISP ("x-resource-name", Vx_resource_name,
4469 doc: /* The name Emacs uses to look up X resources.
4470 `x-get-resource' uses this as the first component of the instance name
4471 when requesting resource values.
4472 Emacs initially sets `x-resource-name' to the name under which Emacs
4473 was invoked, or to the value specified with the `-name' or `-rn'
4474 switches, if present.
4476 It may be useful to bind this variable locally around a call
4477 to `x-get-resource'. See also the variable `x-resource-class'. */);
4478 Vx_resource_name = Qnil;
4480 DEFVAR_LISP ("x-resource-class", Vx_resource_class,
4481 doc: /* The class Emacs uses to look up X resources.
4482 `x-get-resource' uses this as the first component of the instance class
4483 when requesting resource values.
4485 Emacs initially sets `x-resource-class' to "Emacs".
4487 Setting this variable permanently is not a reasonable thing to do,
4488 but binding this variable locally around a call to `x-get-resource'
4489 is a reasonable practice. See also the variable `x-resource-name'. */);
4490 Vx_resource_class = build_string (EMACS_CLASS);
4492 DEFVAR_LISP ("frame-alpha-lower-limit", Vframe_alpha_lower_limit,
4493 doc: /* The lower limit of the frame opacity (alpha transparency).
4494 The value should range from 0 (invisible) to 100 (completely opaque).
4495 You can also use a floating number between 0.0 and 1.0.
4496 The default is 20. */);
4497 Vframe_alpha_lower_limit = make_number (20);
4498 #endif
4500 DEFVAR_LISP ("default-frame-alist", Vdefault_frame_alist,
4501 doc: /* Alist of default values for frame creation.
4502 These may be set in your init file, like this:
4503 (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1)))
4504 These override values given in window system configuration data,
4505 including X Windows' defaults database.
4506 For values specific to the first Emacs frame, see `initial-frame-alist'.
4507 For window-system specific values, see `window-system-default-frame-alist'.
4508 For values specific to the separate minibuffer frame, see
4509 `minibuffer-frame-alist'.
4510 The `menu-bar-lines' element of the list controls whether new frames
4511 have menu bars; `menu-bar-mode' works by altering this element.
4512 Setting this variable does not affect existing frames, only new ones. */);
4513 Vdefault_frame_alist = Qnil;
4515 DEFVAR_LISP ("default-frame-scroll-bars", Vdefault_frame_scroll_bars,
4516 doc: /* Default position of scroll bars on this window-system. */);
4517 #ifdef HAVE_WINDOW_SYSTEM
4518 #if defined(HAVE_NTGUI) || defined(NS_IMPL_COCOA) || (defined(USE_GTK) && defined(USE_TOOLKIT_SCROLL_BARS))
4519 /* MS-Windows, Mac OS X, and GTK have scroll bars on the right by
4520 default. */
4521 Vdefault_frame_scroll_bars = Qright;
4522 #else
4523 Vdefault_frame_scroll_bars = Qleft;
4524 #endif
4525 #else
4526 Vdefault_frame_scroll_bars = Qnil;
4527 #endif
4529 DEFVAR_LISP ("terminal-frame", Vterminal_frame,
4530 doc: /* The initial frame-object, which represents Emacs's stdout. */);
4532 DEFVAR_LISP ("mouse-position-function", Vmouse_position_function,
4533 doc: /* If non-nil, function to transform normal value of `mouse-position'.
4534 `mouse-position' calls this function, passing its usual return value as
4535 argument, and returns whatever this function returns.
4536 This abnormal hook exists for the benefit of packages like `xt-mouse.el'
4537 which need to do mouse handling at the Lisp level. */);
4538 Vmouse_position_function = Qnil;
4540 DEFVAR_LISP ("mouse-highlight", Vmouse_highlight,
4541 doc: /* If non-nil, clickable text is highlighted when mouse is over it.
4542 If the value is an integer, highlighting is only shown after moving the
4543 mouse, while keyboard input turns off the highlight even when the mouse
4544 is over the clickable text. However, the mouse shape still indicates
4545 when the mouse is over clickable text. */);
4546 Vmouse_highlight = Qt;
4548 DEFVAR_LISP ("make-pointer-invisible", Vmake_pointer_invisible,
4549 doc: /* If non-nil, make pointer invisible while typing.
4550 The pointer becomes visible again when the mouse is moved. */);
4551 Vmake_pointer_invisible = Qt;
4553 DEFVAR_LISP ("delete-frame-functions", Vdelete_frame_functions,
4554 doc: /* Functions to be run before deleting a frame.
4555 The functions are run with one arg, the frame to be deleted.
4556 See `delete-frame'.
4558 Note that functions in this list may be called just before the frame is
4559 actually deleted, or some time later (or even both when an earlier function
4560 in `delete-frame-functions' (indirectly) calls `delete-frame'
4561 recursively). */);
4562 Vdelete_frame_functions = Qnil;
4563 Qdelete_frame_functions = intern_c_string ("delete-frame-functions");
4564 staticpro (&Qdelete_frame_functions);
4566 DEFVAR_LISP ("menu-bar-mode", Vmenu_bar_mode,
4567 doc: /* Non-nil if Menu-Bar mode is enabled.
4568 See the command `menu-bar-mode' for a description of this minor mode.
4569 Setting this variable directly does not take effect;
4570 either customize it (see the info node `Easy Customization')
4571 or call the function `menu-bar-mode'. */);
4572 Vmenu_bar_mode = Qt;
4574 DEFVAR_LISP ("tool-bar-mode", Vtool_bar_mode,
4575 doc: /* Non-nil if Tool-Bar mode is enabled.
4576 See the command `tool-bar-mode' for a description of this minor mode.
4577 Setting this variable directly does not take effect;
4578 either customize it (see the info node `Easy Customization')
4579 or call the function `tool-bar-mode'. */);
4580 #ifdef HAVE_WINDOW_SYSTEM
4581 Vtool_bar_mode = Qt;
4582 #else
4583 Vtool_bar_mode = Qnil;
4584 #endif
4586 DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
4587 doc: /* Minibufferless frames use this frame's minibuffer.
4589 Emacs cannot create minibufferless frames unless this is set to an
4590 appropriate surrogate.
4592 Emacs consults this variable only when creating minibufferless
4593 frames; once the frame is created, it sticks with its assigned
4594 minibuffer, no matter what this variable is set to. This means that
4595 this variable doesn't necessarily say anything meaningful about the
4596 current set of frames, or where the minibuffer is currently being
4597 displayed.
4599 This variable is local to the current terminal and cannot be buffer-local. */);
4601 DEFVAR_BOOL ("focus-follows-mouse", focus_follows_mouse,
4602 doc: /* Non-nil if window system changes focus when you move the mouse.
4603 You should set this variable to tell Emacs how your window manager
4604 handles focus, since there is no way in general for Emacs to find out
4605 automatically. See also `mouse-autoselect-window'. */);
4606 focus_follows_mouse = 0;
4608 staticpro (&Vframe_list);
4610 defsubr (&Sactive_minibuffer_window);
4611 defsubr (&Sframep);
4612 defsubr (&Sframe_live_p);
4613 defsubr (&Swindow_system);
4614 defsubr (&Smake_terminal_frame);
4615 defsubr (&Shandle_switch_frame);
4616 defsubr (&Sselect_frame);
4617 defsubr (&Sselected_frame);
4618 defsubr (&Swindow_frame);
4619 defsubr (&Sframe_root_window);
4620 defsubr (&Sframe_first_window);
4621 defsubr (&Sframe_selected_window);
4622 defsubr (&Sset_frame_selected_window);
4623 defsubr (&Sframe_list);
4624 defsubr (&Snext_frame);
4625 defsubr (&Sprevious_frame);
4626 defsubr (&Sdelete_frame);
4627 defsubr (&Smouse_position);
4628 defsubr (&Smouse_pixel_position);
4629 defsubr (&Sset_mouse_position);
4630 defsubr (&Sset_mouse_pixel_position);
4631 #if 0
4632 defsubr (&Sframe_configuration);
4633 defsubr (&Srestore_frame_configuration);
4634 #endif
4635 defsubr (&Smake_frame_visible);
4636 defsubr (&Smake_frame_invisible);
4637 defsubr (&Siconify_frame);
4638 defsubr (&Sframe_visible_p);
4639 defsubr (&Svisible_frame_list);
4640 defsubr (&Sraise_frame);
4641 defsubr (&Slower_frame);
4642 defsubr (&Sredirect_frame_focus);
4643 defsubr (&Sframe_focus);
4644 defsubr (&Sframe_parameters);
4645 defsubr (&Sframe_parameter);
4646 defsubr (&Smodify_frame_parameters);
4647 defsubr (&Sframe_char_height);
4648 defsubr (&Sframe_char_width);
4649 defsubr (&Sframe_pixel_height);
4650 defsubr (&Sframe_pixel_width);
4651 defsubr (&Stool_bar_pixel_width);
4652 defsubr (&Sset_frame_height);
4653 defsubr (&Sset_frame_width);
4654 defsubr (&Sset_frame_size);
4655 defsubr (&Sset_frame_position);
4656 defsubr (&Sframe_pointer_visible_p);
4658 #ifdef HAVE_WINDOW_SYSTEM
4659 defsubr (&Sx_get_resource);
4660 defsubr (&Sx_parse_geometry);
4661 #endif