* eshell/em-cmpl.el (eshell-pcomplete): More thoroughly imitate pcomplete.
[emacs.git] / src / frame.c
blob79893abf8265e73753785a8f837df7b34f935e89
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;
135 static void
136 set_menu_bar_lines_1 (Lisp_Object window, int n)
138 struct window *w = XWINDOW (window);
140 w->last_modified = 0;
141 wset_top_line (w, make_number (XFASTINT (w->top_line) + n));
142 wset_total_lines (w, make_number (XFASTINT (w->total_lines) - n));
144 /* Handle just the top child in a vertical split. */
145 if (!NILP (w->vchild))
146 set_menu_bar_lines_1 (w->vchild, n);
148 /* Adjust all children in a horizontal split. */
149 for (window = w->hchild; !NILP (window); window = w->next)
151 w = XWINDOW (window);
152 set_menu_bar_lines_1 (window, n);
156 void
157 set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
159 int nlines;
160 int olines = FRAME_MENU_BAR_LINES (f);
162 /* Right now, menu bars don't work properly in minibuf-only frames;
163 most of the commands try to apply themselves to the minibuffer
164 frame itself, and get an error because you can't switch buffers
165 in or split the minibuffer window. */
166 if (FRAME_MINIBUF_ONLY_P (f))
167 return;
169 if (TYPE_RANGED_INTEGERP (int, value))
170 nlines = XINT (value);
171 else
172 nlines = 0;
174 if (nlines != olines)
176 windows_or_buffers_changed++;
177 FRAME_WINDOW_SIZES_CHANGED (f) = 1;
178 FRAME_MENU_BAR_LINES (f) = nlines;
179 set_menu_bar_lines_1 (f->root_window, nlines - olines);
180 adjust_glyphs (f);
184 Lisp_Object Vframe_list;
187 DEFUN ("framep", Fframep, Sframep, 1, 1, 0,
188 doc: /* Return non-nil if OBJECT is a frame.
189 Value is:
190 t for a termcap frame (a character-only terminal),
191 'x' for an Emacs frame that is really an X window,
192 'w32' for an Emacs frame that is a window on MS-Windows display,
193 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
194 'pc' for a direct-write MS-DOS frame.
195 See also `frame-live-p'. */)
196 (Lisp_Object object)
198 if (!FRAMEP (object))
199 return Qnil;
200 switch (XFRAME (object)->output_method)
202 case output_initial: /* The initial frame is like a termcap frame. */
203 case output_termcap:
204 return Qt;
205 case output_x_window:
206 return Qx;
207 case output_w32:
208 return Qw32;
209 case output_msdos_raw:
210 return Qpc;
211 case output_mac:
212 return Qmac;
213 case output_ns:
214 return Qns;
215 default:
216 emacs_abort ();
220 DEFUN ("frame-live-p", Fframe_live_p, Sframe_live_p, 1, 1, 0,
221 doc: /* Return non-nil if OBJECT is a frame which has not been deleted.
222 Value is nil if OBJECT is not a live frame. If object is a live
223 frame, the return value indicates what sort of terminal device it is
224 displayed on. See the documentation of `framep' for possible
225 return values. */)
226 (Lisp_Object object)
228 return ((FRAMEP (object)
229 && FRAME_LIVE_P (XFRAME (object)))
230 ? Fframep (object)
231 : Qnil);
234 DEFUN ("window-system", Fwindow_system, Swindow_system, 0, 1, 0,
235 doc: /* The name of the window system that FRAME is displaying through.
236 The value is a symbol:
237 nil for a termcap frame (a character-only terminal),
238 'x' for an Emacs frame that is really an X window,
239 'w32' for an Emacs frame that is a window on MS-Windows display,
240 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
241 'pc' for a direct-write MS-DOS frame.
243 FRAME defaults to the currently selected frame.
245 Use of this function as a predicate is deprecated. Instead,
246 use `display-graphic-p' or any of the other `display-*-p'
247 predicates which report frame's specific UI-related capabilities. */)
248 (Lisp_Object frame)
250 Lisp_Object type;
251 if (NILP (frame))
252 frame = selected_frame;
254 type = Fframep (frame);
256 if (NILP (type))
257 wrong_type_argument (Qframep, frame);
259 if (EQ (type, Qt))
260 return Qnil;
261 else
262 return type;
265 struct frame *
266 make_frame (int mini_p)
268 Lisp_Object frame;
269 register struct frame *f;
270 register Lisp_Object root_window;
271 register Lisp_Object mini_window;
273 f = allocate_frame ();
274 XSETFRAME (frame, f);
276 /* Initialize Lisp data. Note that allocate_frame initializes all
277 Lisp data to nil, so do it only for slots which should not be nil. */
278 fset_tool_bar_position (f, Qtop);
280 /* Initialize non-Lisp data. Note that allocate_frame zeroes out all
281 non-Lisp data, so do it only for slots which should not be zero.
282 To avoid subtle bugs and for the sake of readability, it's better to
283 initialize enum members explicitly even if their values are zero. */
284 f->wants_modeline = 1;
285 f->garbaged = 1;
286 f->has_minibuffer = mini_p;
287 f->vertical_scroll_bar_type = vertical_scroll_bar_none;
288 f->column_width = 1; /* !FRAME_WINDOW_P value */
289 f->line_height = 1; /* !FRAME_WINDOW_P value */
290 #ifdef HAVE_WINDOW_SYSTEM
291 f->want_fullscreen = FULLSCREEN_NONE;
292 #endif
294 root_window = make_window ();
295 if (mini_p)
297 mini_window = make_window ();
298 wset_next (XWINDOW (root_window), mini_window);
299 wset_prev (XWINDOW (mini_window), root_window);
300 XWINDOW (mini_window)->mini = 1;
301 wset_frame (XWINDOW (mini_window), frame);
302 fset_minibuffer_window (f, mini_window);
304 else
306 mini_window = Qnil;
307 wset_next (XWINDOW (root_window), Qnil);
308 fset_minibuffer_window (f, Qnil);
311 wset_frame (XWINDOW (root_window), frame);
313 /* 10 is arbitrary,
314 just so that there is "something there."
315 Correct size will be set up later with change_frame_size. */
317 SET_FRAME_COLS (f, 10);
318 FRAME_LINES (f) = 10;
320 wset_total_cols (XWINDOW (root_window), make_number (10));
321 wset_total_lines (XWINDOW (root_window), make_number (mini_p ? 9 : 10));
323 if (mini_p)
325 wset_total_cols (XWINDOW (mini_window), make_number (10));
326 wset_top_line (XWINDOW (mini_window), make_number (9));
327 wset_total_lines (XWINDOW (mini_window), make_number (1));
330 /* Choose a buffer for the frame's root window. */
332 Lisp_Object buf;
334 wset_buffer (XWINDOW (root_window), Qt);
335 buf = Fcurrent_buffer ();
336 /* If buf is a 'hidden' buffer (i.e. one whose name starts with
337 a space), try to find another one. */
338 if (SREF (Fbuffer_name (buf), 0) == ' ')
339 buf = other_buffer_safely (buf);
341 /* Use set_window_buffer, not Fset_window_buffer, and don't let
342 hooks be run by it. The reason is that the whole frame/window
343 arrangement is not yet fully initialized at this point. Windows
344 don't have the right size, glyph matrices aren't initialized
345 etc. Running Lisp functions at this point surely ends in a
346 SEGV. */
347 set_window_buffer (root_window, buf, 0, 0);
348 fset_buffer_list (f, Fcons (buf, Qnil));
351 if (mini_p)
353 wset_buffer (XWINDOW (mini_window), Qt);
354 set_window_buffer (mini_window,
355 (NILP (Vminibuffer_list)
356 ? get_minibuffer (0)
357 : Fcar (Vminibuffer_list)),
358 0, 0);
361 fset_root_window (f, root_window);
362 fset_selected_window (f, root_window);
363 /* Make sure this window seems more recently used than
364 a newly-created, never-selected window. */
365 XWINDOW (f->selected_window)->use_time = ++window_select_count;
367 return f;
370 #ifdef HAVE_WINDOW_SYSTEM
371 /* Make a frame using a separate minibuffer window on another frame.
372 MINI_WINDOW is the minibuffer window to use. nil means use the
373 default (the global minibuffer). */
375 struct frame *
376 make_frame_without_minibuffer (register Lisp_Object mini_window, KBOARD *kb, Lisp_Object display)
378 register struct frame *f;
379 struct gcpro gcpro1;
381 if (!NILP (mini_window))
382 CHECK_LIVE_WINDOW (mini_window);
384 if (!NILP (mini_window)
385 && FRAME_KBOARD (XFRAME (XWINDOW (mini_window)->frame)) != kb)
386 error ("Frame and minibuffer must be on the same terminal");
388 /* Make a frame containing just a root window. */
389 f = make_frame (0);
391 if (NILP (mini_window))
393 /* Use default-minibuffer-frame if possible. */
394 if (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
395 || ! FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))
397 Lisp_Object frame_dummy;
399 XSETFRAME (frame_dummy, f);
400 GCPRO1 (frame_dummy);
401 /* If there's no minibuffer frame to use, create one. */
402 kset_default_minibuffer_frame
403 (kb, call1 (intern ("make-initial-minibuffer-frame"), display));
404 UNGCPRO;
407 mini_window
408 = XFRAME (KVAR (kb, Vdefault_minibuffer_frame))->minibuffer_window;
411 fset_minibuffer_window (f, mini_window);
413 /* Make the chosen minibuffer window display the proper minibuffer,
414 unless it is already showing a minibuffer. */
415 if (NILP (Fmemq (XWINDOW (mini_window)->buffer, Vminibuffer_list)))
416 /* Use set_window_buffer instead of Fset_window_buffer (see
417 discussion of bug#11984, bug#12025, bug#12026). */
418 set_window_buffer (mini_window,
419 (NILP (Vminibuffer_list)
420 ? get_minibuffer (0)
421 : Fcar (Vminibuffer_list)), 0, 0);
422 return f;
425 /* Make a frame containing only a minibuffer window. */
427 struct frame *
428 make_minibuffer_frame (void)
430 /* First make a frame containing just a root window, no minibuffer. */
432 register struct frame *f = make_frame (0);
433 register Lisp_Object mini_window;
434 register Lisp_Object frame;
436 XSETFRAME (frame, f);
438 f->auto_raise = 0;
439 f->auto_lower = 0;
440 f->no_split = 1;
441 f->wants_modeline = 0;
442 f->has_minibuffer = 1;
444 /* Now label the root window as also being the minibuffer.
445 Avoid infinite looping on the window chain by marking next pointer
446 as nil. */
448 mini_window = f->root_window;
449 fset_minibuffer_window (f, mini_window);
450 XWINDOW (mini_window)->mini = 1;
451 wset_next (XWINDOW (mini_window), Qnil);
452 wset_prev (XWINDOW (mini_window), Qnil);
453 wset_frame (XWINDOW (mini_window), frame);
455 /* Put the proper buffer in that window. */
457 /* Use set_window_buffer instead of Fset_window_buffer (see
458 discussion of bug#11984, bug#12025, bug#12026). */
459 set_window_buffer (mini_window,
460 (NILP (Vminibuffer_list)
461 ? get_minibuffer (0)
462 : Fcar (Vminibuffer_list)), 0, 0);
463 return f;
465 #endif /* HAVE_WINDOW_SYSTEM */
467 /* Construct a frame that refers to a terminal. */
469 static printmax_t tty_frame_count;
471 struct frame *
472 make_initial_frame (void)
474 struct frame *f;
475 struct terminal *terminal;
476 Lisp_Object frame;
478 eassert (initial_kboard);
480 /* The first call must initialize Vframe_list. */
481 if (! (NILP (Vframe_list) || CONSP (Vframe_list)))
482 Vframe_list = Qnil;
484 terminal = init_initial_terminal ();
486 f = make_frame (1);
487 XSETFRAME (frame, f);
489 Vframe_list = Fcons (frame, Vframe_list);
491 tty_frame_count = 1;
492 fset_name (f, build_pure_c_string ("F1"));
494 f->visible = 1;
495 f->async_visible = 1;
497 f->output_method = terminal->type;
498 f->terminal = terminal;
499 f->terminal->reference_count++;
500 f->output_data.nothing = 0;
502 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
503 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
505 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
506 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
508 /* The default value of menu-bar-mode is t. */
509 set_menu_bar_lines (f, make_number (1), Qnil);
511 if (!noninteractive)
512 init_frame_faces (f);
514 return f;
518 static struct frame *
519 make_terminal_frame (struct terminal *terminal)
521 register struct frame *f;
522 Lisp_Object frame;
523 char name[sizeof "F" + INT_STRLEN_BOUND (printmax_t)];
525 if (!terminal->name)
526 error ("Terminal is not live, can't create new frames on it");
528 f = make_frame (1);
530 XSETFRAME (frame, f);
531 Vframe_list = Fcons (frame, Vframe_list);
533 fset_name (f, make_formatted_string (name, "F%"pMd, ++tty_frame_count));
535 f->visible = 1; /* FRAME_SET_VISIBLE wd set frame_garbaged. */
536 f->async_visible = 1; /* Don't let visible be cleared later. */
537 f->terminal = terminal;
538 f->terminal->reference_count++;
539 #ifdef MSDOS
540 f->output_data.tty->display_info = &the_only_display_info;
541 if (!inhibit_window_system
542 && (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame))
543 || XFRAME (selected_frame)->output_method == output_msdos_raw))
544 f->output_method = output_msdos_raw;
545 else
546 f->output_method = output_termcap;
547 #else /* not MSDOS */
548 f->output_method = output_termcap;
549 create_tty_output (f);
550 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
551 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
552 #endif /* not MSDOS */
554 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
555 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
556 FRAME_MENU_BAR_LINES(f) = NILP (Vmenu_bar_mode) ? 0 : 1;
558 /* Set the top frame to the newly created frame. */
559 if (FRAMEP (FRAME_TTY (f)->top_frame)
560 && FRAME_LIVE_P (XFRAME (FRAME_TTY (f)->top_frame)))
561 XFRAME (FRAME_TTY (f)->top_frame)->async_visible = 2; /* obscured */
563 FRAME_TTY (f)->top_frame = frame;
565 if (!noninteractive)
566 init_frame_faces (f);
568 return f;
571 /* Get a suitable value for frame parameter PARAMETER for a newly
572 created frame, based on (1) the user-supplied frame parameter
573 alist SUPPLIED_PARMS, and (2) CURRENT_VALUE. */
575 static Lisp_Object
576 get_future_frame_param (Lisp_Object parameter,
577 Lisp_Object supplied_parms,
578 char *current_value)
580 Lisp_Object result;
582 result = Fassq (parameter, supplied_parms);
583 if (NILP (result))
584 result = Fassq (parameter, XFRAME (selected_frame)->param_alist);
585 if (NILP (result) && current_value != NULL)
586 result = build_string (current_value);
587 if (!NILP (result) && !STRINGP (result))
588 result = XCDR (result);
589 if (NILP (result) || !STRINGP (result))
590 result = Qnil;
592 return result;
595 DEFUN ("make-terminal-frame", Fmake_terminal_frame, Smake_terminal_frame,
596 1, 1, 0,
597 doc: /* Create an additional terminal frame, possibly on another terminal.
598 This function takes one argument, an alist specifying frame parameters.
600 You can create multiple frames on a single text terminal, but only one
601 of them (the selected terminal frame) is actually displayed.
603 In practice, generally you don't need to specify any parameters,
604 except when you want to create a new frame on another terminal.
605 In that case, the `tty' parameter specifies the device file to open,
606 and the `tty-type' parameter specifies the terminal type. Example:
608 (make-terminal-frame '((tty . "/dev/pts/5") (tty-type . "xterm")))
610 Note that changing the size of one terminal frame automatically
611 affects all frames on the same terminal device. */)
612 (Lisp_Object parms)
614 struct frame *f;
615 struct terminal *t = NULL;
616 Lisp_Object frame, tem;
617 struct frame *sf = SELECTED_FRAME ();
619 #ifdef MSDOS
620 if (sf->output_method != output_msdos_raw
621 && sf->output_method != output_termcap)
622 emacs_abort ();
623 #else /* not MSDOS */
625 #ifdef WINDOWSNT /* This should work now! */
626 if (sf->output_method != output_termcap)
627 error ("Not using an ASCII terminal now; cannot make a new ASCII frame");
628 #endif
629 #endif /* not MSDOS */
632 Lisp_Object terminal;
634 terminal = Fassq (Qterminal, parms);
635 if (CONSP (terminal))
637 terminal = XCDR (terminal);
638 t = get_terminal (terminal, 1);
640 #ifdef MSDOS
641 if (t && t != the_only_display_info.terminal)
642 /* msdos.c assumes a single tty_display_info object. */
643 error ("Multiple terminals are not supported on this platform");
644 if (!t)
645 t = the_only_display_info.terminal;
646 #endif
649 if (!t)
651 char *name = 0, *type = 0;
652 Lisp_Object tty, tty_type;
654 tty = get_future_frame_param
655 (Qtty, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
656 ? FRAME_TTY (XFRAME (selected_frame))->name
657 : NULL));
658 if (!NILP (tty))
660 name = alloca (SBYTES (tty) + 1);
661 memcpy (name, SSDATA (tty), SBYTES (tty));
662 name[SBYTES (tty)] = 0;
665 tty_type = get_future_frame_param
666 (Qtty_type, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
667 ? FRAME_TTY (XFRAME (selected_frame))->type
668 : NULL));
669 if (!NILP (tty_type))
671 type = alloca (SBYTES (tty_type) + 1);
672 memcpy (type, SSDATA (tty_type), SBYTES (tty_type));
673 type[SBYTES (tty_type)] = 0;
676 t = init_tty (name, type, 0); /* Errors are not fatal. */
679 f = make_terminal_frame (t);
682 int width, height;
683 get_tty_size (fileno (FRAME_TTY (f)->input), &width, &height);
684 change_frame_size (f, height, width, 0, 0, 0);
687 adjust_glyphs (f);
688 calculate_costs (f);
689 XSETFRAME (frame, f);
690 Fmodify_frame_parameters (frame, parms);
691 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty_type,
692 build_string (t->display_info.tty->type)),
693 Qnil));
694 if (t->display_info.tty->name != NULL)
695 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty,
696 build_string (t->display_info.tty->name)),
697 Qnil));
698 else
699 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty, Qnil), Qnil));
701 /* Make the frame face alist be frame-specific, so that each
702 frame could change its face definitions independently. */
703 fset_face_alist (f, Fcopy_alist (sf->face_alist));
704 /* Simple Fcopy_alist isn't enough, because we need the contents of
705 the vectors which are the CDRs of associations in face_alist to
706 be copied as well. */
707 for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem))
708 XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem))));
709 return frame;
713 /* Perform the switch to frame FRAME.
715 If FRAME is a switch-frame event `(switch-frame FRAME1)', use
716 FRAME1 as frame.
718 If TRACK is non-zero and the frame that currently has the focus
719 redirects its focus to the selected frame, redirect that focused
720 frame's focus to FRAME instead.
722 FOR_DELETION non-zero means that the selected frame is being
723 deleted, which includes the possibility that the frame's terminal
724 is dead.
726 The value of NORECORD is passed as argument to Fselect_window. */
728 Lisp_Object
729 do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object norecord)
731 struct frame *sf = SELECTED_FRAME ();
733 /* If FRAME is a switch-frame event, extract the frame we should
734 switch to. */
735 if (CONSP (frame)
736 && EQ (XCAR (frame), Qswitch_frame)
737 && CONSP (XCDR (frame)))
738 frame = XCAR (XCDR (frame));
740 /* This used to say CHECK_LIVE_FRAME, but apparently it's possible for
741 a switch-frame event to arrive after a frame is no longer live,
742 especially when deleting the initial frame during startup. */
743 CHECK_FRAME (frame);
744 if (! FRAME_LIVE_P (XFRAME (frame)))
745 return Qnil;
747 if (sf == XFRAME (frame))
748 return frame;
750 /* This is too greedy; it causes inappropriate focus redirection
751 that's hard to get rid of. */
752 #if 0
753 /* If a frame's focus has been redirected toward the currently
754 selected frame, we should change the redirection to point to the
755 newly selected frame. This means that if the focus is redirected
756 from a minibufferless frame to a surrogate minibuffer frame, we
757 can use `other-window' to switch between all the frames using
758 that minibuffer frame, and the focus redirection will follow us
759 around. */
760 if (track)
762 Lisp_Object tail;
764 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
766 Lisp_Object focus;
768 if (!FRAMEP (XCAR (tail)))
769 emacs_abort ();
771 focus = FRAME_FOCUS_FRAME (XFRAME (XCAR (tail)));
773 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
774 Fredirect_frame_focus (XCAR (tail), frame);
777 #else /* ! 0 */
778 /* Instead, apply it only to the frame we're pointing to. */
779 #ifdef HAVE_WINDOW_SYSTEM
780 if (track && FRAME_WINDOW_P (XFRAME (frame)))
782 Lisp_Object focus, xfocus;
784 xfocus = x_get_focus_frame (XFRAME (frame));
785 if (FRAMEP (xfocus))
787 focus = FRAME_FOCUS_FRAME (XFRAME (xfocus));
788 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
789 Fredirect_frame_focus (xfocus, frame);
792 #endif /* HAVE_X_WINDOWS */
793 #endif /* ! 0 */
795 if (!for_deletion && FRAME_HAS_MINIBUF_P (sf))
796 resize_mini_window (XWINDOW (FRAME_MINIBUF_WINDOW (sf)), 1);
798 if (FRAME_TERMCAP_P (XFRAME (frame)) || FRAME_MSDOS_P (XFRAME (frame)))
800 if (FRAMEP (FRAME_TTY (XFRAME (frame))->top_frame))
801 /* Mark previously displayed frame as now obscured. */
802 XFRAME (FRAME_TTY (XFRAME (frame))->top_frame)->async_visible = 2;
803 XFRAME (frame)->async_visible = 1;
804 FRAME_TTY (XFRAME (frame))->top_frame = frame;
807 selected_frame = frame;
808 if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
809 last_nonminibuf_frame = XFRAME (selected_frame);
811 Fselect_window (XFRAME (frame)->selected_window, norecord);
813 /* We want to make sure that the next event generates a frame-switch
814 event to the appropriate frame. This seems kludgy to me, but
815 before you take it out, make sure that evaluating something like
816 (select-window (frame-root-window (new-frame))) doesn't end up
817 with your typing being interpreted in the new frame instead of
818 the one you're actually typing in. */
819 internal_last_event_frame = Qnil;
821 return frame;
824 DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 2, "e",
825 doc: /* Select FRAME.
826 Subsequent editing commands apply to its selected window.
827 Optional argument NORECORD means to neither change the order of
828 recently selected windows nor the buffer list.
830 The selection of FRAME lasts until the next time the user does
831 something to select a different frame, or until the next time
832 this function is called. If you are using a window system, the
833 previously selected frame may be restored as the selected frame
834 when returning to the command loop, because it still may have
835 the window system's input focus. On a text terminal, the next
836 redisplay will display FRAME.
838 This function returns FRAME, or nil if FRAME has been deleted. */)
839 (Lisp_Object frame, Lisp_Object norecord)
841 return do_switch_frame (frame, 1, 0, norecord);
845 DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 1, "e",
846 doc: /* Handle a switch-frame event EVENT.
847 Switch-frame events are usually bound to this function.
848 A switch-frame event tells Emacs that the window manager has requested
849 that the user's events be directed to the frame mentioned in the event.
850 This function selects the selected window of the frame of EVENT.
852 If EVENT is frame object, handle it as if it were a switch-frame event
853 to that frame. */)
854 (Lisp_Object event)
856 /* Preserve prefix arg that the command loop just cleared. */
857 kset_prefix_arg (current_kboard, Vcurrent_prefix_arg);
858 Frun_hooks (1, &Qmouse_leave_buffer_hook);
859 return do_switch_frame (event, 0, 0, Qnil);
862 DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0,
863 doc: /* Return the frame that is now selected. */)
864 (void)
866 return selected_frame;
869 DEFUN ("frame-list", Fframe_list, Sframe_list,
870 0, 0, 0,
871 doc: /* Return a list of all live frames. */)
872 (void)
874 Lisp_Object frames;
875 frames = Fcopy_sequence (Vframe_list);
876 #ifdef HAVE_WINDOW_SYSTEM
877 if (FRAMEP (tip_frame))
878 frames = Fdelq (tip_frame, frames);
879 #endif
880 return frames;
883 /* Return the next frame in the frame list after FRAME.
884 If MINIBUF is nil, exclude minibuffer-only frames.
885 If MINIBUF is a window, include only its own frame
886 and any frame now using that window as the minibuffer.
887 If MINIBUF is `visible', include all visible frames.
888 If MINIBUF is 0, include all visible and iconified frames.
889 Otherwise, include all frames. */
891 static Lisp_Object
892 next_frame (Lisp_Object frame, Lisp_Object minibuf)
894 Lisp_Object tail;
895 int passed = 0;
897 /* There must always be at least one frame in Vframe_list. */
898 if (! CONSP (Vframe_list))
899 emacs_abort ();
901 /* If this frame is dead, it won't be in Vframe_list, and we'll loop
902 forever. Forestall that. */
903 CHECK_LIVE_FRAME (frame);
905 while (1)
906 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
908 Lisp_Object f;
910 f = XCAR (tail);
912 if (passed
913 && ((!FRAME_TERMCAP_P (XFRAME (f)) && !FRAME_TERMCAP_P (XFRAME (frame))
914 && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
915 || (FRAME_TERMCAP_P (XFRAME (f)) && FRAME_TERMCAP_P (XFRAME (frame))
916 && FRAME_TTY (XFRAME (f)) == FRAME_TTY (XFRAME (frame)))))
918 /* Decide whether this frame is eligible to be returned. */
920 /* If we've looped all the way around without finding any
921 eligible frames, return the original frame. */
922 if (EQ (f, frame))
923 return f;
925 /* Let minibuf decide if this frame is acceptable. */
926 if (NILP (minibuf))
928 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
929 return f;
931 else if (EQ (minibuf, Qvisible))
933 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
934 if (FRAME_VISIBLE_P (XFRAME (f)))
935 return f;
937 else if (INTEGERP (minibuf) && XINT (minibuf) == 0)
939 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
940 if (FRAME_VISIBLE_P (XFRAME (f))
941 || FRAME_ICONIFIED_P (XFRAME (f)))
942 return f;
944 else if (WINDOWP (minibuf))
946 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
947 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
948 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
949 FRAME_FOCUS_FRAME (XFRAME (f))))
950 return f;
952 else
953 return f;
956 if (EQ (frame, f))
957 passed++;
961 /* Return the previous frame in the frame list before FRAME.
962 If MINIBUF is nil, exclude minibuffer-only frames.
963 If MINIBUF is a window, include only its own frame
964 and any frame now using that window as the minibuffer.
965 If MINIBUF is `visible', include all visible frames.
966 If MINIBUF is 0, include all visible and iconified frames.
967 Otherwise, include all frames. */
969 static Lisp_Object
970 prev_frame (Lisp_Object frame, Lisp_Object minibuf)
972 Lisp_Object tail;
973 Lisp_Object prev;
975 /* There must always be at least one frame in Vframe_list. */
976 if (! CONSP (Vframe_list))
977 emacs_abort ();
979 prev = Qnil;
980 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
982 Lisp_Object f;
984 f = XCAR (tail);
985 if (!FRAMEP (f))
986 emacs_abort ();
988 if (EQ (frame, f) && !NILP (prev))
989 return prev;
991 if ((!FRAME_TERMCAP_P (XFRAME (f)) && !FRAME_TERMCAP_P (XFRAME (frame))
992 && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
993 || (FRAME_TERMCAP_P (XFRAME (f)) && FRAME_TERMCAP_P (XFRAME (frame))
994 && FRAME_TTY (XFRAME (f)) == FRAME_TTY (XFRAME (frame))))
996 /* Decide whether this frame is eligible to be returned,
997 according to minibuf. */
998 if (NILP (minibuf))
1000 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
1001 prev = f;
1003 else if (WINDOWP (minibuf))
1005 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
1006 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
1007 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
1008 FRAME_FOCUS_FRAME (XFRAME (f))))
1009 prev = f;
1011 else if (EQ (minibuf, Qvisible))
1013 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1014 if (FRAME_VISIBLE_P (XFRAME (f)))
1015 prev = f;
1017 else if (XFASTINT (minibuf) == 0)
1019 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1020 if (FRAME_VISIBLE_P (XFRAME (f))
1021 || FRAME_ICONIFIED_P (XFRAME (f)))
1022 prev = f;
1024 else
1025 prev = f;
1029 /* We've scanned the entire list. */
1030 if (NILP (prev))
1031 /* We went through the whole frame list without finding a single
1032 acceptable frame. Return the original frame. */
1033 return frame;
1034 else
1035 /* There were no acceptable frames in the list before FRAME; otherwise,
1036 we would have returned directly from the loop. Since PREV is the last
1037 acceptable frame in the list, return it. */
1038 return prev;
1042 DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0,
1043 doc: /* Return the next frame in the frame list after FRAME.
1044 It considers only frames on the same terminal as FRAME.
1045 By default, skip minibuffer-only frames.
1046 If omitted, FRAME defaults to the selected frame.
1047 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1048 If MINIFRAME is a window, include only its own frame
1049 and any frame now using that window as the minibuffer.
1050 If MINIFRAME is `visible', include all visible frames.
1051 If MINIFRAME is 0, include all visible and iconified frames.
1052 Otherwise, include all frames. */)
1053 (Lisp_Object frame, Lisp_Object miniframe)
1055 if (NILP (frame))
1056 frame = selected_frame;
1058 CHECK_LIVE_FRAME (frame);
1059 return next_frame (frame, miniframe);
1062 DEFUN ("previous-frame", Fprevious_frame, Sprevious_frame, 0, 2, 0,
1063 doc: /* Return the previous frame in the frame list before FRAME.
1064 It considers only frames on the same terminal as FRAME.
1065 By default, skip minibuffer-only frames.
1066 If omitted, FRAME defaults to the selected frame.
1067 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1068 If MINIFRAME is a window, include only its own frame
1069 and any frame now using that window as the minibuffer.
1070 If MINIFRAME is `visible', include all visible frames.
1071 If MINIFRAME is 0, include all visible and iconified frames.
1072 Otherwise, include all frames. */)
1073 (Lisp_Object frame, Lisp_Object miniframe)
1075 if (NILP (frame))
1076 frame = selected_frame;
1077 CHECK_LIVE_FRAME (frame);
1078 return prev_frame (frame, miniframe);
1081 /* Return 1 if it is ok to delete frame F;
1082 0 if all frames aside from F are invisible.
1083 (Exception: if F is the terminal frame, and we are using X, return 1.) */
1085 static int
1086 other_visible_frames (FRAME_PTR f)
1088 Lisp_Object frames;
1090 for (frames = Vframe_list; CONSP (frames); frames = XCDR (frames))
1092 Lisp_Object this = XCAR (frames);
1093 if (f == XFRAME (this))
1094 continue;
1096 /* Verify that we can still talk to the frame's X window,
1097 and note any recent change in visibility. */
1098 #ifdef HAVE_WINDOW_SYSTEM
1099 if (FRAME_WINDOW_P (XFRAME (this)))
1101 x_sync (XFRAME (this));
1102 FRAME_SAMPLE_VISIBILITY (XFRAME (this));
1104 #endif
1106 if (FRAME_VISIBLE_P (XFRAME (this))
1107 || FRAME_ICONIFIED_P (XFRAME (this))
1108 /* Allow deleting the terminal frame when at least one X
1109 frame exists. */
1110 || (FRAME_WINDOW_P (XFRAME (this)) && !FRAME_WINDOW_P (f)))
1111 return 1;
1113 return 0;
1116 /* Delete FRAME. When FORCE equals Qnoelisp, delete FRAME
1117 unconditionally. x_connection_closed and delete_terminal use
1118 this. Any other value of FORCE implements the semantics
1119 described for Fdelete_frame. */
1120 Lisp_Object
1121 delete_frame (Lisp_Object frame, Lisp_Object force)
1123 struct frame *f;
1124 struct frame *sf = SELECTED_FRAME ();
1125 struct kboard *kb;
1127 int minibuffer_selected, is_tooltip_frame;
1129 if (EQ (frame, Qnil))
1131 f = sf;
1132 XSETFRAME (frame, f);
1134 else
1136 CHECK_FRAME (frame);
1137 f = XFRAME (frame);
1140 if (! FRAME_LIVE_P (f))
1141 return Qnil;
1143 if (NILP (force) && !other_visible_frames (f))
1144 error ("Attempt to delete the sole visible or iconified frame");
1146 /* x_connection_closed must have set FORCE to `noelisp' in order
1147 to delete the last frame, if it is gone. */
1148 if (NILP (XCDR (Vframe_list)) && !EQ (force, Qnoelisp))
1149 error ("Attempt to delete the only frame");
1151 /* Does this frame have a minibuffer, and is it the surrogate
1152 minibuffer for any other frame? */
1153 if (FRAME_HAS_MINIBUF_P (XFRAME (frame)))
1155 Lisp_Object frames;
1157 for (frames = Vframe_list;
1158 CONSP (frames);
1159 frames = XCDR (frames))
1161 Lisp_Object this;
1162 this = XCAR (frames);
1164 if (! EQ (this, frame)
1165 && EQ (frame,
1166 WINDOW_FRAME (XWINDOW
1167 (FRAME_MINIBUF_WINDOW (XFRAME (this))))))
1169 /* If we MUST delete this frame, delete the other first.
1170 But do this only if FORCE equals `noelisp'. */
1171 if (EQ (force, Qnoelisp))
1172 delete_frame (this, Qnoelisp);
1173 else
1174 error ("Attempt to delete a surrogate minibuffer frame");
1179 is_tooltip_frame = !NILP (Fframe_parameter (frame, intern ("tooltip")));
1181 /* Run `delete-frame-functions' unless FORCE is `noelisp' or
1182 frame is a tooltip. FORCE is set to `noelisp' when handling
1183 a disconnect from the terminal, so we don't dare call Lisp
1184 code. */
1185 if (NILP (Vrun_hooks) || is_tooltip_frame)
1187 else if (EQ (force, Qnoelisp))
1188 pending_funcalls
1189 = Fcons (list3 (Qrun_hook_with_args, Qdelete_frame_functions, frame),
1190 pending_funcalls);
1191 else
1193 #ifdef HAVE_X_WINDOWS
1194 /* Also, save clipboard to the clipboard manager. */
1195 x_clipboard_manager_save_frame (frame);
1196 #endif
1198 safe_call2 (Qrun_hook_with_args, Qdelete_frame_functions, frame);
1201 /* The hook may sometimes (indirectly) cause the frame to be deleted. */
1202 if (! FRAME_LIVE_P (f))
1203 return Qnil;
1205 /* At this point, we are committed to deleting the frame.
1206 There is no more chance for errors to prevent it. */
1208 minibuffer_selected = EQ (minibuf_window, selected_window);
1210 /* Don't let the frame remain selected. */
1211 if (f == sf)
1213 Lisp_Object tail, frame1;
1215 /* Look for another visible frame on the same terminal. */
1216 frame1 = next_frame (frame, Qvisible);
1218 /* If there is none, find *some* other frame. */
1219 if (NILP (frame1) || EQ (frame1, frame))
1221 FOR_EACH_FRAME (tail, frame1)
1223 if (! EQ (frame, frame1) && FRAME_LIVE_P (XFRAME (frame1)))
1225 /* Do not change a text terminal's top-frame. */
1226 struct frame *f1 = XFRAME (frame1);
1227 if (FRAME_TERMCAP_P (f1) || FRAME_MSDOS_P (f1))
1229 Lisp_Object top_frame = FRAME_TTY (f1)->top_frame;
1230 if (!EQ (top_frame, frame))
1231 frame1 = top_frame;
1233 break;
1237 #ifdef NS_IMPL_COCOA
1238 else
1239 /* Under NS, there is no system mechanism for choosing a new
1240 window to get focus -- it is left to application code.
1241 So the portion of THIS application interfacing with NS
1242 needs to know about it. We call Fraise_frame, but the
1243 purpose is really to transfer focus. */
1244 Fraise_frame (frame1);
1245 #endif
1247 do_switch_frame (frame1, 0, 1, Qnil);
1248 sf = SELECTED_FRAME ();
1251 /* Don't allow minibuf_window to remain on a deleted frame. */
1252 if (EQ (f->minibuffer_window, minibuf_window))
1254 /* Use set_window_buffer instead of Fset_window_buffer (see
1255 discussion of bug#11984, bug#12025, bug#12026). */
1256 set_window_buffer (sf->minibuffer_window,
1257 XWINDOW (minibuf_window)->buffer, 0, 0);
1258 minibuf_window = sf->minibuffer_window;
1260 /* If the dying minibuffer window was selected,
1261 select the new one. */
1262 if (minibuffer_selected)
1263 Fselect_window (minibuf_window, Qnil);
1266 /* Don't let echo_area_window to remain on a deleted frame. */
1267 if (EQ (f->minibuffer_window, echo_area_window))
1268 echo_area_window = sf->minibuffer_window;
1270 /* Clear any X selections for this frame. */
1271 #ifdef HAVE_X_WINDOWS
1272 if (FRAME_X_P (f))
1273 x_clear_frame_selections (f);
1274 #endif
1276 /* Free glyphs.
1277 This function must be called before the window tree of the
1278 frame is deleted because windows contain dynamically allocated
1279 memory. */
1280 free_glyphs (f);
1282 #ifdef HAVE_WINDOW_SYSTEM
1283 /* Give chance to each font driver to free a frame specific data. */
1284 font_update_drivers (f, Qnil);
1285 #endif
1287 /* Mark all the windows that used to be on FRAME as deleted, and then
1288 remove the reference to them. */
1289 delete_all_child_windows (f->root_window);
1290 fset_root_window (f, Qnil);
1292 Vframe_list = Fdelq (frame, Vframe_list);
1293 FRAME_SET_VISIBLE (f, 0);
1295 /* Allow the vector of menu bar contents to be freed in the next
1296 garbage collection. The frame object itself may not be garbage
1297 collected until much later, because recent_keys and other data
1298 structures can still refer to it. */
1299 fset_menu_bar_vector (f, Qnil);
1301 /* If FRAME's buffer lists contains killed
1302 buffers, this helps GC to reclaim them. */
1303 fset_buffer_list (f, Qnil);
1304 fset_buried_buffer_list (f, Qnil);
1306 free_font_driver_list (f);
1307 xfree (f->namebuf);
1308 xfree (f->decode_mode_spec_buffer);
1309 xfree (FRAME_INSERT_COST (f));
1310 xfree (FRAME_DELETEN_COST (f));
1311 xfree (FRAME_INSERTN_COST (f));
1312 xfree (FRAME_DELETE_COST (f));
1313 xfree (FRAME_MESSAGE_BUF (f));
1315 /* Since some events are handled at the interrupt level, we may get
1316 an event for f at any time; if we zero out the frame's terminal
1317 now, then we may trip up the event-handling code. Instead, we'll
1318 promise that the terminal of the frame must be valid until we
1319 have called the window-system-dependent frame destruction
1320 routine. */
1322 if (FRAME_TERMINAL (f)->delete_frame_hook)
1323 (*FRAME_TERMINAL (f)->delete_frame_hook) (f);
1326 struct terminal *terminal = FRAME_TERMINAL (f);
1327 f->output_data.nothing = 0;
1328 f->terminal = 0; /* Now the frame is dead. */
1330 /* If needed, delete the terminal that this frame was on.
1331 (This must be done after the frame is killed.) */
1332 terminal->reference_count--;
1333 #ifdef USE_GTK
1334 /* FIXME: Deleting the terminal crashes emacs because of a GTK
1335 bug.
1336 http://lists.gnu.org/archive/html/emacs-devel/2011-10/msg00363.html */
1337 if (terminal->reference_count == 0 && terminal->type == output_x_window)
1338 terminal->reference_count = 1;
1339 #endif /* USE_GTK */
1340 if (terminal->reference_count == 0)
1342 Lisp_Object tmp;
1343 XSETTERMINAL (tmp, terminal);
1345 kb = NULL;
1346 Fdelete_terminal (tmp, NILP (force) ? Qt : force);
1348 else
1349 kb = terminal->kboard;
1352 /* If we've deleted the last_nonminibuf_frame, then try to find
1353 another one. */
1354 if (f == last_nonminibuf_frame)
1356 Lisp_Object frames;
1358 last_nonminibuf_frame = 0;
1360 for (frames = Vframe_list;
1361 CONSP (frames);
1362 frames = XCDR (frames))
1364 f = XFRAME (XCAR (frames));
1365 if (!FRAME_MINIBUF_ONLY_P (f))
1367 last_nonminibuf_frame = f;
1368 break;
1373 /* If there's no other frame on the same kboard, get out of
1374 single-kboard state if we're in it for this kboard. */
1375 if (kb != NULL)
1377 Lisp_Object frames;
1378 /* Some frame we found on the same kboard, or nil if there are none. */
1379 Lisp_Object frame_on_same_kboard;
1381 frame_on_same_kboard = Qnil;
1383 for (frames = Vframe_list;
1384 CONSP (frames);
1385 frames = XCDR (frames))
1387 Lisp_Object this;
1388 struct frame *f1;
1390 this = XCAR (frames);
1391 if (!FRAMEP (this))
1392 emacs_abort ();
1393 f1 = XFRAME (this);
1395 if (kb == FRAME_KBOARD (f1))
1396 frame_on_same_kboard = this;
1399 if (NILP (frame_on_same_kboard))
1400 not_single_kboard_state (kb);
1404 /* If we've deleted this keyboard's default_minibuffer_frame, try to
1405 find another one. Prefer minibuffer-only frames, but also notice
1406 frames with other windows. */
1407 if (kb != NULL && EQ (frame, KVAR (kb, Vdefault_minibuffer_frame)))
1409 Lisp_Object frames;
1411 /* The last frame we saw with a minibuffer, minibuffer-only or not. */
1412 Lisp_Object frame_with_minibuf;
1413 /* Some frame we found on the same kboard, or nil if there are none. */
1414 Lisp_Object frame_on_same_kboard;
1416 frame_on_same_kboard = Qnil;
1417 frame_with_minibuf = Qnil;
1419 for (frames = Vframe_list;
1420 CONSP (frames);
1421 frames = XCDR (frames))
1423 Lisp_Object this;
1424 struct frame *f1;
1426 this = XCAR (frames);
1427 if (!FRAMEP (this))
1428 emacs_abort ();
1429 f1 = XFRAME (this);
1431 /* Consider only frames on the same kboard
1432 and only those with minibuffers. */
1433 if (kb == FRAME_KBOARD (f1)
1434 && FRAME_HAS_MINIBUF_P (f1))
1436 frame_with_minibuf = this;
1437 if (FRAME_MINIBUF_ONLY_P (f1))
1438 break;
1441 if (kb == FRAME_KBOARD (f1))
1442 frame_on_same_kboard = this;
1445 if (!NILP (frame_on_same_kboard))
1447 /* We know that there must be some frame with a minibuffer out
1448 there. If this were not true, all of the frames present
1449 would have to be minibufferless, which implies that at some
1450 point their minibuffer frames must have been deleted, but
1451 that is prohibited at the top; you can't delete surrogate
1452 minibuffer frames. */
1453 if (NILP (frame_with_minibuf))
1454 emacs_abort ();
1456 kset_default_minibuffer_frame (kb, frame_with_minibuf);
1458 else
1459 /* No frames left on this kboard--say no minibuffer either. */
1460 kset_default_minibuffer_frame (kb, Qnil);
1463 /* Cause frame titles to update--necessary if we now have just one frame. */
1464 if (!is_tooltip_frame)
1465 update_mode_lines = 1;
1467 return Qnil;
1470 DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 2, "",
1471 doc: /* Delete FRAME, permanently eliminating it from use.
1472 FRAME defaults to the selected frame.
1474 A frame may not be deleted if its minibuffer is used by other frames.
1475 Normally, you may not delete a frame if all other frames are invisible,
1476 but if the second optional argument FORCE is non-nil, you may do so.
1478 This function runs `delete-frame-functions' before actually
1479 deleting the frame, unless the frame is a tooltip.
1480 The functions are run with one argument, the frame to be deleted. */)
1481 (Lisp_Object frame, Lisp_Object force)
1483 return delete_frame (frame, !NILP (force) ? Qt : Qnil);
1487 /* Return mouse position in character cell units. */
1489 DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0,
1490 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1491 The position is given in character cells, where (0, 0) is the
1492 upper-left corner of the frame, X is the horizontal offset, and Y is
1493 the vertical offset.
1494 If Emacs is running on a mouseless terminal or hasn't been programmed
1495 to read the mouse position, it returns the selected frame for FRAME
1496 and nil for X and Y.
1497 If `mouse-position-function' is non-nil, `mouse-position' calls it,
1498 passing the normal return value to that function as an argument,
1499 and returns whatever that function returns. */)
1500 (void)
1502 FRAME_PTR f;
1503 Lisp_Object lispy_dummy;
1504 Lisp_Object x, y, retval;
1505 struct gcpro gcpro1;
1507 f = SELECTED_FRAME ();
1508 x = y = Qnil;
1510 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
1511 /* It's okay for the hook to refrain from storing anything. */
1512 if (FRAME_TERMINAL (f)->mouse_position_hook)
1514 enum scroll_bar_part party_dummy;
1515 Time time_dummy;
1516 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1517 &lispy_dummy, &party_dummy,
1518 &x, &y,
1519 &time_dummy);
1522 if (! NILP (x))
1524 int col = XINT (x);
1525 int row = XINT (y);
1526 pixel_to_glyph_coords (f, col, row, &col, &row, NULL, 1);
1527 XSETINT (x, col);
1528 XSETINT (y, row);
1530 #endif
1531 XSETFRAME (lispy_dummy, f);
1532 retval = Fcons (lispy_dummy, Fcons (x, y));
1533 GCPRO1 (retval);
1534 if (!NILP (Vmouse_position_function))
1535 retval = call1 (Vmouse_position_function, retval);
1536 RETURN_UNGCPRO (retval);
1539 DEFUN ("mouse-pixel-position", Fmouse_pixel_position,
1540 Smouse_pixel_position, 0, 0, 0,
1541 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1542 The position is given in pixel units, where (0, 0) is the
1543 upper-left corner of the frame, X is the horizontal offset, and Y is
1544 the vertical offset.
1545 If Emacs is running on a mouseless terminal or hasn't been programmed
1546 to read the mouse position, it returns the selected frame for FRAME
1547 and nil for X and Y. */)
1548 (void)
1550 FRAME_PTR f;
1551 Lisp_Object lispy_dummy;
1552 Lisp_Object x, y;
1554 f = SELECTED_FRAME ();
1555 x = y = Qnil;
1557 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
1558 /* It's okay for the hook to refrain from storing anything. */
1559 if (FRAME_TERMINAL (f)->mouse_position_hook)
1561 enum scroll_bar_part party_dummy;
1562 Time time_dummy;
1563 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1564 &lispy_dummy, &party_dummy,
1565 &x, &y,
1566 &time_dummy);
1569 #endif
1570 XSETFRAME (lispy_dummy, f);
1571 return Fcons (lispy_dummy, Fcons (x, y));
1574 DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0,
1575 doc: /* Move the mouse pointer to the center of character cell (X,Y) in FRAME.
1576 Coordinates are relative to the frame, not a window,
1577 so the coordinates of the top left character in the frame
1578 may be nonzero due to left-hand scroll bars or the menu bar.
1580 The position is given in character cells, where (0, 0) is the
1581 upper-left corner of the frame, X is the horizontal offset, and Y is
1582 the vertical offset.
1584 This function is a no-op for an X frame that is not visible.
1585 If you have just created a frame, you must wait for it to become visible
1586 before calling this function on it, like this.
1587 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1588 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1590 CHECK_LIVE_FRAME (frame);
1591 CHECK_TYPE_RANGED_INTEGER (int, x);
1592 CHECK_TYPE_RANGED_INTEGER (int, y);
1594 /* I think this should be done with a hook. */
1595 #ifdef HAVE_WINDOW_SYSTEM
1596 if (FRAME_WINDOW_P (XFRAME (frame)))
1597 /* Warping the mouse will cause enternotify and focus events. */
1598 x_set_mouse_position (XFRAME (frame), XINT (x), XINT (y));
1599 #else
1600 #if defined (MSDOS) && defined (HAVE_MOUSE)
1601 if (FRAME_MSDOS_P (XFRAME (frame)))
1603 Fselect_frame (frame, Qnil);
1604 mouse_moveto (XINT (x), XINT (y));
1606 #else
1607 #ifdef HAVE_GPM
1609 Fselect_frame (frame, Qnil);
1610 term_mouse_moveto (XINT (x), XINT (y));
1612 #endif
1613 #endif
1614 #endif
1616 return Qnil;
1619 DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position,
1620 Sset_mouse_pixel_position, 3, 3, 0,
1621 doc: /* Move the mouse pointer to pixel position (X,Y) in FRAME.
1622 The position is given in pixels, where (0, 0) is the upper-left corner
1623 of the frame, X is the horizontal offset, and Y is the vertical offset.
1625 Note, this is a no-op for an X frame that is not visible.
1626 If you have just created a frame, you must wait for it to become visible
1627 before calling this function on it, like this.
1628 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1629 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1631 CHECK_LIVE_FRAME (frame);
1632 CHECK_TYPE_RANGED_INTEGER (int, x);
1633 CHECK_TYPE_RANGED_INTEGER (int, y);
1635 /* I think this should be done with a hook. */
1636 #ifdef HAVE_WINDOW_SYSTEM
1637 if (FRAME_WINDOW_P (XFRAME (frame)))
1638 /* Warping the mouse will cause enternotify and focus events. */
1639 x_set_mouse_pixel_position (XFRAME (frame), XINT (x), XINT (y));
1640 #else
1641 #if defined (MSDOS) && defined (HAVE_MOUSE)
1642 if (FRAME_MSDOS_P (XFRAME (frame)))
1644 Fselect_frame (frame, Qnil);
1645 mouse_moveto (XINT (x), XINT (y));
1647 #else
1648 #ifdef HAVE_GPM
1650 Fselect_frame (frame, Qnil);
1651 term_mouse_moveto (XINT (x), XINT (y));
1653 #endif
1654 #endif
1655 #endif
1657 return Qnil;
1660 static void make_frame_visible_1 (Lisp_Object);
1662 DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible,
1663 0, 1, "",
1664 doc: /* Make the frame FRAME visible (assuming it is an X window).
1665 If omitted, FRAME defaults to the currently selected frame. */)
1666 (Lisp_Object frame)
1668 if (NILP (frame))
1669 frame = selected_frame;
1671 CHECK_LIVE_FRAME (frame);
1673 /* I think this should be done with a hook. */
1674 #ifdef HAVE_WINDOW_SYSTEM
1675 if (FRAME_WINDOW_P (XFRAME (frame)))
1677 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1678 x_make_frame_visible (XFRAME (frame));
1680 #endif
1682 make_frame_visible_1 (XFRAME (frame)->root_window);
1684 /* Make menu bar update for the Buffers and Frames menus. */
1685 windows_or_buffers_changed++;
1687 return frame;
1690 /* Update the display_time slot of the buffers shown in WINDOW
1691 and all its descendants. */
1693 static void
1694 make_frame_visible_1 (Lisp_Object window)
1696 struct window *w;
1698 for (;!NILP (window); window = w->next)
1700 w = XWINDOW (window);
1702 if (!NILP (w->buffer))
1703 bset_display_time (XBUFFER (w->buffer), Fcurrent_time ());
1705 if (!NILP (w->vchild))
1706 make_frame_visible_1 (w->vchild);
1707 if (!NILP (w->hchild))
1708 make_frame_visible_1 (w->hchild);
1712 DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible,
1713 0, 2, "",
1714 doc: /* Make the frame FRAME invisible.
1715 If omitted, FRAME defaults to the currently selected frame.
1716 On graphical displays, invisible frames are not updated and are
1717 usually not displayed at all, even in a window system's \"taskbar\".
1719 Normally you may not make FRAME invisible if all other frames are invisible,
1720 but if the second optional argument FORCE is non-nil, you may do so.
1722 This function has no effect on text terminal frames. Such frames are
1723 always considered visible, whether or not they are currently being
1724 displayed in the terminal. */)
1725 (Lisp_Object frame, Lisp_Object force)
1727 if (NILP (frame))
1728 frame = selected_frame;
1730 CHECK_LIVE_FRAME (frame);
1732 if (NILP (force) && !other_visible_frames (XFRAME (frame)))
1733 error ("Attempt to make invisible the sole visible or iconified frame");
1735 /* Don't allow minibuf_window to remain on a deleted frame. */
1736 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1738 struct frame *sf = XFRAME (selected_frame);
1739 /* Use set_window_buffer instead of Fset_window_buffer (see
1740 discussion of bug#11984, bug#12025, bug#12026). */
1741 set_window_buffer (sf->minibuffer_window,
1742 XWINDOW (minibuf_window)->buffer, 0, 0);
1743 minibuf_window = sf->minibuffer_window;
1746 /* I think this should be done with a hook. */
1747 #ifdef HAVE_WINDOW_SYSTEM
1748 if (FRAME_WINDOW_P (XFRAME (frame)))
1749 x_make_frame_invisible (XFRAME (frame));
1750 #endif
1752 /* Make menu bar update for the Buffers and Frames menus. */
1753 windows_or_buffers_changed++;
1755 return Qnil;
1758 DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame,
1759 0, 1, "",
1760 doc: /* Make the frame FRAME into an icon.
1761 If omitted, FRAME defaults to the currently selected frame. */)
1762 (Lisp_Object frame)
1764 if (NILP (frame))
1765 frame = selected_frame;
1767 CHECK_LIVE_FRAME (frame);
1769 #if 0 /* This isn't logically necessary, and it can do GC. */
1770 /* Don't let the frame remain selected. */
1771 if (EQ (frame, selected_frame))
1772 Fhandle_switch_frame (next_frame (frame, Qt));
1773 #endif
1775 /* Don't allow minibuf_window to remain on an iconified frame. */
1776 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1778 struct frame *sf = XFRAME (selected_frame);
1779 /* Use set_window_buffer instead of Fset_window_buffer (see
1780 discussion of bug#11984, bug#12025, bug#12026). */
1781 set_window_buffer (sf->minibuffer_window,
1782 XWINDOW (minibuf_window)->buffer, 0, 0);
1783 minibuf_window = sf->minibuffer_window;
1786 /* I think this should be done with a hook. */
1787 #ifdef HAVE_WINDOW_SYSTEM
1788 if (FRAME_WINDOW_P (XFRAME (frame)))
1789 x_iconify_frame (XFRAME (frame));
1790 #endif
1792 /* Make menu bar update for the Buffers and Frames menus. */
1793 windows_or_buffers_changed++;
1795 return Qnil;
1798 DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p,
1799 1, 1, 0,
1800 doc: /* Return t if FRAME is \"visible\" (actually in use for display).
1801 Return the symbol `icon' if FRAME is iconified or \"minimized\".
1802 Return nil if FRAME was made invisible, via `make-frame-invisible'.
1803 On graphical displays, invisible frames are not updated and are
1804 usually not displayed at all, even in a window system's \"taskbar\".
1806 If FRAME is a text terminal frame, this always returns t.
1807 Such frames are always considered visible, whether or not they are
1808 currently being displayed on the terminal. */)
1809 (Lisp_Object frame)
1811 CHECK_LIVE_FRAME (frame);
1813 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1815 if (FRAME_VISIBLE_P (XFRAME (frame)))
1816 return Qt;
1817 if (FRAME_ICONIFIED_P (XFRAME (frame)))
1818 return Qicon;
1819 return Qnil;
1822 DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list,
1823 0, 0, 0,
1824 doc: /* Return a list of all frames now \"visible\" (being updated). */)
1825 (void)
1827 Lisp_Object tail, frame;
1828 struct frame *f;
1829 Lisp_Object value;
1831 value = Qnil;
1832 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1834 frame = XCAR (tail);
1835 if (!FRAMEP (frame))
1836 continue;
1837 f = XFRAME (frame);
1838 if (FRAME_VISIBLE_P (f))
1839 value = Fcons (frame, value);
1841 return value;
1845 DEFUN ("raise-frame", Fraise_frame, Sraise_frame, 0, 1, "",
1846 doc: /* Bring FRAME to the front, so it occludes any frames it overlaps.
1847 If FRAME is invisible or iconified, make it visible.
1848 If you don't specify a frame, the selected frame is used.
1849 If Emacs is displaying on an ordinary terminal or some other device which
1850 doesn't support multiple overlapping frames, this function selects FRAME. */)
1851 (Lisp_Object frame)
1853 struct frame *f;
1854 if (NILP (frame))
1855 frame = selected_frame;
1857 CHECK_LIVE_FRAME (frame);
1859 f = XFRAME (frame);
1861 if (FRAME_TERMCAP_P (f))
1862 /* On a text terminal select FRAME. */
1863 Fselect_frame (frame, Qnil);
1864 else
1865 /* Do like the documentation says. */
1866 Fmake_frame_visible (frame);
1868 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
1869 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 1);
1871 return Qnil;
1874 /* Should we have a corresponding function called Flower_Power? */
1875 DEFUN ("lower-frame", Flower_frame, Slower_frame, 0, 1, "",
1876 doc: /* Send FRAME to the back, so it is occluded by any frames that overlap it.
1877 If you don't specify a frame, the selected frame is used.
1878 If Emacs is displaying on an ordinary terminal or some other device which
1879 doesn't support multiple overlapping frames, this function does nothing. */)
1880 (Lisp_Object frame)
1882 struct frame *f;
1884 if (NILP (frame))
1885 frame = selected_frame;
1887 CHECK_LIVE_FRAME (frame);
1889 f = XFRAME (frame);
1891 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
1892 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 0);
1894 return Qnil;
1898 DEFUN ("redirect-frame-focus", Fredirect_frame_focus, Sredirect_frame_focus,
1899 1, 2, 0,
1900 doc: /* Arrange for keystrokes typed at FRAME to be sent to FOCUS-FRAME.
1901 In other words, switch-frame events caused by events in FRAME will
1902 request a switch to FOCUS-FRAME, and `last-event-frame' will be
1903 FOCUS-FRAME after reading an event typed at FRAME.
1905 If FOCUS-FRAME is nil, any existing redirection is canceled, and the
1906 frame again receives its own keystrokes.
1908 Focus redirection is useful for temporarily redirecting keystrokes to
1909 a surrogate minibuffer frame when a frame doesn't have its own
1910 minibuffer window.
1912 A frame's focus redirection can be changed by `select-frame'. If frame
1913 FOO is selected, and then a different frame BAR is selected, any
1914 frames redirecting their focus to FOO are shifted to redirect their
1915 focus to BAR. This allows focus redirection to work properly when the
1916 user switches from one frame to another using `select-window'.
1918 This means that a frame whose focus is redirected to itself is treated
1919 differently from a frame whose focus is redirected to nil; the former
1920 is affected by `select-frame', while the latter is not.
1922 The redirection lasts until `redirect-frame-focus' is called to change it. */)
1923 (Lisp_Object frame, Lisp_Object focus_frame)
1925 struct frame *f;
1927 /* Note that we don't check for a live frame here. It's reasonable
1928 to redirect the focus of a frame you're about to delete, if you
1929 know what other frame should receive those keystrokes. */
1930 CHECK_FRAME (frame);
1932 if (! NILP (focus_frame))
1933 CHECK_LIVE_FRAME (focus_frame);
1935 f = XFRAME (frame);
1937 fset_focus_frame (f, focus_frame);
1939 if (FRAME_TERMINAL (f)->frame_rehighlight_hook)
1940 (*FRAME_TERMINAL (f)->frame_rehighlight_hook) (f);
1942 return Qnil;
1946 DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 1, 1, 0,
1947 doc: /* Return the frame to which FRAME's keystrokes are currently being sent.
1948 This returns nil if FRAME's focus is not redirected.
1949 See `redirect-frame-focus'. */)
1950 (Lisp_Object frame)
1952 CHECK_LIVE_FRAME (frame);
1954 return FRAME_FOCUS_FRAME (XFRAME (frame));
1959 /* Return the value of frame parameter PROP in frame FRAME. */
1961 #ifdef HAVE_WINDOW_SYSTEM
1962 #if !HAVE_NS
1963 static
1964 #endif
1965 Lisp_Object
1966 get_frame_param (register struct frame *frame, Lisp_Object prop)
1968 register Lisp_Object tem;
1970 tem = Fassq (prop, frame->param_alist);
1971 if (EQ (tem, Qnil))
1972 return tem;
1973 return Fcdr (tem);
1975 #endif
1977 /* Return the buffer-predicate of the selected frame. */
1979 Lisp_Object
1980 frame_buffer_predicate (Lisp_Object frame)
1982 return XFRAME (frame)->buffer_predicate;
1985 /* Return the buffer-list of the selected frame. */
1987 static Lisp_Object
1988 frame_buffer_list (Lisp_Object frame)
1990 return XFRAME (frame)->buffer_list;
1993 /* Discard BUFFER from the buffer-list and buried-buffer-list of each frame. */
1995 void
1996 frames_discard_buffer (Lisp_Object buffer)
1998 Lisp_Object frame, tail;
2000 FOR_EACH_FRAME (tail, frame)
2002 fset_buffer_list
2003 (XFRAME (frame), Fdelq (buffer, XFRAME (frame)->buffer_list));
2004 fset_buried_buffer_list
2005 (XFRAME (frame), Fdelq (buffer, XFRAME (frame)->buried_buffer_list));
2009 /* Modify the alist in *ALISTPTR to associate PROP with VAL.
2010 If the alist already has an element for PROP, we change it. */
2012 void
2013 store_in_alist (Lisp_Object *alistptr, Lisp_Object prop, Lisp_Object val)
2015 register Lisp_Object tem;
2017 tem = Fassq (prop, *alistptr);
2018 if (EQ (tem, Qnil))
2019 *alistptr = Fcons (Fcons (prop, val), *alistptr);
2020 else
2021 Fsetcdr (tem, val);
2024 static int
2025 frame_name_fnn_p (char *str, ptrdiff_t len)
2027 if (len > 1 && str[0] == 'F' && '0' <= str[1] && str[1] <= '9')
2029 char *p = str + 2;
2030 while ('0' <= *p && *p <= '9')
2031 p++;
2032 if (p == str + len)
2033 return 1;
2035 return 0;
2038 /* Set the name of the terminal frame. Also used by MSDOS frames.
2039 Modeled after x_set_name which is used for WINDOW frames. */
2041 static void
2042 set_term_frame_name (struct frame *f, Lisp_Object name)
2044 f->explicit_name = ! NILP (name);
2046 /* If NAME is nil, set the name to F<num>. */
2047 if (NILP (name))
2049 char namebuf[sizeof "F" + INT_STRLEN_BOUND (printmax_t)];
2051 /* Check for no change needed in this very common case
2052 before we do any consing. */
2053 if (frame_name_fnn_p (SSDATA (f->name), SBYTES (f->name)))
2054 return;
2056 name = make_formatted_string (namebuf, "F%"pMd, ++tty_frame_count);
2058 else
2060 CHECK_STRING (name);
2062 /* Don't change the name if it's already NAME. */
2063 if (! NILP (Fstring_equal (name, f->name)))
2064 return;
2066 /* Don't allow the user to set the frame name to F<num>, so it
2067 doesn't clash with the names we generate for terminal frames. */
2068 if (frame_name_fnn_p (SSDATA (name), SBYTES (name)))
2069 error ("Frame names of the form F<num> are usurped by Emacs");
2072 fset_name (f, name);
2073 update_mode_lines = 1;
2076 void
2077 store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
2079 register Lisp_Object old_alist_elt;
2081 /* The buffer-list parameters are stored in a special place and not
2082 in the alist. All buffers must be live. */
2083 if (EQ (prop, Qbuffer_list))
2085 Lisp_Object list = Qnil;
2086 for (; CONSP (val); val = XCDR (val))
2087 if (!NILP (Fbuffer_live_p (XCAR (val))))
2088 list = Fcons (XCAR (val), list);
2089 fset_buffer_list (f, Fnreverse (list));
2090 return;
2092 if (EQ (prop, Qburied_buffer_list))
2094 Lisp_Object list = Qnil;
2095 for (; CONSP (val); val = XCDR (val))
2096 if (!NILP (Fbuffer_live_p (XCAR (val))))
2097 list = Fcons (XCAR (val), list);
2098 fset_buried_buffer_list (f, Fnreverse (list));
2099 return;
2102 /* If PROP is a symbol which is supposed to have frame-local values,
2103 and it is set up based on this frame, switch to the global
2104 binding. That way, we can create or alter the frame-local binding
2105 without messing up the symbol's status. */
2106 if (SYMBOLP (prop))
2108 struct Lisp_Symbol *sym = XSYMBOL (prop);
2109 start:
2110 switch (sym->redirect)
2112 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
2113 case SYMBOL_PLAINVAL: case SYMBOL_FORWARDED: break;
2114 case SYMBOL_LOCALIZED:
2115 { struct Lisp_Buffer_Local_Value *blv = sym->val.blv;
2116 if (blv->frame_local && blv_found (blv) && XFRAME (blv->where) == f)
2117 swap_in_global_binding (sym);
2118 break;
2120 default: emacs_abort ();
2124 /* The tty color needed to be set before the frame's parameter
2125 alist was updated with the new value. This is not true any more,
2126 but we still do this test early on. */
2127 if (FRAME_TERMCAP_P (f) && EQ (prop, Qtty_color_mode)
2128 && f == FRAME_TTY (f)->previous_frame)
2129 /* Force redisplay of this tty. */
2130 FRAME_TTY (f)->previous_frame = NULL;
2132 /* Update the frame parameter alist. */
2133 old_alist_elt = Fassq (prop, f->param_alist);
2134 if (EQ (old_alist_elt, Qnil))
2135 fset_param_alist (f, Fcons (Fcons (prop, val), f->param_alist));
2136 else
2137 Fsetcdr (old_alist_elt, val);
2139 /* Update some other special parameters in their special places
2140 in addition to the alist. */
2142 if (EQ (prop, Qbuffer_predicate))
2143 fset_buffer_predicate (f, val);
2145 if (! FRAME_WINDOW_P (f))
2147 if (EQ (prop, Qmenu_bar_lines))
2148 set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f)));
2149 else if (EQ (prop, Qname))
2150 set_term_frame_name (f, val);
2153 if (EQ (prop, Qminibuffer) && WINDOWP (val))
2155 if (! MINI_WINDOW_P (XWINDOW (val)))
2156 error ("Surrogate minibuffer windows must be minibuffer windows");
2158 if ((FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
2159 && !EQ (val, f->minibuffer_window))
2160 error ("Can't change the surrogate minibuffer of a frame with its own minibuffer");
2162 /* Install the chosen minibuffer window, with proper buffer. */
2163 fset_minibuffer_window (f, val);
2167 DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0,
2168 doc: /* Return the parameters-alist of frame FRAME.
2169 It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
2170 The meaningful PARMs depend on the kind of frame.
2171 If FRAME is omitted, return information on the currently selected frame. */)
2172 (Lisp_Object frame)
2174 Lisp_Object alist;
2175 FRAME_PTR f;
2176 int height, width;
2177 struct gcpro gcpro1;
2179 if (NILP (frame))
2180 frame = selected_frame;
2182 CHECK_FRAME (frame);
2183 f = XFRAME (frame);
2185 if (!FRAME_LIVE_P (f))
2186 return Qnil;
2188 alist = Fcopy_alist (f->param_alist);
2189 GCPRO1 (alist);
2191 if (!FRAME_WINDOW_P (f))
2193 int fg = FRAME_FOREGROUND_PIXEL (f);
2194 int bg = FRAME_BACKGROUND_PIXEL (f);
2195 Lisp_Object elt;
2197 /* If the frame's parameter alist says the colors are
2198 unspecified and reversed, take the frame's background pixel
2199 for foreground and vice versa. */
2200 elt = Fassq (Qforeground_color, alist);
2201 if (CONSP (elt) && STRINGP (XCDR (elt)))
2203 if (strncmp (SSDATA (XCDR (elt)),
2204 unspecified_bg,
2205 SCHARS (XCDR (elt))) == 0)
2206 store_in_alist (&alist, Qforeground_color, tty_color_name (f, bg));
2207 else if (strncmp (SSDATA (XCDR (elt)),
2208 unspecified_fg,
2209 SCHARS (XCDR (elt))) == 0)
2210 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2212 else
2213 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2214 elt = Fassq (Qbackground_color, alist);
2215 if (CONSP (elt) && STRINGP (XCDR (elt)))
2217 if (strncmp (SSDATA (XCDR (elt)),
2218 unspecified_fg,
2219 SCHARS (XCDR (elt))) == 0)
2220 store_in_alist (&alist, Qbackground_color, tty_color_name (f, fg));
2221 else if (strncmp (SSDATA (XCDR (elt)),
2222 unspecified_bg,
2223 SCHARS (XCDR (elt))) == 0)
2224 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2226 else
2227 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2228 store_in_alist (&alist, intern ("font"),
2229 build_string (FRAME_MSDOS_P (f)
2230 ? "ms-dos"
2231 : FRAME_W32_P (f) ? "w32term"
2232 :"tty"));
2234 store_in_alist (&alist, Qname, f->name);
2235 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2236 store_in_alist (&alist, Qheight, make_number (height));
2237 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2238 store_in_alist (&alist, Qwidth, make_number (width));
2239 store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil));
2240 store_in_alist (&alist, Qminibuffer,
2241 (! FRAME_HAS_MINIBUF_P (f) ? Qnil
2242 : FRAME_MINIBUF_ONLY_P (f) ? Qonly
2243 : FRAME_MINIBUF_WINDOW (f)));
2244 store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
2245 store_in_alist (&alist, Qbuffer_list, frame_buffer_list (frame));
2246 store_in_alist (&alist, Qburied_buffer_list,
2247 XFRAME (frame)->buried_buffer_list);
2249 /* I think this should be done with a hook. */
2250 #ifdef HAVE_WINDOW_SYSTEM
2251 if (FRAME_WINDOW_P (f))
2252 x_report_frame_params (f, &alist);
2253 else
2254 #endif
2256 /* This ought to be correct in f->param_alist for an X frame. */
2257 Lisp_Object lines;
2258 XSETFASTINT (lines, FRAME_MENU_BAR_LINES (f));
2259 store_in_alist (&alist, Qmenu_bar_lines, lines);
2262 UNGCPRO;
2263 return alist;
2267 DEFUN ("frame-parameter", Fframe_parameter, Sframe_parameter, 2, 2, 0,
2268 doc: /* Return FRAME's value for parameter PARAMETER.
2269 If FRAME is nil, describe the currently selected frame. */)
2270 (Lisp_Object frame, Lisp_Object parameter)
2272 struct frame *f;
2273 Lisp_Object value;
2275 if (NILP (frame))
2276 frame = selected_frame;
2277 else
2278 CHECK_FRAME (frame);
2279 CHECK_SYMBOL (parameter);
2281 f = XFRAME (frame);
2282 value = Qnil;
2284 if (FRAME_LIVE_P (f))
2286 /* Avoid consing in frequent cases. */
2287 if (EQ (parameter, Qname))
2288 value = f->name;
2289 #ifdef HAVE_X_WINDOWS
2290 else if (EQ (parameter, Qdisplay) && FRAME_X_P (f))
2291 value = XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element);
2292 #endif /* HAVE_X_WINDOWS */
2293 else if (EQ (parameter, Qbackground_color)
2294 || EQ (parameter, Qforeground_color))
2296 value = Fassq (parameter, f->param_alist);
2297 if (CONSP (value))
2299 value = XCDR (value);
2300 /* Fframe_parameters puts the actual fg/bg color names,
2301 even if f->param_alist says otherwise. This is
2302 important when param_alist's notion of colors is
2303 "unspecified". We need to do the same here. */
2304 if (STRINGP (value) && !FRAME_WINDOW_P (f))
2306 const char *color_name;
2307 ptrdiff_t csz;
2309 if (EQ (parameter, Qbackground_color))
2311 color_name = SSDATA (value);
2312 csz = SCHARS (value);
2313 if (strncmp (color_name, unspecified_bg, csz) == 0)
2314 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2315 else if (strncmp (color_name, unspecified_fg, csz) == 0)
2316 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2318 else if (EQ (parameter, Qforeground_color))
2320 color_name = SSDATA (value);
2321 csz = SCHARS (value);
2322 if (strncmp (color_name, unspecified_fg, csz) == 0)
2323 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2324 else if (strncmp (color_name, unspecified_bg, csz) == 0)
2325 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2329 else
2330 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2332 else if (EQ (parameter, Qdisplay_type)
2333 || EQ (parameter, Qbackground_mode))
2334 value = Fcdr (Fassq (parameter, f->param_alist));
2335 else
2336 /* FIXME: Avoid this code path at all (as well as code duplication)
2337 by sharing more code with Fframe_parameters. */
2338 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2341 return value;
2345 DEFUN ("modify-frame-parameters", Fmodify_frame_parameters,
2346 Smodify_frame_parameters, 2, 2, 0,
2347 doc: /* Modify the parameters of frame FRAME according to ALIST.
2348 If FRAME is nil, it defaults to the selected frame.
2349 ALIST is an alist of parameters to change and their new values.
2350 Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.
2351 The meaningful PARMs depend on the kind of frame.
2352 Undefined PARMs are ignored, but stored in the frame's parameter list
2353 so that `frame-parameters' will return them.
2355 The value of frame parameter FOO can also be accessed
2356 as a frame-local binding for the variable FOO, if you have
2357 enabled such bindings for that variable with `make-variable-frame-local'.
2358 Note that this functionality is obsolete as of Emacs 22.2, and its
2359 use is not recommended. Explicitly check for a frame-parameter instead. */)
2360 (Lisp_Object frame, Lisp_Object alist)
2362 FRAME_PTR f;
2363 register Lisp_Object tail, prop, val;
2365 if (EQ (frame, Qnil))
2366 frame = selected_frame;
2367 CHECK_LIVE_FRAME (frame);
2368 f = XFRAME (frame);
2370 /* I think this should be done with a hook. */
2371 #ifdef HAVE_WINDOW_SYSTEM
2372 if (FRAME_WINDOW_P (f))
2373 x_set_frame_parameters (f, alist);
2374 else
2375 #endif
2376 #ifdef MSDOS
2377 if (FRAME_MSDOS_P (f))
2378 IT_set_frame_parameters (f, alist);
2379 else
2380 #endif
2383 EMACS_INT length = XFASTINT (Flength (alist));
2384 ptrdiff_t i;
2385 Lisp_Object *parms;
2386 Lisp_Object *values;
2387 USE_SAFE_ALLOCA;
2388 SAFE_ALLOCA_LISP (parms, 2 * length);
2389 values = parms + length;
2391 /* Extract parm names and values into those vectors. */
2393 i = 0;
2394 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2396 Lisp_Object elt;
2398 elt = XCAR (tail);
2399 parms[i] = Fcar (elt);
2400 values[i] = Fcdr (elt);
2401 i++;
2404 /* Now process them in reverse of specified order. */
2405 while (--i >= 0)
2407 prop = parms[i];
2408 val = values[i];
2409 store_frame_param (f, prop, val);
2411 if (EQ (prop, Qforeground_color)
2412 || EQ (prop, Qbackground_color))
2413 update_face_from_frame_parameter (f, prop, val);
2416 SAFE_FREE ();
2418 return Qnil;
2421 DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height,
2422 0, 1, 0,
2423 doc: /* Height in pixels of a line in the font in frame FRAME.
2424 If FRAME is omitted, the selected frame is used.
2425 For a terminal frame, the value is always 1. */)
2426 (Lisp_Object frame)
2428 struct frame *f;
2430 if (NILP (frame))
2431 frame = selected_frame;
2432 CHECK_FRAME (frame);
2433 f = XFRAME (frame);
2435 #ifdef HAVE_WINDOW_SYSTEM
2436 if (FRAME_WINDOW_P (f))
2437 return make_number (x_char_height (f));
2438 else
2439 #endif
2440 return make_number (1);
2444 DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width,
2445 0, 1, 0,
2446 doc: /* Width in pixels of characters in the font in frame FRAME.
2447 If FRAME is omitted, the selected frame is used.
2448 On a graphical screen, the width is the standard width of the default font.
2449 For a terminal screen, the value is always 1. */)
2450 (Lisp_Object frame)
2452 struct frame *f;
2454 if (NILP (frame))
2455 frame = selected_frame;
2456 CHECK_FRAME (frame);
2457 f = XFRAME (frame);
2459 #ifdef HAVE_WINDOW_SYSTEM
2460 if (FRAME_WINDOW_P (f))
2461 return make_number (x_char_width (f));
2462 else
2463 #endif
2464 return make_number (1);
2467 DEFUN ("frame-pixel-height", Fframe_pixel_height,
2468 Sframe_pixel_height, 0, 1, 0,
2469 doc: /* Return a FRAME's height in pixels.
2470 If FRAME is omitted, the selected frame is used. The exact value
2471 of the result depends on the window-system and toolkit in use:
2473 In the Gtk+ version of Emacs, it includes only any window (including
2474 the minibuffer or echo area), mode line, and header line. It does not
2475 include the tool bar or menu bar.
2477 With other graphical versions, it also includes the tool bar and the
2478 menu bar.
2480 For a text terminal, it includes the menu bar. In this case, the
2481 result is really in characters rather than pixels (i.e., is identical
2482 to `frame-height'). */)
2483 (Lisp_Object frame)
2485 struct frame *f;
2487 if (NILP (frame))
2488 frame = selected_frame;
2489 CHECK_FRAME (frame);
2490 f = XFRAME (frame);
2492 #ifdef HAVE_WINDOW_SYSTEM
2493 if (FRAME_WINDOW_P (f))
2494 return make_number (x_pixel_height (f));
2495 else
2496 #endif
2497 return make_number (FRAME_LINES (f));
2500 DEFUN ("frame-pixel-width", Fframe_pixel_width,
2501 Sframe_pixel_width, 0, 1, 0,
2502 doc: /* Return FRAME's width in pixels.
2503 For a terminal frame, the result really gives the width in characters.
2504 If FRAME is omitted, the selected frame is used. */)
2505 (Lisp_Object frame)
2507 struct frame *f;
2509 if (NILP (frame))
2510 frame = selected_frame;
2511 CHECK_FRAME (frame);
2512 f = XFRAME (frame);
2514 #ifdef HAVE_WINDOW_SYSTEM
2515 if (FRAME_WINDOW_P (f))
2516 return make_number (x_pixel_width (f));
2517 else
2518 #endif
2519 return make_number (FRAME_COLS (f));
2522 DEFUN ("tool-bar-pixel-width", Ftool_bar_pixel_width,
2523 Stool_bar_pixel_width, 0, 1, 0,
2524 doc: /* Return width in pixels of FRAME's tool bar.
2525 The result is greater than zero only when the tool bar is on the left
2526 or right side of FRAME. If FRAME is omitted, the selected frame is
2527 used. */)
2528 (Lisp_Object frame)
2530 if (NILP (frame))
2531 frame = selected_frame;
2532 CHECK_FRAME (frame);
2534 #ifdef FRAME_TOOLBAR_WIDTH
2535 if (FRAME_WINDOW_P (XFRAME (frame)))
2536 return make_number (FRAME_TOOLBAR_WIDTH (XFRAME (frame)));
2537 #endif
2538 return make_number (0);
2541 DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0,
2542 doc: /* Specify that the frame FRAME has LINES lines.
2543 Optional third arg non-nil means that redisplay should use LINES lines
2544 but that the idea of the actual height of the frame should not be changed. */)
2545 (Lisp_Object frame, Lisp_Object lines, Lisp_Object pretend)
2547 register struct frame *f;
2549 CHECK_TYPE_RANGED_INTEGER (int, lines);
2550 if (NILP (frame))
2551 frame = selected_frame;
2552 CHECK_LIVE_FRAME (frame);
2553 f = XFRAME (frame);
2555 /* I think this should be done with a hook. */
2556 #ifdef HAVE_WINDOW_SYSTEM
2557 if (FRAME_WINDOW_P (f))
2559 if (XINT (lines) != FRAME_LINES (f))
2560 x_set_window_size (f, 1, FRAME_COLS (f), XINT (lines));
2561 do_pending_window_change (0);
2563 else
2564 #endif
2565 change_frame_size (f, XINT (lines), 0, !NILP (pretend), 0, 0);
2566 return Qnil;
2569 DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 3, 0,
2570 doc: /* Specify that the frame FRAME has COLS columns.
2571 Optional third arg non-nil means that redisplay should use COLS columns
2572 but that the idea of the actual width of the frame should not be changed. */)
2573 (Lisp_Object frame, Lisp_Object cols, Lisp_Object pretend)
2575 register struct frame *f;
2576 CHECK_TYPE_RANGED_INTEGER (int, cols);
2577 if (NILP (frame))
2578 frame = selected_frame;
2579 CHECK_LIVE_FRAME (frame);
2580 f = XFRAME (frame);
2582 /* I think this should be done with a hook. */
2583 #ifdef HAVE_WINDOW_SYSTEM
2584 if (FRAME_WINDOW_P (f))
2586 if (XINT (cols) != FRAME_COLS (f))
2587 x_set_window_size (f, 1, XINT (cols), FRAME_LINES (f));
2588 do_pending_window_change (0);
2590 else
2591 #endif
2592 change_frame_size (f, 0, XINT (cols), !NILP (pretend), 0, 0);
2593 return Qnil;
2596 DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0,
2597 doc: /* Sets size of FRAME to COLS by ROWS, measured in characters. */)
2598 (Lisp_Object frame, Lisp_Object cols, Lisp_Object rows)
2600 register struct frame *f;
2602 CHECK_LIVE_FRAME (frame);
2603 CHECK_TYPE_RANGED_INTEGER (int, cols);
2604 CHECK_TYPE_RANGED_INTEGER (int, rows);
2605 f = XFRAME (frame);
2607 /* I think this should be done with a hook. */
2608 #ifdef HAVE_WINDOW_SYSTEM
2609 if (FRAME_WINDOW_P (f))
2611 if (XINT (rows) != FRAME_LINES (f)
2612 || XINT (cols) != FRAME_COLS (f)
2613 || f->new_text_lines || f->new_text_cols)
2614 x_set_window_size (f, 1, XINT (cols), XINT (rows));
2615 do_pending_window_change (0);
2617 else
2618 #endif
2619 change_frame_size (f, XINT (rows), XINT (cols), 0, 0, 0);
2621 return Qnil;
2624 DEFUN ("set-frame-position", Fset_frame_position,
2625 Sset_frame_position, 3, 3, 0,
2626 doc: /* Sets position of FRAME in pixels to XOFFSET by YOFFSET.
2627 This is actually the position of the upper left corner of the frame.
2628 Negative values for XOFFSET or YOFFSET are interpreted relative to
2629 the rightmost or bottommost possible position (that stays within the screen). */)
2630 (Lisp_Object frame, Lisp_Object xoffset, Lisp_Object yoffset)
2632 register struct frame *f;
2634 CHECK_LIVE_FRAME (frame);
2635 CHECK_TYPE_RANGED_INTEGER (int, xoffset);
2636 CHECK_TYPE_RANGED_INTEGER (int, yoffset);
2637 f = XFRAME (frame);
2639 /* I think this should be done with a hook. */
2640 #ifdef HAVE_WINDOW_SYSTEM
2641 if (FRAME_WINDOW_P (f))
2642 x_set_offset (f, XINT (xoffset), XINT (yoffset), 1);
2643 #endif
2645 return Qt;
2649 /***********************************************************************
2650 Frame Parameters
2651 ***********************************************************************/
2653 /* Connect the frame-parameter names for X frames
2654 to the ways of passing the parameter values to the window system.
2656 The name of a parameter, as a Lisp symbol,
2657 has an `x-frame-parameter' property which is an integer in Lisp
2658 that is an index in this table. */
2660 struct frame_parm_table {
2661 const char *name;
2662 Lisp_Object *variable;
2665 static const struct frame_parm_table frame_parms[] =
2667 {"auto-raise", &Qauto_raise},
2668 {"auto-lower", &Qauto_lower},
2669 {"background-color", 0},
2670 {"border-color", &Qborder_color},
2671 {"border-width", &Qborder_width},
2672 {"cursor-color", &Qcursor_color},
2673 {"cursor-type", &Qcursor_type},
2674 {"font", 0},
2675 {"foreground-color", 0},
2676 {"icon-name", &Qicon_name},
2677 {"icon-type", &Qicon_type},
2678 {"internal-border-width", &Qinternal_border_width},
2679 {"menu-bar-lines", &Qmenu_bar_lines},
2680 {"mouse-color", &Qmouse_color},
2681 {"name", &Qname},
2682 {"scroll-bar-width", &Qscroll_bar_width},
2683 {"title", &Qtitle},
2684 {"unsplittable", &Qunsplittable},
2685 {"vertical-scroll-bars", &Qvertical_scroll_bars},
2686 {"visibility", &Qvisibility},
2687 {"tool-bar-lines", &Qtool_bar_lines},
2688 {"scroll-bar-foreground", &Qscroll_bar_foreground},
2689 {"scroll-bar-background", &Qscroll_bar_background},
2690 {"screen-gamma", &Qscreen_gamma},
2691 {"line-spacing", &Qline_spacing},
2692 {"left-fringe", &Qleft_fringe},
2693 {"right-fringe", &Qright_fringe},
2694 {"wait-for-wm", &Qwait_for_wm},
2695 {"fullscreen", &Qfullscreen},
2696 {"font-backend", &Qfont_backend},
2697 {"alpha", &Qalpha},
2698 {"sticky", &Qsticky},
2699 {"tool-bar-position", &Qtool_bar_position},
2702 #ifdef HAVE_NTGUI
2704 /* Calculate fullscreen size. Return in *TOP_POS and *LEFT_POS the
2705 wanted positions of the WM window (not Emacs window).
2706 Return in *WIDTH and *HEIGHT the wanted width and height of Emacs
2707 window (FRAME_X_WINDOW).
2710 void
2711 x_fullscreen_adjust (struct frame *f, int *width, int *height, int *top_pos, int *left_pos)
2713 int newwidth = FRAME_COLS (f);
2714 int newheight = FRAME_LINES (f);
2715 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2717 *top_pos = f->top_pos;
2718 *left_pos = f->left_pos;
2720 if (f->want_fullscreen & FULLSCREEN_HEIGHT)
2722 int ph;
2724 ph = x_display_pixel_height (dpyinfo);
2725 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2726 ph = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, newheight) - f->y_pixels_diff;
2727 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2728 *top_pos = 0;
2731 if (f->want_fullscreen & FULLSCREEN_WIDTH)
2733 int pw;
2735 pw = x_display_pixel_width (dpyinfo);
2736 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2737 pw = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, newwidth) - f->x_pixels_diff;
2738 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2739 *left_pos = 0;
2742 *width = newwidth;
2743 *height = newheight;
2746 #endif /* HAVE_NTGUI */
2748 #ifdef HAVE_WINDOW_SYSTEM
2750 /* Change the parameters of frame F as specified by ALIST.
2751 If a parameter is not specially recognized, do nothing special;
2752 otherwise call the `x_set_...' function for that parameter.
2753 Except for certain geometry properties, always call store_frame_param
2754 to store the new value in the parameter alist. */
2756 void
2757 x_set_frame_parameters (FRAME_PTR f, Lisp_Object alist)
2759 Lisp_Object tail;
2761 /* If both of these parameters are present, it's more efficient to
2762 set them both at once. So we wait until we've looked at the
2763 entire list before we set them. */
2764 int width, height;
2766 /* Same here. */
2767 Lisp_Object left, top;
2769 /* Same with these. */
2770 Lisp_Object icon_left, icon_top;
2772 /* Record in these vectors all the parms specified. */
2773 Lisp_Object *parms;
2774 Lisp_Object *values;
2775 ptrdiff_t i, p;
2776 int left_no_change = 0, top_no_change = 0;
2777 int icon_left_no_change = 0, icon_top_no_change = 0;
2778 int size_changed = 0;
2779 struct gcpro gcpro1, gcpro2;
2781 i = 0;
2782 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2783 i++;
2785 parms = alloca (i * sizeof *parms);
2786 values = alloca (i * sizeof *values);
2788 /* Extract parm names and values into those vectors. */
2790 i = 0;
2791 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2793 Lisp_Object elt;
2795 elt = XCAR (tail);
2796 parms[i] = Fcar (elt);
2797 values[i] = Fcdr (elt);
2798 i++;
2800 /* TAIL and ALIST are not used again below here. */
2801 alist = tail = Qnil;
2803 GCPRO2 (*parms, *values);
2804 gcpro1.nvars = i;
2805 gcpro2.nvars = i;
2807 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
2808 because their values appear in VALUES and strings are not valid. */
2809 top = left = Qunbound;
2810 icon_left = icon_top = Qunbound;
2812 /* Provide default values for HEIGHT and WIDTH. */
2813 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2814 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2816 /* Process foreground_color and background_color before anything else.
2817 They are independent of other properties, but other properties (e.g.,
2818 cursor_color) are dependent upon them. */
2819 /* Process default font as well, since fringe widths depends on it. */
2820 for (p = 0; p < i; p++)
2822 Lisp_Object prop, val;
2824 prop = parms[p];
2825 val = values[p];
2826 if (EQ (prop, Qforeground_color)
2827 || EQ (prop, Qbackground_color)
2828 || EQ (prop, Qfont))
2830 register Lisp_Object param_index, old_value;
2832 old_value = get_frame_param (f, prop);
2833 if (NILP (Fequal (val, old_value)))
2835 store_frame_param (f, prop, val);
2837 param_index = Fget (prop, Qx_frame_parameter);
2838 if (NATNUMP (param_index)
2839 && (XFASTINT (param_index)
2840 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2841 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
2842 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2847 /* Now process them in reverse of specified order. */
2848 while (i-- != 0)
2850 Lisp_Object prop, val;
2852 prop = parms[i];
2853 val = values[i];
2855 if (EQ (prop, Qwidth) && RANGED_INTEGERP (0, val, INT_MAX))
2857 size_changed = 1;
2858 width = XFASTINT (val);
2860 else if (EQ (prop, Qheight) && RANGED_INTEGERP (0, val, INT_MAX))
2862 size_changed = 1;
2863 height = XFASTINT (val);
2865 else if (EQ (prop, Qtop))
2866 top = val;
2867 else if (EQ (prop, Qleft))
2868 left = val;
2869 else if (EQ (prop, Qicon_top))
2870 icon_top = val;
2871 else if (EQ (prop, Qicon_left))
2872 icon_left = val;
2873 else if (EQ (prop, Qforeground_color)
2874 || EQ (prop, Qbackground_color)
2875 || EQ (prop, Qfont))
2876 /* Processed above. */
2877 continue;
2878 else
2880 register Lisp_Object param_index, old_value;
2882 old_value = get_frame_param (f, prop);
2884 store_frame_param (f, prop, val);
2886 param_index = Fget (prop, Qx_frame_parameter);
2887 if (NATNUMP (param_index)
2888 && (XFASTINT (param_index)
2889 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2890 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
2891 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2895 /* Don't die if just one of these was set. */
2896 if (EQ (left, Qunbound))
2898 left_no_change = 1;
2899 if (f->left_pos < 0)
2900 left = Fcons (Qplus, Fcons (make_number (f->left_pos), Qnil));
2901 else
2902 XSETINT (left, f->left_pos);
2904 if (EQ (top, Qunbound))
2906 top_no_change = 1;
2907 if (f->top_pos < 0)
2908 top = Fcons (Qplus, Fcons (make_number (f->top_pos), Qnil));
2909 else
2910 XSETINT (top, f->top_pos);
2913 /* If one of the icon positions was not set, preserve or default it. */
2914 if (! TYPE_RANGED_INTEGERP (int, icon_left))
2916 icon_left_no_change = 1;
2917 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
2918 if (NILP (icon_left))
2919 XSETINT (icon_left, 0);
2921 if (! TYPE_RANGED_INTEGERP (int, icon_top))
2923 icon_top_no_change = 1;
2924 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
2925 if (NILP (icon_top))
2926 XSETINT (icon_top, 0);
2929 /* Don't set these parameters unless they've been explicitly
2930 specified. The window might be mapped or resized while we're in
2931 this function, and we don't want to override that unless the lisp
2932 code has asked for it.
2934 Don't set these parameters unless they actually differ from the
2935 window's current parameters; the window may not actually exist
2936 yet. */
2938 Lisp_Object frame;
2940 check_frame_size (f, &height, &width);
2942 XSETFRAME (frame, f);
2944 if (size_changed
2945 && (width != FRAME_COLS (f)
2946 || height != FRAME_LINES (f)
2947 || f->new_text_lines || f->new_text_cols))
2948 Fset_frame_size (frame, make_number (width), make_number (height));
2950 if ((!NILP (left) || !NILP (top))
2951 && ! (left_no_change && top_no_change)
2952 && ! (NUMBERP (left) && XINT (left) == f->left_pos
2953 && NUMBERP (top) && XINT (top) == f->top_pos))
2955 int leftpos = 0;
2956 int toppos = 0;
2958 /* Record the signs. */
2959 f->size_hint_flags &= ~ (XNegative | YNegative);
2960 if (EQ (left, Qminus))
2961 f->size_hint_flags |= XNegative;
2962 else if (TYPE_RANGED_INTEGERP (int, left))
2964 leftpos = XINT (left);
2965 if (leftpos < 0)
2966 f->size_hint_flags |= XNegative;
2968 else if (CONSP (left) && EQ (XCAR (left), Qminus)
2969 && CONSP (XCDR (left))
2970 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (left)), INT_MAX))
2972 leftpos = - XINT (XCAR (XCDR (left)));
2973 f->size_hint_flags |= XNegative;
2975 else if (CONSP (left) && EQ (XCAR (left), Qplus)
2976 && CONSP (XCDR (left))
2977 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (left))))
2979 leftpos = XINT (XCAR (XCDR (left)));
2982 if (EQ (top, Qminus))
2983 f->size_hint_flags |= YNegative;
2984 else if (TYPE_RANGED_INTEGERP (int, top))
2986 toppos = XINT (top);
2987 if (toppos < 0)
2988 f->size_hint_flags |= YNegative;
2990 else if (CONSP (top) && EQ (XCAR (top), Qminus)
2991 && CONSP (XCDR (top))
2992 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (top)), INT_MAX))
2994 toppos = - XINT (XCAR (XCDR (top)));
2995 f->size_hint_flags |= YNegative;
2997 else if (CONSP (top) && EQ (XCAR (top), Qplus)
2998 && CONSP (XCDR (top))
2999 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (top))))
3001 toppos = XINT (XCAR (XCDR (top)));
3005 /* Store the numeric value of the position. */
3006 f->top_pos = toppos;
3007 f->left_pos = leftpos;
3009 f->win_gravity = NorthWestGravity;
3011 /* Actually set that position, and convert to absolute. */
3012 x_set_offset (f, leftpos, toppos, -1);
3015 if ((!NILP (icon_left) || !NILP (icon_top))
3016 && ! (icon_left_no_change && icon_top_no_change))
3017 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
3020 UNGCPRO;
3024 /* Insert a description of internally-recorded parameters of frame X
3025 into the parameter alist *ALISTPTR that is to be given to the user.
3026 Only parameters that are specific to the X window system
3027 and whose values are not correctly recorded in the frame's
3028 param_alist need to be considered here. */
3030 void
3031 x_report_frame_params (struct frame *f, Lisp_Object *alistptr)
3033 Lisp_Object tem;
3034 uprintmax_t w;
3035 char buf[INT_BUFSIZE_BOUND (w)];
3037 /* Represent negative positions (off the top or left screen edge)
3038 in a way that Fmodify_frame_parameters will understand correctly. */
3039 XSETINT (tem, f->left_pos);
3040 if (f->left_pos >= 0)
3041 store_in_alist (alistptr, Qleft, tem);
3042 else
3043 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
3045 XSETINT (tem, f->top_pos);
3046 if (f->top_pos >= 0)
3047 store_in_alist (alistptr, Qtop, tem);
3048 else
3049 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
3051 store_in_alist (alistptr, Qborder_width,
3052 make_number (f->border_width));
3053 store_in_alist (alistptr, Qinternal_border_width,
3054 make_number (FRAME_INTERNAL_BORDER_WIDTH (f)));
3055 store_in_alist (alistptr, Qleft_fringe,
3056 make_number (FRAME_LEFT_FRINGE_WIDTH (f)));
3057 store_in_alist (alistptr, Qright_fringe,
3058 make_number (FRAME_RIGHT_FRINGE_WIDTH (f)));
3059 store_in_alist (alistptr, Qscroll_bar_width,
3060 (! FRAME_HAS_VERTICAL_SCROLL_BARS (f)
3061 ? make_number (0)
3062 : FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0
3063 ? make_number (FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3064 /* nil means "use default width"
3065 for non-toolkit scroll bar.
3066 ruler-mode.el depends on this. */
3067 : Qnil));
3068 /* FRAME_X_WINDOW is not guaranteed to return an integer. E.g., on
3069 MS-Windows it returns a value whose type is HANDLE, which is
3070 actually a pointer. Explicit casting avoids compiler
3071 warnings. */
3072 w = (uintptr_t) FRAME_X_WINDOW (f);
3073 store_in_alist (alistptr, Qwindow_id,
3074 make_formatted_string (buf, "%"pMu, w));
3075 #ifdef HAVE_X_WINDOWS
3076 #ifdef USE_X_TOOLKIT
3077 /* Tooltip frame may not have this widget. */
3078 if (FRAME_X_OUTPUT (f)->widget)
3079 #endif
3080 w = (uintptr_t) FRAME_OUTER_WINDOW (f);
3081 store_in_alist (alistptr, Qouter_window_id,
3082 make_formatted_string (buf, "%"pMu, w));
3083 #endif
3084 store_in_alist (alistptr, Qicon_name, f->icon_name);
3085 FRAME_SAMPLE_VISIBILITY (f);
3086 store_in_alist (alistptr, Qvisibility,
3087 (FRAME_VISIBLE_P (f) ? Qt
3088 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
3089 store_in_alist (alistptr, Qdisplay,
3090 XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
3092 if (FRAME_X_OUTPUT (f)->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
3093 tem = Qnil;
3094 else
3095 XSETFASTINT (tem, FRAME_X_OUTPUT (f)->parent_desc);
3096 store_in_alist (alistptr, Qexplicit_name, (f->explicit_name ? Qt : Qnil));
3097 store_in_alist (alistptr, Qparent_id, tem);
3098 store_in_alist (alistptr, Qtool_bar_position, f->tool_bar_position);
3102 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
3103 the previous value of that parameter, NEW_VALUE is the new value. */
3105 void
3106 x_set_fullscreen (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3108 if (NILP (new_value))
3109 f->want_fullscreen = FULLSCREEN_NONE;
3110 else if (EQ (new_value, Qfullboth) || EQ (new_value, Qfullscreen))
3111 f->want_fullscreen = FULLSCREEN_BOTH;
3112 else if (EQ (new_value, Qfullwidth))
3113 f->want_fullscreen = FULLSCREEN_WIDTH;
3114 else if (EQ (new_value, Qfullheight))
3115 f->want_fullscreen = FULLSCREEN_HEIGHT;
3116 else if (EQ (new_value, Qmaximized))
3117 f->want_fullscreen = FULLSCREEN_MAXIMIZED;
3119 if (FRAME_TERMINAL (f)->fullscreen_hook != NULL)
3120 FRAME_TERMINAL (f)->fullscreen_hook (f);
3124 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
3125 the previous value of that parameter, NEW_VALUE is the new value. */
3127 void
3128 x_set_line_spacing (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3130 if (NILP (new_value))
3131 f->extra_line_spacing = 0;
3132 else if (RANGED_INTEGERP (0, new_value, INT_MAX))
3133 f->extra_line_spacing = XFASTINT (new_value);
3134 else
3135 signal_error ("Invalid line-spacing", new_value);
3136 if (FRAME_VISIBLE_P (f))
3137 redraw_frame (f);
3141 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
3142 the previous value of that parameter, NEW_VALUE is the new value. */
3144 void
3145 x_set_screen_gamma (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3147 Lisp_Object bgcolor;
3149 if (NILP (new_value))
3150 f->gamma = 0;
3151 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
3152 /* The value 0.4545 is the normal viewing gamma. */
3153 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
3154 else
3155 signal_error ("Invalid screen-gamma", new_value);
3157 /* Apply the new gamma value to the frame background. */
3158 bgcolor = Fassq (Qbackground_color, f->param_alist);
3159 if (CONSP (bgcolor) && (bgcolor = XCDR (bgcolor), STRINGP (bgcolor)))
3161 Lisp_Object parm_index = Fget (Qbackground_color, Qx_frame_parameter);
3162 if (NATNUMP (parm_index)
3163 && (XFASTINT (parm_index)
3164 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3165 && FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
3166 (*FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
3167 (f, bgcolor, Qnil);
3170 Fclear_face_cache (Qnil);
3174 void
3175 x_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3177 Lisp_Object font_object;
3178 int fontset = -1;
3179 #ifdef HAVE_X_WINDOWS
3180 Lisp_Object font_param = arg;
3181 #endif
3183 /* Set the frame parameter back to the old value because we may
3184 fail to use ARG as the new parameter value. */
3185 store_frame_param (f, Qfont, oldval);
3187 /* ARG is a fontset name, a font name, a cons of fontset name and a
3188 font object, or a font object. In the last case, this function
3189 never fail. */
3190 if (STRINGP (arg))
3192 fontset = fs_query_fontset (arg, 0);
3193 if (fontset < 0)
3195 font_object = font_open_by_name (f, arg);
3196 if (NILP (font_object))
3197 error ("Font `%s' is not defined", SSDATA (arg));
3198 arg = AREF (font_object, FONT_NAME_INDEX);
3200 else if (fontset > 0)
3202 font_object = font_open_by_name (f, fontset_ascii (fontset));
3203 if (NILP (font_object))
3204 error ("Font `%s' is not defined", SDATA (arg));
3205 arg = AREF (font_object, FONT_NAME_INDEX);
3207 else
3208 error ("The default fontset can't be used for a frame font");
3210 else if (CONSP (arg) && STRINGP (XCAR (arg)) && FONT_OBJECT_P (XCDR (arg)))
3212 /* This is the case that the ASCII font of F's fontset XCAR
3213 (arg) is changed to the font XCDR (arg) by
3214 `set-fontset-font'. */
3215 fontset = fs_query_fontset (XCAR (arg), 0);
3216 if (fontset < 0)
3217 error ("Unknown fontset: %s", SDATA (XCAR (arg)));
3218 font_object = XCDR (arg);
3219 arg = AREF (font_object, FONT_NAME_INDEX);
3220 #ifdef HAVE_X_WINDOWS
3221 font_param = Ffont_get (font_object, QCname);
3222 #endif
3224 else if (FONT_OBJECT_P (arg))
3226 font_object = arg;
3227 #ifdef HAVE_X_WINDOWS
3228 font_param = Ffont_get (font_object, QCname);
3229 #endif
3230 /* This is to store the XLFD font name in the frame parameter for
3231 backward compatibility. We should store the font-object
3232 itself in the future. */
3233 arg = AREF (font_object, FONT_NAME_INDEX);
3234 fontset = FRAME_FONTSET (f);
3235 /* Check if we can use the current fontset. If not, set FONTSET
3236 to -1 to generate a new fontset from FONT-OBJECT. */
3237 if (fontset >= 0)
3239 Lisp_Object ascii_font = fontset_ascii (fontset);
3240 Lisp_Object spec = font_spec_from_name (ascii_font);
3242 if (NILP (spec))
3243 signal_error ("Invalid font name", ascii_font);
3245 if (! font_match_p (spec, font_object))
3246 fontset = -1;
3249 else
3250 signal_error ("Invalid font", arg);
3252 if (! NILP (Fequal (font_object, oldval)))
3253 return;
3255 x_new_font (f, font_object, fontset);
3256 store_frame_param (f, Qfont, arg);
3257 #ifdef HAVE_X_WINDOWS
3258 store_frame_param (f, Qfont_param, font_param);
3259 #endif
3260 /* Recalculate toolbar height. */
3261 f->n_tool_bar_rows = 0;
3262 /* Ensure we redraw it. */
3263 clear_current_matrices (f);
3265 recompute_basic_faces (f);
3267 do_pending_window_change (0);
3269 /* We used to call face-set-after-frame-default here, but it leads to
3270 recursive calls (since that function can set the `default' face's
3271 font which in turns changes the frame's `font' parameter).
3272 Also I don't know what this call is meant to do, but it seems the
3273 wrong way to do it anyway (it does a lot more work than what seems
3274 reasonable in response to a change to `font'). */
3278 void
3279 x_set_font_backend (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3281 if (! NILP (new_value)
3282 && !CONSP (new_value))
3284 char *p0, *p1;
3286 CHECK_STRING (new_value);
3287 p0 = p1 = SSDATA (new_value);
3288 new_value = Qnil;
3289 while (*p0)
3291 while (*p1 && ! c_isspace (*p1) && *p1 != ',') p1++;
3292 if (p0 < p1)
3293 new_value = Fcons (Fintern (make_string (p0, p1 - p0), Qnil),
3294 new_value);
3295 if (*p1)
3297 int c;
3299 while ((c = *++p1) && c_isspace (c));
3301 p0 = p1;
3303 new_value = Fnreverse (new_value);
3306 if (! NILP (old_value) && ! NILP (Fequal (old_value, new_value)))
3307 return;
3309 if (FRAME_FONT (f))
3310 free_all_realized_faces (Qnil);
3312 new_value = font_update_drivers (f, NILP (new_value) ? Qt : new_value);
3313 if (NILP (new_value))
3315 if (NILP (old_value))
3316 error ("No font backend available");
3317 font_update_drivers (f, old_value);
3318 error ("None of specified font backends are available");
3320 store_frame_param (f, Qfont_backend, new_value);
3322 if (FRAME_FONT (f))
3324 Lisp_Object frame;
3326 XSETFRAME (frame, f);
3327 x_set_font (f, Fframe_parameter (frame, Qfont), Qnil);
3328 ++face_change_count;
3329 ++windows_or_buffers_changed;
3334 void
3335 x_set_fringe_width (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3337 compute_fringe_widths (f, 1);
3338 #ifdef HAVE_X_WINDOWS
3339 /* Must adjust this so window managers report correct number of columns. */
3340 if (FRAME_X_WINDOW (f) != 0)
3341 x_wm_set_size_hint (f, 0, 0);
3342 #endif
3345 void
3346 x_set_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3348 CHECK_TYPE_RANGED_INTEGER (int, arg);
3350 if (XINT (arg) == f->border_width)
3351 return;
3353 if (FRAME_X_WINDOW (f) != 0)
3354 error ("Cannot change the border width of a frame");
3356 f->border_width = XINT (arg);
3359 void
3360 x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3362 int old = FRAME_INTERNAL_BORDER_WIDTH (f);
3364 CHECK_TYPE_RANGED_INTEGER (int, arg);
3365 FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
3366 if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
3367 FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
3369 #ifdef USE_X_TOOLKIT
3370 if (FRAME_X_OUTPUT (f)->edit_widget)
3371 widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
3372 #endif
3374 if (FRAME_INTERNAL_BORDER_WIDTH (f) == old)
3375 return;
3377 if (FRAME_X_WINDOW (f) != 0)
3379 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3380 SET_FRAME_GARBAGED (f);
3381 do_pending_window_change (0);
3383 else
3384 SET_FRAME_GARBAGED (f);
3387 void
3388 x_set_visibility (struct frame *f, Lisp_Object value, Lisp_Object oldval)
3390 Lisp_Object frame;
3391 XSETFRAME (frame, f);
3393 if (NILP (value))
3394 Fmake_frame_invisible (frame, Qt);
3395 else if (EQ (value, Qicon))
3396 Ficonify_frame (frame);
3397 else
3398 Fmake_frame_visible (frame);
3401 void
3402 x_set_autoraise (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3404 f->auto_raise = !EQ (Qnil, arg);
3407 void
3408 x_set_autolower (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3410 f->auto_lower = !EQ (Qnil, arg);
3413 void
3414 x_set_unsplittable (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3416 f->no_split = !NILP (arg);
3419 void
3420 x_set_vertical_scroll_bars (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3422 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
3423 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
3424 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
3425 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
3427 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
3428 = (NILP (arg)
3429 ? vertical_scroll_bar_none
3430 : EQ (Qleft, arg)
3431 ? vertical_scroll_bar_left
3432 : EQ (Qright, arg)
3433 ? vertical_scroll_bar_right
3434 : EQ (Qleft, Vdefault_frame_scroll_bars)
3435 ? vertical_scroll_bar_left
3436 : EQ (Qright, Vdefault_frame_scroll_bars)
3437 ? vertical_scroll_bar_right
3438 : vertical_scroll_bar_none);
3440 /* We set this parameter before creating the X window for the
3441 frame, so we can get the geometry right from the start.
3442 However, if the window hasn't been created yet, we shouldn't
3443 call x_set_window_size. */
3444 if (FRAME_X_WINDOW (f))
3445 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3446 do_pending_window_change (0);
3450 void
3451 x_set_scroll_bar_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3453 int wid = FRAME_COLUMN_WIDTH (f);
3455 if (NILP (arg))
3457 x_set_scroll_bar_default_width (f);
3459 if (FRAME_X_WINDOW (f))
3460 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3461 do_pending_window_change (0);
3463 else if (RANGED_INTEGERP (1, arg, INT_MAX)
3464 && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3466 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
3467 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
3469 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg);
3470 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
3471 if (FRAME_X_WINDOW (f))
3472 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3473 do_pending_window_change (0);
3476 change_frame_size (f, 0, FRAME_COLS (f), 0, 0, 0);
3477 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
3478 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
3483 /* Return non-nil if frame F wants a bitmap icon. */
3485 Lisp_Object
3486 x_icon_type (FRAME_PTR f)
3488 Lisp_Object tem;
3490 tem = assq_no_quit (Qicon_type, f->param_alist);
3491 if (CONSP (tem))
3492 return XCDR (tem);
3493 else
3494 return Qnil;
3497 void
3498 x_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3500 double alpha = 1.0;
3501 double newval[2];
3502 int i;
3503 Lisp_Object item;
3505 for (i = 0; i < 2; i++)
3507 newval[i] = 1.0;
3508 if (CONSP (arg))
3510 item = CAR (arg);
3511 arg = CDR (arg);
3513 else
3514 item = arg;
3516 if (NILP (item))
3517 alpha = - 1.0;
3518 else if (FLOATP (item))
3520 alpha = XFLOAT_DATA (item);
3521 if (alpha < 0.0 || 1.0 < alpha)
3522 args_out_of_range (make_float (0.0), make_float (1.0));
3524 else if (INTEGERP (item))
3526 EMACS_INT ialpha = XINT (item);
3527 if (ialpha < 0 || 100 < ialpha)
3528 args_out_of_range (make_number (0), make_number (100));
3529 else
3530 alpha = ialpha / 100.0;
3532 else
3533 wrong_type_argument (Qnumberp, item);
3534 newval[i] = alpha;
3537 for (i = 0; i < 2; i++)
3538 f->alpha[i] = newval[i];
3540 #if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA)
3541 block_input ();
3542 x_set_frame_alpha (f);
3543 unblock_input ();
3544 #endif
3546 return;
3550 /* Subroutines of creating an X frame. */
3552 /* Make sure that Vx_resource_name is set to a reasonable value.
3553 Fix it up, or set it to `emacs' if it is too hopeless. */
3555 void
3556 validate_x_resource_name (void)
3558 ptrdiff_t len = 0;
3559 /* Number of valid characters in the resource name. */
3560 ptrdiff_t good_count = 0;
3561 /* Number of invalid characters in the resource name. */
3562 ptrdiff_t bad_count = 0;
3563 Lisp_Object new;
3564 ptrdiff_t i;
3566 if (!STRINGP (Vx_resource_class))
3567 Vx_resource_class = build_string (EMACS_CLASS);
3569 if (STRINGP (Vx_resource_name))
3571 unsigned char *p = SDATA (Vx_resource_name);
3573 len = SBYTES (Vx_resource_name);
3575 /* Only letters, digits, - and _ are valid in resource names.
3576 Count the valid characters and count the invalid ones. */
3577 for (i = 0; i < len; i++)
3579 int c = p[i];
3580 if (! ((c >= 'a' && c <= 'z')
3581 || (c >= 'A' && c <= 'Z')
3582 || (c >= '0' && c <= '9')
3583 || c == '-' || c == '_'))
3584 bad_count++;
3585 else
3586 good_count++;
3589 else
3590 /* Not a string => completely invalid. */
3591 bad_count = 5, good_count = 0;
3593 /* If name is valid already, return. */
3594 if (bad_count == 0)
3595 return;
3597 /* If name is entirely invalid, or nearly so, or is so implausibly
3598 large that alloca might not work, use `emacs'. */
3599 if (good_count < 2 || MAX_ALLOCA - sizeof ".customization" < len)
3601 Vx_resource_name = build_string ("emacs");
3602 return;
3605 /* Name is partly valid. Copy it and replace the invalid characters
3606 with underscores. */
3608 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
3610 for (i = 0; i < len; i++)
3612 int c = SREF (new, i);
3613 if (! ((c >= 'a' && c <= 'z')
3614 || (c >= 'A' && c <= 'Z')
3615 || (c >= '0' && c <= '9')
3616 || c == '-' || c == '_'))
3617 SSET (new, i, '_');
3622 extern char *x_get_string_resource (XrmDatabase, const char *, const char *);
3623 extern Display_Info *check_x_display_info (Lisp_Object);
3626 /* Get specified attribute from resource database RDB.
3627 See Fx_get_resource below for other parameters. */
3629 static Lisp_Object
3630 xrdb_get_resource (XrmDatabase rdb, Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3632 register char *value;
3633 char *name_key;
3634 char *class_key;
3636 CHECK_STRING (attribute);
3637 CHECK_STRING (class);
3639 if (!NILP (component))
3640 CHECK_STRING (component);
3641 if (!NILP (subclass))
3642 CHECK_STRING (subclass);
3643 if (NILP (component) != NILP (subclass))
3644 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3646 validate_x_resource_name ();
3648 /* Allocate space for the components, the dots which separate them,
3649 and the final '\0'. Make them big enough for the worst case. */
3650 name_key = alloca (SBYTES (Vx_resource_name)
3651 + (STRINGP (component)
3652 ? SBYTES (component) : 0)
3653 + SBYTES (attribute)
3654 + 3);
3656 class_key = alloca (SBYTES (Vx_resource_class)
3657 + SBYTES (class)
3658 + (STRINGP (subclass)
3659 ? SBYTES (subclass) : 0)
3660 + 3);
3662 /* Start with emacs.FRAMENAME for the name (the specific one)
3663 and with `Emacs' for the class key (the general one). */
3664 strcpy (name_key, SSDATA (Vx_resource_name));
3665 strcpy (class_key, SSDATA (Vx_resource_class));
3667 strcat (class_key, ".");
3668 strcat (class_key, SSDATA (class));
3670 if (!NILP (component))
3672 strcat (class_key, ".");
3673 strcat (class_key, SSDATA (subclass));
3675 strcat (name_key, ".");
3676 strcat (name_key, SSDATA (component));
3679 strcat (name_key, ".");
3680 strcat (name_key, SSDATA (attribute));
3682 value = x_get_string_resource (rdb, name_key, class_key);
3684 if (value != (char *) 0 && *value)
3685 return build_string (value);
3686 else
3687 return Qnil;
3691 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
3692 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
3693 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
3694 class, where INSTANCE is the name under which Emacs was invoked, or
3695 the name specified by the `-name' or `-rn' command-line arguments.
3697 The optional arguments COMPONENT and SUBCLASS add to the key and the
3698 class, respectively. You must specify both of them or neither.
3699 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
3700 and the class is `Emacs.CLASS.SUBCLASS'. */)
3701 (Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3703 #ifdef HAVE_X_WINDOWS
3704 check_x ();
3705 #endif
3707 return xrdb_get_resource (check_x_display_info (Qnil)->xrdb,
3708 attribute, class, component, subclass);
3711 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
3713 Lisp_Object
3714 display_x_get_resource (Display_Info *dpyinfo, Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3716 return xrdb_get_resource (dpyinfo->xrdb,
3717 attribute, class, component, subclass);
3720 #if defined HAVE_X_WINDOWS && !defined USE_X_TOOLKIT
3721 /* Used when C code wants a resource value. */
3722 /* Called from oldXMenu/Create.c. */
3723 char *
3724 x_get_resource_string (const char *attribute, const char *class)
3726 char *result;
3727 struct frame *sf = SELECTED_FRAME ();
3728 ptrdiff_t invocation_namelen = SBYTES (Vinvocation_name);
3729 USE_SAFE_ALLOCA;
3731 /* Allocate space for the components, the dots which separate them,
3732 and the final '\0'. */
3733 char *name_key = SAFE_ALLOCA (invocation_namelen + strlen (attribute) + 2);
3734 char *class_key = alloca ((sizeof (EMACS_CLASS) - 1) + strlen (class) + 2);
3736 esprintf (name_key, "%s.%s", SSDATA (Vinvocation_name), attribute);
3737 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3739 result = x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
3740 name_key, class_key);
3741 SAFE_FREE ();
3742 return result;
3744 #endif
3746 /* Return the value of parameter PARAM.
3748 First search ALIST, then Vdefault_frame_alist, then the X defaults
3749 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3751 Convert the resource to the type specified by desired_type.
3753 If no default is specified, return Qunbound. If you call
3754 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3755 and don't let it get stored in any Lisp-visible variables! */
3757 Lisp_Object
3758 x_get_arg (Display_Info *dpyinfo, Lisp_Object alist, Lisp_Object param,
3759 const char *attribute, const char *class, enum resource_types type)
3761 register Lisp_Object tem;
3763 tem = Fassq (param, alist);
3765 if (!NILP (tem))
3767 /* If we find this parm in ALIST, clear it out
3768 so that it won't be "left over" at the end. */
3769 Lisp_Object tail;
3770 XSETCAR (tem, Qnil);
3771 /* In case the parameter appears more than once in the alist,
3772 clear it out. */
3773 for (tail = alist; CONSP (tail); tail = XCDR (tail))
3774 if (CONSP (XCAR (tail))
3775 && EQ (XCAR (XCAR (tail)), param))
3776 XSETCAR (XCAR (tail), Qnil);
3778 else
3779 tem = Fassq (param, Vdefault_frame_alist);
3781 /* If it wasn't specified in ALIST or the Lisp-level defaults,
3782 look in the X resources. */
3783 if (EQ (tem, Qnil))
3785 if (attribute && dpyinfo)
3787 tem = display_x_get_resource (dpyinfo,
3788 build_string (attribute),
3789 build_string (class),
3790 Qnil, Qnil);
3792 if (NILP (tem))
3793 return Qunbound;
3795 switch (type)
3797 case RES_TYPE_NUMBER:
3798 return make_number (atoi (SSDATA (tem)));
3800 case RES_TYPE_BOOLEAN_NUMBER:
3801 if (!strcmp (SSDATA (tem), "on")
3802 || !strcmp (SSDATA (tem), "true"))
3803 return make_number (1);
3804 return make_number (atoi (SSDATA (tem)));
3805 break;
3807 case RES_TYPE_FLOAT:
3808 return make_float (atof (SSDATA (tem)));
3810 case RES_TYPE_BOOLEAN:
3811 tem = Fdowncase (tem);
3812 if (!strcmp (SSDATA (tem), "on")
3813 #ifdef HAVE_NS
3814 || !strcmp (SSDATA (tem), "yes")
3815 #endif
3816 || !strcmp (SSDATA (tem), "true"))
3817 return Qt;
3818 else
3819 return Qnil;
3821 case RES_TYPE_STRING:
3822 return tem;
3824 case RES_TYPE_SYMBOL:
3825 /* As a special case, we map the values `true' and `on'
3826 to Qt, and `false' and `off' to Qnil. */
3828 Lisp_Object lower;
3829 lower = Fdowncase (tem);
3830 if (!strcmp (SSDATA (lower), "on")
3831 #ifdef HAVE_NS
3832 || !strcmp (SSDATA (lower), "yes")
3833 #endif
3834 || !strcmp (SSDATA (lower), "true"))
3835 return Qt;
3836 else if (!strcmp (SSDATA (lower), "off")
3837 #ifdef HAVE_NS
3838 || !strcmp (SSDATA (lower), "no")
3839 #endif
3840 || !strcmp (SSDATA (lower), "false"))
3841 return Qnil;
3842 else
3843 return Fintern (tem, Qnil);
3846 default:
3847 emacs_abort ();
3850 else
3851 return Qunbound;
3853 return Fcdr (tem);
3856 static Lisp_Object
3857 x_frame_get_arg (struct frame *f, Lisp_Object alist, Lisp_Object param,
3858 const char *attribute, const char *class,
3859 enum resource_types type)
3861 return x_get_arg (FRAME_X_DISPLAY_INFO (f),
3862 alist, param, attribute, class, type);
3865 /* Like x_frame_get_arg, but also record the value in f->param_alist. */
3867 Lisp_Object
3868 x_frame_get_and_record_arg (struct frame *f, Lisp_Object alist,
3869 Lisp_Object param,
3870 const char *attribute, const char *class,
3871 enum resource_types type)
3873 Lisp_Object value;
3875 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
3876 attribute, class, type);
3877 if (! NILP (value) && ! EQ (value, Qunbound))
3878 store_frame_param (f, param, value);
3880 return value;
3884 /* Record in frame F the specified or default value according to ALIST
3885 of the parameter named PROP (a Lisp symbol).
3886 If no value is specified for PROP, look for an X default for XPROP
3887 on the frame named NAME.
3888 If that is not found either, use the value DEFLT. */
3890 Lisp_Object
3891 x_default_parameter (struct frame *f, Lisp_Object alist, Lisp_Object prop,
3892 Lisp_Object deflt, const char *xprop, const char *xclass,
3893 enum resource_types type)
3895 Lisp_Object tem;
3897 tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type);
3898 if (EQ (tem, Qunbound))
3899 tem = deflt;
3900 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
3901 return tem;
3905 #if !defined (HAVE_X_WINDOWS) && defined (NoValue)
3908 * XParseGeometry parses strings of the form
3909 * "=<width>x<height>{+-}<xoffset>{+-}<yoffset>", where
3910 * width, height, xoffset, and yoffset are unsigned integers.
3911 * Example: "=80x24+300-49"
3912 * The equal sign is optional.
3913 * It returns a bitmask that indicates which of the four values
3914 * were actually found in the string. For each value found,
3915 * the corresponding argument is updated; for each value
3916 * not found, the corresponding argument is left unchanged.
3919 static int
3920 XParseGeometry (char *string,
3921 int *x, int *y,
3922 unsigned int *width, unsigned int *height)
3924 int mask = NoValue;
3925 char *strind;
3926 unsigned long int tempWidth, tempHeight;
3927 long int tempX, tempY;
3928 char *nextCharacter;
3930 if (string == NULL || *string == '\0')
3931 return mask;
3932 if (*string == '=')
3933 string++; /* ignore possible '=' at beg of geometry spec */
3935 strind = string;
3936 if (*strind != '+' && *strind != '-' && *strind != 'x')
3938 tempWidth = strtoul (strind, &nextCharacter, 10);
3939 if (strind == nextCharacter)
3940 return 0;
3941 strind = nextCharacter;
3942 mask |= WidthValue;
3945 if (*strind == 'x' || *strind == 'X')
3947 strind++;
3948 tempHeight = strtoul (strind, &nextCharacter, 10);
3949 if (strind == nextCharacter)
3950 return 0;
3951 strind = nextCharacter;
3952 mask |= HeightValue;
3955 if (*strind == '+' || *strind == '-')
3957 if (*strind == '-')
3958 mask |= XNegative;
3959 tempX = strtol (strind, &nextCharacter, 10);
3960 if (strind == nextCharacter)
3961 return 0;
3962 strind = nextCharacter;
3963 mask |= XValue;
3964 if (*strind == '+' || *strind == '-')
3966 if (*strind == '-')
3967 mask |= YNegative;
3968 tempY = strtol (strind, &nextCharacter, 10);
3969 if (strind == nextCharacter)
3970 return 0;
3971 strind = nextCharacter;
3972 mask |= YValue;
3976 /* If strind isn't at the end of the string then it's an invalid
3977 geometry specification. */
3979 if (*strind != '\0')
3980 return 0;
3982 if (mask & XValue)
3983 *x = clip_to_bounds (INT_MIN, tempX, INT_MAX);
3984 if (mask & YValue)
3985 *y = clip_to_bounds (INT_MIN, tempY, INT_MAX);
3986 if (mask & WidthValue)
3987 *width = min (tempWidth, UINT_MAX);
3988 if (mask & HeightValue)
3989 *height = min (tempHeight, UINT_MAX);
3990 return mask;
3993 #endif /* !defined (HAVE_X_WINDOWS) && defined (NoValue) */
3996 /* NS used to define x-parse-geometry in ns-win.el, but that confused
3997 make-docfile: the documentation string in ns-win.el was used for
3998 x-parse-geometry even in non-NS builds.
4000 With two definitions of x-parse-geometry in this file, various
4001 things still get confused (eg M-x apropos documentation), so that
4002 it is best if the two definitions just share the same doc-string.
4004 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
4005 doc: /* Parse a display geometry string STRING.
4006 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
4007 The properties returned may include `top', `left', `height', and `width'.
4008 For X, the value of `left' or `top' may be an integer,
4009 or a list (+ N) meaning N pixels relative to top/left corner,
4010 or a list (- N) meaning -N pixels relative to bottom/right corner.
4011 On Nextstep, this just calls `ns-parse-geometry'. */)
4012 (Lisp_Object string)
4014 int geometry, x, y;
4015 unsigned int width, height;
4016 Lisp_Object result;
4018 CHECK_STRING (string);
4020 #ifdef HAVE_NS
4021 if (strchr (SSDATA (string), ' ') != NULL)
4022 return call1 (Qns_parse_geometry, string);
4023 #endif
4024 geometry = XParseGeometry (SSDATA (string),
4025 &x, &y, &width, &height);
4026 result = Qnil;
4027 if (geometry & XValue)
4029 Lisp_Object element;
4031 if (x >= 0 && (geometry & XNegative))
4032 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
4033 else if (x < 0 && ! (geometry & XNegative))
4034 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
4035 else
4036 element = Fcons (Qleft, make_number (x));
4037 result = Fcons (element, result);
4040 if (geometry & YValue)
4042 Lisp_Object element;
4044 if (y >= 0 && (geometry & YNegative))
4045 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
4046 else if (y < 0 && ! (geometry & YNegative))
4047 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
4048 else
4049 element = Fcons (Qtop, make_number (y));
4050 result = Fcons (element, result);
4053 if (geometry & WidthValue)
4054 result = Fcons (Fcons (Qwidth, make_number (width)), result);
4055 if (geometry & HeightValue)
4056 result = Fcons (Fcons (Qheight, make_number (height)), result);
4058 return result;
4062 /* Calculate the desired size and position of frame F.
4063 Return the flags saying which aspects were specified.
4065 Also set the win_gravity and size_hint_flags of F.
4067 Adjust height for toolbar if TOOLBAR_P is 1.
4069 This function does not make the coordinates positive. */
4071 #define DEFAULT_ROWS 35
4072 #define DEFAULT_COLS 80
4075 x_figure_window_size (struct frame *f, Lisp_Object parms, int toolbar_p)
4077 register Lisp_Object tem0, tem1, tem2;
4078 long window_prompting = 0;
4079 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
4081 /* Default values if we fall through.
4082 Actually, if that happens we should get
4083 window manager prompting. */
4084 SET_FRAME_COLS (f, DEFAULT_COLS);
4085 FRAME_LINES (f) = DEFAULT_ROWS;
4086 /* Window managers expect that if program-specified
4087 positions are not (0,0), they're intentional, not defaults. */
4088 f->top_pos = 0;
4089 f->left_pos = 0;
4091 /* Ensure that old new_text_cols and new_text_lines will not override the
4092 values set here. */
4093 /* ++KFS: This was specific to W32, but seems ok for all platforms */
4094 f->new_text_cols = f->new_text_lines = 0;
4096 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
4097 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
4098 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
4099 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4101 if (!EQ (tem0, Qunbound))
4103 CHECK_NUMBER (tem0);
4104 if (! (0 <= XINT (tem0) && XINT (tem0) <= INT_MAX))
4105 xsignal1 (Qargs_out_of_range, tem0);
4106 FRAME_LINES (f) = XINT (tem0);
4108 if (!EQ (tem1, Qunbound))
4110 CHECK_NUMBER (tem1);
4111 if (! (0 <= XINT (tem1) && XINT (tem1) <= INT_MAX))
4112 xsignal1 (Qargs_out_of_range, tem1);
4113 SET_FRAME_COLS (f, XINT (tem1));
4115 if (!NILP (tem2) && !EQ (tem2, Qunbound))
4116 window_prompting |= USSize;
4117 else
4118 window_prompting |= PSize;
4121 f->scroll_bar_actual_width
4122 = FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f);
4124 /* This used to be done _before_ calling x_figure_window_size, but
4125 since the height is reset here, this was really a no-op. I
4126 assume that moving it here does what Gerd intended (although he
4127 no longer can remember what that was... ++KFS, 2003-03-25. */
4129 /* Add the tool-bar height to the initial frame height so that the
4130 user gets a text display area of the size he specified with -g or
4131 via .Xdefaults. Later changes of the tool-bar height don't
4132 change the frame size. This is done so that users can create
4133 tall Emacs frames without having to guess how tall the tool-bar
4134 will get. */
4135 if (toolbar_p && FRAME_TOOL_BAR_LINES (f))
4137 int margin, relief, bar_height;
4139 relief = (tool_bar_button_relief >= 0
4140 ? tool_bar_button_relief
4141 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
4143 if (RANGED_INTEGERP (1, Vtool_bar_button_margin, INT_MAX))
4144 margin = XFASTINT (Vtool_bar_button_margin);
4145 else if (CONSP (Vtool_bar_button_margin)
4146 && RANGED_INTEGERP (1, XCDR (Vtool_bar_button_margin), INT_MAX))
4147 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
4148 else
4149 margin = 0;
4151 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
4152 FRAME_LINES (f) += (bar_height + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f);
4155 compute_fringe_widths (f, 0);
4157 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, FRAME_COLS (f));
4158 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, FRAME_LINES (f));
4160 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
4161 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
4162 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
4163 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4165 if (EQ (tem0, Qminus))
4167 f->top_pos = 0;
4168 window_prompting |= YNegative;
4170 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
4171 && CONSP (XCDR (tem0))
4172 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (tem0)), INT_MAX))
4174 f->top_pos = - XINT (XCAR (XCDR (tem0)));
4175 window_prompting |= YNegative;
4177 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
4178 && CONSP (XCDR (tem0))
4179 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (tem0))))
4181 f->top_pos = XINT (XCAR (XCDR (tem0)));
4183 else if (EQ (tem0, Qunbound))
4184 f->top_pos = 0;
4185 else
4187 CHECK_TYPE_RANGED_INTEGER (int, tem0);
4188 f->top_pos = XINT (tem0);
4189 if (f->top_pos < 0)
4190 window_prompting |= YNegative;
4193 if (EQ (tem1, Qminus))
4195 f->left_pos = 0;
4196 window_prompting |= XNegative;
4198 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
4199 && CONSP (XCDR (tem1))
4200 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (tem1)), INT_MAX))
4202 f->left_pos = - XINT (XCAR (XCDR (tem1)));
4203 window_prompting |= XNegative;
4205 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
4206 && CONSP (XCDR (tem1))
4207 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (tem1))))
4209 f->left_pos = XINT (XCAR (XCDR (tem1)));
4211 else if (EQ (tem1, Qunbound))
4212 f->left_pos = 0;
4213 else
4215 CHECK_TYPE_RANGED_INTEGER (int, tem1);
4216 f->left_pos = XINT (tem1);
4217 if (f->left_pos < 0)
4218 window_prompting |= XNegative;
4221 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
4222 window_prompting |= USPosition;
4223 else
4224 window_prompting |= PPosition;
4227 if (window_prompting & XNegative)
4229 if (window_prompting & YNegative)
4230 f->win_gravity = SouthEastGravity;
4231 else
4232 f->win_gravity = NorthEastGravity;
4234 else
4236 if (window_prompting & YNegative)
4237 f->win_gravity = SouthWestGravity;
4238 else
4239 f->win_gravity = NorthWestGravity;
4242 f->size_hint_flags = window_prompting;
4244 return window_prompting;
4249 #endif /* HAVE_WINDOW_SYSTEM */
4251 void
4252 frame_make_pointer_invisible (void)
4254 if (! NILP (Vmake_pointer_invisible))
4256 struct frame *f;
4257 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4258 return;
4260 f = SELECTED_FRAME ();
4261 if (f && !f->pointer_invisible
4262 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4264 f->mouse_moved = 0;
4265 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 1);
4266 f->pointer_invisible = 1;
4271 void
4272 frame_make_pointer_visible (void)
4274 /* We don't check Vmake_pointer_invisible here in case the
4275 pointer was invisible when Vmake_pointer_invisible was set to nil. */
4276 struct frame *f;
4278 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4279 return;
4281 f = SELECTED_FRAME ();
4282 if (f && f->pointer_invisible && f->mouse_moved
4283 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4285 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 0);
4286 f->pointer_invisible = 0;
4290 DEFUN ("frame-pointer-visible-p", Fframe_pointer_visible_p,
4291 Sframe_pointer_visible_p, 0, 1, 0,
4292 doc: /* Return t if the mouse pointer displayed on FRAME is visible.
4293 Otherwise it returns nil. FRAME omitted or nil means the
4294 selected frame. This is useful when `make-pointer-invisible' is set. */)
4295 (Lisp_Object frame)
4297 if (NILP (frame))
4298 frame = selected_frame;
4300 CHECK_FRAME (frame);
4302 return (XFRAME (frame)->pointer_invisible ? Qnil : Qt);
4306 /***********************************************************************
4307 Initialization
4308 ***********************************************************************/
4310 void
4311 syms_of_frame (void)
4313 DEFSYM (Qframep, "framep");
4314 DEFSYM (Qframe_live_p, "frame-live-p");
4315 DEFSYM (Qexplicit_name, "explicit-name");
4316 DEFSYM (Qheight, "height");
4317 DEFSYM (Qicon, "icon");
4318 DEFSYM (Qminibuffer, "minibuffer");
4319 DEFSYM (Qmodeline, "modeline");
4320 DEFSYM (Qonly, "only");
4321 DEFSYM (Qnone, "none");
4322 DEFSYM (Qwidth, "width");
4323 DEFSYM (Qgeometry, "geometry");
4324 DEFSYM (Qicon_left, "icon-left");
4325 DEFSYM (Qicon_top, "icon-top");
4326 DEFSYM (Qtooltip, "tooltip");
4327 DEFSYM (Qleft, "left");
4328 DEFSYM (Qright, "right");
4329 DEFSYM (Quser_position, "user-position");
4330 DEFSYM (Quser_size, "user-size");
4331 DEFSYM (Qwindow_id, "window-id");
4332 #ifdef HAVE_X_WINDOWS
4333 DEFSYM (Qouter_window_id, "outer-window-id");
4334 #endif
4335 DEFSYM (Qparent_id, "parent-id");
4336 DEFSYM (Qx, "x");
4337 DEFSYM (Qw32, "w32");
4338 DEFSYM (Qpc, "pc");
4339 DEFSYM (Qns, "ns");
4340 DEFSYM (Qvisible, "visible");
4341 DEFSYM (Qbuffer_predicate, "buffer-predicate");
4342 DEFSYM (Qbuffer_list, "buffer-list");
4343 DEFSYM (Qburied_buffer_list, "buried-buffer-list");
4344 DEFSYM (Qdisplay_type, "display-type");
4345 DEFSYM (Qbackground_mode, "background-mode");
4346 DEFSYM (Qnoelisp, "noelisp");
4347 DEFSYM (Qtty_color_mode, "tty-color-mode");
4348 DEFSYM (Qtty, "tty");
4349 DEFSYM (Qtty_type, "tty-type");
4351 DEFSYM (Qface_set_after_frame_default, "face-set-after-frame-default");
4353 DEFSYM (Qfullwidth, "fullwidth");
4354 DEFSYM (Qfullheight, "fullheight");
4355 DEFSYM (Qfullboth, "fullboth");
4356 DEFSYM (Qmaximized, "maximized");
4357 DEFSYM (Qx_resource_name, "x-resource-name");
4358 DEFSYM (Qx_frame_parameter, "x-frame-parameter");
4360 DEFSYM (Qterminal, "terminal");
4361 DEFSYM (Qterminal_live_p, "terminal-live-p");
4363 #ifdef HAVE_NS
4364 DEFSYM (Qns_parse_geometry, "ns-parse-geometry");
4365 #endif
4368 int i;
4370 for (i = 0; i < sizeof (frame_parms) / sizeof (frame_parms[0]); i++)
4372 Lisp_Object v = intern_c_string (frame_parms[i].name);
4373 if (frame_parms[i].variable)
4375 *frame_parms[i].variable = v;
4376 staticpro (frame_parms[i].variable);
4378 Fput (v, Qx_frame_parameter, make_number (i));
4382 #ifdef HAVE_WINDOW_SYSTEM
4383 DEFVAR_LISP ("x-resource-name", Vx_resource_name,
4384 doc: /* The name Emacs uses to look up X resources.
4385 `x-get-resource' uses this as the first component of the instance name
4386 when requesting resource values.
4387 Emacs initially sets `x-resource-name' to the name under which Emacs
4388 was invoked, or to the value specified with the `-name' or `-rn'
4389 switches, if present.
4391 It may be useful to bind this variable locally around a call
4392 to `x-get-resource'. See also the variable `x-resource-class'. */);
4393 Vx_resource_name = Qnil;
4395 DEFVAR_LISP ("x-resource-class", Vx_resource_class,
4396 doc: /* The class Emacs uses to look up X resources.
4397 `x-get-resource' uses this as the first component of the instance class
4398 when requesting resource values.
4400 Emacs initially sets `x-resource-class' to "Emacs".
4402 Setting this variable permanently is not a reasonable thing to do,
4403 but binding this variable locally around a call to `x-get-resource'
4404 is a reasonable practice. See also the variable `x-resource-name'. */);
4405 Vx_resource_class = build_string (EMACS_CLASS);
4407 DEFVAR_LISP ("frame-alpha-lower-limit", Vframe_alpha_lower_limit,
4408 doc: /* The lower limit of the frame opacity (alpha transparency).
4409 The value should range from 0 (invisible) to 100 (completely opaque).
4410 You can also use a floating number between 0.0 and 1.0.
4411 The default is 20. */);
4412 Vframe_alpha_lower_limit = make_number (20);
4413 #endif
4415 DEFVAR_LISP ("default-frame-alist", Vdefault_frame_alist,
4416 doc: /* Alist of default values for frame creation.
4417 These may be set in your init file, like this:
4418 (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1)))
4419 These override values given in window system configuration data,
4420 including X Windows' defaults database.
4421 For values specific to the first Emacs frame, see `initial-frame-alist'.
4422 For window-system specific values, see `window-system-default-frame-alist'.
4423 For values specific to the separate minibuffer frame, see
4424 `minibuffer-frame-alist'.
4425 The `menu-bar-lines' element of the list controls whether new frames
4426 have menu bars; `menu-bar-mode' works by altering this element.
4427 Setting this variable does not affect existing frames, only new ones. */);
4428 Vdefault_frame_alist = Qnil;
4430 DEFVAR_LISP ("default-frame-scroll-bars", Vdefault_frame_scroll_bars,
4431 doc: /* Default position of scroll bars on this window-system. */);
4432 #ifdef HAVE_WINDOW_SYSTEM
4433 #if defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA) || (defined (USE_GTK) && defined (USE_TOOLKIT_SCROLL_BARS))
4434 /* MS-Windows, Mac OS X, and GTK have scroll bars on the right by
4435 default. */
4436 Vdefault_frame_scroll_bars = Qright;
4437 #else
4438 Vdefault_frame_scroll_bars = Qleft;
4439 #endif
4440 #else
4441 Vdefault_frame_scroll_bars = Qnil;
4442 #endif
4444 DEFVAR_LISP ("terminal-frame", Vterminal_frame,
4445 doc: /* The initial frame-object, which represents Emacs's stdout. */);
4447 DEFVAR_LISP ("mouse-position-function", Vmouse_position_function,
4448 doc: /* If non-nil, function to transform normal value of `mouse-position'.
4449 `mouse-position' calls this function, passing its usual return value as
4450 argument, and returns whatever this function returns.
4451 This abnormal hook exists for the benefit of packages like `xt-mouse.el'
4452 which need to do mouse handling at the Lisp level. */);
4453 Vmouse_position_function = Qnil;
4455 DEFVAR_LISP ("mouse-highlight", Vmouse_highlight,
4456 doc: /* If non-nil, clickable text is highlighted when mouse is over it.
4457 If the value is an integer, highlighting is only shown after moving the
4458 mouse, while keyboard input turns off the highlight even when the mouse
4459 is over the clickable text. However, the mouse shape still indicates
4460 when the mouse is over clickable text. */);
4461 Vmouse_highlight = Qt;
4463 DEFVAR_LISP ("make-pointer-invisible", Vmake_pointer_invisible,
4464 doc: /* If non-nil, make pointer invisible while typing.
4465 The pointer becomes visible again when the mouse is moved. */);
4466 Vmake_pointer_invisible = Qt;
4468 DEFVAR_LISP ("delete-frame-functions", Vdelete_frame_functions,
4469 doc: /* Functions run before deleting a frame.
4470 The functions are run with one arg, the frame to be deleted.
4471 See `delete-frame'.
4473 Note that functions in this list may be called just before the frame is
4474 actually deleted, or some time later (or even both when an earlier function
4475 in `delete-frame-functions' (indirectly) calls `delete-frame'
4476 recursively). */);
4477 Vdelete_frame_functions = Qnil;
4478 DEFSYM (Qdelete_frame_functions, "delete-frame-functions");
4480 DEFVAR_LISP ("menu-bar-mode", Vmenu_bar_mode,
4481 doc: /* Non-nil if Menu-Bar mode is enabled.
4482 See the command `menu-bar-mode' for a description of this minor mode.
4483 Setting this variable directly does not take effect;
4484 either customize it (see the info node `Easy Customization')
4485 or call the function `menu-bar-mode'. */);
4486 Vmenu_bar_mode = Qt;
4488 DEFVAR_LISP ("tool-bar-mode", Vtool_bar_mode,
4489 doc: /* Non-nil if Tool-Bar mode is enabled.
4490 See the command `tool-bar-mode' for a description of this minor mode.
4491 Setting this variable directly does not take effect;
4492 either customize it (see the info node `Easy Customization')
4493 or call the function `tool-bar-mode'. */);
4494 #ifdef HAVE_WINDOW_SYSTEM
4495 Vtool_bar_mode = Qt;
4496 #else
4497 Vtool_bar_mode = Qnil;
4498 #endif
4500 DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
4501 doc: /* Minibufferless frames use this frame's minibuffer.
4503 Emacs cannot create minibufferless frames unless this is set to an
4504 appropriate surrogate.
4506 Emacs consults this variable only when creating minibufferless
4507 frames; once the frame is created, it sticks with its assigned
4508 minibuffer, no matter what this variable is set to. This means that
4509 this variable doesn't necessarily say anything meaningful about the
4510 current set of frames, or where the minibuffer is currently being
4511 displayed.
4513 This variable is local to the current terminal and cannot be buffer-local. */);
4515 DEFVAR_BOOL ("focus-follows-mouse", focus_follows_mouse,
4516 doc: /* Non-nil if window system changes focus when you move the mouse.
4517 You should set this variable to tell Emacs how your window manager
4518 handles focus, since there is no way in general for Emacs to find out
4519 automatically. See also `mouse-autoselect-window'. */);
4520 focus_follows_mouse = 0;
4522 staticpro (&Vframe_list);
4524 defsubr (&Sframep);
4525 defsubr (&Sframe_live_p);
4526 defsubr (&Swindow_system);
4527 defsubr (&Smake_terminal_frame);
4528 defsubr (&Shandle_switch_frame);
4529 defsubr (&Sselect_frame);
4530 defsubr (&Sselected_frame);
4531 defsubr (&Sframe_list);
4532 defsubr (&Snext_frame);
4533 defsubr (&Sprevious_frame);
4534 defsubr (&Sdelete_frame);
4535 defsubr (&Smouse_position);
4536 defsubr (&Smouse_pixel_position);
4537 defsubr (&Sset_mouse_position);
4538 defsubr (&Sset_mouse_pixel_position);
4539 #if 0
4540 defsubr (&Sframe_configuration);
4541 defsubr (&Srestore_frame_configuration);
4542 #endif
4543 defsubr (&Smake_frame_visible);
4544 defsubr (&Smake_frame_invisible);
4545 defsubr (&Siconify_frame);
4546 defsubr (&Sframe_visible_p);
4547 defsubr (&Svisible_frame_list);
4548 defsubr (&Sraise_frame);
4549 defsubr (&Slower_frame);
4550 defsubr (&Sredirect_frame_focus);
4551 defsubr (&Sframe_focus);
4552 defsubr (&Sframe_parameters);
4553 defsubr (&Sframe_parameter);
4554 defsubr (&Smodify_frame_parameters);
4555 defsubr (&Sframe_char_height);
4556 defsubr (&Sframe_char_width);
4557 defsubr (&Sframe_pixel_height);
4558 defsubr (&Sframe_pixel_width);
4559 defsubr (&Stool_bar_pixel_width);
4560 defsubr (&Sset_frame_height);
4561 defsubr (&Sset_frame_width);
4562 defsubr (&Sset_frame_size);
4563 defsubr (&Sset_frame_position);
4564 defsubr (&Sframe_pointer_visible_p);
4566 #ifdef HAVE_WINDOW_SYSTEM
4567 defsubr (&Sx_get_resource);
4568 defsubr (&Sx_parse_geometry);
4569 #endif