* src/xdisp.c (select_frame_for_redisplay): Keep selected_window and
[emacs.git] / src / frame.c
blob5cefad6ca4625aff7a5731dcf13e8d990af29b20
1 /* Generic frame functions.
3 Copyright (C) 1993-1995, 1997, 1999-2012 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20 #include <config.h>
22 #define FRAME_INLINE EXTERN_INLINE
24 #include <stdio.h>
25 #include <errno.h>
26 #include <limits.h>
28 #include <c-ctype.h>
30 #include "lisp.h"
31 #include "character.h"
33 #ifdef HAVE_WINDOW_SYSTEM
34 #include TERM_HEADER
35 #endif /* HAVE_WINDOW_SYSTEM */
37 #include "buffer.h"
38 /* These help us bind and responding to switch-frame events. */
39 #include "commands.h"
40 #include "keyboard.h"
41 #include "frame.h"
42 #include "blockinput.h"
43 #include "termchar.h"
44 #include "termhooks.h"
45 #include "dispextern.h"
46 #include "window.h"
47 #include "font.h"
48 #ifdef HAVE_WINDOW_SYSTEM
49 #include "fontset.h"
50 #endif
51 #ifdef MSDOS
52 #include "msdos.h"
53 #include "dosfns.h"
54 #endif
56 #ifdef HAVE_NS
57 Lisp_Object Qns_parse_geometry;
58 #endif
60 Lisp_Object Qframep, Qframe_live_p;
61 Lisp_Object Qicon, Qmodeline;
62 Lisp_Object Qonly, Qnone;
63 Lisp_Object Qx, Qw32, Qmac, Qpc, Qns;
64 Lisp_Object Qvisible;
65 Lisp_Object Qdisplay_type;
66 static Lisp_Object Qbackground_mode;
67 Lisp_Object Qnoelisp;
69 static Lisp_Object Qx_frame_parameter;
70 Lisp_Object Qx_resource_name;
71 Lisp_Object Qterminal;
72 Lisp_Object Qterminal_live_p;
74 /* Frame parameters (set or reported). */
76 Lisp_Object Qauto_raise, Qauto_lower;
77 Lisp_Object Qborder_color, Qborder_width;
78 Lisp_Object Qcursor_color, Qcursor_type;
79 static Lisp_Object Qgeometry; /* Not used */
80 Lisp_Object Qheight, Qwidth;
81 Lisp_Object Qleft, Qright;
82 Lisp_Object Qicon_left, Qicon_top, Qicon_type, Qicon_name;
83 Lisp_Object Qtooltip;
84 Lisp_Object Qinternal_border_width;
85 Lisp_Object Qmouse_color;
86 Lisp_Object Qminibuffer;
87 Lisp_Object Qscroll_bar_width, Qvertical_scroll_bars;
88 Lisp_Object Qvisibility;
89 Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
90 Lisp_Object Qscreen_gamma;
91 Lisp_Object Qline_spacing;
92 static Lisp_Object Quser_position, Quser_size;
93 Lisp_Object Qwait_for_wm;
94 static Lisp_Object Qwindow_id;
95 #ifdef HAVE_X_WINDOWS
96 static Lisp_Object Qouter_window_id;
97 #endif
98 Lisp_Object Qparent_id;
99 Lisp_Object Qtitle, Qname;
100 static Lisp_Object Qexplicit_name;
101 Lisp_Object Qunsplittable;
102 Lisp_Object Qmenu_bar_lines, Qtool_bar_lines, Qtool_bar_position;
103 Lisp_Object Qleft_fringe, Qright_fringe;
104 Lisp_Object Qbuffer_predicate;
105 static Lisp_Object Qbuffer_list, Qburied_buffer_list;
106 Lisp_Object Qtty_color_mode;
107 Lisp_Object Qtty, Qtty_type;
109 Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth, Qmaximized;
110 Lisp_Object Qsticky;
111 Lisp_Object Qfont_backend;
112 Lisp_Object Qalpha;
114 Lisp_Object Qface_set_after_frame_default;
116 static Lisp_Object Qdelete_frame_functions;
118 #ifdef HAVE_WINDOW_SYSTEM
119 static void x_report_frame_params (struct frame *, Lisp_Object *);
120 #endif
122 /* These setters are used only in this file, so they can be private. */
123 static void
124 fset_buffer_predicate (struct frame *f, Lisp_Object val)
126 f->buffer_predicate = val;
128 static void
129 fset_minibuffer_window (struct frame *f, Lisp_Object val)
131 f->minibuffer_window = val;
134 struct frame *
135 decode_live_frame (register Lisp_Object frame)
137 if (NILP (frame))
138 frame = selected_frame;
139 CHECK_LIVE_FRAME (frame);
140 return XFRAME (frame);
143 struct frame *
144 decode_any_frame (register Lisp_Object frame)
146 if (NILP (frame))
147 frame = selected_frame;
148 CHECK_FRAME (frame);
149 return XFRAME (frame);
152 static void
153 set_menu_bar_lines_1 (Lisp_Object window, int n)
155 struct window *w = XWINDOW (window);
157 w->last_modified = 0;
158 wset_top_line (w, make_number (XFASTINT (w->top_line) + n));
159 wset_total_lines (w, make_number (XFASTINT (w->total_lines) - n));
161 /* Handle just the top child in a vertical split. */
162 if (!NILP (w->vchild))
163 set_menu_bar_lines_1 (w->vchild, n);
165 /* Adjust all children in a horizontal split. */
166 for (window = w->hchild; !NILP (window); window = w->next)
168 w = XWINDOW (window);
169 set_menu_bar_lines_1 (window, n);
173 void
174 set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
176 int nlines;
177 int olines = FRAME_MENU_BAR_LINES (f);
179 /* Right now, menu bars don't work properly in minibuf-only frames;
180 most of the commands try to apply themselves to the minibuffer
181 frame itself, and get an error because you can't switch buffers
182 in or split the minibuffer window. */
183 if (FRAME_MINIBUF_ONLY_P (f))
184 return;
186 if (TYPE_RANGED_INTEGERP (int, value))
187 nlines = XINT (value);
188 else
189 nlines = 0;
191 if (nlines != olines)
193 windows_or_buffers_changed++;
194 FRAME_WINDOW_SIZES_CHANGED (f) = 1;
195 FRAME_MENU_BAR_LINES (f) = nlines;
196 set_menu_bar_lines_1 (f->root_window, nlines - olines);
197 adjust_glyphs (f);
201 Lisp_Object Vframe_list;
204 DEFUN ("framep", Fframep, Sframep, 1, 1, 0,
205 doc: /* Return non-nil if OBJECT is a frame.
206 Value is:
207 t for a termcap frame (a character-only terminal),
208 'x' for an Emacs frame that is really an X window,
209 'w32' for an Emacs frame that is a window on MS-Windows display,
210 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
211 'pc' for a direct-write MS-DOS frame.
212 See also `frame-live-p'. */)
213 (Lisp_Object object)
215 if (!FRAMEP (object))
216 return Qnil;
217 switch (XFRAME (object)->output_method)
219 case output_initial: /* The initial frame is like a termcap frame. */
220 case output_termcap:
221 return Qt;
222 case output_x_window:
223 return Qx;
224 case output_w32:
225 return Qw32;
226 case output_msdos_raw:
227 return Qpc;
228 case output_mac:
229 return Qmac;
230 case output_ns:
231 return Qns;
232 default:
233 emacs_abort ();
237 DEFUN ("frame-live-p", Fframe_live_p, Sframe_live_p, 1, 1, 0,
238 doc: /* Return non-nil if OBJECT is a frame which has not been deleted.
239 Value is nil if OBJECT is not a live frame. If object is a live
240 frame, the return value indicates what sort of terminal device it is
241 displayed on. See the documentation of `framep' for possible
242 return values. */)
243 (Lisp_Object object)
245 return ((FRAMEP (object)
246 && FRAME_LIVE_P (XFRAME (object)))
247 ? Fframep (object)
248 : Qnil);
251 DEFUN ("window-system", Fwindow_system, Swindow_system, 0, 1, 0,
252 doc: /* The name of the window system that FRAME is displaying through.
253 The value is a symbol:
254 nil for a termcap frame (a character-only terminal),
255 'x' for an Emacs frame that is really an X window,
256 'w32' for an Emacs frame that is a window on MS-Windows display,
257 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
258 'pc' for a direct-write MS-DOS frame.
260 FRAME defaults to the currently selected frame.
262 Use of this function as a predicate is deprecated. Instead,
263 use `display-graphic-p' or any of the other `display-*-p'
264 predicates which report frame's specific UI-related capabilities. */)
265 (Lisp_Object frame)
267 Lisp_Object type;
268 if (NILP (frame))
269 frame = selected_frame;
271 type = Fframep (frame);
273 if (NILP (type))
274 wrong_type_argument (Qframep, frame);
276 if (EQ (type, Qt))
277 return Qnil;
278 else
279 return type;
282 struct frame *
283 make_frame (int mini_p)
285 Lisp_Object frame;
286 register struct frame *f;
287 register Lisp_Object root_window;
288 register Lisp_Object mini_window;
290 f = allocate_frame ();
291 XSETFRAME (frame, f);
293 /* Initialize Lisp data. Note that allocate_frame initializes all
294 Lisp data to nil, so do it only for slots which should not be nil. */
295 fset_tool_bar_position (f, Qtop);
297 /* Initialize non-Lisp data. Note that allocate_frame zeroes out all
298 non-Lisp data, so do it only for slots which should not be zero.
299 To avoid subtle bugs and for the sake of readability, it's better to
300 initialize enum members explicitly even if their values are zero. */
301 f->wants_modeline = 1;
302 f->garbaged = 1;
303 f->has_minibuffer = mini_p;
304 f->vertical_scroll_bar_type = vertical_scroll_bar_none;
305 f->column_width = 1; /* !FRAME_WINDOW_P value */
306 f->line_height = 1; /* !FRAME_WINDOW_P value */
307 #ifdef HAVE_WINDOW_SYSTEM
308 f->want_fullscreen = FULLSCREEN_NONE;
309 #endif
311 root_window = make_window ();
312 if (mini_p)
314 mini_window = make_window ();
315 wset_next (XWINDOW (root_window), mini_window);
316 wset_prev (XWINDOW (mini_window), root_window);
317 XWINDOW (mini_window)->mini = 1;
318 wset_frame (XWINDOW (mini_window), frame);
319 fset_minibuffer_window (f, mini_window);
321 else
323 mini_window = Qnil;
324 wset_next (XWINDOW (root_window), Qnil);
325 fset_minibuffer_window (f, Qnil);
328 wset_frame (XWINDOW (root_window), frame);
330 /* 10 is arbitrary,
331 just so that there is "something there."
332 Correct size will be set up later with change_frame_size. */
334 SET_FRAME_COLS (f, 10);
335 FRAME_LINES (f) = 10;
337 wset_total_cols (XWINDOW (root_window), make_number (10));
338 wset_total_lines (XWINDOW (root_window), make_number (mini_p ? 9 : 10));
340 if (mini_p)
342 wset_total_cols (XWINDOW (mini_window), make_number (10));
343 wset_top_line (XWINDOW (mini_window), make_number (9));
344 wset_total_lines (XWINDOW (mini_window), make_number (1));
347 /* Choose a buffer for the frame's root window. */
349 Lisp_Object buf = Fcurrent_buffer ();
351 /* If current buffer is hidden, try to find another one. */
352 if (BUFFER_HIDDEN_P (XBUFFER (buf)))
353 buf = other_buffer_safely (buf);
355 /* Use set_window_buffer, not Fset_window_buffer, and don't let
356 hooks be run by it. The reason is that the whole frame/window
357 arrangement is not yet fully initialized at this point. Windows
358 don't have the right size, glyph matrices aren't initialized
359 etc. Running Lisp functions at this point surely ends in a
360 SEGV. */
361 set_window_buffer (root_window, buf, 0, 0);
362 fset_buffer_list (f, Fcons (buf, Qnil));
365 if (mini_p)
366 set_window_buffer (mini_window,
367 (NILP (Vminibuffer_list)
368 ? get_minibuffer (0)
369 : Fcar (Vminibuffer_list)),
370 0, 0);
372 fset_root_window (f, root_window);
373 fset_selected_window (f, root_window);
374 /* Make sure this window seems more recently used than
375 a newly-created, never-selected window. */
376 XWINDOW (f->selected_window)->use_time = ++window_select_count;
378 return f;
381 #ifdef HAVE_WINDOW_SYSTEM
382 /* Make a frame using a separate minibuffer window on another frame.
383 MINI_WINDOW is the minibuffer window to use. nil means use the
384 default (the global minibuffer). */
386 struct frame *
387 make_frame_without_minibuffer (register Lisp_Object mini_window, KBOARD *kb, Lisp_Object display)
389 register struct frame *f;
390 struct gcpro gcpro1;
392 if (!NILP (mini_window))
393 CHECK_LIVE_WINDOW (mini_window);
395 if (!NILP (mini_window)
396 && FRAME_KBOARD (XFRAME (XWINDOW (mini_window)->frame)) != kb)
397 error ("Frame and minibuffer must be on the same terminal");
399 /* Make a frame containing just a root window. */
400 f = make_frame (0);
402 if (NILP (mini_window))
404 /* Use default-minibuffer-frame if possible. */
405 if (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
406 || ! FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))
408 Lisp_Object frame_dummy;
410 XSETFRAME (frame_dummy, f);
411 GCPRO1 (frame_dummy);
412 /* If there's no minibuffer frame to use, create one. */
413 kset_default_minibuffer_frame
414 (kb, call1 (intern ("make-initial-minibuffer-frame"), display));
415 UNGCPRO;
418 mini_window
419 = XFRAME (KVAR (kb, Vdefault_minibuffer_frame))->minibuffer_window;
422 fset_minibuffer_window (f, mini_window);
424 /* Make the chosen minibuffer window display the proper minibuffer,
425 unless it is already showing a minibuffer. */
426 if (NILP (Fmemq (XWINDOW (mini_window)->buffer, Vminibuffer_list)))
427 /* Use set_window_buffer instead of Fset_window_buffer (see
428 discussion of bug#11984, bug#12025, bug#12026). */
429 set_window_buffer (mini_window,
430 (NILP (Vminibuffer_list)
431 ? get_minibuffer (0)
432 : Fcar (Vminibuffer_list)), 0, 0);
433 return f;
436 /* Make a frame containing only a minibuffer window. */
438 struct frame *
439 make_minibuffer_frame (void)
441 /* First make a frame containing just a root window, no minibuffer. */
443 register struct frame *f = make_frame (0);
444 register Lisp_Object mini_window;
445 register Lisp_Object frame;
447 XSETFRAME (frame, f);
449 f->auto_raise = 0;
450 f->auto_lower = 0;
451 f->no_split = 1;
452 f->wants_modeline = 0;
453 f->has_minibuffer = 1;
455 /* Now label the root window as also being the minibuffer.
456 Avoid infinite looping on the window chain by marking next pointer
457 as nil. */
459 mini_window = f->root_window;
460 fset_minibuffer_window (f, mini_window);
461 XWINDOW (mini_window)->mini = 1;
462 wset_next (XWINDOW (mini_window), Qnil);
463 wset_prev (XWINDOW (mini_window), Qnil);
464 wset_frame (XWINDOW (mini_window), frame);
466 /* Put the proper buffer in that window. */
468 /* Use set_window_buffer instead of Fset_window_buffer (see
469 discussion of bug#11984, bug#12025, bug#12026). */
470 set_window_buffer (mini_window,
471 (NILP (Vminibuffer_list)
472 ? get_minibuffer (0)
473 : Fcar (Vminibuffer_list)), 0, 0);
474 return f;
476 #endif /* HAVE_WINDOW_SYSTEM */
478 /* Construct a frame that refers to a terminal. */
480 static printmax_t tty_frame_count;
482 struct frame *
483 make_initial_frame (void)
485 struct frame *f;
486 struct terminal *terminal;
487 Lisp_Object frame;
489 eassert (initial_kboard);
491 /* The first call must initialize Vframe_list. */
492 if (! (NILP (Vframe_list) || CONSP (Vframe_list)))
493 Vframe_list = Qnil;
495 terminal = init_initial_terminal ();
497 f = make_frame (1);
498 XSETFRAME (frame, f);
500 Vframe_list = Fcons (frame, Vframe_list);
502 tty_frame_count = 1;
503 fset_name (f, build_pure_c_string ("F1"));
505 f->visible = 1;
506 f->async_visible = 1;
508 f->output_method = terminal->type;
509 f->terminal = terminal;
510 f->terminal->reference_count++;
511 f->output_data.nothing = 0;
513 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
514 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
516 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
518 /* The default value of menu-bar-mode is t. */
519 set_menu_bar_lines (f, make_number (1), Qnil);
521 if (!noninteractive)
522 init_frame_faces (f);
524 return f;
528 static struct frame *
529 make_terminal_frame (struct terminal *terminal)
531 register struct frame *f;
532 Lisp_Object frame;
533 char name[sizeof "F" + INT_STRLEN_BOUND (printmax_t)];
535 if (!terminal->name)
536 error ("Terminal is not live, can't create new frames on it");
538 f = make_frame (1);
540 XSETFRAME (frame, f);
541 Vframe_list = Fcons (frame, Vframe_list);
543 fset_name (f, make_formatted_string (name, "F%"pMd, ++tty_frame_count));
545 f->visible = 1; /* FRAME_SET_VISIBLE wd set frame_garbaged. */
546 f->async_visible = 1; /* Don't let visible be cleared later. */
547 f->terminal = terminal;
548 f->terminal->reference_count++;
549 #ifdef MSDOS
550 f->output_data.tty->display_info = &the_only_display_info;
551 if (!inhibit_window_system
552 && (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame))
553 || XFRAME (selected_frame)->output_method == output_msdos_raw))
554 f->output_method = output_msdos_raw;
555 else
556 f->output_method = output_termcap;
557 #else /* not MSDOS */
558 f->output_method = output_termcap;
559 create_tty_output (f);
560 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
561 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
562 #endif /* not MSDOS */
564 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
565 FRAME_MENU_BAR_LINES(f) = NILP (Vmenu_bar_mode) ? 0 : 1;
567 /* Set the top frame to the newly created frame. */
568 if (FRAMEP (FRAME_TTY (f)->top_frame)
569 && FRAME_LIVE_P (XFRAME (FRAME_TTY (f)->top_frame)))
570 XFRAME (FRAME_TTY (f)->top_frame)->async_visible = 2; /* obscured */
572 FRAME_TTY (f)->top_frame = frame;
574 if (!noninteractive)
575 init_frame_faces (f);
577 return f;
580 /* Get a suitable value for frame parameter PARAMETER for a newly
581 created frame, based on (1) the user-supplied frame parameter
582 alist SUPPLIED_PARMS, and (2) CURRENT_VALUE. */
584 static Lisp_Object
585 get_future_frame_param (Lisp_Object parameter,
586 Lisp_Object supplied_parms,
587 char *current_value)
589 Lisp_Object result;
591 result = Fassq (parameter, supplied_parms);
592 if (NILP (result))
593 result = Fassq (parameter, XFRAME (selected_frame)->param_alist);
594 if (NILP (result) && current_value != NULL)
595 result = build_string (current_value);
596 if (!NILP (result) && !STRINGP (result))
597 result = XCDR (result);
598 if (NILP (result) || !STRINGP (result))
599 result = Qnil;
601 return result;
604 DEFUN ("make-terminal-frame", Fmake_terminal_frame, Smake_terminal_frame,
605 1, 1, 0,
606 doc: /* Create an additional terminal frame, possibly on another terminal.
607 This function takes one argument, an alist specifying frame parameters.
609 You can create multiple frames on a single text terminal, but only one
610 of them (the selected terminal frame) is actually displayed.
612 In practice, generally you don't need to specify any parameters,
613 except when you want to create a new frame on another terminal.
614 In that case, the `tty' parameter specifies the device file to open,
615 and the `tty-type' parameter specifies the terminal type. Example:
617 (make-terminal-frame '((tty . "/dev/pts/5") (tty-type . "xterm")))
619 Note that changing the size of one terminal frame automatically
620 affects all frames on the same terminal device. */)
621 (Lisp_Object parms)
623 struct frame *f;
624 struct terminal *t = NULL;
625 Lisp_Object frame, tem;
626 struct frame *sf = SELECTED_FRAME ();
628 #ifdef MSDOS
629 if (sf->output_method != output_msdos_raw
630 && sf->output_method != output_termcap)
631 emacs_abort ();
632 #else /* not MSDOS */
634 #ifdef WINDOWSNT /* This should work now! */
635 if (sf->output_method != output_termcap)
636 error ("Not using an ASCII terminal now; cannot make a new ASCII frame");
637 #endif
638 #endif /* not MSDOS */
641 Lisp_Object terminal;
643 terminal = Fassq (Qterminal, parms);
644 if (CONSP (terminal))
646 terminal = XCDR (terminal);
647 t = get_terminal (terminal, 1);
649 #ifdef MSDOS
650 if (t && t != the_only_display_info.terminal)
651 /* msdos.c assumes a single tty_display_info object. */
652 error ("Multiple terminals are not supported on this platform");
653 if (!t)
654 t = the_only_display_info.terminal;
655 #endif
658 if (!t)
660 char *name = 0, *type = 0;
661 Lisp_Object tty, tty_type;
663 tty = get_future_frame_param
664 (Qtty, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
665 ? FRAME_TTY (XFRAME (selected_frame))->name
666 : NULL));
667 if (!NILP (tty))
669 name = alloca (SBYTES (tty) + 1);
670 memcpy (name, SSDATA (tty), SBYTES (tty));
671 name[SBYTES (tty)] = 0;
674 tty_type = get_future_frame_param
675 (Qtty_type, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
676 ? FRAME_TTY (XFRAME (selected_frame))->type
677 : NULL));
678 if (!NILP (tty_type))
680 type = alloca (SBYTES (tty_type) + 1);
681 memcpy (type, SSDATA (tty_type), SBYTES (tty_type));
682 type[SBYTES (tty_type)] = 0;
685 t = init_tty (name, type, 0); /* Errors are not fatal. */
688 f = make_terminal_frame (t);
691 int width, height;
692 get_tty_size (fileno (FRAME_TTY (f)->input), &width, &height);
693 change_frame_size (f, height, width, 0, 0, 0);
696 adjust_glyphs (f);
697 calculate_costs (f);
698 XSETFRAME (frame, f);
699 Fmodify_frame_parameters (frame, parms);
700 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty_type,
701 build_string (t->display_info.tty->type)),
702 Qnil));
703 if (t->display_info.tty->name != NULL)
704 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty,
705 build_string (t->display_info.tty->name)),
706 Qnil));
707 else
708 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty, Qnil), Qnil));
710 /* Make the frame face alist be frame-specific, so that each
711 frame could change its face definitions independently. */
712 fset_face_alist (f, Fcopy_alist (sf->face_alist));
713 /* Simple Fcopy_alist isn't enough, because we need the contents of
714 the vectors which are the CDRs of associations in face_alist to
715 be copied as well. */
716 for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem))
717 XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem))));
718 return frame;
722 /* Perform the switch to frame FRAME.
724 If FRAME is a switch-frame event `(switch-frame FRAME1)', use
725 FRAME1 as frame.
727 If TRACK is non-zero and the frame that currently has the focus
728 redirects its focus to the selected frame, redirect that focused
729 frame's focus to FRAME instead.
731 FOR_DELETION non-zero means that the selected frame is being
732 deleted, which includes the possibility that the frame's terminal
733 is dead.
735 The value of NORECORD is passed as argument to Fselect_window. */
737 Lisp_Object
738 do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object norecord)
740 struct frame *sf = SELECTED_FRAME ();
742 /* If FRAME is a switch-frame event, extract the frame we should
743 switch to. */
744 if (CONSP (frame)
745 && EQ (XCAR (frame), Qswitch_frame)
746 && CONSP (XCDR (frame)))
747 frame = XCAR (XCDR (frame));
749 /* This used to say CHECK_LIVE_FRAME, but apparently it's possible for
750 a switch-frame event to arrive after a frame is no longer live,
751 especially when deleting the initial frame during startup. */
752 CHECK_FRAME (frame);
753 if (! FRAME_LIVE_P (XFRAME (frame)))
754 return Qnil;
756 if (sf == XFRAME (frame))
757 return frame;
759 /* This is too greedy; it causes inappropriate focus redirection
760 that's hard to get rid of. */
761 #if 0
762 /* If a frame's focus has been redirected toward the currently
763 selected frame, we should change the redirection to point to the
764 newly selected frame. This means that if the focus is redirected
765 from a minibufferless frame to a surrogate minibuffer frame, we
766 can use `other-window' to switch between all the frames using
767 that minibuffer frame, and the focus redirection will follow us
768 around. */
769 if (track)
771 Lisp_Object tail;
773 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
775 Lisp_Object focus;
777 if (!FRAMEP (XCAR (tail)))
778 emacs_abort ();
780 focus = FRAME_FOCUS_FRAME (XFRAME (XCAR (tail)));
782 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
783 Fredirect_frame_focus (XCAR (tail), frame);
786 #else /* ! 0 */
787 /* Instead, apply it only to the frame we're pointing to. */
788 #ifdef HAVE_WINDOW_SYSTEM
789 if (track && FRAME_WINDOW_P (XFRAME (frame)))
791 Lisp_Object focus, xfocus;
793 xfocus = x_get_focus_frame (XFRAME (frame));
794 if (FRAMEP (xfocus))
796 focus = FRAME_FOCUS_FRAME (XFRAME (xfocus));
797 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
798 Fredirect_frame_focus (xfocus, frame);
801 #endif /* HAVE_X_WINDOWS */
802 #endif /* ! 0 */
804 if (!for_deletion && FRAME_HAS_MINIBUF_P (sf))
805 resize_mini_window (XWINDOW (FRAME_MINIBUF_WINDOW (sf)), 1);
807 if (FRAME_TERMCAP_P (XFRAME (frame)) || FRAME_MSDOS_P (XFRAME (frame)))
809 if (FRAMEP (FRAME_TTY (XFRAME (frame))->top_frame))
810 /* Mark previously displayed frame as now obscured. */
811 XFRAME (FRAME_TTY (XFRAME (frame))->top_frame)->async_visible = 2;
812 XFRAME (frame)->async_visible = 1;
813 FRAME_TTY (XFRAME (frame))->top_frame = frame;
816 selected_frame = frame;
817 if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
818 last_nonminibuf_frame = XFRAME (selected_frame);
820 Fselect_window (XFRAME (frame)->selected_window, norecord);
822 /* We want to make sure that the next event generates a frame-switch
823 event to the appropriate frame. This seems kludgy to me, but
824 before you take it out, make sure that evaluating something like
825 (select-window (frame-root-window (new-frame))) doesn't end up
826 with your typing being interpreted in the new frame instead of
827 the one you're actually typing in. */
828 internal_last_event_frame = Qnil;
830 return frame;
833 DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 2, "e",
834 doc: /* Select FRAME.
835 Subsequent editing commands apply to its selected window.
836 Optional argument NORECORD means to neither change the order of
837 recently selected windows nor the buffer list.
839 The selection of FRAME lasts until the next time the user does
840 something to select a different frame, or until the next time
841 this function is called. If you are using a window system, the
842 previously selected frame may be restored as the selected frame
843 when returning to the command loop, because it still may have
844 the window system's input focus. On a text terminal, the next
845 redisplay will display FRAME.
847 This function returns FRAME, or nil if FRAME has been deleted. */)
848 (Lisp_Object frame, Lisp_Object norecord)
850 return do_switch_frame (frame, 1, 0, norecord);
854 DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 1, "e",
855 doc: /* Handle a switch-frame event EVENT.
856 Switch-frame events are usually bound to this function.
857 A switch-frame event tells Emacs that the window manager has requested
858 that the user's events be directed to the frame mentioned in the event.
859 This function selects the selected window of the frame of EVENT.
861 If EVENT is frame object, handle it as if it were a switch-frame event
862 to that frame. */)
863 (Lisp_Object event)
865 /* Preserve prefix arg that the command loop just cleared. */
866 kset_prefix_arg (current_kboard, Vcurrent_prefix_arg);
867 Frun_hooks (1, &Qmouse_leave_buffer_hook);
868 return do_switch_frame (event, 0, 0, Qnil);
871 DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0,
872 doc: /* Return the frame that is now selected. */)
873 (void)
875 return selected_frame;
878 DEFUN ("frame-list", Fframe_list, Sframe_list,
879 0, 0, 0,
880 doc: /* Return a list of all live frames. */)
881 (void)
883 Lisp_Object frames;
884 frames = Fcopy_sequence (Vframe_list);
885 #ifdef HAVE_WINDOW_SYSTEM
886 if (FRAMEP (tip_frame))
887 frames = Fdelq (tip_frame, frames);
888 #endif
889 return frames;
892 /* Return CANDIDATE if it can be used as 'other-than-FRAME' frame on the
893 same tty (for tty frames) or among frames which uses FRAME's keyboard.
894 If MINIBUF is nil, do not consider minibuffer-only candidate.
895 If MINIBUF is `visible', do not consider an invisible candidate.
896 If MINIBUF is a window, consider only its own frame and candidate now
897 using that window as the minibuffer.
898 If MINIBUF is 0, consider candidate if it is visible or iconified.
899 Otherwise consider any candidate and return nil if CANDIDATE is not
900 acceptable. */
902 static Lisp_Object
903 candidate_frame (Lisp_Object candidate, Lisp_Object frame, Lisp_Object minibuf)
905 struct frame *c = XFRAME (candidate), *f = XFRAME (frame);
907 if ((!FRAME_TERMCAP_P (c) && !FRAME_TERMCAP_P (f)
908 && FRAME_KBOARD (c) == FRAME_KBOARD (f))
909 || (FRAME_TERMCAP_P (c) && FRAME_TERMCAP_P (f)
910 && FRAME_TTY (c) == FRAME_TTY (f)))
912 if (NILP (minibuf))
914 if (!FRAME_MINIBUF_ONLY_P (c))
915 return candidate;
917 else if (EQ (minibuf, Qvisible))
919 FRAME_SAMPLE_VISIBILITY (c);
920 if (FRAME_VISIBLE_P (c))
921 return candidate;
923 else if (WINDOWP (minibuf))
925 if (EQ (FRAME_MINIBUF_WINDOW (c), minibuf)
926 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), candidate)
927 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
928 FRAME_FOCUS_FRAME (c)))
929 return candidate;
931 else if (XFASTINT (minibuf) == 0)
933 FRAME_SAMPLE_VISIBILITY (c);
934 if (FRAME_VISIBLE_P (c) || FRAME_ICONIFIED_P (c))
935 return candidate;
937 else
938 return candidate;
940 return Qnil;
943 /* Return the next frame in the frame list after FRAME. */
945 static Lisp_Object
946 next_frame (Lisp_Object frame, Lisp_Object minibuf)
948 Lisp_Object f, tail;
949 int passed = 0;
951 /* There must always be at least one frame in Vframe_list. */
952 eassert (CONSP (Vframe_list));
954 while (passed < 2)
955 FOR_EACH_FRAME (tail, f)
957 if (passed)
959 f = candidate_frame (f, frame, minibuf);
960 if (!NILP (f))
961 return f;
963 if (EQ (frame, f))
964 passed++;
966 return frame;
969 /* Return the previous frame in the frame list before FRAME. */
971 static Lisp_Object
972 prev_frame (Lisp_Object frame, Lisp_Object minibuf)
974 Lisp_Object f, tail, prev = Qnil;
976 /* There must always be at least one frame in Vframe_list. */
977 eassert (CONSP (Vframe_list));
979 FOR_EACH_FRAME (tail, f)
981 if (EQ (frame, f) && !NILP (prev))
982 return prev;
983 f = candidate_frame (f, frame, minibuf);
984 if (!NILP (f))
985 prev = f;
988 /* We've scanned the entire list. */
989 if (NILP (prev))
990 /* We went through the whole frame list without finding a single
991 acceptable frame. Return the original frame. */
992 return frame;
993 else
994 /* There were no acceptable frames in the list before FRAME; otherwise,
995 we would have returned directly from the loop. Since PREV is the last
996 acceptable frame in the list, return it. */
997 return prev;
1001 DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0,
1002 doc: /* Return the next frame in the frame list after FRAME.
1003 It considers only frames on the same terminal as FRAME.
1004 By default, skip minibuffer-only frames.
1005 If omitted, FRAME defaults to the selected frame.
1006 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1007 If MINIFRAME is a window, include only its own frame
1008 and any frame now using that window as the minibuffer.
1009 If MINIFRAME is `visible', include all visible frames.
1010 If MINIFRAME is 0, include all visible and iconified frames.
1011 Otherwise, include all frames. */)
1012 (Lisp_Object frame, Lisp_Object miniframe)
1014 if (NILP (frame))
1015 frame = selected_frame;
1016 CHECK_LIVE_FRAME (frame);
1017 return next_frame (frame, miniframe);
1020 DEFUN ("previous-frame", Fprevious_frame, Sprevious_frame, 0, 2, 0,
1021 doc: /* Return the previous frame in the frame list before FRAME.
1022 It considers only frames on the same terminal as FRAME.
1023 By default, skip minibuffer-only frames.
1024 If omitted, FRAME defaults to the selected frame.
1025 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1026 If MINIFRAME is a window, include only its own frame
1027 and any frame now using that window as the minibuffer.
1028 If MINIFRAME is `visible', include all visible frames.
1029 If MINIFRAME is 0, include all visible and iconified frames.
1030 Otherwise, include all frames. */)
1031 (Lisp_Object frame, Lisp_Object miniframe)
1033 if (NILP (frame))
1034 frame = selected_frame;
1035 CHECK_LIVE_FRAME (frame);
1036 return prev_frame (frame, miniframe);
1039 /* Return 1 if it is ok to delete frame F;
1040 0 if all frames aside from F are invisible.
1041 (Exception: if F is the terminal frame, and we are using X, return 1.) */
1043 static int
1044 other_visible_frames (FRAME_PTR f)
1046 Lisp_Object frames, this;
1048 FOR_EACH_FRAME (frames, this)
1050 if (f == XFRAME (this))
1051 continue;
1053 /* Verify that we can still talk to the frame's X window,
1054 and note any recent change in visibility. */
1055 #ifdef HAVE_WINDOW_SYSTEM
1056 if (FRAME_WINDOW_P (XFRAME (this)))
1058 x_sync (XFRAME (this));
1059 FRAME_SAMPLE_VISIBILITY (XFRAME (this));
1061 #endif
1063 if (FRAME_VISIBLE_P (XFRAME (this))
1064 || FRAME_ICONIFIED_P (XFRAME (this))
1065 /* Allow deleting the terminal frame when at least one X
1066 frame exists. */
1067 || (FRAME_WINDOW_P (XFRAME (this)) && !FRAME_WINDOW_P (f)))
1068 return 1;
1070 return 0;
1073 /* Delete FRAME. When FORCE equals Qnoelisp, delete FRAME
1074 unconditionally. x_connection_closed and delete_terminal use
1075 this. Any other value of FORCE implements the semantics
1076 described for Fdelete_frame. */
1077 Lisp_Object
1078 delete_frame (Lisp_Object frame, Lisp_Object force)
1080 struct frame *f = decode_any_frame (frame);
1081 struct frame *sf = SELECTED_FRAME ();
1082 struct kboard *kb;
1084 int minibuffer_selected, is_tooltip_frame;
1086 if (! FRAME_LIVE_P (f))
1087 return Qnil;
1089 if (NILP (force) && !other_visible_frames (f))
1090 error ("Attempt to delete the sole visible or iconified frame");
1092 /* x_connection_closed must have set FORCE to `noelisp' in order
1093 to delete the last frame, if it is gone. */
1094 if (NILP (XCDR (Vframe_list)) && !EQ (force, Qnoelisp))
1095 error ("Attempt to delete the only frame");
1097 XSETFRAME (frame, f);
1099 /* Does this frame have a minibuffer, and is it the surrogate
1100 minibuffer for any other frame? */
1101 if (FRAME_HAS_MINIBUF_P (f))
1103 Lisp_Object frames, this;
1105 FOR_EACH_FRAME (frames, this)
1107 if (! EQ (this, frame)
1108 && EQ (frame,
1109 WINDOW_FRAME (XWINDOW
1110 (FRAME_MINIBUF_WINDOW (XFRAME (this))))))
1112 /* If we MUST delete this frame, delete the other first.
1113 But do this only if FORCE equals `noelisp'. */
1114 if (EQ (force, Qnoelisp))
1115 delete_frame (this, Qnoelisp);
1116 else
1117 error ("Attempt to delete a surrogate minibuffer frame");
1122 is_tooltip_frame = !NILP (Fframe_parameter (frame, intern ("tooltip")));
1124 /* Run `delete-frame-functions' unless FORCE is `noelisp' or
1125 frame is a tooltip. FORCE is set to `noelisp' when handling
1126 a disconnect from the terminal, so we don't dare call Lisp
1127 code. */
1128 if (NILP (Vrun_hooks) || is_tooltip_frame)
1130 else if (EQ (force, Qnoelisp))
1131 pending_funcalls
1132 = Fcons (list3 (Qrun_hook_with_args, Qdelete_frame_functions, frame),
1133 pending_funcalls);
1134 else
1136 #ifdef HAVE_X_WINDOWS
1137 /* Also, save clipboard to the clipboard manager. */
1138 x_clipboard_manager_save_frame (frame);
1139 #endif
1141 safe_call2 (Qrun_hook_with_args, Qdelete_frame_functions, frame);
1144 /* The hook may sometimes (indirectly) cause the frame to be deleted. */
1145 if (! FRAME_LIVE_P (f))
1146 return Qnil;
1148 /* At this point, we are committed to deleting the frame.
1149 There is no more chance for errors to prevent it. */
1151 minibuffer_selected = EQ (minibuf_window, selected_window);
1153 /* Don't let the frame remain selected. */
1154 if (f == sf)
1156 Lisp_Object tail, frame1;
1158 /* Look for another visible frame on the same terminal. */
1159 frame1 = next_frame (frame, Qvisible);
1161 /* If there is none, find *some* other frame. */
1162 if (NILP (frame1) || EQ (frame1, frame))
1164 FOR_EACH_FRAME (tail, frame1)
1166 if (! EQ (frame, frame1) && FRAME_LIVE_P (XFRAME (frame1)))
1168 /* Do not change a text terminal's top-frame. */
1169 struct frame *f1 = XFRAME (frame1);
1170 if (FRAME_TERMCAP_P (f1) || FRAME_MSDOS_P (f1))
1172 Lisp_Object top_frame = FRAME_TTY (f1)->top_frame;
1173 if (!EQ (top_frame, frame))
1174 frame1 = top_frame;
1176 break;
1180 #ifdef NS_IMPL_COCOA
1181 else
1182 /* Under NS, there is no system mechanism for choosing a new
1183 window to get focus -- it is left to application code.
1184 So the portion of THIS application interfacing with NS
1185 needs to know about it. We call Fraise_frame, but the
1186 purpose is really to transfer focus. */
1187 Fraise_frame (frame1);
1188 #endif
1190 do_switch_frame (frame1, 0, 1, Qnil);
1191 sf = SELECTED_FRAME ();
1194 /* Don't allow minibuf_window to remain on a deleted frame. */
1195 if (EQ (f->minibuffer_window, minibuf_window))
1197 /* Use set_window_buffer instead of Fset_window_buffer (see
1198 discussion of bug#11984, bug#12025, bug#12026). */
1199 set_window_buffer (sf->minibuffer_window,
1200 XWINDOW (minibuf_window)->buffer, 0, 0);
1201 minibuf_window = sf->minibuffer_window;
1203 /* If the dying minibuffer window was selected,
1204 select the new one. */
1205 if (minibuffer_selected)
1206 Fselect_window (minibuf_window, Qnil);
1209 /* Don't let echo_area_window to remain on a deleted frame. */
1210 if (EQ (f->minibuffer_window, echo_area_window))
1211 echo_area_window = sf->minibuffer_window;
1213 /* Clear any X selections for this frame. */
1214 #ifdef HAVE_X_WINDOWS
1215 if (FRAME_X_P (f))
1216 x_clear_frame_selections (f);
1217 #endif
1219 /* Free glyphs.
1220 This function must be called before the window tree of the
1221 frame is deleted because windows contain dynamically allocated
1222 memory. */
1223 free_glyphs (f);
1225 #ifdef HAVE_WINDOW_SYSTEM
1226 /* Give chance to each font driver to free a frame specific data. */
1227 font_update_drivers (f, Qnil);
1228 #endif
1230 /* Mark all the windows that used to be on FRAME as deleted, and then
1231 remove the reference to them. */
1232 delete_all_child_windows (f->root_window);
1233 fset_root_window (f, Qnil);
1235 Vframe_list = Fdelq (frame, Vframe_list);
1236 FRAME_SET_VISIBLE (f, 0);
1238 /* Allow the vector of menu bar contents to be freed in the next
1239 garbage collection. The frame object itself may not be garbage
1240 collected until much later, because recent_keys and other data
1241 structures can still refer to it. */
1242 fset_menu_bar_vector (f, Qnil);
1244 /* If FRAME's buffer lists contains killed
1245 buffers, this helps GC to reclaim them. */
1246 fset_buffer_list (f, Qnil);
1247 fset_buried_buffer_list (f, Qnil);
1249 free_font_driver_list (f);
1250 xfree (f->namebuf);
1251 xfree (f->decode_mode_spec_buffer);
1252 xfree (FRAME_INSERT_COST (f));
1253 xfree (FRAME_DELETEN_COST (f));
1254 xfree (FRAME_INSERTN_COST (f));
1255 xfree (FRAME_DELETE_COST (f));
1256 xfree (FRAME_MESSAGE_BUF (f));
1258 /* Since some events are handled at the interrupt level, we may get
1259 an event for f at any time; if we zero out the frame's terminal
1260 now, then we may trip up the event-handling code. Instead, we'll
1261 promise that the terminal of the frame must be valid until we
1262 have called the window-system-dependent frame destruction
1263 routine. */
1265 if (FRAME_TERMINAL (f)->delete_frame_hook)
1266 (*FRAME_TERMINAL (f)->delete_frame_hook) (f);
1269 struct terminal *terminal = FRAME_TERMINAL (f);
1270 f->output_data.nothing = 0;
1271 f->terminal = 0; /* Now the frame is dead. */
1273 /* If needed, delete the terminal that this frame was on.
1274 (This must be done after the frame is killed.) */
1275 terminal->reference_count--;
1276 #ifdef USE_GTK
1277 /* FIXME: Deleting the terminal crashes emacs because of a GTK
1278 bug.
1279 http://lists.gnu.org/archive/html/emacs-devel/2011-10/msg00363.html */
1280 if (terminal->reference_count == 0 && terminal->type == output_x_window)
1281 terminal->reference_count = 1;
1282 #endif /* USE_GTK */
1283 if (terminal->reference_count == 0)
1285 Lisp_Object tmp;
1286 XSETTERMINAL (tmp, terminal);
1288 kb = NULL;
1289 Fdelete_terminal (tmp, NILP (force) ? Qt : force);
1291 else
1292 kb = terminal->kboard;
1295 /* If we've deleted the last_nonminibuf_frame, then try to find
1296 another one. */
1297 if (f == last_nonminibuf_frame)
1299 Lisp_Object frames, this;
1301 last_nonminibuf_frame = 0;
1303 FOR_EACH_FRAME (frames, this)
1305 f = XFRAME (this);
1306 if (!FRAME_MINIBUF_ONLY_P (f))
1308 last_nonminibuf_frame = f;
1309 break;
1314 /* If there's no other frame on the same kboard, get out of
1315 single-kboard state if we're in it for this kboard. */
1316 if (kb != NULL)
1318 Lisp_Object frames, this;
1319 /* Some frame we found on the same kboard, or nil if there are none. */
1320 Lisp_Object frame_on_same_kboard = Qnil;
1322 FOR_EACH_FRAME (frames, this)
1323 if (kb == FRAME_KBOARD (XFRAME (this)))
1324 frame_on_same_kboard = this;
1326 if (NILP (frame_on_same_kboard))
1327 not_single_kboard_state (kb);
1331 /* If we've deleted this keyboard's default_minibuffer_frame, try to
1332 find another one. Prefer minibuffer-only frames, but also notice
1333 frames with other windows. */
1334 if (kb != NULL && EQ (frame, KVAR (kb, Vdefault_minibuffer_frame)))
1336 Lisp_Object frames, this;
1338 /* The last frame we saw with a minibuffer, minibuffer-only or not. */
1339 Lisp_Object frame_with_minibuf = Qnil;
1340 /* Some frame we found on the same kboard, or nil if there are none. */
1341 Lisp_Object frame_on_same_kboard = Qnil;
1343 FOR_EACH_FRAME (frames, this)
1345 struct frame *f1 = XFRAME (this);
1347 /* Consider only frames on the same kboard
1348 and only those with minibuffers. */
1349 if (kb == FRAME_KBOARD (f1)
1350 && FRAME_HAS_MINIBUF_P (f1))
1352 frame_with_minibuf = this;
1353 if (FRAME_MINIBUF_ONLY_P (f1))
1354 break;
1357 if (kb == FRAME_KBOARD (f1))
1358 frame_on_same_kboard = this;
1361 if (!NILP (frame_on_same_kboard))
1363 /* We know that there must be some frame with a minibuffer out
1364 there. If this were not true, all of the frames present
1365 would have to be minibufferless, which implies that at some
1366 point their minibuffer frames must have been deleted, but
1367 that is prohibited at the top; you can't delete surrogate
1368 minibuffer frames. */
1369 if (NILP (frame_with_minibuf))
1370 emacs_abort ();
1372 kset_default_minibuffer_frame (kb, frame_with_minibuf);
1374 else
1375 /* No frames left on this kboard--say no minibuffer either. */
1376 kset_default_minibuffer_frame (kb, Qnil);
1379 /* Cause frame titles to update--necessary if we now have just one frame. */
1380 if (!is_tooltip_frame)
1381 update_mode_lines = 1;
1383 return Qnil;
1386 DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 2, "",
1387 doc: /* Delete FRAME, permanently eliminating it from use.
1388 FRAME defaults to the selected frame.
1390 A frame may not be deleted if its minibuffer is used by other frames.
1391 Normally, you may not delete a frame if all other frames are invisible,
1392 but if the second optional argument FORCE is non-nil, you may do so.
1394 This function runs `delete-frame-functions' before actually
1395 deleting the frame, unless the frame is a tooltip.
1396 The functions are run with one argument, the frame to be deleted. */)
1397 (Lisp_Object frame, Lisp_Object force)
1399 return delete_frame (frame, !NILP (force) ? Qt : Qnil);
1403 /* Return mouse position in character cell units. */
1405 DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0,
1406 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1407 The position is given in character cells, where (0, 0) is the
1408 upper-left corner of the frame, X is the horizontal offset, and Y is
1409 the vertical offset.
1410 If Emacs is running on a mouseless terminal or hasn't been programmed
1411 to read the mouse position, it returns the selected frame for FRAME
1412 and nil for X and Y.
1413 If `mouse-position-function' is non-nil, `mouse-position' calls it,
1414 passing the normal return value to that function as an argument,
1415 and returns whatever that function returns. */)
1416 (void)
1418 FRAME_PTR f;
1419 Lisp_Object lispy_dummy;
1420 Lisp_Object x, y, retval;
1421 struct gcpro gcpro1;
1423 f = SELECTED_FRAME ();
1424 x = y = Qnil;
1426 /* It's okay for the hook to refrain from storing anything. */
1427 if (FRAME_TERMINAL (f)->mouse_position_hook)
1429 enum scroll_bar_part party_dummy;
1430 Time time_dummy;
1431 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1432 &lispy_dummy, &party_dummy,
1433 &x, &y,
1434 &time_dummy);
1437 if (! NILP (x))
1439 int col = XINT (x);
1440 int row = XINT (y);
1441 pixel_to_glyph_coords (f, col, row, &col, &row, NULL, 1);
1442 XSETINT (x, col);
1443 XSETINT (y, row);
1445 XSETFRAME (lispy_dummy, f);
1446 retval = Fcons (lispy_dummy, Fcons (x, y));
1447 GCPRO1 (retval);
1448 if (!NILP (Vmouse_position_function))
1449 retval = call1 (Vmouse_position_function, retval);
1450 RETURN_UNGCPRO (retval);
1453 DEFUN ("mouse-pixel-position", Fmouse_pixel_position,
1454 Smouse_pixel_position, 0, 0, 0,
1455 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1456 The position is given in pixel units, where (0, 0) is the
1457 upper-left corner of the frame, X is the horizontal offset, and Y is
1458 the vertical offset.
1459 If Emacs is running on a mouseless terminal or hasn't been programmed
1460 to read the mouse position, it returns the selected frame for FRAME
1461 and nil for X and Y. */)
1462 (void)
1464 FRAME_PTR f;
1465 Lisp_Object lispy_dummy;
1466 Lisp_Object x, y;
1468 f = SELECTED_FRAME ();
1469 x = y = Qnil;
1471 /* It's okay for the hook to refrain from storing anything. */
1472 if (FRAME_TERMINAL (f)->mouse_position_hook)
1474 enum scroll_bar_part party_dummy;
1475 Time time_dummy;
1476 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1477 &lispy_dummy, &party_dummy,
1478 &x, &y,
1479 &time_dummy);
1482 XSETFRAME (lispy_dummy, f);
1483 return Fcons (lispy_dummy, Fcons (x, y));
1486 DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0,
1487 doc: /* Move the mouse pointer to the center of character cell (X,Y) in FRAME.
1488 Coordinates are relative to the frame, not a window,
1489 so the coordinates of the top left character in the frame
1490 may be nonzero due to left-hand scroll bars or the menu bar.
1492 The position is given in character cells, where (0, 0) is the
1493 upper-left corner of the frame, X is the horizontal offset, and Y is
1494 the vertical offset.
1496 This function is a no-op for an X frame that is not visible.
1497 If you have just created a frame, you must wait for it to become visible
1498 before calling this function on it, like this.
1499 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1500 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1502 CHECK_LIVE_FRAME (frame);
1503 CHECK_TYPE_RANGED_INTEGER (int, x);
1504 CHECK_TYPE_RANGED_INTEGER (int, y);
1506 /* I think this should be done with a hook. */
1507 #ifdef HAVE_WINDOW_SYSTEM
1508 if (FRAME_WINDOW_P (XFRAME (frame)))
1509 /* Warping the mouse will cause enternotify and focus events. */
1510 x_set_mouse_position (XFRAME (frame), XINT (x), XINT (y));
1511 #else
1512 #if defined (MSDOS)
1513 if (FRAME_MSDOS_P (XFRAME (frame)))
1515 Fselect_frame (frame, Qnil);
1516 mouse_moveto (XINT (x), XINT (y));
1518 #else
1519 #ifdef HAVE_GPM
1521 Fselect_frame (frame, Qnil);
1522 term_mouse_moveto (XINT (x), XINT (y));
1524 #endif
1525 #endif
1526 #endif
1528 return Qnil;
1531 DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position,
1532 Sset_mouse_pixel_position, 3, 3, 0,
1533 doc: /* Move the mouse pointer to pixel position (X,Y) in FRAME.
1534 The position is given in pixels, where (0, 0) is the upper-left corner
1535 of the frame, X is the horizontal offset, and Y is the vertical offset.
1537 Note, this is a no-op for an X frame that is not visible.
1538 If you have just created a frame, you must wait for it to become visible
1539 before calling this function on it, like this.
1540 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1541 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1543 CHECK_LIVE_FRAME (frame);
1544 CHECK_TYPE_RANGED_INTEGER (int, x);
1545 CHECK_TYPE_RANGED_INTEGER (int, y);
1547 /* I think this should be done with a hook. */
1548 #ifdef HAVE_WINDOW_SYSTEM
1549 if (FRAME_WINDOW_P (XFRAME (frame)))
1550 /* Warping the mouse will cause enternotify and focus events. */
1551 x_set_mouse_pixel_position (XFRAME (frame), XINT (x), XINT (y));
1552 #else
1553 #if defined (MSDOS)
1554 if (FRAME_MSDOS_P (XFRAME (frame)))
1556 Fselect_frame (frame, Qnil);
1557 mouse_moveto (XINT (x), XINT (y));
1559 #else
1560 #ifdef HAVE_GPM
1562 Fselect_frame (frame, Qnil);
1563 term_mouse_moveto (XINT (x), XINT (y));
1565 #endif
1566 #endif
1567 #endif
1569 return Qnil;
1572 static void make_frame_visible_1 (Lisp_Object);
1574 DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible,
1575 0, 1, "",
1576 doc: /* Make the frame FRAME visible (assuming it is an X window).
1577 If omitted, FRAME defaults to the currently selected frame. */)
1578 (Lisp_Object frame)
1580 struct frame *f = decode_live_frame (frame);
1582 /* I think this should be done with a hook. */
1583 #ifdef HAVE_WINDOW_SYSTEM
1584 if (FRAME_WINDOW_P (f))
1586 FRAME_SAMPLE_VISIBILITY (f);
1587 x_make_frame_visible (f);
1589 #endif
1591 make_frame_visible_1 (f->root_window);
1593 /* Make menu bar update for the Buffers and Frames menus. */
1594 windows_or_buffers_changed++;
1596 XSETFRAME (frame, f);
1597 return frame;
1600 /* Update the display_time slot of the buffers shown in WINDOW
1601 and all its descendants. */
1603 static void
1604 make_frame_visible_1 (Lisp_Object window)
1606 struct window *w;
1608 for (;!NILP (window); window = w->next)
1610 w = XWINDOW (window);
1612 if (!NILP (w->buffer))
1613 bset_display_time (XBUFFER (w->buffer), Fcurrent_time ());
1615 if (!NILP (w->vchild))
1616 make_frame_visible_1 (w->vchild);
1617 if (!NILP (w->hchild))
1618 make_frame_visible_1 (w->hchild);
1622 DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible,
1623 0, 2, "",
1624 doc: /* Make the frame FRAME invisible.
1625 If omitted, FRAME defaults to the currently selected frame.
1626 On graphical displays, invisible frames are not updated and are
1627 usually not displayed at all, even in a window system's \"taskbar\".
1629 Normally you may not make FRAME invisible if all other frames are invisible,
1630 but if the second optional argument FORCE is non-nil, you may do so.
1632 This function has no effect on text terminal frames. Such frames are
1633 always considered visible, whether or not they are currently being
1634 displayed in the terminal. */)
1635 (Lisp_Object frame, Lisp_Object force)
1637 struct frame *f = decode_live_frame (frame);
1639 if (NILP (force) && !other_visible_frames (f))
1640 error ("Attempt to make invisible the sole visible or iconified frame");
1642 /* Don't allow minibuf_window to remain on a deleted frame. */
1643 if (EQ (f->minibuffer_window, minibuf_window))
1645 struct frame *sf = XFRAME (selected_frame);
1646 /* Use set_window_buffer instead of Fset_window_buffer (see
1647 discussion of bug#11984, bug#12025, bug#12026). */
1648 set_window_buffer (sf->minibuffer_window,
1649 XWINDOW (minibuf_window)->buffer, 0, 0);
1650 minibuf_window = sf->minibuffer_window;
1653 /* I think this should be done with a hook. */
1654 #ifdef HAVE_WINDOW_SYSTEM
1655 if (FRAME_WINDOW_P (f))
1656 x_make_frame_invisible (f);
1657 #endif
1659 /* Make menu bar update for the Buffers and Frames menus. */
1660 windows_or_buffers_changed++;
1662 return Qnil;
1665 DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame,
1666 0, 1, "",
1667 doc: /* Make the frame FRAME into an icon.
1668 If omitted, FRAME defaults to the currently selected frame. */)
1669 (Lisp_Object frame)
1671 struct frame *f = decode_live_frame (frame);
1673 /* Don't allow minibuf_window to remain on an iconified frame. */
1674 if (EQ (f->minibuffer_window, minibuf_window))
1676 struct frame *sf = XFRAME (selected_frame);
1677 /* Use set_window_buffer instead of Fset_window_buffer (see
1678 discussion of bug#11984, bug#12025, bug#12026). */
1679 set_window_buffer (sf->minibuffer_window,
1680 XWINDOW (minibuf_window)->buffer, 0, 0);
1681 minibuf_window = sf->minibuffer_window;
1684 /* I think this should be done with a hook. */
1685 #ifdef HAVE_WINDOW_SYSTEM
1686 if (FRAME_WINDOW_P (f))
1687 x_iconify_frame (f);
1688 #endif
1690 /* Make menu bar update for the Buffers and Frames menus. */
1691 windows_or_buffers_changed++;
1693 return Qnil;
1696 DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p,
1697 1, 1, 0,
1698 doc: /* Return t if FRAME is \"visible\" (actually in use for display).
1699 Return the symbol `icon' if FRAME is iconified or \"minimized\".
1700 Return nil if FRAME was made invisible, via `make-frame-invisible'.
1701 On graphical displays, invisible frames are not updated and are
1702 usually not displayed at all, even in a window system's \"taskbar\".
1704 If FRAME is a text terminal frame, this always returns t.
1705 Such frames are always considered visible, whether or not they are
1706 currently being displayed on the terminal. */)
1707 (Lisp_Object frame)
1709 CHECK_LIVE_FRAME (frame);
1711 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1713 if (FRAME_VISIBLE_P (XFRAME (frame)))
1714 return Qt;
1715 if (FRAME_ICONIFIED_P (XFRAME (frame)))
1716 return Qicon;
1717 return Qnil;
1720 DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list,
1721 0, 0, 0,
1722 doc: /* Return a list of all frames now \"visible\" (being updated). */)
1723 (void)
1725 Lisp_Object tail, frame, value = Qnil;
1727 FOR_EACH_FRAME (tail, frame)
1728 if (FRAME_VISIBLE_P (XFRAME (frame)))
1729 value = Fcons (frame, value);
1731 return value;
1735 DEFUN ("raise-frame", Fraise_frame, Sraise_frame, 0, 1, "",
1736 doc: /* Bring FRAME to the front, so it occludes any frames it overlaps.
1737 If FRAME is invisible or iconified, make it visible.
1738 If you don't specify a frame, the selected frame is used.
1739 If Emacs is displaying on an ordinary terminal or some other device which
1740 doesn't support multiple overlapping frames, this function selects FRAME. */)
1741 (Lisp_Object frame)
1743 struct frame *f = decode_live_frame (frame);
1745 XSETFRAME (frame, f);
1747 if (FRAME_TERMCAP_P (f))
1748 /* On a text terminal select FRAME. */
1749 Fselect_frame (frame, Qnil);
1750 else
1751 /* Do like the documentation says. */
1752 Fmake_frame_visible (frame);
1754 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
1755 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 1);
1757 return Qnil;
1760 /* Should we have a corresponding function called Flower_Power? */
1761 DEFUN ("lower-frame", Flower_frame, Slower_frame, 0, 1, "",
1762 doc: /* Send FRAME to the back, so it is occluded by any frames that overlap it.
1763 If you don't specify a frame, the selected frame is used.
1764 If Emacs is displaying on an ordinary terminal or some other device which
1765 doesn't support multiple overlapping frames, this function does nothing. */)
1766 (Lisp_Object frame)
1768 struct frame *f = decode_live_frame (frame);
1770 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
1771 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 0);
1773 return Qnil;
1777 DEFUN ("redirect-frame-focus", Fredirect_frame_focus, Sredirect_frame_focus,
1778 1, 2, 0,
1779 doc: /* Arrange for keystrokes typed at FRAME to be sent to FOCUS-FRAME.
1780 In other words, switch-frame events caused by events in FRAME will
1781 request a switch to FOCUS-FRAME, and `last-event-frame' will be
1782 FOCUS-FRAME after reading an event typed at FRAME.
1784 If FOCUS-FRAME is nil, any existing redirection is canceled, and the
1785 frame again receives its own keystrokes.
1787 Focus redirection is useful for temporarily redirecting keystrokes to
1788 a surrogate minibuffer frame when a frame doesn't have its own
1789 minibuffer window.
1791 A frame's focus redirection can be changed by `select-frame'. If frame
1792 FOO is selected, and then a different frame BAR is selected, any
1793 frames redirecting their focus to FOO are shifted to redirect their
1794 focus to BAR. This allows focus redirection to work properly when the
1795 user switches from one frame to another using `select-window'.
1797 This means that a frame whose focus is redirected to itself is treated
1798 differently from a frame whose focus is redirected to nil; the former
1799 is affected by `select-frame', while the latter is not.
1801 The redirection lasts until `redirect-frame-focus' is called to change it. */)
1802 (Lisp_Object frame, Lisp_Object focus_frame)
1804 /* Note that we don't check for a live frame here. It's reasonable
1805 to redirect the focus of a frame you're about to delete, if you
1806 know what other frame should receive those keystrokes. */
1807 struct frame *f = decode_any_frame (frame);
1809 if (! NILP (focus_frame))
1810 CHECK_LIVE_FRAME (focus_frame);
1812 fset_focus_frame (f, focus_frame);
1814 if (FRAME_TERMINAL (f)->frame_rehighlight_hook)
1815 (*FRAME_TERMINAL (f)->frame_rehighlight_hook) (f);
1817 return Qnil;
1821 DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 0, 1, 0,
1822 doc: /* Return the frame to which FRAME's keystrokes are currently being sent.
1823 If FRAME is omitted or nil, the selected frame is used.
1824 Return nil if FRAME's focus is not redirected.
1825 See `redirect-frame-focus'. */)
1826 (Lisp_Object frame)
1828 return FRAME_FOCUS_FRAME (decode_live_frame (frame));
1833 /* Return the value of frame parameter PROP in frame FRAME. */
1835 #ifdef HAVE_WINDOW_SYSTEM
1836 #if !HAVE_NS
1837 static
1838 #endif
1839 Lisp_Object
1840 get_frame_param (register struct frame *frame, Lisp_Object prop)
1842 register Lisp_Object tem;
1844 tem = Fassq (prop, frame->param_alist);
1845 if (EQ (tem, Qnil))
1846 return tem;
1847 return Fcdr (tem);
1849 #endif
1851 /* Discard BUFFER from the buffer-list and buried-buffer-list of each frame. */
1853 void
1854 frames_discard_buffer (Lisp_Object buffer)
1856 Lisp_Object frame, tail;
1858 FOR_EACH_FRAME (tail, frame)
1860 fset_buffer_list
1861 (XFRAME (frame), Fdelq (buffer, XFRAME (frame)->buffer_list));
1862 fset_buried_buffer_list
1863 (XFRAME (frame), Fdelq (buffer, XFRAME (frame)->buried_buffer_list));
1867 /* Modify the alist in *ALISTPTR to associate PROP with VAL.
1868 If the alist already has an element for PROP, we change it. */
1870 void
1871 store_in_alist (Lisp_Object *alistptr, Lisp_Object prop, Lisp_Object val)
1873 register Lisp_Object tem;
1875 tem = Fassq (prop, *alistptr);
1876 if (EQ (tem, Qnil))
1877 *alistptr = Fcons (Fcons (prop, val), *alistptr);
1878 else
1879 Fsetcdr (tem, val);
1882 static int
1883 frame_name_fnn_p (char *str, ptrdiff_t len)
1885 if (len > 1 && str[0] == 'F' && '0' <= str[1] && str[1] <= '9')
1887 char *p = str + 2;
1888 while ('0' <= *p && *p <= '9')
1889 p++;
1890 if (p == str + len)
1891 return 1;
1893 return 0;
1896 /* Set the name of the terminal frame. Also used by MSDOS frames.
1897 Modeled after x_set_name which is used for WINDOW frames. */
1899 static void
1900 set_term_frame_name (struct frame *f, Lisp_Object name)
1902 f->explicit_name = ! NILP (name);
1904 /* If NAME is nil, set the name to F<num>. */
1905 if (NILP (name))
1907 char namebuf[sizeof "F" + INT_STRLEN_BOUND (printmax_t)];
1909 /* Check for no change needed in this very common case
1910 before we do any consing. */
1911 if (frame_name_fnn_p (SSDATA (f->name), SBYTES (f->name)))
1912 return;
1914 name = make_formatted_string (namebuf, "F%"pMd, ++tty_frame_count);
1916 else
1918 CHECK_STRING (name);
1920 /* Don't change the name if it's already NAME. */
1921 if (! NILP (Fstring_equal (name, f->name)))
1922 return;
1924 /* Don't allow the user to set the frame name to F<num>, so it
1925 doesn't clash with the names we generate for terminal frames. */
1926 if (frame_name_fnn_p (SSDATA (name), SBYTES (name)))
1927 error ("Frame names of the form F<num> are usurped by Emacs");
1930 fset_name (f, name);
1931 update_mode_lines = 1;
1934 void
1935 store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
1937 register Lisp_Object old_alist_elt;
1939 /* The buffer-list parameters are stored in a special place and not
1940 in the alist. All buffers must be live. */
1941 if (EQ (prop, Qbuffer_list))
1943 Lisp_Object list = Qnil;
1944 for (; CONSP (val); val = XCDR (val))
1945 if (!NILP (Fbuffer_live_p (XCAR (val))))
1946 list = Fcons (XCAR (val), list);
1947 fset_buffer_list (f, Fnreverse (list));
1948 return;
1950 if (EQ (prop, Qburied_buffer_list))
1952 Lisp_Object list = Qnil;
1953 for (; CONSP (val); val = XCDR (val))
1954 if (!NILP (Fbuffer_live_p (XCAR (val))))
1955 list = Fcons (XCAR (val), list);
1956 fset_buried_buffer_list (f, Fnreverse (list));
1957 return;
1960 /* If PROP is a symbol which is supposed to have frame-local values,
1961 and it is set up based on this frame, switch to the global
1962 binding. That way, we can create or alter the frame-local binding
1963 without messing up the symbol's status. */
1964 if (SYMBOLP (prop))
1966 struct Lisp_Symbol *sym = XSYMBOL (prop);
1967 start:
1968 switch (sym->redirect)
1970 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
1971 case SYMBOL_PLAINVAL: case SYMBOL_FORWARDED: break;
1972 case SYMBOL_LOCALIZED:
1973 { struct Lisp_Buffer_Local_Value *blv = sym->val.blv;
1974 if (blv->frame_local && blv_found (blv) && XFRAME (blv->where) == f)
1975 swap_in_global_binding (sym);
1976 break;
1978 default: emacs_abort ();
1982 /* The tty color needed to be set before the frame's parameter
1983 alist was updated with the new value. This is not true any more,
1984 but we still do this test early on. */
1985 if (FRAME_TERMCAP_P (f) && EQ (prop, Qtty_color_mode)
1986 && f == FRAME_TTY (f)->previous_frame)
1987 /* Force redisplay of this tty. */
1988 FRAME_TTY (f)->previous_frame = NULL;
1990 /* Update the frame parameter alist. */
1991 old_alist_elt = Fassq (prop, f->param_alist);
1992 if (EQ (old_alist_elt, Qnil))
1993 fset_param_alist (f, Fcons (Fcons (prop, val), f->param_alist));
1994 else
1995 Fsetcdr (old_alist_elt, val);
1997 /* Update some other special parameters in their special places
1998 in addition to the alist. */
2000 if (EQ (prop, Qbuffer_predicate))
2001 fset_buffer_predicate (f, val);
2003 if (! FRAME_WINDOW_P (f))
2005 if (EQ (prop, Qmenu_bar_lines))
2006 set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f)));
2007 else if (EQ (prop, Qname))
2008 set_term_frame_name (f, val);
2011 if (EQ (prop, Qminibuffer) && WINDOWP (val))
2013 if (! MINI_WINDOW_P (XWINDOW (val)))
2014 error ("Surrogate minibuffer windows must be minibuffer windows");
2016 if ((FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
2017 && !EQ (val, f->minibuffer_window))
2018 error ("Can't change the surrogate minibuffer of a frame with its own minibuffer");
2020 /* Install the chosen minibuffer window, with proper buffer. */
2021 fset_minibuffer_window (f, val);
2025 DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0,
2026 doc: /* Return the parameters-alist of frame FRAME.
2027 It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
2028 The meaningful PARMs depend on the kind of frame.
2029 If FRAME is omitted or nil, return information on the currently selected frame. */)
2030 (Lisp_Object frame)
2032 Lisp_Object alist;
2033 struct frame *f = decode_any_frame (frame);
2034 int height, width;
2035 struct gcpro gcpro1;
2037 if (!FRAME_LIVE_P (f))
2038 return Qnil;
2040 alist = Fcopy_alist (f->param_alist);
2041 GCPRO1 (alist);
2043 if (!FRAME_WINDOW_P (f))
2045 int fg = FRAME_FOREGROUND_PIXEL (f);
2046 int bg = FRAME_BACKGROUND_PIXEL (f);
2047 Lisp_Object elt;
2049 /* If the frame's parameter alist says the colors are
2050 unspecified and reversed, take the frame's background pixel
2051 for foreground and vice versa. */
2052 elt = Fassq (Qforeground_color, alist);
2053 if (CONSP (elt) && STRINGP (XCDR (elt)))
2055 if (strncmp (SSDATA (XCDR (elt)),
2056 unspecified_bg,
2057 SCHARS (XCDR (elt))) == 0)
2058 store_in_alist (&alist, Qforeground_color, tty_color_name (f, bg));
2059 else if (strncmp (SSDATA (XCDR (elt)),
2060 unspecified_fg,
2061 SCHARS (XCDR (elt))) == 0)
2062 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2064 else
2065 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2066 elt = Fassq (Qbackground_color, alist);
2067 if (CONSP (elt) && STRINGP (XCDR (elt)))
2069 if (strncmp (SSDATA (XCDR (elt)),
2070 unspecified_fg,
2071 SCHARS (XCDR (elt))) == 0)
2072 store_in_alist (&alist, Qbackground_color, tty_color_name (f, fg));
2073 else if (strncmp (SSDATA (XCDR (elt)),
2074 unspecified_bg,
2075 SCHARS (XCDR (elt))) == 0)
2076 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2078 else
2079 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2080 store_in_alist (&alist, intern ("font"),
2081 build_string (FRAME_MSDOS_P (f)
2082 ? "ms-dos"
2083 : FRAME_W32_P (f) ? "w32term"
2084 :"tty"));
2086 store_in_alist (&alist, Qname, f->name);
2087 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2088 store_in_alist (&alist, Qheight, make_number (height));
2089 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2090 store_in_alist (&alist, Qwidth, make_number (width));
2091 store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil));
2092 store_in_alist (&alist, Qminibuffer,
2093 (! FRAME_HAS_MINIBUF_P (f) ? Qnil
2094 : FRAME_MINIBUF_ONLY_P (f) ? Qonly
2095 : FRAME_MINIBUF_WINDOW (f)));
2096 store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
2097 store_in_alist (&alist, Qbuffer_list, f->buffer_list);
2098 store_in_alist (&alist, Qburied_buffer_list, f->buried_buffer_list);
2100 /* I think this should be done with a hook. */
2101 #ifdef HAVE_WINDOW_SYSTEM
2102 if (FRAME_WINDOW_P (f))
2103 x_report_frame_params (f, &alist);
2104 else
2105 #endif
2107 /* This ought to be correct in f->param_alist for an X frame. */
2108 Lisp_Object lines;
2109 XSETFASTINT (lines, FRAME_MENU_BAR_LINES (f));
2110 store_in_alist (&alist, Qmenu_bar_lines, lines);
2113 UNGCPRO;
2114 return alist;
2118 DEFUN ("frame-parameter", Fframe_parameter, Sframe_parameter, 2, 2, 0,
2119 doc: /* Return FRAME's value for parameter PARAMETER.
2120 If FRAME is nil, describe the currently selected frame. */)
2121 (Lisp_Object frame, Lisp_Object parameter)
2123 struct frame *f = decode_any_frame (frame);
2124 Lisp_Object value = Qnil;
2126 CHECK_SYMBOL (parameter);
2128 XSETFRAME (frame, f);
2130 if (FRAME_LIVE_P (f))
2132 /* Avoid consing in frequent cases. */
2133 if (EQ (parameter, Qname))
2134 value = f->name;
2135 #ifdef HAVE_X_WINDOWS
2136 else if (EQ (parameter, Qdisplay) && FRAME_X_P (f))
2137 value = XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element);
2138 #endif /* HAVE_X_WINDOWS */
2139 else if (EQ (parameter, Qbackground_color)
2140 || EQ (parameter, Qforeground_color))
2142 value = Fassq (parameter, f->param_alist);
2143 if (CONSP (value))
2145 value = XCDR (value);
2146 /* Fframe_parameters puts the actual fg/bg color names,
2147 even if f->param_alist says otherwise. This is
2148 important when param_alist's notion of colors is
2149 "unspecified". We need to do the same here. */
2150 if (STRINGP (value) && !FRAME_WINDOW_P (f))
2152 const char *color_name;
2153 ptrdiff_t csz;
2155 if (EQ (parameter, Qbackground_color))
2157 color_name = SSDATA (value);
2158 csz = SCHARS (value);
2159 if (strncmp (color_name, unspecified_bg, csz) == 0)
2160 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2161 else if (strncmp (color_name, unspecified_fg, csz) == 0)
2162 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2164 else if (EQ (parameter, Qforeground_color))
2166 color_name = SSDATA (value);
2167 csz = SCHARS (value);
2168 if (strncmp (color_name, unspecified_fg, csz) == 0)
2169 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2170 else if (strncmp (color_name, unspecified_bg, csz) == 0)
2171 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2175 else
2176 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2178 else if (EQ (parameter, Qdisplay_type)
2179 || EQ (parameter, Qbackground_mode))
2180 value = Fcdr (Fassq (parameter, f->param_alist));
2181 else
2182 /* FIXME: Avoid this code path at all (as well as code duplication)
2183 by sharing more code with Fframe_parameters. */
2184 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2187 return value;
2191 DEFUN ("modify-frame-parameters", Fmodify_frame_parameters,
2192 Smodify_frame_parameters, 2, 2, 0,
2193 doc: /* Modify the parameters of frame FRAME according to ALIST.
2194 If FRAME is nil, it defaults to the selected frame.
2195 ALIST is an alist of parameters to change and their new values.
2196 Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.
2197 The meaningful PARMs depend on the kind of frame.
2198 Undefined PARMs are ignored, but stored in the frame's parameter list
2199 so that `frame-parameters' will return them.
2201 The value of frame parameter FOO can also be accessed
2202 as a frame-local binding for the variable FOO, if you have
2203 enabled such bindings for that variable with `make-variable-frame-local'.
2204 Note that this functionality is obsolete as of Emacs 22.2, and its
2205 use is not recommended. Explicitly check for a frame-parameter instead. */)
2206 (Lisp_Object frame, Lisp_Object alist)
2208 struct frame *f = decode_live_frame (frame);
2209 register Lisp_Object tail, prop, val;
2211 /* I think this should be done with a hook. */
2212 #ifdef HAVE_WINDOW_SYSTEM
2213 if (FRAME_WINDOW_P (f))
2214 x_set_frame_parameters (f, alist);
2215 else
2216 #endif
2217 #ifdef MSDOS
2218 if (FRAME_MSDOS_P (f))
2219 IT_set_frame_parameters (f, alist);
2220 else
2221 #endif
2224 EMACS_INT length = XFASTINT (Flength (alist));
2225 ptrdiff_t i;
2226 Lisp_Object *parms;
2227 Lisp_Object *values;
2228 USE_SAFE_ALLOCA;
2229 SAFE_ALLOCA_LISP (parms, 2 * length);
2230 values = parms + length;
2232 /* Extract parm names and values into those vectors. */
2234 i = 0;
2235 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2237 Lisp_Object elt;
2239 elt = XCAR (tail);
2240 parms[i] = Fcar (elt);
2241 values[i] = Fcdr (elt);
2242 i++;
2245 /* Now process them in reverse of specified order. */
2246 while (--i >= 0)
2248 prop = parms[i];
2249 val = values[i];
2250 store_frame_param (f, prop, val);
2252 if (EQ (prop, Qforeground_color)
2253 || EQ (prop, Qbackground_color))
2254 update_face_from_frame_parameter (f, prop, val);
2257 SAFE_FREE ();
2259 return Qnil;
2262 DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height,
2263 0, 1, 0,
2264 doc: /* Height in pixels of a line in the font in frame FRAME.
2265 If FRAME is omitted or nil, the selected frame is used.
2266 For a terminal frame, the value is always 1. */)
2267 (Lisp_Object frame)
2269 #ifdef HAVE_WINDOW_SYSTEM
2270 struct frame *f = decode_any_frame (frame);
2272 if (FRAME_WINDOW_P (f))
2273 return make_number (FRAME_LINE_HEIGHT (f));
2274 else
2275 #endif
2276 return make_number (1);
2280 DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width,
2281 0, 1, 0,
2282 doc: /* Width in pixels of characters in the font in frame FRAME.
2283 If FRAME is omitted or nil, the selected frame is used.
2284 On a graphical screen, the width is the standard width of the default font.
2285 For a terminal screen, the value is always 1. */)
2286 (Lisp_Object frame)
2288 #ifdef HAVE_WINDOW_SYSTEM
2289 struct frame *f = decode_any_frame (frame);
2291 if (FRAME_WINDOW_P (f))
2292 return make_number (FRAME_COLUMN_WIDTH (f));
2293 else
2294 #endif
2295 return make_number (1);
2298 DEFUN ("frame-pixel-height", Fframe_pixel_height,
2299 Sframe_pixel_height, 0, 1, 0,
2300 doc: /* Return a FRAME's height in pixels.
2301 If FRAME is omitted or nil, the selected frame is used. The exact value
2302 of the result depends on the window-system and toolkit in use:
2304 In the Gtk+ version of Emacs, it includes only any window (including
2305 the minibuffer or echo area), mode line, and header line. It does not
2306 include the tool bar or menu bar.
2308 With other graphical versions, it also includes the tool bar and the
2309 menu bar.
2311 For a text terminal, it includes the menu bar. In this case, the
2312 result is really in characters rather than pixels (i.e., is identical
2313 to `frame-height'). */)
2314 (Lisp_Object frame)
2316 struct frame *f = decode_any_frame (frame);
2318 #ifdef HAVE_WINDOW_SYSTEM
2319 if (FRAME_WINDOW_P (f))
2320 return make_number (x_pixel_height (f));
2321 else
2322 #endif
2323 return make_number (FRAME_LINES (f));
2326 DEFUN ("frame-pixel-width", Fframe_pixel_width,
2327 Sframe_pixel_width, 0, 1, 0,
2328 doc: /* Return FRAME's width in pixels.
2329 For a terminal frame, the result really gives the width in characters.
2330 If FRAME is omitted or nil, the selected frame is used. */)
2331 (Lisp_Object frame)
2333 struct frame *f = decode_any_frame (frame);
2335 #ifdef HAVE_WINDOW_SYSTEM
2336 if (FRAME_WINDOW_P (f))
2337 return make_number (x_pixel_width (f));
2338 else
2339 #endif
2340 return make_number (FRAME_COLS (f));
2343 DEFUN ("tool-bar-pixel-width", Ftool_bar_pixel_width,
2344 Stool_bar_pixel_width, 0, 1, 0,
2345 doc: /* Return width in pixels of FRAME's tool bar.
2346 The result is greater than zero only when the tool bar is on the left
2347 or right side of FRAME. If FRAME is omitted or nil, the selected frame
2348 is used. */)
2349 (Lisp_Object frame)
2351 #ifdef FRAME_TOOLBAR_WIDTH
2352 struct frame *f = decode_any_frame (frame);
2354 if (FRAME_WINDOW_P (f))
2355 return make_number (FRAME_TOOLBAR_WIDTH (f));
2356 #endif
2357 return make_number (0);
2360 DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0,
2361 doc: /* Specify that the frame FRAME has LINES lines.
2362 Optional third arg non-nil means that redisplay should use LINES lines
2363 but that the idea of the actual height of the frame should not be changed. */)
2364 (Lisp_Object frame, Lisp_Object lines, Lisp_Object pretend)
2366 register struct frame *f = decode_live_frame (frame);
2368 CHECK_TYPE_RANGED_INTEGER (int, lines);
2370 /* I think this should be done with a hook. */
2371 #ifdef HAVE_WINDOW_SYSTEM
2372 if (FRAME_WINDOW_P (f))
2374 if (XINT (lines) != FRAME_LINES (f))
2375 x_set_window_size (f, 1, FRAME_COLS (f), XINT (lines));
2376 do_pending_window_change (0);
2378 else
2379 #endif
2380 change_frame_size (f, XINT (lines), 0, !NILP (pretend), 0, 0);
2381 return Qnil;
2384 DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 3, 0,
2385 doc: /* Specify that the frame FRAME has COLS columns.
2386 Optional third arg non-nil means that redisplay should use COLS columns
2387 but that the idea of the actual width of the frame should not be changed. */)
2388 (Lisp_Object frame, Lisp_Object cols, Lisp_Object pretend)
2390 register struct frame *f = decode_live_frame (frame);
2392 CHECK_TYPE_RANGED_INTEGER (int, cols);
2394 /* I think this should be done with a hook. */
2395 #ifdef HAVE_WINDOW_SYSTEM
2396 if (FRAME_WINDOW_P (f))
2398 if (XINT (cols) != FRAME_COLS (f))
2399 x_set_window_size (f, 1, XINT (cols), FRAME_LINES (f));
2400 do_pending_window_change (0);
2402 else
2403 #endif
2404 change_frame_size (f, 0, XINT (cols), !NILP (pretend), 0, 0);
2405 return Qnil;
2408 DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0,
2409 doc: /* Sets size of FRAME to COLS by ROWS, measured in characters. */)
2410 (Lisp_Object frame, Lisp_Object cols, Lisp_Object rows)
2412 register struct frame *f;
2414 CHECK_LIVE_FRAME (frame);
2415 CHECK_TYPE_RANGED_INTEGER (int, cols);
2416 CHECK_TYPE_RANGED_INTEGER (int, rows);
2417 f = XFRAME (frame);
2419 /* I think this should be done with a hook. */
2420 #ifdef HAVE_WINDOW_SYSTEM
2421 if (FRAME_WINDOW_P (f))
2423 if (XINT (rows) != FRAME_LINES (f)
2424 || XINT (cols) != FRAME_COLS (f)
2425 || f->new_text_lines || f->new_text_cols)
2426 x_set_window_size (f, 1, XINT (cols), XINT (rows));
2427 do_pending_window_change (0);
2429 else
2430 #endif
2431 change_frame_size (f, XINT (rows), XINT (cols), 0, 0, 0);
2433 return Qnil;
2436 DEFUN ("set-frame-position", Fset_frame_position,
2437 Sset_frame_position, 3, 3, 0,
2438 doc: /* Sets position of FRAME in pixels to XOFFSET by YOFFSET.
2439 This is actually the position of the upper left corner of the frame.
2440 Negative values for XOFFSET or YOFFSET are interpreted relative to
2441 the rightmost or bottommost possible position (that stays within the screen). */)
2442 (Lisp_Object frame, Lisp_Object xoffset, Lisp_Object yoffset)
2444 register struct frame *f;
2446 CHECK_LIVE_FRAME (frame);
2447 CHECK_TYPE_RANGED_INTEGER (int, xoffset);
2448 CHECK_TYPE_RANGED_INTEGER (int, yoffset);
2449 f = XFRAME (frame);
2451 /* I think this should be done with a hook. */
2452 #ifdef HAVE_WINDOW_SYSTEM
2453 if (FRAME_WINDOW_P (f))
2454 x_set_offset (f, XINT (xoffset), XINT (yoffset), 1);
2455 #endif
2457 return Qt;
2461 /***********************************************************************
2462 Frame Parameters
2463 ***********************************************************************/
2465 /* Connect the frame-parameter names for X frames
2466 to the ways of passing the parameter values to the window system.
2468 The name of a parameter, as a Lisp symbol,
2469 has an `x-frame-parameter' property which is an integer in Lisp
2470 that is an index in this table. */
2472 struct frame_parm_table {
2473 const char *name;
2474 Lisp_Object *variable;
2477 static const struct frame_parm_table frame_parms[] =
2479 {"auto-raise", &Qauto_raise},
2480 {"auto-lower", &Qauto_lower},
2481 {"background-color", 0},
2482 {"border-color", &Qborder_color},
2483 {"border-width", &Qborder_width},
2484 {"cursor-color", &Qcursor_color},
2485 {"cursor-type", &Qcursor_type},
2486 {"font", 0},
2487 {"foreground-color", 0},
2488 {"icon-name", &Qicon_name},
2489 {"icon-type", &Qicon_type},
2490 {"internal-border-width", &Qinternal_border_width},
2491 {"menu-bar-lines", &Qmenu_bar_lines},
2492 {"mouse-color", &Qmouse_color},
2493 {"name", &Qname},
2494 {"scroll-bar-width", &Qscroll_bar_width},
2495 {"title", &Qtitle},
2496 {"unsplittable", &Qunsplittable},
2497 {"vertical-scroll-bars", &Qvertical_scroll_bars},
2498 {"visibility", &Qvisibility},
2499 {"tool-bar-lines", &Qtool_bar_lines},
2500 {"scroll-bar-foreground", &Qscroll_bar_foreground},
2501 {"scroll-bar-background", &Qscroll_bar_background},
2502 {"screen-gamma", &Qscreen_gamma},
2503 {"line-spacing", &Qline_spacing},
2504 {"left-fringe", &Qleft_fringe},
2505 {"right-fringe", &Qright_fringe},
2506 {"wait-for-wm", &Qwait_for_wm},
2507 {"fullscreen", &Qfullscreen},
2508 {"font-backend", &Qfont_backend},
2509 {"alpha", &Qalpha},
2510 {"sticky", &Qsticky},
2511 {"tool-bar-position", &Qtool_bar_position},
2514 #ifdef HAVE_NTGUI
2516 /* Calculate fullscreen size. Return in *TOP_POS and *LEFT_POS the
2517 wanted positions of the WM window (not Emacs window).
2518 Return in *WIDTH and *HEIGHT the wanted width and height of Emacs
2519 window (FRAME_X_WINDOW).
2522 void
2523 x_fullscreen_adjust (struct frame *f, int *width, int *height, int *top_pos, int *left_pos)
2525 int newwidth = FRAME_COLS (f);
2526 int newheight = FRAME_LINES (f);
2527 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2529 *top_pos = f->top_pos;
2530 *left_pos = f->left_pos;
2532 if (f->want_fullscreen & FULLSCREEN_HEIGHT)
2534 int ph;
2536 ph = x_display_pixel_height (dpyinfo);
2537 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2538 ph = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, newheight) - f->y_pixels_diff;
2539 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2540 *top_pos = 0;
2543 if (f->want_fullscreen & FULLSCREEN_WIDTH)
2545 int pw;
2547 pw = x_display_pixel_width (dpyinfo);
2548 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2549 pw = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, newwidth) - f->x_pixels_diff;
2550 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2551 *left_pos = 0;
2554 *width = newwidth;
2555 *height = newheight;
2558 #endif /* HAVE_NTGUI */
2560 #ifdef HAVE_WINDOW_SYSTEM
2562 /* Change the parameters of frame F as specified by ALIST.
2563 If a parameter is not specially recognized, do nothing special;
2564 otherwise call the `x_set_...' function for that parameter.
2565 Except for certain geometry properties, always call store_frame_param
2566 to store the new value in the parameter alist. */
2568 void
2569 x_set_frame_parameters (FRAME_PTR f, Lisp_Object alist)
2571 Lisp_Object tail;
2573 /* If both of these parameters are present, it's more efficient to
2574 set them both at once. So we wait until we've looked at the
2575 entire list before we set them. */
2576 int width, height;
2578 /* Same here. */
2579 Lisp_Object left, top;
2581 /* Same with these. */
2582 Lisp_Object icon_left, icon_top;
2584 /* Record in these vectors all the parms specified. */
2585 Lisp_Object *parms;
2586 Lisp_Object *values;
2587 ptrdiff_t i, p;
2588 int left_no_change = 0, top_no_change = 0;
2589 int icon_left_no_change = 0, icon_top_no_change = 0;
2590 int size_changed = 0;
2591 struct gcpro gcpro1, gcpro2;
2593 i = 0;
2594 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2595 i++;
2597 parms = alloca (i * sizeof *parms);
2598 values = alloca (i * sizeof *values);
2600 /* Extract parm names and values into those vectors. */
2602 i = 0;
2603 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2605 Lisp_Object elt;
2607 elt = XCAR (tail);
2608 parms[i] = Fcar (elt);
2609 values[i] = Fcdr (elt);
2610 i++;
2612 /* TAIL and ALIST are not used again below here. */
2613 alist = tail = Qnil;
2615 GCPRO2 (*parms, *values);
2616 gcpro1.nvars = i;
2617 gcpro2.nvars = i;
2619 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
2620 because their values appear in VALUES and strings are not valid. */
2621 top = left = Qunbound;
2622 icon_left = icon_top = Qunbound;
2624 /* Provide default values for HEIGHT and WIDTH. */
2625 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2626 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2628 /* Process foreground_color and background_color before anything else.
2629 They are independent of other properties, but other properties (e.g.,
2630 cursor_color) are dependent upon them. */
2631 /* Process default font as well, since fringe widths depends on it. */
2632 for (p = 0; p < i; p++)
2634 Lisp_Object prop, val;
2636 prop = parms[p];
2637 val = values[p];
2638 if (EQ (prop, Qforeground_color)
2639 || EQ (prop, Qbackground_color)
2640 || EQ (prop, Qfont))
2642 register Lisp_Object param_index, old_value;
2644 old_value = get_frame_param (f, prop);
2645 if (NILP (Fequal (val, old_value)))
2647 store_frame_param (f, prop, val);
2649 param_index = Fget (prop, Qx_frame_parameter);
2650 if (NATNUMP (param_index)
2651 && (XFASTINT (param_index)
2652 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2653 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
2654 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2659 /* Now process them in reverse of specified order. */
2660 while (i-- != 0)
2662 Lisp_Object prop, val;
2664 prop = parms[i];
2665 val = values[i];
2667 if (EQ (prop, Qwidth) && RANGED_INTEGERP (0, val, INT_MAX))
2669 size_changed = 1;
2670 width = XFASTINT (val);
2672 else if (EQ (prop, Qheight) && RANGED_INTEGERP (0, val, INT_MAX))
2674 size_changed = 1;
2675 height = XFASTINT (val);
2677 else if (EQ (prop, Qtop))
2678 top = val;
2679 else if (EQ (prop, Qleft))
2680 left = val;
2681 else if (EQ (prop, Qicon_top))
2682 icon_top = val;
2683 else if (EQ (prop, Qicon_left))
2684 icon_left = val;
2685 else if (EQ (prop, Qforeground_color)
2686 || EQ (prop, Qbackground_color)
2687 || EQ (prop, Qfont))
2688 /* Processed above. */
2689 continue;
2690 else
2692 register Lisp_Object param_index, old_value;
2694 old_value = get_frame_param (f, prop);
2696 store_frame_param (f, prop, val);
2698 param_index = Fget (prop, Qx_frame_parameter);
2699 if (NATNUMP (param_index)
2700 && (XFASTINT (param_index)
2701 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2702 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
2703 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2707 /* Don't die if just one of these was set. */
2708 if (EQ (left, Qunbound))
2710 left_no_change = 1;
2711 if (f->left_pos < 0)
2712 left = Fcons (Qplus, Fcons (make_number (f->left_pos), Qnil));
2713 else
2714 XSETINT (left, f->left_pos);
2716 if (EQ (top, Qunbound))
2718 top_no_change = 1;
2719 if (f->top_pos < 0)
2720 top = Fcons (Qplus, Fcons (make_number (f->top_pos), Qnil));
2721 else
2722 XSETINT (top, f->top_pos);
2725 /* If one of the icon positions was not set, preserve or default it. */
2726 if (! TYPE_RANGED_INTEGERP (int, icon_left))
2728 icon_left_no_change = 1;
2729 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
2730 if (NILP (icon_left))
2731 XSETINT (icon_left, 0);
2733 if (! TYPE_RANGED_INTEGERP (int, icon_top))
2735 icon_top_no_change = 1;
2736 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
2737 if (NILP (icon_top))
2738 XSETINT (icon_top, 0);
2741 /* Don't set these parameters unless they've been explicitly
2742 specified. The window might be mapped or resized while we're in
2743 this function, and we don't want to override that unless the lisp
2744 code has asked for it.
2746 Don't set these parameters unless they actually differ from the
2747 window's current parameters; the window may not actually exist
2748 yet. */
2750 Lisp_Object frame;
2752 check_frame_size (f, &height, &width);
2754 XSETFRAME (frame, f);
2756 if (size_changed
2757 && (width != FRAME_COLS (f)
2758 || height != FRAME_LINES (f)
2759 || f->new_text_lines || f->new_text_cols))
2760 Fset_frame_size (frame, make_number (width), make_number (height));
2762 if ((!NILP (left) || !NILP (top))
2763 && ! (left_no_change && top_no_change)
2764 && ! (NUMBERP (left) && XINT (left) == f->left_pos
2765 && NUMBERP (top) && XINT (top) == f->top_pos))
2767 int leftpos = 0;
2768 int toppos = 0;
2770 /* Record the signs. */
2771 f->size_hint_flags &= ~ (XNegative | YNegative);
2772 if (EQ (left, Qminus))
2773 f->size_hint_flags |= XNegative;
2774 else if (TYPE_RANGED_INTEGERP (int, left))
2776 leftpos = XINT (left);
2777 if (leftpos < 0)
2778 f->size_hint_flags |= XNegative;
2780 else if (CONSP (left) && EQ (XCAR (left), Qminus)
2781 && CONSP (XCDR (left))
2782 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (left)), INT_MAX))
2784 leftpos = - XINT (XCAR (XCDR (left)));
2785 f->size_hint_flags |= XNegative;
2787 else if (CONSP (left) && EQ (XCAR (left), Qplus)
2788 && CONSP (XCDR (left))
2789 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (left))))
2791 leftpos = XINT (XCAR (XCDR (left)));
2794 if (EQ (top, Qminus))
2795 f->size_hint_flags |= YNegative;
2796 else if (TYPE_RANGED_INTEGERP (int, top))
2798 toppos = XINT (top);
2799 if (toppos < 0)
2800 f->size_hint_flags |= YNegative;
2802 else if (CONSP (top) && EQ (XCAR (top), Qminus)
2803 && CONSP (XCDR (top))
2804 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (top)), INT_MAX))
2806 toppos = - XINT (XCAR (XCDR (top)));
2807 f->size_hint_flags |= YNegative;
2809 else if (CONSP (top) && EQ (XCAR (top), Qplus)
2810 && CONSP (XCDR (top))
2811 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (top))))
2813 toppos = XINT (XCAR (XCDR (top)));
2817 /* Store the numeric value of the position. */
2818 f->top_pos = toppos;
2819 f->left_pos = leftpos;
2821 f->win_gravity = NorthWestGravity;
2823 /* Actually set that position, and convert to absolute. */
2824 x_set_offset (f, leftpos, toppos, -1);
2827 if ((!NILP (icon_left) || !NILP (icon_top))
2828 && ! (icon_left_no_change && icon_top_no_change))
2829 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
2832 UNGCPRO;
2836 /* Insert a description of internally-recorded parameters of frame X
2837 into the parameter alist *ALISTPTR that is to be given to the user.
2838 Only parameters that are specific to the X window system
2839 and whose values are not correctly recorded in the frame's
2840 param_alist need to be considered here. */
2842 void
2843 x_report_frame_params (struct frame *f, Lisp_Object *alistptr)
2845 Lisp_Object tem;
2846 uprintmax_t w;
2847 char buf[INT_BUFSIZE_BOUND (w)];
2849 /* Represent negative positions (off the top or left screen edge)
2850 in a way that Fmodify_frame_parameters will understand correctly. */
2851 XSETINT (tem, f->left_pos);
2852 if (f->left_pos >= 0)
2853 store_in_alist (alistptr, Qleft, tem);
2854 else
2855 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
2857 XSETINT (tem, f->top_pos);
2858 if (f->top_pos >= 0)
2859 store_in_alist (alistptr, Qtop, tem);
2860 else
2861 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
2863 store_in_alist (alistptr, Qborder_width,
2864 make_number (f->border_width));
2865 store_in_alist (alistptr, Qinternal_border_width,
2866 make_number (FRAME_INTERNAL_BORDER_WIDTH (f)));
2867 store_in_alist (alistptr, Qleft_fringe,
2868 make_number (FRAME_LEFT_FRINGE_WIDTH (f)));
2869 store_in_alist (alistptr, Qright_fringe,
2870 make_number (FRAME_RIGHT_FRINGE_WIDTH (f)));
2871 store_in_alist (alistptr, Qscroll_bar_width,
2872 (! FRAME_HAS_VERTICAL_SCROLL_BARS (f)
2873 ? make_number (0)
2874 : FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0
2875 ? make_number (FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
2876 /* nil means "use default width"
2877 for non-toolkit scroll bar.
2878 ruler-mode.el depends on this. */
2879 : Qnil));
2880 /* FRAME_X_WINDOW is not guaranteed to return an integer. E.g., on
2881 MS-Windows it returns a value whose type is HANDLE, which is
2882 actually a pointer. Explicit casting avoids compiler
2883 warnings. */
2884 w = (uintptr_t) FRAME_X_WINDOW (f);
2885 store_in_alist (alistptr, Qwindow_id,
2886 make_formatted_string (buf, "%"pMu, w));
2887 #ifdef HAVE_X_WINDOWS
2888 #ifdef USE_X_TOOLKIT
2889 /* Tooltip frame may not have this widget. */
2890 if (FRAME_X_OUTPUT (f)->widget)
2891 #endif
2892 w = (uintptr_t) FRAME_OUTER_WINDOW (f);
2893 store_in_alist (alistptr, Qouter_window_id,
2894 make_formatted_string (buf, "%"pMu, w));
2895 #endif
2896 store_in_alist (alistptr, Qicon_name, f->icon_name);
2897 FRAME_SAMPLE_VISIBILITY (f);
2898 store_in_alist (alistptr, Qvisibility,
2899 (FRAME_VISIBLE_P (f) ? Qt
2900 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
2901 store_in_alist (alistptr, Qdisplay,
2902 XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
2904 if (FRAME_X_OUTPUT (f)->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
2905 tem = Qnil;
2906 else
2907 XSETFASTINT (tem, FRAME_X_OUTPUT (f)->parent_desc);
2908 store_in_alist (alistptr, Qexplicit_name, (f->explicit_name ? Qt : Qnil));
2909 store_in_alist (alistptr, Qparent_id, tem);
2910 store_in_alist (alistptr, Qtool_bar_position, f->tool_bar_position);
2914 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
2915 the previous value of that parameter, NEW_VALUE is the new value. */
2917 void
2918 x_set_fullscreen (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
2920 if (NILP (new_value))
2921 f->want_fullscreen = FULLSCREEN_NONE;
2922 else if (EQ (new_value, Qfullboth) || EQ (new_value, Qfullscreen))
2923 f->want_fullscreen = FULLSCREEN_BOTH;
2924 else if (EQ (new_value, Qfullwidth))
2925 f->want_fullscreen = FULLSCREEN_WIDTH;
2926 else if (EQ (new_value, Qfullheight))
2927 f->want_fullscreen = FULLSCREEN_HEIGHT;
2928 else if (EQ (new_value, Qmaximized))
2929 f->want_fullscreen = FULLSCREEN_MAXIMIZED;
2931 if (FRAME_TERMINAL (f)->fullscreen_hook != NULL)
2932 FRAME_TERMINAL (f)->fullscreen_hook (f);
2936 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
2937 the previous value of that parameter, NEW_VALUE is the new value. */
2939 void
2940 x_set_line_spacing (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
2942 if (NILP (new_value))
2943 f->extra_line_spacing = 0;
2944 else if (RANGED_INTEGERP (0, new_value, INT_MAX))
2945 f->extra_line_spacing = XFASTINT (new_value);
2946 else
2947 signal_error ("Invalid line-spacing", new_value);
2948 if (FRAME_VISIBLE_P (f))
2949 redraw_frame (f);
2953 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
2954 the previous value of that parameter, NEW_VALUE is the new value. */
2956 void
2957 x_set_screen_gamma (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
2959 Lisp_Object bgcolor;
2961 if (NILP (new_value))
2962 f->gamma = 0;
2963 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
2964 /* The value 0.4545 is the normal viewing gamma. */
2965 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
2966 else
2967 signal_error ("Invalid screen-gamma", new_value);
2969 /* Apply the new gamma value to the frame background. */
2970 bgcolor = Fassq (Qbackground_color, f->param_alist);
2971 if (CONSP (bgcolor) && (bgcolor = XCDR (bgcolor), STRINGP (bgcolor)))
2973 Lisp_Object parm_index = Fget (Qbackground_color, Qx_frame_parameter);
2974 if (NATNUMP (parm_index)
2975 && (XFASTINT (parm_index)
2976 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2977 && FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
2978 (*FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
2979 (f, bgcolor, Qnil);
2982 Fclear_face_cache (Qnil);
2986 void
2987 x_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
2989 Lisp_Object font_object;
2990 int fontset = -1;
2991 #ifdef HAVE_X_WINDOWS
2992 Lisp_Object font_param = arg;
2993 #endif
2995 /* Set the frame parameter back to the old value because we may
2996 fail to use ARG as the new parameter value. */
2997 store_frame_param (f, Qfont, oldval);
2999 /* ARG is a fontset name, a font name, a cons of fontset name and a
3000 font object, or a font object. In the last case, this function
3001 never fail. */
3002 if (STRINGP (arg))
3004 fontset = fs_query_fontset (arg, 0);
3005 if (fontset < 0)
3007 font_object = font_open_by_name (f, arg);
3008 if (NILP (font_object))
3009 error ("Font `%s' is not defined", SSDATA (arg));
3010 arg = AREF (font_object, FONT_NAME_INDEX);
3012 else if (fontset > 0)
3014 font_object = font_open_by_name (f, fontset_ascii (fontset));
3015 if (NILP (font_object))
3016 error ("Font `%s' is not defined", SDATA (arg));
3017 arg = AREF (font_object, FONT_NAME_INDEX);
3019 else
3020 error ("The default fontset can't be used for a frame font");
3022 else if (CONSP (arg) && STRINGP (XCAR (arg)) && FONT_OBJECT_P (XCDR (arg)))
3024 /* This is the case that the ASCII font of F's fontset XCAR
3025 (arg) is changed to the font XCDR (arg) by
3026 `set-fontset-font'. */
3027 fontset = fs_query_fontset (XCAR (arg), 0);
3028 if (fontset < 0)
3029 error ("Unknown fontset: %s", SDATA (XCAR (arg)));
3030 font_object = XCDR (arg);
3031 arg = AREF (font_object, FONT_NAME_INDEX);
3032 #ifdef HAVE_X_WINDOWS
3033 font_param = Ffont_get (font_object, QCname);
3034 #endif
3036 else if (FONT_OBJECT_P (arg))
3038 font_object = arg;
3039 #ifdef HAVE_X_WINDOWS
3040 font_param = Ffont_get (font_object, QCname);
3041 #endif
3042 /* This is to store the XLFD font name in the frame parameter for
3043 backward compatibility. We should store the font-object
3044 itself in the future. */
3045 arg = AREF (font_object, FONT_NAME_INDEX);
3046 fontset = FRAME_FONTSET (f);
3047 /* Check if we can use the current fontset. If not, set FONTSET
3048 to -1 to generate a new fontset from FONT-OBJECT. */
3049 if (fontset >= 0)
3051 Lisp_Object ascii_font = fontset_ascii (fontset);
3052 Lisp_Object spec = font_spec_from_name (ascii_font);
3054 if (NILP (spec))
3055 signal_error ("Invalid font name", ascii_font);
3057 if (! font_match_p (spec, font_object))
3058 fontset = -1;
3061 else
3062 signal_error ("Invalid font", arg);
3064 if (! NILP (Fequal (font_object, oldval)))
3065 return;
3067 x_new_font (f, font_object, fontset);
3068 store_frame_param (f, Qfont, arg);
3069 #ifdef HAVE_X_WINDOWS
3070 store_frame_param (f, Qfont_param, font_param);
3071 #endif
3072 /* Recalculate toolbar height. */
3073 f->n_tool_bar_rows = 0;
3074 /* Ensure we redraw it. */
3075 clear_current_matrices (f);
3077 recompute_basic_faces (f);
3079 do_pending_window_change (0);
3081 /* We used to call face-set-after-frame-default here, but it leads to
3082 recursive calls (since that function can set the `default' face's
3083 font which in turns changes the frame's `font' parameter).
3084 Also I don't know what this call is meant to do, but it seems the
3085 wrong way to do it anyway (it does a lot more work than what seems
3086 reasonable in response to a change to `font'). */
3090 void
3091 x_set_font_backend (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3093 if (! NILP (new_value)
3094 && !CONSP (new_value))
3096 char *p0, *p1;
3098 CHECK_STRING (new_value);
3099 p0 = p1 = SSDATA (new_value);
3100 new_value = Qnil;
3101 while (*p0)
3103 while (*p1 && ! c_isspace (*p1) && *p1 != ',') p1++;
3104 if (p0 < p1)
3105 new_value = Fcons (Fintern (make_string (p0, p1 - p0), Qnil),
3106 new_value);
3107 if (*p1)
3109 int c;
3111 while ((c = *++p1) && c_isspace (c));
3113 p0 = p1;
3115 new_value = Fnreverse (new_value);
3118 if (! NILP (old_value) && ! NILP (Fequal (old_value, new_value)))
3119 return;
3121 if (FRAME_FONT (f))
3122 free_all_realized_faces (Qnil);
3124 new_value = font_update_drivers (f, NILP (new_value) ? Qt : new_value);
3125 if (NILP (new_value))
3127 if (NILP (old_value))
3128 error ("No font backend available");
3129 font_update_drivers (f, old_value);
3130 error ("None of specified font backends are available");
3132 store_frame_param (f, Qfont_backend, new_value);
3134 if (FRAME_FONT (f))
3136 Lisp_Object frame;
3138 XSETFRAME (frame, f);
3139 x_set_font (f, Fframe_parameter (frame, Qfont), Qnil);
3140 ++face_change_count;
3141 ++windows_or_buffers_changed;
3146 void
3147 x_set_fringe_width (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3149 compute_fringe_widths (f, 1);
3150 #ifdef HAVE_X_WINDOWS
3151 /* Must adjust this so window managers report correct number of columns. */
3152 if (FRAME_X_WINDOW (f) != 0)
3153 x_wm_set_size_hint (f, 0, 0);
3154 #endif
3157 void
3158 x_set_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3160 CHECK_TYPE_RANGED_INTEGER (int, arg);
3162 if (XINT (arg) == f->border_width)
3163 return;
3165 if (FRAME_X_WINDOW (f) != 0)
3166 error ("Cannot change the border width of a frame");
3168 f->border_width = XINT (arg);
3171 void
3172 x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3174 int old = FRAME_INTERNAL_BORDER_WIDTH (f);
3176 CHECK_TYPE_RANGED_INTEGER (int, arg);
3177 FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
3178 if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
3179 FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
3181 #ifdef USE_X_TOOLKIT
3182 if (FRAME_X_OUTPUT (f)->edit_widget)
3183 widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
3184 #endif
3186 if (FRAME_INTERNAL_BORDER_WIDTH (f) == old)
3187 return;
3189 if (FRAME_X_WINDOW (f) != 0)
3191 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3192 SET_FRAME_GARBAGED (f);
3193 do_pending_window_change (0);
3195 else
3196 SET_FRAME_GARBAGED (f);
3199 void
3200 x_set_visibility (struct frame *f, Lisp_Object value, Lisp_Object oldval)
3202 Lisp_Object frame;
3203 XSETFRAME (frame, f);
3205 if (NILP (value))
3206 Fmake_frame_invisible (frame, Qt);
3207 else if (EQ (value, Qicon))
3208 Ficonify_frame (frame);
3209 else
3210 Fmake_frame_visible (frame);
3213 void
3214 x_set_autoraise (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3216 f->auto_raise = !EQ (Qnil, arg);
3219 void
3220 x_set_autolower (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3222 f->auto_lower = !EQ (Qnil, arg);
3225 void
3226 x_set_unsplittable (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3228 f->no_split = !NILP (arg);
3231 void
3232 x_set_vertical_scroll_bars (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3234 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
3235 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
3236 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
3237 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
3239 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
3240 = (NILP (arg)
3241 ? vertical_scroll_bar_none
3242 : EQ (Qleft, arg)
3243 ? vertical_scroll_bar_left
3244 : EQ (Qright, arg)
3245 ? vertical_scroll_bar_right
3246 : EQ (Qleft, Vdefault_frame_scroll_bars)
3247 ? vertical_scroll_bar_left
3248 : EQ (Qright, Vdefault_frame_scroll_bars)
3249 ? vertical_scroll_bar_right
3250 : vertical_scroll_bar_none);
3252 /* We set this parameter before creating the X window for the
3253 frame, so we can get the geometry right from the start.
3254 However, if the window hasn't been created yet, we shouldn't
3255 call x_set_window_size. */
3256 if (FRAME_X_WINDOW (f))
3257 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3258 do_pending_window_change (0);
3262 void
3263 x_set_scroll_bar_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3265 int wid = FRAME_COLUMN_WIDTH (f);
3267 if (NILP (arg))
3269 x_set_scroll_bar_default_width (f);
3271 if (FRAME_X_WINDOW (f))
3272 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3273 do_pending_window_change (0);
3275 else if (RANGED_INTEGERP (1, arg, INT_MAX)
3276 && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3278 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
3279 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
3281 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg);
3282 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
3283 if (FRAME_X_WINDOW (f))
3284 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3285 do_pending_window_change (0);
3288 change_frame_size (f, 0, FRAME_COLS (f), 0, 0, 0);
3289 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
3290 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
3295 /* Return non-nil if frame F wants a bitmap icon. */
3297 Lisp_Object
3298 x_icon_type (FRAME_PTR f)
3300 Lisp_Object tem;
3302 tem = assq_no_quit (Qicon_type, f->param_alist);
3303 if (CONSP (tem))
3304 return XCDR (tem);
3305 else
3306 return Qnil;
3309 void
3310 x_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3312 double alpha = 1.0;
3313 double newval[2];
3314 int i;
3315 Lisp_Object item;
3317 for (i = 0; i < 2; i++)
3319 newval[i] = 1.0;
3320 if (CONSP (arg))
3322 item = CAR (arg);
3323 arg = CDR (arg);
3325 else
3326 item = arg;
3328 if (NILP (item))
3329 alpha = - 1.0;
3330 else if (FLOATP (item))
3332 alpha = XFLOAT_DATA (item);
3333 if (alpha < 0.0 || 1.0 < alpha)
3334 args_out_of_range (make_float (0.0), make_float (1.0));
3336 else if (INTEGERP (item))
3338 EMACS_INT ialpha = XINT (item);
3339 if (ialpha < 0 || 100 < ialpha)
3340 args_out_of_range (make_number (0), make_number (100));
3341 else
3342 alpha = ialpha / 100.0;
3344 else
3345 wrong_type_argument (Qnumberp, item);
3346 newval[i] = alpha;
3349 for (i = 0; i < 2; i++)
3350 f->alpha[i] = newval[i];
3352 #if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA)
3353 block_input ();
3354 x_set_frame_alpha (f);
3355 unblock_input ();
3356 #endif
3358 return;
3362 /* Subroutines of creating an X frame. */
3364 /* Make sure that Vx_resource_name is set to a reasonable value.
3365 Fix it up, or set it to `emacs' if it is too hopeless. */
3367 void
3368 validate_x_resource_name (void)
3370 ptrdiff_t len = 0;
3371 /* Number of valid characters in the resource name. */
3372 ptrdiff_t good_count = 0;
3373 /* Number of invalid characters in the resource name. */
3374 ptrdiff_t bad_count = 0;
3375 Lisp_Object new;
3376 ptrdiff_t i;
3378 if (!STRINGP (Vx_resource_class))
3379 Vx_resource_class = build_string (EMACS_CLASS);
3381 if (STRINGP (Vx_resource_name))
3383 unsigned char *p = SDATA (Vx_resource_name);
3385 len = SBYTES (Vx_resource_name);
3387 /* Only letters, digits, - and _ are valid in resource names.
3388 Count the valid characters and count the invalid ones. */
3389 for (i = 0; i < len; i++)
3391 int c = p[i];
3392 if (! ((c >= 'a' && c <= 'z')
3393 || (c >= 'A' && c <= 'Z')
3394 || (c >= '0' && c <= '9')
3395 || c == '-' || c == '_'))
3396 bad_count++;
3397 else
3398 good_count++;
3401 else
3402 /* Not a string => completely invalid. */
3403 bad_count = 5, good_count = 0;
3405 /* If name is valid already, return. */
3406 if (bad_count == 0)
3407 return;
3409 /* If name is entirely invalid, or nearly so, or is so implausibly
3410 large that alloca might not work, use `emacs'. */
3411 if (good_count < 2 || MAX_ALLOCA - sizeof ".customization" < len)
3413 Vx_resource_name = build_string ("emacs");
3414 return;
3417 /* Name is partly valid. Copy it and replace the invalid characters
3418 with underscores. */
3420 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
3422 for (i = 0; i < len; i++)
3424 int c = SREF (new, i);
3425 if (! ((c >= 'a' && c <= 'z')
3426 || (c >= 'A' && c <= 'Z')
3427 || (c >= '0' && c <= '9')
3428 || c == '-' || c == '_'))
3429 SSET (new, i, '_');
3434 extern char *x_get_string_resource (XrmDatabase, const char *, const char *);
3435 extern Display_Info *check_x_display_info (Lisp_Object);
3438 /* Get specified attribute from resource database RDB.
3439 See Fx_get_resource below for other parameters. */
3441 static Lisp_Object
3442 xrdb_get_resource (XrmDatabase rdb, Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3444 register char *value;
3445 char *name_key;
3446 char *class_key;
3448 CHECK_STRING (attribute);
3449 CHECK_STRING (class);
3451 if (!NILP (component))
3452 CHECK_STRING (component);
3453 if (!NILP (subclass))
3454 CHECK_STRING (subclass);
3455 if (NILP (component) != NILP (subclass))
3456 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3458 validate_x_resource_name ();
3460 /* Allocate space for the components, the dots which separate them,
3461 and the final '\0'. Make them big enough for the worst case. */
3462 name_key = alloca (SBYTES (Vx_resource_name)
3463 + (STRINGP (component)
3464 ? SBYTES (component) : 0)
3465 + SBYTES (attribute)
3466 + 3);
3468 class_key = alloca (SBYTES (Vx_resource_class)
3469 + SBYTES (class)
3470 + (STRINGP (subclass)
3471 ? SBYTES (subclass) : 0)
3472 + 3);
3474 /* Start with emacs.FRAMENAME for the name (the specific one)
3475 and with `Emacs' for the class key (the general one). */
3476 strcpy (name_key, SSDATA (Vx_resource_name));
3477 strcpy (class_key, SSDATA (Vx_resource_class));
3479 strcat (class_key, ".");
3480 strcat (class_key, SSDATA (class));
3482 if (!NILP (component))
3484 strcat (class_key, ".");
3485 strcat (class_key, SSDATA (subclass));
3487 strcat (name_key, ".");
3488 strcat (name_key, SSDATA (component));
3491 strcat (name_key, ".");
3492 strcat (name_key, SSDATA (attribute));
3494 value = x_get_string_resource (rdb, name_key, class_key);
3496 if (value != (char *) 0 && *value)
3497 return build_string (value);
3498 else
3499 return Qnil;
3503 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
3504 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
3505 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
3506 class, where INSTANCE is the name under which Emacs was invoked, or
3507 the name specified by the `-name' or `-rn' command-line arguments.
3509 The optional arguments COMPONENT and SUBCLASS add to the key and the
3510 class, respectively. You must specify both of them or neither.
3511 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
3512 and the class is `Emacs.CLASS.SUBCLASS'. */)
3513 (Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3515 #ifdef HAVE_X_WINDOWS
3516 check_x ();
3517 #endif
3519 return xrdb_get_resource (check_x_display_info (Qnil)->xrdb,
3520 attribute, class, component, subclass);
3523 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
3525 Lisp_Object
3526 display_x_get_resource (Display_Info *dpyinfo, Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3528 return xrdb_get_resource (dpyinfo->xrdb,
3529 attribute, class, component, subclass);
3532 #if defined HAVE_X_WINDOWS && !defined USE_X_TOOLKIT
3533 /* Used when C code wants a resource value. */
3534 /* Called from oldXMenu/Create.c. */
3535 char *
3536 x_get_resource_string (const char *attribute, const char *class)
3538 char *result;
3539 struct frame *sf = SELECTED_FRAME ();
3540 ptrdiff_t invocation_namelen = SBYTES (Vinvocation_name);
3541 USE_SAFE_ALLOCA;
3543 /* Allocate space for the components, the dots which separate them,
3544 and the final '\0'. */
3545 char *name_key = SAFE_ALLOCA (invocation_namelen + strlen (attribute) + 2);
3546 char *class_key = alloca ((sizeof (EMACS_CLASS) - 1) + strlen (class) + 2);
3548 esprintf (name_key, "%s.%s", SSDATA (Vinvocation_name), attribute);
3549 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3551 result = x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
3552 name_key, class_key);
3553 SAFE_FREE ();
3554 return result;
3556 #endif
3558 /* Return the value of parameter PARAM.
3560 First search ALIST, then Vdefault_frame_alist, then the X defaults
3561 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3563 Convert the resource to the type specified by desired_type.
3565 If no default is specified, return Qunbound. If you call
3566 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3567 and don't let it get stored in any Lisp-visible variables! */
3569 Lisp_Object
3570 x_get_arg (Display_Info *dpyinfo, Lisp_Object alist, Lisp_Object param,
3571 const char *attribute, const char *class, enum resource_types type)
3573 register Lisp_Object tem;
3575 tem = Fassq (param, alist);
3577 if (!NILP (tem))
3579 /* If we find this parm in ALIST, clear it out
3580 so that it won't be "left over" at the end. */
3581 Lisp_Object tail;
3582 XSETCAR (tem, Qnil);
3583 /* In case the parameter appears more than once in the alist,
3584 clear it out. */
3585 for (tail = alist; CONSP (tail); tail = XCDR (tail))
3586 if (CONSP (XCAR (tail))
3587 && EQ (XCAR (XCAR (tail)), param))
3588 XSETCAR (XCAR (tail), Qnil);
3590 else
3591 tem = Fassq (param, Vdefault_frame_alist);
3593 /* If it wasn't specified in ALIST or the Lisp-level defaults,
3594 look in the X resources. */
3595 if (EQ (tem, Qnil))
3597 if (attribute && dpyinfo)
3599 tem = display_x_get_resource (dpyinfo,
3600 build_string (attribute),
3601 build_string (class),
3602 Qnil, Qnil);
3604 if (NILP (tem))
3605 return Qunbound;
3607 switch (type)
3609 case RES_TYPE_NUMBER:
3610 return make_number (atoi (SSDATA (tem)));
3612 case RES_TYPE_BOOLEAN_NUMBER:
3613 if (!strcmp (SSDATA (tem), "on")
3614 || !strcmp (SSDATA (tem), "true"))
3615 return make_number (1);
3616 return make_number (atoi (SSDATA (tem)));
3617 break;
3619 case RES_TYPE_FLOAT:
3620 return make_float (atof (SSDATA (tem)));
3622 case RES_TYPE_BOOLEAN:
3623 tem = Fdowncase (tem);
3624 if (!strcmp (SSDATA (tem), "on")
3625 #ifdef HAVE_NS
3626 || !strcmp (SSDATA (tem), "yes")
3627 #endif
3628 || !strcmp (SSDATA (tem), "true"))
3629 return Qt;
3630 else
3631 return Qnil;
3633 case RES_TYPE_STRING:
3634 return tem;
3636 case RES_TYPE_SYMBOL:
3637 /* As a special case, we map the values `true' and `on'
3638 to Qt, and `false' and `off' to Qnil. */
3640 Lisp_Object lower;
3641 lower = Fdowncase (tem);
3642 if (!strcmp (SSDATA (lower), "on")
3643 #ifdef HAVE_NS
3644 || !strcmp (SSDATA (lower), "yes")
3645 #endif
3646 || !strcmp (SSDATA (lower), "true"))
3647 return Qt;
3648 else if (!strcmp (SSDATA (lower), "off")
3649 #ifdef HAVE_NS
3650 || !strcmp (SSDATA (lower), "no")
3651 #endif
3652 || !strcmp (SSDATA (lower), "false"))
3653 return Qnil;
3654 else
3655 return Fintern (tem, Qnil);
3658 default:
3659 emacs_abort ();
3662 else
3663 return Qunbound;
3665 return Fcdr (tem);
3668 static Lisp_Object
3669 x_frame_get_arg (struct frame *f, Lisp_Object alist, Lisp_Object param,
3670 const char *attribute, const char *class,
3671 enum resource_types type)
3673 return x_get_arg (FRAME_X_DISPLAY_INFO (f),
3674 alist, param, attribute, class, type);
3677 /* Like x_frame_get_arg, but also record the value in f->param_alist. */
3679 Lisp_Object
3680 x_frame_get_and_record_arg (struct frame *f, Lisp_Object alist,
3681 Lisp_Object param,
3682 const char *attribute, const char *class,
3683 enum resource_types type)
3685 Lisp_Object value;
3687 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
3688 attribute, class, type);
3689 if (! NILP (value) && ! EQ (value, Qunbound))
3690 store_frame_param (f, param, value);
3692 return value;
3696 /* Record in frame F the specified or default value according to ALIST
3697 of the parameter named PROP (a Lisp symbol).
3698 If no value is specified for PROP, look for an X default for XPROP
3699 on the frame named NAME.
3700 If that is not found either, use the value DEFLT. */
3702 Lisp_Object
3703 x_default_parameter (struct frame *f, Lisp_Object alist, Lisp_Object prop,
3704 Lisp_Object deflt, const char *xprop, const char *xclass,
3705 enum resource_types type)
3707 Lisp_Object tem;
3709 tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type);
3710 if (EQ (tem, Qunbound))
3711 tem = deflt;
3712 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
3713 return tem;
3717 #if !defined (HAVE_X_WINDOWS) && defined (NoValue)
3720 * XParseGeometry parses strings of the form
3721 * "=<width>x<height>{+-}<xoffset>{+-}<yoffset>", where
3722 * width, height, xoffset, and yoffset are unsigned integers.
3723 * Example: "=80x24+300-49"
3724 * The equal sign is optional.
3725 * It returns a bitmask that indicates which of the four values
3726 * were actually found in the string. For each value found,
3727 * the corresponding argument is updated; for each value
3728 * not found, the corresponding argument is left unchanged.
3731 static int
3732 XParseGeometry (char *string,
3733 int *x, int *y,
3734 unsigned int *width, unsigned int *height)
3736 int mask = NoValue;
3737 char *strind;
3738 unsigned long int tempWidth, tempHeight;
3739 long int tempX, tempY;
3740 char *nextCharacter;
3742 if (string == NULL || *string == '\0')
3743 return mask;
3744 if (*string == '=')
3745 string++; /* ignore possible '=' at beg of geometry spec */
3747 strind = string;
3748 if (*strind != '+' && *strind != '-' && *strind != 'x')
3750 tempWidth = strtoul (strind, &nextCharacter, 10);
3751 if (strind == nextCharacter)
3752 return 0;
3753 strind = nextCharacter;
3754 mask |= WidthValue;
3757 if (*strind == 'x' || *strind == 'X')
3759 strind++;
3760 tempHeight = strtoul (strind, &nextCharacter, 10);
3761 if (strind == nextCharacter)
3762 return 0;
3763 strind = nextCharacter;
3764 mask |= HeightValue;
3767 if (*strind == '+' || *strind == '-')
3769 if (*strind == '-')
3770 mask |= XNegative;
3771 tempX = strtol (strind, &nextCharacter, 10);
3772 if (strind == nextCharacter)
3773 return 0;
3774 strind = nextCharacter;
3775 mask |= XValue;
3776 if (*strind == '+' || *strind == '-')
3778 if (*strind == '-')
3779 mask |= YNegative;
3780 tempY = strtol (strind, &nextCharacter, 10);
3781 if (strind == nextCharacter)
3782 return 0;
3783 strind = nextCharacter;
3784 mask |= YValue;
3788 /* If strind isn't at the end of the string then it's an invalid
3789 geometry specification. */
3791 if (*strind != '\0')
3792 return 0;
3794 if (mask & XValue)
3795 *x = clip_to_bounds (INT_MIN, tempX, INT_MAX);
3796 if (mask & YValue)
3797 *y = clip_to_bounds (INT_MIN, tempY, INT_MAX);
3798 if (mask & WidthValue)
3799 *width = min (tempWidth, UINT_MAX);
3800 if (mask & HeightValue)
3801 *height = min (tempHeight, UINT_MAX);
3802 return mask;
3805 #endif /* !defined (HAVE_X_WINDOWS) && defined (NoValue) */
3808 /* NS used to define x-parse-geometry in ns-win.el, but that confused
3809 make-docfile: the documentation string in ns-win.el was used for
3810 x-parse-geometry even in non-NS builds.
3812 With two definitions of x-parse-geometry in this file, various
3813 things still get confused (eg M-x apropos documentation), so that
3814 it is best if the two definitions just share the same doc-string.
3816 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
3817 doc: /* Parse a display geometry string STRING.
3818 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3819 The properties returned may include `top', `left', `height', and `width'.
3820 For X, the value of `left' or `top' may be an integer,
3821 or a list (+ N) meaning N pixels relative to top/left corner,
3822 or a list (- N) meaning -N pixels relative to bottom/right corner.
3823 On Nextstep, this just calls `ns-parse-geometry'. */)
3824 (Lisp_Object string)
3826 int geometry, x, y;
3827 unsigned int width, height;
3828 Lisp_Object result;
3830 CHECK_STRING (string);
3832 #ifdef HAVE_NS
3833 if (strchr (SSDATA (string), ' ') != NULL)
3834 return call1 (Qns_parse_geometry, string);
3835 #endif
3836 geometry = XParseGeometry (SSDATA (string),
3837 &x, &y, &width, &height);
3838 result = Qnil;
3839 if (geometry & XValue)
3841 Lisp_Object element;
3843 if (x >= 0 && (geometry & XNegative))
3844 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
3845 else if (x < 0 && ! (geometry & XNegative))
3846 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
3847 else
3848 element = Fcons (Qleft, make_number (x));
3849 result = Fcons (element, result);
3852 if (geometry & YValue)
3854 Lisp_Object element;
3856 if (y >= 0 && (geometry & YNegative))
3857 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
3858 else if (y < 0 && ! (geometry & YNegative))
3859 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
3860 else
3861 element = Fcons (Qtop, make_number (y));
3862 result = Fcons (element, result);
3865 if (geometry & WidthValue)
3866 result = Fcons (Fcons (Qwidth, make_number (width)), result);
3867 if (geometry & HeightValue)
3868 result = Fcons (Fcons (Qheight, make_number (height)), result);
3870 return result;
3874 /* Calculate the desired size and position of frame F.
3875 Return the flags saying which aspects were specified.
3877 Also set the win_gravity and size_hint_flags of F.
3879 Adjust height for toolbar if TOOLBAR_P is 1.
3881 This function does not make the coordinates positive. */
3883 #define DEFAULT_ROWS 35
3884 #define DEFAULT_COLS 80
3887 x_figure_window_size (struct frame *f, Lisp_Object parms, int toolbar_p)
3889 register Lisp_Object tem0, tem1, tem2;
3890 long window_prompting = 0;
3891 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3893 /* Default values if we fall through.
3894 Actually, if that happens we should get
3895 window manager prompting. */
3896 SET_FRAME_COLS (f, DEFAULT_COLS);
3897 FRAME_LINES (f) = DEFAULT_ROWS;
3898 /* Window managers expect that if program-specified
3899 positions are not (0,0), they're intentional, not defaults. */
3900 f->top_pos = 0;
3901 f->left_pos = 0;
3903 /* Ensure that old new_text_cols and new_text_lines will not override the
3904 values set here. */
3905 /* ++KFS: This was specific to W32, but seems ok for all platforms */
3906 f->new_text_cols = f->new_text_lines = 0;
3908 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
3909 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
3910 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
3911 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3913 if (!EQ (tem0, Qunbound))
3915 CHECK_NUMBER (tem0);
3916 if (! (0 <= XINT (tem0) && XINT (tem0) <= INT_MAX))
3917 xsignal1 (Qargs_out_of_range, tem0);
3918 FRAME_LINES (f) = XINT (tem0);
3920 if (!EQ (tem1, Qunbound))
3922 CHECK_NUMBER (tem1);
3923 if (! (0 <= XINT (tem1) && XINT (tem1) <= INT_MAX))
3924 xsignal1 (Qargs_out_of_range, tem1);
3925 SET_FRAME_COLS (f, XINT (tem1));
3927 if (!NILP (tem2) && !EQ (tem2, Qunbound))
3928 window_prompting |= USSize;
3929 else
3930 window_prompting |= PSize;
3933 f->scroll_bar_actual_width
3934 = FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f);
3936 /* This used to be done _before_ calling x_figure_window_size, but
3937 since the height is reset here, this was really a no-op. I
3938 assume that moving it here does what Gerd intended (although he
3939 no longer can remember what that was... ++KFS, 2003-03-25. */
3941 /* Add the tool-bar height to the initial frame height so that the
3942 user gets a text display area of the size he specified with -g or
3943 via .Xdefaults. Later changes of the tool-bar height don't
3944 change the frame size. This is done so that users can create
3945 tall Emacs frames without having to guess how tall the tool-bar
3946 will get. */
3947 if (toolbar_p && FRAME_TOOL_BAR_LINES (f))
3949 int margin, relief, bar_height;
3951 relief = (tool_bar_button_relief >= 0
3952 ? tool_bar_button_relief
3953 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
3955 if (RANGED_INTEGERP (1, Vtool_bar_button_margin, INT_MAX))
3956 margin = XFASTINT (Vtool_bar_button_margin);
3957 else if (CONSP (Vtool_bar_button_margin)
3958 && RANGED_INTEGERP (1, XCDR (Vtool_bar_button_margin), INT_MAX))
3959 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
3960 else
3961 margin = 0;
3963 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
3964 FRAME_LINES (f) += (bar_height + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f);
3967 compute_fringe_widths (f, 0);
3969 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, FRAME_COLS (f));
3970 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, FRAME_LINES (f));
3972 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
3973 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
3974 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
3975 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3977 if (EQ (tem0, Qminus))
3979 f->top_pos = 0;
3980 window_prompting |= YNegative;
3982 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
3983 && CONSP (XCDR (tem0))
3984 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (tem0)), INT_MAX))
3986 f->top_pos = - XINT (XCAR (XCDR (tem0)));
3987 window_prompting |= YNegative;
3989 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
3990 && CONSP (XCDR (tem0))
3991 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (tem0))))
3993 f->top_pos = XINT (XCAR (XCDR (tem0)));
3995 else if (EQ (tem0, Qunbound))
3996 f->top_pos = 0;
3997 else
3999 CHECK_TYPE_RANGED_INTEGER (int, tem0);
4000 f->top_pos = XINT (tem0);
4001 if (f->top_pos < 0)
4002 window_prompting |= YNegative;
4005 if (EQ (tem1, Qminus))
4007 f->left_pos = 0;
4008 window_prompting |= XNegative;
4010 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
4011 && CONSP (XCDR (tem1))
4012 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (tem1)), INT_MAX))
4014 f->left_pos = - XINT (XCAR (XCDR (tem1)));
4015 window_prompting |= XNegative;
4017 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
4018 && CONSP (XCDR (tem1))
4019 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (tem1))))
4021 f->left_pos = XINT (XCAR (XCDR (tem1)));
4023 else if (EQ (tem1, Qunbound))
4024 f->left_pos = 0;
4025 else
4027 CHECK_TYPE_RANGED_INTEGER (int, tem1);
4028 f->left_pos = XINT (tem1);
4029 if (f->left_pos < 0)
4030 window_prompting |= XNegative;
4033 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
4034 window_prompting |= USPosition;
4035 else
4036 window_prompting |= PPosition;
4039 if (window_prompting & XNegative)
4041 if (window_prompting & YNegative)
4042 f->win_gravity = SouthEastGravity;
4043 else
4044 f->win_gravity = NorthEastGravity;
4046 else
4048 if (window_prompting & YNegative)
4049 f->win_gravity = SouthWestGravity;
4050 else
4051 f->win_gravity = NorthWestGravity;
4054 f->size_hint_flags = window_prompting;
4056 return window_prompting;
4061 #endif /* HAVE_WINDOW_SYSTEM */
4063 void
4064 frame_make_pointer_invisible (void)
4066 if (! NILP (Vmake_pointer_invisible))
4068 struct frame *f;
4069 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4070 return;
4072 f = SELECTED_FRAME ();
4073 if (f && !f->pointer_invisible
4074 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4076 f->mouse_moved = 0;
4077 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 1);
4078 f->pointer_invisible = 1;
4083 void
4084 frame_make_pointer_visible (void)
4086 /* We don't check Vmake_pointer_invisible here in case the
4087 pointer was invisible when Vmake_pointer_invisible was set to nil. */
4088 struct frame *f;
4090 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4091 return;
4093 f = SELECTED_FRAME ();
4094 if (f && f->pointer_invisible && f->mouse_moved
4095 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4097 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 0);
4098 f->pointer_invisible = 0;
4102 DEFUN ("frame-pointer-visible-p", Fframe_pointer_visible_p,
4103 Sframe_pointer_visible_p, 0, 1, 0,
4104 doc: /* Return t if the mouse pointer displayed on FRAME is visible.
4105 Otherwise it returns nil. FRAME omitted or nil means the
4106 selected frame. This is useful when `make-pointer-invisible' is set. */)
4107 (Lisp_Object frame)
4109 return decode_any_frame (frame)->pointer_invisible ? Qnil : Qt;
4113 /***********************************************************************
4114 Initialization
4115 ***********************************************************************/
4117 void
4118 syms_of_frame (void)
4120 DEFSYM (Qframep, "framep");
4121 DEFSYM (Qframe_live_p, "frame-live-p");
4122 DEFSYM (Qexplicit_name, "explicit-name");
4123 DEFSYM (Qheight, "height");
4124 DEFSYM (Qicon, "icon");
4125 DEFSYM (Qminibuffer, "minibuffer");
4126 DEFSYM (Qmodeline, "modeline");
4127 DEFSYM (Qonly, "only");
4128 DEFSYM (Qnone, "none");
4129 DEFSYM (Qwidth, "width");
4130 DEFSYM (Qgeometry, "geometry");
4131 DEFSYM (Qicon_left, "icon-left");
4132 DEFSYM (Qicon_top, "icon-top");
4133 DEFSYM (Qtooltip, "tooltip");
4134 DEFSYM (Qleft, "left");
4135 DEFSYM (Qright, "right");
4136 DEFSYM (Quser_position, "user-position");
4137 DEFSYM (Quser_size, "user-size");
4138 DEFSYM (Qwindow_id, "window-id");
4139 #ifdef HAVE_X_WINDOWS
4140 DEFSYM (Qouter_window_id, "outer-window-id");
4141 #endif
4142 DEFSYM (Qparent_id, "parent-id");
4143 DEFSYM (Qx, "x");
4144 DEFSYM (Qw32, "w32");
4145 DEFSYM (Qpc, "pc");
4146 DEFSYM (Qns, "ns");
4147 DEFSYM (Qvisible, "visible");
4148 DEFSYM (Qbuffer_predicate, "buffer-predicate");
4149 DEFSYM (Qbuffer_list, "buffer-list");
4150 DEFSYM (Qburied_buffer_list, "buried-buffer-list");
4151 DEFSYM (Qdisplay_type, "display-type");
4152 DEFSYM (Qbackground_mode, "background-mode");
4153 DEFSYM (Qnoelisp, "noelisp");
4154 DEFSYM (Qtty_color_mode, "tty-color-mode");
4155 DEFSYM (Qtty, "tty");
4156 DEFSYM (Qtty_type, "tty-type");
4158 DEFSYM (Qface_set_after_frame_default, "face-set-after-frame-default");
4160 DEFSYM (Qfullwidth, "fullwidth");
4161 DEFSYM (Qfullheight, "fullheight");
4162 DEFSYM (Qfullboth, "fullboth");
4163 DEFSYM (Qmaximized, "maximized");
4164 DEFSYM (Qx_resource_name, "x-resource-name");
4165 DEFSYM (Qx_frame_parameter, "x-frame-parameter");
4167 DEFSYM (Qterminal, "terminal");
4168 DEFSYM (Qterminal_live_p, "terminal-live-p");
4170 #ifdef HAVE_NS
4171 DEFSYM (Qns_parse_geometry, "ns-parse-geometry");
4172 #endif
4175 int i;
4177 for (i = 0; i < sizeof (frame_parms) / sizeof (frame_parms[0]); i++)
4179 Lisp_Object v = intern_c_string (frame_parms[i].name);
4180 if (frame_parms[i].variable)
4182 *frame_parms[i].variable = v;
4183 staticpro (frame_parms[i].variable);
4185 Fput (v, Qx_frame_parameter, make_number (i));
4189 #ifdef HAVE_WINDOW_SYSTEM
4190 DEFVAR_LISP ("x-resource-name", Vx_resource_name,
4191 doc: /* The name Emacs uses to look up X resources.
4192 `x-get-resource' uses this as the first component of the instance name
4193 when requesting resource values.
4194 Emacs initially sets `x-resource-name' to the name under which Emacs
4195 was invoked, or to the value specified with the `-name' or `-rn'
4196 switches, if present.
4198 It may be useful to bind this variable locally around a call
4199 to `x-get-resource'. See also the variable `x-resource-class'. */);
4200 Vx_resource_name = Qnil;
4202 DEFVAR_LISP ("x-resource-class", Vx_resource_class,
4203 doc: /* The class Emacs uses to look up X resources.
4204 `x-get-resource' uses this as the first component of the instance class
4205 when requesting resource values.
4207 Emacs initially sets `x-resource-class' to "Emacs".
4209 Setting this variable permanently is not a reasonable thing to do,
4210 but binding this variable locally around a call to `x-get-resource'
4211 is a reasonable practice. See also the variable `x-resource-name'. */);
4212 Vx_resource_class = build_string (EMACS_CLASS);
4214 DEFVAR_LISP ("frame-alpha-lower-limit", Vframe_alpha_lower_limit,
4215 doc: /* The lower limit of the frame opacity (alpha transparency).
4216 The value should range from 0 (invisible) to 100 (completely opaque).
4217 You can also use a floating number between 0.0 and 1.0.
4218 The default is 20. */);
4219 Vframe_alpha_lower_limit = make_number (20);
4220 #endif
4222 DEFVAR_LISP ("default-frame-alist", Vdefault_frame_alist,
4223 doc: /* Alist of default values for frame creation.
4224 These may be set in your init file, like this:
4225 (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1)))
4226 These override values given in window system configuration data,
4227 including X Windows' defaults database.
4228 For values specific to the first Emacs frame, see `initial-frame-alist'.
4229 For window-system specific values, see `window-system-default-frame-alist'.
4230 For values specific to the separate minibuffer frame, see
4231 `minibuffer-frame-alist'.
4232 The `menu-bar-lines' element of the list controls whether new frames
4233 have menu bars; `menu-bar-mode' works by altering this element.
4234 Setting this variable does not affect existing frames, only new ones. */);
4235 Vdefault_frame_alist = Qnil;
4237 DEFVAR_LISP ("default-frame-scroll-bars", Vdefault_frame_scroll_bars,
4238 doc: /* Default position of scroll bars on this window-system. */);
4239 #ifdef HAVE_WINDOW_SYSTEM
4240 #if defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA) || (defined (USE_GTK) && defined (USE_TOOLKIT_SCROLL_BARS))
4241 /* MS-Windows, Mac OS X, and GTK have scroll bars on the right by
4242 default. */
4243 Vdefault_frame_scroll_bars = Qright;
4244 #else
4245 Vdefault_frame_scroll_bars = Qleft;
4246 #endif
4247 #else
4248 Vdefault_frame_scroll_bars = Qnil;
4249 #endif
4251 DEFVAR_LISP ("terminal-frame", Vterminal_frame,
4252 doc: /* The initial frame-object, which represents Emacs's stdout. */);
4254 DEFVAR_LISP ("mouse-position-function", Vmouse_position_function,
4255 doc: /* If non-nil, function to transform normal value of `mouse-position'.
4256 `mouse-position' calls this function, passing its usual return value as
4257 argument, and returns whatever this function returns.
4258 This abnormal hook exists for the benefit of packages like `xt-mouse.el'
4259 which need to do mouse handling at the Lisp level. */);
4260 Vmouse_position_function = Qnil;
4262 DEFVAR_LISP ("mouse-highlight", Vmouse_highlight,
4263 doc: /* If non-nil, clickable text is highlighted when mouse is over it.
4264 If the value is an integer, highlighting is only shown after moving the
4265 mouse, while keyboard input turns off the highlight even when the mouse
4266 is over the clickable text. However, the mouse shape still indicates
4267 when the mouse is over clickable text. */);
4268 Vmouse_highlight = Qt;
4270 DEFVAR_LISP ("make-pointer-invisible", Vmake_pointer_invisible,
4271 doc: /* If non-nil, make pointer invisible while typing.
4272 The pointer becomes visible again when the mouse is moved. */);
4273 Vmake_pointer_invisible = Qt;
4275 DEFVAR_LISP ("delete-frame-functions", Vdelete_frame_functions,
4276 doc: /* Functions run before deleting a frame.
4277 The functions are run with one arg, the frame to be deleted.
4278 See `delete-frame'.
4280 Note that functions in this list may be called just before the frame is
4281 actually deleted, or some time later (or even both when an earlier function
4282 in `delete-frame-functions' (indirectly) calls `delete-frame'
4283 recursively). */);
4284 Vdelete_frame_functions = Qnil;
4285 DEFSYM (Qdelete_frame_functions, "delete-frame-functions");
4287 DEFVAR_LISP ("menu-bar-mode", Vmenu_bar_mode,
4288 doc: /* Non-nil if Menu-Bar mode is enabled.
4289 See the command `menu-bar-mode' for a description of this minor mode.
4290 Setting this variable directly does not take effect;
4291 either customize it (see the info node `Easy Customization')
4292 or call the function `menu-bar-mode'. */);
4293 Vmenu_bar_mode = Qt;
4295 DEFVAR_LISP ("tool-bar-mode", Vtool_bar_mode,
4296 doc: /* Non-nil if Tool-Bar mode is enabled.
4297 See the command `tool-bar-mode' for a description of this minor mode.
4298 Setting this variable directly does not take effect;
4299 either customize it (see the info node `Easy Customization')
4300 or call the function `tool-bar-mode'. */);
4301 #ifdef HAVE_WINDOW_SYSTEM
4302 Vtool_bar_mode = Qt;
4303 #else
4304 Vtool_bar_mode = Qnil;
4305 #endif
4307 DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
4308 doc: /* Minibufferless frames use this frame's minibuffer.
4310 Emacs cannot create minibufferless frames unless this is set to an
4311 appropriate surrogate.
4313 Emacs consults this variable only when creating minibufferless
4314 frames; once the frame is created, it sticks with its assigned
4315 minibuffer, no matter what this variable is set to. This means that
4316 this variable doesn't necessarily say anything meaningful about the
4317 current set of frames, or where the minibuffer is currently being
4318 displayed.
4320 This variable is local to the current terminal and cannot be buffer-local. */);
4322 DEFVAR_BOOL ("focus-follows-mouse", focus_follows_mouse,
4323 doc: /* Non-nil if window system changes focus when you move the mouse.
4324 You should set this variable to tell Emacs how your window manager
4325 handles focus, since there is no way in general for Emacs to find out
4326 automatically. See also `mouse-autoselect-window'. */);
4327 focus_follows_mouse = 0;
4329 staticpro (&Vframe_list);
4331 defsubr (&Sframep);
4332 defsubr (&Sframe_live_p);
4333 defsubr (&Swindow_system);
4334 defsubr (&Smake_terminal_frame);
4335 defsubr (&Shandle_switch_frame);
4336 defsubr (&Sselect_frame);
4337 defsubr (&Sselected_frame);
4338 defsubr (&Sframe_list);
4339 defsubr (&Snext_frame);
4340 defsubr (&Sprevious_frame);
4341 defsubr (&Sdelete_frame);
4342 defsubr (&Smouse_position);
4343 defsubr (&Smouse_pixel_position);
4344 defsubr (&Sset_mouse_position);
4345 defsubr (&Sset_mouse_pixel_position);
4346 #if 0
4347 defsubr (&Sframe_configuration);
4348 defsubr (&Srestore_frame_configuration);
4349 #endif
4350 defsubr (&Smake_frame_visible);
4351 defsubr (&Smake_frame_invisible);
4352 defsubr (&Siconify_frame);
4353 defsubr (&Sframe_visible_p);
4354 defsubr (&Svisible_frame_list);
4355 defsubr (&Sraise_frame);
4356 defsubr (&Slower_frame);
4357 defsubr (&Sredirect_frame_focus);
4358 defsubr (&Sframe_focus);
4359 defsubr (&Sframe_parameters);
4360 defsubr (&Sframe_parameter);
4361 defsubr (&Smodify_frame_parameters);
4362 defsubr (&Sframe_char_height);
4363 defsubr (&Sframe_char_width);
4364 defsubr (&Sframe_pixel_height);
4365 defsubr (&Sframe_pixel_width);
4366 defsubr (&Stool_bar_pixel_width);
4367 defsubr (&Sset_frame_height);
4368 defsubr (&Sset_frame_width);
4369 defsubr (&Sset_frame_size);
4370 defsubr (&Sset_frame_position);
4371 defsubr (&Sframe_pointer_visible_p);
4373 #ifdef HAVE_WINDOW_SYSTEM
4374 defsubr (&Sx_get_resource);
4375 defsubr (&Sx_parse_geometry);
4376 #endif