* alloc.c (allocate_vectorlike): Adjust to memory_full API change.
[emacs.git] / src / frame.c
blob6008ba9567af4603662db2cc339881d4bb8af1ac
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 if (!noninteractive)
548 init_frame_faces (f);
550 return f;
554 static struct frame *
555 make_terminal_frame (struct terminal *terminal)
557 register struct frame *f;
558 Lisp_Object frame;
559 char name[20];
561 if (!terminal->name)
562 error ("Terminal is not live, can't create new frames on it");
564 f = make_frame (1);
566 XSETFRAME (frame, f);
567 Vframe_list = Fcons (frame, Vframe_list);
569 tty_frame_count++;
570 sprintf (name, "F%d", tty_frame_count);
571 f->name = build_string (name);
573 f->visible = 1; /* FRAME_SET_VISIBLE wd set frame_garbaged. */
574 f->async_visible = 1; /* Don't let visible be cleared later. */
575 f->terminal = terminal;
576 f->terminal->reference_count++;
577 #ifdef MSDOS
578 f->output_data.tty->display_info = &the_only_display_info;
579 if (!inhibit_window_system
580 && (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame))
581 || XFRAME (selected_frame)->output_method == output_msdos_raw))
582 f->output_method = output_msdos_raw;
583 else
584 f->output_method = output_termcap;
585 #else /* not MSDOS */
586 f->output_method = output_termcap;
587 create_tty_output (f);
588 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
589 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
590 #endif /* not MSDOS */
592 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
593 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
594 FRAME_MENU_BAR_LINES(f) = NILP (Vmenu_bar_mode) ? 0 : 1;
596 /* Set the top frame to the newly created frame. */
597 if (FRAMEP (FRAME_TTY (f)->top_frame)
598 && FRAME_LIVE_P (XFRAME (FRAME_TTY (f)->top_frame)))
599 XFRAME (FRAME_TTY (f)->top_frame)->async_visible = 2; /* obscured */
601 FRAME_TTY (f)->top_frame = frame;
603 if (!noninteractive)
604 init_frame_faces (f);
606 return f;
609 /* Get a suitable value for frame parameter PARAMETER for a newly
610 created frame, based on (1) the user-supplied frame parameter
611 alist SUPPLIED_PARMS, and (2) CURRENT_VALUE. */
613 static Lisp_Object
614 get_future_frame_param (Lisp_Object parameter,
615 Lisp_Object supplied_parms,
616 char *current_value)
618 Lisp_Object result;
620 result = Fassq (parameter, supplied_parms);
621 if (NILP (result))
622 result = Fassq (parameter, XFRAME (selected_frame)->param_alist);
623 if (NILP (result) && current_value != NULL)
624 result = build_string (current_value);
625 if (!NILP (result) && !STRINGP (result))
626 result = XCDR (result);
627 if (NILP (result) || !STRINGP (result))
628 result = Qnil;
630 return result;
633 DEFUN ("make-terminal-frame", Fmake_terminal_frame, Smake_terminal_frame,
634 1, 1, 0,
635 doc: /* Create an additional terminal frame, possibly on another terminal.
636 This function takes one argument, an alist specifying frame parameters.
638 You can create multiple frames on a single text-only terminal, but
639 only one of them (the selected terminal frame) is actually displayed.
641 In practice, generally you don't need to specify any parameters,
642 except when you want to create a new frame on another terminal.
643 In that case, the `tty' parameter specifies the device file to open,
644 and the `tty-type' parameter specifies the terminal type. Example:
646 (make-terminal-frame '((tty . "/dev/pts/5") (tty-type . "xterm")))
648 Note that changing the size of one terminal frame automatically
649 affects all frames on the same terminal device. */)
650 (Lisp_Object parms)
652 struct frame *f;
653 struct terminal *t = NULL;
654 Lisp_Object frame, tem;
655 struct frame *sf = SELECTED_FRAME ();
657 #ifdef MSDOS
658 if (sf->output_method != output_msdos_raw
659 && sf->output_method != output_termcap)
660 abort ();
661 #else /* not MSDOS */
663 #ifdef WINDOWSNT /* This should work now! */
664 if (sf->output_method != output_termcap)
665 error ("Not using an ASCII terminal now; cannot make a new ASCII frame");
666 #endif
667 #endif /* not MSDOS */
670 Lisp_Object terminal;
672 terminal = Fassq (Qterminal, parms);
673 if (!NILP (terminal))
675 terminal = XCDR (terminal);
676 t = get_terminal (terminal, 1);
678 #ifdef MSDOS
679 if (t && t != the_only_display_info.terminal)
680 /* msdos.c assumes a single tty_display_info object. */
681 error ("Multiple terminals are not supported on this platform");
682 if (!t)
683 t = the_only_display_info.terminal;
684 #endif
687 if (!t)
689 char *name = 0, *type = 0;
690 Lisp_Object tty, tty_type;
692 tty = get_future_frame_param
693 (Qtty, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
694 ? FRAME_TTY (XFRAME (selected_frame))->name
695 : NULL));
696 if (!NILP (tty))
698 name = (char *) alloca (SBYTES (tty) + 1);
699 strncpy (name, SSDATA (tty), SBYTES (tty));
700 name[SBYTES (tty)] = 0;
703 tty_type = get_future_frame_param
704 (Qtty_type, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
705 ? FRAME_TTY (XFRAME (selected_frame))->type
706 : NULL));
707 if (!NILP (tty_type))
709 type = (char *) alloca (SBYTES (tty_type) + 1);
710 strncpy (type, SSDATA (tty_type), SBYTES (tty_type));
711 type[SBYTES (tty_type)] = 0;
714 t = init_tty (name, type, 0); /* Errors are not fatal. */
717 f = make_terminal_frame (t);
720 int width, height;
721 get_tty_size (fileno (FRAME_TTY (f)->input), &width, &height);
722 change_frame_size (f, height, width, 0, 0, 0);
725 adjust_glyphs (f);
726 calculate_costs (f);
727 XSETFRAME (frame, f);
728 Fmodify_frame_parameters (frame, parms);
729 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty_type,
730 build_string (t->display_info.tty->type)),
731 Qnil));
732 if (t->display_info.tty->name != NULL)
733 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty,
734 build_string (t->display_info.tty->name)),
735 Qnil));
736 else
737 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty, Qnil), Qnil));
739 /* Make the frame face alist be frame-specific, so that each
740 frame could change its face definitions independently. */
741 f->face_alist = Fcopy_alist (sf->face_alist);
742 /* Simple Fcopy_alist isn't enough, because we need the contents of
743 the vectors which are the CDRs of associations in face_alist to
744 be copied as well. */
745 for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem))
746 XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem))));
747 return frame;
751 /* Perform the switch to frame FRAME.
753 If FRAME is a switch-frame event `(switch-frame FRAME1)', use
754 FRAME1 as frame.
756 If TRACK is non-zero and the frame that currently has the focus
757 redirects its focus to the selected frame, redirect that focused
758 frame's focus to FRAME instead.
760 FOR_DELETION non-zero means that the selected frame is being
761 deleted, which includes the possibility that the frame's terminal
762 is dead.
764 The value of NORECORD is passed as argument to Fselect_window. */
766 Lisp_Object
767 do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object norecord)
769 struct frame *sf = SELECTED_FRAME ();
771 /* If FRAME is a switch-frame event, extract the frame we should
772 switch to. */
773 if (CONSP (frame)
774 && EQ (XCAR (frame), Qswitch_frame)
775 && CONSP (XCDR (frame)))
776 frame = XCAR (XCDR (frame));
778 /* This used to say CHECK_LIVE_FRAME, but apparently it's possible for
779 a switch-frame event to arrive after a frame is no longer live,
780 especially when deleting the initial frame during startup. */
781 CHECK_FRAME (frame);
782 if (! FRAME_LIVE_P (XFRAME (frame)))
783 return Qnil;
785 if (sf == XFRAME (frame))
786 return frame;
788 /* This is too greedy; it causes inappropriate focus redirection
789 that's hard to get rid of. */
790 #if 0
791 /* If a frame's focus has been redirected toward the currently
792 selected frame, we should change the redirection to point to the
793 newly selected frame. This means that if the focus is redirected
794 from a minibufferless frame to a surrogate minibuffer frame, we
795 can use `other-window' to switch between all the frames using
796 that minibuffer frame, and the focus redirection will follow us
797 around. */
798 if (track)
800 Lisp_Object tail;
802 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
804 Lisp_Object focus;
806 if (!FRAMEP (XCAR (tail)))
807 abort ();
809 focus = FRAME_FOCUS_FRAME (XFRAME (XCAR (tail)));
811 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
812 Fredirect_frame_focus (XCAR (tail), frame);
815 #else /* ! 0 */
816 /* Instead, apply it only to the frame we're pointing to. */
817 #ifdef HAVE_WINDOW_SYSTEM
818 if (track && FRAME_WINDOW_P (XFRAME (frame)))
820 Lisp_Object focus, xfocus;
822 xfocus = x_get_focus_frame (XFRAME (frame));
823 if (FRAMEP (xfocus))
825 focus = FRAME_FOCUS_FRAME (XFRAME (xfocus));
826 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
827 Fredirect_frame_focus (xfocus, frame);
830 #endif /* HAVE_X_WINDOWS */
831 #endif /* ! 0 */
833 if (!for_deletion && FRAME_HAS_MINIBUF_P (sf))
834 resize_mini_window (XWINDOW (FRAME_MINIBUF_WINDOW (sf)), 1);
836 if (FRAME_TERMCAP_P (XFRAME (frame)) || FRAME_MSDOS_P (XFRAME (frame)))
838 if (FRAMEP (FRAME_TTY (XFRAME (frame))->top_frame))
839 /* Mark previously displayed frame as now obscured. */
840 XFRAME (FRAME_TTY (XFRAME (frame))->top_frame)->async_visible = 2;
841 XFRAME (frame)->async_visible = 1;
842 FRAME_TTY (XFRAME (frame))->top_frame = frame;
845 selected_frame = frame;
846 if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
847 last_nonminibuf_frame = XFRAME (selected_frame);
849 Fselect_window (XFRAME (frame)->selected_window, norecord);
851 /* We want to make sure that the next event generates a frame-switch
852 event to the appropriate frame. This seems kludgy to me, but
853 before you take it out, make sure that evaluating something like
854 (select-window (frame-root-window (new-frame))) doesn't end up
855 with your typing being interpreted in the new frame instead of
856 the one you're actually typing in. */
857 internal_last_event_frame = Qnil;
859 return frame;
862 DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 2, "e",
863 doc: /* Select FRAME.
864 Subsequent editing commands apply to its selected window.
865 Optional argument NORECORD means to neither change the order of
866 recently selected windows nor the buffer list.
868 The selection of FRAME lasts until the next time the user does
869 something to select a different frame, or until the next time
870 this function is called. If you are using a window system, the
871 previously selected frame may be restored as the selected frame
872 when returning to the command loop, because it still may have
873 the window system's input focus. On a text-only terminal, the
874 next redisplay will display FRAME.
876 This function returns FRAME, or nil if FRAME has been deleted. */)
877 (Lisp_Object frame, Lisp_Object norecord)
879 return do_switch_frame (frame, 1, 0, norecord);
883 DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 1, "e",
884 doc: /* Handle a switch-frame event EVENT.
885 Switch-frame events are usually bound to this function.
886 A switch-frame event tells Emacs that the window manager has requested
887 that the user's events be directed to the frame mentioned in the event.
888 This function selects the selected window of the frame of EVENT.
890 If EVENT is frame object, handle it as if it were a switch-frame event
891 to that frame. */)
892 (Lisp_Object event)
894 /* Preserve prefix arg that the command loop just cleared. */
895 KVAR (current_kboard, Vprefix_arg) = Vcurrent_prefix_arg;
896 Frun_hooks (1, &Qmouse_leave_buffer_hook);
897 return do_switch_frame (event, 0, 0, Qnil);
900 DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0,
901 doc: /* Return the frame that is now selected. */)
902 (void)
904 return selected_frame;
907 DEFUN ("window-frame", Fwindow_frame, Swindow_frame, 1, 1, 0,
908 doc: /* Return the frame object that window WINDOW is on. */)
909 (Lisp_Object window)
911 CHECK_LIVE_WINDOW (window);
912 return XWINDOW (window)->frame;
915 DEFUN ("frame-first-window", Fframe_first_window, Sframe_first_window, 0, 1, 0,
916 doc: /* Returns the topmost, leftmost window of FRAME.
917 If omitted, FRAME defaults to the currently selected frame. */)
918 (Lisp_Object frame)
920 Lisp_Object w;
922 if (NILP (frame))
923 w = SELECTED_FRAME ()->root_window;
924 else
926 CHECK_LIVE_FRAME (frame);
927 w = XFRAME (frame)->root_window;
929 while (NILP (XWINDOW (w)->buffer))
931 if (! NILP (XWINDOW (w)->hchild))
932 w = XWINDOW (w)->hchild;
933 else if (! NILP (XWINDOW (w)->vchild))
934 w = XWINDOW (w)->vchild;
935 else
936 abort ();
938 return w;
941 DEFUN ("active-minibuffer-window", Factive_minibuffer_window,
942 Sactive_minibuffer_window, 0, 0, 0,
943 doc: /* Return the currently active minibuffer window, or nil if none. */)
944 (void)
946 return minibuf_level ? minibuf_window : Qnil;
949 DEFUN ("frame-root-window", Fframe_root_window, Sframe_root_window, 0, 1, 0,
950 doc: /* Returns the root-window of FRAME.
951 If omitted, FRAME defaults to the currently selected frame. */)
952 (Lisp_Object frame)
954 Lisp_Object window;
956 if (NILP (frame))
957 window = SELECTED_FRAME ()->root_window;
958 else
960 CHECK_LIVE_FRAME (frame);
961 window = XFRAME (frame)->root_window;
964 return window;
967 DEFUN ("frame-selected-window", Fframe_selected_window,
968 Sframe_selected_window, 0, 1, 0,
969 doc: /* Return the selected window of FRAME.
970 FRAME defaults to the currently selected frame. */)
971 (Lisp_Object frame)
973 Lisp_Object window;
975 if (NILP (frame))
976 window = SELECTED_FRAME ()->selected_window;
977 else
979 CHECK_LIVE_FRAME (frame);
980 window = XFRAME (frame)->selected_window;
983 return window;
986 DEFUN ("set-frame-selected-window", Fset_frame_selected_window,
987 Sset_frame_selected_window, 2, 3, 0,
988 doc: /* Set selected window of FRAME to WINDOW.
989 If FRAME is nil, use the selected frame. If FRAME is the
990 selected frame, this makes WINDOW the selected window.
991 Optional argument NORECORD non-nil means to neither change the
992 order of recently selected windows nor the buffer list.
993 Return WINDOW. */)
994 (Lisp_Object frame, Lisp_Object window, Lisp_Object norecord)
996 if (NILP (frame))
997 frame = selected_frame;
999 CHECK_LIVE_FRAME (frame);
1000 CHECK_LIVE_WINDOW (window);
1002 if (! EQ (frame, WINDOW_FRAME (XWINDOW (window))))
1003 error ("In `set-frame-selected-window', WINDOW is not on FRAME");
1005 if (EQ (frame, selected_frame))
1006 return Fselect_window (window, norecord);
1008 return XFRAME (frame)->selected_window = window;
1012 DEFUN ("frame-list", Fframe_list, Sframe_list,
1013 0, 0, 0,
1014 doc: /* Return a list of all live frames. */)
1015 (void)
1017 Lisp_Object frames;
1018 frames = Fcopy_sequence (Vframe_list);
1019 #ifdef HAVE_WINDOW_SYSTEM
1020 if (FRAMEP (tip_frame))
1021 frames = Fdelq (tip_frame, frames);
1022 #endif
1023 return frames;
1026 /* Return the next frame in the frame list after FRAME.
1027 If MINIBUF is nil, exclude minibuffer-only frames.
1028 If MINIBUF is a window, include only its own frame
1029 and any frame now using that window as the minibuffer.
1030 If MINIBUF is `visible', include all visible frames.
1031 If MINIBUF is 0, include all visible and iconified frames.
1032 Otherwise, include all frames. */
1034 static Lisp_Object
1035 next_frame (Lisp_Object frame, Lisp_Object minibuf)
1037 Lisp_Object tail;
1038 int passed = 0;
1040 /* There must always be at least one frame in Vframe_list. */
1041 if (! CONSP (Vframe_list))
1042 abort ();
1044 /* If this frame is dead, it won't be in Vframe_list, and we'll loop
1045 forever. Forestall that. */
1046 CHECK_LIVE_FRAME (frame);
1048 while (1)
1049 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1051 Lisp_Object f;
1053 f = XCAR (tail);
1055 if (passed
1056 && ((!FRAME_TERMCAP_P (XFRAME (f)) && !FRAME_TERMCAP_P (XFRAME (frame))
1057 && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
1058 || (FRAME_TERMCAP_P (XFRAME (f)) && FRAME_TERMCAP_P (XFRAME (frame))
1059 && FRAME_TTY (XFRAME (f)) == FRAME_TTY (XFRAME (frame)))))
1061 /* Decide whether this frame is eligible to be returned. */
1063 /* If we've looped all the way around without finding any
1064 eligible frames, return the original frame. */
1065 if (EQ (f, frame))
1066 return f;
1068 /* Let minibuf decide if this frame is acceptable. */
1069 if (NILP (minibuf))
1071 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
1072 return f;
1074 else if (EQ (minibuf, Qvisible))
1076 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1077 if (FRAME_VISIBLE_P (XFRAME (f)))
1078 return f;
1080 else if (INTEGERP (minibuf) && XINT (minibuf) == 0)
1082 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1083 if (FRAME_VISIBLE_P (XFRAME (f))
1084 || FRAME_ICONIFIED_P (XFRAME (f)))
1085 return f;
1087 else if (WINDOWP (minibuf))
1089 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
1090 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
1091 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
1092 FRAME_FOCUS_FRAME (XFRAME (f))))
1093 return f;
1095 else
1096 return f;
1099 if (EQ (frame, f))
1100 passed++;
1104 /* Return the previous frame in the frame list before FRAME.
1105 If MINIBUF is nil, exclude minibuffer-only frames.
1106 If MINIBUF is a window, include only its own frame
1107 and any frame now using that window as the minibuffer.
1108 If MINIBUF is `visible', include all visible frames.
1109 If MINIBUF is 0, include all visible and iconified frames.
1110 Otherwise, include all frames. */
1112 static Lisp_Object
1113 prev_frame (Lisp_Object frame, Lisp_Object minibuf)
1115 Lisp_Object tail;
1116 Lisp_Object prev;
1118 /* There must always be at least one frame in Vframe_list. */
1119 if (! CONSP (Vframe_list))
1120 abort ();
1122 prev = Qnil;
1123 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1125 Lisp_Object f;
1127 f = XCAR (tail);
1128 if (!FRAMEP (f))
1129 abort ();
1131 if (EQ (frame, f) && !NILP (prev))
1132 return prev;
1134 if ((!FRAME_TERMCAP_P (XFRAME (f)) && !FRAME_TERMCAP_P (XFRAME (frame))
1135 && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
1136 || (FRAME_TERMCAP_P (XFRAME (f)) && FRAME_TERMCAP_P (XFRAME (frame))
1137 && FRAME_TTY (XFRAME (f)) == FRAME_TTY (XFRAME (frame))))
1139 /* Decide whether this frame is eligible to be returned,
1140 according to minibuf. */
1141 if (NILP (minibuf))
1143 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
1144 prev = f;
1146 else if (WINDOWP (minibuf))
1148 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
1149 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
1150 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
1151 FRAME_FOCUS_FRAME (XFRAME (f))))
1152 prev = f;
1154 else if (EQ (minibuf, Qvisible))
1156 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1157 if (FRAME_VISIBLE_P (XFRAME (f)))
1158 prev = f;
1160 else if (XFASTINT (minibuf) == 0)
1162 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1163 if (FRAME_VISIBLE_P (XFRAME (f))
1164 || FRAME_ICONIFIED_P (XFRAME (f)))
1165 prev = f;
1167 else
1168 prev = f;
1172 /* We've scanned the entire list. */
1173 if (NILP (prev))
1174 /* We went through the whole frame list without finding a single
1175 acceptable frame. Return the original frame. */
1176 return frame;
1177 else
1178 /* There were no acceptable frames in the list before FRAME; otherwise,
1179 we would have returned directly from the loop. Since PREV is the last
1180 acceptable frame in the list, return it. */
1181 return prev;
1185 DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0,
1186 doc: /* Return the next frame in the frame list after FRAME.
1187 It considers only frames on the same terminal as FRAME.
1188 By default, skip minibuffer-only frames.
1189 If omitted, FRAME defaults to the selected frame.
1190 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1191 If MINIFRAME is a window, include only its own frame
1192 and any frame now using that window as the minibuffer.
1193 If MINIFRAME is `visible', include all visible frames.
1194 If MINIFRAME is 0, include all visible and iconified frames.
1195 Otherwise, include all frames. */)
1196 (Lisp_Object frame, Lisp_Object miniframe)
1198 if (NILP (frame))
1199 frame = selected_frame;
1201 CHECK_LIVE_FRAME (frame);
1202 return next_frame (frame, miniframe);
1205 DEFUN ("previous-frame", Fprevious_frame, Sprevious_frame, 0, 2, 0,
1206 doc: /* Return the previous frame in the frame list before FRAME.
1207 It considers only frames on the same terminal as FRAME.
1208 By default, skip minibuffer-only frames.
1209 If omitted, FRAME defaults to the selected frame.
1210 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1211 If MINIFRAME is a window, include only its own frame
1212 and any frame now using that window as the minibuffer.
1213 If MINIFRAME is `visible', include all visible frames.
1214 If MINIFRAME is 0, include all visible and iconified frames.
1215 Otherwise, include all frames. */)
1216 (Lisp_Object frame, Lisp_Object miniframe)
1218 if (NILP (frame))
1219 frame = selected_frame;
1220 CHECK_LIVE_FRAME (frame);
1221 return prev_frame (frame, miniframe);
1224 /* Return 1 if it is ok to delete frame F;
1225 0 if all frames aside from F are invisible.
1226 (Exception: if F is the terminal frame, and we are using X, return 1.) */
1229 other_visible_frames (FRAME_PTR f)
1231 /* We know the selected frame is visible,
1232 so if F is some other frame, it can't be the sole visible one. */
1233 if (f == SELECTED_FRAME ())
1235 Lisp_Object frames;
1236 int count = 0;
1238 for (frames = Vframe_list;
1239 CONSP (frames);
1240 frames = XCDR (frames))
1242 Lisp_Object this;
1244 this = XCAR (frames);
1245 /* Verify that the frame's window still exists
1246 and we can still talk to it. And note any recent change
1247 in visibility. */
1248 #ifdef HAVE_WINDOW_SYSTEM
1249 if (FRAME_WINDOW_P (XFRAME (this)))
1251 x_sync (XFRAME (this));
1252 FRAME_SAMPLE_VISIBILITY (XFRAME (this));
1254 #endif
1256 if (FRAME_VISIBLE_P (XFRAME (this))
1257 || FRAME_ICONIFIED_P (XFRAME (this))
1258 /* Allow deleting the terminal frame when at least
1259 one X frame exists! */
1260 || (FRAME_WINDOW_P (XFRAME (this)) && !FRAME_WINDOW_P (f)))
1261 count++;
1263 return count > 1;
1265 return 1;
1268 /* Delete FRAME. When FORCE equals Qnoelisp, delete FRAME
1269 unconditionally. x_connection_closed and delete_terminal use
1270 this. Any other value of FORCE implements the semantics
1271 described for Fdelete_frame. */
1272 Lisp_Object
1273 delete_frame (Lisp_Object frame, Lisp_Object force)
1274 /* If we use `register' here, gcc-4.0.2 on amd64 using
1275 -DUSE_LISP_UNION_TYPE complains further down that we're getting the
1276 address of `force'. Go figure. */
1279 struct frame *f;
1280 struct frame *sf = SELECTED_FRAME ();
1281 struct kboard *kb;
1283 int minibuffer_selected, tooltip_frame;
1285 if (EQ (frame, Qnil))
1287 f = sf;
1288 XSETFRAME (frame, f);
1290 else
1292 CHECK_FRAME (frame);
1293 f = XFRAME (frame);
1296 if (! FRAME_LIVE_P (f))
1297 return Qnil;
1299 if (NILP (force) && !other_visible_frames (f))
1300 error ("Attempt to delete the sole visible or iconified frame");
1302 /* x_connection_closed must have set FORCE to `noelisp' in order
1303 to delete the last frame, if it is gone. */
1304 if (NILP (XCDR (Vframe_list)) && !EQ (force, Qnoelisp))
1305 error ("Attempt to delete the only frame");
1307 /* Does this frame have a minibuffer, and is it the surrogate
1308 minibuffer for any other frame? */
1309 if (FRAME_HAS_MINIBUF_P (XFRAME (frame)))
1311 Lisp_Object frames;
1313 for (frames = Vframe_list;
1314 CONSP (frames);
1315 frames = XCDR (frames))
1317 Lisp_Object this;
1318 this = XCAR (frames);
1320 if (! EQ (this, frame)
1321 && EQ (frame,
1322 WINDOW_FRAME (XWINDOW
1323 (FRAME_MINIBUF_WINDOW (XFRAME (this))))))
1325 /* If we MUST delete this frame, delete the other first.
1326 But do this only if FORCE equals `noelisp'. */
1327 if (EQ (force, Qnoelisp))
1328 delete_frame (this, Qnoelisp);
1329 else
1330 error ("Attempt to delete a surrogate minibuffer frame");
1335 tooltip_frame = !NILP (Fframe_parameter (frame, intern ("tooltip")));
1337 /* Run `delete-frame-functions' unless FORCE is `noelisp' or
1338 frame is a tooltip. FORCE is set to `noelisp' when handling
1339 a disconnect from the terminal, so we don't dare call Lisp
1340 code. */
1341 if (NILP (Vrun_hooks) || tooltip_frame)
1343 else if (EQ (force, Qnoelisp))
1344 pending_funcalls
1345 = Fcons (list3 (Qrun_hook_with_args, Qdelete_frame_functions, frame),
1346 pending_funcalls);
1347 else
1349 #ifdef HAVE_X_WINDOWS
1350 /* Also, save clipboard to the the clipboard manager. */
1351 x_clipboard_manager_save_frame (frame);
1352 #endif
1354 safe_call2 (Qrun_hook_with_args, Qdelete_frame_functions, frame);
1357 /* The hook may sometimes (indirectly) cause the frame to be deleted. */
1358 if (! FRAME_LIVE_P (f))
1359 return Qnil;
1361 /* At this point, we are committed to deleting the frame.
1362 There is no more chance for errors to prevent it. */
1364 minibuffer_selected = EQ (minibuf_window, selected_window);
1366 /* Don't let the frame remain selected. */
1367 if (f == sf)
1369 Lisp_Object tail, frame1;
1371 /* Look for another visible frame on the same terminal. */
1372 frame1 = next_frame (frame, Qvisible);
1374 /* If there is none, find *some* other frame. */
1375 if (NILP (frame1) || EQ (frame1, frame))
1377 FOR_EACH_FRAME (tail, frame1)
1379 if (! EQ (frame, frame1) && FRAME_LIVE_P (XFRAME (frame1)))
1380 break;
1383 #ifdef NS_IMPL_COCOA
1384 else
1385 /* Under NS, there is no system mechanism for choosing a new
1386 window to get focus -- it is left to application code.
1387 So the portion of THIS application interfacing with NS
1388 needs to know about it. We call Fraise_frame, but the
1389 purpose is really to transfer focus. */
1390 Fraise_frame (frame1);
1391 #endif
1393 do_switch_frame (frame1, 0, 1, Qnil);
1394 sf = SELECTED_FRAME ();
1397 /* Don't allow minibuf_window to remain on a deleted frame. */
1398 if (EQ (f->minibuffer_window, minibuf_window))
1400 Fset_window_buffer (sf->minibuffer_window,
1401 XWINDOW (minibuf_window)->buffer, Qnil);
1402 minibuf_window = sf->minibuffer_window;
1404 /* If the dying minibuffer window was selected,
1405 select the new one. */
1406 if (minibuffer_selected)
1407 Fselect_window (minibuf_window, Qnil);
1410 /* Don't let echo_area_window to remain on a deleted frame. */
1411 if (EQ (f->minibuffer_window, echo_area_window))
1412 echo_area_window = sf->minibuffer_window;
1414 /* Clear any X selections for this frame. */
1415 #ifdef HAVE_X_WINDOWS
1416 if (FRAME_X_P (f))
1417 x_clear_frame_selections (f);
1418 #endif
1420 /* Free glyphs.
1421 This function must be called before the window tree of the
1422 frame is deleted because windows contain dynamically allocated
1423 memory. */
1424 free_glyphs (f);
1426 #ifdef HAVE_WINDOW_SYSTEM
1427 /* Give chance to each font driver to free a frame specific data. */
1428 font_update_drivers (f, Qnil);
1429 #endif
1431 /* Mark all the windows that used to be on FRAME as deleted, and then
1432 remove the reference to them. */
1433 delete_all_subwindows (XWINDOW (f->root_window));
1434 f->root_window = Qnil;
1436 Vframe_list = Fdelq (frame, Vframe_list);
1437 FRAME_SET_VISIBLE (f, 0);
1439 /* Allow the vector of menu bar contents to be freed in the next
1440 garbage collection. The frame object itself may not be garbage
1441 collected until much later, because recent_keys and other data
1442 structures can still refer to it. */
1443 f->menu_bar_vector = Qnil;
1445 free_font_driver_list (f);
1446 xfree (f->namebuf);
1447 xfree (f->decode_mode_spec_buffer);
1448 xfree (FRAME_INSERT_COST (f));
1449 xfree (FRAME_DELETEN_COST (f));
1450 xfree (FRAME_INSERTN_COST (f));
1451 xfree (FRAME_DELETE_COST (f));
1452 xfree (FRAME_MESSAGE_BUF (f));
1454 /* Since some events are handled at the interrupt level, we may get
1455 an event for f at any time; if we zero out the frame's terminal
1456 now, then we may trip up the event-handling code. Instead, we'll
1457 promise that the terminal of the frame must be valid until we
1458 have called the window-system-dependent frame destruction
1459 routine. */
1461 if (FRAME_TERMINAL (f)->delete_frame_hook)
1462 (*FRAME_TERMINAL (f)->delete_frame_hook) (f);
1465 struct terminal *terminal = FRAME_TERMINAL (f);
1466 f->output_data.nothing = 0;
1467 f->terminal = 0; /* Now the frame is dead. */
1469 /* If needed, delete the terminal that this frame was on.
1470 (This must be done after the frame is killed.) */
1471 terminal->reference_count--;
1472 if (terminal->reference_count == 0)
1474 Lisp_Object tmp;
1475 XSETTERMINAL (tmp, terminal);
1477 kb = NULL;
1478 Fdelete_terminal (tmp, NILP (force) ? Qt : force);
1480 else
1481 kb = terminal->kboard;
1484 /* If we've deleted the last_nonminibuf_frame, then try to find
1485 another one. */
1486 if (f == last_nonminibuf_frame)
1488 Lisp_Object frames;
1490 last_nonminibuf_frame = 0;
1492 for (frames = Vframe_list;
1493 CONSP (frames);
1494 frames = XCDR (frames))
1496 f = XFRAME (XCAR (frames));
1497 if (!FRAME_MINIBUF_ONLY_P (f))
1499 last_nonminibuf_frame = f;
1500 break;
1505 /* If there's no other frame on the same kboard, get out of
1506 single-kboard state if we're in it for this kboard. */
1507 if (kb != NULL)
1509 Lisp_Object frames;
1510 /* Some frame we found on the same kboard, or nil if there are none. */
1511 Lisp_Object frame_on_same_kboard;
1513 frame_on_same_kboard = Qnil;
1515 for (frames = Vframe_list;
1516 CONSP (frames);
1517 frames = XCDR (frames))
1519 Lisp_Object this;
1520 struct frame *f1;
1522 this = XCAR (frames);
1523 if (!FRAMEP (this))
1524 abort ();
1525 f1 = XFRAME (this);
1527 if (kb == FRAME_KBOARD (f1))
1528 frame_on_same_kboard = this;
1531 if (NILP (frame_on_same_kboard))
1532 not_single_kboard_state (kb);
1536 /* If we've deleted this keyboard's default_minibuffer_frame, try to
1537 find another one. Prefer minibuffer-only frames, but also notice
1538 frames with other windows. */
1539 if (kb != NULL && EQ (frame, KVAR (kb, Vdefault_minibuffer_frame)))
1541 Lisp_Object frames;
1543 /* The last frame we saw with a minibuffer, minibuffer-only or not. */
1544 Lisp_Object frame_with_minibuf;
1545 /* Some frame we found on the same kboard, or nil if there are none. */
1546 Lisp_Object frame_on_same_kboard;
1548 frame_on_same_kboard = Qnil;
1549 frame_with_minibuf = Qnil;
1551 for (frames = Vframe_list;
1552 CONSP (frames);
1553 frames = XCDR (frames))
1555 Lisp_Object this;
1556 struct frame *f1;
1558 this = XCAR (frames);
1559 if (!FRAMEP (this))
1560 abort ();
1561 f1 = XFRAME (this);
1563 /* Consider only frames on the same kboard
1564 and only those with minibuffers. */
1565 if (kb == FRAME_KBOARD (f1)
1566 && FRAME_HAS_MINIBUF_P (f1))
1568 frame_with_minibuf = this;
1569 if (FRAME_MINIBUF_ONLY_P (f1))
1570 break;
1573 if (kb == FRAME_KBOARD (f1))
1574 frame_on_same_kboard = this;
1577 if (!NILP (frame_on_same_kboard))
1579 /* We know that there must be some frame with a minibuffer out
1580 there. If this were not true, all of the frames present
1581 would have to be minibufferless, which implies that at some
1582 point their minibuffer frames must have been deleted, but
1583 that is prohibited at the top; you can't delete surrogate
1584 minibuffer frames. */
1585 if (NILP (frame_with_minibuf))
1586 abort ();
1588 KVAR (kb, Vdefault_minibuffer_frame) = frame_with_minibuf;
1590 else
1591 /* No frames left on this kboard--say no minibuffer either. */
1592 KVAR (kb, Vdefault_minibuffer_frame) = Qnil;
1595 /* Cause frame titles to update--necessary if we now have just one frame. */
1596 if (!tooltip_frame)
1597 update_mode_lines = 1;
1599 return Qnil;
1602 DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 2, "",
1603 doc: /* Delete FRAME, permanently eliminating it from use.
1604 FRAME defaults to the selected frame.
1606 A frame may not be deleted if its minibuffer is used by other frames.
1607 Normally, you may not delete a frame if all other frames are invisible,
1608 but if the second optional argument FORCE is non-nil, you may do so.
1610 This function runs `delete-frame-functions' before actually
1611 deleting the frame, unless the frame is a tooltip.
1612 The functions are run with one argument, the frame to be deleted. */)
1613 (Lisp_Object frame, Lisp_Object force)
1615 return delete_frame (frame, !NILP (force) ? Qt : Qnil);
1619 /* Return mouse position in character cell units. */
1621 DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0,
1622 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1623 The position is given in character cells, where (0, 0) is the
1624 upper-left corner of the frame, X is the horizontal offset, and Y is
1625 the vertical offset.
1626 If Emacs is running on a mouseless terminal or hasn't been programmed
1627 to read the mouse position, it returns the selected frame for FRAME
1628 and nil for X and Y.
1629 If `mouse-position-function' is non-nil, `mouse-position' calls it,
1630 passing the normal return value to that function as an argument,
1631 and returns whatever that function returns. */)
1632 (void)
1634 FRAME_PTR f;
1635 Lisp_Object lispy_dummy;
1636 enum scroll_bar_part party_dummy;
1637 Lisp_Object x, y, retval;
1638 int col, row;
1639 Time long_dummy;
1640 struct gcpro gcpro1;
1642 f = SELECTED_FRAME ();
1643 x = y = Qnil;
1645 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
1646 /* It's okay for the hook to refrain from storing anything. */
1647 if (FRAME_TERMINAL (f)->mouse_position_hook)
1648 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1649 &lispy_dummy, &party_dummy,
1650 &x, &y,
1651 &long_dummy);
1652 if (! NILP (x))
1654 col = XINT (x);
1655 row = XINT (y);
1656 pixel_to_glyph_coords (f, col, row, &col, &row, NULL, 1);
1657 XSETINT (x, col);
1658 XSETINT (y, row);
1660 #endif
1661 XSETFRAME (lispy_dummy, f);
1662 retval = Fcons (lispy_dummy, Fcons (x, y));
1663 GCPRO1 (retval);
1664 if (!NILP (Vmouse_position_function))
1665 retval = call1 (Vmouse_position_function, retval);
1666 RETURN_UNGCPRO (retval);
1669 DEFUN ("mouse-pixel-position", Fmouse_pixel_position,
1670 Smouse_pixel_position, 0, 0, 0,
1671 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1672 The position is given in pixel units, where (0, 0) is the
1673 upper-left corner of the frame, X is the horizontal offset, and Y is
1674 the vertical offset.
1675 If Emacs is running on a mouseless terminal or hasn't been programmed
1676 to read the mouse position, it returns the selected frame for FRAME
1677 and nil for X and Y. */)
1678 (void)
1680 FRAME_PTR f;
1681 Lisp_Object lispy_dummy;
1682 enum scroll_bar_part party_dummy;
1683 Lisp_Object x, y;
1684 Time long_dummy;
1686 f = SELECTED_FRAME ();
1687 x = y = Qnil;
1689 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
1690 /* It's okay for the hook to refrain from storing anything. */
1691 if (FRAME_TERMINAL (f)->mouse_position_hook)
1692 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1693 &lispy_dummy, &party_dummy,
1694 &x, &y,
1695 &long_dummy);
1696 #endif
1697 XSETFRAME (lispy_dummy, f);
1698 return Fcons (lispy_dummy, Fcons (x, y));
1701 DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0,
1702 doc: /* Move the mouse pointer to the center of character cell (X,Y) in FRAME.
1703 Coordinates are relative to the frame, not a window,
1704 so the coordinates of the top left character in the frame
1705 may be nonzero due to left-hand scroll bars or the menu bar.
1707 The position is given in character cells, where (0, 0) is the
1708 upper-left corner of the frame, X is the horizontal offset, and Y is
1709 the vertical offset.
1711 This function is a no-op for an X frame that is not visible.
1712 If you have just created a frame, you must wait for it to become visible
1713 before calling this function on it, like this.
1714 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1715 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1717 CHECK_LIVE_FRAME (frame);
1718 CHECK_NUMBER (x);
1719 CHECK_NUMBER (y);
1721 /* I think this should be done with a hook. */
1722 #ifdef HAVE_WINDOW_SYSTEM
1723 if (FRAME_WINDOW_P (XFRAME (frame)))
1724 /* Warping the mouse will cause enternotify and focus events. */
1725 x_set_mouse_position (XFRAME (frame), XINT (x), XINT (y));
1726 #else
1727 #if defined (MSDOS) && defined (HAVE_MOUSE)
1728 if (FRAME_MSDOS_P (XFRAME (frame)))
1730 Fselect_frame (frame, Qnil);
1731 mouse_moveto (XINT (x), XINT (y));
1733 #else
1734 #ifdef HAVE_GPM
1736 Fselect_frame (frame, Qnil);
1737 term_mouse_moveto (XINT (x), XINT (y));
1739 #endif
1740 #endif
1741 #endif
1743 return Qnil;
1746 DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position,
1747 Sset_mouse_pixel_position, 3, 3, 0,
1748 doc: /* Move the mouse pointer to pixel position (X,Y) in FRAME.
1749 The position is given in pixels, where (0, 0) is the upper-left corner
1750 of the frame, X is the horizontal offset, and Y is the vertical offset.
1752 Note, this is a no-op for an X frame that is not visible.
1753 If you have just created a frame, you must wait for it to become visible
1754 before calling this function on it, like this.
1755 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1756 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1758 CHECK_LIVE_FRAME (frame);
1759 CHECK_NUMBER (x);
1760 CHECK_NUMBER (y);
1762 /* I think this should be done with a hook. */
1763 #ifdef HAVE_WINDOW_SYSTEM
1764 if (FRAME_WINDOW_P (XFRAME (frame)))
1765 /* Warping the mouse will cause enternotify and focus events. */
1766 x_set_mouse_pixel_position (XFRAME (frame), XINT (x), XINT (y));
1767 #else
1768 #if defined (MSDOS) && defined (HAVE_MOUSE)
1769 if (FRAME_MSDOS_P (XFRAME (frame)))
1771 Fselect_frame (frame, Qnil);
1772 mouse_moveto (XINT (x), XINT (y));
1774 #else
1775 #ifdef HAVE_GPM
1777 Fselect_frame (frame, Qnil);
1778 term_mouse_moveto (XINT (x), XINT (y));
1780 #endif
1781 #endif
1782 #endif
1784 return Qnil;
1787 static void make_frame_visible_1 (Lisp_Object);
1789 DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible,
1790 0, 1, "",
1791 doc: /* Make the frame FRAME visible (assuming it is an X window).
1792 If omitted, FRAME defaults to the currently selected frame. */)
1793 (Lisp_Object frame)
1795 if (NILP (frame))
1796 frame = selected_frame;
1798 CHECK_LIVE_FRAME (frame);
1800 /* I think this should be done with a hook. */
1801 #ifdef HAVE_WINDOW_SYSTEM
1802 if (FRAME_WINDOW_P (XFRAME (frame)))
1804 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1805 x_make_frame_visible (XFRAME (frame));
1807 #endif
1809 make_frame_visible_1 (XFRAME (frame)->root_window);
1811 /* Make menu bar update for the Buffers and Frames menus. */
1812 windows_or_buffers_changed++;
1814 return frame;
1817 /* Update the display_time slot of the buffers shown in WINDOW
1818 and all its descendents. */
1820 static void
1821 make_frame_visible_1 (Lisp_Object window)
1823 struct window *w;
1825 for (;!NILP (window); window = w->next)
1827 w = XWINDOW (window);
1829 if (!NILP (w->buffer))
1830 BVAR (XBUFFER (w->buffer), display_time) = Fcurrent_time ();
1832 if (!NILP (w->vchild))
1833 make_frame_visible_1 (w->vchild);
1834 if (!NILP (w->hchild))
1835 make_frame_visible_1 (w->hchild);
1839 DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible,
1840 0, 2, "",
1841 doc: /* Make the frame FRAME invisible.
1842 If omitted, FRAME defaults to the currently selected frame.
1843 On graphical displays, invisible frames are not updated and are
1844 usually not displayed at all, even in a window system's \"taskbar\".
1846 Normally you may not make FRAME invisible if all other frames are invisible,
1847 but if the second optional argument FORCE is non-nil, you may do so.
1849 This function has no effect on text-only terminal frames. Such frames
1850 are always considered visible, whether or not they are currently being
1851 displayed in the terminal. */)
1852 (Lisp_Object frame, Lisp_Object force)
1854 if (NILP (frame))
1855 frame = selected_frame;
1857 CHECK_LIVE_FRAME (frame);
1859 if (NILP (force) && !other_visible_frames (XFRAME (frame)))
1860 error ("Attempt to make invisible the sole visible or iconified frame");
1862 #if 0 /* This isn't logically necessary, and it can do GC. */
1863 /* Don't let the frame remain selected. */
1864 if (EQ (frame, selected_frame))
1865 do_switch_frame (next_frame (frame, Qt), 0, 0, Qnil)
1866 #endif
1868 /* Don't allow minibuf_window to remain on a deleted frame. */
1869 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1871 struct frame *sf = XFRAME (selected_frame);
1872 Fset_window_buffer (sf->minibuffer_window,
1873 XWINDOW (minibuf_window)->buffer, Qnil);
1874 minibuf_window = sf->minibuffer_window;
1877 /* I think this should be done with a hook. */
1878 #ifdef HAVE_WINDOW_SYSTEM
1879 if (FRAME_WINDOW_P (XFRAME (frame)))
1880 x_make_frame_invisible (XFRAME (frame));
1881 #endif
1883 /* Make menu bar update for the Buffers and Frames menus. */
1884 windows_or_buffers_changed++;
1886 return Qnil;
1889 DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame,
1890 0, 1, "",
1891 doc: /* Make the frame FRAME into an icon.
1892 If omitted, FRAME defaults to the currently selected frame. */)
1893 (Lisp_Object frame)
1895 if (NILP (frame))
1896 frame = selected_frame;
1898 CHECK_LIVE_FRAME (frame);
1900 #if 0 /* This isn't logically necessary, and it can do GC. */
1901 /* Don't let the frame remain selected. */
1902 if (EQ (frame, selected_frame))
1903 Fhandle_switch_frame (next_frame (frame, Qt));
1904 #endif
1906 /* Don't allow minibuf_window to remain on a deleted frame. */
1907 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1909 struct frame *sf = XFRAME (selected_frame);
1910 Fset_window_buffer (sf->minibuffer_window,
1911 XWINDOW (minibuf_window)->buffer, Qnil);
1912 minibuf_window = sf->minibuffer_window;
1915 /* I think this should be done with a hook. */
1916 #ifdef HAVE_WINDOW_SYSTEM
1917 if (FRAME_WINDOW_P (XFRAME (frame)))
1918 x_iconify_frame (XFRAME (frame));
1919 #endif
1921 /* Make menu bar update for the Buffers and Frames menus. */
1922 windows_or_buffers_changed++;
1924 return Qnil;
1927 DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p,
1928 1, 1, 0,
1929 doc: /* Return t if FRAME is \"visible\" (actually in use for display).
1930 Return the symbol `icon' if FRAME is iconified or \"minimized\".
1931 Return nil if FRAME was made invisible, via `make-frame-invisible'.
1932 On graphical displays, invisible frames are not updated and are
1933 usually not displayed at all, even in a window system's \"taskbar\".
1935 If FRAME is a text-only terminal frame, this always returns t.
1936 Such frames are always considered visible, whether or not they are
1937 currently being displayed on the terminal. */)
1938 (Lisp_Object frame)
1940 CHECK_LIVE_FRAME (frame);
1942 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1944 if (FRAME_VISIBLE_P (XFRAME (frame)))
1945 return Qt;
1946 if (FRAME_ICONIFIED_P (XFRAME (frame)))
1947 return Qicon;
1948 return Qnil;
1951 DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list,
1952 0, 0, 0,
1953 doc: /* Return a list of all frames now \"visible\" (being updated). */)
1954 (void)
1956 Lisp_Object tail, frame;
1957 struct frame *f;
1958 Lisp_Object value;
1960 value = Qnil;
1961 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1963 frame = XCAR (tail);
1964 if (!FRAMEP (frame))
1965 continue;
1966 f = XFRAME (frame);
1967 if (FRAME_VISIBLE_P (f))
1968 value = Fcons (frame, value);
1970 return value;
1974 DEFUN ("raise-frame", Fraise_frame, Sraise_frame, 0, 1, "",
1975 doc: /* Bring FRAME to the front, so it occludes any frames it overlaps.
1976 If FRAME is invisible or iconified, make it visible.
1977 If you don't specify a frame, the selected frame is used.
1978 If Emacs is displaying on an ordinary terminal or some other device which
1979 doesn't support multiple overlapping frames, this function selects FRAME. */)
1980 (Lisp_Object frame)
1982 struct frame *f;
1983 if (NILP (frame))
1984 frame = selected_frame;
1986 CHECK_LIVE_FRAME (frame);
1988 f = XFRAME (frame);
1990 if (FRAME_TERMCAP_P (f))
1991 /* On a text-only terminal select FRAME. */
1992 Fselect_frame (frame, Qnil);
1993 else
1994 /* Do like the documentation says. */
1995 Fmake_frame_visible (frame);
1997 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
1998 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 1);
2000 return Qnil;
2003 /* Should we have a corresponding function called Flower_Power? */
2004 DEFUN ("lower-frame", Flower_frame, Slower_frame, 0, 1, "",
2005 doc: /* Send FRAME to the back, so it is occluded by any frames that overlap it.
2006 If you don't specify a frame, the selected frame is used.
2007 If Emacs is displaying on an ordinary terminal or some other device which
2008 doesn't support multiple overlapping frames, this function does nothing. */)
2009 (Lisp_Object frame)
2011 struct frame *f;
2013 if (NILP (frame))
2014 frame = selected_frame;
2016 CHECK_LIVE_FRAME (frame);
2018 f = XFRAME (frame);
2020 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
2021 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 0);
2023 return Qnil;
2027 DEFUN ("redirect-frame-focus", Fredirect_frame_focus, Sredirect_frame_focus,
2028 1, 2, 0,
2029 doc: /* Arrange for keystrokes typed at FRAME to be sent to FOCUS-FRAME.
2030 In other words, switch-frame events caused by events in FRAME will
2031 request a switch to FOCUS-FRAME, and `last-event-frame' will be
2032 FOCUS-FRAME after reading an event typed at FRAME.
2034 If FOCUS-FRAME is omitted or nil, any existing redirection is
2035 cancelled, and the frame again receives its own keystrokes.
2037 Focus redirection is useful for temporarily redirecting keystrokes to
2038 a surrogate minibuffer frame when a frame doesn't have its own
2039 minibuffer window.
2041 A frame's focus redirection can be changed by `select-frame'. If frame
2042 FOO is selected, and then a different frame BAR is selected, any
2043 frames redirecting their focus to FOO are shifted to redirect their
2044 focus to BAR. This allows focus redirection to work properly when the
2045 user switches from one frame to another using `select-window'.
2047 This means that a frame whose focus is redirected to itself is treated
2048 differently from a frame whose focus is redirected to nil; the former
2049 is affected by `select-frame', while the latter is not.
2051 The redirection lasts until `redirect-frame-focus' is called to change it. */)
2052 (Lisp_Object frame, Lisp_Object focus_frame)
2054 struct frame *f;
2056 /* Note that we don't check for a live frame here. It's reasonable
2057 to redirect the focus of a frame you're about to delete, if you
2058 know what other frame should receive those keystrokes. */
2059 CHECK_FRAME (frame);
2061 if (! NILP (focus_frame))
2062 CHECK_LIVE_FRAME (focus_frame);
2064 f = XFRAME (frame);
2066 f->focus_frame = focus_frame;
2068 if (FRAME_TERMINAL (f)->frame_rehighlight_hook)
2069 (*FRAME_TERMINAL (f)->frame_rehighlight_hook) (f);
2071 return Qnil;
2075 DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 1, 1, 0,
2076 doc: /* Return the frame to which FRAME's keystrokes are currently being sent.
2077 This returns nil if FRAME's focus is not redirected.
2078 See `redirect-frame-focus'. */)
2079 (Lisp_Object frame)
2081 CHECK_LIVE_FRAME (frame);
2083 return FRAME_FOCUS_FRAME (XFRAME (frame));
2088 /* Return the value of frame parameter PROP in frame FRAME. */
2090 #if !HAVE_NS
2091 static
2092 #endif
2093 Lisp_Object
2094 get_frame_param (register struct frame *frame, Lisp_Object prop)
2096 register Lisp_Object tem;
2098 tem = Fassq (prop, frame->param_alist);
2099 if (EQ (tem, Qnil))
2100 return tem;
2101 return Fcdr (tem);
2104 /* Return the buffer-predicate of the selected frame. */
2106 Lisp_Object
2107 frame_buffer_predicate (Lisp_Object frame)
2109 return XFRAME (frame)->buffer_predicate;
2112 /* Return the buffer-list of the selected frame. */
2114 Lisp_Object
2115 frame_buffer_list (Lisp_Object frame)
2117 return XFRAME (frame)->buffer_list;
2120 /* Set the buffer-list of the selected frame. */
2122 void
2123 set_frame_buffer_list (Lisp_Object frame, Lisp_Object list)
2125 XFRAME (frame)->buffer_list = list;
2128 /* Discard BUFFER from the buffer-list and buried-buffer-list of each frame. */
2130 void
2131 frames_discard_buffer (Lisp_Object buffer)
2133 Lisp_Object frame, tail;
2135 FOR_EACH_FRAME (tail, frame)
2137 XFRAME (frame)->buffer_list
2138 = Fdelq (buffer, XFRAME (frame)->buffer_list);
2139 XFRAME (frame)->buried_buffer_list
2140 = Fdelq (buffer, XFRAME (frame)->buried_buffer_list);
2144 /* Modify the alist in *ALISTPTR to associate PROP with VAL.
2145 If the alist already has an element for PROP, we change it. */
2147 void
2148 store_in_alist (Lisp_Object *alistptr, Lisp_Object prop, Lisp_Object val)
2150 register Lisp_Object tem;
2152 tem = Fassq (prop, *alistptr);
2153 if (EQ (tem, Qnil))
2154 *alistptr = Fcons (Fcons (prop, val), *alistptr);
2155 else
2156 Fsetcdr (tem, val);
2159 static int
2160 frame_name_fnn_p (char *str, EMACS_INT len)
2162 if (len > 1 && str[0] == 'F' && '0' <= str[1] && str[1] <= '9')
2164 char *p = str + 2;
2165 while ('0' <= *p && *p <= '9')
2166 p++;
2167 if (p == str + len)
2168 return 1;
2170 return 0;
2173 /* Set the name of the terminal frame. Also used by MSDOS frames.
2174 Modeled after x_set_name which is used for WINDOW frames. */
2176 static void
2177 set_term_frame_name (struct frame *f, Lisp_Object name)
2179 f->explicit_name = ! NILP (name);
2181 /* If NAME is nil, set the name to F<num>. */
2182 if (NILP (name))
2184 char namebuf[20];
2186 /* Check for no change needed in this very common case
2187 before we do any consing. */
2188 if (frame_name_fnn_p (SSDATA (f->name),
2189 SBYTES (f->name)))
2190 return;
2192 tty_frame_count++;
2193 sprintf (namebuf, "F%d", tty_frame_count);
2194 name = build_string (namebuf);
2196 else
2198 CHECK_STRING (name);
2200 /* Don't change the name if it's already NAME. */
2201 if (! NILP (Fstring_equal (name, f->name)))
2202 return;
2204 /* Don't allow the user to set the frame name to F<num>, so it
2205 doesn't clash with the names we generate for terminal frames. */
2206 if (frame_name_fnn_p (SSDATA (name), SBYTES (name)))
2207 error ("Frame names of the form F<num> are usurped by Emacs");
2210 f->name = name;
2211 update_mode_lines = 1;
2214 void
2215 store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
2217 register Lisp_Object old_alist_elt;
2219 /* The buffer-list parameters are stored in a special place and not
2220 in the alist. All buffers must be live. */
2221 if (EQ (prop, Qbuffer_list))
2223 Lisp_Object list = Qnil;
2224 for (; CONSP (val); val = XCDR (val))
2225 if (!NILP (Fbuffer_live_p (XCAR (val))))
2226 list = Fcons (XCAR (val), list);
2227 f->buffer_list = Fnreverse (list);
2228 return;
2230 if (EQ (prop, Qburied_buffer_list))
2232 Lisp_Object list = Qnil;
2233 for (; CONSP (val); val = XCDR (val))
2234 if (!NILP (Fbuffer_live_p (XCAR (val))))
2235 list = Fcons (XCAR (val), list);
2236 f->buried_buffer_list = Fnreverse (list);
2237 return;
2240 /* If PROP is a symbol which is supposed to have frame-local values,
2241 and it is set up based on this frame, switch to the global
2242 binding. That way, we can create or alter the frame-local binding
2243 without messing up the symbol's status. */
2244 if (SYMBOLP (prop))
2246 struct Lisp_Symbol *sym = XSYMBOL (prop);
2247 start:
2248 switch (sym->redirect)
2250 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
2251 case SYMBOL_PLAINVAL: case SYMBOL_FORWARDED: break;
2252 case SYMBOL_LOCALIZED:
2253 { struct Lisp_Buffer_Local_Value *blv = sym->val.blv;
2254 if (blv->frame_local && BLV_FOUND (blv) && XFRAME (blv->where) == f)
2255 swap_in_global_binding (sym);
2256 break;
2258 default: abort ();
2262 /* The tty color needed to be set before the frame's parameter
2263 alist was updated with the new value. This is not true any more,
2264 but we still do this test early on. */
2265 if (FRAME_TERMCAP_P (f) && EQ (prop, Qtty_color_mode)
2266 && f == FRAME_TTY (f)->previous_frame)
2267 /* Force redisplay of this tty. */
2268 FRAME_TTY (f)->previous_frame = NULL;
2270 /* Update the frame parameter alist. */
2271 old_alist_elt = Fassq (prop, f->param_alist);
2272 if (EQ (old_alist_elt, Qnil))
2273 f->param_alist = Fcons (Fcons (prop, val), f->param_alist);
2274 else
2275 Fsetcdr (old_alist_elt, val);
2277 /* Update some other special parameters in their special places
2278 in addition to the alist. */
2280 if (EQ (prop, Qbuffer_predicate))
2281 f->buffer_predicate = val;
2283 if (! FRAME_WINDOW_P (f))
2285 if (EQ (prop, Qmenu_bar_lines))
2286 set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f)));
2287 else if (EQ (prop, Qname))
2288 set_term_frame_name (f, val);
2291 if (EQ (prop, Qminibuffer) && WINDOWP (val))
2293 if (! MINI_WINDOW_P (XWINDOW (val)))
2294 error ("Surrogate minibuffer windows must be minibuffer windows");
2296 if ((FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
2297 && !EQ (val, f->minibuffer_window))
2298 error ("Can't change the surrogate minibuffer of a frame with its own minibuffer");
2300 /* Install the chosen minibuffer window, with proper buffer. */
2301 f->minibuffer_window = val;
2305 DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0,
2306 doc: /* Return the parameters-alist of frame FRAME.
2307 It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
2308 The meaningful PARMs depend on the kind of frame.
2309 If FRAME is omitted, return information on the currently selected frame. */)
2310 (Lisp_Object frame)
2312 Lisp_Object alist;
2313 FRAME_PTR f;
2314 int height, width;
2315 struct gcpro gcpro1;
2317 if (NILP (frame))
2318 frame = selected_frame;
2320 CHECK_FRAME (frame);
2321 f = XFRAME (frame);
2323 if (!FRAME_LIVE_P (f))
2324 return Qnil;
2326 alist = Fcopy_alist (f->param_alist);
2327 GCPRO1 (alist);
2329 if (!FRAME_WINDOW_P (f))
2331 int fg = FRAME_FOREGROUND_PIXEL (f);
2332 int bg = FRAME_BACKGROUND_PIXEL (f);
2333 Lisp_Object elt;
2335 /* If the frame's parameter alist says the colors are
2336 unspecified and reversed, take the frame's background pixel
2337 for foreground and vice versa. */
2338 elt = Fassq (Qforeground_color, alist);
2339 if (CONSP (elt) && STRINGP (XCDR (elt)))
2341 if (strncmp (SSDATA (XCDR (elt)),
2342 unspecified_bg,
2343 SCHARS (XCDR (elt))) == 0)
2344 store_in_alist (&alist, Qforeground_color, tty_color_name (f, bg));
2345 else if (strncmp (SSDATA (XCDR (elt)),
2346 unspecified_fg,
2347 SCHARS (XCDR (elt))) == 0)
2348 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2350 else
2351 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2352 elt = Fassq (Qbackground_color, alist);
2353 if (CONSP (elt) && STRINGP (XCDR (elt)))
2355 if (strncmp (SSDATA (XCDR (elt)),
2356 unspecified_fg,
2357 SCHARS (XCDR (elt))) == 0)
2358 store_in_alist (&alist, Qbackground_color, tty_color_name (f, fg));
2359 else if (strncmp (SSDATA (XCDR (elt)),
2360 unspecified_bg,
2361 SCHARS (XCDR (elt))) == 0)
2362 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2364 else
2365 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2366 store_in_alist (&alist, intern ("font"),
2367 build_string (FRAME_MSDOS_P (f)
2368 ? "ms-dos"
2369 : FRAME_W32_P (f) ? "w32term"
2370 :"tty"));
2372 store_in_alist (&alist, Qname, f->name);
2373 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2374 store_in_alist (&alist, Qheight, make_number (height));
2375 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2376 store_in_alist (&alist, Qwidth, make_number (width));
2377 store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil));
2378 store_in_alist (&alist, Qminibuffer,
2379 (! FRAME_HAS_MINIBUF_P (f) ? Qnil
2380 : FRAME_MINIBUF_ONLY_P (f) ? Qonly
2381 : FRAME_MINIBUF_WINDOW (f)));
2382 store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
2383 store_in_alist (&alist, Qbuffer_list, frame_buffer_list (frame));
2384 store_in_alist (&alist, Qburied_buffer_list, XFRAME (frame)->buried_buffer_list);
2386 /* I think this should be done with a hook. */
2387 #ifdef HAVE_WINDOW_SYSTEM
2388 if (FRAME_WINDOW_P (f))
2389 x_report_frame_params (f, &alist);
2390 else
2391 #endif
2393 /* This ought to be correct in f->param_alist for an X frame. */
2394 Lisp_Object lines;
2395 XSETFASTINT (lines, FRAME_MENU_BAR_LINES (f));
2396 store_in_alist (&alist, Qmenu_bar_lines, lines);
2399 UNGCPRO;
2400 return alist;
2404 DEFUN ("frame-parameter", Fframe_parameter, Sframe_parameter, 2, 2, 0,
2405 doc: /* Return FRAME's value for parameter PARAMETER.
2406 If FRAME is nil, describe the currently selected frame. */)
2407 (Lisp_Object frame, Lisp_Object parameter)
2409 struct frame *f;
2410 Lisp_Object value;
2412 if (NILP (frame))
2413 frame = selected_frame;
2414 else
2415 CHECK_FRAME (frame);
2416 CHECK_SYMBOL (parameter);
2418 f = XFRAME (frame);
2419 value = Qnil;
2421 if (FRAME_LIVE_P (f))
2423 /* Avoid consing in frequent cases. */
2424 if (EQ (parameter, Qname))
2425 value = f->name;
2426 #ifdef HAVE_X_WINDOWS
2427 else if (EQ (parameter, Qdisplay) && FRAME_X_P (f))
2428 value = XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element);
2429 #endif /* HAVE_X_WINDOWS */
2430 else if (EQ (parameter, Qbackground_color)
2431 || EQ (parameter, Qforeground_color))
2433 value = Fassq (parameter, f->param_alist);
2434 if (CONSP (value))
2436 value = XCDR (value);
2437 /* Fframe_parameters puts the actual fg/bg color names,
2438 even if f->param_alist says otherwise. This is
2439 important when param_alist's notion of colors is
2440 "unspecified". We need to do the same here. */
2441 if (STRINGP (value) && !FRAME_WINDOW_P (f))
2443 const char *color_name;
2444 EMACS_INT csz;
2446 if (EQ (parameter, Qbackground_color))
2448 color_name = SSDATA (value);
2449 csz = SCHARS (value);
2450 if (strncmp (color_name, unspecified_bg, csz) == 0)
2451 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2452 else if (strncmp (color_name, unspecified_fg, csz) == 0)
2453 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2455 else if (EQ (parameter, Qforeground_color))
2457 color_name = SSDATA (value);
2458 csz = SCHARS (value);
2459 if (strncmp (color_name, unspecified_fg, csz) == 0)
2460 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2461 else if (strncmp (color_name, unspecified_bg, csz) == 0)
2462 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2466 else
2467 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2469 else if (EQ (parameter, Qdisplay_type)
2470 || EQ (parameter, Qbackground_mode))
2471 value = Fcdr (Fassq (parameter, f->param_alist));
2472 else
2473 /* FIXME: Avoid this code path at all (as well as code duplication)
2474 by sharing more code with Fframe_parameters. */
2475 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2478 return value;
2482 DEFUN ("modify-frame-parameters", Fmodify_frame_parameters,
2483 Smodify_frame_parameters, 2, 2, 0,
2484 doc: /* Modify the parameters of frame FRAME according to ALIST.
2485 If FRAME is nil, it defaults to the selected frame.
2486 ALIST is an alist of parameters to change and their new values.
2487 Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.
2488 The meaningful PARMs depend on the kind of frame.
2489 Undefined PARMs are ignored, but stored in the frame's parameter list
2490 so that `frame-parameters' will return them.
2492 The value of frame parameter FOO can also be accessed
2493 as a frame-local binding for the variable FOO, if you have
2494 enabled such bindings for that variable with `make-variable-frame-local'.
2495 Note that this functionality is obsolete as of Emacs 22.2, and its
2496 use is not recommended. Explicitly check for a frame-parameter instead. */)
2497 (Lisp_Object frame, Lisp_Object alist)
2499 FRAME_PTR f;
2500 register Lisp_Object tail, prop, val;
2502 if (EQ (frame, Qnil))
2503 frame = selected_frame;
2504 CHECK_LIVE_FRAME (frame);
2505 f = XFRAME (frame);
2507 /* I think this should be done with a hook. */
2508 #ifdef HAVE_WINDOW_SYSTEM
2509 if (FRAME_WINDOW_P (f))
2510 x_set_frame_parameters (f, alist);
2511 else
2512 #endif
2513 #ifdef MSDOS
2514 if (FRAME_MSDOS_P (f))
2515 IT_set_frame_parameters (f, alist);
2516 else
2517 #endif
2520 int length = XINT (Flength (alist));
2521 int i;
2522 Lisp_Object *parms
2523 = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
2524 Lisp_Object *values
2525 = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
2527 /* Extract parm names and values into those vectors. */
2529 i = 0;
2530 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2532 Lisp_Object elt;
2534 elt = XCAR (tail);
2535 parms[i] = Fcar (elt);
2536 values[i] = Fcdr (elt);
2537 i++;
2540 /* Now process them in reverse of specified order. */
2541 while (--i >= 0)
2543 prop = parms[i];
2544 val = values[i];
2545 store_frame_param (f, prop, val);
2547 /* Changing the background color might change the background
2548 mode, so that we have to load new defface specs.
2549 Call frame-set-background-mode to do that. */
2550 if (EQ (prop, Qbackground_color))
2551 call1 (Qframe_set_background_mode, frame);
2554 return Qnil;
2557 DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height,
2558 0, 1, 0,
2559 doc: /* Height in pixels of a line in the font in frame FRAME.
2560 If FRAME is omitted, the selected frame is used.
2561 For a terminal frame, the value is always 1. */)
2562 (Lisp_Object frame)
2564 struct frame *f;
2566 if (NILP (frame))
2567 frame = selected_frame;
2568 CHECK_FRAME (frame);
2569 f = XFRAME (frame);
2571 #ifdef HAVE_WINDOW_SYSTEM
2572 if (FRAME_WINDOW_P (f))
2573 return make_number (x_char_height (f));
2574 else
2575 #endif
2576 return make_number (1);
2580 DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width,
2581 0, 1, 0,
2582 doc: /* Width in pixels of characters in the font in frame FRAME.
2583 If FRAME is omitted, the selected frame is used.
2584 On a graphical screen, the width is the standard width of the default font.
2585 For a terminal screen, the value is always 1. */)
2586 (Lisp_Object frame)
2588 struct frame *f;
2590 if (NILP (frame))
2591 frame = selected_frame;
2592 CHECK_FRAME (frame);
2593 f = XFRAME (frame);
2595 #ifdef HAVE_WINDOW_SYSTEM
2596 if (FRAME_WINDOW_P (f))
2597 return make_number (x_char_width (f));
2598 else
2599 #endif
2600 return make_number (1);
2603 DEFUN ("frame-pixel-height", Fframe_pixel_height,
2604 Sframe_pixel_height, 0, 1, 0,
2605 doc: /* Return a FRAME's height in pixels.
2606 If FRAME is omitted, the selected frame is used. The exact value
2607 of the result depends on the window-system and toolkit in use:
2609 In the Gtk+ version of Emacs, it includes only any window (including
2610 the minibuffer or eacho area), mode line, and header line. It does not
2611 include the tool bar or menu bar.
2613 With the Motif or Lucid toolkits, it also includes the tool bar (but
2614 not the menu bar).
2616 In a graphical version with no toolkit, it includes both the tool bar
2617 and menu bar.
2619 For a text-only terminal, it includes the menu bar. In this case, the
2620 result is really in characters rather than pixels (i.e., is identical
2621 to `frame-height'). */)
2622 (Lisp_Object frame)
2624 struct frame *f;
2626 if (NILP (frame))
2627 frame = selected_frame;
2628 CHECK_FRAME (frame);
2629 f = XFRAME (frame);
2631 #ifdef HAVE_WINDOW_SYSTEM
2632 if (FRAME_WINDOW_P (f))
2633 return make_number (x_pixel_height (f));
2634 else
2635 #endif
2636 return make_number (FRAME_LINES (f));
2639 DEFUN ("frame-pixel-width", Fframe_pixel_width,
2640 Sframe_pixel_width, 0, 1, 0,
2641 doc: /* Return FRAME's width in pixels.
2642 For a terminal frame, the result really gives the width in characters.
2643 If FRAME is omitted, the selected frame is used. */)
2644 (Lisp_Object frame)
2646 struct frame *f;
2648 if (NILP (frame))
2649 frame = selected_frame;
2650 CHECK_FRAME (frame);
2651 f = XFRAME (frame);
2653 #ifdef HAVE_WINDOW_SYSTEM
2654 if (FRAME_WINDOW_P (f))
2655 return make_number (x_pixel_width (f));
2656 else
2657 #endif
2658 return make_number (FRAME_COLS (f));
2661 DEFUN ("tool-bar-pixel-width", Ftool_bar_pixel_width,
2662 Stool_bar_pixel_width, 0, 1, 0,
2663 doc: /* Return width in pixels of FRAME's tool bar.
2664 The result is greater than zero only when the tool bar is on the left
2665 or right side of FRAME. If FRAME is omitted, the selected frame is
2666 used. */)
2667 (Lisp_Object frame)
2669 struct frame *f;
2671 if (NILP (frame))
2672 frame = selected_frame;
2673 CHECK_FRAME (frame);
2674 f = XFRAME (frame);
2676 #ifdef FRAME_TOOLBAR_WIDTH
2677 if (FRAME_WINDOW_P (f))
2678 return make_number (FRAME_TOOLBAR_WIDTH (f));
2679 #endif
2680 return make_number (0);
2683 DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0,
2684 doc: /* Specify that the frame FRAME has LINES lines.
2685 Optional third arg non-nil means that redisplay should use LINES lines
2686 but that the idea of the actual height of the frame should not be changed. */)
2687 (Lisp_Object frame, Lisp_Object lines, Lisp_Object pretend)
2689 register struct frame *f;
2691 CHECK_NUMBER (lines);
2692 if (NILP (frame))
2693 frame = selected_frame;
2694 CHECK_LIVE_FRAME (frame);
2695 f = XFRAME (frame);
2697 /* I think this should be done with a hook. */
2698 #ifdef HAVE_WINDOW_SYSTEM
2699 if (FRAME_WINDOW_P (f))
2701 if (XINT (lines) != FRAME_LINES (f))
2702 x_set_window_size (f, 1, FRAME_COLS (f), XINT (lines));
2703 do_pending_window_change (0);
2705 else
2706 #endif
2707 change_frame_size (f, XINT (lines), 0, !NILP (pretend), 0, 0);
2708 return Qnil;
2711 DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 3, 0,
2712 doc: /* Specify that the frame FRAME has COLS columns.
2713 Optional third arg non-nil means that redisplay should use COLS columns
2714 but that the idea of the actual width of the frame should not be changed. */)
2715 (Lisp_Object frame, Lisp_Object cols, Lisp_Object pretend)
2717 register struct frame *f;
2718 CHECK_NUMBER (cols);
2719 if (NILP (frame))
2720 frame = selected_frame;
2721 CHECK_LIVE_FRAME (frame);
2722 f = XFRAME (frame);
2724 /* I think this should be done with a hook. */
2725 #ifdef HAVE_WINDOW_SYSTEM
2726 if (FRAME_WINDOW_P (f))
2728 if (XINT (cols) != FRAME_COLS (f))
2729 x_set_window_size (f, 1, XINT (cols), FRAME_LINES (f));
2730 do_pending_window_change (0);
2732 else
2733 #endif
2734 change_frame_size (f, 0, XINT (cols), !NILP (pretend), 0, 0);
2735 return Qnil;
2738 DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0,
2739 doc: /* Sets size of FRAME to COLS by ROWS, measured in characters. */)
2740 (Lisp_Object frame, Lisp_Object cols, Lisp_Object rows)
2742 register struct frame *f;
2744 CHECK_LIVE_FRAME (frame);
2745 CHECK_NUMBER (cols);
2746 CHECK_NUMBER (rows);
2747 f = XFRAME (frame);
2749 /* I think this should be done with a hook. */
2750 #ifdef HAVE_WINDOW_SYSTEM
2751 if (FRAME_WINDOW_P (f))
2753 if (XINT (rows) != FRAME_LINES (f)
2754 || XINT (cols) != FRAME_COLS (f)
2755 || f->new_text_lines || f->new_text_cols)
2756 x_set_window_size (f, 1, XINT (cols), XINT (rows));
2757 do_pending_window_change (0);
2759 else
2760 #endif
2761 change_frame_size (f, XINT (rows), XINT (cols), 0, 0, 0);
2763 return Qnil;
2766 DEFUN ("set-frame-position", Fset_frame_position,
2767 Sset_frame_position, 3, 3, 0,
2768 doc: /* Sets position of FRAME in pixels to XOFFSET by YOFFSET.
2769 This is actually the position of the upper left corner of the frame.
2770 Negative values for XOFFSET or YOFFSET are interpreted relative to
2771 the rightmost or bottommost possible position (that stays within the screen). */)
2772 (Lisp_Object frame, Lisp_Object xoffset, Lisp_Object yoffset)
2774 register struct frame *f;
2776 CHECK_LIVE_FRAME (frame);
2777 CHECK_NUMBER (xoffset);
2778 CHECK_NUMBER (yoffset);
2779 f = XFRAME (frame);
2781 /* I think this should be done with a hook. */
2782 #ifdef HAVE_WINDOW_SYSTEM
2783 if (FRAME_WINDOW_P (f))
2784 x_set_offset (f, XINT (xoffset), XINT (yoffset), 1);
2785 #endif
2787 return Qt;
2791 /***********************************************************************
2792 Frame Parameters
2793 ***********************************************************************/
2795 /* Connect the frame-parameter names for X frames
2796 to the ways of passing the parameter values to the window system.
2798 The name of a parameter, as a Lisp symbol,
2799 has an `x-frame-parameter' property which is an integer in Lisp
2800 that is an index in this table. */
2802 struct frame_parm_table {
2803 const char *name;
2804 Lisp_Object *variable;
2807 static const struct frame_parm_table frame_parms[] =
2809 {"auto-raise", &Qauto_raise},
2810 {"auto-lower", &Qauto_lower},
2811 {"background-color", 0},
2812 {"border-color", &Qborder_color},
2813 {"border-width", &Qborder_width},
2814 {"cursor-color", &Qcursor_color},
2815 {"cursor-type", &Qcursor_type},
2816 {"font", 0},
2817 {"foreground-color", 0},
2818 {"icon-name", &Qicon_name},
2819 {"icon-type", &Qicon_type},
2820 {"internal-border-width", &Qinternal_border_width},
2821 {"menu-bar-lines", &Qmenu_bar_lines},
2822 {"mouse-color", &Qmouse_color},
2823 {"name", &Qname},
2824 {"scroll-bar-width", &Qscroll_bar_width},
2825 {"title", &Qtitle},
2826 {"unsplittable", &Qunsplittable},
2827 {"vertical-scroll-bars", &Qvertical_scroll_bars},
2828 {"visibility", &Qvisibility},
2829 {"tool-bar-lines", &Qtool_bar_lines},
2830 {"scroll-bar-foreground", &Qscroll_bar_foreground},
2831 {"scroll-bar-background", &Qscroll_bar_background},
2832 {"screen-gamma", &Qscreen_gamma},
2833 {"line-spacing", &Qline_spacing},
2834 {"left-fringe", &Qleft_fringe},
2835 {"right-fringe", &Qright_fringe},
2836 {"wait-for-wm", &Qwait_for_wm},
2837 {"fullscreen", &Qfullscreen},
2838 {"font-backend", &Qfont_backend},
2839 {"alpha", &Qalpha},
2840 {"sticky", &Qsticky},
2841 {"tool-bar-position", &Qtool_bar_position},
2844 #ifdef WINDOWSNT
2846 /* Calculate fullscreen size. Return in *TOP_POS and *LEFT_POS the
2847 wanted positions of the WM window (not Emacs window).
2848 Return in *WIDTH and *HEIGHT the wanted width and height of Emacs
2849 window (FRAME_X_WINDOW).
2852 void
2853 x_fullscreen_adjust (struct frame *f, int *width, int *height, int *top_pos, int *left_pos)
2855 int newwidth = FRAME_COLS (f);
2856 int newheight = FRAME_LINES (f);
2857 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2859 *top_pos = f->top_pos;
2860 *left_pos = f->left_pos;
2862 if (f->want_fullscreen & FULLSCREEN_HEIGHT)
2864 int ph;
2866 ph = x_display_pixel_height (dpyinfo);
2867 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2868 ph = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, newheight) - f->y_pixels_diff;
2869 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2870 *top_pos = 0;
2873 if (f->want_fullscreen & FULLSCREEN_WIDTH)
2875 int pw;
2877 pw = x_display_pixel_width (dpyinfo);
2878 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2879 pw = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, newwidth) - f->x_pixels_diff;
2880 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2881 *left_pos = 0;
2884 *width = newwidth;
2885 *height = newheight;
2888 #endif /* WINDOWSNT */
2890 #ifdef HAVE_WINDOW_SYSTEM
2892 /* Change the parameters of frame F as specified by ALIST.
2893 If a parameter is not specially recognized, do nothing special;
2894 otherwise call the `x_set_...' function for that parameter.
2895 Except for certain geometry properties, always call store_frame_param
2896 to store the new value in the parameter alist. */
2898 void
2899 x_set_frame_parameters (FRAME_PTR f, Lisp_Object alist)
2901 Lisp_Object tail;
2903 /* If both of these parameters are present, it's more efficient to
2904 set them both at once. So we wait until we've looked at the
2905 entire list before we set them. */
2906 int width, height;
2908 /* Same here. */
2909 Lisp_Object left, top;
2911 /* Same with these. */
2912 Lisp_Object icon_left, icon_top;
2914 /* Record in these vectors all the parms specified. */
2915 Lisp_Object *parms;
2916 Lisp_Object *values;
2917 size_t i, p;
2918 int left_no_change = 0, top_no_change = 0;
2919 int icon_left_no_change = 0, icon_top_no_change = 0;
2920 int size_changed = 0;
2921 struct gcpro gcpro1, gcpro2;
2923 i = 0;
2924 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
2925 i++;
2927 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
2928 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
2930 /* Extract parm names and values into those vectors. */
2932 i = 0;
2933 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2935 Lisp_Object elt;
2937 elt = XCAR (tail);
2938 parms[i] = Fcar (elt);
2939 values[i] = Fcdr (elt);
2940 i++;
2942 /* TAIL and ALIST are not used again below here. */
2943 alist = tail = Qnil;
2945 GCPRO2 (*parms, *values);
2946 gcpro1.nvars = i;
2947 gcpro2.nvars = i;
2949 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
2950 because their values appear in VALUES and strings are not valid. */
2951 top = left = Qunbound;
2952 icon_left = icon_top = Qunbound;
2954 /* Provide default values for HEIGHT and WIDTH. */
2955 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2956 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2958 /* Process foreground_color and background_color before anything else.
2959 They are independent of other properties, but other properties (e.g.,
2960 cursor_color) are dependent upon them. */
2961 /* Process default font as well, since fringe widths depends on it. */
2962 for (p = 0; p < i; p++)
2964 Lisp_Object prop, val;
2966 prop = parms[p];
2967 val = values[p];
2968 if (EQ (prop, Qforeground_color)
2969 || EQ (prop, Qbackground_color)
2970 || EQ (prop, Qfont))
2972 register Lisp_Object param_index, old_value;
2974 old_value = get_frame_param (f, prop);
2975 if (NILP (Fequal (val, old_value)))
2977 store_frame_param (f, prop, val);
2979 param_index = Fget (prop, Qx_frame_parameter);
2980 if (NATNUMP (param_index)
2981 && (XFASTINT (param_index)
2982 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2983 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
2984 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2989 /* Now process them in reverse of specified order. */
2990 while (i-- != 0)
2992 Lisp_Object prop, val;
2994 prop = parms[i];
2995 val = values[i];
2997 if (EQ (prop, Qwidth) && NATNUMP (val))
2999 size_changed = 1;
3000 width = XFASTINT (val);
3002 else if (EQ (prop, Qheight) && NATNUMP (val))
3004 size_changed = 1;
3005 height = XFASTINT (val);
3007 else if (EQ (prop, Qtop))
3008 top = val;
3009 else if (EQ (prop, Qleft))
3010 left = val;
3011 else if (EQ (prop, Qicon_top))
3012 icon_top = val;
3013 else if (EQ (prop, Qicon_left))
3014 icon_left = val;
3015 else if (EQ (prop, Qforeground_color)
3016 || EQ (prop, Qbackground_color)
3017 || EQ (prop, Qfont))
3018 /* Processed above. */
3019 continue;
3020 else
3022 register Lisp_Object param_index, old_value;
3024 old_value = get_frame_param (f, prop);
3026 store_frame_param (f, prop, val);
3028 param_index = Fget (prop, Qx_frame_parameter);
3029 if (NATNUMP (param_index)
3030 && (XFASTINT (param_index)
3031 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3032 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
3033 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
3037 /* Don't die if just one of these was set. */
3038 if (EQ (left, Qunbound))
3040 left_no_change = 1;
3041 if (f->left_pos < 0)
3042 left = Fcons (Qplus, Fcons (make_number (f->left_pos), Qnil));
3043 else
3044 XSETINT (left, f->left_pos);
3046 if (EQ (top, Qunbound))
3048 top_no_change = 1;
3049 if (f->top_pos < 0)
3050 top = Fcons (Qplus, Fcons (make_number (f->top_pos), Qnil));
3051 else
3052 XSETINT (top, f->top_pos);
3055 /* If one of the icon positions was not set, preserve or default it. */
3056 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
3058 icon_left_no_change = 1;
3059 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
3060 if (NILP (icon_left))
3061 XSETINT (icon_left, 0);
3063 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
3065 icon_top_no_change = 1;
3066 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
3067 if (NILP (icon_top))
3068 XSETINT (icon_top, 0);
3071 /* Don't set these parameters unless they've been explicitly
3072 specified. The window might be mapped or resized while we're in
3073 this function, and we don't want to override that unless the lisp
3074 code has asked for it.
3076 Don't set these parameters unless they actually differ from the
3077 window's current parameters; the window may not actually exist
3078 yet. */
3080 Lisp_Object frame;
3082 check_frame_size (f, &height, &width);
3084 XSETFRAME (frame, f);
3086 if (size_changed
3087 && (width != FRAME_COLS (f)
3088 || height != FRAME_LINES (f)
3089 || f->new_text_lines || f->new_text_cols))
3090 Fset_frame_size (frame, make_number (width), make_number (height));
3092 if ((!NILP (left) || !NILP (top))
3093 && ! (left_no_change && top_no_change)
3094 && ! (NUMBERP (left) && XINT (left) == f->left_pos
3095 && NUMBERP (top) && XINT (top) == f->top_pos))
3097 int leftpos = 0;
3098 int toppos = 0;
3100 /* Record the signs. */
3101 f->size_hint_flags &= ~ (XNegative | YNegative);
3102 if (EQ (left, Qminus))
3103 f->size_hint_flags |= XNegative;
3104 else if (INTEGERP (left))
3106 leftpos = XINT (left);
3107 if (leftpos < 0)
3108 f->size_hint_flags |= XNegative;
3110 else if (CONSP (left) && EQ (XCAR (left), Qminus)
3111 && CONSP (XCDR (left))
3112 && INTEGERP (XCAR (XCDR (left))))
3114 leftpos = - XINT (XCAR (XCDR (left)));
3115 f->size_hint_flags |= XNegative;
3117 else if (CONSP (left) && EQ (XCAR (left), Qplus)
3118 && CONSP (XCDR (left))
3119 && INTEGERP (XCAR (XCDR (left))))
3121 leftpos = XINT (XCAR (XCDR (left)));
3124 if (EQ (top, Qminus))
3125 f->size_hint_flags |= YNegative;
3126 else if (INTEGERP (top))
3128 toppos = XINT (top);
3129 if (toppos < 0)
3130 f->size_hint_flags |= YNegative;
3132 else if (CONSP (top) && EQ (XCAR (top), Qminus)
3133 && CONSP (XCDR (top))
3134 && INTEGERP (XCAR (XCDR (top))))
3136 toppos = - XINT (XCAR (XCDR (top)));
3137 f->size_hint_flags |= YNegative;
3139 else if (CONSP (top) && EQ (XCAR (top), Qplus)
3140 && CONSP (XCDR (top))
3141 && INTEGERP (XCAR (XCDR (top))))
3143 toppos = XINT (XCAR (XCDR (top)));
3147 /* Store the numeric value of the position. */
3148 f->top_pos = toppos;
3149 f->left_pos = leftpos;
3151 f->win_gravity = NorthWestGravity;
3153 /* Actually set that position, and convert to absolute. */
3154 x_set_offset (f, leftpos, toppos, -1);
3157 if ((!NILP (icon_left) || !NILP (icon_top))
3158 && ! (icon_left_no_change && icon_top_no_change))
3159 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
3162 UNGCPRO;
3166 /* Insert a description of internally-recorded parameters of frame X
3167 into the parameter alist *ALISTPTR that is to be given to the user.
3168 Only parameters that are specific to the X window system
3169 and whose values are not correctly recorded in the frame's
3170 param_alist need to be considered here. */
3172 void
3173 x_report_frame_params (struct frame *f, Lisp_Object *alistptr)
3175 char buf[16];
3176 Lisp_Object tem;
3178 /* Represent negative positions (off the top or left screen edge)
3179 in a way that Fmodify_frame_parameters will understand correctly. */
3180 XSETINT (tem, f->left_pos);
3181 if (f->left_pos >= 0)
3182 store_in_alist (alistptr, Qleft, tem);
3183 else
3184 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
3186 XSETINT (tem, f->top_pos);
3187 if (f->top_pos >= 0)
3188 store_in_alist (alistptr, Qtop, tem);
3189 else
3190 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
3192 store_in_alist (alistptr, Qborder_width,
3193 make_number (f->border_width));
3194 store_in_alist (alistptr, Qinternal_border_width,
3195 make_number (FRAME_INTERNAL_BORDER_WIDTH (f)));
3196 store_in_alist (alistptr, Qleft_fringe,
3197 make_number (FRAME_LEFT_FRINGE_WIDTH (f)));
3198 store_in_alist (alistptr, Qright_fringe,
3199 make_number (FRAME_RIGHT_FRINGE_WIDTH (f)));
3200 store_in_alist (alistptr, Qscroll_bar_width,
3201 (! FRAME_HAS_VERTICAL_SCROLL_BARS (f)
3202 ? make_number (0)
3203 : FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0
3204 ? make_number (FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3205 /* nil means "use default width"
3206 for non-toolkit scroll bar.
3207 ruler-mode.el depends on this. */
3208 : Qnil));
3209 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
3210 store_in_alist (alistptr, Qwindow_id,
3211 build_string (buf));
3212 #ifdef HAVE_X_WINDOWS
3213 #ifdef USE_X_TOOLKIT
3214 /* Tooltip frame may not have this widget. */
3215 if (FRAME_X_OUTPUT (f)->widget)
3216 #endif
3217 sprintf (buf, "%ld", (long) FRAME_OUTER_WINDOW (f));
3218 store_in_alist (alistptr, Qouter_window_id,
3219 build_string (buf));
3220 #endif
3221 store_in_alist (alistptr, Qicon_name, f->icon_name);
3222 FRAME_SAMPLE_VISIBILITY (f);
3223 store_in_alist (alistptr, Qvisibility,
3224 (FRAME_VISIBLE_P (f) ? Qt
3225 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
3226 store_in_alist (alistptr, Qdisplay,
3227 XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
3229 if (FRAME_X_OUTPUT (f)->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
3230 tem = Qnil;
3231 else
3232 XSETFASTINT (tem, FRAME_X_OUTPUT (f)->parent_desc);
3233 store_in_alist (alistptr, Qexplicit_name, (f->explicit_name ? Qt : Qnil));
3234 store_in_alist (alistptr, Qparent_id, tem);
3235 store_in_alist (alistptr, Qtool_bar_position, f->tool_bar_position);
3239 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
3240 the previous value of that parameter, NEW_VALUE is the new value. */
3242 void
3243 x_set_fullscreen (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3245 if (NILP (new_value))
3246 f->want_fullscreen = FULLSCREEN_NONE;
3247 else if (EQ (new_value, Qfullboth) || EQ (new_value, Qfullscreen))
3248 f->want_fullscreen = FULLSCREEN_BOTH;
3249 else if (EQ (new_value, Qfullwidth))
3250 f->want_fullscreen = FULLSCREEN_WIDTH;
3251 else if (EQ (new_value, Qfullheight))
3252 f->want_fullscreen = FULLSCREEN_HEIGHT;
3253 else if (EQ (new_value, Qmaximized))
3254 f->want_fullscreen = FULLSCREEN_MAXIMIZED;
3256 if (FRAME_TERMINAL (f)->fullscreen_hook != NULL)
3257 FRAME_TERMINAL (f)->fullscreen_hook (f);
3261 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
3262 the previous value of that parameter, NEW_VALUE is the new value. */
3264 void
3265 x_set_line_spacing (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3267 if (NILP (new_value))
3268 f->extra_line_spacing = 0;
3269 else if (NATNUMP (new_value))
3270 f->extra_line_spacing = XFASTINT (new_value);
3271 else
3272 signal_error ("Invalid line-spacing", new_value);
3273 if (FRAME_VISIBLE_P (f))
3274 redraw_frame (f);
3278 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
3279 the previous value of that parameter, NEW_VALUE is the new value. */
3281 void
3282 x_set_screen_gamma (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3284 Lisp_Object bgcolor;
3286 if (NILP (new_value))
3287 f->gamma = 0;
3288 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
3289 /* The value 0.4545 is the normal viewing gamma. */
3290 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
3291 else
3292 signal_error ("Invalid screen-gamma", new_value);
3294 /* Apply the new gamma value to the frame background. */
3295 bgcolor = Fassq (Qbackground_color, f->param_alist);
3296 if (CONSP (bgcolor) && (bgcolor = XCDR (bgcolor), STRINGP (bgcolor)))
3298 Lisp_Object parm_index = Fget (Qbackground_color, Qx_frame_parameter);
3299 if (NATNUMP (parm_index)
3300 && (XFASTINT (parm_index)
3301 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3302 && FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
3303 (*FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
3304 (f, bgcolor, Qnil);
3307 Fclear_face_cache (Qnil);
3311 void
3312 x_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3314 Lisp_Object font_object, font_param = Qnil;
3315 int fontset = -1;
3317 /* Set the frame parameter back to the old value because we may
3318 fail to use ARG as the new parameter value. */
3319 store_frame_param (f, Qfont, oldval);
3321 /* ARG is a fontset name, a font name, a cons of fontset name and a
3322 font object, or a font object. In the last case, this function
3323 never fail. */
3324 if (STRINGP (arg))
3326 font_param = arg;
3327 fontset = fs_query_fontset (arg, 0);
3328 if (fontset < 0)
3330 font_object = font_open_by_name (f, SSDATA (arg));
3331 if (NILP (font_object))
3332 error ("Font `%s' is not defined", SSDATA (arg));
3333 arg = AREF (font_object, FONT_NAME_INDEX);
3335 else if (fontset > 0)
3337 Lisp_Object ascii_font = fontset_ascii (fontset);
3339 font_object = font_open_by_name (f, SSDATA (ascii_font));
3340 if (NILP (font_object))
3341 error ("Font `%s' is not defined", SDATA (arg));
3342 arg = AREF (font_object, FONT_NAME_INDEX);
3344 else
3345 error ("The default fontset can't be used for a frame font");
3347 else if (CONSP (arg) && STRINGP (XCAR (arg)) && FONT_OBJECT_P (XCDR (arg)))
3349 /* This is the case that the ASCII font of F's fontset XCAR
3350 (arg) is changed to the font XCDR (arg) by
3351 `set-fontset-font'. */
3352 fontset = fs_query_fontset (XCAR (arg), 0);
3353 if (fontset < 0)
3354 error ("Unknown fontset: %s", SDATA (XCAR (arg)));
3355 font_object = XCDR (arg);
3356 arg = AREF (font_object, FONT_NAME_INDEX);
3357 font_param = Ffont_get (font_object, QCname);
3359 else if (FONT_OBJECT_P (arg))
3361 font_object = arg;
3362 font_param = Ffont_get (font_object, QCname);
3363 /* This is to store the XLFD font name in the frame parameter for
3364 backward compatibility. We should store the font-object
3365 itself in the future. */
3366 arg = AREF (font_object, FONT_NAME_INDEX);
3367 fontset = FRAME_FONTSET (f);
3368 /* Check if we can use the current fontset. If not, set FONTSET
3369 to -1 to generate a new fontset from FONT-OBJECT. */
3370 if (fontset >= 0)
3372 Lisp_Object ascii_font = fontset_ascii (fontset);
3373 Lisp_Object spec = font_spec_from_name (ascii_font);
3375 if (! font_match_p (spec, font_object))
3376 fontset = -1;
3379 else
3380 signal_error ("Invalid font", arg);
3382 if (! NILP (Fequal (font_object, oldval)))
3383 return;
3385 x_new_font (f, font_object, fontset);
3386 store_frame_param (f, Qfont, arg);
3387 #ifdef HAVE_X_WINDOWS
3388 store_frame_param (f, Qfont_param, font_param);
3389 #endif
3390 /* Recalculate toolbar height. */
3391 f->n_tool_bar_rows = 0;
3392 /* Ensure we redraw it. */
3393 clear_current_matrices (f);
3395 recompute_basic_faces (f);
3397 do_pending_window_change (0);
3399 /* We used to call face-set-after-frame-default here, but it leads to
3400 recursive calls (since that function can set the `default' face's
3401 font which in turns changes the frame's `font' parameter).
3402 Also I don't know what this call is meant to do, but it seems the
3403 wrong way to do it anyway (it does a lot more work than what seems
3404 reasonable in response to a change to `font'). */
3408 void
3409 x_set_font_backend (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3411 if (! NILP (new_value)
3412 && !CONSP (new_value))
3414 char *p0, *p1;
3416 CHECK_STRING (new_value);
3417 p0 = p1 = SSDATA (new_value);
3418 new_value = Qnil;
3419 while (*p0)
3421 while (*p1 && ! isspace (*p1) && *p1 != ',') p1++;
3422 if (p0 < p1)
3423 new_value = Fcons (Fintern (make_string (p0, p1 - p0), Qnil),
3424 new_value);
3425 if (*p1)
3427 int c;
3429 while ((c = *++p1) && isspace (c));
3431 p0 = p1;
3433 new_value = Fnreverse (new_value);
3436 if (! NILP (old_value) && ! NILP (Fequal (old_value, new_value)))
3437 return;
3439 if (FRAME_FONT (f))
3440 free_all_realized_faces (Qnil);
3442 new_value = font_update_drivers (f, NILP (new_value) ? Qt : new_value);
3443 if (NILP (new_value))
3445 if (NILP (old_value))
3446 error ("No font backend available");
3447 font_update_drivers (f, old_value);
3448 error ("None of specified font backends are available");
3450 store_frame_param (f, Qfont_backend, new_value);
3452 if (FRAME_FONT (f))
3454 Lisp_Object frame;
3456 XSETFRAME (frame, f);
3457 x_set_font (f, Fframe_parameter (frame, Qfont), Qnil);
3458 ++face_change_count;
3459 ++windows_or_buffers_changed;
3464 void
3465 x_set_fringe_width (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3467 compute_fringe_widths (f, 1);
3468 #ifdef HAVE_X_WINDOWS
3469 /* Must adjust this so window managers report correct number of columns. */
3470 if (FRAME_X_WINDOW (f) != 0)
3471 x_wm_set_size_hint (f, 0, 0);
3472 #endif
3475 void
3476 x_set_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3478 CHECK_NUMBER (arg);
3480 if (XINT (arg) == f->border_width)
3481 return;
3483 if (FRAME_X_WINDOW (f) != 0)
3484 error ("Cannot change the border width of a frame");
3486 f->border_width = XINT (arg);
3489 void
3490 x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3492 int old = FRAME_INTERNAL_BORDER_WIDTH (f);
3494 CHECK_NUMBER (arg);
3495 FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
3496 if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
3497 FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
3499 #ifdef USE_X_TOOLKIT
3500 if (FRAME_X_OUTPUT (f)->edit_widget)
3501 widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
3502 #endif
3504 if (FRAME_INTERNAL_BORDER_WIDTH (f) == old)
3505 return;
3507 if (FRAME_X_WINDOW (f) != 0)
3509 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3510 SET_FRAME_GARBAGED (f);
3511 do_pending_window_change (0);
3513 else
3514 SET_FRAME_GARBAGED (f);
3517 void
3518 x_set_visibility (struct frame *f, Lisp_Object value, Lisp_Object oldval)
3520 Lisp_Object frame;
3521 XSETFRAME (frame, f);
3523 if (NILP (value))
3524 Fmake_frame_invisible (frame, Qt);
3525 else if (EQ (value, Qicon))
3526 Ficonify_frame (frame);
3527 else
3528 Fmake_frame_visible (frame);
3531 void
3532 x_set_autoraise (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3534 f->auto_raise = !EQ (Qnil, arg);
3537 void
3538 x_set_autolower (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3540 f->auto_lower = !EQ (Qnil, arg);
3543 void
3544 x_set_unsplittable (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3546 f->no_split = !NILP (arg);
3549 void
3550 x_set_vertical_scroll_bars (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3552 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
3553 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
3554 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
3555 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
3557 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
3558 = (NILP (arg)
3559 ? vertical_scroll_bar_none
3560 : EQ (Qleft, arg)
3561 ? vertical_scroll_bar_left
3562 : EQ (Qright, arg)
3563 ? vertical_scroll_bar_right
3564 : EQ (Qleft, Vdefault_frame_scroll_bars)
3565 ? vertical_scroll_bar_left
3566 : EQ (Qright, Vdefault_frame_scroll_bars)
3567 ? vertical_scroll_bar_right
3568 : vertical_scroll_bar_none);
3570 /* We set this parameter before creating the X window for the
3571 frame, so we can get the geometry right from the start.
3572 However, if the window hasn't been created yet, we shouldn't
3573 call x_set_window_size. */
3574 if (FRAME_X_WINDOW (f))
3575 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3576 do_pending_window_change (0);
3580 void
3581 x_set_scroll_bar_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3583 int wid = FRAME_COLUMN_WIDTH (f);
3585 if (NILP (arg))
3587 x_set_scroll_bar_default_width (f);
3589 if (FRAME_X_WINDOW (f))
3590 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3591 do_pending_window_change (0);
3593 else if (INTEGERP (arg) && XINT (arg) > 0
3594 && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3596 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
3597 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
3599 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg);
3600 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
3601 if (FRAME_X_WINDOW (f))
3602 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3603 do_pending_window_change (0);
3606 change_frame_size (f, 0, FRAME_COLS (f), 0, 0, 0);
3607 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
3608 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
3613 /* Return non-nil if frame F wants a bitmap icon. */
3615 Lisp_Object
3616 x_icon_type (FRAME_PTR f)
3618 Lisp_Object tem;
3620 tem = assq_no_quit (Qicon_type, f->param_alist);
3621 if (CONSP (tem))
3622 return XCDR (tem);
3623 else
3624 return Qnil;
3627 void
3628 x_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3630 double alpha = 1.0;
3631 double newval[2];
3632 int i, ialpha;
3633 Lisp_Object item;
3635 for (i = 0; i < 2; i++)
3637 newval[i] = 1.0;
3638 if (CONSP (arg))
3640 item = CAR (arg);
3641 arg = CDR (arg);
3643 else
3644 item = arg;
3646 if (NILP (item))
3647 alpha = - 1.0;
3648 else if (FLOATP (item))
3650 alpha = XFLOAT_DATA (item);
3651 if (alpha < 0.0 || 1.0 < alpha)
3652 args_out_of_range (make_float (0.0), make_float (1.0));
3654 else if (INTEGERP (item))
3656 ialpha = XINT (item);
3657 if (ialpha < 0 || 100 < ialpha)
3658 args_out_of_range (make_number (0), make_number (100));
3659 else
3660 alpha = ialpha / 100.0;
3662 else
3663 wrong_type_argument (Qnumberp, item);
3664 newval[i] = alpha;
3667 for (i = 0; i < 2; i++)
3668 f->alpha[i] = newval[i];
3670 #if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA)
3671 BLOCK_INPUT;
3672 x_set_frame_alpha (f);
3673 UNBLOCK_INPUT;
3674 #endif
3676 return;
3680 /* Subroutines of creating an X frame. */
3682 /* Make sure that Vx_resource_name is set to a reasonable value.
3683 Fix it up, or set it to `emacs' if it is too hopeless. */
3685 void
3686 validate_x_resource_name (void)
3688 int len = 0;
3689 /* Number of valid characters in the resource name. */
3690 int good_count = 0;
3691 /* Number of invalid characters in the resource name. */
3692 int bad_count = 0;
3693 Lisp_Object new;
3694 int i;
3696 if (!STRINGP (Vx_resource_class))
3697 Vx_resource_class = build_string (EMACS_CLASS);
3699 if (STRINGP (Vx_resource_name))
3701 unsigned char *p = SDATA (Vx_resource_name);
3703 len = SBYTES (Vx_resource_name);
3705 /* Only letters, digits, - and _ are valid in resource names.
3706 Count the valid characters and count the invalid ones. */
3707 for (i = 0; i < len; i++)
3709 int c = p[i];
3710 if (! ((c >= 'a' && c <= 'z')
3711 || (c >= 'A' && c <= 'Z')
3712 || (c >= '0' && c <= '9')
3713 || c == '-' || c == '_'))
3714 bad_count++;
3715 else
3716 good_count++;
3719 else
3720 /* Not a string => completely invalid. */
3721 bad_count = 5, good_count = 0;
3723 /* If name is valid already, return. */
3724 if (bad_count == 0)
3725 return;
3727 /* If name is entirely invalid, or nearly so, use `emacs'. */
3728 if (good_count < 2)
3730 Vx_resource_name = build_string ("emacs");
3731 return;
3734 /* Name is partly valid. Copy it and replace the invalid characters
3735 with underscores. */
3737 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
3739 for (i = 0; i < len; i++)
3741 int c = SREF (new, i);
3742 if (! ((c >= 'a' && c <= 'z')
3743 || (c >= 'A' && c <= 'Z')
3744 || (c >= '0' && c <= '9')
3745 || c == '-' || c == '_'))
3746 SSET (new, i, '_');
3751 extern char *x_get_string_resource (XrmDatabase, const char *, const char *);
3752 extern Display_Info *check_x_display_info (Lisp_Object);
3755 /* Get specified attribute from resource database RDB.
3756 See Fx_get_resource below for other parameters. */
3758 static Lisp_Object
3759 xrdb_get_resource (XrmDatabase rdb, Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3761 register char *value;
3762 char *name_key;
3763 char *class_key;
3765 CHECK_STRING (attribute);
3766 CHECK_STRING (class);
3768 if (!NILP (component))
3769 CHECK_STRING (component);
3770 if (!NILP (subclass))
3771 CHECK_STRING (subclass);
3772 if (NILP (component) != NILP (subclass))
3773 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3775 validate_x_resource_name ();
3777 /* Allocate space for the components, the dots which separate them,
3778 and the final '\0'. Make them big enough for the worst case. */
3779 name_key = (char *) alloca (SBYTES (Vx_resource_name)
3780 + (STRINGP (component)
3781 ? SBYTES (component) : 0)
3782 + SBYTES (attribute)
3783 + 3);
3785 class_key = (char *) alloca (SBYTES (Vx_resource_class)
3786 + SBYTES (class)
3787 + (STRINGP (subclass)
3788 ? SBYTES (subclass) : 0)
3789 + 3);
3791 /* Start with emacs.FRAMENAME for the name (the specific one)
3792 and with `Emacs' for the class key (the general one). */
3793 strcpy (name_key, SSDATA (Vx_resource_name));
3794 strcpy (class_key, SSDATA (Vx_resource_class));
3796 strcat (class_key, ".");
3797 strcat (class_key, SSDATA (class));
3799 if (!NILP (component))
3801 strcat (class_key, ".");
3802 strcat (class_key, SSDATA (subclass));
3804 strcat (name_key, ".");
3805 strcat (name_key, SSDATA (component));
3808 strcat (name_key, ".");
3809 strcat (name_key, SSDATA (attribute));
3811 value = x_get_string_resource (rdb, name_key, class_key);
3813 if (value != (char *) 0 && *value)
3814 return build_string (value);
3815 else
3816 return Qnil;
3820 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
3821 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
3822 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
3823 class, where INSTANCE is the name under which Emacs was invoked, or
3824 the name specified by the `-name' or `-rn' command-line arguments.
3826 The optional arguments COMPONENT and SUBCLASS add to the key and the
3827 class, respectively. You must specify both of them or neither.
3828 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
3829 and the class is `Emacs.CLASS.SUBCLASS'. */)
3830 (Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3832 #ifdef HAVE_X_WINDOWS
3833 check_x ();
3834 #endif
3836 return xrdb_get_resource (check_x_display_info (Qnil)->xrdb,
3837 attribute, class, component, subclass);
3840 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
3842 Lisp_Object
3843 display_x_get_resource (Display_Info *dpyinfo, Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3845 return xrdb_get_resource (dpyinfo->xrdb,
3846 attribute, class, component, subclass);
3849 #if defined HAVE_X_WINDOWS && !defined USE_X_TOOLKIT
3850 /* Used when C code wants a resource value. */
3851 /* Called from oldXMenu/Create.c. */
3852 char *
3853 x_get_resource_string (const char *attribute, const char *class)
3855 char *name_key;
3856 char *class_key;
3857 struct frame *sf = SELECTED_FRAME ();
3859 /* Allocate space for the components, the dots which separate them,
3860 and the final '\0'. */
3861 name_key = (char *) alloca (SBYTES (Vinvocation_name)
3862 + strlen (attribute) + 2);
3863 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
3864 + strlen (class) + 2);
3866 sprintf (name_key, "%s.%s", SSDATA (Vinvocation_name), attribute);
3867 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3869 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
3870 name_key, class_key);
3872 #endif
3874 /* Return the value of parameter PARAM.
3876 First search ALIST, then Vdefault_frame_alist, then the X defaults
3877 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3879 Convert the resource to the type specified by desired_type.
3881 If no default is specified, return Qunbound. If you call
3882 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3883 and don't let it get stored in any Lisp-visible variables! */
3885 Lisp_Object
3886 x_get_arg (Display_Info *dpyinfo, Lisp_Object alist, Lisp_Object param,
3887 const char *attribute, const char *class, enum resource_types type)
3889 register Lisp_Object tem;
3891 tem = Fassq (param, alist);
3893 if (!NILP (tem))
3895 /* If we find this parm in ALIST, clear it out
3896 so that it won't be "left over" at the end. */
3897 Lisp_Object tail;
3898 XSETCAR (tem, Qnil);
3899 /* In case the parameter appears more than once in the alist,
3900 clear it out. */
3901 for (tail = alist; CONSP (tail); tail = XCDR (tail))
3902 if (CONSP (XCAR (tail))
3903 && EQ (XCAR (XCAR (tail)), param))
3904 XSETCAR (XCAR (tail), Qnil);
3906 else
3907 tem = Fassq (param, Vdefault_frame_alist);
3909 /* If it wasn't specified in ALIST or the Lisp-level defaults,
3910 look in the X resources. */
3911 if (EQ (tem, Qnil))
3913 if (attribute && dpyinfo)
3915 tem = display_x_get_resource (dpyinfo,
3916 build_string (attribute),
3917 build_string (class),
3918 Qnil, Qnil);
3920 if (NILP (tem))
3921 return Qunbound;
3923 switch (type)
3925 case RES_TYPE_NUMBER:
3926 return make_number (atoi (SSDATA (tem)));
3928 case RES_TYPE_BOOLEAN_NUMBER:
3929 if (!strcmp (SSDATA (tem), "on")
3930 || !strcmp (SSDATA (tem), "true"))
3931 return make_number (1);
3932 return make_number (atoi (SSDATA (tem)));
3933 break;
3935 case RES_TYPE_FLOAT:
3936 return make_float (atof (SSDATA (tem)));
3938 case RES_TYPE_BOOLEAN:
3939 tem = Fdowncase (tem);
3940 if (!strcmp (SSDATA (tem), "on")
3941 #ifdef HAVE_NS
3942 || !strcmp (SSDATA (tem), "yes")
3943 #endif
3944 || !strcmp (SSDATA (tem), "true"))
3945 return Qt;
3946 else
3947 return Qnil;
3949 case RES_TYPE_STRING:
3950 return tem;
3952 case RES_TYPE_SYMBOL:
3953 /* As a special case, we map the values `true' and `on'
3954 to Qt, and `false' and `off' to Qnil. */
3956 Lisp_Object lower;
3957 lower = Fdowncase (tem);
3958 if (!strcmp (SSDATA (lower), "on")
3959 #ifdef HAVE_NS
3960 || !strcmp (SSDATA (lower), "yes")
3961 #endif
3962 || !strcmp (SSDATA (lower), "true"))
3963 return Qt;
3964 else if (!strcmp (SSDATA (lower), "off")
3965 #ifdef HAVE_NS
3966 || !strcmp (SSDATA (lower), "no")
3967 #endif
3968 || !strcmp (SSDATA (lower), "false"))
3969 return Qnil;
3970 else
3971 return Fintern (tem, Qnil);
3974 default:
3975 abort ();
3978 else
3979 return Qunbound;
3981 return Fcdr (tem);
3984 static Lisp_Object
3985 x_frame_get_arg (struct frame *f, Lisp_Object alist, Lisp_Object param,
3986 const char *attribute, const char *class,
3987 enum resource_types type)
3989 return x_get_arg (FRAME_X_DISPLAY_INFO (f),
3990 alist, param, attribute, class, type);
3993 /* Like x_frame_get_arg, but also record the value in f->param_alist. */
3995 Lisp_Object
3996 x_frame_get_and_record_arg (struct frame *f, Lisp_Object alist,
3997 Lisp_Object param,
3998 const char *attribute, const char *class,
3999 enum resource_types type)
4001 Lisp_Object value;
4003 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
4004 attribute, class, type);
4005 if (! NILP (value) && ! EQ (value, Qunbound))
4006 store_frame_param (f, param, value);
4008 return value;
4012 /* Record in frame F the specified or default value according to ALIST
4013 of the parameter named PROP (a Lisp symbol).
4014 If no value is specified for PROP, look for an X default for XPROP
4015 on the frame named NAME.
4016 If that is not found either, use the value DEFLT. */
4018 Lisp_Object
4019 x_default_parameter (struct frame *f, Lisp_Object alist, Lisp_Object prop,
4020 Lisp_Object deflt, const char *xprop, const char *xclass,
4021 enum resource_types type)
4023 Lisp_Object tem;
4025 tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type);
4026 if (EQ (tem, Qunbound))
4027 tem = deflt;
4028 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
4029 return tem;
4035 /* NS used to define x-parse-geometry in ns-win.el, but that confused
4036 make-docfile: the documentation string in ns-win.el was used for
4037 x-parse-geometry even in non-NS builds.
4039 With two definitions of x-parse-geometry in this file, various
4040 things still get confused (eg M-x apropos documentation), so that
4041 it is best if the two definitions just share the same doc-string.
4043 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
4044 doc: /* Parse a display geometry string STRING.
4045 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
4046 The properties returned may include `top', `left', `height', and `width'.
4047 For X, the value of `left' or `top' may be an integer,
4048 or a list (+ N) meaning N pixels relative to top/left corner,
4049 or a list (- N) meaning -N pixels relative to bottom/right corner.
4050 On Nextstep, this just calls `ns-parse-geometry'. */)
4051 (Lisp_Object string)
4053 #ifdef HAVE_NS
4054 call1 (Qns_parse_geometry, string);
4055 #else
4056 int geometry, x, y;
4057 unsigned int width, height;
4058 Lisp_Object result;
4060 CHECK_STRING (string);
4062 geometry = XParseGeometry (SSDATA (string),
4063 &x, &y, &width, &height);
4064 result = Qnil;
4065 if (geometry & XValue)
4067 Lisp_Object element;
4069 if (x >= 0 && (geometry & XNegative))
4070 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
4071 else if (x < 0 && ! (geometry & XNegative))
4072 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
4073 else
4074 element = Fcons (Qleft, make_number (x));
4075 result = Fcons (element, result);
4078 if (geometry & YValue)
4080 Lisp_Object element;
4082 if (y >= 0 && (geometry & YNegative))
4083 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
4084 else if (y < 0 && ! (geometry & YNegative))
4085 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
4086 else
4087 element = Fcons (Qtop, make_number (y));
4088 result = Fcons (element, result);
4091 if (geometry & WidthValue)
4092 result = Fcons (Fcons (Qwidth, make_number (width)), result);
4093 if (geometry & HeightValue)
4094 result = Fcons (Fcons (Qheight, make_number (height)), result);
4096 return result;
4097 #endif /* HAVE_NS */
4101 /* Calculate the desired size and position of frame F.
4102 Return the flags saying which aspects were specified.
4104 Also set the win_gravity and size_hint_flags of F.
4106 Adjust height for toolbar if TOOLBAR_P is 1.
4108 This function does not make the coordinates positive. */
4110 #define DEFAULT_ROWS 35
4111 #define DEFAULT_COLS 80
4114 x_figure_window_size (struct frame *f, Lisp_Object parms, int toolbar_p)
4116 register Lisp_Object tem0, tem1, tem2;
4117 long window_prompting = 0;
4118 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
4120 /* Default values if we fall through.
4121 Actually, if that happens we should get
4122 window manager prompting. */
4123 SET_FRAME_COLS (f, DEFAULT_COLS);
4124 FRAME_LINES (f) = DEFAULT_ROWS;
4125 /* Window managers expect that if program-specified
4126 positions are not (0,0), they're intentional, not defaults. */
4127 f->top_pos = 0;
4128 f->left_pos = 0;
4130 /* Ensure that old new_text_cols and new_text_lines will not override the
4131 values set here. */
4132 /* ++KFS: This was specific to W32, but seems ok for all platforms */
4133 f->new_text_cols = f->new_text_lines = 0;
4135 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
4136 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
4137 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
4138 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4140 if (!EQ (tem0, Qunbound))
4142 CHECK_NUMBER (tem0);
4143 FRAME_LINES (f) = XINT (tem0);
4145 if (!EQ (tem1, Qunbound))
4147 CHECK_NUMBER (tem1);
4148 SET_FRAME_COLS (f, XINT (tem1));
4150 if (!NILP (tem2) && !EQ (tem2, Qunbound))
4151 window_prompting |= USSize;
4152 else
4153 window_prompting |= PSize;
4156 f->scroll_bar_actual_width
4157 = FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f);
4159 /* This used to be done _before_ calling x_figure_window_size, but
4160 since the height is reset here, this was really a no-op. I
4161 assume that moving it here does what Gerd intended (although he
4162 no longer can remember what that was... ++KFS, 2003-03-25. */
4164 /* Add the tool-bar height to the initial frame height so that the
4165 user gets a text display area of the size he specified with -g or
4166 via .Xdefaults. Later changes of the tool-bar height don't
4167 change the frame size. This is done so that users can create
4168 tall Emacs frames without having to guess how tall the tool-bar
4169 will get. */
4170 if (toolbar_p && FRAME_TOOL_BAR_LINES (f))
4172 int margin, relief, bar_height;
4174 relief = (tool_bar_button_relief >= 0
4175 ? tool_bar_button_relief
4176 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
4178 if (INTEGERP (Vtool_bar_button_margin)
4179 && XINT (Vtool_bar_button_margin) > 0)
4180 margin = XFASTINT (Vtool_bar_button_margin);
4181 else if (CONSP (Vtool_bar_button_margin)
4182 && INTEGERP (XCDR (Vtool_bar_button_margin))
4183 && XINT (XCDR (Vtool_bar_button_margin)) > 0)
4184 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
4185 else
4186 margin = 0;
4188 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
4189 FRAME_LINES (f) += (bar_height + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f);
4192 compute_fringe_widths (f, 0);
4194 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, FRAME_COLS (f));
4195 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, FRAME_LINES (f));
4197 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
4198 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
4199 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
4200 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4202 if (EQ (tem0, Qminus))
4204 f->top_pos = 0;
4205 window_prompting |= YNegative;
4207 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
4208 && CONSP (XCDR (tem0))
4209 && INTEGERP (XCAR (XCDR (tem0))))
4211 f->top_pos = - XINT (XCAR (XCDR (tem0)));
4212 window_prompting |= YNegative;
4214 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
4215 && CONSP (XCDR (tem0))
4216 && INTEGERP (XCAR (XCDR (tem0))))
4218 f->top_pos = XINT (XCAR (XCDR (tem0)));
4220 else if (EQ (tem0, Qunbound))
4221 f->top_pos = 0;
4222 else
4224 CHECK_NUMBER (tem0);
4225 f->top_pos = XINT (tem0);
4226 if (f->top_pos < 0)
4227 window_prompting |= YNegative;
4230 if (EQ (tem1, Qminus))
4232 f->left_pos = 0;
4233 window_prompting |= XNegative;
4235 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
4236 && CONSP (XCDR (tem1))
4237 && INTEGERP (XCAR (XCDR (tem1))))
4239 f->left_pos = - XINT (XCAR (XCDR (tem1)));
4240 window_prompting |= XNegative;
4242 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
4243 && CONSP (XCDR (tem1))
4244 && INTEGERP (XCAR (XCDR (tem1))))
4246 f->left_pos = XINT (XCAR (XCDR (tem1)));
4248 else if (EQ (tem1, Qunbound))
4249 f->left_pos = 0;
4250 else
4252 CHECK_NUMBER (tem1);
4253 f->left_pos = XINT (tem1);
4254 if (f->left_pos < 0)
4255 window_prompting |= XNegative;
4258 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
4259 window_prompting |= USPosition;
4260 else
4261 window_prompting |= PPosition;
4264 if (window_prompting & XNegative)
4266 if (window_prompting & YNegative)
4267 f->win_gravity = SouthEastGravity;
4268 else
4269 f->win_gravity = NorthEastGravity;
4271 else
4273 if (window_prompting & YNegative)
4274 f->win_gravity = SouthWestGravity;
4275 else
4276 f->win_gravity = NorthWestGravity;
4279 f->size_hint_flags = window_prompting;
4281 return window_prompting;
4286 #endif /* HAVE_WINDOW_SYSTEM */
4288 void
4289 frame_make_pointer_invisible (void)
4291 if (! NILP (Vmake_pointer_invisible))
4293 struct frame *f;
4294 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4295 return;
4297 f = SELECTED_FRAME ();
4298 if (f && !f->pointer_invisible
4299 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4301 f->mouse_moved = 0;
4302 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 1);
4303 f->pointer_invisible = 1;
4308 void
4309 frame_make_pointer_visible (void)
4311 /* We don't check Vmake_pointer_invisible here in case the
4312 pointer was invisible when Vmake_pointer_invisible was set to nil. */
4313 struct frame *f;
4315 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4316 return;
4318 f = SELECTED_FRAME ();
4319 if (f && f->pointer_invisible && f->mouse_moved
4320 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4322 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 0);
4323 f->pointer_invisible = 0;
4327 DEFUN ("frame-pointer-visible-p", Fframe_pointer_visible_p,
4328 Sframe_pointer_visible_p, 0, 1, 0,
4329 doc: /* Return t if the mouse pointer displayed on FRAME is visible.
4330 Otherwise it returns nil. FRAME omitted or nil means the
4331 selected frame. This is useful when `make-pointer-invisible' is set. */)
4332 (Lisp_Object frame)
4334 if (NILP (frame))
4335 frame = selected_frame;
4337 CHECK_FRAME (frame);
4339 return (XFRAME (frame)->pointer_invisible ? Qnil : Qt);
4343 /***********************************************************************
4344 Initialization
4345 ***********************************************************************/
4347 void
4348 syms_of_frame (void)
4350 Qframep = intern_c_string ("framep");
4351 staticpro (&Qframep);
4352 Qframe_live_p = intern_c_string ("frame-live-p");
4353 staticpro (&Qframe_live_p);
4354 Qexplicit_name = intern_c_string ("explicit-name");
4355 staticpro (&Qexplicit_name);
4356 Qheight = intern_c_string ("height");
4357 staticpro (&Qheight);
4358 Qicon = intern_c_string ("icon");
4359 staticpro (&Qicon);
4360 Qminibuffer = intern_c_string ("minibuffer");
4361 staticpro (&Qminibuffer);
4362 Qmodeline = intern_c_string ("modeline");
4363 staticpro (&Qmodeline);
4364 Qonly = intern_c_string ("only");
4365 staticpro (&Qonly);
4366 Qwidth = intern_c_string ("width");
4367 staticpro (&Qwidth);
4368 Qgeometry = intern_c_string ("geometry");
4369 staticpro (&Qgeometry);
4370 Qicon_left = intern_c_string ("icon-left");
4371 staticpro (&Qicon_left);
4372 Qicon_top = intern_c_string ("icon-top");
4373 staticpro (&Qicon_top);
4374 Qtooltip = intern_c_string ("tooltip");
4375 staticpro (&Qtooltip);
4376 Qleft = intern_c_string ("left");
4377 staticpro (&Qleft);
4378 Qright = intern_c_string ("right");
4379 staticpro (&Qright);
4380 Quser_position = intern_c_string ("user-position");
4381 staticpro (&Quser_position);
4382 Quser_size = intern_c_string ("user-size");
4383 staticpro (&Quser_size);
4384 Qwindow_id = intern_c_string ("window-id");
4385 staticpro (&Qwindow_id);
4386 #ifdef HAVE_X_WINDOWS
4387 Qouter_window_id = intern_c_string ("outer-window-id");
4388 staticpro (&Qouter_window_id);
4389 #endif
4390 Qparent_id = intern_c_string ("parent-id");
4391 staticpro (&Qparent_id);
4392 Qx = intern_c_string ("x");
4393 staticpro (&Qx);
4394 Qw32 = intern_c_string ("w32");
4395 staticpro (&Qw32);
4396 Qpc = intern_c_string ("pc");
4397 staticpro (&Qpc);
4398 Qmac = intern_c_string ("mac");
4399 staticpro (&Qmac);
4400 Qns = intern_c_string ("ns");
4401 staticpro (&Qns);
4402 Qvisible = intern_c_string ("visible");
4403 staticpro (&Qvisible);
4404 Qbuffer_predicate = intern_c_string ("buffer-predicate");
4405 staticpro (&Qbuffer_predicate);
4406 Qbuffer_list = intern_c_string ("buffer-list");
4407 staticpro (&Qbuffer_list);
4408 Qburied_buffer_list = intern_c_string ("buried-buffer-list");
4409 staticpro (&Qburied_buffer_list);
4410 Qdisplay_type = intern_c_string ("display-type");
4411 staticpro (&Qdisplay_type);
4412 Qbackground_mode = intern_c_string ("background-mode");
4413 staticpro (&Qbackground_mode);
4414 Qnoelisp = intern_c_string ("noelisp");
4415 staticpro (&Qnoelisp);
4416 Qtty_color_mode = intern_c_string ("tty-color-mode");
4417 staticpro (&Qtty_color_mode);
4418 Qtty = intern_c_string ("tty");
4419 staticpro (&Qtty);
4420 Qtty_type = intern_c_string ("tty-type");
4421 staticpro (&Qtty_type);
4423 Qface_set_after_frame_default = intern_c_string ("face-set-after-frame-default");
4424 staticpro (&Qface_set_after_frame_default);
4426 Qfullwidth = intern_c_string ("fullwidth");
4427 staticpro (&Qfullwidth);
4428 Qfullheight = intern_c_string ("fullheight");
4429 staticpro (&Qfullheight);
4430 Qfullboth = intern_c_string ("fullboth");
4431 staticpro (&Qfullboth);
4432 Qmaximized = intern_c_string ("maximized");
4433 staticpro (&Qmaximized);
4434 Qx_resource_name = intern_c_string ("x-resource-name");
4435 staticpro (&Qx_resource_name);
4437 Qx_frame_parameter = intern_c_string ("x-frame-parameter");
4438 staticpro (&Qx_frame_parameter);
4440 Qterminal = intern_c_string ("terminal");
4441 staticpro (&Qterminal);
4442 Qterminal_live_p = intern_c_string ("terminal-live-p");
4443 staticpro (&Qterminal_live_p);
4445 #ifdef HAVE_NS
4446 Qns_parse_geometry = intern_c_string ("ns-parse-geometry");
4447 staticpro (&Qns_parse_geometry);
4448 #endif
4451 int i;
4453 for (i = 0; i < sizeof (frame_parms) / sizeof (frame_parms[0]); i++)
4455 Lisp_Object v = intern_c_string (frame_parms[i].name);
4456 if (frame_parms[i].variable)
4458 *frame_parms[i].variable = v;
4459 staticpro (frame_parms[i].variable);
4461 Fput (v, Qx_frame_parameter, make_number (i));
4465 #ifdef HAVE_WINDOW_SYSTEM
4466 DEFVAR_LISP ("x-resource-name", Vx_resource_name,
4467 doc: /* The name Emacs uses to look up X resources.
4468 `x-get-resource' uses this as the first component of the instance name
4469 when requesting resource values.
4470 Emacs initially sets `x-resource-name' to the name under which Emacs
4471 was invoked, or to the value specified with the `-name' or `-rn'
4472 switches, if present.
4474 It may be useful to bind this variable locally around a call
4475 to `x-get-resource'. See also the variable `x-resource-class'. */);
4476 Vx_resource_name = Qnil;
4478 DEFVAR_LISP ("x-resource-class", Vx_resource_class,
4479 doc: /* The class Emacs uses to look up X resources.
4480 `x-get-resource' uses this as the first component of the instance class
4481 when requesting resource values.
4483 Emacs initially sets `x-resource-class' to "Emacs".
4485 Setting this variable permanently is not a reasonable thing to do,
4486 but binding this variable locally around a call to `x-get-resource'
4487 is a reasonable practice. See also the variable `x-resource-name'. */);
4488 Vx_resource_class = build_string (EMACS_CLASS);
4490 DEFVAR_LISP ("frame-alpha-lower-limit", Vframe_alpha_lower_limit,
4491 doc: /* The lower limit of the frame opacity (alpha transparency).
4492 The value should range from 0 (invisible) to 100 (completely opaque).
4493 You can also use a floating number between 0.0 and 1.0.
4494 The default is 20. */);
4495 Vframe_alpha_lower_limit = make_number (20);
4496 #endif
4498 DEFVAR_LISP ("default-frame-alist", Vdefault_frame_alist,
4499 doc: /* Alist of default values for frame creation.
4500 These may be set in your init file, like this:
4501 (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1)))
4502 These override values given in window system configuration data,
4503 including X Windows' defaults database.
4504 For values specific to the first Emacs frame, see `initial-frame-alist'.
4505 For window-system specific values, see `window-system-default-frame-alist'.
4506 For values specific to the separate minibuffer frame, see
4507 `minibuffer-frame-alist'.
4508 The `menu-bar-lines' element of the list controls whether new frames
4509 have menu bars; `menu-bar-mode' works by altering this element.
4510 Setting this variable does not affect existing frames, only new ones. */);
4511 Vdefault_frame_alist = Qnil;
4513 DEFVAR_LISP ("default-frame-scroll-bars", Vdefault_frame_scroll_bars,
4514 doc: /* Default position of scroll bars on this window-system. */);
4515 #ifdef HAVE_WINDOW_SYSTEM
4516 #if defined(HAVE_NTGUI) || defined(NS_IMPL_COCOA) || (defined(USE_GTK) && defined(USE_TOOLKIT_SCROLL_BARS))
4517 /* MS-Windows, Mac OS X, and GTK have scroll bars on the right by
4518 default. */
4519 Vdefault_frame_scroll_bars = Qright;
4520 #else
4521 Vdefault_frame_scroll_bars = Qleft;
4522 #endif
4523 #else
4524 Vdefault_frame_scroll_bars = Qnil;
4525 #endif
4527 DEFVAR_LISP ("terminal-frame", Vterminal_frame,
4528 doc: /* The initial frame-object, which represents Emacs's stdout. */);
4530 DEFVAR_LISP ("mouse-position-function", Vmouse_position_function,
4531 doc: /* If non-nil, function to transform normal value of `mouse-position'.
4532 `mouse-position' calls this function, passing its usual return value as
4533 argument, and returns whatever this function returns.
4534 This abnormal hook exists for the benefit of packages like `xt-mouse.el'
4535 which need to do mouse handling at the Lisp level. */);
4536 Vmouse_position_function = Qnil;
4538 DEFVAR_LISP ("mouse-highlight", Vmouse_highlight,
4539 doc: /* If non-nil, clickable text is highlighted when mouse is over it.
4540 If the value is an integer, highlighting is only shown after moving the
4541 mouse, while keyboard input turns off the highlight even when the mouse
4542 is over the clickable text. However, the mouse shape still indicates
4543 when the mouse is over clickable text. */);
4544 Vmouse_highlight = Qt;
4546 DEFVAR_LISP ("make-pointer-invisible", Vmake_pointer_invisible,
4547 doc: /* If non-nil, make pointer invisible while typing.
4548 The pointer becomes visible again when the mouse is moved. */);
4549 Vmake_pointer_invisible = Qt;
4551 DEFVAR_LISP ("delete-frame-functions", Vdelete_frame_functions,
4552 doc: /* Functions to be run before deleting a frame.
4553 The functions are run with one arg, the frame to be deleted.
4554 See `delete-frame'.
4556 Note that functions in this list may be called just before the frame is
4557 actually deleted, or some time later (or even both when an earlier function
4558 in `delete-frame-functions' (indirectly) calls `delete-frame'
4559 recursively). */);
4560 Vdelete_frame_functions = Qnil;
4561 Qdelete_frame_functions = intern_c_string ("delete-frame-functions");
4562 staticpro (&Qdelete_frame_functions);
4564 DEFVAR_LISP ("menu-bar-mode", Vmenu_bar_mode,
4565 doc: /* Non-nil if Menu-Bar mode is enabled.
4566 See the command `menu-bar-mode' for a description of this minor mode.
4567 Setting this variable directly does not take effect;
4568 either customize it (see the info node `Easy Customization')
4569 or call the function `menu-bar-mode'. */);
4570 Vmenu_bar_mode = Qt;
4572 DEFVAR_LISP ("tool-bar-mode", Vtool_bar_mode,
4573 doc: /* Non-nil if Tool-Bar mode is enabled.
4574 See the command `tool-bar-mode' for a description of this minor mode.
4575 Setting this variable directly does not take effect;
4576 either customize it (see the info node `Easy Customization')
4577 or call the function `tool-bar-mode'. */);
4578 #ifdef HAVE_WINDOW_SYSTEM
4579 Vtool_bar_mode = Qt;
4580 #else
4581 Vtool_bar_mode = Qnil;
4582 #endif
4584 DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
4585 doc: /* Minibufferless frames use this frame's minibuffer.
4587 Emacs cannot create minibufferless frames unless this is set to an
4588 appropriate surrogate.
4590 Emacs consults this variable only when creating minibufferless
4591 frames; once the frame is created, it sticks with its assigned
4592 minibuffer, no matter what this variable is set to. This means that
4593 this variable doesn't necessarily say anything meaningful about the
4594 current set of frames, or where the minibuffer is currently being
4595 displayed.
4597 This variable is local to the current terminal and cannot be buffer-local. */);
4599 DEFVAR_BOOL ("focus-follows-mouse", focus_follows_mouse,
4600 doc: /* Non-nil if window system changes focus when you move the mouse.
4601 You should set this variable to tell Emacs how your window manager
4602 handles focus, since there is no way in general for Emacs to find out
4603 automatically. See also `mouse-autoselect-window'. */);
4604 focus_follows_mouse = 0;
4606 staticpro (&Vframe_list);
4608 defsubr (&Sactive_minibuffer_window);
4609 defsubr (&Sframep);
4610 defsubr (&Sframe_live_p);
4611 defsubr (&Swindow_system);
4612 defsubr (&Smake_terminal_frame);
4613 defsubr (&Shandle_switch_frame);
4614 defsubr (&Sselect_frame);
4615 defsubr (&Sselected_frame);
4616 defsubr (&Swindow_frame);
4617 defsubr (&Sframe_root_window);
4618 defsubr (&Sframe_first_window);
4619 defsubr (&Sframe_selected_window);
4620 defsubr (&Sset_frame_selected_window);
4621 defsubr (&Sframe_list);
4622 defsubr (&Snext_frame);
4623 defsubr (&Sprevious_frame);
4624 defsubr (&Sdelete_frame);
4625 defsubr (&Smouse_position);
4626 defsubr (&Smouse_pixel_position);
4627 defsubr (&Sset_mouse_position);
4628 defsubr (&Sset_mouse_pixel_position);
4629 #if 0
4630 defsubr (&Sframe_configuration);
4631 defsubr (&Srestore_frame_configuration);
4632 #endif
4633 defsubr (&Smake_frame_visible);
4634 defsubr (&Smake_frame_invisible);
4635 defsubr (&Siconify_frame);
4636 defsubr (&Sframe_visible_p);
4637 defsubr (&Svisible_frame_list);
4638 defsubr (&Sraise_frame);
4639 defsubr (&Slower_frame);
4640 defsubr (&Sredirect_frame_focus);
4641 defsubr (&Sframe_focus);
4642 defsubr (&Sframe_parameters);
4643 defsubr (&Sframe_parameter);
4644 defsubr (&Smodify_frame_parameters);
4645 defsubr (&Sframe_char_height);
4646 defsubr (&Sframe_char_width);
4647 defsubr (&Sframe_pixel_height);
4648 defsubr (&Sframe_pixel_width);
4649 defsubr (&Stool_bar_pixel_width);
4650 defsubr (&Sset_frame_height);
4651 defsubr (&Sset_frame_width);
4652 defsubr (&Sset_frame_size);
4653 defsubr (&Sset_frame_position);
4654 defsubr (&Sframe_pointer_visible_p);
4656 #ifdef HAVE_WINDOW_SYSTEM
4657 defsubr (&Sx_get_resource);
4658 defsubr (&Sx_parse_geometry);
4659 #endif