* lisp/env.el (env--substitute-vars-regexp): Don't use rx (for bootstrap).
[emacs.git] / src / frame.c
blob52be8be270ea6004a09022322b14600395ea4878
1 /* Generic frame functions.
3 Copyright (C) 1993-1995, 1997, 1999-2012 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 #define FRAME_INLINE EXTERN_INLINE
24 #include <stdio.h>
25 #include <errno.h>
26 #include <limits.h>
28 #include <c-ctype.h>
30 #include "lisp.h"
31 #include "character.h"
33 #ifdef HAVE_WINDOW_SYSTEM
34 #include TERM_HEADER
35 #endif /* HAVE_WINDOW_SYSTEM */
37 #include "buffer.h"
38 /* These help us bind and responding to switch-frame events. */
39 #include "commands.h"
40 #include "keyboard.h"
41 #include "frame.h"
42 #include "blockinput.h"
43 #include "termchar.h"
44 #include "termhooks.h"
45 #include "dispextern.h"
46 #include "window.h"
47 #include "font.h"
48 #ifdef HAVE_WINDOW_SYSTEM
49 #include "fontset.h"
50 #endif
51 #ifdef MSDOS
52 #include "msdos.h"
53 #include "dosfns.h"
54 #endif
56 #ifdef HAVE_NS
57 Lisp_Object Qns_parse_geometry;
58 #endif
60 Lisp_Object Qframep, Qframe_live_p;
61 Lisp_Object Qicon, Qmodeline;
62 Lisp_Object Qonly, Qnone;
63 Lisp_Object Qx, Qw32, Qmac, Qpc, Qns;
64 Lisp_Object Qvisible;
65 Lisp_Object Qdisplay_type;
66 static Lisp_Object Qbackground_mode;
67 Lisp_Object Qnoelisp;
69 static Lisp_Object Qx_frame_parameter;
70 Lisp_Object Qx_resource_name;
71 Lisp_Object Qterminal;
72 Lisp_Object Qterminal_live_p;
74 /* Frame parameters (set or reported). */
76 Lisp_Object Qauto_raise, Qauto_lower;
77 Lisp_Object Qborder_color, Qborder_width;
78 Lisp_Object Qcursor_color, Qcursor_type;
79 static Lisp_Object Qgeometry; /* Not used */
80 Lisp_Object Qheight, Qwidth;
81 Lisp_Object Qleft, Qright;
82 Lisp_Object Qicon_left, Qicon_top, Qicon_type, Qicon_name;
83 Lisp_Object Qtooltip;
84 Lisp_Object Qinternal_border_width;
85 Lisp_Object Qmouse_color;
86 Lisp_Object Qminibuffer;
87 Lisp_Object Qscroll_bar_width, Qvertical_scroll_bars;
88 Lisp_Object Qvisibility;
89 Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
90 Lisp_Object Qscreen_gamma;
91 Lisp_Object Qline_spacing;
92 static Lisp_Object Quser_position, Quser_size;
93 Lisp_Object Qwait_for_wm;
94 static Lisp_Object Qwindow_id;
95 #ifdef HAVE_X_WINDOWS
96 static Lisp_Object Qouter_window_id;
97 #endif
98 Lisp_Object Qparent_id;
99 Lisp_Object Qtitle, Qname;
100 static Lisp_Object Qexplicit_name;
101 Lisp_Object Qunsplittable;
102 Lisp_Object Qmenu_bar_lines, Qtool_bar_lines, Qtool_bar_position;
103 Lisp_Object Qleft_fringe, Qright_fringe;
104 Lisp_Object Qbuffer_predicate;
105 static Lisp_Object Qbuffer_list, Qburied_buffer_list;
106 Lisp_Object Qtty_color_mode;
107 Lisp_Object Qtty, Qtty_type;
109 Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth, Qmaximized;
110 Lisp_Object Qsticky;
111 Lisp_Object Qfont_backend;
112 Lisp_Object Qalpha;
114 Lisp_Object Qface_set_after_frame_default;
116 static Lisp_Object Qdelete_frame_functions;
118 #ifdef HAVE_WINDOW_SYSTEM
119 static void x_report_frame_params (struct frame *, Lisp_Object *);
120 #endif
122 /* These setters are used only in this file, so they can be private. */
123 static void
124 fset_buffer_predicate (struct frame *f, Lisp_Object val)
126 f->buffer_predicate = val;
128 static void
129 fset_minibuffer_window (struct frame *f, Lisp_Object val)
131 f->minibuffer_window = val;
134 struct frame *
135 decode_live_frame (register Lisp_Object frame)
137 if (NILP (frame))
138 frame = selected_frame;
139 CHECK_LIVE_FRAME (frame);
140 return XFRAME (frame);
143 struct frame *
144 decode_any_frame (register Lisp_Object frame)
146 if (NILP (frame))
147 frame = selected_frame;
148 CHECK_FRAME (frame);
149 return XFRAME (frame);
152 static void
153 set_menu_bar_lines_1 (Lisp_Object window, int n)
155 struct window *w = XWINDOW (window);
157 w->last_modified = 0;
158 wset_top_line (w, make_number (XFASTINT (w->top_line) + n));
159 wset_total_lines (w, make_number (XFASTINT (w->total_lines) - n));
161 /* Handle just the top child in a vertical split. */
162 if (!NILP (w->vchild))
163 set_menu_bar_lines_1 (w->vchild, n);
165 /* Adjust all children in a horizontal split. */
166 for (window = w->hchild; !NILP (window); window = w->next)
168 w = XWINDOW (window);
169 set_menu_bar_lines_1 (window, n);
173 void
174 set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
176 int nlines;
177 int olines = FRAME_MENU_BAR_LINES (f);
179 /* Right now, menu bars don't work properly in minibuf-only frames;
180 most of the commands try to apply themselves to the minibuffer
181 frame itself, and get an error because you can't switch buffers
182 in or split the minibuffer window. */
183 if (FRAME_MINIBUF_ONLY_P (f))
184 return;
186 if (TYPE_RANGED_INTEGERP (int, value))
187 nlines = XINT (value);
188 else
189 nlines = 0;
191 if (nlines != olines)
193 windows_or_buffers_changed++;
194 FRAME_WINDOW_SIZES_CHANGED (f) = 1;
195 FRAME_MENU_BAR_LINES (f) = nlines;
196 set_menu_bar_lines_1 (f->root_window, nlines - olines);
197 adjust_glyphs (f);
201 Lisp_Object Vframe_list;
204 DEFUN ("framep", Fframep, Sframep, 1, 1, 0,
205 doc: /* Return non-nil if OBJECT is a frame.
206 Value is:
207 t for a termcap frame (a character-only terminal),
208 'x' for an Emacs frame that is really an X window,
209 'w32' for an Emacs frame that is a window on MS-Windows display,
210 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
211 'pc' for a direct-write MS-DOS frame.
212 See also `frame-live-p'. */)
213 (Lisp_Object object)
215 if (!FRAMEP (object))
216 return Qnil;
217 switch (XFRAME (object)->output_method)
219 case output_initial: /* The initial frame is like a termcap frame. */
220 case output_termcap:
221 return Qt;
222 case output_x_window:
223 return Qx;
224 case output_w32:
225 return Qw32;
226 case output_msdos_raw:
227 return Qpc;
228 case output_mac:
229 return Qmac;
230 case output_ns:
231 return Qns;
232 default:
233 emacs_abort ();
237 DEFUN ("frame-live-p", Fframe_live_p, Sframe_live_p, 1, 1, 0,
238 doc: /* Return non-nil if OBJECT is a frame which has not been deleted.
239 Value is nil if OBJECT is not a live frame. If object is a live
240 frame, the return value indicates what sort of terminal device it is
241 displayed on. See the documentation of `framep' for possible
242 return values. */)
243 (Lisp_Object object)
245 return ((FRAMEP (object)
246 && FRAME_LIVE_P (XFRAME (object)))
247 ? Fframep (object)
248 : Qnil);
251 DEFUN ("window-system", Fwindow_system, Swindow_system, 0, 1, 0,
252 doc: /* The name of the window system that FRAME is displaying through.
253 The value is a symbol:
254 nil for a termcap frame (a character-only terminal),
255 'x' for an Emacs frame that is really an X window,
256 'w32' for an Emacs frame that is a window on MS-Windows display,
257 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
258 'pc' for a direct-write MS-DOS frame.
260 FRAME defaults to the currently selected frame.
262 Use of this function as a predicate is deprecated. Instead,
263 use `display-graphic-p' or any of the other `display-*-p'
264 predicates which report frame's specific UI-related capabilities. */)
265 (Lisp_Object frame)
267 Lisp_Object type;
268 if (NILP (frame))
269 frame = selected_frame;
271 type = Fframep (frame);
273 if (NILP (type))
274 wrong_type_argument (Qframep, frame);
276 if (EQ (type, Qt))
277 return Qnil;
278 else
279 return type;
282 struct frame *
283 make_frame (int mini_p)
285 Lisp_Object frame;
286 register struct frame *f;
287 register Lisp_Object root_window;
288 register Lisp_Object mini_window;
290 f = allocate_frame ();
291 XSETFRAME (frame, f);
293 /* Initialize Lisp data. Note that allocate_frame initializes all
294 Lisp data to nil, so do it only for slots which should not be nil. */
295 fset_tool_bar_position (f, Qtop);
297 /* Initialize non-Lisp data. Note that allocate_frame zeroes out all
298 non-Lisp data, so do it only for slots which should not be zero.
299 To avoid subtle bugs and for the sake of readability, it's better to
300 initialize enum members explicitly even if their values are zero. */
301 f->wants_modeline = 1;
302 f->garbaged = 1;
303 f->has_minibuffer = mini_p;
304 f->vertical_scroll_bar_type = vertical_scroll_bar_none;
305 f->column_width = 1; /* !FRAME_WINDOW_P value */
306 f->line_height = 1; /* !FRAME_WINDOW_P value */
307 #ifdef HAVE_WINDOW_SYSTEM
308 f->want_fullscreen = FULLSCREEN_NONE;
309 #endif
311 root_window = make_window ();
312 if (mini_p)
314 mini_window = make_window ();
315 wset_next (XWINDOW (root_window), mini_window);
316 wset_prev (XWINDOW (mini_window), root_window);
317 XWINDOW (mini_window)->mini = 1;
318 wset_frame (XWINDOW (mini_window), frame);
319 fset_minibuffer_window (f, mini_window);
321 else
323 mini_window = Qnil;
324 wset_next (XWINDOW (root_window), Qnil);
325 fset_minibuffer_window (f, Qnil);
328 wset_frame (XWINDOW (root_window), frame);
330 /* 10 is arbitrary,
331 just so that there is "something there."
332 Correct size will be set up later with change_frame_size. */
334 SET_FRAME_COLS (f, 10);
335 FRAME_LINES (f) = 10;
337 wset_total_cols (XWINDOW (root_window), make_number (10));
338 wset_total_lines (XWINDOW (root_window), make_number (mini_p ? 9 : 10));
340 if (mini_p)
342 wset_total_cols (XWINDOW (mini_window), make_number (10));
343 wset_top_line (XWINDOW (mini_window), make_number (9));
344 wset_total_lines (XWINDOW (mini_window), make_number (1));
347 /* Choose a buffer for the frame's root window. */
349 Lisp_Object buf;
351 wset_buffer (XWINDOW (root_window), Qt);
352 buf = Fcurrent_buffer ();
353 /* If buf is a 'hidden' buffer (i.e. one whose name starts with
354 a space), try to find another one. */
355 if (SREF (Fbuffer_name (buf), 0) == ' ')
356 buf = other_buffer_safely (buf);
358 /* Use set_window_buffer, not Fset_window_buffer, and don't let
359 hooks be run by it. The reason is that the whole frame/window
360 arrangement is not yet fully initialized at this point. Windows
361 don't have the right size, glyph matrices aren't initialized
362 etc. Running Lisp functions at this point surely ends in a
363 SEGV. */
364 set_window_buffer (root_window, buf, 0, 0);
365 fset_buffer_list (f, Fcons (buf, Qnil));
368 if (mini_p)
370 wset_buffer (XWINDOW (mini_window), Qt);
371 set_window_buffer (mini_window,
372 (NILP (Vminibuffer_list)
373 ? get_minibuffer (0)
374 : Fcar (Vminibuffer_list)),
375 0, 0);
378 fset_root_window (f, root_window);
379 fset_selected_window (f, root_window);
380 /* Make sure this window seems more recently used than
381 a newly-created, never-selected window. */
382 XWINDOW (f->selected_window)->use_time = ++window_select_count;
384 return f;
387 #ifdef HAVE_WINDOW_SYSTEM
388 /* Make a frame using a separate minibuffer window on another frame.
389 MINI_WINDOW is the minibuffer window to use. nil means use the
390 default (the global minibuffer). */
392 struct frame *
393 make_frame_without_minibuffer (register Lisp_Object mini_window, KBOARD *kb, Lisp_Object display)
395 register struct frame *f;
396 struct gcpro gcpro1;
398 if (!NILP (mini_window))
399 CHECK_LIVE_WINDOW (mini_window);
401 if (!NILP (mini_window)
402 && FRAME_KBOARD (XFRAME (XWINDOW (mini_window)->frame)) != kb)
403 error ("Frame and minibuffer must be on the same terminal");
405 /* Make a frame containing just a root window. */
406 f = make_frame (0);
408 if (NILP (mini_window))
410 /* Use default-minibuffer-frame if possible. */
411 if (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
412 || ! FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))
414 Lisp_Object frame_dummy;
416 XSETFRAME (frame_dummy, f);
417 GCPRO1 (frame_dummy);
418 /* If there's no minibuffer frame to use, create one. */
419 kset_default_minibuffer_frame
420 (kb, call1 (intern ("make-initial-minibuffer-frame"), display));
421 UNGCPRO;
424 mini_window
425 = XFRAME (KVAR (kb, Vdefault_minibuffer_frame))->minibuffer_window;
428 fset_minibuffer_window (f, mini_window);
430 /* Make the chosen minibuffer window display the proper minibuffer,
431 unless it is already showing a minibuffer. */
432 if (NILP (Fmemq (XWINDOW (mini_window)->buffer, Vminibuffer_list)))
433 /* Use set_window_buffer instead of Fset_window_buffer (see
434 discussion of bug#11984, bug#12025, bug#12026). */
435 set_window_buffer (mini_window,
436 (NILP (Vminibuffer_list)
437 ? get_minibuffer (0)
438 : Fcar (Vminibuffer_list)), 0, 0);
439 return f;
442 /* Make a frame containing only a minibuffer window. */
444 struct frame *
445 make_minibuffer_frame (void)
447 /* First make a frame containing just a root window, no minibuffer. */
449 register struct frame *f = make_frame (0);
450 register Lisp_Object mini_window;
451 register Lisp_Object frame;
453 XSETFRAME (frame, f);
455 f->auto_raise = 0;
456 f->auto_lower = 0;
457 f->no_split = 1;
458 f->wants_modeline = 0;
459 f->has_minibuffer = 1;
461 /* Now label the root window as also being the minibuffer.
462 Avoid infinite looping on the window chain by marking next pointer
463 as nil. */
465 mini_window = f->root_window;
466 fset_minibuffer_window (f, mini_window);
467 XWINDOW (mini_window)->mini = 1;
468 wset_next (XWINDOW (mini_window), Qnil);
469 wset_prev (XWINDOW (mini_window), Qnil);
470 wset_frame (XWINDOW (mini_window), frame);
472 /* Put the proper buffer in that window. */
474 /* Use set_window_buffer instead of Fset_window_buffer (see
475 discussion of bug#11984, bug#12025, bug#12026). */
476 set_window_buffer (mini_window,
477 (NILP (Vminibuffer_list)
478 ? get_minibuffer (0)
479 : Fcar (Vminibuffer_list)), 0, 0);
480 return f;
482 #endif /* HAVE_WINDOW_SYSTEM */
484 /* Construct a frame that refers to a terminal. */
486 static printmax_t tty_frame_count;
488 struct frame *
489 make_initial_frame (void)
491 struct frame *f;
492 struct terminal *terminal;
493 Lisp_Object frame;
495 eassert (initial_kboard);
497 /* The first call must initialize Vframe_list. */
498 if (! (NILP (Vframe_list) || CONSP (Vframe_list)))
499 Vframe_list = Qnil;
501 terminal = init_initial_terminal ();
503 f = make_frame (1);
504 XSETFRAME (frame, f);
506 Vframe_list = Fcons (frame, Vframe_list);
508 tty_frame_count = 1;
509 fset_name (f, build_pure_c_string ("F1"));
511 f->visible = 1;
512 f->async_visible = 1;
514 f->output_method = terminal->type;
515 f->terminal = terminal;
516 f->terminal->reference_count++;
517 f->output_data.nothing = 0;
519 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
520 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
522 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
524 /* The default value of menu-bar-mode is t. */
525 set_menu_bar_lines (f, make_number (1), Qnil);
527 if (!noninteractive)
528 init_frame_faces (f);
530 return f;
534 static struct frame *
535 make_terminal_frame (struct terminal *terminal)
537 register struct frame *f;
538 Lisp_Object frame;
539 char name[sizeof "F" + INT_STRLEN_BOUND (printmax_t)];
541 if (!terminal->name)
542 error ("Terminal is not live, can't create new frames on it");
544 f = make_frame (1);
546 XSETFRAME (frame, f);
547 Vframe_list = Fcons (frame, Vframe_list);
549 fset_name (f, make_formatted_string (name, "F%"pMd, ++tty_frame_count));
551 f->visible = 1; /* FRAME_SET_VISIBLE wd set frame_garbaged. */
552 f->async_visible = 1; /* Don't let visible be cleared later. */
553 f->terminal = terminal;
554 f->terminal->reference_count++;
555 #ifdef MSDOS
556 f->output_data.tty->display_info = &the_only_display_info;
557 if (!inhibit_window_system
558 && (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame))
559 || XFRAME (selected_frame)->output_method == output_msdos_raw))
560 f->output_method = output_msdos_raw;
561 else
562 f->output_method = output_termcap;
563 #else /* not MSDOS */
564 f->output_method = output_termcap;
565 create_tty_output (f);
566 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
567 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
568 #endif /* not MSDOS */
570 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
571 FRAME_MENU_BAR_LINES(f) = NILP (Vmenu_bar_mode) ? 0 : 1;
573 /* Set the top frame to the newly created frame. */
574 if (FRAMEP (FRAME_TTY (f)->top_frame)
575 && FRAME_LIVE_P (XFRAME (FRAME_TTY (f)->top_frame)))
576 XFRAME (FRAME_TTY (f)->top_frame)->async_visible = 2; /* obscured */
578 FRAME_TTY (f)->top_frame = frame;
580 if (!noninteractive)
581 init_frame_faces (f);
583 return f;
586 /* Get a suitable value for frame parameter PARAMETER for a newly
587 created frame, based on (1) the user-supplied frame parameter
588 alist SUPPLIED_PARMS, and (2) CURRENT_VALUE. */
590 static Lisp_Object
591 get_future_frame_param (Lisp_Object parameter,
592 Lisp_Object supplied_parms,
593 char *current_value)
595 Lisp_Object result;
597 result = Fassq (parameter, supplied_parms);
598 if (NILP (result))
599 result = Fassq (parameter, XFRAME (selected_frame)->param_alist);
600 if (NILP (result) && current_value != NULL)
601 result = build_string (current_value);
602 if (!NILP (result) && !STRINGP (result))
603 result = XCDR (result);
604 if (NILP (result) || !STRINGP (result))
605 result = Qnil;
607 return result;
610 DEFUN ("make-terminal-frame", Fmake_terminal_frame, Smake_terminal_frame,
611 1, 1, 0,
612 doc: /* Create an additional terminal frame, possibly on another terminal.
613 This function takes one argument, an alist specifying frame parameters.
615 You can create multiple frames on a single text terminal, but only one
616 of them (the selected terminal frame) is actually displayed.
618 In practice, generally you don't need to specify any parameters,
619 except when you want to create a new frame on another terminal.
620 In that case, the `tty' parameter specifies the device file to open,
621 and the `tty-type' parameter specifies the terminal type. Example:
623 (make-terminal-frame '((tty . "/dev/pts/5") (tty-type . "xterm")))
625 Note that changing the size of one terminal frame automatically
626 affects all frames on the same terminal device. */)
627 (Lisp_Object parms)
629 struct frame *f;
630 struct terminal *t = NULL;
631 Lisp_Object frame, tem;
632 struct frame *sf = SELECTED_FRAME ();
634 #ifdef MSDOS
635 if (sf->output_method != output_msdos_raw
636 && sf->output_method != output_termcap)
637 emacs_abort ();
638 #else /* not MSDOS */
640 #ifdef WINDOWSNT /* This should work now! */
641 if (sf->output_method != output_termcap)
642 error ("Not using an ASCII terminal now; cannot make a new ASCII frame");
643 #endif
644 #endif /* not MSDOS */
647 Lisp_Object terminal;
649 terminal = Fassq (Qterminal, parms);
650 if (CONSP (terminal))
652 terminal = XCDR (terminal);
653 t = get_terminal (terminal, 1);
655 #ifdef MSDOS
656 if (t && t != the_only_display_info.terminal)
657 /* msdos.c assumes a single tty_display_info object. */
658 error ("Multiple terminals are not supported on this platform");
659 if (!t)
660 t = the_only_display_info.terminal;
661 #endif
664 if (!t)
666 char *name = 0, *type = 0;
667 Lisp_Object tty, tty_type;
669 tty = get_future_frame_param
670 (Qtty, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
671 ? FRAME_TTY (XFRAME (selected_frame))->name
672 : NULL));
673 if (!NILP (tty))
675 name = alloca (SBYTES (tty) + 1);
676 memcpy (name, SSDATA (tty), SBYTES (tty));
677 name[SBYTES (tty)] = 0;
680 tty_type = get_future_frame_param
681 (Qtty_type, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
682 ? FRAME_TTY (XFRAME (selected_frame))->type
683 : NULL));
684 if (!NILP (tty_type))
686 type = alloca (SBYTES (tty_type) + 1);
687 memcpy (type, SSDATA (tty_type), SBYTES (tty_type));
688 type[SBYTES (tty_type)] = 0;
691 t = init_tty (name, type, 0); /* Errors are not fatal. */
694 f = make_terminal_frame (t);
697 int width, height;
698 get_tty_size (fileno (FRAME_TTY (f)->input), &width, &height);
699 change_frame_size (f, height, width, 0, 0, 0);
702 adjust_glyphs (f);
703 calculate_costs (f);
704 XSETFRAME (frame, f);
705 Fmodify_frame_parameters (frame, parms);
706 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty_type,
707 build_string (t->display_info.tty->type)),
708 Qnil));
709 if (t->display_info.tty->name != NULL)
710 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty,
711 build_string (t->display_info.tty->name)),
712 Qnil));
713 else
714 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty, Qnil), Qnil));
716 /* Make the frame face alist be frame-specific, so that each
717 frame could change its face definitions independently. */
718 fset_face_alist (f, Fcopy_alist (sf->face_alist));
719 /* Simple Fcopy_alist isn't enough, because we need the contents of
720 the vectors which are the CDRs of associations in face_alist to
721 be copied as well. */
722 for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem))
723 XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem))));
724 return frame;
728 /* Perform the switch to frame FRAME.
730 If FRAME is a switch-frame event `(switch-frame FRAME1)', use
731 FRAME1 as frame.
733 If TRACK is non-zero and the frame that currently has the focus
734 redirects its focus to the selected frame, redirect that focused
735 frame's focus to FRAME instead.
737 FOR_DELETION non-zero means that the selected frame is being
738 deleted, which includes the possibility that the frame's terminal
739 is dead.
741 The value of NORECORD is passed as argument to Fselect_window. */
743 Lisp_Object
744 do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object norecord)
746 struct frame *sf = SELECTED_FRAME ();
748 /* If FRAME is a switch-frame event, extract the frame we should
749 switch to. */
750 if (CONSP (frame)
751 && EQ (XCAR (frame), Qswitch_frame)
752 && CONSP (XCDR (frame)))
753 frame = XCAR (XCDR (frame));
755 /* This used to say CHECK_LIVE_FRAME, but apparently it's possible for
756 a switch-frame event to arrive after a frame is no longer live,
757 especially when deleting the initial frame during startup. */
758 CHECK_FRAME (frame);
759 if (! FRAME_LIVE_P (XFRAME (frame)))
760 return Qnil;
762 if (sf == XFRAME (frame))
763 return frame;
765 /* This is too greedy; it causes inappropriate focus redirection
766 that's hard to get rid of. */
767 #if 0
768 /* If a frame's focus has been redirected toward the currently
769 selected frame, we should change the redirection to point to the
770 newly selected frame. This means that if the focus is redirected
771 from a minibufferless frame to a surrogate minibuffer frame, we
772 can use `other-window' to switch between all the frames using
773 that minibuffer frame, and the focus redirection will follow us
774 around. */
775 if (track)
777 Lisp_Object tail;
779 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
781 Lisp_Object focus;
783 if (!FRAMEP (XCAR (tail)))
784 emacs_abort ();
786 focus = FRAME_FOCUS_FRAME (XFRAME (XCAR (tail)));
788 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
789 Fredirect_frame_focus (XCAR (tail), frame);
792 #else /* ! 0 */
793 /* Instead, apply it only to the frame we're pointing to. */
794 #ifdef HAVE_WINDOW_SYSTEM
795 if (track && FRAME_WINDOW_P (XFRAME (frame)))
797 Lisp_Object focus, xfocus;
799 xfocus = x_get_focus_frame (XFRAME (frame));
800 if (FRAMEP (xfocus))
802 focus = FRAME_FOCUS_FRAME (XFRAME (xfocus));
803 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
804 Fredirect_frame_focus (xfocus, frame);
807 #endif /* HAVE_X_WINDOWS */
808 #endif /* ! 0 */
810 if (!for_deletion && FRAME_HAS_MINIBUF_P (sf))
811 resize_mini_window (XWINDOW (FRAME_MINIBUF_WINDOW (sf)), 1);
813 if (FRAME_TERMCAP_P (XFRAME (frame)) || FRAME_MSDOS_P (XFRAME (frame)))
815 if (FRAMEP (FRAME_TTY (XFRAME (frame))->top_frame))
816 /* Mark previously displayed frame as now obscured. */
817 XFRAME (FRAME_TTY (XFRAME (frame))->top_frame)->async_visible = 2;
818 XFRAME (frame)->async_visible = 1;
819 FRAME_TTY (XFRAME (frame))->top_frame = frame;
822 selected_frame = frame;
823 if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
824 last_nonminibuf_frame = XFRAME (selected_frame);
826 Fselect_window (XFRAME (frame)->selected_window, norecord);
828 /* We want to make sure that the next event generates a frame-switch
829 event to the appropriate frame. This seems kludgy to me, but
830 before you take it out, make sure that evaluating something like
831 (select-window (frame-root-window (new-frame))) doesn't end up
832 with your typing being interpreted in the new frame instead of
833 the one you're actually typing in. */
834 internal_last_event_frame = Qnil;
836 return frame;
839 DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 2, "e",
840 doc: /* Select FRAME.
841 Subsequent editing commands apply to its selected window.
842 Optional argument NORECORD means to neither change the order of
843 recently selected windows nor the buffer list.
845 The selection of FRAME lasts until the next time the user does
846 something to select a different frame, or until the next time
847 this function is called. If you are using a window system, the
848 previously selected frame may be restored as the selected frame
849 when returning to the command loop, because it still may have
850 the window system's input focus. On a text terminal, the next
851 redisplay will display FRAME.
853 This function returns FRAME, or nil if FRAME has been deleted. */)
854 (Lisp_Object frame, Lisp_Object norecord)
856 return do_switch_frame (frame, 1, 0, norecord);
860 DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 1, "e",
861 doc: /* Handle a switch-frame event EVENT.
862 Switch-frame events are usually bound to this function.
863 A switch-frame event tells Emacs that the window manager has requested
864 that the user's events be directed to the frame mentioned in the event.
865 This function selects the selected window of the frame of EVENT.
867 If EVENT is frame object, handle it as if it were a switch-frame event
868 to that frame. */)
869 (Lisp_Object event)
871 /* Preserve prefix arg that the command loop just cleared. */
872 kset_prefix_arg (current_kboard, Vcurrent_prefix_arg);
873 Frun_hooks (1, &Qmouse_leave_buffer_hook);
874 return do_switch_frame (event, 0, 0, Qnil);
877 DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0,
878 doc: /* Return the frame that is now selected. */)
879 (void)
881 return selected_frame;
884 DEFUN ("frame-list", Fframe_list, Sframe_list,
885 0, 0, 0,
886 doc: /* Return a list of all live frames. */)
887 (void)
889 Lisp_Object frames;
890 frames = Fcopy_sequence (Vframe_list);
891 #ifdef HAVE_WINDOW_SYSTEM
892 if (FRAMEP (tip_frame))
893 frames = Fdelq (tip_frame, frames);
894 #endif
895 return frames;
898 /* Return the next frame in the frame list after FRAME.
899 If MINIBUF is nil, exclude minibuffer-only frames.
900 If MINIBUF is a window, include only its own frame
901 and any frame now using that window as the minibuffer.
902 If MINIBUF is `visible', include all visible frames.
903 If MINIBUF is 0, include all visible and iconified frames.
904 Otherwise, include all frames. */
906 static Lisp_Object
907 next_frame (Lisp_Object frame, Lisp_Object minibuf)
909 Lisp_Object tail;
910 int passed = 0;
912 /* There must always be at least one frame in Vframe_list. */
913 if (! CONSP (Vframe_list))
914 emacs_abort ();
916 /* If this frame is dead, it won't be in Vframe_list, and we'll loop
917 forever. Forestall that. */
918 CHECK_LIVE_FRAME (frame);
920 while (1)
921 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
923 Lisp_Object f;
925 f = XCAR (tail);
927 if (passed
928 && ((!FRAME_TERMCAP_P (XFRAME (f)) && !FRAME_TERMCAP_P (XFRAME (frame))
929 && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
930 || (FRAME_TERMCAP_P (XFRAME (f)) && FRAME_TERMCAP_P (XFRAME (frame))
931 && FRAME_TTY (XFRAME (f)) == FRAME_TTY (XFRAME (frame)))))
933 /* Decide whether this frame is eligible to be returned. */
935 /* If we've looped all the way around without finding any
936 eligible frames, return the original frame. */
937 if (EQ (f, frame))
938 return f;
940 /* Let minibuf decide if this frame is acceptable. */
941 if (NILP (minibuf))
943 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
944 return f;
946 else if (EQ (minibuf, Qvisible))
948 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
949 if (FRAME_VISIBLE_P (XFRAME (f)))
950 return f;
952 else if (INTEGERP (minibuf) && XINT (minibuf) == 0)
954 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
955 if (FRAME_VISIBLE_P (XFRAME (f))
956 || FRAME_ICONIFIED_P (XFRAME (f)))
957 return f;
959 else if (WINDOWP (minibuf))
961 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
962 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
963 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
964 FRAME_FOCUS_FRAME (XFRAME (f))))
965 return f;
967 else
968 return f;
971 if (EQ (frame, f))
972 passed++;
976 /* Return the previous frame in the frame list before FRAME.
977 If MINIBUF is nil, exclude minibuffer-only frames.
978 If MINIBUF is a window, include only its own frame
979 and any frame now using that window as the minibuffer.
980 If MINIBUF is `visible', include all visible frames.
981 If MINIBUF is 0, include all visible and iconified frames.
982 Otherwise, include all frames. */
984 static Lisp_Object
985 prev_frame (Lisp_Object frame, Lisp_Object minibuf)
987 Lisp_Object tail;
988 Lisp_Object prev;
990 /* There must always be at least one frame in Vframe_list. */
991 if (! CONSP (Vframe_list))
992 emacs_abort ();
994 prev = Qnil;
995 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
997 Lisp_Object f;
999 f = XCAR (tail);
1000 if (!FRAMEP (f))
1001 emacs_abort ();
1003 if (EQ (frame, f) && !NILP (prev))
1004 return prev;
1006 if ((!FRAME_TERMCAP_P (XFRAME (f)) && !FRAME_TERMCAP_P (XFRAME (frame))
1007 && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
1008 || (FRAME_TERMCAP_P (XFRAME (f)) && FRAME_TERMCAP_P (XFRAME (frame))
1009 && FRAME_TTY (XFRAME (f)) == FRAME_TTY (XFRAME (frame))))
1011 /* Decide whether this frame is eligible to be returned,
1012 according to minibuf. */
1013 if (NILP (minibuf))
1015 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
1016 prev = f;
1018 else if (WINDOWP (minibuf))
1020 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
1021 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
1022 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
1023 FRAME_FOCUS_FRAME (XFRAME (f))))
1024 prev = f;
1026 else if (EQ (minibuf, Qvisible))
1028 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1029 if (FRAME_VISIBLE_P (XFRAME (f)))
1030 prev = f;
1032 else if (XFASTINT (minibuf) == 0)
1034 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1035 if (FRAME_VISIBLE_P (XFRAME (f))
1036 || FRAME_ICONIFIED_P (XFRAME (f)))
1037 prev = f;
1039 else
1040 prev = f;
1044 /* We've scanned the entire list. */
1045 if (NILP (prev))
1046 /* We went through the whole frame list without finding a single
1047 acceptable frame. Return the original frame. */
1048 return frame;
1049 else
1050 /* There were no acceptable frames in the list before FRAME; otherwise,
1051 we would have returned directly from the loop. Since PREV is the last
1052 acceptable frame in the list, return it. */
1053 return prev;
1057 DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0,
1058 doc: /* Return the next frame in the frame list after FRAME.
1059 It considers only frames on the same terminal as FRAME.
1060 By default, skip minibuffer-only frames.
1061 If omitted, FRAME defaults to the selected frame.
1062 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1063 If MINIFRAME is a window, include only its own frame
1064 and any frame now using that window as the minibuffer.
1065 If MINIFRAME is `visible', include all visible frames.
1066 If MINIFRAME is 0, include all visible and iconified frames.
1067 Otherwise, include all frames. */)
1068 (Lisp_Object frame, Lisp_Object miniframe)
1070 if (NILP (frame))
1071 frame = selected_frame;
1073 CHECK_LIVE_FRAME (frame);
1074 return next_frame (frame, miniframe);
1077 DEFUN ("previous-frame", Fprevious_frame, Sprevious_frame, 0, 2, 0,
1078 doc: /* Return the previous frame in the frame list before FRAME.
1079 It considers only frames on the same terminal as FRAME.
1080 By default, skip minibuffer-only frames.
1081 If omitted, FRAME defaults to the selected frame.
1082 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1083 If MINIFRAME is a window, include only its own frame
1084 and any frame now using that window as the minibuffer.
1085 If MINIFRAME is `visible', include all visible frames.
1086 If MINIFRAME is 0, include all visible and iconified frames.
1087 Otherwise, include all frames. */)
1088 (Lisp_Object frame, Lisp_Object miniframe)
1090 if (NILP (frame))
1091 frame = selected_frame;
1092 CHECK_LIVE_FRAME (frame);
1093 return prev_frame (frame, miniframe);
1096 /* Return 1 if it is ok to delete frame F;
1097 0 if all frames aside from F are invisible.
1098 (Exception: if F is the terminal frame, and we are using X, return 1.) */
1100 static int
1101 other_visible_frames (FRAME_PTR f)
1103 Lisp_Object frames;
1105 for (frames = Vframe_list; CONSP (frames); frames = XCDR (frames))
1107 Lisp_Object this = XCAR (frames);
1108 if (f == XFRAME (this))
1109 continue;
1111 /* Verify that we can still talk to the frame's X window,
1112 and note any recent change in visibility. */
1113 #ifdef HAVE_WINDOW_SYSTEM
1114 if (FRAME_WINDOW_P (XFRAME (this)))
1116 x_sync (XFRAME (this));
1117 FRAME_SAMPLE_VISIBILITY (XFRAME (this));
1119 #endif
1121 if (FRAME_VISIBLE_P (XFRAME (this))
1122 || FRAME_ICONIFIED_P (XFRAME (this))
1123 /* Allow deleting the terminal frame when at least one X
1124 frame exists. */
1125 || (FRAME_WINDOW_P (XFRAME (this)) && !FRAME_WINDOW_P (f)))
1126 return 1;
1128 return 0;
1131 /* Delete FRAME. When FORCE equals Qnoelisp, delete FRAME
1132 unconditionally. x_connection_closed and delete_terminal use
1133 this. Any other value of FORCE implements the semantics
1134 described for Fdelete_frame. */
1135 Lisp_Object
1136 delete_frame (Lisp_Object frame, Lisp_Object force)
1138 struct frame *f = decode_any_frame (frame);
1139 struct frame *sf = SELECTED_FRAME ();
1140 struct kboard *kb;
1142 int minibuffer_selected, is_tooltip_frame;
1144 if (! FRAME_LIVE_P (f))
1145 return Qnil;
1147 if (NILP (force) && !other_visible_frames (f))
1148 error ("Attempt to delete the sole visible or iconified frame");
1150 /* x_connection_closed must have set FORCE to `noelisp' in order
1151 to delete the last frame, if it is gone. */
1152 if (NILP (XCDR (Vframe_list)) && !EQ (force, Qnoelisp))
1153 error ("Attempt to delete the only frame");
1155 XSETFRAME (frame, f);
1157 /* Does this frame have a minibuffer, and is it the surrogate
1158 minibuffer for any other frame? */
1159 if (FRAME_HAS_MINIBUF_P (f))
1161 Lisp_Object frames;
1163 for (frames = Vframe_list;
1164 CONSP (frames);
1165 frames = XCDR (frames))
1167 Lisp_Object this;
1168 this = XCAR (frames);
1170 if (! EQ (this, frame)
1171 && EQ (frame,
1172 WINDOW_FRAME (XWINDOW
1173 (FRAME_MINIBUF_WINDOW (XFRAME (this))))))
1175 /* If we MUST delete this frame, delete the other first.
1176 But do this only if FORCE equals `noelisp'. */
1177 if (EQ (force, Qnoelisp))
1178 delete_frame (this, Qnoelisp);
1179 else
1180 error ("Attempt to delete a surrogate minibuffer frame");
1185 is_tooltip_frame = !NILP (Fframe_parameter (frame, intern ("tooltip")));
1187 /* Run `delete-frame-functions' unless FORCE is `noelisp' or
1188 frame is a tooltip. FORCE is set to `noelisp' when handling
1189 a disconnect from the terminal, so we don't dare call Lisp
1190 code. */
1191 if (NILP (Vrun_hooks) || is_tooltip_frame)
1193 else if (EQ (force, Qnoelisp))
1194 pending_funcalls
1195 = Fcons (list3 (Qrun_hook_with_args, Qdelete_frame_functions, frame),
1196 pending_funcalls);
1197 else
1199 #ifdef HAVE_X_WINDOWS
1200 /* Also, save clipboard to the clipboard manager. */
1201 x_clipboard_manager_save_frame (frame);
1202 #endif
1204 safe_call2 (Qrun_hook_with_args, Qdelete_frame_functions, frame);
1207 /* The hook may sometimes (indirectly) cause the frame to be deleted. */
1208 if (! FRAME_LIVE_P (f))
1209 return Qnil;
1211 /* At this point, we are committed to deleting the frame.
1212 There is no more chance for errors to prevent it. */
1214 minibuffer_selected = EQ (minibuf_window, selected_window);
1216 /* Don't let the frame remain selected. */
1217 if (f == sf)
1219 Lisp_Object tail, frame1;
1221 /* Look for another visible frame on the same terminal. */
1222 frame1 = next_frame (frame, Qvisible);
1224 /* If there is none, find *some* other frame. */
1225 if (NILP (frame1) || EQ (frame1, frame))
1227 FOR_EACH_FRAME (tail, frame1)
1229 if (! EQ (frame, frame1) && FRAME_LIVE_P (XFRAME (frame1)))
1231 /* Do not change a text terminal's top-frame. */
1232 struct frame *f1 = XFRAME (frame1);
1233 if (FRAME_TERMCAP_P (f1) || FRAME_MSDOS_P (f1))
1235 Lisp_Object top_frame = FRAME_TTY (f1)->top_frame;
1236 if (!EQ (top_frame, frame))
1237 frame1 = top_frame;
1239 break;
1243 #ifdef NS_IMPL_COCOA
1244 else
1245 /* Under NS, there is no system mechanism for choosing a new
1246 window to get focus -- it is left to application code.
1247 So the portion of THIS application interfacing with NS
1248 needs to know about it. We call Fraise_frame, but the
1249 purpose is really to transfer focus. */
1250 Fraise_frame (frame1);
1251 #endif
1253 do_switch_frame (frame1, 0, 1, Qnil);
1254 sf = SELECTED_FRAME ();
1257 /* Don't allow minibuf_window to remain on a deleted frame. */
1258 if (EQ (f->minibuffer_window, minibuf_window))
1260 /* Use set_window_buffer instead of Fset_window_buffer (see
1261 discussion of bug#11984, bug#12025, bug#12026). */
1262 set_window_buffer (sf->minibuffer_window,
1263 XWINDOW (minibuf_window)->buffer, 0, 0);
1264 minibuf_window = sf->minibuffer_window;
1266 /* If the dying minibuffer window was selected,
1267 select the new one. */
1268 if (minibuffer_selected)
1269 Fselect_window (minibuf_window, Qnil);
1272 /* Don't let echo_area_window to remain on a deleted frame. */
1273 if (EQ (f->minibuffer_window, echo_area_window))
1274 echo_area_window = sf->minibuffer_window;
1276 /* Clear any X selections for this frame. */
1277 #ifdef HAVE_X_WINDOWS
1278 if (FRAME_X_P (f))
1279 x_clear_frame_selections (f);
1280 #endif
1282 /* Free glyphs.
1283 This function must be called before the window tree of the
1284 frame is deleted because windows contain dynamically allocated
1285 memory. */
1286 free_glyphs (f);
1288 #ifdef HAVE_WINDOW_SYSTEM
1289 /* Give chance to each font driver to free a frame specific data. */
1290 font_update_drivers (f, Qnil);
1291 #endif
1293 /* Mark all the windows that used to be on FRAME as deleted, and then
1294 remove the reference to them. */
1295 delete_all_child_windows (f->root_window);
1296 fset_root_window (f, Qnil);
1298 Vframe_list = Fdelq (frame, Vframe_list);
1299 FRAME_SET_VISIBLE (f, 0);
1301 /* Allow the vector of menu bar contents to be freed in the next
1302 garbage collection. The frame object itself may not be garbage
1303 collected until much later, because recent_keys and other data
1304 structures can still refer to it. */
1305 fset_menu_bar_vector (f, Qnil);
1307 /* If FRAME's buffer lists contains killed
1308 buffers, this helps GC to reclaim them. */
1309 fset_buffer_list (f, Qnil);
1310 fset_buried_buffer_list (f, Qnil);
1312 free_font_driver_list (f);
1313 xfree (f->namebuf);
1314 xfree (f->decode_mode_spec_buffer);
1315 xfree (FRAME_INSERT_COST (f));
1316 xfree (FRAME_DELETEN_COST (f));
1317 xfree (FRAME_INSERTN_COST (f));
1318 xfree (FRAME_DELETE_COST (f));
1319 xfree (FRAME_MESSAGE_BUF (f));
1321 /* Since some events are handled at the interrupt level, we may get
1322 an event for f at any time; if we zero out the frame's terminal
1323 now, then we may trip up the event-handling code. Instead, we'll
1324 promise that the terminal of the frame must be valid until we
1325 have called the window-system-dependent frame destruction
1326 routine. */
1328 if (FRAME_TERMINAL (f)->delete_frame_hook)
1329 (*FRAME_TERMINAL (f)->delete_frame_hook) (f);
1332 struct terminal *terminal = FRAME_TERMINAL (f);
1333 f->output_data.nothing = 0;
1334 f->terminal = 0; /* Now the frame is dead. */
1336 /* If needed, delete the terminal that this frame was on.
1337 (This must be done after the frame is killed.) */
1338 terminal->reference_count--;
1339 #ifdef USE_GTK
1340 /* FIXME: Deleting the terminal crashes emacs because of a GTK
1341 bug.
1342 http://lists.gnu.org/archive/html/emacs-devel/2011-10/msg00363.html */
1343 if (terminal->reference_count == 0 && terminal->type == output_x_window)
1344 terminal->reference_count = 1;
1345 #endif /* USE_GTK */
1346 if (terminal->reference_count == 0)
1348 Lisp_Object tmp;
1349 XSETTERMINAL (tmp, terminal);
1351 kb = NULL;
1352 Fdelete_terminal (tmp, NILP (force) ? Qt : force);
1354 else
1355 kb = terminal->kboard;
1358 /* If we've deleted the last_nonminibuf_frame, then try to find
1359 another one. */
1360 if (f == last_nonminibuf_frame)
1362 Lisp_Object frames;
1364 last_nonminibuf_frame = 0;
1366 for (frames = Vframe_list;
1367 CONSP (frames);
1368 frames = XCDR (frames))
1370 f = XFRAME (XCAR (frames));
1371 if (!FRAME_MINIBUF_ONLY_P (f))
1373 last_nonminibuf_frame = f;
1374 break;
1379 /* If there's no other frame on the same kboard, get out of
1380 single-kboard state if we're in it for this kboard. */
1381 if (kb != NULL)
1383 Lisp_Object frames;
1384 /* Some frame we found on the same kboard, or nil if there are none. */
1385 Lisp_Object frame_on_same_kboard;
1387 frame_on_same_kboard = Qnil;
1389 for (frames = Vframe_list;
1390 CONSP (frames);
1391 frames = XCDR (frames))
1393 Lisp_Object this;
1394 struct frame *f1;
1396 this = XCAR (frames);
1397 if (!FRAMEP (this))
1398 emacs_abort ();
1399 f1 = XFRAME (this);
1401 if (kb == FRAME_KBOARD (f1))
1402 frame_on_same_kboard = this;
1405 if (NILP (frame_on_same_kboard))
1406 not_single_kboard_state (kb);
1410 /* If we've deleted this keyboard's default_minibuffer_frame, try to
1411 find another one. Prefer minibuffer-only frames, but also notice
1412 frames with other windows. */
1413 if (kb != NULL && EQ (frame, KVAR (kb, Vdefault_minibuffer_frame)))
1415 Lisp_Object frames;
1417 /* The last frame we saw with a minibuffer, minibuffer-only or not. */
1418 Lisp_Object frame_with_minibuf;
1419 /* Some frame we found on the same kboard, or nil if there are none. */
1420 Lisp_Object frame_on_same_kboard;
1422 frame_on_same_kboard = Qnil;
1423 frame_with_minibuf = Qnil;
1425 for (frames = Vframe_list;
1426 CONSP (frames);
1427 frames = XCDR (frames))
1429 Lisp_Object this;
1430 struct frame *f1;
1432 this = XCAR (frames);
1433 if (!FRAMEP (this))
1434 emacs_abort ();
1435 f1 = XFRAME (this);
1437 /* Consider only frames on the same kboard
1438 and only those with minibuffers. */
1439 if (kb == FRAME_KBOARD (f1)
1440 && FRAME_HAS_MINIBUF_P (f1))
1442 frame_with_minibuf = this;
1443 if (FRAME_MINIBUF_ONLY_P (f1))
1444 break;
1447 if (kb == FRAME_KBOARD (f1))
1448 frame_on_same_kboard = this;
1451 if (!NILP (frame_on_same_kboard))
1453 /* We know that there must be some frame with a minibuffer out
1454 there. If this were not true, all of the frames present
1455 would have to be minibufferless, which implies that at some
1456 point their minibuffer frames must have been deleted, but
1457 that is prohibited at the top; you can't delete surrogate
1458 minibuffer frames. */
1459 if (NILP (frame_with_minibuf))
1460 emacs_abort ();
1462 kset_default_minibuffer_frame (kb, frame_with_minibuf);
1464 else
1465 /* No frames left on this kboard--say no minibuffer either. */
1466 kset_default_minibuffer_frame (kb, Qnil);
1469 /* Cause frame titles to update--necessary if we now have just one frame. */
1470 if (!is_tooltip_frame)
1471 update_mode_lines = 1;
1473 return Qnil;
1476 DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 2, "",
1477 doc: /* Delete FRAME, permanently eliminating it from use.
1478 FRAME defaults to the selected frame.
1480 A frame may not be deleted if its minibuffer is used by other frames.
1481 Normally, you may not delete a frame if all other frames are invisible,
1482 but if the second optional argument FORCE is non-nil, you may do so.
1484 This function runs `delete-frame-functions' before actually
1485 deleting the frame, unless the frame is a tooltip.
1486 The functions are run with one argument, the frame to be deleted. */)
1487 (Lisp_Object frame, Lisp_Object force)
1489 return delete_frame (frame, !NILP (force) ? Qt : Qnil);
1493 /* Return mouse position in character cell units. */
1495 DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0,
1496 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1497 The position is given in character cells, where (0, 0) is the
1498 upper-left corner of the frame, X is the horizontal offset, and Y is
1499 the vertical offset.
1500 If Emacs is running on a mouseless terminal or hasn't been programmed
1501 to read the mouse position, it returns the selected frame for FRAME
1502 and nil for X and Y.
1503 If `mouse-position-function' is non-nil, `mouse-position' calls it,
1504 passing the normal return value to that function as an argument,
1505 and returns whatever that function returns. */)
1506 (void)
1508 FRAME_PTR f;
1509 Lisp_Object lispy_dummy;
1510 Lisp_Object x, y, retval;
1511 struct gcpro gcpro1;
1513 f = SELECTED_FRAME ();
1514 x = y = Qnil;
1516 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
1517 /* It's okay for the hook to refrain from storing anything. */
1518 if (FRAME_TERMINAL (f)->mouse_position_hook)
1520 enum scroll_bar_part party_dummy;
1521 Time time_dummy;
1522 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1523 &lispy_dummy, &party_dummy,
1524 &x, &y,
1525 &time_dummy);
1528 if (! NILP (x))
1530 int col = XINT (x);
1531 int row = XINT (y);
1532 pixel_to_glyph_coords (f, col, row, &col, &row, NULL, 1);
1533 XSETINT (x, col);
1534 XSETINT (y, row);
1536 #endif
1537 XSETFRAME (lispy_dummy, f);
1538 retval = Fcons (lispy_dummy, Fcons (x, y));
1539 GCPRO1 (retval);
1540 if (!NILP (Vmouse_position_function))
1541 retval = call1 (Vmouse_position_function, retval);
1542 RETURN_UNGCPRO (retval);
1545 DEFUN ("mouse-pixel-position", Fmouse_pixel_position,
1546 Smouse_pixel_position, 0, 0, 0,
1547 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1548 The position is given in pixel units, where (0, 0) is the
1549 upper-left corner of the frame, X is the horizontal offset, and Y is
1550 the vertical offset.
1551 If Emacs is running on a mouseless terminal or hasn't been programmed
1552 to read the mouse position, it returns the selected frame for FRAME
1553 and nil for X and Y. */)
1554 (void)
1556 FRAME_PTR f;
1557 Lisp_Object lispy_dummy;
1558 Lisp_Object x, y;
1560 f = SELECTED_FRAME ();
1561 x = y = Qnil;
1563 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
1564 /* It's okay for the hook to refrain from storing anything. */
1565 if (FRAME_TERMINAL (f)->mouse_position_hook)
1567 enum scroll_bar_part party_dummy;
1568 Time time_dummy;
1569 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1570 &lispy_dummy, &party_dummy,
1571 &x, &y,
1572 &time_dummy);
1575 #endif
1576 XSETFRAME (lispy_dummy, f);
1577 return Fcons (lispy_dummy, Fcons (x, y));
1580 DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0,
1581 doc: /* Move the mouse pointer to the center of character cell (X,Y) in FRAME.
1582 Coordinates are relative to the frame, not a window,
1583 so the coordinates of the top left character in the frame
1584 may be nonzero due to left-hand scroll bars or the menu bar.
1586 The position is given in character cells, where (0, 0) is the
1587 upper-left corner of the frame, X is the horizontal offset, and Y is
1588 the vertical offset.
1590 This function is a no-op for an X frame that is not visible.
1591 If you have just created a frame, you must wait for it to become visible
1592 before calling this function on it, like this.
1593 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1594 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1596 CHECK_LIVE_FRAME (frame);
1597 CHECK_TYPE_RANGED_INTEGER (int, x);
1598 CHECK_TYPE_RANGED_INTEGER (int, y);
1600 /* I think this should be done with a hook. */
1601 #ifdef HAVE_WINDOW_SYSTEM
1602 if (FRAME_WINDOW_P (XFRAME (frame)))
1603 /* Warping the mouse will cause enternotify and focus events. */
1604 x_set_mouse_position (XFRAME (frame), XINT (x), XINT (y));
1605 #else
1606 #if defined (MSDOS) && defined (HAVE_MOUSE)
1607 if (FRAME_MSDOS_P (XFRAME (frame)))
1609 Fselect_frame (frame, Qnil);
1610 mouse_moveto (XINT (x), XINT (y));
1612 #else
1613 #ifdef HAVE_GPM
1615 Fselect_frame (frame, Qnil);
1616 term_mouse_moveto (XINT (x), XINT (y));
1618 #endif
1619 #endif
1620 #endif
1622 return Qnil;
1625 DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position,
1626 Sset_mouse_pixel_position, 3, 3, 0,
1627 doc: /* Move the mouse pointer to pixel position (X,Y) in FRAME.
1628 The position is given in pixels, where (0, 0) is the upper-left corner
1629 of the frame, X is the horizontal offset, and Y is the vertical offset.
1631 Note, this is a no-op for an X frame that is not visible.
1632 If you have just created a frame, you must wait for it to become visible
1633 before calling this function on it, like this.
1634 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1635 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1637 CHECK_LIVE_FRAME (frame);
1638 CHECK_TYPE_RANGED_INTEGER (int, x);
1639 CHECK_TYPE_RANGED_INTEGER (int, y);
1641 /* I think this should be done with a hook. */
1642 #ifdef HAVE_WINDOW_SYSTEM
1643 if (FRAME_WINDOW_P (XFRAME (frame)))
1644 /* Warping the mouse will cause enternotify and focus events. */
1645 x_set_mouse_pixel_position (XFRAME (frame), XINT (x), XINT (y));
1646 #else
1647 #if defined (MSDOS) && defined (HAVE_MOUSE)
1648 if (FRAME_MSDOS_P (XFRAME (frame)))
1650 Fselect_frame (frame, Qnil);
1651 mouse_moveto (XINT (x), XINT (y));
1653 #else
1654 #ifdef HAVE_GPM
1656 Fselect_frame (frame, Qnil);
1657 term_mouse_moveto (XINT (x), XINT (y));
1659 #endif
1660 #endif
1661 #endif
1663 return Qnil;
1666 static void make_frame_visible_1 (Lisp_Object);
1668 DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible,
1669 0, 1, "",
1670 doc: /* Make the frame FRAME visible (assuming it is an X window).
1671 If omitted, FRAME defaults to the currently selected frame. */)
1672 (Lisp_Object frame)
1674 struct frame *f = decode_live_frame (frame);
1676 /* I think this should be done with a hook. */
1677 #ifdef HAVE_WINDOW_SYSTEM
1678 if (FRAME_WINDOW_P (f))
1680 FRAME_SAMPLE_VISIBILITY (f);
1681 x_make_frame_visible (f);
1683 #endif
1685 make_frame_visible_1 (f->root_window);
1687 /* Make menu bar update for the Buffers and Frames menus. */
1688 windows_or_buffers_changed++;
1690 XSETFRAME (frame, f);
1691 return frame;
1694 /* Update the display_time slot of the buffers shown in WINDOW
1695 and all its descendants. */
1697 static void
1698 make_frame_visible_1 (Lisp_Object window)
1700 struct window *w;
1702 for (;!NILP (window); window = w->next)
1704 w = XWINDOW (window);
1706 if (!NILP (w->buffer))
1707 bset_display_time (XBUFFER (w->buffer), Fcurrent_time ());
1709 if (!NILP (w->vchild))
1710 make_frame_visible_1 (w->vchild);
1711 if (!NILP (w->hchild))
1712 make_frame_visible_1 (w->hchild);
1716 DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible,
1717 0, 2, "",
1718 doc: /* Make the frame FRAME invisible.
1719 If omitted, FRAME defaults to the currently selected frame.
1720 On graphical displays, invisible frames are not updated and are
1721 usually not displayed at all, even in a window system's \"taskbar\".
1723 Normally you may not make FRAME invisible if all other frames are invisible,
1724 but if the second optional argument FORCE is non-nil, you may do so.
1726 This function has no effect on text terminal frames. Such frames are
1727 always considered visible, whether or not they are currently being
1728 displayed in the terminal. */)
1729 (Lisp_Object frame, Lisp_Object force)
1731 struct frame *f = decode_live_frame (frame);
1733 if (NILP (force) && !other_visible_frames (f))
1734 error ("Attempt to make invisible the sole visible or iconified frame");
1736 /* Don't allow minibuf_window to remain on a deleted frame. */
1737 if (EQ (f->minibuffer_window, minibuf_window))
1739 struct frame *sf = XFRAME (selected_frame);
1740 /* Use set_window_buffer instead of Fset_window_buffer (see
1741 discussion of bug#11984, bug#12025, bug#12026). */
1742 set_window_buffer (sf->minibuffer_window,
1743 XWINDOW (minibuf_window)->buffer, 0, 0);
1744 minibuf_window = sf->minibuffer_window;
1747 /* I think this should be done with a hook. */
1748 #ifdef HAVE_WINDOW_SYSTEM
1749 if (FRAME_WINDOW_P (f))
1750 x_make_frame_invisible (f);
1751 #endif
1753 /* Make menu bar update for the Buffers and Frames menus. */
1754 windows_or_buffers_changed++;
1756 return Qnil;
1759 DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame,
1760 0, 1, "",
1761 doc: /* Make the frame FRAME into an icon.
1762 If omitted, FRAME defaults to the currently selected frame. */)
1763 (Lisp_Object frame)
1765 struct frame *f = decode_live_frame (frame);
1767 /* Don't allow minibuf_window to remain on an iconified frame. */
1768 if (EQ (f->minibuffer_window, minibuf_window))
1770 struct frame *sf = XFRAME (selected_frame);
1771 /* Use set_window_buffer instead of Fset_window_buffer (see
1772 discussion of bug#11984, bug#12025, bug#12026). */
1773 set_window_buffer (sf->minibuffer_window,
1774 XWINDOW (minibuf_window)->buffer, 0, 0);
1775 minibuf_window = sf->minibuffer_window;
1778 /* I think this should be done with a hook. */
1779 #ifdef HAVE_WINDOW_SYSTEM
1780 if (FRAME_WINDOW_P (f))
1781 x_iconify_frame (f);
1782 #endif
1784 /* Make menu bar update for the Buffers and Frames menus. */
1785 windows_or_buffers_changed++;
1787 return Qnil;
1790 DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p,
1791 1, 1, 0,
1792 doc: /* Return t if FRAME is \"visible\" (actually in use for display).
1793 Return the symbol `icon' if FRAME is iconified or \"minimized\".
1794 Return nil if FRAME was made invisible, via `make-frame-invisible'.
1795 On graphical displays, invisible frames are not updated and are
1796 usually not displayed at all, even in a window system's \"taskbar\".
1798 If FRAME is a text terminal frame, this always returns t.
1799 Such frames are always considered visible, whether or not they are
1800 currently being displayed on the terminal. */)
1801 (Lisp_Object frame)
1803 CHECK_LIVE_FRAME (frame);
1805 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1807 if (FRAME_VISIBLE_P (XFRAME (frame)))
1808 return Qt;
1809 if (FRAME_ICONIFIED_P (XFRAME (frame)))
1810 return Qicon;
1811 return Qnil;
1814 DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list,
1815 0, 0, 0,
1816 doc: /* Return a list of all frames now \"visible\" (being updated). */)
1817 (void)
1819 Lisp_Object tail, frame;
1820 struct frame *f;
1821 Lisp_Object value;
1823 value = Qnil;
1824 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1826 frame = XCAR (tail);
1827 if (!FRAMEP (frame))
1828 continue;
1829 f = XFRAME (frame);
1830 if (FRAME_VISIBLE_P (f))
1831 value = Fcons (frame, value);
1833 return value;
1837 DEFUN ("raise-frame", Fraise_frame, Sraise_frame, 0, 1, "",
1838 doc: /* Bring FRAME to the front, so it occludes any frames it overlaps.
1839 If FRAME is invisible or iconified, make it visible.
1840 If you don't specify a frame, the selected frame is used.
1841 If Emacs is displaying on an ordinary terminal or some other device which
1842 doesn't support multiple overlapping frames, this function selects FRAME. */)
1843 (Lisp_Object frame)
1845 struct frame *f = decode_live_frame (frame);
1847 XSETFRAME (frame, f);
1849 if (FRAME_TERMCAP_P (f))
1850 /* On a text terminal select FRAME. */
1851 Fselect_frame (frame, Qnil);
1852 else
1853 /* Do like the documentation says. */
1854 Fmake_frame_visible (frame);
1856 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
1857 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 1);
1859 return Qnil;
1862 /* Should we have a corresponding function called Flower_Power? */
1863 DEFUN ("lower-frame", Flower_frame, Slower_frame, 0, 1, "",
1864 doc: /* Send FRAME to the back, so it is occluded by any frames that overlap it.
1865 If you don't specify a frame, the selected frame is used.
1866 If Emacs is displaying on an ordinary terminal or some other device which
1867 doesn't support multiple overlapping frames, this function does nothing. */)
1868 (Lisp_Object frame)
1870 struct frame *f = decode_live_frame (frame);
1872 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
1873 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 0);
1875 return Qnil;
1879 DEFUN ("redirect-frame-focus", Fredirect_frame_focus, Sredirect_frame_focus,
1880 1, 2, 0,
1881 doc: /* Arrange for keystrokes typed at FRAME to be sent to FOCUS-FRAME.
1882 In other words, switch-frame events caused by events in FRAME will
1883 request a switch to FOCUS-FRAME, and `last-event-frame' will be
1884 FOCUS-FRAME after reading an event typed at FRAME.
1886 If FOCUS-FRAME is nil, any existing redirection is canceled, and the
1887 frame again receives its own keystrokes.
1889 Focus redirection is useful for temporarily redirecting keystrokes to
1890 a surrogate minibuffer frame when a frame doesn't have its own
1891 minibuffer window.
1893 A frame's focus redirection can be changed by `select-frame'. If frame
1894 FOO is selected, and then a different frame BAR is selected, any
1895 frames redirecting their focus to FOO are shifted to redirect their
1896 focus to BAR. This allows focus redirection to work properly when the
1897 user switches from one frame to another using `select-window'.
1899 This means that a frame whose focus is redirected to itself is treated
1900 differently from a frame whose focus is redirected to nil; the former
1901 is affected by `select-frame', while the latter is not.
1903 The redirection lasts until `redirect-frame-focus' is called to change it. */)
1904 (Lisp_Object frame, Lisp_Object focus_frame)
1906 /* Note that we don't check for a live frame here. It's reasonable
1907 to redirect the focus of a frame you're about to delete, if you
1908 know what other frame should receive those keystrokes. */
1909 struct frame *f = decode_any_frame (frame);
1911 if (! NILP (focus_frame))
1912 CHECK_LIVE_FRAME (focus_frame);
1914 fset_focus_frame (f, focus_frame);
1916 if (FRAME_TERMINAL (f)->frame_rehighlight_hook)
1917 (*FRAME_TERMINAL (f)->frame_rehighlight_hook) (f);
1919 return Qnil;
1923 DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 0, 1, 0,
1924 doc: /* Return the frame to which FRAME's keystrokes are currently being sent.
1925 If FRAME is omitted or nil, the selected frame is used.
1926 Return nil if FRAME's focus is not redirected.
1927 See `redirect-frame-focus'. */)
1928 (Lisp_Object frame)
1930 return FRAME_FOCUS_FRAME (decode_live_frame (frame));
1935 /* Return the value of frame parameter PROP in frame FRAME. */
1937 #ifdef HAVE_WINDOW_SYSTEM
1938 #if !HAVE_NS
1939 static
1940 #endif
1941 Lisp_Object
1942 get_frame_param (register struct frame *frame, Lisp_Object prop)
1944 register Lisp_Object tem;
1946 tem = Fassq (prop, frame->param_alist);
1947 if (EQ (tem, Qnil))
1948 return tem;
1949 return Fcdr (tem);
1951 #endif
1953 /* Discard BUFFER from the buffer-list and buried-buffer-list of each frame. */
1955 void
1956 frames_discard_buffer (Lisp_Object buffer)
1958 Lisp_Object frame, tail;
1960 FOR_EACH_FRAME (tail, frame)
1962 fset_buffer_list
1963 (XFRAME (frame), Fdelq (buffer, XFRAME (frame)->buffer_list));
1964 fset_buried_buffer_list
1965 (XFRAME (frame), Fdelq (buffer, XFRAME (frame)->buried_buffer_list));
1969 /* Modify the alist in *ALISTPTR to associate PROP with VAL.
1970 If the alist already has an element for PROP, we change it. */
1972 void
1973 store_in_alist (Lisp_Object *alistptr, Lisp_Object prop, Lisp_Object val)
1975 register Lisp_Object tem;
1977 tem = Fassq (prop, *alistptr);
1978 if (EQ (tem, Qnil))
1979 *alistptr = Fcons (Fcons (prop, val), *alistptr);
1980 else
1981 Fsetcdr (tem, val);
1984 static int
1985 frame_name_fnn_p (char *str, ptrdiff_t len)
1987 if (len > 1 && str[0] == 'F' && '0' <= str[1] && str[1] <= '9')
1989 char *p = str + 2;
1990 while ('0' <= *p && *p <= '9')
1991 p++;
1992 if (p == str + len)
1993 return 1;
1995 return 0;
1998 /* Set the name of the terminal frame. Also used by MSDOS frames.
1999 Modeled after x_set_name which is used for WINDOW frames. */
2001 static void
2002 set_term_frame_name (struct frame *f, Lisp_Object name)
2004 f->explicit_name = ! NILP (name);
2006 /* If NAME is nil, set the name to F<num>. */
2007 if (NILP (name))
2009 char namebuf[sizeof "F" + INT_STRLEN_BOUND (printmax_t)];
2011 /* Check for no change needed in this very common case
2012 before we do any consing. */
2013 if (frame_name_fnn_p (SSDATA (f->name), SBYTES (f->name)))
2014 return;
2016 name = make_formatted_string (namebuf, "F%"pMd, ++tty_frame_count);
2018 else
2020 CHECK_STRING (name);
2022 /* Don't change the name if it's already NAME. */
2023 if (! NILP (Fstring_equal (name, f->name)))
2024 return;
2026 /* Don't allow the user to set the frame name to F<num>, so it
2027 doesn't clash with the names we generate for terminal frames. */
2028 if (frame_name_fnn_p (SSDATA (name), SBYTES (name)))
2029 error ("Frame names of the form F<num> are usurped by Emacs");
2032 fset_name (f, name);
2033 update_mode_lines = 1;
2036 void
2037 store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
2039 register Lisp_Object old_alist_elt;
2041 /* The buffer-list parameters are stored in a special place and not
2042 in the alist. All buffers must be live. */
2043 if (EQ (prop, Qbuffer_list))
2045 Lisp_Object list = Qnil;
2046 for (; CONSP (val); val = XCDR (val))
2047 if (!NILP (Fbuffer_live_p (XCAR (val))))
2048 list = Fcons (XCAR (val), list);
2049 fset_buffer_list (f, Fnreverse (list));
2050 return;
2052 if (EQ (prop, Qburied_buffer_list))
2054 Lisp_Object list = Qnil;
2055 for (; CONSP (val); val = XCDR (val))
2056 if (!NILP (Fbuffer_live_p (XCAR (val))))
2057 list = Fcons (XCAR (val), list);
2058 fset_buried_buffer_list (f, Fnreverse (list));
2059 return;
2062 /* If PROP is a symbol which is supposed to have frame-local values,
2063 and it is set up based on this frame, switch to the global
2064 binding. That way, we can create or alter the frame-local binding
2065 without messing up the symbol's status. */
2066 if (SYMBOLP (prop))
2068 struct Lisp_Symbol *sym = XSYMBOL (prop);
2069 start:
2070 switch (sym->redirect)
2072 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
2073 case SYMBOL_PLAINVAL: case SYMBOL_FORWARDED: break;
2074 case SYMBOL_LOCALIZED:
2075 { struct Lisp_Buffer_Local_Value *blv = sym->val.blv;
2076 if (blv->frame_local && blv_found (blv) && XFRAME (blv->where) == f)
2077 swap_in_global_binding (sym);
2078 break;
2080 default: emacs_abort ();
2084 /* The tty color needed to be set before the frame's parameter
2085 alist was updated with the new value. This is not true any more,
2086 but we still do this test early on. */
2087 if (FRAME_TERMCAP_P (f) && EQ (prop, Qtty_color_mode)
2088 && f == FRAME_TTY (f)->previous_frame)
2089 /* Force redisplay of this tty. */
2090 FRAME_TTY (f)->previous_frame = NULL;
2092 /* Update the frame parameter alist. */
2093 old_alist_elt = Fassq (prop, f->param_alist);
2094 if (EQ (old_alist_elt, Qnil))
2095 fset_param_alist (f, Fcons (Fcons (prop, val), f->param_alist));
2096 else
2097 Fsetcdr (old_alist_elt, val);
2099 /* Update some other special parameters in their special places
2100 in addition to the alist. */
2102 if (EQ (prop, Qbuffer_predicate))
2103 fset_buffer_predicate (f, val);
2105 if (! FRAME_WINDOW_P (f))
2107 if (EQ (prop, Qmenu_bar_lines))
2108 set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f)));
2109 else if (EQ (prop, Qname))
2110 set_term_frame_name (f, val);
2113 if (EQ (prop, Qminibuffer) && WINDOWP (val))
2115 if (! MINI_WINDOW_P (XWINDOW (val)))
2116 error ("Surrogate minibuffer windows must be minibuffer windows");
2118 if ((FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
2119 && !EQ (val, f->minibuffer_window))
2120 error ("Can't change the surrogate minibuffer of a frame with its own minibuffer");
2122 /* Install the chosen minibuffer window, with proper buffer. */
2123 fset_minibuffer_window (f, val);
2127 DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0,
2128 doc: /* Return the parameters-alist of frame FRAME.
2129 It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
2130 The meaningful PARMs depend on the kind of frame.
2131 If FRAME is omitted or nil, return information on the currently selected frame. */)
2132 (Lisp_Object frame)
2134 Lisp_Object alist;
2135 struct frame *f = decode_any_frame (frame);
2136 int height, width;
2137 struct gcpro gcpro1;
2139 if (!FRAME_LIVE_P (f))
2140 return Qnil;
2142 alist = Fcopy_alist (f->param_alist);
2143 GCPRO1 (alist);
2145 if (!FRAME_WINDOW_P (f))
2147 int fg = FRAME_FOREGROUND_PIXEL (f);
2148 int bg = FRAME_BACKGROUND_PIXEL (f);
2149 Lisp_Object elt;
2151 /* If the frame's parameter alist says the colors are
2152 unspecified and reversed, take the frame's background pixel
2153 for foreground and vice versa. */
2154 elt = Fassq (Qforeground_color, alist);
2155 if (CONSP (elt) && STRINGP (XCDR (elt)))
2157 if (strncmp (SSDATA (XCDR (elt)),
2158 unspecified_bg,
2159 SCHARS (XCDR (elt))) == 0)
2160 store_in_alist (&alist, Qforeground_color, tty_color_name (f, bg));
2161 else if (strncmp (SSDATA (XCDR (elt)),
2162 unspecified_fg,
2163 SCHARS (XCDR (elt))) == 0)
2164 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2166 else
2167 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2168 elt = Fassq (Qbackground_color, alist);
2169 if (CONSP (elt) && STRINGP (XCDR (elt)))
2171 if (strncmp (SSDATA (XCDR (elt)),
2172 unspecified_fg,
2173 SCHARS (XCDR (elt))) == 0)
2174 store_in_alist (&alist, Qbackground_color, tty_color_name (f, fg));
2175 else if (strncmp (SSDATA (XCDR (elt)),
2176 unspecified_bg,
2177 SCHARS (XCDR (elt))) == 0)
2178 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2180 else
2181 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2182 store_in_alist (&alist, intern ("font"),
2183 build_string (FRAME_MSDOS_P (f)
2184 ? "ms-dos"
2185 : FRAME_W32_P (f) ? "w32term"
2186 :"tty"));
2188 store_in_alist (&alist, Qname, f->name);
2189 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2190 store_in_alist (&alist, Qheight, make_number (height));
2191 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2192 store_in_alist (&alist, Qwidth, make_number (width));
2193 store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil));
2194 store_in_alist (&alist, Qminibuffer,
2195 (! FRAME_HAS_MINIBUF_P (f) ? Qnil
2196 : FRAME_MINIBUF_ONLY_P (f) ? Qonly
2197 : FRAME_MINIBUF_WINDOW (f)));
2198 store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
2199 store_in_alist (&alist, Qbuffer_list, f->buffer_list);
2200 store_in_alist (&alist, Qburied_buffer_list, f->buried_buffer_list);
2202 /* I think this should be done with a hook. */
2203 #ifdef HAVE_WINDOW_SYSTEM
2204 if (FRAME_WINDOW_P (f))
2205 x_report_frame_params (f, &alist);
2206 else
2207 #endif
2209 /* This ought to be correct in f->param_alist for an X frame. */
2210 Lisp_Object lines;
2211 XSETFASTINT (lines, FRAME_MENU_BAR_LINES (f));
2212 store_in_alist (&alist, Qmenu_bar_lines, lines);
2215 UNGCPRO;
2216 return alist;
2220 DEFUN ("frame-parameter", Fframe_parameter, Sframe_parameter, 2, 2, 0,
2221 doc: /* Return FRAME's value for parameter PARAMETER.
2222 If FRAME is nil, describe the currently selected frame. */)
2223 (Lisp_Object frame, Lisp_Object parameter)
2225 struct frame *f = decode_any_frame (frame);
2226 Lisp_Object value = Qnil;
2228 CHECK_SYMBOL (parameter);
2230 XSETFRAME (frame, f);
2232 if (FRAME_LIVE_P (f))
2234 /* Avoid consing in frequent cases. */
2235 if (EQ (parameter, Qname))
2236 value = f->name;
2237 #ifdef HAVE_X_WINDOWS
2238 else if (EQ (parameter, Qdisplay) && FRAME_X_P (f))
2239 value = XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element);
2240 #endif /* HAVE_X_WINDOWS */
2241 else if (EQ (parameter, Qbackground_color)
2242 || EQ (parameter, Qforeground_color))
2244 value = Fassq (parameter, f->param_alist);
2245 if (CONSP (value))
2247 value = XCDR (value);
2248 /* Fframe_parameters puts the actual fg/bg color names,
2249 even if f->param_alist says otherwise. This is
2250 important when param_alist's notion of colors is
2251 "unspecified". We need to do the same here. */
2252 if (STRINGP (value) && !FRAME_WINDOW_P (f))
2254 const char *color_name;
2255 ptrdiff_t csz;
2257 if (EQ (parameter, Qbackground_color))
2259 color_name = SSDATA (value);
2260 csz = SCHARS (value);
2261 if (strncmp (color_name, unspecified_bg, csz) == 0)
2262 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2263 else if (strncmp (color_name, unspecified_fg, csz) == 0)
2264 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2266 else if (EQ (parameter, Qforeground_color))
2268 color_name = SSDATA (value);
2269 csz = SCHARS (value);
2270 if (strncmp (color_name, unspecified_fg, csz) == 0)
2271 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2272 else if (strncmp (color_name, unspecified_bg, csz) == 0)
2273 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2277 else
2278 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2280 else if (EQ (parameter, Qdisplay_type)
2281 || EQ (parameter, Qbackground_mode))
2282 value = Fcdr (Fassq (parameter, f->param_alist));
2283 else
2284 /* FIXME: Avoid this code path at all (as well as code duplication)
2285 by sharing more code with Fframe_parameters. */
2286 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2289 return value;
2293 DEFUN ("modify-frame-parameters", Fmodify_frame_parameters,
2294 Smodify_frame_parameters, 2, 2, 0,
2295 doc: /* Modify the parameters of frame FRAME according to ALIST.
2296 If FRAME is nil, it defaults to the selected frame.
2297 ALIST is an alist of parameters to change and their new values.
2298 Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.
2299 The meaningful PARMs depend on the kind of frame.
2300 Undefined PARMs are ignored, but stored in the frame's parameter list
2301 so that `frame-parameters' will return them.
2303 The value of frame parameter FOO can also be accessed
2304 as a frame-local binding for the variable FOO, if you have
2305 enabled such bindings for that variable with `make-variable-frame-local'.
2306 Note that this functionality is obsolete as of Emacs 22.2, and its
2307 use is not recommended. Explicitly check for a frame-parameter instead. */)
2308 (Lisp_Object frame, Lisp_Object alist)
2310 struct frame *f = decode_live_frame (frame);
2311 register Lisp_Object tail, prop, val;
2313 /* I think this should be done with a hook. */
2314 #ifdef HAVE_WINDOW_SYSTEM
2315 if (FRAME_WINDOW_P (f))
2316 x_set_frame_parameters (f, alist);
2317 else
2318 #endif
2319 #ifdef MSDOS
2320 if (FRAME_MSDOS_P (f))
2321 IT_set_frame_parameters (f, alist);
2322 else
2323 #endif
2326 EMACS_INT length = XFASTINT (Flength (alist));
2327 ptrdiff_t i;
2328 Lisp_Object *parms;
2329 Lisp_Object *values;
2330 USE_SAFE_ALLOCA;
2331 SAFE_ALLOCA_LISP (parms, 2 * length);
2332 values = parms + length;
2334 /* Extract parm names and values into those vectors. */
2336 i = 0;
2337 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2339 Lisp_Object elt;
2341 elt = XCAR (tail);
2342 parms[i] = Fcar (elt);
2343 values[i] = Fcdr (elt);
2344 i++;
2347 /* Now process them in reverse of specified order. */
2348 while (--i >= 0)
2350 prop = parms[i];
2351 val = values[i];
2352 store_frame_param (f, prop, val);
2354 if (EQ (prop, Qforeground_color)
2355 || EQ (prop, Qbackground_color))
2356 update_face_from_frame_parameter (f, prop, val);
2359 SAFE_FREE ();
2361 return Qnil;
2364 DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height,
2365 0, 1, 0,
2366 doc: /* Height in pixels of a line in the font in frame FRAME.
2367 If FRAME is omitted or nil, the selected frame is used.
2368 For a terminal frame, the value is always 1. */)
2369 (Lisp_Object frame)
2371 #ifdef HAVE_WINDOW_SYSTEM
2372 struct frame *f = decode_any_frame (frame);
2374 if (FRAME_WINDOW_P (f))
2375 return make_number (x_char_height (f));
2376 else
2377 #endif
2378 return make_number (1);
2382 DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width,
2383 0, 1, 0,
2384 doc: /* Width in pixels of characters in the font in frame FRAME.
2385 If FRAME is omitted or nil, the selected frame is used.
2386 On a graphical screen, the width is the standard width of the default font.
2387 For a terminal screen, the value is always 1. */)
2388 (Lisp_Object frame)
2390 #ifdef HAVE_WINDOW_SYSTEM
2391 struct frame *f = decode_any_frame (frame);
2393 if (FRAME_WINDOW_P (f))
2394 return make_number (x_char_width (f));
2395 else
2396 #endif
2397 return make_number (1);
2400 DEFUN ("frame-pixel-height", Fframe_pixel_height,
2401 Sframe_pixel_height, 0, 1, 0,
2402 doc: /* Return a FRAME's height in pixels.
2403 If FRAME is omitted or nil, the selected frame is used. The exact value
2404 of the result depends on the window-system and toolkit in use:
2406 In the Gtk+ version of Emacs, it includes only any window (including
2407 the minibuffer or echo area), mode line, and header line. It does not
2408 include the tool bar or menu bar.
2410 With other graphical versions, it also includes the tool bar and the
2411 menu bar.
2413 For a text terminal, it includes the menu bar. In this case, the
2414 result is really in characters rather than pixels (i.e., is identical
2415 to `frame-height'). */)
2416 (Lisp_Object frame)
2418 struct frame *f = decode_any_frame (frame);
2420 #ifdef HAVE_WINDOW_SYSTEM
2421 if (FRAME_WINDOW_P (f))
2422 return make_number (x_pixel_height (f));
2423 else
2424 #endif
2425 return make_number (FRAME_LINES (f));
2428 DEFUN ("frame-pixel-width", Fframe_pixel_width,
2429 Sframe_pixel_width, 0, 1, 0,
2430 doc: /* Return FRAME's width in pixels.
2431 For a terminal frame, the result really gives the width in characters.
2432 If FRAME is omitted or nil, the selected frame is used. */)
2433 (Lisp_Object frame)
2435 struct frame *f = decode_any_frame (frame);
2437 #ifdef HAVE_WINDOW_SYSTEM
2438 if (FRAME_WINDOW_P (f))
2439 return make_number (x_pixel_width (f));
2440 else
2441 #endif
2442 return make_number (FRAME_COLS (f));
2445 DEFUN ("tool-bar-pixel-width", Ftool_bar_pixel_width,
2446 Stool_bar_pixel_width, 0, 1, 0,
2447 doc: /* Return width in pixels of FRAME's tool bar.
2448 The result is greater than zero only when the tool bar is on the left
2449 or right side of FRAME. If FRAME is omitted or nil, the selected frame
2450 is used. */)
2451 (Lisp_Object frame)
2453 #ifdef FRAME_TOOLBAR_WIDTH
2454 struct frame *f = decode_any_frame (frame);
2456 if (FRAME_WINDOW_P (f))
2457 return make_number (FRAME_TOOLBAR_WIDTH (f));
2458 #endif
2459 return make_number (0);
2462 DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0,
2463 doc: /* Specify that the frame FRAME has LINES lines.
2464 Optional third arg non-nil means that redisplay should use LINES lines
2465 but that the idea of the actual height of the frame should not be changed. */)
2466 (Lisp_Object frame, Lisp_Object lines, Lisp_Object pretend)
2468 register struct frame *f = decode_live_frame (frame);
2470 CHECK_TYPE_RANGED_INTEGER (int, lines);
2472 /* I think this should be done with a hook. */
2473 #ifdef HAVE_WINDOW_SYSTEM
2474 if (FRAME_WINDOW_P (f))
2476 if (XINT (lines) != FRAME_LINES (f))
2477 x_set_window_size (f, 1, FRAME_COLS (f), XINT (lines));
2478 do_pending_window_change (0);
2480 else
2481 #endif
2482 change_frame_size (f, XINT (lines), 0, !NILP (pretend), 0, 0);
2483 return Qnil;
2486 DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 3, 0,
2487 doc: /* Specify that the frame FRAME has COLS columns.
2488 Optional third arg non-nil means that redisplay should use COLS columns
2489 but that the idea of the actual width of the frame should not be changed. */)
2490 (Lisp_Object frame, Lisp_Object cols, Lisp_Object pretend)
2492 register struct frame *f = decode_live_frame (frame);
2494 CHECK_TYPE_RANGED_INTEGER (int, cols);
2496 /* I think this should be done with a hook. */
2497 #ifdef HAVE_WINDOW_SYSTEM
2498 if (FRAME_WINDOW_P (f))
2500 if (XINT (cols) != FRAME_COLS (f))
2501 x_set_window_size (f, 1, XINT (cols), FRAME_LINES (f));
2502 do_pending_window_change (0);
2504 else
2505 #endif
2506 change_frame_size (f, 0, XINT (cols), !NILP (pretend), 0, 0);
2507 return Qnil;
2510 DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0,
2511 doc: /* Sets size of FRAME to COLS by ROWS, measured in characters. */)
2512 (Lisp_Object frame, Lisp_Object cols, Lisp_Object rows)
2514 register struct frame *f;
2516 CHECK_LIVE_FRAME (frame);
2517 CHECK_TYPE_RANGED_INTEGER (int, cols);
2518 CHECK_TYPE_RANGED_INTEGER (int, rows);
2519 f = XFRAME (frame);
2521 /* I think this should be done with a hook. */
2522 #ifdef HAVE_WINDOW_SYSTEM
2523 if (FRAME_WINDOW_P (f))
2525 if (XINT (rows) != FRAME_LINES (f)
2526 || XINT (cols) != FRAME_COLS (f)
2527 || f->new_text_lines || f->new_text_cols)
2528 x_set_window_size (f, 1, XINT (cols), XINT (rows));
2529 do_pending_window_change (0);
2531 else
2532 #endif
2533 change_frame_size (f, XINT (rows), XINT (cols), 0, 0, 0);
2535 return Qnil;
2538 DEFUN ("set-frame-position", Fset_frame_position,
2539 Sset_frame_position, 3, 3, 0,
2540 doc: /* Sets position of FRAME in pixels to XOFFSET by YOFFSET.
2541 This is actually the position of the upper left corner of the frame.
2542 Negative values for XOFFSET or YOFFSET are interpreted relative to
2543 the rightmost or bottommost possible position (that stays within the screen). */)
2544 (Lisp_Object frame, Lisp_Object xoffset, Lisp_Object yoffset)
2546 register struct frame *f;
2548 CHECK_LIVE_FRAME (frame);
2549 CHECK_TYPE_RANGED_INTEGER (int, xoffset);
2550 CHECK_TYPE_RANGED_INTEGER (int, yoffset);
2551 f = XFRAME (frame);
2553 /* I think this should be done with a hook. */
2554 #ifdef HAVE_WINDOW_SYSTEM
2555 if (FRAME_WINDOW_P (f))
2556 x_set_offset (f, XINT (xoffset), XINT (yoffset), 1);
2557 #endif
2559 return Qt;
2563 /***********************************************************************
2564 Frame Parameters
2565 ***********************************************************************/
2567 /* Connect the frame-parameter names for X frames
2568 to the ways of passing the parameter values to the window system.
2570 The name of a parameter, as a Lisp symbol,
2571 has an `x-frame-parameter' property which is an integer in Lisp
2572 that is an index in this table. */
2574 struct frame_parm_table {
2575 const char *name;
2576 Lisp_Object *variable;
2579 static const struct frame_parm_table frame_parms[] =
2581 {"auto-raise", &Qauto_raise},
2582 {"auto-lower", &Qauto_lower},
2583 {"background-color", 0},
2584 {"border-color", &Qborder_color},
2585 {"border-width", &Qborder_width},
2586 {"cursor-color", &Qcursor_color},
2587 {"cursor-type", &Qcursor_type},
2588 {"font", 0},
2589 {"foreground-color", 0},
2590 {"icon-name", &Qicon_name},
2591 {"icon-type", &Qicon_type},
2592 {"internal-border-width", &Qinternal_border_width},
2593 {"menu-bar-lines", &Qmenu_bar_lines},
2594 {"mouse-color", &Qmouse_color},
2595 {"name", &Qname},
2596 {"scroll-bar-width", &Qscroll_bar_width},
2597 {"title", &Qtitle},
2598 {"unsplittable", &Qunsplittable},
2599 {"vertical-scroll-bars", &Qvertical_scroll_bars},
2600 {"visibility", &Qvisibility},
2601 {"tool-bar-lines", &Qtool_bar_lines},
2602 {"scroll-bar-foreground", &Qscroll_bar_foreground},
2603 {"scroll-bar-background", &Qscroll_bar_background},
2604 {"screen-gamma", &Qscreen_gamma},
2605 {"line-spacing", &Qline_spacing},
2606 {"left-fringe", &Qleft_fringe},
2607 {"right-fringe", &Qright_fringe},
2608 {"wait-for-wm", &Qwait_for_wm},
2609 {"fullscreen", &Qfullscreen},
2610 {"font-backend", &Qfont_backend},
2611 {"alpha", &Qalpha},
2612 {"sticky", &Qsticky},
2613 {"tool-bar-position", &Qtool_bar_position},
2616 #ifdef HAVE_NTGUI
2618 /* Calculate fullscreen size. Return in *TOP_POS and *LEFT_POS the
2619 wanted positions of the WM window (not Emacs window).
2620 Return in *WIDTH and *HEIGHT the wanted width and height of Emacs
2621 window (FRAME_X_WINDOW).
2624 void
2625 x_fullscreen_adjust (struct frame *f, int *width, int *height, int *top_pos, int *left_pos)
2627 int newwidth = FRAME_COLS (f);
2628 int newheight = FRAME_LINES (f);
2629 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2631 *top_pos = f->top_pos;
2632 *left_pos = f->left_pos;
2634 if (f->want_fullscreen & FULLSCREEN_HEIGHT)
2636 int ph;
2638 ph = x_display_pixel_height (dpyinfo);
2639 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2640 ph = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, newheight) - f->y_pixels_diff;
2641 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2642 *top_pos = 0;
2645 if (f->want_fullscreen & FULLSCREEN_WIDTH)
2647 int pw;
2649 pw = x_display_pixel_width (dpyinfo);
2650 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2651 pw = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, newwidth) - f->x_pixels_diff;
2652 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2653 *left_pos = 0;
2656 *width = newwidth;
2657 *height = newheight;
2660 #endif /* HAVE_NTGUI */
2662 #ifdef HAVE_WINDOW_SYSTEM
2664 /* Change the parameters of frame F as specified by ALIST.
2665 If a parameter is not specially recognized, do nothing special;
2666 otherwise call the `x_set_...' function for that parameter.
2667 Except for certain geometry properties, always call store_frame_param
2668 to store the new value in the parameter alist. */
2670 void
2671 x_set_frame_parameters (FRAME_PTR f, Lisp_Object alist)
2673 Lisp_Object tail;
2675 /* If both of these parameters are present, it's more efficient to
2676 set them both at once. So we wait until we've looked at the
2677 entire list before we set them. */
2678 int width, height;
2680 /* Same here. */
2681 Lisp_Object left, top;
2683 /* Same with these. */
2684 Lisp_Object icon_left, icon_top;
2686 /* Record in these vectors all the parms specified. */
2687 Lisp_Object *parms;
2688 Lisp_Object *values;
2689 ptrdiff_t i, p;
2690 int left_no_change = 0, top_no_change = 0;
2691 int icon_left_no_change = 0, icon_top_no_change = 0;
2692 int size_changed = 0;
2693 struct gcpro gcpro1, gcpro2;
2695 i = 0;
2696 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2697 i++;
2699 parms = alloca (i * sizeof *parms);
2700 values = alloca (i * sizeof *values);
2702 /* Extract parm names and values into those vectors. */
2704 i = 0;
2705 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2707 Lisp_Object elt;
2709 elt = XCAR (tail);
2710 parms[i] = Fcar (elt);
2711 values[i] = Fcdr (elt);
2712 i++;
2714 /* TAIL and ALIST are not used again below here. */
2715 alist = tail = Qnil;
2717 GCPRO2 (*parms, *values);
2718 gcpro1.nvars = i;
2719 gcpro2.nvars = i;
2721 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
2722 because their values appear in VALUES and strings are not valid. */
2723 top = left = Qunbound;
2724 icon_left = icon_top = Qunbound;
2726 /* Provide default values for HEIGHT and WIDTH. */
2727 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2728 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2730 /* Process foreground_color and background_color before anything else.
2731 They are independent of other properties, but other properties (e.g.,
2732 cursor_color) are dependent upon them. */
2733 /* Process default font as well, since fringe widths depends on it. */
2734 for (p = 0; p < i; p++)
2736 Lisp_Object prop, val;
2738 prop = parms[p];
2739 val = values[p];
2740 if (EQ (prop, Qforeground_color)
2741 || EQ (prop, Qbackground_color)
2742 || EQ (prop, Qfont))
2744 register Lisp_Object param_index, old_value;
2746 old_value = get_frame_param (f, prop);
2747 if (NILP (Fequal (val, old_value)))
2749 store_frame_param (f, prop, val);
2751 param_index = Fget (prop, Qx_frame_parameter);
2752 if (NATNUMP (param_index)
2753 && (XFASTINT (param_index)
2754 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2755 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
2756 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2761 /* Now process them in reverse of specified order. */
2762 while (i-- != 0)
2764 Lisp_Object prop, val;
2766 prop = parms[i];
2767 val = values[i];
2769 if (EQ (prop, Qwidth) && RANGED_INTEGERP (0, val, INT_MAX))
2771 size_changed = 1;
2772 width = XFASTINT (val);
2774 else if (EQ (prop, Qheight) && RANGED_INTEGERP (0, val, INT_MAX))
2776 size_changed = 1;
2777 height = XFASTINT (val);
2779 else if (EQ (prop, Qtop))
2780 top = val;
2781 else if (EQ (prop, Qleft))
2782 left = val;
2783 else if (EQ (prop, Qicon_top))
2784 icon_top = val;
2785 else if (EQ (prop, Qicon_left))
2786 icon_left = val;
2787 else if (EQ (prop, Qforeground_color)
2788 || EQ (prop, Qbackground_color)
2789 || EQ (prop, Qfont))
2790 /* Processed above. */
2791 continue;
2792 else
2794 register Lisp_Object param_index, old_value;
2796 old_value = get_frame_param (f, prop);
2798 store_frame_param (f, prop, val);
2800 param_index = Fget (prop, Qx_frame_parameter);
2801 if (NATNUMP (param_index)
2802 && (XFASTINT (param_index)
2803 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2804 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
2805 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2809 /* Don't die if just one of these was set. */
2810 if (EQ (left, Qunbound))
2812 left_no_change = 1;
2813 if (f->left_pos < 0)
2814 left = Fcons (Qplus, Fcons (make_number (f->left_pos), Qnil));
2815 else
2816 XSETINT (left, f->left_pos);
2818 if (EQ (top, Qunbound))
2820 top_no_change = 1;
2821 if (f->top_pos < 0)
2822 top = Fcons (Qplus, Fcons (make_number (f->top_pos), Qnil));
2823 else
2824 XSETINT (top, f->top_pos);
2827 /* If one of the icon positions was not set, preserve or default it. */
2828 if (! TYPE_RANGED_INTEGERP (int, icon_left))
2830 icon_left_no_change = 1;
2831 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
2832 if (NILP (icon_left))
2833 XSETINT (icon_left, 0);
2835 if (! TYPE_RANGED_INTEGERP (int, icon_top))
2837 icon_top_no_change = 1;
2838 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
2839 if (NILP (icon_top))
2840 XSETINT (icon_top, 0);
2843 /* Don't set these parameters unless they've been explicitly
2844 specified. The window might be mapped or resized while we're in
2845 this function, and we don't want to override that unless the lisp
2846 code has asked for it.
2848 Don't set these parameters unless they actually differ from the
2849 window's current parameters; the window may not actually exist
2850 yet. */
2852 Lisp_Object frame;
2854 check_frame_size (f, &height, &width);
2856 XSETFRAME (frame, f);
2858 if (size_changed
2859 && (width != FRAME_COLS (f)
2860 || height != FRAME_LINES (f)
2861 || f->new_text_lines || f->new_text_cols))
2862 Fset_frame_size (frame, make_number (width), make_number (height));
2864 if ((!NILP (left) || !NILP (top))
2865 && ! (left_no_change && top_no_change)
2866 && ! (NUMBERP (left) && XINT (left) == f->left_pos
2867 && NUMBERP (top) && XINT (top) == f->top_pos))
2869 int leftpos = 0;
2870 int toppos = 0;
2872 /* Record the signs. */
2873 f->size_hint_flags &= ~ (XNegative | YNegative);
2874 if (EQ (left, Qminus))
2875 f->size_hint_flags |= XNegative;
2876 else if (TYPE_RANGED_INTEGERP (int, left))
2878 leftpos = XINT (left);
2879 if (leftpos < 0)
2880 f->size_hint_flags |= XNegative;
2882 else if (CONSP (left) && EQ (XCAR (left), Qminus)
2883 && CONSP (XCDR (left))
2884 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (left)), INT_MAX))
2886 leftpos = - XINT (XCAR (XCDR (left)));
2887 f->size_hint_flags |= XNegative;
2889 else if (CONSP (left) && EQ (XCAR (left), Qplus)
2890 && CONSP (XCDR (left))
2891 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (left))))
2893 leftpos = XINT (XCAR (XCDR (left)));
2896 if (EQ (top, Qminus))
2897 f->size_hint_flags |= YNegative;
2898 else if (TYPE_RANGED_INTEGERP (int, top))
2900 toppos = XINT (top);
2901 if (toppos < 0)
2902 f->size_hint_flags |= YNegative;
2904 else if (CONSP (top) && EQ (XCAR (top), Qminus)
2905 && CONSP (XCDR (top))
2906 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (top)), INT_MAX))
2908 toppos = - XINT (XCAR (XCDR (top)));
2909 f->size_hint_flags |= YNegative;
2911 else if (CONSP (top) && EQ (XCAR (top), Qplus)
2912 && CONSP (XCDR (top))
2913 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (top))))
2915 toppos = XINT (XCAR (XCDR (top)));
2919 /* Store the numeric value of the position. */
2920 f->top_pos = toppos;
2921 f->left_pos = leftpos;
2923 f->win_gravity = NorthWestGravity;
2925 /* Actually set that position, and convert to absolute. */
2926 x_set_offset (f, leftpos, toppos, -1);
2929 if ((!NILP (icon_left) || !NILP (icon_top))
2930 && ! (icon_left_no_change && icon_top_no_change))
2931 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
2934 UNGCPRO;
2938 /* Insert a description of internally-recorded parameters of frame X
2939 into the parameter alist *ALISTPTR that is to be given to the user.
2940 Only parameters that are specific to the X window system
2941 and whose values are not correctly recorded in the frame's
2942 param_alist need to be considered here. */
2944 void
2945 x_report_frame_params (struct frame *f, Lisp_Object *alistptr)
2947 Lisp_Object tem;
2948 uprintmax_t w;
2949 char buf[INT_BUFSIZE_BOUND (w)];
2951 /* Represent negative positions (off the top or left screen edge)
2952 in a way that Fmodify_frame_parameters will understand correctly. */
2953 XSETINT (tem, f->left_pos);
2954 if (f->left_pos >= 0)
2955 store_in_alist (alistptr, Qleft, tem);
2956 else
2957 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
2959 XSETINT (tem, f->top_pos);
2960 if (f->top_pos >= 0)
2961 store_in_alist (alistptr, Qtop, tem);
2962 else
2963 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
2965 store_in_alist (alistptr, Qborder_width,
2966 make_number (f->border_width));
2967 store_in_alist (alistptr, Qinternal_border_width,
2968 make_number (FRAME_INTERNAL_BORDER_WIDTH (f)));
2969 store_in_alist (alistptr, Qleft_fringe,
2970 make_number (FRAME_LEFT_FRINGE_WIDTH (f)));
2971 store_in_alist (alistptr, Qright_fringe,
2972 make_number (FRAME_RIGHT_FRINGE_WIDTH (f)));
2973 store_in_alist (alistptr, Qscroll_bar_width,
2974 (! FRAME_HAS_VERTICAL_SCROLL_BARS (f)
2975 ? make_number (0)
2976 : FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0
2977 ? make_number (FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
2978 /* nil means "use default width"
2979 for non-toolkit scroll bar.
2980 ruler-mode.el depends on this. */
2981 : Qnil));
2982 /* FRAME_X_WINDOW is not guaranteed to return an integer. E.g., on
2983 MS-Windows it returns a value whose type is HANDLE, which is
2984 actually a pointer. Explicit casting avoids compiler
2985 warnings. */
2986 w = (uintptr_t) FRAME_X_WINDOW (f);
2987 store_in_alist (alistptr, Qwindow_id,
2988 make_formatted_string (buf, "%"pMu, w));
2989 #ifdef HAVE_X_WINDOWS
2990 #ifdef USE_X_TOOLKIT
2991 /* Tooltip frame may not have this widget. */
2992 if (FRAME_X_OUTPUT (f)->widget)
2993 #endif
2994 w = (uintptr_t) FRAME_OUTER_WINDOW (f);
2995 store_in_alist (alistptr, Qouter_window_id,
2996 make_formatted_string (buf, "%"pMu, w));
2997 #endif
2998 store_in_alist (alistptr, Qicon_name, f->icon_name);
2999 FRAME_SAMPLE_VISIBILITY (f);
3000 store_in_alist (alistptr, Qvisibility,
3001 (FRAME_VISIBLE_P (f) ? Qt
3002 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
3003 store_in_alist (alistptr, Qdisplay,
3004 XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
3006 if (FRAME_X_OUTPUT (f)->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
3007 tem = Qnil;
3008 else
3009 XSETFASTINT (tem, FRAME_X_OUTPUT (f)->parent_desc);
3010 store_in_alist (alistptr, Qexplicit_name, (f->explicit_name ? Qt : Qnil));
3011 store_in_alist (alistptr, Qparent_id, tem);
3012 store_in_alist (alistptr, Qtool_bar_position, f->tool_bar_position);
3016 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
3017 the previous value of that parameter, NEW_VALUE is the new value. */
3019 void
3020 x_set_fullscreen (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3022 if (NILP (new_value))
3023 f->want_fullscreen = FULLSCREEN_NONE;
3024 else if (EQ (new_value, Qfullboth) || EQ (new_value, Qfullscreen))
3025 f->want_fullscreen = FULLSCREEN_BOTH;
3026 else if (EQ (new_value, Qfullwidth))
3027 f->want_fullscreen = FULLSCREEN_WIDTH;
3028 else if (EQ (new_value, Qfullheight))
3029 f->want_fullscreen = FULLSCREEN_HEIGHT;
3030 else if (EQ (new_value, Qmaximized))
3031 f->want_fullscreen = FULLSCREEN_MAXIMIZED;
3033 if (FRAME_TERMINAL (f)->fullscreen_hook != NULL)
3034 FRAME_TERMINAL (f)->fullscreen_hook (f);
3038 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
3039 the previous value of that parameter, NEW_VALUE is the new value. */
3041 void
3042 x_set_line_spacing (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3044 if (NILP (new_value))
3045 f->extra_line_spacing = 0;
3046 else if (RANGED_INTEGERP (0, new_value, INT_MAX))
3047 f->extra_line_spacing = XFASTINT (new_value);
3048 else
3049 signal_error ("Invalid line-spacing", new_value);
3050 if (FRAME_VISIBLE_P (f))
3051 redraw_frame (f);
3055 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
3056 the previous value of that parameter, NEW_VALUE is the new value. */
3058 void
3059 x_set_screen_gamma (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3061 Lisp_Object bgcolor;
3063 if (NILP (new_value))
3064 f->gamma = 0;
3065 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
3066 /* The value 0.4545 is the normal viewing gamma. */
3067 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
3068 else
3069 signal_error ("Invalid screen-gamma", new_value);
3071 /* Apply the new gamma value to the frame background. */
3072 bgcolor = Fassq (Qbackground_color, f->param_alist);
3073 if (CONSP (bgcolor) && (bgcolor = XCDR (bgcolor), STRINGP (bgcolor)))
3075 Lisp_Object parm_index = Fget (Qbackground_color, Qx_frame_parameter);
3076 if (NATNUMP (parm_index)
3077 && (XFASTINT (parm_index)
3078 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3079 && FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
3080 (*FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
3081 (f, bgcolor, Qnil);
3084 Fclear_face_cache (Qnil);
3088 void
3089 x_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3091 Lisp_Object font_object;
3092 int fontset = -1;
3093 #ifdef HAVE_X_WINDOWS
3094 Lisp_Object font_param = arg;
3095 #endif
3097 /* Set the frame parameter back to the old value because we may
3098 fail to use ARG as the new parameter value. */
3099 store_frame_param (f, Qfont, oldval);
3101 /* ARG is a fontset name, a font name, a cons of fontset name and a
3102 font object, or a font object. In the last case, this function
3103 never fail. */
3104 if (STRINGP (arg))
3106 fontset = fs_query_fontset (arg, 0);
3107 if (fontset < 0)
3109 font_object = font_open_by_name (f, arg);
3110 if (NILP (font_object))
3111 error ("Font `%s' is not defined", SSDATA (arg));
3112 arg = AREF (font_object, FONT_NAME_INDEX);
3114 else if (fontset > 0)
3116 font_object = font_open_by_name (f, fontset_ascii (fontset));
3117 if (NILP (font_object))
3118 error ("Font `%s' is not defined", SDATA (arg));
3119 arg = AREF (font_object, FONT_NAME_INDEX);
3121 else
3122 error ("The default fontset can't be used for a frame font");
3124 else if (CONSP (arg) && STRINGP (XCAR (arg)) && FONT_OBJECT_P (XCDR (arg)))
3126 /* This is the case that the ASCII font of F's fontset XCAR
3127 (arg) is changed to the font XCDR (arg) by
3128 `set-fontset-font'. */
3129 fontset = fs_query_fontset (XCAR (arg), 0);
3130 if (fontset < 0)
3131 error ("Unknown fontset: %s", SDATA (XCAR (arg)));
3132 font_object = XCDR (arg);
3133 arg = AREF (font_object, FONT_NAME_INDEX);
3134 #ifdef HAVE_X_WINDOWS
3135 font_param = Ffont_get (font_object, QCname);
3136 #endif
3138 else if (FONT_OBJECT_P (arg))
3140 font_object = arg;
3141 #ifdef HAVE_X_WINDOWS
3142 font_param = Ffont_get (font_object, QCname);
3143 #endif
3144 /* This is to store the XLFD font name in the frame parameter for
3145 backward compatibility. We should store the font-object
3146 itself in the future. */
3147 arg = AREF (font_object, FONT_NAME_INDEX);
3148 fontset = FRAME_FONTSET (f);
3149 /* Check if we can use the current fontset. If not, set FONTSET
3150 to -1 to generate a new fontset from FONT-OBJECT. */
3151 if (fontset >= 0)
3153 Lisp_Object ascii_font = fontset_ascii (fontset);
3154 Lisp_Object spec = font_spec_from_name (ascii_font);
3156 if (NILP (spec))
3157 signal_error ("Invalid font name", ascii_font);
3159 if (! font_match_p (spec, font_object))
3160 fontset = -1;
3163 else
3164 signal_error ("Invalid font", arg);
3166 if (! NILP (Fequal (font_object, oldval)))
3167 return;
3169 x_new_font (f, font_object, fontset);
3170 store_frame_param (f, Qfont, arg);
3171 #ifdef HAVE_X_WINDOWS
3172 store_frame_param (f, Qfont_param, font_param);
3173 #endif
3174 /* Recalculate toolbar height. */
3175 f->n_tool_bar_rows = 0;
3176 /* Ensure we redraw it. */
3177 clear_current_matrices (f);
3179 recompute_basic_faces (f);
3181 do_pending_window_change (0);
3183 /* We used to call face-set-after-frame-default here, but it leads to
3184 recursive calls (since that function can set the `default' face's
3185 font which in turns changes the frame's `font' parameter).
3186 Also I don't know what this call is meant to do, but it seems the
3187 wrong way to do it anyway (it does a lot more work than what seems
3188 reasonable in response to a change to `font'). */
3192 void
3193 x_set_font_backend (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3195 if (! NILP (new_value)
3196 && !CONSP (new_value))
3198 char *p0, *p1;
3200 CHECK_STRING (new_value);
3201 p0 = p1 = SSDATA (new_value);
3202 new_value = Qnil;
3203 while (*p0)
3205 while (*p1 && ! c_isspace (*p1) && *p1 != ',') p1++;
3206 if (p0 < p1)
3207 new_value = Fcons (Fintern (make_string (p0, p1 - p0), Qnil),
3208 new_value);
3209 if (*p1)
3211 int c;
3213 while ((c = *++p1) && c_isspace (c));
3215 p0 = p1;
3217 new_value = Fnreverse (new_value);
3220 if (! NILP (old_value) && ! NILP (Fequal (old_value, new_value)))
3221 return;
3223 if (FRAME_FONT (f))
3224 free_all_realized_faces (Qnil);
3226 new_value = font_update_drivers (f, NILP (new_value) ? Qt : new_value);
3227 if (NILP (new_value))
3229 if (NILP (old_value))
3230 error ("No font backend available");
3231 font_update_drivers (f, old_value);
3232 error ("None of specified font backends are available");
3234 store_frame_param (f, Qfont_backend, new_value);
3236 if (FRAME_FONT (f))
3238 Lisp_Object frame;
3240 XSETFRAME (frame, f);
3241 x_set_font (f, Fframe_parameter (frame, Qfont), Qnil);
3242 ++face_change_count;
3243 ++windows_or_buffers_changed;
3248 void
3249 x_set_fringe_width (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3251 compute_fringe_widths (f, 1);
3252 #ifdef HAVE_X_WINDOWS
3253 /* Must adjust this so window managers report correct number of columns. */
3254 if (FRAME_X_WINDOW (f) != 0)
3255 x_wm_set_size_hint (f, 0, 0);
3256 #endif
3259 void
3260 x_set_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3262 CHECK_TYPE_RANGED_INTEGER (int, arg);
3264 if (XINT (arg) == f->border_width)
3265 return;
3267 if (FRAME_X_WINDOW (f) != 0)
3268 error ("Cannot change the border width of a frame");
3270 f->border_width = XINT (arg);
3273 void
3274 x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3276 int old = FRAME_INTERNAL_BORDER_WIDTH (f);
3278 CHECK_TYPE_RANGED_INTEGER (int, arg);
3279 FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
3280 if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
3281 FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
3283 #ifdef USE_X_TOOLKIT
3284 if (FRAME_X_OUTPUT (f)->edit_widget)
3285 widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
3286 #endif
3288 if (FRAME_INTERNAL_BORDER_WIDTH (f) == old)
3289 return;
3291 if (FRAME_X_WINDOW (f) != 0)
3293 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3294 SET_FRAME_GARBAGED (f);
3295 do_pending_window_change (0);
3297 else
3298 SET_FRAME_GARBAGED (f);
3301 void
3302 x_set_visibility (struct frame *f, Lisp_Object value, Lisp_Object oldval)
3304 Lisp_Object frame;
3305 XSETFRAME (frame, f);
3307 if (NILP (value))
3308 Fmake_frame_invisible (frame, Qt);
3309 else if (EQ (value, Qicon))
3310 Ficonify_frame (frame);
3311 else
3312 Fmake_frame_visible (frame);
3315 void
3316 x_set_autoraise (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3318 f->auto_raise = !EQ (Qnil, arg);
3321 void
3322 x_set_autolower (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3324 f->auto_lower = !EQ (Qnil, arg);
3327 void
3328 x_set_unsplittable (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3330 f->no_split = !NILP (arg);
3333 void
3334 x_set_vertical_scroll_bars (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3336 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
3337 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
3338 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
3339 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
3341 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
3342 = (NILP (arg)
3343 ? vertical_scroll_bar_none
3344 : EQ (Qleft, arg)
3345 ? vertical_scroll_bar_left
3346 : EQ (Qright, arg)
3347 ? vertical_scroll_bar_right
3348 : EQ (Qleft, Vdefault_frame_scroll_bars)
3349 ? vertical_scroll_bar_left
3350 : EQ (Qright, Vdefault_frame_scroll_bars)
3351 ? vertical_scroll_bar_right
3352 : vertical_scroll_bar_none);
3354 /* We set this parameter before creating the X window for the
3355 frame, so we can get the geometry right from the start.
3356 However, if the window hasn't been created yet, we shouldn't
3357 call x_set_window_size. */
3358 if (FRAME_X_WINDOW (f))
3359 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3360 do_pending_window_change (0);
3364 void
3365 x_set_scroll_bar_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3367 int wid = FRAME_COLUMN_WIDTH (f);
3369 if (NILP (arg))
3371 x_set_scroll_bar_default_width (f);
3373 if (FRAME_X_WINDOW (f))
3374 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3375 do_pending_window_change (0);
3377 else if (RANGED_INTEGERP (1, arg, INT_MAX)
3378 && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3380 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
3381 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
3383 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg);
3384 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
3385 if (FRAME_X_WINDOW (f))
3386 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3387 do_pending_window_change (0);
3390 change_frame_size (f, 0, FRAME_COLS (f), 0, 0, 0);
3391 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
3392 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
3397 /* Return non-nil if frame F wants a bitmap icon. */
3399 Lisp_Object
3400 x_icon_type (FRAME_PTR f)
3402 Lisp_Object tem;
3404 tem = assq_no_quit (Qicon_type, f->param_alist);
3405 if (CONSP (tem))
3406 return XCDR (tem);
3407 else
3408 return Qnil;
3411 void
3412 x_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3414 double alpha = 1.0;
3415 double newval[2];
3416 int i;
3417 Lisp_Object item;
3419 for (i = 0; i < 2; i++)
3421 newval[i] = 1.0;
3422 if (CONSP (arg))
3424 item = CAR (arg);
3425 arg = CDR (arg);
3427 else
3428 item = arg;
3430 if (NILP (item))
3431 alpha = - 1.0;
3432 else if (FLOATP (item))
3434 alpha = XFLOAT_DATA (item);
3435 if (alpha < 0.0 || 1.0 < alpha)
3436 args_out_of_range (make_float (0.0), make_float (1.0));
3438 else if (INTEGERP (item))
3440 EMACS_INT ialpha = XINT (item);
3441 if (ialpha < 0 || 100 < ialpha)
3442 args_out_of_range (make_number (0), make_number (100));
3443 else
3444 alpha = ialpha / 100.0;
3446 else
3447 wrong_type_argument (Qnumberp, item);
3448 newval[i] = alpha;
3451 for (i = 0; i < 2; i++)
3452 f->alpha[i] = newval[i];
3454 #if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA)
3455 block_input ();
3456 x_set_frame_alpha (f);
3457 unblock_input ();
3458 #endif
3460 return;
3464 /* Subroutines of creating an X frame. */
3466 /* Make sure that Vx_resource_name is set to a reasonable value.
3467 Fix it up, or set it to `emacs' if it is too hopeless. */
3469 void
3470 validate_x_resource_name (void)
3472 ptrdiff_t len = 0;
3473 /* Number of valid characters in the resource name. */
3474 ptrdiff_t good_count = 0;
3475 /* Number of invalid characters in the resource name. */
3476 ptrdiff_t bad_count = 0;
3477 Lisp_Object new;
3478 ptrdiff_t i;
3480 if (!STRINGP (Vx_resource_class))
3481 Vx_resource_class = build_string (EMACS_CLASS);
3483 if (STRINGP (Vx_resource_name))
3485 unsigned char *p = SDATA (Vx_resource_name);
3487 len = SBYTES (Vx_resource_name);
3489 /* Only letters, digits, - and _ are valid in resource names.
3490 Count the valid characters and count the invalid ones. */
3491 for (i = 0; i < len; i++)
3493 int c = p[i];
3494 if (! ((c >= 'a' && c <= 'z')
3495 || (c >= 'A' && c <= 'Z')
3496 || (c >= '0' && c <= '9')
3497 || c == '-' || c == '_'))
3498 bad_count++;
3499 else
3500 good_count++;
3503 else
3504 /* Not a string => completely invalid. */
3505 bad_count = 5, good_count = 0;
3507 /* If name is valid already, return. */
3508 if (bad_count == 0)
3509 return;
3511 /* If name is entirely invalid, or nearly so, or is so implausibly
3512 large that alloca might not work, use `emacs'. */
3513 if (good_count < 2 || MAX_ALLOCA - sizeof ".customization" < len)
3515 Vx_resource_name = build_string ("emacs");
3516 return;
3519 /* Name is partly valid. Copy it and replace the invalid characters
3520 with underscores. */
3522 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
3524 for (i = 0; i < len; i++)
3526 int c = SREF (new, i);
3527 if (! ((c >= 'a' && c <= 'z')
3528 || (c >= 'A' && c <= 'Z')
3529 || (c >= '0' && c <= '9')
3530 || c == '-' || c == '_'))
3531 SSET (new, i, '_');
3536 extern char *x_get_string_resource (XrmDatabase, const char *, const char *);
3537 extern Display_Info *check_x_display_info (Lisp_Object);
3540 /* Get specified attribute from resource database RDB.
3541 See Fx_get_resource below for other parameters. */
3543 static Lisp_Object
3544 xrdb_get_resource (XrmDatabase rdb, Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3546 register char *value;
3547 char *name_key;
3548 char *class_key;
3550 CHECK_STRING (attribute);
3551 CHECK_STRING (class);
3553 if (!NILP (component))
3554 CHECK_STRING (component);
3555 if (!NILP (subclass))
3556 CHECK_STRING (subclass);
3557 if (NILP (component) != NILP (subclass))
3558 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3560 validate_x_resource_name ();
3562 /* Allocate space for the components, the dots which separate them,
3563 and the final '\0'. Make them big enough for the worst case. */
3564 name_key = alloca (SBYTES (Vx_resource_name)
3565 + (STRINGP (component)
3566 ? SBYTES (component) : 0)
3567 + SBYTES (attribute)
3568 + 3);
3570 class_key = alloca (SBYTES (Vx_resource_class)
3571 + SBYTES (class)
3572 + (STRINGP (subclass)
3573 ? SBYTES (subclass) : 0)
3574 + 3);
3576 /* Start with emacs.FRAMENAME for the name (the specific one)
3577 and with `Emacs' for the class key (the general one). */
3578 strcpy (name_key, SSDATA (Vx_resource_name));
3579 strcpy (class_key, SSDATA (Vx_resource_class));
3581 strcat (class_key, ".");
3582 strcat (class_key, SSDATA (class));
3584 if (!NILP (component))
3586 strcat (class_key, ".");
3587 strcat (class_key, SSDATA (subclass));
3589 strcat (name_key, ".");
3590 strcat (name_key, SSDATA (component));
3593 strcat (name_key, ".");
3594 strcat (name_key, SSDATA (attribute));
3596 value = x_get_string_resource (rdb, name_key, class_key);
3598 if (value != (char *) 0 && *value)
3599 return build_string (value);
3600 else
3601 return Qnil;
3605 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
3606 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
3607 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
3608 class, where INSTANCE is the name under which Emacs was invoked, or
3609 the name specified by the `-name' or `-rn' command-line arguments.
3611 The optional arguments COMPONENT and SUBCLASS add to the key and the
3612 class, respectively. You must specify both of them or neither.
3613 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
3614 and the class is `Emacs.CLASS.SUBCLASS'. */)
3615 (Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3617 #ifdef HAVE_X_WINDOWS
3618 check_x ();
3619 #endif
3621 return xrdb_get_resource (check_x_display_info (Qnil)->xrdb,
3622 attribute, class, component, subclass);
3625 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
3627 Lisp_Object
3628 display_x_get_resource (Display_Info *dpyinfo, Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3630 return xrdb_get_resource (dpyinfo->xrdb,
3631 attribute, class, component, subclass);
3634 #if defined HAVE_X_WINDOWS && !defined USE_X_TOOLKIT
3635 /* Used when C code wants a resource value. */
3636 /* Called from oldXMenu/Create.c. */
3637 char *
3638 x_get_resource_string (const char *attribute, const char *class)
3640 char *result;
3641 struct frame *sf = SELECTED_FRAME ();
3642 ptrdiff_t invocation_namelen = SBYTES (Vinvocation_name);
3643 USE_SAFE_ALLOCA;
3645 /* Allocate space for the components, the dots which separate them,
3646 and the final '\0'. */
3647 char *name_key = SAFE_ALLOCA (invocation_namelen + strlen (attribute) + 2);
3648 char *class_key = alloca ((sizeof (EMACS_CLASS) - 1) + strlen (class) + 2);
3650 esprintf (name_key, "%s.%s", SSDATA (Vinvocation_name), attribute);
3651 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3653 result = x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
3654 name_key, class_key);
3655 SAFE_FREE ();
3656 return result;
3658 #endif
3660 /* Return the value of parameter PARAM.
3662 First search ALIST, then Vdefault_frame_alist, then the X defaults
3663 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3665 Convert the resource to the type specified by desired_type.
3667 If no default is specified, return Qunbound. If you call
3668 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3669 and don't let it get stored in any Lisp-visible variables! */
3671 Lisp_Object
3672 x_get_arg (Display_Info *dpyinfo, Lisp_Object alist, Lisp_Object param,
3673 const char *attribute, const char *class, enum resource_types type)
3675 register Lisp_Object tem;
3677 tem = Fassq (param, alist);
3679 if (!NILP (tem))
3681 /* If we find this parm in ALIST, clear it out
3682 so that it won't be "left over" at the end. */
3683 Lisp_Object tail;
3684 XSETCAR (tem, Qnil);
3685 /* In case the parameter appears more than once in the alist,
3686 clear it out. */
3687 for (tail = alist; CONSP (tail); tail = XCDR (tail))
3688 if (CONSP (XCAR (tail))
3689 && EQ (XCAR (XCAR (tail)), param))
3690 XSETCAR (XCAR (tail), Qnil);
3692 else
3693 tem = Fassq (param, Vdefault_frame_alist);
3695 /* If it wasn't specified in ALIST or the Lisp-level defaults,
3696 look in the X resources. */
3697 if (EQ (tem, Qnil))
3699 if (attribute && dpyinfo)
3701 tem = display_x_get_resource (dpyinfo,
3702 build_string (attribute),
3703 build_string (class),
3704 Qnil, Qnil);
3706 if (NILP (tem))
3707 return Qunbound;
3709 switch (type)
3711 case RES_TYPE_NUMBER:
3712 return make_number (atoi (SSDATA (tem)));
3714 case RES_TYPE_BOOLEAN_NUMBER:
3715 if (!strcmp (SSDATA (tem), "on")
3716 || !strcmp (SSDATA (tem), "true"))
3717 return make_number (1);
3718 return make_number (atoi (SSDATA (tem)));
3719 break;
3721 case RES_TYPE_FLOAT:
3722 return make_float (atof (SSDATA (tem)));
3724 case RES_TYPE_BOOLEAN:
3725 tem = Fdowncase (tem);
3726 if (!strcmp (SSDATA (tem), "on")
3727 #ifdef HAVE_NS
3728 || !strcmp (SSDATA (tem), "yes")
3729 #endif
3730 || !strcmp (SSDATA (tem), "true"))
3731 return Qt;
3732 else
3733 return Qnil;
3735 case RES_TYPE_STRING:
3736 return tem;
3738 case RES_TYPE_SYMBOL:
3739 /* As a special case, we map the values `true' and `on'
3740 to Qt, and `false' and `off' to Qnil. */
3742 Lisp_Object lower;
3743 lower = Fdowncase (tem);
3744 if (!strcmp (SSDATA (lower), "on")
3745 #ifdef HAVE_NS
3746 || !strcmp (SSDATA (lower), "yes")
3747 #endif
3748 || !strcmp (SSDATA (lower), "true"))
3749 return Qt;
3750 else if (!strcmp (SSDATA (lower), "off")
3751 #ifdef HAVE_NS
3752 || !strcmp (SSDATA (lower), "no")
3753 #endif
3754 || !strcmp (SSDATA (lower), "false"))
3755 return Qnil;
3756 else
3757 return Fintern (tem, Qnil);
3760 default:
3761 emacs_abort ();
3764 else
3765 return Qunbound;
3767 return Fcdr (tem);
3770 static Lisp_Object
3771 x_frame_get_arg (struct frame *f, Lisp_Object alist, Lisp_Object param,
3772 const char *attribute, const char *class,
3773 enum resource_types type)
3775 return x_get_arg (FRAME_X_DISPLAY_INFO (f),
3776 alist, param, attribute, class, type);
3779 /* Like x_frame_get_arg, but also record the value in f->param_alist. */
3781 Lisp_Object
3782 x_frame_get_and_record_arg (struct frame *f, Lisp_Object alist,
3783 Lisp_Object param,
3784 const char *attribute, const char *class,
3785 enum resource_types type)
3787 Lisp_Object value;
3789 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
3790 attribute, class, type);
3791 if (! NILP (value) && ! EQ (value, Qunbound))
3792 store_frame_param (f, param, value);
3794 return value;
3798 /* Record in frame F the specified or default value according to ALIST
3799 of the parameter named PROP (a Lisp symbol).
3800 If no value is specified for PROP, look for an X default for XPROP
3801 on the frame named NAME.
3802 If that is not found either, use the value DEFLT. */
3804 Lisp_Object
3805 x_default_parameter (struct frame *f, Lisp_Object alist, Lisp_Object prop,
3806 Lisp_Object deflt, const char *xprop, const char *xclass,
3807 enum resource_types type)
3809 Lisp_Object tem;
3811 tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type);
3812 if (EQ (tem, Qunbound))
3813 tem = deflt;
3814 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
3815 return tem;
3819 #if !defined (HAVE_X_WINDOWS) && defined (NoValue)
3822 * XParseGeometry parses strings of the form
3823 * "=<width>x<height>{+-}<xoffset>{+-}<yoffset>", where
3824 * width, height, xoffset, and yoffset are unsigned integers.
3825 * Example: "=80x24+300-49"
3826 * The equal sign is optional.
3827 * It returns a bitmask that indicates which of the four values
3828 * were actually found in the string. For each value found,
3829 * the corresponding argument is updated; for each value
3830 * not found, the corresponding argument is left unchanged.
3833 static int
3834 XParseGeometry (char *string,
3835 int *x, int *y,
3836 unsigned int *width, unsigned int *height)
3838 int mask = NoValue;
3839 char *strind;
3840 unsigned long int tempWidth, tempHeight;
3841 long int tempX, tempY;
3842 char *nextCharacter;
3844 if (string == NULL || *string == '\0')
3845 return mask;
3846 if (*string == '=')
3847 string++; /* ignore possible '=' at beg of geometry spec */
3849 strind = string;
3850 if (*strind != '+' && *strind != '-' && *strind != 'x')
3852 tempWidth = strtoul (strind, &nextCharacter, 10);
3853 if (strind == nextCharacter)
3854 return 0;
3855 strind = nextCharacter;
3856 mask |= WidthValue;
3859 if (*strind == 'x' || *strind == 'X')
3861 strind++;
3862 tempHeight = strtoul (strind, &nextCharacter, 10);
3863 if (strind == nextCharacter)
3864 return 0;
3865 strind = nextCharacter;
3866 mask |= HeightValue;
3869 if (*strind == '+' || *strind == '-')
3871 if (*strind == '-')
3872 mask |= XNegative;
3873 tempX = strtol (strind, &nextCharacter, 10);
3874 if (strind == nextCharacter)
3875 return 0;
3876 strind = nextCharacter;
3877 mask |= XValue;
3878 if (*strind == '+' || *strind == '-')
3880 if (*strind == '-')
3881 mask |= YNegative;
3882 tempY = strtol (strind, &nextCharacter, 10);
3883 if (strind == nextCharacter)
3884 return 0;
3885 strind = nextCharacter;
3886 mask |= YValue;
3890 /* If strind isn't at the end of the string then it's an invalid
3891 geometry specification. */
3893 if (*strind != '\0')
3894 return 0;
3896 if (mask & XValue)
3897 *x = clip_to_bounds (INT_MIN, tempX, INT_MAX);
3898 if (mask & YValue)
3899 *y = clip_to_bounds (INT_MIN, tempY, INT_MAX);
3900 if (mask & WidthValue)
3901 *width = min (tempWidth, UINT_MAX);
3902 if (mask & HeightValue)
3903 *height = min (tempHeight, UINT_MAX);
3904 return mask;
3907 #endif /* !defined (HAVE_X_WINDOWS) && defined (NoValue) */
3910 /* NS used to define x-parse-geometry in ns-win.el, but that confused
3911 make-docfile: the documentation string in ns-win.el was used for
3912 x-parse-geometry even in non-NS builds.
3914 With two definitions of x-parse-geometry in this file, various
3915 things still get confused (eg M-x apropos documentation), so that
3916 it is best if the two definitions just share the same doc-string.
3918 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
3919 doc: /* Parse a display geometry string STRING.
3920 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3921 The properties returned may include `top', `left', `height', and `width'.
3922 For X, the value of `left' or `top' may be an integer,
3923 or a list (+ N) meaning N pixels relative to top/left corner,
3924 or a list (- N) meaning -N pixels relative to bottom/right corner.
3925 On Nextstep, this just calls `ns-parse-geometry'. */)
3926 (Lisp_Object string)
3928 int geometry, x, y;
3929 unsigned int width, height;
3930 Lisp_Object result;
3932 CHECK_STRING (string);
3934 #ifdef HAVE_NS
3935 if (strchr (SSDATA (string), ' ') != NULL)
3936 return call1 (Qns_parse_geometry, string);
3937 #endif
3938 geometry = XParseGeometry (SSDATA (string),
3939 &x, &y, &width, &height);
3940 result = Qnil;
3941 if (geometry & XValue)
3943 Lisp_Object element;
3945 if (x >= 0 && (geometry & XNegative))
3946 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
3947 else if (x < 0 && ! (geometry & XNegative))
3948 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
3949 else
3950 element = Fcons (Qleft, make_number (x));
3951 result = Fcons (element, result);
3954 if (geometry & YValue)
3956 Lisp_Object element;
3958 if (y >= 0 && (geometry & YNegative))
3959 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
3960 else if (y < 0 && ! (geometry & YNegative))
3961 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
3962 else
3963 element = Fcons (Qtop, make_number (y));
3964 result = Fcons (element, result);
3967 if (geometry & WidthValue)
3968 result = Fcons (Fcons (Qwidth, make_number (width)), result);
3969 if (geometry & HeightValue)
3970 result = Fcons (Fcons (Qheight, make_number (height)), result);
3972 return result;
3976 /* Calculate the desired size and position of frame F.
3977 Return the flags saying which aspects were specified.
3979 Also set the win_gravity and size_hint_flags of F.
3981 Adjust height for toolbar if TOOLBAR_P is 1.
3983 This function does not make the coordinates positive. */
3985 #define DEFAULT_ROWS 35
3986 #define DEFAULT_COLS 80
3989 x_figure_window_size (struct frame *f, Lisp_Object parms, int toolbar_p)
3991 register Lisp_Object tem0, tem1, tem2;
3992 long window_prompting = 0;
3993 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3995 /* Default values if we fall through.
3996 Actually, if that happens we should get
3997 window manager prompting. */
3998 SET_FRAME_COLS (f, DEFAULT_COLS);
3999 FRAME_LINES (f) = DEFAULT_ROWS;
4000 /* Window managers expect that if program-specified
4001 positions are not (0,0), they're intentional, not defaults. */
4002 f->top_pos = 0;
4003 f->left_pos = 0;
4005 /* Ensure that old new_text_cols and new_text_lines will not override the
4006 values set here. */
4007 /* ++KFS: This was specific to W32, but seems ok for all platforms */
4008 f->new_text_cols = f->new_text_lines = 0;
4010 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
4011 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
4012 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
4013 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4015 if (!EQ (tem0, Qunbound))
4017 CHECK_NUMBER (tem0);
4018 if (! (0 <= XINT (tem0) && XINT (tem0) <= INT_MAX))
4019 xsignal1 (Qargs_out_of_range, tem0);
4020 FRAME_LINES (f) = XINT (tem0);
4022 if (!EQ (tem1, Qunbound))
4024 CHECK_NUMBER (tem1);
4025 if (! (0 <= XINT (tem1) && XINT (tem1) <= INT_MAX))
4026 xsignal1 (Qargs_out_of_range, tem1);
4027 SET_FRAME_COLS (f, XINT (tem1));
4029 if (!NILP (tem2) && !EQ (tem2, Qunbound))
4030 window_prompting |= USSize;
4031 else
4032 window_prompting |= PSize;
4035 f->scroll_bar_actual_width
4036 = FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f);
4038 /* This used to be done _before_ calling x_figure_window_size, but
4039 since the height is reset here, this was really a no-op. I
4040 assume that moving it here does what Gerd intended (although he
4041 no longer can remember what that was... ++KFS, 2003-03-25. */
4043 /* Add the tool-bar height to the initial frame height so that the
4044 user gets a text display area of the size he specified with -g or
4045 via .Xdefaults. Later changes of the tool-bar height don't
4046 change the frame size. This is done so that users can create
4047 tall Emacs frames without having to guess how tall the tool-bar
4048 will get. */
4049 if (toolbar_p && FRAME_TOOL_BAR_LINES (f))
4051 int margin, relief, bar_height;
4053 relief = (tool_bar_button_relief >= 0
4054 ? tool_bar_button_relief
4055 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
4057 if (RANGED_INTEGERP (1, Vtool_bar_button_margin, INT_MAX))
4058 margin = XFASTINT (Vtool_bar_button_margin);
4059 else if (CONSP (Vtool_bar_button_margin)
4060 && RANGED_INTEGERP (1, XCDR (Vtool_bar_button_margin), INT_MAX))
4061 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
4062 else
4063 margin = 0;
4065 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
4066 FRAME_LINES (f) += (bar_height + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f);
4069 compute_fringe_widths (f, 0);
4071 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, FRAME_COLS (f));
4072 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, FRAME_LINES (f));
4074 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
4075 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
4076 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
4077 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4079 if (EQ (tem0, Qminus))
4081 f->top_pos = 0;
4082 window_prompting |= YNegative;
4084 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
4085 && CONSP (XCDR (tem0))
4086 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (tem0)), INT_MAX))
4088 f->top_pos = - XINT (XCAR (XCDR (tem0)));
4089 window_prompting |= YNegative;
4091 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
4092 && CONSP (XCDR (tem0))
4093 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (tem0))))
4095 f->top_pos = XINT (XCAR (XCDR (tem0)));
4097 else if (EQ (tem0, Qunbound))
4098 f->top_pos = 0;
4099 else
4101 CHECK_TYPE_RANGED_INTEGER (int, tem0);
4102 f->top_pos = XINT (tem0);
4103 if (f->top_pos < 0)
4104 window_prompting |= YNegative;
4107 if (EQ (tem1, Qminus))
4109 f->left_pos = 0;
4110 window_prompting |= XNegative;
4112 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
4113 && CONSP (XCDR (tem1))
4114 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (tem1)), INT_MAX))
4116 f->left_pos = - XINT (XCAR (XCDR (tem1)));
4117 window_prompting |= XNegative;
4119 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
4120 && CONSP (XCDR (tem1))
4121 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (tem1))))
4123 f->left_pos = XINT (XCAR (XCDR (tem1)));
4125 else if (EQ (tem1, Qunbound))
4126 f->left_pos = 0;
4127 else
4129 CHECK_TYPE_RANGED_INTEGER (int, tem1);
4130 f->left_pos = XINT (tem1);
4131 if (f->left_pos < 0)
4132 window_prompting |= XNegative;
4135 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
4136 window_prompting |= USPosition;
4137 else
4138 window_prompting |= PPosition;
4141 if (window_prompting & XNegative)
4143 if (window_prompting & YNegative)
4144 f->win_gravity = SouthEastGravity;
4145 else
4146 f->win_gravity = NorthEastGravity;
4148 else
4150 if (window_prompting & YNegative)
4151 f->win_gravity = SouthWestGravity;
4152 else
4153 f->win_gravity = NorthWestGravity;
4156 f->size_hint_flags = window_prompting;
4158 return window_prompting;
4163 #endif /* HAVE_WINDOW_SYSTEM */
4165 void
4166 frame_make_pointer_invisible (void)
4168 if (! NILP (Vmake_pointer_invisible))
4170 struct frame *f;
4171 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4172 return;
4174 f = SELECTED_FRAME ();
4175 if (f && !f->pointer_invisible
4176 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4178 f->mouse_moved = 0;
4179 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 1);
4180 f->pointer_invisible = 1;
4185 void
4186 frame_make_pointer_visible (void)
4188 /* We don't check Vmake_pointer_invisible here in case the
4189 pointer was invisible when Vmake_pointer_invisible was set to nil. */
4190 struct frame *f;
4192 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4193 return;
4195 f = SELECTED_FRAME ();
4196 if (f && f->pointer_invisible && f->mouse_moved
4197 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4199 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 0);
4200 f->pointer_invisible = 0;
4204 DEFUN ("frame-pointer-visible-p", Fframe_pointer_visible_p,
4205 Sframe_pointer_visible_p, 0, 1, 0,
4206 doc: /* Return t if the mouse pointer displayed on FRAME is visible.
4207 Otherwise it returns nil. FRAME omitted or nil means the
4208 selected frame. This is useful when `make-pointer-invisible' is set. */)
4209 (Lisp_Object frame)
4211 return decode_any_frame (frame)->pointer_invisible ? Qnil : Qt;
4215 /***********************************************************************
4216 Initialization
4217 ***********************************************************************/
4219 void
4220 syms_of_frame (void)
4222 DEFSYM (Qframep, "framep");
4223 DEFSYM (Qframe_live_p, "frame-live-p");
4224 DEFSYM (Qexplicit_name, "explicit-name");
4225 DEFSYM (Qheight, "height");
4226 DEFSYM (Qicon, "icon");
4227 DEFSYM (Qminibuffer, "minibuffer");
4228 DEFSYM (Qmodeline, "modeline");
4229 DEFSYM (Qonly, "only");
4230 DEFSYM (Qnone, "none");
4231 DEFSYM (Qwidth, "width");
4232 DEFSYM (Qgeometry, "geometry");
4233 DEFSYM (Qicon_left, "icon-left");
4234 DEFSYM (Qicon_top, "icon-top");
4235 DEFSYM (Qtooltip, "tooltip");
4236 DEFSYM (Qleft, "left");
4237 DEFSYM (Qright, "right");
4238 DEFSYM (Quser_position, "user-position");
4239 DEFSYM (Quser_size, "user-size");
4240 DEFSYM (Qwindow_id, "window-id");
4241 #ifdef HAVE_X_WINDOWS
4242 DEFSYM (Qouter_window_id, "outer-window-id");
4243 #endif
4244 DEFSYM (Qparent_id, "parent-id");
4245 DEFSYM (Qx, "x");
4246 DEFSYM (Qw32, "w32");
4247 DEFSYM (Qpc, "pc");
4248 DEFSYM (Qns, "ns");
4249 DEFSYM (Qvisible, "visible");
4250 DEFSYM (Qbuffer_predicate, "buffer-predicate");
4251 DEFSYM (Qbuffer_list, "buffer-list");
4252 DEFSYM (Qburied_buffer_list, "buried-buffer-list");
4253 DEFSYM (Qdisplay_type, "display-type");
4254 DEFSYM (Qbackground_mode, "background-mode");
4255 DEFSYM (Qnoelisp, "noelisp");
4256 DEFSYM (Qtty_color_mode, "tty-color-mode");
4257 DEFSYM (Qtty, "tty");
4258 DEFSYM (Qtty_type, "tty-type");
4260 DEFSYM (Qface_set_after_frame_default, "face-set-after-frame-default");
4262 DEFSYM (Qfullwidth, "fullwidth");
4263 DEFSYM (Qfullheight, "fullheight");
4264 DEFSYM (Qfullboth, "fullboth");
4265 DEFSYM (Qmaximized, "maximized");
4266 DEFSYM (Qx_resource_name, "x-resource-name");
4267 DEFSYM (Qx_frame_parameter, "x-frame-parameter");
4269 DEFSYM (Qterminal, "terminal");
4270 DEFSYM (Qterminal_live_p, "terminal-live-p");
4272 #ifdef HAVE_NS
4273 DEFSYM (Qns_parse_geometry, "ns-parse-geometry");
4274 #endif
4277 int i;
4279 for (i = 0; i < sizeof (frame_parms) / sizeof (frame_parms[0]); i++)
4281 Lisp_Object v = intern_c_string (frame_parms[i].name);
4282 if (frame_parms[i].variable)
4284 *frame_parms[i].variable = v;
4285 staticpro (frame_parms[i].variable);
4287 Fput (v, Qx_frame_parameter, make_number (i));
4291 #ifdef HAVE_WINDOW_SYSTEM
4292 DEFVAR_LISP ("x-resource-name", Vx_resource_name,
4293 doc: /* The name Emacs uses to look up X resources.
4294 `x-get-resource' uses this as the first component of the instance name
4295 when requesting resource values.
4296 Emacs initially sets `x-resource-name' to the name under which Emacs
4297 was invoked, or to the value specified with the `-name' or `-rn'
4298 switches, if present.
4300 It may be useful to bind this variable locally around a call
4301 to `x-get-resource'. See also the variable `x-resource-class'. */);
4302 Vx_resource_name = Qnil;
4304 DEFVAR_LISP ("x-resource-class", Vx_resource_class,
4305 doc: /* The class Emacs uses to look up X resources.
4306 `x-get-resource' uses this as the first component of the instance class
4307 when requesting resource values.
4309 Emacs initially sets `x-resource-class' to "Emacs".
4311 Setting this variable permanently is not a reasonable thing to do,
4312 but binding this variable locally around a call to `x-get-resource'
4313 is a reasonable practice. See also the variable `x-resource-name'. */);
4314 Vx_resource_class = build_string (EMACS_CLASS);
4316 DEFVAR_LISP ("frame-alpha-lower-limit", Vframe_alpha_lower_limit,
4317 doc: /* The lower limit of the frame opacity (alpha transparency).
4318 The value should range from 0 (invisible) to 100 (completely opaque).
4319 You can also use a floating number between 0.0 and 1.0.
4320 The default is 20. */);
4321 Vframe_alpha_lower_limit = make_number (20);
4322 #endif
4324 DEFVAR_LISP ("default-frame-alist", Vdefault_frame_alist,
4325 doc: /* Alist of default values for frame creation.
4326 These may be set in your init file, like this:
4327 (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1)))
4328 These override values given in window system configuration data,
4329 including X Windows' defaults database.
4330 For values specific to the first Emacs frame, see `initial-frame-alist'.
4331 For window-system specific values, see `window-system-default-frame-alist'.
4332 For values specific to the separate minibuffer frame, see
4333 `minibuffer-frame-alist'.
4334 The `menu-bar-lines' element of the list controls whether new frames
4335 have menu bars; `menu-bar-mode' works by altering this element.
4336 Setting this variable does not affect existing frames, only new ones. */);
4337 Vdefault_frame_alist = Qnil;
4339 DEFVAR_LISP ("default-frame-scroll-bars", Vdefault_frame_scroll_bars,
4340 doc: /* Default position of scroll bars on this window-system. */);
4341 #ifdef HAVE_WINDOW_SYSTEM
4342 #if defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA) || (defined (USE_GTK) && defined (USE_TOOLKIT_SCROLL_BARS))
4343 /* MS-Windows, Mac OS X, and GTK have scroll bars on the right by
4344 default. */
4345 Vdefault_frame_scroll_bars = Qright;
4346 #else
4347 Vdefault_frame_scroll_bars = Qleft;
4348 #endif
4349 #else
4350 Vdefault_frame_scroll_bars = Qnil;
4351 #endif
4353 DEFVAR_LISP ("terminal-frame", Vterminal_frame,
4354 doc: /* The initial frame-object, which represents Emacs's stdout. */);
4356 DEFVAR_LISP ("mouse-position-function", Vmouse_position_function,
4357 doc: /* If non-nil, function to transform normal value of `mouse-position'.
4358 `mouse-position' calls this function, passing its usual return value as
4359 argument, and returns whatever this function returns.
4360 This abnormal hook exists for the benefit of packages like `xt-mouse.el'
4361 which need to do mouse handling at the Lisp level. */);
4362 Vmouse_position_function = Qnil;
4364 DEFVAR_LISP ("mouse-highlight", Vmouse_highlight,
4365 doc: /* If non-nil, clickable text is highlighted when mouse is over it.
4366 If the value is an integer, highlighting is only shown after moving the
4367 mouse, while keyboard input turns off the highlight even when the mouse
4368 is over the clickable text. However, the mouse shape still indicates
4369 when the mouse is over clickable text. */);
4370 Vmouse_highlight = Qt;
4372 DEFVAR_LISP ("make-pointer-invisible", Vmake_pointer_invisible,
4373 doc: /* If non-nil, make pointer invisible while typing.
4374 The pointer becomes visible again when the mouse is moved. */);
4375 Vmake_pointer_invisible = Qt;
4377 DEFVAR_LISP ("delete-frame-functions", Vdelete_frame_functions,
4378 doc: /* Functions run before deleting a frame.
4379 The functions are run with one arg, the frame to be deleted.
4380 See `delete-frame'.
4382 Note that functions in this list may be called just before the frame is
4383 actually deleted, or some time later (or even both when an earlier function
4384 in `delete-frame-functions' (indirectly) calls `delete-frame'
4385 recursively). */);
4386 Vdelete_frame_functions = Qnil;
4387 DEFSYM (Qdelete_frame_functions, "delete-frame-functions");
4389 DEFVAR_LISP ("menu-bar-mode", Vmenu_bar_mode,
4390 doc: /* Non-nil if Menu-Bar mode is enabled.
4391 See the command `menu-bar-mode' for a description of this minor mode.
4392 Setting this variable directly does not take effect;
4393 either customize it (see the info node `Easy Customization')
4394 or call the function `menu-bar-mode'. */);
4395 Vmenu_bar_mode = Qt;
4397 DEFVAR_LISP ("tool-bar-mode", Vtool_bar_mode,
4398 doc: /* Non-nil if Tool-Bar mode is enabled.
4399 See the command `tool-bar-mode' for a description of this minor mode.
4400 Setting this variable directly does not take effect;
4401 either customize it (see the info node `Easy Customization')
4402 or call the function `tool-bar-mode'. */);
4403 #ifdef HAVE_WINDOW_SYSTEM
4404 Vtool_bar_mode = Qt;
4405 #else
4406 Vtool_bar_mode = Qnil;
4407 #endif
4409 DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
4410 doc: /* Minibufferless frames use this frame's minibuffer.
4412 Emacs cannot create minibufferless frames unless this is set to an
4413 appropriate surrogate.
4415 Emacs consults this variable only when creating minibufferless
4416 frames; once the frame is created, it sticks with its assigned
4417 minibuffer, no matter what this variable is set to. This means that
4418 this variable doesn't necessarily say anything meaningful about the
4419 current set of frames, or where the minibuffer is currently being
4420 displayed.
4422 This variable is local to the current terminal and cannot be buffer-local. */);
4424 DEFVAR_BOOL ("focus-follows-mouse", focus_follows_mouse,
4425 doc: /* Non-nil if window system changes focus when you move the mouse.
4426 You should set this variable to tell Emacs how your window manager
4427 handles focus, since there is no way in general for Emacs to find out
4428 automatically. See also `mouse-autoselect-window'. */);
4429 focus_follows_mouse = 0;
4431 staticpro (&Vframe_list);
4433 defsubr (&Sframep);
4434 defsubr (&Sframe_live_p);
4435 defsubr (&Swindow_system);
4436 defsubr (&Smake_terminal_frame);
4437 defsubr (&Shandle_switch_frame);
4438 defsubr (&Sselect_frame);
4439 defsubr (&Sselected_frame);
4440 defsubr (&Sframe_list);
4441 defsubr (&Snext_frame);
4442 defsubr (&Sprevious_frame);
4443 defsubr (&Sdelete_frame);
4444 defsubr (&Smouse_position);
4445 defsubr (&Smouse_pixel_position);
4446 defsubr (&Sset_mouse_position);
4447 defsubr (&Sset_mouse_pixel_position);
4448 #if 0
4449 defsubr (&Sframe_configuration);
4450 defsubr (&Srestore_frame_configuration);
4451 #endif
4452 defsubr (&Smake_frame_visible);
4453 defsubr (&Smake_frame_invisible);
4454 defsubr (&Siconify_frame);
4455 defsubr (&Sframe_visible_p);
4456 defsubr (&Svisible_frame_list);
4457 defsubr (&Sraise_frame);
4458 defsubr (&Slower_frame);
4459 defsubr (&Sredirect_frame_focus);
4460 defsubr (&Sframe_focus);
4461 defsubr (&Sframe_parameters);
4462 defsubr (&Sframe_parameter);
4463 defsubr (&Smodify_frame_parameters);
4464 defsubr (&Sframe_char_height);
4465 defsubr (&Sframe_char_width);
4466 defsubr (&Sframe_pixel_height);
4467 defsubr (&Sframe_pixel_width);
4468 defsubr (&Stool_bar_pixel_width);
4469 defsubr (&Sset_frame_height);
4470 defsubr (&Sset_frame_width);
4471 defsubr (&Sset_frame_size);
4472 defsubr (&Sset_frame_position);
4473 defsubr (&Sframe_pointer_visible_p);
4475 #ifdef HAVE_WINDOW_SYSTEM
4476 defsubr (&Sx_get_resource);
4477 defsubr (&Sx_parse_geometry);
4478 #endif