* todo-mode.el: Offer to convert legacy file. Update commentary.
[emacs.git] / src / frame.c
bloba207ef690da63f04c65dd139a8430d68202e48f1
1 /* Generic frame functions.
3 Copyright (C) 1993-1995, 1997, 1999-2013 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, 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 Lisp_Object Qheight, Qwidth;
80 Lisp_Object Qleft, Qright;
81 Lisp_Object Qicon_left, Qicon_top, Qicon_type, Qicon_name;
82 Lisp_Object Qtooltip;
83 Lisp_Object Qinternal_border_width;
84 Lisp_Object Qmouse_color;
85 Lisp_Object Qminibuffer;
86 Lisp_Object Qscroll_bar_width, Qvertical_scroll_bars;
87 Lisp_Object Qvisibility;
88 Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
89 Lisp_Object Qscreen_gamma;
90 Lisp_Object Qline_spacing;
91 static Lisp_Object Quser_position, Quser_size;
92 Lisp_Object Qwait_for_wm;
93 static Lisp_Object Qwindow_id;
94 #ifdef HAVE_X_WINDOWS
95 static Lisp_Object Qouter_window_id;
96 #endif
97 Lisp_Object Qparent_id;
98 Lisp_Object Qtitle, Qname;
99 static Lisp_Object Qexplicit_name;
100 Lisp_Object Qunsplittable;
101 Lisp_Object Qmenu_bar_lines, Qtool_bar_lines, Qtool_bar_position;
102 Lisp_Object Qleft_fringe, Qright_fringe;
103 Lisp_Object Qbuffer_predicate;
104 static Lisp_Object Qbuffer_list, Qburied_buffer_list;
105 Lisp_Object Qtty_color_mode;
106 Lisp_Object Qtty, Qtty_type;
108 Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth, Qmaximized;
109 Lisp_Object Qsticky;
110 Lisp_Object Qfont_backend;
111 Lisp_Object Qalpha;
113 Lisp_Object Qface_set_after_frame_default;
115 static Lisp_Object Qdelete_frame_functions;
117 static Lisp_Object Qgeometry, Qworkarea, Qmm_size, Qframes, Qsource;
119 #ifdef HAVE_WINDOW_SYSTEM
120 static void x_report_frame_params (struct frame *, Lisp_Object *);
121 #endif
123 /* These setters are used only in this file, so they can be private. */
124 static void
125 fset_buffer_predicate (struct frame *f, Lisp_Object val)
127 f->buffer_predicate = val;
129 static void
130 fset_minibuffer_window (struct frame *f, Lisp_Object val)
132 f->minibuffer_window = val;
135 struct frame *
136 decode_live_frame (register Lisp_Object frame)
138 if (NILP (frame))
139 frame = selected_frame;
140 CHECK_LIVE_FRAME (frame);
141 return XFRAME (frame);
144 struct frame *
145 decode_any_frame (register Lisp_Object frame)
147 if (NILP (frame))
148 frame = selected_frame;
149 CHECK_FRAME (frame);
150 return XFRAME (frame);
153 bool
154 window_system_available (struct frame *f)
156 if (f)
157 return FRAME_WINDOW_P (f) || FRAME_MSDOS_P (f);
158 else
159 #ifdef HAVE_WINDOW_SYSTEM
160 return x_display_list != NULL;
161 #else
162 return 0;
163 #endif
166 struct frame *
167 decode_window_system_frame (Lisp_Object frame)
169 struct frame *f = decode_live_frame (frame);
171 if (!window_system_available (f))
172 error ("Window system frame should be used");
173 return f;
176 void
177 check_window_system (struct frame *f)
179 if (!window_system_available (f))
180 error (f ? "Window system frame should be used"
181 : "Window system is not in use or not initialized");
184 static void
185 set_menu_bar_lines_1 (Lisp_Object window, int n)
187 struct window *w = XWINDOW (window);
189 w->last_modified = 0;
190 w->top_line += n;
191 w->total_lines -= n;
193 /* Handle just the top child in a vertical split. */
194 if (WINDOW_VERTICAL_COMBINATION_P (w))
195 set_menu_bar_lines_1 (w->contents, n);
196 else if (WINDOW_HORIZONTAL_COMBINATION_P (w))
197 /* Adjust all children in a horizontal split. */
198 for (window = w->contents; !NILP (window); window = w->next)
200 w = XWINDOW (window);
201 set_menu_bar_lines_1 (window, n);
205 void
206 set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
208 int nlines;
209 int olines = FRAME_MENU_BAR_LINES (f);
211 /* Right now, menu bars don't work properly in minibuf-only frames;
212 most of the commands try to apply themselves to the minibuffer
213 frame itself, and get an error because you can't switch buffers
214 in or split the minibuffer window. */
215 if (FRAME_MINIBUF_ONLY_P (f))
216 return;
218 if (TYPE_RANGED_INTEGERP (int, value))
219 nlines = XINT (value);
220 else
221 nlines = 0;
223 if (nlines != olines)
225 windows_or_buffers_changed++;
226 FRAME_WINDOW_SIZES_CHANGED (f) = 1;
227 FRAME_MENU_BAR_LINES (f) = nlines;
228 set_menu_bar_lines_1 (f->root_window, nlines - olines);
229 adjust_glyphs (f);
233 Lisp_Object Vframe_list;
236 DEFUN ("framep", Fframep, Sframep, 1, 1, 0,
237 doc: /* Return non-nil if OBJECT is a frame.
238 Value is:
239 t for a termcap frame (a character-only terminal),
240 'x' for an Emacs frame that is really an X window,
241 'w32' for an Emacs frame that is a window on MS-Windows display,
242 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
243 'pc' for a direct-write MS-DOS frame.
244 See also `frame-live-p'. */)
245 (Lisp_Object object)
247 if (!FRAMEP (object))
248 return Qnil;
249 switch (XFRAME (object)->output_method)
251 case output_initial: /* The initial frame is like a termcap frame. */
252 case output_termcap:
253 return Qt;
254 case output_x_window:
255 return Qx;
256 case output_w32:
257 return Qw32;
258 case output_msdos_raw:
259 return Qpc;
260 case output_ns:
261 return Qns;
262 default:
263 emacs_abort ();
267 DEFUN ("frame-live-p", Fframe_live_p, Sframe_live_p, 1, 1, 0,
268 doc: /* Return non-nil if OBJECT is a frame which has not been deleted.
269 Value is nil if OBJECT is not a live frame. If object is a live
270 frame, the return value indicates what sort of terminal device it is
271 displayed on. See the documentation of `framep' for possible
272 return values. */)
273 (Lisp_Object object)
275 return ((FRAMEP (object)
276 && FRAME_LIVE_P (XFRAME (object)))
277 ? Fframep (object)
278 : Qnil);
281 DEFUN ("window-system", Fwindow_system, Swindow_system, 0, 1, 0,
282 doc: /* The name of the window system that FRAME is displaying through.
283 The value is a symbol:
284 nil for a termcap frame (a character-only terminal),
285 'x' for an Emacs frame that is really an X window,
286 'w32' for an Emacs frame that is a window on MS-Windows display,
287 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
288 'pc' for a direct-write MS-DOS frame.
290 FRAME defaults to the currently selected frame.
292 Use of this function as a predicate is deprecated. Instead,
293 use `display-graphic-p' or any of the other `display-*-p'
294 predicates which report frame's specific UI-related capabilities. */)
295 (Lisp_Object frame)
297 Lisp_Object type;
298 if (NILP (frame))
299 frame = selected_frame;
301 type = Fframep (frame);
303 if (NILP (type))
304 wrong_type_argument (Qframep, frame);
306 if (EQ (type, Qt))
307 return Qnil;
308 else
309 return type;
312 struct frame *
313 make_frame (int mini_p)
315 Lisp_Object frame;
316 register struct frame *f;
317 register Lisp_Object root_window;
318 register Lisp_Object mini_window;
320 f = allocate_frame ();
321 XSETFRAME (frame, f);
323 /* Initialize Lisp data. Note that allocate_frame initializes all
324 Lisp data to nil, so do it only for slots which should not be nil. */
325 fset_tool_bar_position (f, Qtop);
327 /* Initialize non-Lisp data. Note that allocate_frame zeroes out all
328 non-Lisp data, so do it only for slots which should not be zero.
329 To avoid subtle bugs and for the sake of readability, it's better to
330 initialize enum members explicitly even if their values are zero. */
331 f->wants_modeline = 1;
332 f->garbaged = 1;
333 f->has_minibuffer = mini_p;
334 f->vertical_scroll_bar_type = vertical_scroll_bar_none;
335 f->column_width = 1; /* !FRAME_WINDOW_P value */
336 f->line_height = 1; /* !FRAME_WINDOW_P value */
337 #ifdef HAVE_WINDOW_SYSTEM
338 f->want_fullscreen = FULLSCREEN_NONE;
339 #endif
341 root_window = make_window ();
342 if (mini_p)
344 mini_window = make_window ();
345 wset_next (XWINDOW (root_window), mini_window);
346 wset_prev (XWINDOW (mini_window), root_window);
347 XWINDOW (mini_window)->mini = 1;
348 wset_frame (XWINDOW (mini_window), frame);
349 fset_minibuffer_window (f, mini_window);
351 else
353 mini_window = Qnil;
354 wset_next (XWINDOW (root_window), Qnil);
355 fset_minibuffer_window (f, Qnil);
358 wset_frame (XWINDOW (root_window), frame);
360 /* 10 is arbitrary,
361 just so that there is "something there."
362 Correct size will be set up later with change_frame_size. */
364 SET_FRAME_COLS (f, 10);
365 FRAME_LINES (f) = 10;
367 XWINDOW (root_window)->total_cols = 10;
368 XWINDOW (root_window)->total_lines = mini_p ? 9 : 10;
370 if (mini_p)
372 XWINDOW (mini_window)->total_cols = 10;
373 XWINDOW (mini_window)->top_line = 9;
374 XWINDOW (mini_window)->total_lines = 1;
377 /* Choose a buffer for the frame's root window. */
379 Lisp_Object buf = Fcurrent_buffer ();
381 /* If current buffer is hidden, try to find another one. */
382 if (BUFFER_HIDDEN_P (XBUFFER (buf)))
383 buf = other_buffer_safely (buf);
385 /* Use set_window_buffer, not Fset_window_buffer, and don't let
386 hooks be run by it. The reason is that the whole frame/window
387 arrangement is not yet fully initialized at this point. Windows
388 don't have the right size, glyph matrices aren't initialized
389 etc. Running Lisp functions at this point surely ends in a
390 SEGV. */
391 set_window_buffer (root_window, buf, 0, 0);
392 fset_buffer_list (f, Fcons (buf, Qnil));
395 if (mini_p)
396 set_window_buffer (mini_window,
397 (NILP (Vminibuffer_list)
398 ? get_minibuffer (0)
399 : Fcar (Vminibuffer_list)),
400 0, 0);
402 fset_root_window (f, root_window);
403 fset_selected_window (f, root_window);
404 /* Make sure this window seems more recently used than
405 a newly-created, never-selected window. */
406 XWINDOW (f->selected_window)->use_time = ++window_select_count;
408 return f;
411 #ifdef HAVE_WINDOW_SYSTEM
412 /* Make a frame using a separate minibuffer window on another frame.
413 MINI_WINDOW is the minibuffer window to use. nil means use the
414 default (the global minibuffer). */
416 struct frame *
417 make_frame_without_minibuffer (register Lisp_Object mini_window, KBOARD *kb, Lisp_Object display)
419 register struct frame *f;
420 struct gcpro gcpro1;
422 if (!NILP (mini_window))
423 CHECK_LIVE_WINDOW (mini_window);
425 if (!NILP (mini_window)
426 && FRAME_KBOARD (XFRAME (XWINDOW (mini_window)->frame)) != kb)
427 error ("Frame and minibuffer must be on the same terminal");
429 /* Make a frame containing just a root window. */
430 f = make_frame (0);
432 if (NILP (mini_window))
434 /* Use default-minibuffer-frame if possible. */
435 if (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
436 || ! FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))
438 Lisp_Object frame_dummy;
440 XSETFRAME (frame_dummy, f);
441 GCPRO1 (frame_dummy);
442 /* If there's no minibuffer frame to use, create one. */
443 kset_default_minibuffer_frame
444 (kb, call1 (intern ("make-initial-minibuffer-frame"), display));
445 UNGCPRO;
448 mini_window
449 = XFRAME (KVAR (kb, Vdefault_minibuffer_frame))->minibuffer_window;
452 fset_minibuffer_window (f, mini_window);
454 /* Make the chosen minibuffer window display the proper minibuffer,
455 unless it is already showing a minibuffer. */
456 if (NILP (Fmemq (XWINDOW (mini_window)->contents, Vminibuffer_list)))
457 /* Use set_window_buffer instead of Fset_window_buffer (see
458 discussion of bug#11984, bug#12025, bug#12026). */
459 set_window_buffer (mini_window,
460 (NILP (Vminibuffer_list)
461 ? get_minibuffer (0)
462 : Fcar (Vminibuffer_list)), 0, 0);
463 return f;
466 /* Make a frame containing only a minibuffer window. */
468 struct frame *
469 make_minibuffer_frame (void)
471 /* First make a frame containing just a root window, no minibuffer. */
473 register struct frame *f = make_frame (0);
474 register Lisp_Object mini_window;
475 register Lisp_Object frame;
477 XSETFRAME (frame, f);
479 f->auto_raise = 0;
480 f->auto_lower = 0;
481 f->no_split = 1;
482 f->wants_modeline = 0;
483 f->has_minibuffer = 1;
485 /* Now label the root window as also being the minibuffer.
486 Avoid infinite looping on the window chain by marking next pointer
487 as nil. */
489 mini_window = f->root_window;
490 fset_minibuffer_window (f, mini_window);
491 XWINDOW (mini_window)->mini = 1;
492 wset_next (XWINDOW (mini_window), Qnil);
493 wset_prev (XWINDOW (mini_window), Qnil);
494 wset_frame (XWINDOW (mini_window), frame);
496 /* Put the proper buffer in that window. */
498 /* Use set_window_buffer instead of Fset_window_buffer (see
499 discussion of bug#11984, bug#12025, bug#12026). */
500 set_window_buffer (mini_window,
501 (NILP (Vminibuffer_list)
502 ? get_minibuffer (0)
503 : Fcar (Vminibuffer_list)), 0, 0);
504 return f;
506 #endif /* HAVE_WINDOW_SYSTEM */
508 /* Construct a frame that refers to a terminal. */
510 static printmax_t tty_frame_count;
512 struct frame *
513 make_initial_frame (void)
515 struct frame *f;
516 struct terminal *terminal;
517 Lisp_Object frame;
519 eassert (initial_kboard);
521 /* The first call must initialize Vframe_list. */
522 if (! (NILP (Vframe_list) || CONSP (Vframe_list)))
523 Vframe_list = Qnil;
525 terminal = init_initial_terminal ();
527 f = make_frame (1);
528 XSETFRAME (frame, f);
530 Vframe_list = Fcons (frame, Vframe_list);
532 tty_frame_count = 1;
533 fset_name (f, build_pure_c_string ("F1"));
535 SET_FRAME_VISIBLE (f, 1);
537 f->output_method = terminal->type;
538 f->terminal = terminal;
539 f->terminal->reference_count++;
540 f->output_data.nothing = 0;
542 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
543 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
545 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
547 /* The default value of menu-bar-mode is t. */
548 set_menu_bar_lines (f, make_number (1), Qnil);
550 if (!noninteractive)
551 init_frame_faces (f);
553 return f;
557 static struct frame *
558 make_terminal_frame (struct terminal *terminal)
560 register struct frame *f;
561 Lisp_Object frame;
562 char name[sizeof "F" + INT_STRLEN_BOUND (printmax_t)];
564 if (!terminal->name)
565 error ("Terminal is not live, can't create new frames on it");
567 f = make_frame (1);
569 XSETFRAME (frame, f);
570 Vframe_list = Fcons (frame, Vframe_list);
572 fset_name (f, make_formatted_string (name, "F%"pMd, ++tty_frame_count));
574 SET_FRAME_VISIBLE (f, 1);
576 f->terminal = terminal;
577 f->terminal->reference_count++;
578 #ifdef MSDOS
579 f->output_data.tty->display_info = &the_only_display_info;
580 if (!inhibit_window_system
581 && (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame))
582 || XFRAME (selected_frame)->output_method == output_msdos_raw))
583 f->output_method = output_msdos_raw;
584 else
585 f->output_method = output_termcap;
586 #else /* not MSDOS */
587 f->output_method = output_termcap;
588 create_tty_output (f);
589 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
590 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
591 #endif /* not MSDOS */
593 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
594 FRAME_MENU_BAR_LINES(f) = NILP (Vmenu_bar_mode) ? 0 : 1;
596 /* Set the top frame to the newly created frame. */
597 if (FRAMEP (FRAME_TTY (f)->top_frame)
598 && FRAME_LIVE_P (XFRAME (FRAME_TTY (f)->top_frame)))
599 SET_FRAME_VISIBLE (XFRAME (FRAME_TTY (f)->top_frame), 2); /* obscured */
601 FRAME_TTY (f)->top_frame = frame;
603 if (!noninteractive)
604 init_frame_faces (f);
606 return f;
609 /* Get a suitable value for frame parameter PARAMETER for a newly
610 created frame, based on (1) the user-supplied frame parameter
611 alist SUPPLIED_PARMS, and (2) CURRENT_VALUE. */
613 static Lisp_Object
614 get_future_frame_param (Lisp_Object parameter,
615 Lisp_Object supplied_parms,
616 char *current_value)
618 Lisp_Object result;
620 result = Fassq (parameter, supplied_parms);
621 if (NILP (result))
622 result = Fassq (parameter, XFRAME (selected_frame)->param_alist);
623 if (NILP (result) && current_value != NULL)
624 result = build_string (current_value);
625 if (!NILP (result) && !STRINGP (result))
626 result = XCDR (result);
627 if (NILP (result) || !STRINGP (result))
628 result = Qnil;
630 return result;
633 DEFUN ("make-terminal-frame", Fmake_terminal_frame, Smake_terminal_frame,
634 1, 1, 0,
635 doc: /* Create an additional terminal frame, possibly on another terminal.
636 This function takes one argument, an alist specifying frame parameters.
638 You can create multiple frames on a single text terminal, but only one
639 of them (the selected terminal frame) is actually displayed.
641 In practice, generally you don't need to specify any parameters,
642 except when you want to create a new frame on another terminal.
643 In that case, the `tty' parameter specifies the device file to open,
644 and the `tty-type' parameter specifies the terminal type. Example:
646 (make-terminal-frame '((tty . "/dev/pts/5") (tty-type . "xterm")))
648 Note that changing the size of one terminal frame automatically
649 affects all frames on the same terminal device. */)
650 (Lisp_Object parms)
652 struct frame *f;
653 struct terminal *t = NULL;
654 Lisp_Object frame, tem;
655 struct frame *sf = SELECTED_FRAME ();
657 #ifdef MSDOS
658 if (sf->output_method != output_msdos_raw
659 && sf->output_method != output_termcap)
660 emacs_abort ();
661 #else /* not MSDOS */
663 #ifdef WINDOWSNT /* This should work now! */
664 if (sf->output_method != output_termcap)
665 error ("Not using an ASCII terminal now; cannot make a new ASCII frame");
666 #endif
667 #endif /* not MSDOS */
670 Lisp_Object terminal;
672 terminal = Fassq (Qterminal, parms);
673 if (CONSP (terminal))
675 terminal = XCDR (terminal);
676 t = get_terminal (terminal, 1);
678 #ifdef MSDOS
679 if (t && t != the_only_display_info.terminal)
680 /* msdos.c assumes a single tty_display_info object. */
681 error ("Multiple terminals are not supported on this platform");
682 if (!t)
683 t = the_only_display_info.terminal;
684 #endif
687 if (!t)
689 char *name = 0, *type = 0;
690 Lisp_Object tty, tty_type;
692 tty = get_future_frame_param
693 (Qtty, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
694 ? FRAME_TTY (XFRAME (selected_frame))->name
695 : NULL));
696 if (!NILP (tty))
698 name = alloca (SBYTES (tty) + 1);
699 memcpy (name, SSDATA (tty), SBYTES (tty));
700 name[SBYTES (tty)] = 0;
703 tty_type = get_future_frame_param
704 (Qtty_type, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
705 ? FRAME_TTY (XFRAME (selected_frame))->type
706 : NULL));
707 if (!NILP (tty_type))
709 type = alloca (SBYTES (tty_type) + 1);
710 memcpy (type, SSDATA (tty_type), SBYTES (tty_type));
711 type[SBYTES (tty_type)] = 0;
714 t = init_tty (name, type, 0); /* Errors are not fatal. */
717 f = make_terminal_frame (t);
720 int width, height;
721 get_tty_size (fileno (FRAME_TTY (f)->input), &width, &height);
722 change_frame_size (f, height, width, 0, 0, 0);
725 adjust_glyphs (f);
726 calculate_costs (f);
727 XSETFRAME (frame, f);
728 Fmodify_frame_parameters (frame, parms);
729 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty_type,
730 build_string (t->display_info.tty->type)),
731 Qnil));
732 if (t->display_info.tty->name != NULL)
733 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty,
734 build_string (t->display_info.tty->name)),
735 Qnil));
736 else
737 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty, Qnil), Qnil));
739 /* Make the frame face alist be frame-specific, so that each
740 frame could change its face definitions independently. */
741 fset_face_alist (f, Fcopy_alist (sf->face_alist));
742 /* Simple Fcopy_alist isn't enough, because we need the contents of
743 the vectors which are the CDRs of associations in face_alist to
744 be copied as well. */
745 for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem))
746 XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem))));
747 return frame;
751 /* Perform the switch to frame FRAME.
753 If FRAME is a switch-frame event `(switch-frame FRAME1)', use
754 FRAME1 as frame.
756 If TRACK is non-zero and the frame that currently has the focus
757 redirects its focus to the selected frame, redirect that focused
758 frame's focus to FRAME instead.
760 FOR_DELETION non-zero means that the selected frame is being
761 deleted, which includes the possibility that the frame's terminal
762 is dead.
764 The value of NORECORD is passed as argument to Fselect_window. */
766 Lisp_Object
767 do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object norecord)
769 struct frame *sf = SELECTED_FRAME ();
771 /* If FRAME is a switch-frame event, extract the frame we should
772 switch to. */
773 if (CONSP (frame)
774 && EQ (XCAR (frame), Qswitch_frame)
775 && CONSP (XCDR (frame)))
776 frame = XCAR (XCDR (frame));
778 /* This used to say CHECK_LIVE_FRAME, but apparently it's possible for
779 a switch-frame event to arrive after a frame is no longer live,
780 especially when deleting the initial frame during startup. */
781 CHECK_FRAME (frame);
782 if (! FRAME_LIVE_P (XFRAME (frame)))
783 return Qnil;
785 if (sf == XFRAME (frame))
786 return frame;
788 /* This is too greedy; it causes inappropriate focus redirection
789 that's hard to get rid of. */
790 #if 0
791 /* If a frame's focus has been redirected toward the currently
792 selected frame, we should change the redirection to point to the
793 newly selected frame. This means that if the focus is redirected
794 from a minibufferless frame to a surrogate minibuffer frame, we
795 can use `other-window' to switch between all the frames using
796 that minibuffer frame, and the focus redirection will follow us
797 around. */
798 if (track)
800 Lisp_Object tail;
802 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
804 Lisp_Object focus;
806 if (!FRAMEP (XCAR (tail)))
807 emacs_abort ();
809 focus = FRAME_FOCUS_FRAME (XFRAME (XCAR (tail)));
811 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
812 Fredirect_frame_focus (XCAR (tail), frame);
815 #else /* ! 0 */
816 /* Instead, apply it only to the frame we're pointing to. */
817 #ifdef HAVE_WINDOW_SYSTEM
818 if (track && FRAME_WINDOW_P (XFRAME (frame)))
820 Lisp_Object focus, xfocus;
822 xfocus = x_get_focus_frame (XFRAME (frame));
823 if (FRAMEP (xfocus))
825 focus = FRAME_FOCUS_FRAME (XFRAME (xfocus));
826 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
827 Fredirect_frame_focus (xfocus, frame);
830 #endif /* HAVE_X_WINDOWS */
831 #endif /* ! 0 */
833 if (!for_deletion && FRAME_HAS_MINIBUF_P (sf))
834 resize_mini_window (XWINDOW (FRAME_MINIBUF_WINDOW (sf)), 1);
836 if (FRAME_TERMCAP_P (XFRAME (frame)) || FRAME_MSDOS_P (XFRAME (frame)))
838 Lisp_Object top_frame = FRAME_TTY (XFRAME (frame))->top_frame;
840 /* Don't mark the frame garbaged and/or obscured if we are
841 switching to the frame that is already the top frame of that
842 TTY. */
843 if (!EQ (frame, top_frame))
845 if (FRAMEP (top_frame))
846 /* Mark previously displayed frame as now obscured. */
847 SET_FRAME_VISIBLE (XFRAME (top_frame), 2);
848 SET_FRAME_VISIBLE (XFRAME (frame), 1);
850 FRAME_TTY (XFRAME (frame))->top_frame = frame;
853 selected_frame = frame;
854 if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
855 last_nonminibuf_frame = XFRAME (selected_frame);
857 Fselect_window (XFRAME (frame)->selected_window, norecord);
859 /* We want to make sure that the next event generates a frame-switch
860 event to the appropriate frame. This seems kludgy to me, but
861 before you take it out, make sure that evaluating something like
862 (select-window (frame-root-window (new-frame))) doesn't end up
863 with your typing being interpreted in the new frame instead of
864 the one you're actually typing in. */
865 internal_last_event_frame = Qnil;
867 return frame;
870 DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 2, "e",
871 doc: /* Select FRAME.
872 Subsequent editing commands apply to its selected window.
873 Optional argument NORECORD means to neither change the order of
874 recently selected windows nor the buffer list.
876 The selection of FRAME lasts until the next time the user does
877 something to select a different frame, or until the next time
878 this function is called. If you are using a window system, the
879 previously selected frame may be restored as the selected frame
880 when returning to the command loop, because it still may have
881 the window system's input focus. On a text terminal, the next
882 redisplay will display FRAME.
884 This function returns FRAME, or nil if FRAME has been deleted. */)
885 (Lisp_Object frame, Lisp_Object norecord)
887 return do_switch_frame (frame, 1, 0, norecord);
891 DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 1, "e",
892 doc: /* Handle a switch-frame event EVENT.
893 Switch-frame events are usually bound to this function.
894 A switch-frame event tells Emacs that the window manager has requested
895 that the user's events be directed to the frame mentioned in the event.
896 This function selects the selected window of the frame of EVENT.
898 If EVENT is frame object, handle it as if it were a switch-frame event
899 to that frame. */)
900 (Lisp_Object event)
902 /* Preserve prefix arg that the command loop just cleared. */
903 kset_prefix_arg (current_kboard, Vcurrent_prefix_arg);
904 Frun_hooks (1, &Qmouse_leave_buffer_hook);
905 return do_switch_frame (event, 0, 0, Qnil);
908 DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0,
909 doc: /* Return the frame that is now selected. */)
910 (void)
912 return selected_frame;
915 DEFUN ("frame-list", Fframe_list, Sframe_list,
916 0, 0, 0,
917 doc: /* Return a list of all live frames. */)
918 (void)
920 Lisp_Object frames;
921 frames = Fcopy_sequence (Vframe_list);
922 #ifdef HAVE_WINDOW_SYSTEM
923 if (FRAMEP (tip_frame))
924 frames = Fdelq (tip_frame, frames);
925 #endif
926 return frames;
929 /* Return CANDIDATE if it can be used as 'other-than-FRAME' frame on the
930 same tty (for tty frames) or among frames which uses FRAME's keyboard.
931 If MINIBUF is nil, do not consider minibuffer-only candidate.
932 If MINIBUF is `visible', do not consider an invisible candidate.
933 If MINIBUF is a window, consider only its own frame and candidate now
934 using that window as the minibuffer.
935 If MINIBUF is 0, consider candidate if it is visible or iconified.
936 Otherwise consider any candidate and return nil if CANDIDATE is not
937 acceptable. */
939 static Lisp_Object
940 candidate_frame (Lisp_Object candidate, Lisp_Object frame, Lisp_Object minibuf)
942 struct frame *c = XFRAME (candidate), *f = XFRAME (frame);
944 if ((!FRAME_TERMCAP_P (c) && !FRAME_TERMCAP_P (f)
945 && FRAME_KBOARD (c) == FRAME_KBOARD (f))
946 || (FRAME_TERMCAP_P (c) && FRAME_TERMCAP_P (f)
947 && FRAME_TTY (c) == FRAME_TTY (f)))
949 if (NILP (minibuf))
951 if (!FRAME_MINIBUF_ONLY_P (c))
952 return candidate;
954 else if (EQ (minibuf, Qvisible))
956 if (FRAME_VISIBLE_P (c))
957 return candidate;
959 else if (WINDOWP (minibuf))
961 if (EQ (FRAME_MINIBUF_WINDOW (c), minibuf)
962 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), candidate)
963 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
964 FRAME_FOCUS_FRAME (c)))
965 return candidate;
967 else if (XFASTINT (minibuf) == 0)
969 if (FRAME_VISIBLE_P (c) || FRAME_ICONIFIED_P (c))
970 return candidate;
972 else
973 return candidate;
975 return Qnil;
978 /* Return the next frame in the frame list after FRAME. */
980 static Lisp_Object
981 next_frame (Lisp_Object frame, Lisp_Object minibuf)
983 Lisp_Object f, tail;
984 int passed = 0;
986 /* There must always be at least one frame in Vframe_list. */
987 eassert (CONSP (Vframe_list));
989 while (passed < 2)
990 FOR_EACH_FRAME (tail, f)
992 if (passed)
994 f = candidate_frame (f, frame, minibuf);
995 if (!NILP (f))
996 return f;
998 if (EQ (frame, f))
999 passed++;
1001 return frame;
1004 /* Return the previous frame in the frame list before FRAME. */
1006 static Lisp_Object
1007 prev_frame (Lisp_Object frame, Lisp_Object minibuf)
1009 Lisp_Object f, tail, prev = Qnil;
1011 /* There must always be at least one frame in Vframe_list. */
1012 eassert (CONSP (Vframe_list));
1014 FOR_EACH_FRAME (tail, f)
1016 if (EQ (frame, f) && !NILP (prev))
1017 return prev;
1018 f = candidate_frame (f, frame, minibuf);
1019 if (!NILP (f))
1020 prev = f;
1023 /* We've scanned the entire list. */
1024 if (NILP (prev))
1025 /* We went through the whole frame list without finding a single
1026 acceptable frame. Return the original frame. */
1027 return frame;
1028 else
1029 /* There were no acceptable frames in the list before FRAME; otherwise,
1030 we would have returned directly from the loop. Since PREV is the last
1031 acceptable frame in the list, return it. */
1032 return prev;
1036 DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0,
1037 doc: /* Return the next frame in the frame list after FRAME.
1038 It considers only frames on the same terminal as FRAME.
1039 By default, skip minibuffer-only frames.
1040 If omitted, FRAME defaults to the selected frame.
1041 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1042 If MINIFRAME is a window, include only its own frame
1043 and any frame now using that window as the minibuffer.
1044 If MINIFRAME is `visible', include all visible frames.
1045 If MINIFRAME is 0, include all visible and iconified frames.
1046 Otherwise, include all frames. */)
1047 (Lisp_Object frame, Lisp_Object miniframe)
1049 if (NILP (frame))
1050 frame = selected_frame;
1051 CHECK_LIVE_FRAME (frame);
1052 return next_frame (frame, miniframe);
1055 DEFUN ("previous-frame", Fprevious_frame, Sprevious_frame, 0, 2, 0,
1056 doc: /* Return the previous frame in the frame list before FRAME.
1057 It considers only frames on the same terminal as FRAME.
1058 By default, skip minibuffer-only frames.
1059 If omitted, FRAME defaults to the selected frame.
1060 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1061 If MINIFRAME is a window, include only its own frame
1062 and any frame now using that window as the minibuffer.
1063 If MINIFRAME is `visible', include all visible frames.
1064 If MINIFRAME is 0, include all visible and iconified frames.
1065 Otherwise, include all frames. */)
1066 (Lisp_Object frame, Lisp_Object miniframe)
1068 if (NILP (frame))
1069 frame = selected_frame;
1070 CHECK_LIVE_FRAME (frame);
1071 return prev_frame (frame, miniframe);
1074 /* Return 1 if it is ok to delete frame F;
1075 0 if all frames aside from F are invisible.
1076 (Exception: if F is the terminal frame, and we are using X, return 1.) */
1078 static int
1079 other_visible_frames (FRAME_PTR f)
1081 Lisp_Object frames, this;
1083 FOR_EACH_FRAME (frames, this)
1085 if (f == XFRAME (this))
1086 continue;
1088 /* Verify that we can still talk to the frame's X window,
1089 and note any recent change in visibility. */
1090 #ifdef HAVE_WINDOW_SYSTEM
1091 if (FRAME_WINDOW_P (XFRAME (this)))
1092 x_sync (XFRAME (this));
1093 #endif
1095 if (FRAME_VISIBLE_P (XFRAME (this))
1096 || FRAME_ICONIFIED_P (XFRAME (this))
1097 /* Allow deleting the terminal frame when at least one X
1098 frame exists. */
1099 || (FRAME_WINDOW_P (XFRAME (this)) && !FRAME_WINDOW_P (f)))
1100 return 1;
1102 return 0;
1105 /* Delete FRAME. When FORCE equals Qnoelisp, delete FRAME
1106 unconditionally. x_connection_closed and delete_terminal use
1107 this. Any other value of FORCE implements the semantics
1108 described for Fdelete_frame. */
1109 Lisp_Object
1110 delete_frame (Lisp_Object frame, Lisp_Object force)
1112 struct frame *f = decode_any_frame (frame);
1113 struct frame *sf = SELECTED_FRAME ();
1114 struct kboard *kb;
1116 int minibuffer_selected, is_tooltip_frame;
1118 if (! FRAME_LIVE_P (f))
1119 return Qnil;
1121 if (NILP (force) && !other_visible_frames (f))
1122 error ("Attempt to delete the sole visible or iconified frame");
1124 /* x_connection_closed must have set FORCE to `noelisp' in order
1125 to delete the last frame, if it is gone. */
1126 if (NILP (XCDR (Vframe_list)) && !EQ (force, Qnoelisp))
1127 error ("Attempt to delete the only frame");
1129 XSETFRAME (frame, f);
1131 /* Does this frame have a minibuffer, and is it the surrogate
1132 minibuffer for any other frame? */
1133 if (FRAME_HAS_MINIBUF_P (f))
1135 Lisp_Object frames, this;
1137 FOR_EACH_FRAME (frames, this)
1139 if (! EQ (this, frame)
1140 && EQ (frame,
1141 WINDOW_FRAME (XWINDOW
1142 (FRAME_MINIBUF_WINDOW (XFRAME (this))))))
1144 /* If we MUST delete this frame, delete the other first.
1145 But do this only if FORCE equals `noelisp'. */
1146 if (EQ (force, Qnoelisp))
1147 delete_frame (this, Qnoelisp);
1148 else
1149 error ("Attempt to delete a surrogate minibuffer frame");
1154 is_tooltip_frame = !NILP (Fframe_parameter (frame, intern ("tooltip")));
1156 /* Run `delete-frame-functions' unless FORCE is `noelisp' or
1157 frame is a tooltip. FORCE is set to `noelisp' when handling
1158 a disconnect from the terminal, so we don't dare call Lisp
1159 code. */
1160 if (NILP (Vrun_hooks) || is_tooltip_frame)
1162 else if (EQ (force, Qnoelisp))
1163 pending_funcalls
1164 = Fcons (list3 (Qrun_hook_with_args, Qdelete_frame_functions, frame),
1165 pending_funcalls);
1166 else
1168 #ifdef HAVE_X_WINDOWS
1169 /* Also, save clipboard to the clipboard manager. */
1170 x_clipboard_manager_save_frame (frame);
1171 #endif
1173 safe_call2 (Qrun_hook_with_args, Qdelete_frame_functions, frame);
1176 /* The hook may sometimes (indirectly) cause the frame to be deleted. */
1177 if (! FRAME_LIVE_P (f))
1178 return Qnil;
1180 /* At this point, we are committed to deleting the frame.
1181 There is no more chance for errors to prevent it. */
1183 minibuffer_selected = EQ (minibuf_window, selected_window);
1185 /* Don't let the frame remain selected. */
1186 if (f == sf)
1188 Lisp_Object tail, frame1;
1190 /* Look for another visible frame on the same terminal. */
1191 frame1 = next_frame (frame, Qvisible);
1193 /* If there is none, find *some* other frame. */
1194 if (NILP (frame1) || EQ (frame1, frame))
1196 FOR_EACH_FRAME (tail, frame1)
1198 if (! EQ (frame, frame1) && FRAME_LIVE_P (XFRAME (frame1)))
1200 /* Do not change a text terminal's top-frame. */
1201 struct frame *f1 = XFRAME (frame1);
1202 if (FRAME_TERMCAP_P (f1) || FRAME_MSDOS_P (f1))
1204 Lisp_Object top_frame = FRAME_TTY (f1)->top_frame;
1205 if (!EQ (top_frame, frame))
1206 frame1 = top_frame;
1208 break;
1212 #ifdef NS_IMPL_COCOA
1213 else
1214 /* Under NS, there is no system mechanism for choosing a new
1215 window to get focus -- it is left to application code.
1216 So the portion of THIS application interfacing with NS
1217 needs to know about it. We call Fraise_frame, but the
1218 purpose is really to transfer focus. */
1219 Fraise_frame (frame1);
1220 #endif
1222 do_switch_frame (frame1, 0, 1, Qnil);
1223 sf = SELECTED_FRAME ();
1226 /* Don't allow minibuf_window to remain on a deleted frame. */
1227 if (EQ (f->minibuffer_window, minibuf_window))
1229 /* Use set_window_buffer instead of Fset_window_buffer (see
1230 discussion of bug#11984, bug#12025, bug#12026). */
1231 set_window_buffer (sf->minibuffer_window,
1232 XWINDOW (minibuf_window)->contents, 0, 0);
1233 minibuf_window = sf->minibuffer_window;
1235 /* If the dying minibuffer window was selected,
1236 select the new one. */
1237 if (minibuffer_selected)
1238 Fselect_window (minibuf_window, Qnil);
1241 /* Don't let echo_area_window to remain on a deleted frame. */
1242 if (EQ (f->minibuffer_window, echo_area_window))
1243 echo_area_window = sf->minibuffer_window;
1245 /* Clear any X selections for this frame. */
1246 #ifdef HAVE_X_WINDOWS
1247 if (FRAME_X_P (f))
1248 x_clear_frame_selections (f);
1249 #endif
1251 /* Free glyphs.
1252 This function must be called before the window tree of the
1253 frame is deleted because windows contain dynamically allocated
1254 memory. */
1255 free_glyphs (f);
1257 #ifdef HAVE_WINDOW_SYSTEM
1258 /* Give chance to each font driver to free a frame specific data. */
1259 font_update_drivers (f, Qnil);
1260 #endif
1262 /* Mark all the windows that used to be on FRAME as deleted, and then
1263 remove the reference to them. */
1264 delete_all_child_windows (f->root_window);
1265 fset_root_window (f, Qnil);
1267 Vframe_list = Fdelq (frame, Vframe_list);
1268 SET_FRAME_VISIBLE (f, 0);
1270 /* Allow the vector of menu bar contents to be freed in the next
1271 garbage collection. The frame object itself may not be garbage
1272 collected until much later, because recent_keys and other data
1273 structures can still refer to it. */
1274 fset_menu_bar_vector (f, Qnil);
1276 /* If FRAME's buffer lists contains killed
1277 buffers, this helps GC to reclaim them. */
1278 fset_buffer_list (f, Qnil);
1279 fset_buried_buffer_list (f, Qnil);
1281 free_font_driver_list (f);
1282 xfree (f->namebuf);
1283 xfree (f->decode_mode_spec_buffer);
1284 xfree (FRAME_INSERT_COST (f));
1285 xfree (FRAME_DELETEN_COST (f));
1286 xfree (FRAME_INSERTN_COST (f));
1287 xfree (FRAME_DELETE_COST (f));
1289 /* Since some events are handled at the interrupt level, we may get
1290 an event for f at any time; if we zero out the frame's terminal
1291 now, then we may trip up the event-handling code. Instead, we'll
1292 promise that the terminal of the frame must be valid until we
1293 have called the window-system-dependent frame destruction
1294 routine. */
1296 if (FRAME_TERMINAL (f)->delete_frame_hook)
1297 (*FRAME_TERMINAL (f)->delete_frame_hook) (f);
1300 struct terminal *terminal = FRAME_TERMINAL (f);
1301 f->output_data.nothing = 0;
1302 f->terminal = 0; /* Now the frame is dead. */
1304 /* If needed, delete the terminal that this frame was on.
1305 (This must be done after the frame is killed.) */
1306 terminal->reference_count--;
1307 #ifdef USE_GTK
1308 /* FIXME: Deleting the terminal crashes emacs because of a GTK
1309 bug.
1310 http://lists.gnu.org/archive/html/emacs-devel/2011-10/msg00363.html */
1311 if (terminal->reference_count == 0 && terminal->type == output_x_window)
1312 terminal->reference_count = 1;
1313 #endif /* USE_GTK */
1314 if (terminal->reference_count == 0)
1316 Lisp_Object tmp;
1317 XSETTERMINAL (tmp, terminal);
1319 kb = NULL;
1320 Fdelete_terminal (tmp, NILP (force) ? Qt : force);
1322 else
1323 kb = terminal->kboard;
1326 /* If we've deleted the last_nonminibuf_frame, then try to find
1327 another one. */
1328 if (f == last_nonminibuf_frame)
1330 Lisp_Object frames, this;
1332 last_nonminibuf_frame = 0;
1334 FOR_EACH_FRAME (frames, this)
1336 f = XFRAME (this);
1337 if (!FRAME_MINIBUF_ONLY_P (f))
1339 last_nonminibuf_frame = f;
1340 break;
1345 /* If there's no other frame on the same kboard, get out of
1346 single-kboard state if we're in it for this kboard. */
1347 if (kb != NULL)
1349 Lisp_Object frames, this;
1350 /* Some frame we found on the same kboard, or nil if there are none. */
1351 Lisp_Object frame_on_same_kboard = Qnil;
1353 FOR_EACH_FRAME (frames, this)
1354 if (kb == FRAME_KBOARD (XFRAME (this)))
1355 frame_on_same_kboard = this;
1357 if (NILP (frame_on_same_kboard))
1358 not_single_kboard_state (kb);
1362 /* If we've deleted this keyboard's default_minibuffer_frame, try to
1363 find another one. Prefer minibuffer-only frames, but also notice
1364 frames with other windows. */
1365 if (kb != NULL && EQ (frame, KVAR (kb, Vdefault_minibuffer_frame)))
1367 Lisp_Object frames, this;
1369 /* The last frame we saw with a minibuffer, minibuffer-only or not. */
1370 Lisp_Object frame_with_minibuf = Qnil;
1371 /* Some frame we found on the same kboard, or nil if there are none. */
1372 Lisp_Object frame_on_same_kboard = Qnil;
1374 FOR_EACH_FRAME (frames, this)
1376 struct frame *f1 = XFRAME (this);
1378 /* Consider only frames on the same kboard
1379 and only those with minibuffers. */
1380 if (kb == FRAME_KBOARD (f1)
1381 && FRAME_HAS_MINIBUF_P (f1))
1383 frame_with_minibuf = this;
1384 if (FRAME_MINIBUF_ONLY_P (f1))
1385 break;
1388 if (kb == FRAME_KBOARD (f1))
1389 frame_on_same_kboard = this;
1392 if (!NILP (frame_on_same_kboard))
1394 /* We know that there must be some frame with a minibuffer out
1395 there. If this were not true, all of the frames present
1396 would have to be minibufferless, which implies that at some
1397 point their minibuffer frames must have been deleted, but
1398 that is prohibited at the top; you can't delete surrogate
1399 minibuffer frames. */
1400 if (NILP (frame_with_minibuf))
1401 emacs_abort ();
1403 kset_default_minibuffer_frame (kb, frame_with_minibuf);
1405 else
1406 /* No frames left on this kboard--say no minibuffer either. */
1407 kset_default_minibuffer_frame (kb, Qnil);
1410 /* Cause frame titles to update--necessary if we now have just one frame. */
1411 if (!is_tooltip_frame)
1412 update_mode_lines = 1;
1414 return Qnil;
1417 DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 2, "",
1418 doc: /* Delete FRAME, permanently eliminating it from use.
1419 FRAME defaults to the selected frame.
1421 A frame may not be deleted if its minibuffer is used by other frames.
1422 Normally, you may not delete a frame if all other frames are invisible,
1423 but if the second optional argument FORCE is non-nil, you may do so.
1425 This function runs `delete-frame-functions' before actually
1426 deleting the frame, unless the frame is a tooltip.
1427 The functions are run with one argument, the frame to be deleted. */)
1428 (Lisp_Object frame, Lisp_Object force)
1430 return delete_frame (frame, !NILP (force) ? Qt : Qnil);
1434 /* Return mouse position in character cell units. */
1436 DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0,
1437 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1438 The position is given in character cells, where (0, 0) is the
1439 upper-left corner of the frame, X is the horizontal offset, and Y is
1440 the vertical offset.
1441 If Emacs is running on a mouseless terminal or hasn't been programmed
1442 to read the mouse position, it returns the selected frame for FRAME
1443 and nil for X and Y.
1444 If `mouse-position-function' is non-nil, `mouse-position' calls it,
1445 passing the normal return value to that function as an argument,
1446 and returns whatever that function returns. */)
1447 (void)
1449 FRAME_PTR f;
1450 Lisp_Object lispy_dummy;
1451 Lisp_Object x, y, retval;
1452 struct gcpro gcpro1;
1454 f = SELECTED_FRAME ();
1455 x = y = Qnil;
1457 /* It's okay for the hook to refrain from storing anything. */
1458 if (FRAME_TERMINAL (f)->mouse_position_hook)
1460 enum scroll_bar_part party_dummy;
1461 Time time_dummy;
1462 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1463 &lispy_dummy, &party_dummy,
1464 &x, &y,
1465 &time_dummy);
1468 if (! NILP (x))
1470 int col = XINT (x);
1471 int row = XINT (y);
1472 pixel_to_glyph_coords (f, col, row, &col, &row, NULL, 1);
1473 XSETINT (x, col);
1474 XSETINT (y, row);
1476 XSETFRAME (lispy_dummy, f);
1477 retval = Fcons (lispy_dummy, Fcons (x, y));
1478 GCPRO1 (retval);
1479 if (!NILP (Vmouse_position_function))
1480 retval = call1 (Vmouse_position_function, retval);
1481 RETURN_UNGCPRO (retval);
1484 DEFUN ("mouse-pixel-position", Fmouse_pixel_position,
1485 Smouse_pixel_position, 0, 0, 0,
1486 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1487 The position is given in pixel units, where (0, 0) is the
1488 upper-left corner of the frame, X is the horizontal offset, and Y is
1489 the vertical offset.
1490 If Emacs is running on a mouseless terminal or hasn't been programmed
1491 to read the mouse position, it returns the selected frame for FRAME
1492 and nil for X and Y. */)
1493 (void)
1495 FRAME_PTR f;
1496 Lisp_Object lispy_dummy;
1497 Lisp_Object x, y;
1499 f = SELECTED_FRAME ();
1500 x = y = Qnil;
1502 /* It's okay for the hook to refrain from storing anything. */
1503 if (FRAME_TERMINAL (f)->mouse_position_hook)
1505 enum scroll_bar_part party_dummy;
1506 Time time_dummy;
1507 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1508 &lispy_dummy, &party_dummy,
1509 &x, &y,
1510 &time_dummy);
1513 XSETFRAME (lispy_dummy, f);
1514 return Fcons (lispy_dummy, Fcons (x, y));
1517 DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0,
1518 doc: /* Move the mouse pointer to the center of character cell (X,Y) in FRAME.
1519 Coordinates are relative to the frame, not a window,
1520 so the coordinates of the top left character in the frame
1521 may be nonzero due to left-hand scroll bars or the menu bar.
1523 The position is given in character cells, where (0, 0) is the
1524 upper-left corner of the frame, X is the horizontal offset, and Y is
1525 the vertical offset.
1527 This function is a no-op for an X frame that is not visible.
1528 If you have just created a frame, you must wait for it to become visible
1529 before calling this function on it, like this.
1530 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1531 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1533 CHECK_LIVE_FRAME (frame);
1534 CHECK_TYPE_RANGED_INTEGER (int, x);
1535 CHECK_TYPE_RANGED_INTEGER (int, y);
1537 /* I think this should be done with a hook. */
1538 #ifdef HAVE_WINDOW_SYSTEM
1539 if (FRAME_WINDOW_P (XFRAME (frame)))
1540 /* Warping the mouse will cause enternotify and focus events. */
1541 x_set_mouse_position (XFRAME (frame), XINT (x), XINT (y));
1542 #else
1543 #if defined (MSDOS)
1544 if (FRAME_MSDOS_P (XFRAME (frame)))
1546 Fselect_frame (frame, Qnil);
1547 mouse_moveto (XINT (x), XINT (y));
1549 #else
1550 #ifdef HAVE_GPM
1552 Fselect_frame (frame, Qnil);
1553 term_mouse_moveto (XINT (x), XINT (y));
1555 #endif
1556 #endif
1557 #endif
1559 return Qnil;
1562 DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position,
1563 Sset_mouse_pixel_position, 3, 3, 0,
1564 doc: /* Move the mouse pointer to pixel position (X,Y) in FRAME.
1565 The position is given in pixels, where (0, 0) is the upper-left corner
1566 of the frame, X is the horizontal offset, and Y is the vertical offset.
1568 Note, this is a no-op for an X frame that is not visible.
1569 If you have just created a frame, you must wait for it to become visible
1570 before calling this function on it, like this.
1571 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1572 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1574 CHECK_LIVE_FRAME (frame);
1575 CHECK_TYPE_RANGED_INTEGER (int, x);
1576 CHECK_TYPE_RANGED_INTEGER (int, y);
1578 /* I think this should be done with a hook. */
1579 #ifdef HAVE_WINDOW_SYSTEM
1580 if (FRAME_WINDOW_P (XFRAME (frame)))
1581 /* Warping the mouse will cause enternotify and focus events. */
1582 x_set_mouse_pixel_position (XFRAME (frame), XINT (x), XINT (y));
1583 #else
1584 #if defined (MSDOS)
1585 if (FRAME_MSDOS_P (XFRAME (frame)))
1587 Fselect_frame (frame, Qnil);
1588 mouse_moveto (XINT (x), XINT (y));
1590 #else
1591 #ifdef HAVE_GPM
1593 Fselect_frame (frame, Qnil);
1594 term_mouse_moveto (XINT (x), XINT (y));
1596 #endif
1597 #endif
1598 #endif
1600 return Qnil;
1603 static void make_frame_visible_1 (Lisp_Object);
1605 DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible,
1606 0, 1, "",
1607 doc: /* Make the frame FRAME visible (assuming it is an X window).
1608 If omitted, FRAME defaults to the currently selected frame. */)
1609 (Lisp_Object frame)
1611 struct frame *f = decode_live_frame (frame);
1613 /* I think this should be done with a hook. */
1614 #ifdef HAVE_WINDOW_SYSTEM
1615 if (FRAME_WINDOW_P (f))
1616 x_make_frame_visible (f);
1617 #endif
1619 make_frame_visible_1 (f->root_window);
1621 /* Make menu bar update for the Buffers and Frames menus. */
1622 windows_or_buffers_changed++;
1624 XSETFRAME (frame, f);
1625 return frame;
1628 /* Update the display_time slot of the buffers shown in WINDOW
1629 and all its descendants. */
1631 static void
1632 make_frame_visible_1 (Lisp_Object window)
1634 struct window *w;
1636 for (; !NILP (window); window = w->next)
1638 w = XWINDOW (window);
1639 if (WINDOWP (w->contents))
1640 make_frame_visible_1 (w->contents);
1641 else
1642 bset_display_time (XBUFFER (w->contents), Fcurrent_time ());
1646 DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible,
1647 0, 2, "",
1648 doc: /* Make the frame FRAME invisible.
1649 If omitted, FRAME defaults to the currently selected frame.
1650 On graphical displays, invisible frames are not updated and are
1651 usually not displayed at all, even in a window system's \"taskbar\".
1653 Normally you may not make FRAME invisible if all other frames are invisible,
1654 but if the second optional argument FORCE is non-nil, you may do so.
1656 This function has no effect on text terminal frames. Such frames are
1657 always considered visible, whether or not they are currently being
1658 displayed in the terminal. */)
1659 (Lisp_Object frame, Lisp_Object force)
1661 struct frame *f = decode_live_frame (frame);
1663 if (NILP (force) && !other_visible_frames (f))
1664 error ("Attempt to make invisible the sole visible or iconified frame");
1666 /* Don't allow minibuf_window to remain on a deleted frame. */
1667 if (EQ (f->minibuffer_window, minibuf_window))
1669 struct frame *sf = XFRAME (selected_frame);
1670 /* Use set_window_buffer instead of Fset_window_buffer (see
1671 discussion of bug#11984, bug#12025, bug#12026). */
1672 set_window_buffer (sf->minibuffer_window,
1673 XWINDOW (minibuf_window)->contents, 0, 0);
1674 minibuf_window = sf->minibuffer_window;
1677 /* I think this should be done with a hook. */
1678 #ifdef HAVE_WINDOW_SYSTEM
1679 if (FRAME_WINDOW_P (f))
1680 x_make_frame_invisible (f);
1681 #endif
1683 /* Make menu bar update for the Buffers and Frames menus. */
1684 windows_or_buffers_changed++;
1686 return Qnil;
1689 DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame,
1690 0, 1, "",
1691 doc: /* Make the frame FRAME into an icon.
1692 If omitted, FRAME defaults to the currently selected frame. */)
1693 (Lisp_Object frame)
1695 struct frame *f = decode_live_frame (frame);
1697 /* Don't allow minibuf_window to remain on an iconified frame. */
1698 if (EQ (f->minibuffer_window, minibuf_window))
1700 struct frame *sf = XFRAME (selected_frame);
1701 /* Use set_window_buffer instead of Fset_window_buffer (see
1702 discussion of bug#11984, bug#12025, bug#12026). */
1703 set_window_buffer (sf->minibuffer_window,
1704 XWINDOW (minibuf_window)->contents, 0, 0);
1705 minibuf_window = sf->minibuffer_window;
1708 /* I think this should be done with a hook. */
1709 #ifdef HAVE_WINDOW_SYSTEM
1710 if (FRAME_WINDOW_P (f))
1711 x_iconify_frame (f);
1712 #endif
1714 /* Make menu bar update for the Buffers and Frames menus. */
1715 windows_or_buffers_changed++;
1717 return Qnil;
1720 DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p,
1721 1, 1, 0,
1722 doc: /* Return t if FRAME is \"visible\" (actually in use for display).
1723 Return the symbol `icon' if FRAME is iconified or \"minimized\".
1724 Return nil if FRAME was made invisible, via `make-frame-invisible'.
1725 On graphical displays, invisible frames are not updated and are
1726 usually not displayed at all, even in a window system's \"taskbar\".
1728 If FRAME is a text terminal frame, this always returns t.
1729 Such frames are always considered visible, whether or not they are
1730 currently being displayed on the terminal. */)
1731 (Lisp_Object frame)
1733 CHECK_LIVE_FRAME (frame);
1735 if (FRAME_VISIBLE_P (XFRAME (frame)))
1736 return Qt;
1737 if (FRAME_ICONIFIED_P (XFRAME (frame)))
1738 return Qicon;
1739 return Qnil;
1742 DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list,
1743 0, 0, 0,
1744 doc: /* Return a list of all frames now \"visible\" (being updated). */)
1745 (void)
1747 Lisp_Object tail, frame, value = Qnil;
1749 FOR_EACH_FRAME (tail, frame)
1750 if (FRAME_VISIBLE_P (XFRAME (frame)))
1751 value = Fcons (frame, value);
1753 return value;
1757 DEFUN ("raise-frame", Fraise_frame, Sraise_frame, 0, 1, "",
1758 doc: /* Bring FRAME to the front, so it occludes any frames it overlaps.
1759 If FRAME is invisible or iconified, make it visible.
1760 If you don't specify a frame, the selected frame is used.
1761 If Emacs is displaying on an ordinary terminal or some other device which
1762 doesn't support multiple overlapping frames, this function selects FRAME. */)
1763 (Lisp_Object frame)
1765 struct frame *f = decode_live_frame (frame);
1767 XSETFRAME (frame, f);
1769 if (FRAME_TERMCAP_P (f))
1770 /* On a text terminal select FRAME. */
1771 Fselect_frame (frame, Qnil);
1772 else
1773 /* Do like the documentation says. */
1774 Fmake_frame_visible (frame);
1776 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
1777 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 1);
1779 return Qnil;
1782 /* Should we have a corresponding function called Flower_Power? */
1783 DEFUN ("lower-frame", Flower_frame, Slower_frame, 0, 1, "",
1784 doc: /* Send FRAME to the back, so it is occluded by any frames that overlap it.
1785 If you don't specify a frame, the selected frame is used.
1786 If Emacs is displaying on an ordinary terminal or some other device which
1787 doesn't support multiple overlapping frames, this function does nothing. */)
1788 (Lisp_Object frame)
1790 struct frame *f = decode_live_frame (frame);
1792 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
1793 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 0);
1795 return Qnil;
1799 DEFUN ("redirect-frame-focus", Fredirect_frame_focus, Sredirect_frame_focus,
1800 1, 2, 0,
1801 doc: /* Arrange for keystrokes typed at FRAME to be sent to FOCUS-FRAME.
1802 In other words, switch-frame events caused by events in FRAME will
1803 request a switch to FOCUS-FRAME, and `last-event-frame' will be
1804 FOCUS-FRAME after reading an event typed at FRAME.
1806 If FOCUS-FRAME is nil, any existing redirection is canceled, and the
1807 frame again receives its own keystrokes.
1809 Focus redirection is useful for temporarily redirecting keystrokes to
1810 a surrogate minibuffer frame when a frame doesn't have its own
1811 minibuffer window.
1813 A frame's focus redirection can be changed by `select-frame'. If frame
1814 FOO is selected, and then a different frame BAR is selected, any
1815 frames redirecting their focus to FOO are shifted to redirect their
1816 focus to BAR. This allows focus redirection to work properly when the
1817 user switches from one frame to another using `select-window'.
1819 This means that a frame whose focus is redirected to itself is treated
1820 differently from a frame whose focus is redirected to nil; the former
1821 is affected by `select-frame', while the latter is not.
1823 The redirection lasts until `redirect-frame-focus' is called to change it. */)
1824 (Lisp_Object frame, Lisp_Object focus_frame)
1826 /* Note that we don't check for a live frame here. It's reasonable
1827 to redirect the focus of a frame you're about to delete, if you
1828 know what other frame should receive those keystrokes. */
1829 struct frame *f = decode_any_frame (frame);
1831 if (! NILP (focus_frame))
1832 CHECK_LIVE_FRAME (focus_frame);
1834 fset_focus_frame (f, focus_frame);
1836 if (FRAME_TERMINAL (f)->frame_rehighlight_hook)
1837 (*FRAME_TERMINAL (f)->frame_rehighlight_hook) (f);
1839 return Qnil;
1843 DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 0, 1, 0,
1844 doc: /* Return the frame to which FRAME's keystrokes are currently being sent.
1845 If FRAME is omitted or nil, the selected frame is used.
1846 Return nil if FRAME's focus is not redirected.
1847 See `redirect-frame-focus'. */)
1848 (Lisp_Object frame)
1850 return FRAME_FOCUS_FRAME (decode_live_frame (frame));
1855 /* Return the value of frame parameter PROP in frame FRAME. */
1857 #ifdef HAVE_WINDOW_SYSTEM
1858 #if !HAVE_NS && !defined(WINDOWSNT)
1859 static
1860 #endif
1861 Lisp_Object
1862 get_frame_param (register struct frame *frame, Lisp_Object prop)
1864 register Lisp_Object tem;
1866 tem = Fassq (prop, frame->param_alist);
1867 if (EQ (tem, Qnil))
1868 return tem;
1869 return Fcdr (tem);
1871 #endif
1873 /* Discard BUFFER from the buffer-list and buried-buffer-list of each frame. */
1875 void
1876 frames_discard_buffer (Lisp_Object buffer)
1878 Lisp_Object frame, tail;
1880 FOR_EACH_FRAME (tail, frame)
1882 fset_buffer_list
1883 (XFRAME (frame), Fdelq (buffer, XFRAME (frame)->buffer_list));
1884 fset_buried_buffer_list
1885 (XFRAME (frame), Fdelq (buffer, XFRAME (frame)->buried_buffer_list));
1889 /* Modify the alist in *ALISTPTR to associate PROP with VAL.
1890 If the alist already has an element for PROP, we change it. */
1892 void
1893 store_in_alist (Lisp_Object *alistptr, Lisp_Object prop, Lisp_Object val)
1895 register Lisp_Object tem;
1897 tem = Fassq (prop, *alistptr);
1898 if (EQ (tem, Qnil))
1899 *alistptr = Fcons (Fcons (prop, val), *alistptr);
1900 else
1901 Fsetcdr (tem, val);
1904 static int
1905 frame_name_fnn_p (char *str, ptrdiff_t len)
1907 if (len > 1 && str[0] == 'F' && '0' <= str[1] && str[1] <= '9')
1909 char *p = str + 2;
1910 while ('0' <= *p && *p <= '9')
1911 p++;
1912 if (p == str + len)
1913 return 1;
1915 return 0;
1918 /* Set the name of the terminal frame. Also used by MSDOS frames.
1919 Modeled after x_set_name which is used for WINDOW frames. */
1921 static void
1922 set_term_frame_name (struct frame *f, Lisp_Object name)
1924 f->explicit_name = ! NILP (name);
1926 /* If NAME is nil, set the name to F<num>. */
1927 if (NILP (name))
1929 char namebuf[sizeof "F" + INT_STRLEN_BOUND (printmax_t)];
1931 /* Check for no change needed in this very common case
1932 before we do any consing. */
1933 if (frame_name_fnn_p (SSDATA (f->name), SBYTES (f->name)))
1934 return;
1936 name = make_formatted_string (namebuf, "F%"pMd, ++tty_frame_count);
1938 else
1940 CHECK_STRING (name);
1942 /* Don't change the name if it's already NAME. */
1943 if (! NILP (Fstring_equal (name, f->name)))
1944 return;
1946 /* Don't allow the user to set the frame name to F<num>, so it
1947 doesn't clash with the names we generate for terminal frames. */
1948 if (frame_name_fnn_p (SSDATA (name), SBYTES (name)))
1949 error ("Frame names of the form F<num> are usurped by Emacs");
1952 fset_name (f, name);
1953 update_mode_lines = 1;
1956 void
1957 store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
1959 register Lisp_Object old_alist_elt;
1961 /* The buffer-list parameters are stored in a special place and not
1962 in the alist. All buffers must be live. */
1963 if (EQ (prop, Qbuffer_list))
1965 Lisp_Object list = Qnil;
1966 for (; CONSP (val); val = XCDR (val))
1967 if (!NILP (Fbuffer_live_p (XCAR (val))))
1968 list = Fcons (XCAR (val), list);
1969 fset_buffer_list (f, Fnreverse (list));
1970 return;
1972 if (EQ (prop, Qburied_buffer_list))
1974 Lisp_Object list = Qnil;
1975 for (; CONSP (val); val = XCDR (val))
1976 if (!NILP (Fbuffer_live_p (XCAR (val))))
1977 list = Fcons (XCAR (val), list);
1978 fset_buried_buffer_list (f, Fnreverse (list));
1979 return;
1982 /* If PROP is a symbol which is supposed to have frame-local values,
1983 and it is set up based on this frame, switch to the global
1984 binding. That way, we can create or alter the frame-local binding
1985 without messing up the symbol's status. */
1986 if (SYMBOLP (prop))
1988 struct Lisp_Symbol *sym = XSYMBOL (prop);
1989 start:
1990 switch (sym->redirect)
1992 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
1993 case SYMBOL_PLAINVAL: case SYMBOL_FORWARDED: break;
1994 case SYMBOL_LOCALIZED:
1995 { struct Lisp_Buffer_Local_Value *blv = sym->val.blv;
1996 if (blv->frame_local && blv_found (blv) && XFRAME (blv->where) == f)
1997 swap_in_global_binding (sym);
1998 break;
2000 default: emacs_abort ();
2004 /* The tty color needed to be set before the frame's parameter
2005 alist was updated with the new value. This is not true any more,
2006 but we still do this test early on. */
2007 if (FRAME_TERMCAP_P (f) && EQ (prop, Qtty_color_mode)
2008 && f == FRAME_TTY (f)->previous_frame)
2009 /* Force redisplay of this tty. */
2010 FRAME_TTY (f)->previous_frame = NULL;
2012 /* Update the frame parameter alist. */
2013 old_alist_elt = Fassq (prop, f->param_alist);
2014 if (EQ (old_alist_elt, Qnil))
2015 fset_param_alist (f, Fcons (Fcons (prop, val), f->param_alist));
2016 else
2017 Fsetcdr (old_alist_elt, val);
2019 /* Update some other special parameters in their special places
2020 in addition to the alist. */
2022 if (EQ (prop, Qbuffer_predicate))
2023 fset_buffer_predicate (f, val);
2025 if (! FRAME_WINDOW_P (f))
2027 if (EQ (prop, Qmenu_bar_lines))
2028 set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f)));
2029 else if (EQ (prop, Qname))
2030 set_term_frame_name (f, val);
2033 if (EQ (prop, Qminibuffer) && WINDOWP (val))
2035 if (! MINI_WINDOW_P (XWINDOW (val)))
2036 error ("Surrogate minibuffer windows must be minibuffer windows");
2038 if ((FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
2039 && !EQ (val, f->minibuffer_window))
2040 error ("Can't change the surrogate minibuffer of a frame with its own minibuffer");
2042 /* Install the chosen minibuffer window, with proper buffer. */
2043 fset_minibuffer_window (f, val);
2047 DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0,
2048 doc: /* Return the parameters-alist of frame FRAME.
2049 It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
2050 The meaningful PARMs depend on the kind of frame.
2051 If FRAME is omitted or nil, return information on the currently selected frame. */)
2052 (Lisp_Object frame)
2054 Lisp_Object alist;
2055 struct frame *f = decode_any_frame (frame);
2056 int height, width;
2057 struct gcpro gcpro1;
2059 if (!FRAME_LIVE_P (f))
2060 return Qnil;
2062 alist = Fcopy_alist (f->param_alist);
2063 GCPRO1 (alist);
2065 if (!FRAME_WINDOW_P (f))
2067 int fg = FRAME_FOREGROUND_PIXEL (f);
2068 int bg = FRAME_BACKGROUND_PIXEL (f);
2069 Lisp_Object elt;
2071 /* If the frame's parameter alist says the colors are
2072 unspecified and reversed, take the frame's background pixel
2073 for foreground and vice versa. */
2074 elt = Fassq (Qforeground_color, alist);
2075 if (CONSP (elt) && STRINGP (XCDR (elt)))
2077 if (strncmp (SSDATA (XCDR (elt)),
2078 unspecified_bg,
2079 SCHARS (XCDR (elt))) == 0)
2080 store_in_alist (&alist, Qforeground_color, tty_color_name (f, bg));
2081 else if (strncmp (SSDATA (XCDR (elt)),
2082 unspecified_fg,
2083 SCHARS (XCDR (elt))) == 0)
2084 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2086 else
2087 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2088 elt = Fassq (Qbackground_color, alist);
2089 if (CONSP (elt) && STRINGP (XCDR (elt)))
2091 if (strncmp (SSDATA (XCDR (elt)),
2092 unspecified_fg,
2093 SCHARS (XCDR (elt))) == 0)
2094 store_in_alist (&alist, Qbackground_color, tty_color_name (f, fg));
2095 else if (strncmp (SSDATA (XCDR (elt)),
2096 unspecified_bg,
2097 SCHARS (XCDR (elt))) == 0)
2098 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2100 else
2101 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2102 store_in_alist (&alist, intern ("font"),
2103 build_string (FRAME_MSDOS_P (f)
2104 ? "ms-dos"
2105 : FRAME_W32_P (f) ? "w32term"
2106 :"tty"));
2108 store_in_alist (&alist, Qname, f->name);
2109 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2110 store_in_alist (&alist, Qheight, make_number (height));
2111 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2112 store_in_alist (&alist, Qwidth, make_number (width));
2113 store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil));
2114 store_in_alist (&alist, Qminibuffer,
2115 (! FRAME_HAS_MINIBUF_P (f) ? Qnil
2116 : FRAME_MINIBUF_ONLY_P (f) ? Qonly
2117 : FRAME_MINIBUF_WINDOW (f)));
2118 store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
2119 store_in_alist (&alist, Qbuffer_list, f->buffer_list);
2120 store_in_alist (&alist, Qburied_buffer_list, f->buried_buffer_list);
2122 /* I think this should be done with a hook. */
2123 #ifdef HAVE_WINDOW_SYSTEM
2124 if (FRAME_WINDOW_P (f))
2125 x_report_frame_params (f, &alist);
2126 else
2127 #endif
2129 /* This ought to be correct in f->param_alist for an X frame. */
2130 Lisp_Object lines;
2131 XSETFASTINT (lines, FRAME_MENU_BAR_LINES (f));
2132 store_in_alist (&alist, Qmenu_bar_lines, lines);
2135 UNGCPRO;
2136 return alist;
2140 DEFUN ("frame-parameter", Fframe_parameter, Sframe_parameter, 2, 2, 0,
2141 doc: /* Return FRAME's value for parameter PARAMETER.
2142 If FRAME is nil, describe the currently selected frame. */)
2143 (Lisp_Object frame, Lisp_Object parameter)
2145 struct frame *f = decode_any_frame (frame);
2146 Lisp_Object value = Qnil;
2148 CHECK_SYMBOL (parameter);
2150 XSETFRAME (frame, f);
2152 if (FRAME_LIVE_P (f))
2154 /* Avoid consing in frequent cases. */
2155 if (EQ (parameter, Qname))
2156 value = f->name;
2157 #ifdef HAVE_X_WINDOWS
2158 else if (EQ (parameter, Qdisplay) && FRAME_X_P (f))
2159 value = XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element);
2160 #endif /* HAVE_X_WINDOWS */
2161 else if (EQ (parameter, Qbackground_color)
2162 || EQ (parameter, Qforeground_color))
2164 value = Fassq (parameter, f->param_alist);
2165 if (CONSP (value))
2167 value = XCDR (value);
2168 /* Fframe_parameters puts the actual fg/bg color names,
2169 even if f->param_alist says otherwise. This is
2170 important when param_alist's notion of colors is
2171 "unspecified". We need to do the same here. */
2172 if (STRINGP (value) && !FRAME_WINDOW_P (f))
2174 const char *color_name;
2175 ptrdiff_t csz;
2177 if (EQ (parameter, Qbackground_color))
2179 color_name = SSDATA (value);
2180 csz = SCHARS (value);
2181 if (strncmp (color_name, unspecified_bg, csz) == 0)
2182 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2183 else if (strncmp (color_name, unspecified_fg, csz) == 0)
2184 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2186 else if (EQ (parameter, Qforeground_color))
2188 color_name = SSDATA (value);
2189 csz = SCHARS (value);
2190 if (strncmp (color_name, unspecified_fg, csz) == 0)
2191 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2192 else if (strncmp (color_name, unspecified_bg, csz) == 0)
2193 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2197 else
2198 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2200 else if (EQ (parameter, Qdisplay_type)
2201 || EQ (parameter, Qbackground_mode))
2202 value = Fcdr (Fassq (parameter, f->param_alist));
2203 else
2204 /* FIXME: Avoid this code path at all (as well as code duplication)
2205 by sharing more code with Fframe_parameters. */
2206 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2209 return value;
2213 DEFUN ("modify-frame-parameters", Fmodify_frame_parameters,
2214 Smodify_frame_parameters, 2, 2, 0,
2215 doc: /* Modify the parameters of frame FRAME according to ALIST.
2216 If FRAME is nil, it defaults to the selected frame.
2217 ALIST is an alist of parameters to change and their new values.
2218 Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.
2219 The meaningful PARMs depend on the kind of frame.
2220 Undefined PARMs are ignored, but stored in the frame's parameter list
2221 so that `frame-parameters' will return them.
2223 The value of frame parameter FOO can also be accessed
2224 as a frame-local binding for the variable FOO, if you have
2225 enabled such bindings for that variable with `make-variable-frame-local'.
2226 Note that this functionality is obsolete as of Emacs 22.2, and its
2227 use is not recommended. Explicitly check for a frame-parameter instead. */)
2228 (Lisp_Object frame, Lisp_Object alist)
2230 struct frame *f = decode_live_frame (frame);
2231 register Lisp_Object tail, prop, val;
2233 /* I think this should be done with a hook. */
2234 #ifdef HAVE_WINDOW_SYSTEM
2235 if (FRAME_WINDOW_P (f))
2236 x_set_frame_parameters (f, alist);
2237 else
2238 #endif
2239 #ifdef MSDOS
2240 if (FRAME_MSDOS_P (f))
2241 IT_set_frame_parameters (f, alist);
2242 else
2243 #endif
2246 EMACS_INT length = XFASTINT (Flength (alist));
2247 ptrdiff_t i;
2248 Lisp_Object *parms;
2249 Lisp_Object *values;
2250 USE_SAFE_ALLOCA;
2251 SAFE_ALLOCA_LISP (parms, 2 * length);
2252 values = parms + length;
2254 /* Extract parm names and values into those vectors. */
2256 i = 0;
2257 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2259 Lisp_Object elt;
2261 elt = XCAR (tail);
2262 parms[i] = Fcar (elt);
2263 values[i] = Fcdr (elt);
2264 i++;
2267 /* Now process them in reverse of specified order. */
2268 while (--i >= 0)
2270 prop = parms[i];
2271 val = values[i];
2272 store_frame_param (f, prop, val);
2274 if (EQ (prop, Qforeground_color)
2275 || EQ (prop, Qbackground_color))
2276 update_face_from_frame_parameter (f, prop, val);
2279 SAFE_FREE ();
2281 return Qnil;
2284 DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height,
2285 0, 1, 0,
2286 doc: /* Height in pixels of a line in the font in frame FRAME.
2287 If FRAME is omitted or nil, the selected frame is used.
2288 For a terminal frame, the value is always 1. */)
2289 (Lisp_Object frame)
2291 #ifdef HAVE_WINDOW_SYSTEM
2292 struct frame *f = decode_any_frame (frame);
2294 if (FRAME_WINDOW_P (f))
2295 return make_number (FRAME_LINE_HEIGHT (f));
2296 else
2297 #endif
2298 return make_number (1);
2302 DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width,
2303 0, 1, 0,
2304 doc: /* Width in pixels of characters in the font in frame FRAME.
2305 If FRAME is omitted or nil, the selected frame is used.
2306 On a graphical screen, the width is the standard width of the default font.
2307 For a terminal screen, the value is always 1. */)
2308 (Lisp_Object frame)
2310 #ifdef HAVE_WINDOW_SYSTEM
2311 struct frame *f = decode_any_frame (frame);
2313 if (FRAME_WINDOW_P (f))
2314 return make_number (FRAME_COLUMN_WIDTH (f));
2315 else
2316 #endif
2317 return make_number (1);
2320 DEFUN ("frame-pixel-height", Fframe_pixel_height,
2321 Sframe_pixel_height, 0, 1, 0,
2322 doc: /* Return a FRAME's height in pixels.
2323 If FRAME is omitted or nil, the selected frame is used. The exact value
2324 of the result depends on the window-system and toolkit in use:
2326 In the Gtk+ version of Emacs, it includes only any window (including
2327 the minibuffer or echo area), mode line, and header line. It does not
2328 include the tool bar or menu bar.
2330 With other graphical versions, it also includes the tool bar and the
2331 menu bar.
2333 For a text terminal, it includes the menu bar. In this case, the
2334 result is really in characters rather than pixels (i.e., is identical
2335 to `frame-height'). */)
2336 (Lisp_Object frame)
2338 struct frame *f = decode_any_frame (frame);
2340 #ifdef HAVE_WINDOW_SYSTEM
2341 if (FRAME_WINDOW_P (f))
2342 return make_number (x_pixel_height (f));
2343 else
2344 #endif
2345 return make_number (FRAME_LINES (f));
2348 DEFUN ("frame-pixel-width", Fframe_pixel_width,
2349 Sframe_pixel_width, 0, 1, 0,
2350 doc: /* Return FRAME's width in pixels.
2351 For a terminal frame, the result really gives the width in characters.
2352 If FRAME is omitted or nil, the selected frame is used. */)
2353 (Lisp_Object frame)
2355 struct frame *f = decode_any_frame (frame);
2357 #ifdef HAVE_WINDOW_SYSTEM
2358 if (FRAME_WINDOW_P (f))
2359 return make_number (x_pixel_width (f));
2360 else
2361 #endif
2362 return make_number (FRAME_COLS (f));
2365 DEFUN ("tool-bar-pixel-width", Ftool_bar_pixel_width,
2366 Stool_bar_pixel_width, 0, 1, 0,
2367 doc: /* Return width in pixels of FRAME's tool bar.
2368 The result is greater than zero only when the tool bar is on the left
2369 or right side of FRAME. If FRAME is omitted or nil, the selected frame
2370 is used. */)
2371 (Lisp_Object frame)
2373 #ifdef FRAME_TOOLBAR_WIDTH
2374 struct frame *f = decode_any_frame (frame);
2376 if (FRAME_WINDOW_P (f))
2377 return make_number (FRAME_TOOLBAR_WIDTH (f));
2378 #endif
2379 return make_number (0);
2382 DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0,
2383 doc: /* Specify that the frame FRAME has LINES lines.
2384 Optional third arg non-nil means that redisplay should use LINES lines
2385 but that the idea of the actual height of the frame should not be changed. */)
2386 (Lisp_Object frame, Lisp_Object lines, Lisp_Object pretend)
2388 register struct frame *f = decode_live_frame (frame);
2390 CHECK_TYPE_RANGED_INTEGER (int, lines);
2392 /* I think this should be done with a hook. */
2393 #ifdef HAVE_WINDOW_SYSTEM
2394 if (FRAME_WINDOW_P (f))
2396 if (XINT (lines) != FRAME_LINES (f))
2397 x_set_window_size (f, 1, FRAME_COLS (f), XINT (lines));
2398 do_pending_window_change (0);
2400 else
2401 #endif
2402 change_frame_size (f, XINT (lines), 0, !NILP (pretend), 0, 0);
2403 return Qnil;
2406 DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 3, 0,
2407 doc: /* Specify that the frame FRAME has COLS columns.
2408 Optional third arg non-nil means that redisplay should use COLS columns
2409 but that the idea of the actual width of the frame should not be changed. */)
2410 (Lisp_Object frame, Lisp_Object cols, Lisp_Object pretend)
2412 register struct frame *f = decode_live_frame (frame);
2414 CHECK_TYPE_RANGED_INTEGER (int, cols);
2416 /* I think this should be done with a hook. */
2417 #ifdef HAVE_WINDOW_SYSTEM
2418 if (FRAME_WINDOW_P (f))
2420 if (XINT (cols) != FRAME_COLS (f))
2421 x_set_window_size (f, 1, XINT (cols), FRAME_LINES (f));
2422 do_pending_window_change (0);
2424 else
2425 #endif
2426 change_frame_size (f, 0, XINT (cols), !NILP (pretend), 0, 0);
2427 return Qnil;
2430 DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0,
2431 doc: /* Sets size of FRAME to COLS by ROWS, measured in characters. */)
2432 (Lisp_Object frame, Lisp_Object cols, Lisp_Object rows)
2434 register struct frame *f;
2436 CHECK_LIVE_FRAME (frame);
2437 CHECK_TYPE_RANGED_INTEGER (int, cols);
2438 CHECK_TYPE_RANGED_INTEGER (int, rows);
2439 f = XFRAME (frame);
2441 /* I think this should be done with a hook. */
2442 #ifdef HAVE_WINDOW_SYSTEM
2443 if (FRAME_WINDOW_P (f))
2445 if (XINT (rows) != FRAME_LINES (f)
2446 || XINT (cols) != FRAME_COLS (f)
2447 || f->new_text_lines || f->new_text_cols)
2448 x_set_window_size (f, 1, XINT (cols), XINT (rows));
2449 do_pending_window_change (0);
2451 else
2452 #endif
2453 change_frame_size (f, XINT (rows), XINT (cols), 0, 0, 0);
2455 return Qnil;
2458 DEFUN ("set-frame-position", Fset_frame_position,
2459 Sset_frame_position, 3, 3, 0,
2460 doc: /* Sets position of FRAME in pixels to XOFFSET by YOFFSET.
2461 This is actually the position of the upper left corner of the frame.
2462 Negative values for XOFFSET or YOFFSET are interpreted relative to
2463 the rightmost or bottommost possible position (that stays within the screen). */)
2464 (Lisp_Object frame, Lisp_Object xoffset, Lisp_Object yoffset)
2466 register struct frame *f;
2468 CHECK_LIVE_FRAME (frame);
2469 CHECK_TYPE_RANGED_INTEGER (int, xoffset);
2470 CHECK_TYPE_RANGED_INTEGER (int, yoffset);
2471 f = XFRAME (frame);
2473 /* I think this should be done with a hook. */
2474 #ifdef HAVE_WINDOW_SYSTEM
2475 if (FRAME_WINDOW_P (f))
2476 x_set_offset (f, XINT (xoffset), XINT (yoffset), 1);
2477 #endif
2479 return Qt;
2483 /***********************************************************************
2484 Frame Parameters
2485 ***********************************************************************/
2487 /* Connect the frame-parameter names for X frames
2488 to the ways of passing the parameter values to the window system.
2490 The name of a parameter, as a Lisp symbol,
2491 has an `x-frame-parameter' property which is an integer in Lisp
2492 that is an index in this table. */
2494 struct frame_parm_table {
2495 const char *name;
2496 Lisp_Object *variable;
2499 static const struct frame_parm_table frame_parms[] =
2501 {"auto-raise", &Qauto_raise},
2502 {"auto-lower", &Qauto_lower},
2503 {"background-color", 0},
2504 {"border-color", &Qborder_color},
2505 {"border-width", &Qborder_width},
2506 {"cursor-color", &Qcursor_color},
2507 {"cursor-type", &Qcursor_type},
2508 {"font", 0},
2509 {"foreground-color", 0},
2510 {"icon-name", &Qicon_name},
2511 {"icon-type", &Qicon_type},
2512 {"internal-border-width", &Qinternal_border_width},
2513 {"menu-bar-lines", &Qmenu_bar_lines},
2514 {"mouse-color", &Qmouse_color},
2515 {"name", &Qname},
2516 {"scroll-bar-width", &Qscroll_bar_width},
2517 {"title", &Qtitle},
2518 {"unsplittable", &Qunsplittable},
2519 {"vertical-scroll-bars", &Qvertical_scroll_bars},
2520 {"visibility", &Qvisibility},
2521 {"tool-bar-lines", &Qtool_bar_lines},
2522 {"scroll-bar-foreground", &Qscroll_bar_foreground},
2523 {"scroll-bar-background", &Qscroll_bar_background},
2524 {"screen-gamma", &Qscreen_gamma},
2525 {"line-spacing", &Qline_spacing},
2526 {"left-fringe", &Qleft_fringe},
2527 {"right-fringe", &Qright_fringe},
2528 {"wait-for-wm", &Qwait_for_wm},
2529 {"fullscreen", &Qfullscreen},
2530 {"font-backend", &Qfont_backend},
2531 {"alpha", &Qalpha},
2532 {"sticky", &Qsticky},
2533 {"tool-bar-position", &Qtool_bar_position},
2536 #ifdef HAVE_NTGUI
2538 /* Calculate fullscreen size. Return in *TOP_POS and *LEFT_POS the
2539 wanted positions of the WM window (not Emacs window).
2540 Return in *WIDTH and *HEIGHT the wanted width and height of Emacs
2541 window (FRAME_X_WINDOW).
2544 void
2545 x_fullscreen_adjust (struct frame *f, int *width, int *height, int *top_pos, int *left_pos)
2547 int newwidth = FRAME_COLS (f);
2548 int newheight = FRAME_LINES (f);
2549 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2551 *top_pos = f->top_pos;
2552 *left_pos = f->left_pos;
2554 if (f->want_fullscreen & FULLSCREEN_HEIGHT)
2556 int ph;
2558 ph = x_display_pixel_height (dpyinfo);
2559 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2560 ph = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, newheight) - f->y_pixels_diff;
2561 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2562 *top_pos = 0;
2565 if (f->want_fullscreen & FULLSCREEN_WIDTH)
2567 int pw;
2569 pw = x_display_pixel_width (dpyinfo);
2570 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2571 pw = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, newwidth) - f->x_pixels_diff;
2572 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2573 *left_pos = 0;
2576 *width = newwidth;
2577 *height = newheight;
2580 #endif /* HAVE_NTGUI */
2582 #ifdef HAVE_WINDOW_SYSTEM
2584 /* Change the parameters of frame F as specified by ALIST.
2585 If a parameter is not specially recognized, do nothing special;
2586 otherwise call the `x_set_...' function for that parameter.
2587 Except for certain geometry properties, always call store_frame_param
2588 to store the new value in the parameter alist. */
2590 void
2591 x_set_frame_parameters (FRAME_PTR f, Lisp_Object alist)
2593 Lisp_Object tail;
2595 /* If both of these parameters are present, it's more efficient to
2596 set them both at once. So we wait until we've looked at the
2597 entire list before we set them. */
2598 int width, height;
2600 /* Same here. */
2601 Lisp_Object left, top;
2603 /* Same with these. */
2604 Lisp_Object icon_left, icon_top;
2606 /* Record in these vectors all the parms specified. */
2607 Lisp_Object *parms;
2608 Lisp_Object *values;
2609 ptrdiff_t i, p;
2610 int left_no_change = 0, top_no_change = 0;
2611 int icon_left_no_change = 0, icon_top_no_change = 0;
2612 int size_changed = 0;
2613 struct gcpro gcpro1, gcpro2;
2615 i = 0;
2616 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2617 i++;
2619 parms = alloca (i * sizeof *parms);
2620 values = alloca (i * sizeof *values);
2622 /* Extract parm names and values into those vectors. */
2624 i = 0;
2625 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2627 Lisp_Object elt;
2629 elt = XCAR (tail);
2630 parms[i] = Fcar (elt);
2631 values[i] = Fcdr (elt);
2632 i++;
2634 /* TAIL and ALIST are not used again below here. */
2635 alist = tail = Qnil;
2637 GCPRO2 (*parms, *values);
2638 gcpro1.nvars = i;
2639 gcpro2.nvars = i;
2641 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
2642 because their values appear in VALUES and strings are not valid. */
2643 top = left = Qunbound;
2644 icon_left = icon_top = Qunbound;
2646 /* Provide default values for HEIGHT and WIDTH. */
2647 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2648 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2650 /* Process foreground_color and background_color before anything else.
2651 They are independent of other properties, but other properties (e.g.,
2652 cursor_color) are dependent upon them. */
2653 /* Process default font as well, since fringe widths depends on it. */
2654 for (p = 0; p < i; p++)
2656 Lisp_Object prop, val;
2658 prop = parms[p];
2659 val = values[p];
2660 if (EQ (prop, Qforeground_color)
2661 || EQ (prop, Qbackground_color)
2662 || EQ (prop, Qfont))
2664 register Lisp_Object param_index, old_value;
2666 old_value = get_frame_param (f, prop);
2667 if (NILP (Fequal (val, old_value)))
2669 store_frame_param (f, prop, val);
2671 param_index = Fget (prop, Qx_frame_parameter);
2672 if (NATNUMP (param_index)
2673 && (XFASTINT (param_index)
2674 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2675 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
2676 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2681 /* Now process them in reverse of specified order. */
2682 while (i-- != 0)
2684 Lisp_Object prop, val;
2686 prop = parms[i];
2687 val = values[i];
2689 if (EQ (prop, Qwidth) && RANGED_INTEGERP (0, val, INT_MAX))
2691 size_changed = 1;
2692 width = XFASTINT (val);
2694 else if (EQ (prop, Qheight) && RANGED_INTEGERP (0, val, INT_MAX))
2696 size_changed = 1;
2697 height = XFASTINT (val);
2699 else if (EQ (prop, Qtop))
2700 top = val;
2701 else if (EQ (prop, Qleft))
2702 left = val;
2703 else if (EQ (prop, Qicon_top))
2704 icon_top = val;
2705 else if (EQ (prop, Qicon_left))
2706 icon_left = val;
2707 else if (EQ (prop, Qforeground_color)
2708 || EQ (prop, Qbackground_color)
2709 || EQ (prop, Qfont))
2710 /* Processed above. */
2711 continue;
2712 else
2714 register Lisp_Object param_index, old_value;
2716 old_value = get_frame_param (f, prop);
2718 store_frame_param (f, prop, val);
2720 param_index = Fget (prop, Qx_frame_parameter);
2721 if (NATNUMP (param_index)
2722 && (XFASTINT (param_index)
2723 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2724 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
2725 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2729 /* Don't die if just one of these was set. */
2730 if (EQ (left, Qunbound))
2732 left_no_change = 1;
2733 if (f->left_pos < 0)
2734 left = Fcons (Qplus, Fcons (make_number (f->left_pos), Qnil));
2735 else
2736 XSETINT (left, f->left_pos);
2738 if (EQ (top, Qunbound))
2740 top_no_change = 1;
2741 if (f->top_pos < 0)
2742 top = Fcons (Qplus, Fcons (make_number (f->top_pos), Qnil));
2743 else
2744 XSETINT (top, f->top_pos);
2747 /* If one of the icon positions was not set, preserve or default it. */
2748 if (! TYPE_RANGED_INTEGERP (int, icon_left))
2750 icon_left_no_change = 1;
2751 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
2752 if (NILP (icon_left))
2753 XSETINT (icon_left, 0);
2755 if (! TYPE_RANGED_INTEGERP (int, icon_top))
2757 icon_top_no_change = 1;
2758 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
2759 if (NILP (icon_top))
2760 XSETINT (icon_top, 0);
2763 /* Don't set these parameters unless they've been explicitly
2764 specified. The window might be mapped or resized while we're in
2765 this function, and we don't want to override that unless the lisp
2766 code has asked for it.
2768 Don't set these parameters unless they actually differ from the
2769 window's current parameters; the window may not actually exist
2770 yet. */
2772 Lisp_Object frame;
2774 check_frame_size (f, &height, &width);
2776 XSETFRAME (frame, f);
2778 if (size_changed
2779 && (width != FRAME_COLS (f)
2780 || height != FRAME_LINES (f)
2781 || f->new_text_lines || f->new_text_cols))
2782 Fset_frame_size (frame, make_number (width), make_number (height));
2784 if ((!NILP (left) || !NILP (top))
2785 && ! (left_no_change && top_no_change)
2786 && ! (NUMBERP (left) && XINT (left) == f->left_pos
2787 && NUMBERP (top) && XINT (top) == f->top_pos))
2789 int leftpos = 0;
2790 int toppos = 0;
2792 /* Record the signs. */
2793 f->size_hint_flags &= ~ (XNegative | YNegative);
2794 if (EQ (left, Qminus))
2795 f->size_hint_flags |= XNegative;
2796 else if (TYPE_RANGED_INTEGERP (int, left))
2798 leftpos = XINT (left);
2799 if (leftpos < 0)
2800 f->size_hint_flags |= XNegative;
2802 else if (CONSP (left) && EQ (XCAR (left), Qminus)
2803 && CONSP (XCDR (left))
2804 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (left)), INT_MAX))
2806 leftpos = - XINT (XCAR (XCDR (left)));
2807 f->size_hint_flags |= XNegative;
2809 else if (CONSP (left) && EQ (XCAR (left), Qplus)
2810 && CONSP (XCDR (left))
2811 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (left))))
2813 leftpos = XINT (XCAR (XCDR (left)));
2816 if (EQ (top, Qminus))
2817 f->size_hint_flags |= YNegative;
2818 else if (TYPE_RANGED_INTEGERP (int, top))
2820 toppos = XINT (top);
2821 if (toppos < 0)
2822 f->size_hint_flags |= YNegative;
2824 else if (CONSP (top) && EQ (XCAR (top), Qminus)
2825 && CONSP (XCDR (top))
2826 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (top)), INT_MAX))
2828 toppos = - XINT (XCAR (XCDR (top)));
2829 f->size_hint_flags |= YNegative;
2831 else if (CONSP (top) && EQ (XCAR (top), Qplus)
2832 && CONSP (XCDR (top))
2833 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (top))))
2835 toppos = XINT (XCAR (XCDR (top)));
2839 /* Store the numeric value of the position. */
2840 f->top_pos = toppos;
2841 f->left_pos = leftpos;
2843 f->win_gravity = NorthWestGravity;
2845 /* Actually set that position, and convert to absolute. */
2846 x_set_offset (f, leftpos, toppos, -1);
2849 if ((!NILP (icon_left) || !NILP (icon_top))
2850 && ! (icon_left_no_change && icon_top_no_change))
2851 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
2854 UNGCPRO;
2858 /* Insert a description of internally-recorded parameters of frame X
2859 into the parameter alist *ALISTPTR that is to be given to the user.
2860 Only parameters that are specific to the X window system
2861 and whose values are not correctly recorded in the frame's
2862 param_alist need to be considered here. */
2864 void
2865 x_report_frame_params (struct frame *f, Lisp_Object *alistptr)
2867 Lisp_Object tem;
2868 uprintmax_t w;
2869 char buf[INT_BUFSIZE_BOUND (w)];
2871 /* Represent negative positions (off the top or left screen edge)
2872 in a way that Fmodify_frame_parameters will understand correctly. */
2873 XSETINT (tem, f->left_pos);
2874 if (f->left_pos >= 0)
2875 store_in_alist (alistptr, Qleft, tem);
2876 else
2877 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
2879 XSETINT (tem, f->top_pos);
2880 if (f->top_pos >= 0)
2881 store_in_alist (alistptr, Qtop, tem);
2882 else
2883 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
2885 store_in_alist (alistptr, Qborder_width,
2886 make_number (f->border_width));
2887 store_in_alist (alistptr, Qinternal_border_width,
2888 make_number (FRAME_INTERNAL_BORDER_WIDTH (f)));
2889 store_in_alist (alistptr, Qleft_fringe,
2890 make_number (FRAME_LEFT_FRINGE_WIDTH (f)));
2891 store_in_alist (alistptr, Qright_fringe,
2892 make_number (FRAME_RIGHT_FRINGE_WIDTH (f)));
2893 store_in_alist (alistptr, Qscroll_bar_width,
2894 (! FRAME_HAS_VERTICAL_SCROLL_BARS (f)
2895 ? make_number (0)
2896 : FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0
2897 ? make_number (FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
2898 /* nil means "use default width"
2899 for non-toolkit scroll bar.
2900 ruler-mode.el depends on this. */
2901 : Qnil));
2902 /* FRAME_X_WINDOW is not guaranteed to return an integer. E.g., on
2903 MS-Windows it returns a value whose type is HANDLE, which is
2904 actually a pointer. Explicit casting avoids compiler
2905 warnings. */
2906 w = (uintptr_t) FRAME_X_WINDOW (f);
2907 store_in_alist (alistptr, Qwindow_id,
2908 make_formatted_string (buf, "%"pMu, w));
2909 #ifdef HAVE_X_WINDOWS
2910 #ifdef USE_X_TOOLKIT
2911 /* Tooltip frame may not have this widget. */
2912 if (FRAME_X_OUTPUT (f)->widget)
2913 #endif
2914 w = (uintptr_t) FRAME_OUTER_WINDOW (f);
2915 store_in_alist (alistptr, Qouter_window_id,
2916 make_formatted_string (buf, "%"pMu, w));
2917 #endif
2918 store_in_alist (alistptr, Qicon_name, f->icon_name);
2919 store_in_alist (alistptr, Qvisibility,
2920 (FRAME_VISIBLE_P (f) ? Qt
2921 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
2922 store_in_alist (alistptr, Qdisplay,
2923 XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
2925 if (FRAME_X_OUTPUT (f)->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
2926 tem = Qnil;
2927 else
2928 XSETFASTINT (tem, FRAME_X_OUTPUT (f)->parent_desc);
2929 store_in_alist (alistptr, Qexplicit_name, (f->explicit_name ? Qt : Qnil));
2930 store_in_alist (alistptr, Qparent_id, tem);
2931 store_in_alist (alistptr, Qtool_bar_position, f->tool_bar_position);
2935 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
2936 the previous value of that parameter, NEW_VALUE is the new value. */
2938 void
2939 x_set_fullscreen (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
2941 if (NILP (new_value))
2942 f->want_fullscreen = FULLSCREEN_NONE;
2943 else if (EQ (new_value, Qfullboth) || EQ (new_value, Qfullscreen))
2944 f->want_fullscreen = FULLSCREEN_BOTH;
2945 else if (EQ (new_value, Qfullwidth))
2946 f->want_fullscreen = FULLSCREEN_WIDTH;
2947 else if (EQ (new_value, Qfullheight))
2948 f->want_fullscreen = FULLSCREEN_HEIGHT;
2949 else if (EQ (new_value, Qmaximized))
2950 f->want_fullscreen = FULLSCREEN_MAXIMIZED;
2952 if (FRAME_TERMINAL (f)->fullscreen_hook != NULL)
2953 FRAME_TERMINAL (f)->fullscreen_hook (f);
2957 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
2958 the previous value of that parameter, NEW_VALUE is the new value. */
2960 void
2961 x_set_line_spacing (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
2963 if (NILP (new_value))
2964 f->extra_line_spacing = 0;
2965 else if (RANGED_INTEGERP (0, new_value, INT_MAX))
2966 f->extra_line_spacing = XFASTINT (new_value);
2967 else
2968 signal_error ("Invalid line-spacing", new_value);
2969 if (FRAME_VISIBLE_P (f))
2970 redraw_frame (f);
2974 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
2975 the previous value of that parameter, NEW_VALUE is the new value. */
2977 void
2978 x_set_screen_gamma (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
2980 Lisp_Object bgcolor;
2982 if (NILP (new_value))
2983 f->gamma = 0;
2984 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
2985 /* The value 0.4545 is the normal viewing gamma. */
2986 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
2987 else
2988 signal_error ("Invalid screen-gamma", new_value);
2990 /* Apply the new gamma value to the frame background. */
2991 bgcolor = Fassq (Qbackground_color, f->param_alist);
2992 if (CONSP (bgcolor) && (bgcolor = XCDR (bgcolor), STRINGP (bgcolor)))
2994 Lisp_Object parm_index = Fget (Qbackground_color, Qx_frame_parameter);
2995 if (NATNUMP (parm_index)
2996 && (XFASTINT (parm_index)
2997 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2998 && FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
2999 (*FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
3000 (f, bgcolor, Qnil);
3003 Fclear_face_cache (Qnil);
3007 void
3008 x_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3010 Lisp_Object font_object;
3011 int fontset = -1;
3012 #ifdef HAVE_X_WINDOWS
3013 Lisp_Object font_param = arg;
3014 #endif
3016 /* Set the frame parameter back to the old value because we may
3017 fail to use ARG as the new parameter value. */
3018 store_frame_param (f, Qfont, oldval);
3020 /* ARG is a fontset name, a font name, a cons of fontset name and a
3021 font object, or a font object. In the last case, this function
3022 never fail. */
3023 if (STRINGP (arg))
3025 fontset = fs_query_fontset (arg, 0);
3026 if (fontset < 0)
3028 font_object = font_open_by_name (f, arg);
3029 if (NILP (font_object))
3030 error ("Font `%s' is not defined", SSDATA (arg));
3031 arg = AREF (font_object, FONT_NAME_INDEX);
3033 else if (fontset > 0)
3035 font_object = font_open_by_name (f, fontset_ascii (fontset));
3036 if (NILP (font_object))
3037 error ("Font `%s' is not defined", SDATA (arg));
3038 arg = AREF (font_object, FONT_NAME_INDEX);
3040 else
3041 error ("The default fontset can't be used for a frame font");
3043 else if (CONSP (arg) && STRINGP (XCAR (arg)) && FONT_OBJECT_P (XCDR (arg)))
3045 /* This is the case that the ASCII font of F's fontset XCAR
3046 (arg) is changed to the font XCDR (arg) by
3047 `set-fontset-font'. */
3048 fontset = fs_query_fontset (XCAR (arg), 0);
3049 if (fontset < 0)
3050 error ("Unknown fontset: %s", SDATA (XCAR (arg)));
3051 font_object = XCDR (arg);
3052 arg = AREF (font_object, FONT_NAME_INDEX);
3053 #ifdef HAVE_X_WINDOWS
3054 font_param = Ffont_get (font_object, QCname);
3055 #endif
3057 else if (FONT_OBJECT_P (arg))
3059 font_object = arg;
3060 #ifdef HAVE_X_WINDOWS
3061 font_param = Ffont_get (font_object, QCname);
3062 #endif
3063 /* This is to store the XLFD font name in the frame parameter for
3064 backward compatibility. We should store the font-object
3065 itself in the future. */
3066 arg = AREF (font_object, FONT_NAME_INDEX);
3067 fontset = FRAME_FONTSET (f);
3068 /* Check if we can use the current fontset. If not, set FONTSET
3069 to -1 to generate a new fontset from FONT-OBJECT. */
3070 if (fontset >= 0)
3072 Lisp_Object ascii_font = fontset_ascii (fontset);
3073 Lisp_Object spec = font_spec_from_name (ascii_font);
3075 if (NILP (spec))
3076 signal_error ("Invalid font name", ascii_font);
3078 if (! font_match_p (spec, font_object))
3079 fontset = -1;
3082 else
3083 signal_error ("Invalid font", arg);
3085 if (! NILP (Fequal (font_object, oldval)))
3086 return;
3088 x_new_font (f, font_object, fontset);
3089 store_frame_param (f, Qfont, arg);
3090 #ifdef HAVE_X_WINDOWS
3091 store_frame_param (f, Qfont_param, font_param);
3092 #endif
3093 /* Recalculate toolbar height. */
3094 f->n_tool_bar_rows = 0;
3095 /* Ensure we redraw it. */
3096 clear_current_matrices (f);
3098 recompute_basic_faces (f);
3100 do_pending_window_change (0);
3102 /* We used to call face-set-after-frame-default here, but it leads to
3103 recursive calls (since that function can set the `default' face's
3104 font which in turns changes the frame's `font' parameter).
3105 Also I don't know what this call is meant to do, but it seems the
3106 wrong way to do it anyway (it does a lot more work than what seems
3107 reasonable in response to a change to `font'). */
3111 void
3112 x_set_font_backend (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3114 if (! NILP (new_value)
3115 && !CONSP (new_value))
3117 char *p0, *p1;
3119 CHECK_STRING (new_value);
3120 p0 = p1 = SSDATA (new_value);
3121 new_value = Qnil;
3122 while (*p0)
3124 while (*p1 && ! c_isspace (*p1) && *p1 != ',') p1++;
3125 if (p0 < p1)
3126 new_value = Fcons (Fintern (make_string (p0, p1 - p0), Qnil),
3127 new_value);
3128 if (*p1)
3130 int c;
3132 while ((c = *++p1) && c_isspace (c));
3134 p0 = p1;
3136 new_value = Fnreverse (new_value);
3139 if (! NILP (old_value) && ! NILP (Fequal (old_value, new_value)))
3140 return;
3142 if (FRAME_FONT (f))
3143 free_all_realized_faces (Qnil);
3145 new_value = font_update_drivers (f, NILP (new_value) ? Qt : new_value);
3146 if (NILP (new_value))
3148 if (NILP (old_value))
3149 error ("No font backend available");
3150 font_update_drivers (f, old_value);
3151 error ("None of specified font backends are available");
3153 store_frame_param (f, Qfont_backend, new_value);
3155 if (FRAME_FONT (f))
3157 Lisp_Object frame;
3159 XSETFRAME (frame, f);
3160 x_set_font (f, Fframe_parameter (frame, Qfont), Qnil);
3161 ++face_change_count;
3162 ++windows_or_buffers_changed;
3167 void
3168 x_set_fringe_width (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3170 compute_fringe_widths (f, 1);
3171 #ifdef HAVE_X_WINDOWS
3172 /* Must adjust this so window managers report correct number of columns. */
3173 if (FRAME_X_WINDOW (f) != 0)
3174 x_wm_set_size_hint (f, 0, 0);
3175 #endif
3178 void
3179 x_set_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3181 CHECK_TYPE_RANGED_INTEGER (int, arg);
3183 if (XINT (arg) == f->border_width)
3184 return;
3186 if (FRAME_X_WINDOW (f) != 0)
3187 error ("Cannot change the border width of a frame");
3189 f->border_width = XINT (arg);
3192 void
3193 x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3195 int old = FRAME_INTERNAL_BORDER_WIDTH (f);
3197 CHECK_TYPE_RANGED_INTEGER (int, arg);
3198 FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
3199 if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
3200 FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
3202 #ifdef USE_X_TOOLKIT
3203 if (FRAME_X_OUTPUT (f)->edit_widget)
3204 widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
3205 #endif
3207 if (FRAME_INTERNAL_BORDER_WIDTH (f) == old)
3208 return;
3210 if (FRAME_X_WINDOW (f) != 0)
3212 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3213 SET_FRAME_GARBAGED (f);
3214 do_pending_window_change (0);
3216 else
3217 SET_FRAME_GARBAGED (f);
3220 void
3221 x_set_visibility (struct frame *f, Lisp_Object value, Lisp_Object oldval)
3223 Lisp_Object frame;
3224 XSETFRAME (frame, f);
3226 if (NILP (value))
3227 Fmake_frame_invisible (frame, Qt);
3228 else if (EQ (value, Qicon))
3229 Ficonify_frame (frame);
3230 else
3231 Fmake_frame_visible (frame);
3234 void
3235 x_set_autoraise (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3237 f->auto_raise = !EQ (Qnil, arg);
3240 void
3241 x_set_autolower (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3243 f->auto_lower = !EQ (Qnil, arg);
3246 void
3247 x_set_unsplittable (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3249 f->no_split = !NILP (arg);
3252 void
3253 x_set_vertical_scroll_bars (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3255 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
3256 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
3257 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
3258 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
3260 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
3261 = (NILP (arg)
3262 ? vertical_scroll_bar_none
3263 : EQ (Qleft, arg)
3264 ? vertical_scroll_bar_left
3265 : EQ (Qright, arg)
3266 ? vertical_scroll_bar_right
3267 : EQ (Qleft, Vdefault_frame_scroll_bars)
3268 ? vertical_scroll_bar_left
3269 : EQ (Qright, Vdefault_frame_scroll_bars)
3270 ? vertical_scroll_bar_right
3271 : vertical_scroll_bar_none);
3273 /* We set this parameter before creating the X window for the
3274 frame, so we can get the geometry right from the start.
3275 However, if the window hasn't been created yet, we shouldn't
3276 call x_set_window_size. */
3277 if (FRAME_X_WINDOW (f))
3278 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3279 do_pending_window_change (0);
3283 void
3284 x_set_scroll_bar_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3286 int wid = FRAME_COLUMN_WIDTH (f);
3288 if (NILP (arg))
3290 x_set_scroll_bar_default_width (f);
3292 if (FRAME_X_WINDOW (f))
3293 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3294 do_pending_window_change (0);
3296 else if (RANGED_INTEGERP (1, arg, INT_MAX)
3297 && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3299 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
3300 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
3302 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg);
3303 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
3304 if (FRAME_X_WINDOW (f))
3305 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3306 do_pending_window_change (0);
3309 change_frame_size (f, 0, FRAME_COLS (f), 0, 0, 0);
3310 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
3311 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
3316 /* Return non-nil if frame F wants a bitmap icon. */
3318 Lisp_Object
3319 x_icon_type (FRAME_PTR f)
3321 Lisp_Object tem;
3323 tem = assq_no_quit (Qicon_type, f->param_alist);
3324 if (CONSP (tem))
3325 return XCDR (tem);
3326 else
3327 return Qnil;
3330 void
3331 x_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3333 double alpha = 1.0;
3334 double newval[2];
3335 int i;
3336 Lisp_Object item;
3338 for (i = 0; i < 2; i++)
3340 newval[i] = 1.0;
3341 if (CONSP (arg))
3343 item = CAR (arg);
3344 arg = CDR (arg);
3346 else
3347 item = arg;
3349 if (NILP (item))
3350 alpha = - 1.0;
3351 else if (FLOATP (item))
3353 alpha = XFLOAT_DATA (item);
3354 if (! (0 <= alpha && alpha <= 1.0))
3355 args_out_of_range (make_float (0.0), make_float (1.0));
3357 else if (INTEGERP (item))
3359 EMACS_INT ialpha = XINT (item);
3360 if (! (0 <= ialpha && alpha <= 100))
3361 args_out_of_range (make_number (0), make_number (100));
3362 alpha = ialpha / 100.0;
3364 else
3365 wrong_type_argument (Qnumberp, item);
3366 newval[i] = alpha;
3369 for (i = 0; i < 2; i++)
3370 f->alpha[i] = newval[i];
3372 #if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA)
3373 block_input ();
3374 x_set_frame_alpha (f);
3375 unblock_input ();
3376 #endif
3378 return;
3382 /* Subroutines of creating an X frame. */
3384 /* Make sure that Vx_resource_name is set to a reasonable value.
3385 Fix it up, or set it to `emacs' if it is too hopeless. */
3387 void
3388 validate_x_resource_name (void)
3390 ptrdiff_t len = 0;
3391 /* Number of valid characters in the resource name. */
3392 ptrdiff_t good_count = 0;
3393 /* Number of invalid characters in the resource name. */
3394 ptrdiff_t bad_count = 0;
3395 Lisp_Object new;
3396 ptrdiff_t i;
3398 if (!STRINGP (Vx_resource_class))
3399 Vx_resource_class = build_string (EMACS_CLASS);
3401 if (STRINGP (Vx_resource_name))
3403 unsigned char *p = SDATA (Vx_resource_name);
3405 len = SBYTES (Vx_resource_name);
3407 /* Only letters, digits, - and _ are valid in resource names.
3408 Count the valid characters and count the invalid ones. */
3409 for (i = 0; i < len; i++)
3411 int c = p[i];
3412 if (! ((c >= 'a' && c <= 'z')
3413 || (c >= 'A' && c <= 'Z')
3414 || (c >= '0' && c <= '9')
3415 || c == '-' || c == '_'))
3416 bad_count++;
3417 else
3418 good_count++;
3421 else
3422 /* Not a string => completely invalid. */
3423 bad_count = 5, good_count = 0;
3425 /* If name is valid already, return. */
3426 if (bad_count == 0)
3427 return;
3429 /* If name is entirely invalid, or nearly so, or is so implausibly
3430 large that alloca might not work, use `emacs'. */
3431 if (good_count < 2 || MAX_ALLOCA - sizeof ".customization" < len)
3433 Vx_resource_name = build_string ("emacs");
3434 return;
3437 /* Name is partly valid. Copy it and replace the invalid characters
3438 with underscores. */
3440 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
3442 for (i = 0; i < len; i++)
3444 int c = SREF (new, i);
3445 if (! ((c >= 'a' && c <= 'z')
3446 || (c >= 'A' && c <= 'Z')
3447 || (c >= '0' && c <= '9')
3448 || c == '-' || c == '_'))
3449 SSET (new, i, '_');
3454 extern char *x_get_string_resource (XrmDatabase, const char *, const char *);
3455 extern Display_Info *check_x_display_info (Lisp_Object);
3458 /* Get specified attribute from resource database RDB.
3459 See Fx_get_resource below for other parameters. */
3461 static Lisp_Object
3462 xrdb_get_resource (XrmDatabase rdb, Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3464 register char *value;
3465 char *name_key;
3466 char *class_key;
3468 CHECK_STRING (attribute);
3469 CHECK_STRING (class);
3471 if (!NILP (component))
3472 CHECK_STRING (component);
3473 if (!NILP (subclass))
3474 CHECK_STRING (subclass);
3475 if (NILP (component) != NILP (subclass))
3476 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3478 validate_x_resource_name ();
3480 /* Allocate space for the components, the dots which separate them,
3481 and the final '\0'. Make them big enough for the worst case. */
3482 name_key = alloca (SBYTES (Vx_resource_name)
3483 + (STRINGP (component)
3484 ? SBYTES (component) : 0)
3485 + SBYTES (attribute)
3486 + 3);
3488 class_key = alloca (SBYTES (Vx_resource_class)
3489 + SBYTES (class)
3490 + (STRINGP (subclass)
3491 ? SBYTES (subclass) : 0)
3492 + 3);
3494 /* Start with emacs.FRAMENAME for the name (the specific one)
3495 and with `Emacs' for the class key (the general one). */
3496 strcpy (name_key, SSDATA (Vx_resource_name));
3497 strcpy (class_key, SSDATA (Vx_resource_class));
3499 strcat (class_key, ".");
3500 strcat (class_key, SSDATA (class));
3502 if (!NILP (component))
3504 strcat (class_key, ".");
3505 strcat (class_key, SSDATA (subclass));
3507 strcat (name_key, ".");
3508 strcat (name_key, SSDATA (component));
3511 strcat (name_key, ".");
3512 strcat (name_key, SSDATA (attribute));
3514 value = x_get_string_resource (rdb, name_key, class_key);
3516 if (value != (char *) 0 && *value)
3517 return build_string (value);
3518 else
3519 return Qnil;
3523 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
3524 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
3525 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
3526 class, where INSTANCE is the name under which Emacs was invoked, or
3527 the name specified by the `-name' or `-rn' command-line arguments.
3529 The optional arguments COMPONENT and SUBCLASS add to the key and the
3530 class, respectively. You must specify both of them or neither.
3531 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
3532 and the class is `Emacs.CLASS.SUBCLASS'. */)
3533 (Lisp_Object attribute, Lisp_Object class, Lisp_Object component,
3534 Lisp_Object subclass)
3536 check_window_system (NULL);
3538 return xrdb_get_resource (check_x_display_info (Qnil)->xrdb,
3539 attribute, class, component, subclass);
3542 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
3544 Lisp_Object
3545 display_x_get_resource (Display_Info *dpyinfo, Lisp_Object attribute,
3546 Lisp_Object class, Lisp_Object component,
3547 Lisp_Object subclass)
3549 return xrdb_get_resource (dpyinfo->xrdb,
3550 attribute, class, component, subclass);
3553 #if defined HAVE_X_WINDOWS && !defined USE_X_TOOLKIT
3554 /* Used when C code wants a resource value. */
3555 /* Called from oldXMenu/Create.c. */
3556 char *
3557 x_get_resource_string (const char *attribute, const char *class)
3559 char *result;
3560 struct frame *sf = SELECTED_FRAME ();
3561 ptrdiff_t invocation_namelen = SBYTES (Vinvocation_name);
3562 USE_SAFE_ALLOCA;
3564 /* Allocate space for the components, the dots which separate them,
3565 and the final '\0'. */
3566 char *name_key = SAFE_ALLOCA (invocation_namelen + strlen (attribute) + 2);
3567 char *class_key = alloca ((sizeof (EMACS_CLASS) - 1) + strlen (class) + 2);
3569 esprintf (name_key, "%s.%s", SSDATA (Vinvocation_name), attribute);
3570 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3572 result = x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
3573 name_key, class_key);
3574 SAFE_FREE ();
3575 return result;
3577 #endif
3579 /* Return the value of parameter PARAM.
3581 First search ALIST, then Vdefault_frame_alist, then the X defaults
3582 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3584 Convert the resource to the type specified by desired_type.
3586 If no default is specified, return Qunbound. If you call
3587 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3588 and don't let it get stored in any Lisp-visible variables! */
3590 Lisp_Object
3591 x_get_arg (Display_Info *dpyinfo, Lisp_Object alist, Lisp_Object param,
3592 const char *attribute, const char *class, enum resource_types type)
3594 register Lisp_Object tem;
3596 tem = Fassq (param, alist);
3598 if (!NILP (tem))
3600 /* If we find this parm in ALIST, clear it out
3601 so that it won't be "left over" at the end. */
3602 Lisp_Object tail;
3603 XSETCAR (tem, Qnil);
3604 /* In case the parameter appears more than once in the alist,
3605 clear it out. */
3606 for (tail = alist; CONSP (tail); tail = XCDR (tail))
3607 if (CONSP (XCAR (tail))
3608 && EQ (XCAR (XCAR (tail)), param))
3609 XSETCAR (XCAR (tail), Qnil);
3611 else
3612 tem = Fassq (param, Vdefault_frame_alist);
3614 /* If it wasn't specified in ALIST or the Lisp-level defaults,
3615 look in the X resources. */
3616 if (EQ (tem, Qnil))
3618 if (attribute && dpyinfo)
3620 tem = display_x_get_resource (dpyinfo,
3621 build_string (attribute),
3622 build_string (class),
3623 Qnil, Qnil);
3625 if (NILP (tem))
3626 return Qunbound;
3628 switch (type)
3630 case RES_TYPE_NUMBER:
3631 return make_number (atoi (SSDATA (tem)));
3633 case RES_TYPE_BOOLEAN_NUMBER:
3634 if (!strcmp (SSDATA (tem), "on")
3635 || !strcmp (SSDATA (tem), "true"))
3636 return make_number (1);
3637 return make_number (atoi (SSDATA (tem)));
3638 break;
3640 case RES_TYPE_FLOAT:
3641 return make_float (atof (SSDATA (tem)));
3643 case RES_TYPE_BOOLEAN:
3644 tem = Fdowncase (tem);
3645 if (!strcmp (SSDATA (tem), "on")
3646 #ifdef HAVE_NS
3647 || !strcmp (SSDATA (tem), "yes")
3648 #endif
3649 || !strcmp (SSDATA (tem), "true"))
3650 return Qt;
3651 else
3652 return Qnil;
3654 case RES_TYPE_STRING:
3655 return tem;
3657 case RES_TYPE_SYMBOL:
3658 /* As a special case, we map the values `true' and `on'
3659 to Qt, and `false' and `off' to Qnil. */
3661 Lisp_Object lower;
3662 lower = Fdowncase (tem);
3663 if (!strcmp (SSDATA (lower), "on")
3664 #ifdef HAVE_NS
3665 || !strcmp (SSDATA (lower), "yes")
3666 #endif
3667 || !strcmp (SSDATA (lower), "true"))
3668 return Qt;
3669 else if (!strcmp (SSDATA (lower), "off")
3670 #ifdef HAVE_NS
3671 || !strcmp (SSDATA (lower), "no")
3672 #endif
3673 || !strcmp (SSDATA (lower), "false"))
3674 return Qnil;
3675 else
3676 return Fintern (tem, Qnil);
3679 default:
3680 emacs_abort ();
3683 else
3684 return Qunbound;
3686 return Fcdr (tem);
3689 static Lisp_Object
3690 x_frame_get_arg (struct frame *f, Lisp_Object alist, Lisp_Object param,
3691 const char *attribute, const char *class,
3692 enum resource_types type)
3694 return x_get_arg (FRAME_X_DISPLAY_INFO (f),
3695 alist, param, attribute, class, type);
3698 /* Like x_frame_get_arg, but also record the value in f->param_alist. */
3700 Lisp_Object
3701 x_frame_get_and_record_arg (struct frame *f, Lisp_Object alist,
3702 Lisp_Object param,
3703 const char *attribute, const char *class,
3704 enum resource_types type)
3706 Lisp_Object value;
3708 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
3709 attribute, class, type);
3710 if (! NILP (value) && ! EQ (value, Qunbound))
3711 store_frame_param (f, param, value);
3713 return value;
3717 /* Record in frame F the specified or default value according to ALIST
3718 of the parameter named PROP (a Lisp symbol).
3719 If no value is specified for PROP, look for an X default for XPROP
3720 on the frame named NAME.
3721 If that is not found either, use the value DEFLT. */
3723 Lisp_Object
3724 x_default_parameter (struct frame *f, Lisp_Object alist, Lisp_Object prop,
3725 Lisp_Object deflt, const char *xprop, const char *xclass,
3726 enum resource_types type)
3728 Lisp_Object tem;
3730 tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type);
3731 if (EQ (tem, Qunbound))
3732 tem = deflt;
3733 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
3734 return tem;
3738 #if !defined (HAVE_X_WINDOWS) && defined (NoValue)
3741 * XParseGeometry parses strings of the form
3742 * "=<width>x<height>{+-}<xoffset>{+-}<yoffset>", where
3743 * width, height, xoffset, and yoffset are unsigned integers.
3744 * Example: "=80x24+300-49"
3745 * The equal sign is optional.
3746 * It returns a bitmask that indicates which of the four values
3747 * were actually found in the string. For each value found,
3748 * the corresponding argument is updated; for each value
3749 * not found, the corresponding argument is left unchanged.
3752 static int
3753 XParseGeometry (char *string,
3754 int *x, int *y,
3755 unsigned int *width, unsigned int *height)
3757 int mask = NoValue;
3758 char *strind;
3759 unsigned long int tempWidth, tempHeight;
3760 long int tempX, tempY;
3761 char *nextCharacter;
3763 if (string == NULL || *string == '\0')
3764 return mask;
3765 if (*string == '=')
3766 string++; /* ignore possible '=' at beg of geometry spec */
3768 strind = string;
3769 if (*strind != '+' && *strind != '-' && *strind != 'x')
3771 tempWidth = strtoul (strind, &nextCharacter, 10);
3772 if (strind == nextCharacter)
3773 return 0;
3774 strind = nextCharacter;
3775 mask |= WidthValue;
3778 if (*strind == 'x' || *strind == 'X')
3780 strind++;
3781 tempHeight = strtoul (strind, &nextCharacter, 10);
3782 if (strind == nextCharacter)
3783 return 0;
3784 strind = nextCharacter;
3785 mask |= HeightValue;
3788 if (*strind == '+' || *strind == '-')
3790 if (*strind == '-')
3791 mask |= XNegative;
3792 tempX = strtol (strind, &nextCharacter, 10);
3793 if (strind == nextCharacter)
3794 return 0;
3795 strind = nextCharacter;
3796 mask |= XValue;
3797 if (*strind == '+' || *strind == '-')
3799 if (*strind == '-')
3800 mask |= YNegative;
3801 tempY = strtol (strind, &nextCharacter, 10);
3802 if (strind == nextCharacter)
3803 return 0;
3804 strind = nextCharacter;
3805 mask |= YValue;
3809 /* If strind isn't at the end of the string then it's an invalid
3810 geometry specification. */
3812 if (*strind != '\0')
3813 return 0;
3815 if (mask & XValue)
3816 *x = clip_to_bounds (INT_MIN, tempX, INT_MAX);
3817 if (mask & YValue)
3818 *y = clip_to_bounds (INT_MIN, tempY, INT_MAX);
3819 if (mask & WidthValue)
3820 *width = min (tempWidth, UINT_MAX);
3821 if (mask & HeightValue)
3822 *height = min (tempHeight, UINT_MAX);
3823 return mask;
3826 #endif /* !defined (HAVE_X_WINDOWS) && defined (NoValue) */
3829 /* NS used to define x-parse-geometry in ns-win.el, but that confused
3830 make-docfile: the documentation string in ns-win.el was used for
3831 x-parse-geometry even in non-NS builds.
3833 With two definitions of x-parse-geometry in this file, various
3834 things still get confused (eg M-x apropos documentation), so that
3835 it is best if the two definitions just share the same doc-string.
3837 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
3838 doc: /* Parse a display geometry string STRING.
3839 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3840 The properties returned may include `top', `left', `height', and `width'.
3841 For X, the value of `left' or `top' may be an integer,
3842 or a list (+ N) meaning N pixels relative to top/left corner,
3843 or a list (- N) meaning -N pixels relative to bottom/right corner.
3844 On Nextstep, this just calls `ns-parse-geometry'. */)
3845 (Lisp_Object string)
3847 int geometry, x, y;
3848 unsigned int width, height;
3849 Lisp_Object result;
3851 CHECK_STRING (string);
3853 #ifdef HAVE_NS
3854 if (strchr (SSDATA (string), ' ') != NULL)
3855 return call1 (Qns_parse_geometry, string);
3856 #endif
3857 geometry = XParseGeometry (SSDATA (string),
3858 &x, &y, &width, &height);
3859 result = Qnil;
3860 if (geometry & XValue)
3862 Lisp_Object element;
3864 if (x >= 0 && (geometry & XNegative))
3865 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
3866 else if (x < 0 && ! (geometry & XNegative))
3867 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
3868 else
3869 element = Fcons (Qleft, make_number (x));
3870 result = Fcons (element, result);
3873 if (geometry & YValue)
3875 Lisp_Object element;
3877 if (y >= 0 && (geometry & YNegative))
3878 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
3879 else if (y < 0 && ! (geometry & YNegative))
3880 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
3881 else
3882 element = Fcons (Qtop, make_number (y));
3883 result = Fcons (element, result);
3886 if (geometry & WidthValue)
3887 result = Fcons (Fcons (Qwidth, make_number (width)), result);
3888 if (geometry & HeightValue)
3889 result = Fcons (Fcons (Qheight, make_number (height)), result);
3891 return result;
3895 /* Calculate the desired size and position of frame F.
3896 Return the flags saying which aspects were specified.
3898 Also set the win_gravity and size_hint_flags of F.
3900 Adjust height for toolbar if TOOLBAR_P is 1.
3902 This function does not make the coordinates positive. */
3904 #define DEFAULT_ROWS 35
3905 #define DEFAULT_COLS 80
3908 x_figure_window_size (struct frame *f, Lisp_Object parms, int toolbar_p)
3910 register Lisp_Object tem0, tem1, tem2;
3911 long window_prompting = 0;
3912 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3914 /* Default values if we fall through.
3915 Actually, if that happens we should get
3916 window manager prompting. */
3917 SET_FRAME_COLS (f, DEFAULT_COLS);
3918 FRAME_LINES (f) = DEFAULT_ROWS;
3919 /* Window managers expect that if program-specified
3920 positions are not (0,0), they're intentional, not defaults. */
3921 f->top_pos = 0;
3922 f->left_pos = 0;
3924 /* Ensure that old new_text_cols and new_text_lines will not override the
3925 values set here. */
3926 /* ++KFS: This was specific to W32, but seems ok for all platforms */
3927 f->new_text_cols = f->new_text_lines = 0;
3929 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
3930 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
3931 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
3932 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3934 if (!EQ (tem0, Qunbound))
3936 CHECK_NUMBER (tem0);
3937 if (! (0 <= XINT (tem0) && XINT (tem0) <= INT_MAX))
3938 xsignal1 (Qargs_out_of_range, tem0);
3939 FRAME_LINES (f) = XINT (tem0);
3941 if (!EQ (tem1, Qunbound))
3943 CHECK_NUMBER (tem1);
3944 if (! (0 <= XINT (tem1) && XINT (tem1) <= INT_MAX))
3945 xsignal1 (Qargs_out_of_range, tem1);
3946 SET_FRAME_COLS (f, XINT (tem1));
3948 if (!NILP (tem2) && !EQ (tem2, Qunbound))
3949 window_prompting |= USSize;
3950 else
3951 window_prompting |= PSize;
3954 f->scroll_bar_actual_width
3955 = FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f);
3957 /* This used to be done _before_ calling x_figure_window_size, but
3958 since the height is reset here, this was really a no-op. I
3959 assume that moving it here does what Gerd intended (although he
3960 no longer can remember what that was... ++KFS, 2003-03-25. */
3962 /* Add the tool-bar height to the initial frame height so that the
3963 user gets a text display area of the size he specified with -g or
3964 via .Xdefaults. Later changes of the tool-bar height don't
3965 change the frame size. This is done so that users can create
3966 tall Emacs frames without having to guess how tall the tool-bar
3967 will get. */
3968 if (toolbar_p && FRAME_TOOL_BAR_LINES (f))
3970 int margin, relief, bar_height;
3972 relief = (tool_bar_button_relief >= 0
3973 ? tool_bar_button_relief
3974 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
3976 if (RANGED_INTEGERP (1, Vtool_bar_button_margin, INT_MAX))
3977 margin = XFASTINT (Vtool_bar_button_margin);
3978 else if (CONSP (Vtool_bar_button_margin)
3979 && RANGED_INTEGERP (1, XCDR (Vtool_bar_button_margin), INT_MAX))
3980 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
3981 else
3982 margin = 0;
3984 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
3985 FRAME_LINES (f) += (bar_height + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f);
3988 compute_fringe_widths (f, 0);
3990 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, FRAME_COLS (f));
3991 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, FRAME_LINES (f));
3993 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
3994 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
3995 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
3996 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3998 if (EQ (tem0, Qminus))
4000 f->top_pos = 0;
4001 window_prompting |= YNegative;
4003 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
4004 && CONSP (XCDR (tem0))
4005 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (tem0)), INT_MAX))
4007 f->top_pos = - XINT (XCAR (XCDR (tem0)));
4008 window_prompting |= YNegative;
4010 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
4011 && CONSP (XCDR (tem0))
4012 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (tem0))))
4014 f->top_pos = XINT (XCAR (XCDR (tem0)));
4016 else if (EQ (tem0, Qunbound))
4017 f->top_pos = 0;
4018 else
4020 CHECK_TYPE_RANGED_INTEGER (int, tem0);
4021 f->top_pos = XINT (tem0);
4022 if (f->top_pos < 0)
4023 window_prompting |= YNegative;
4026 if (EQ (tem1, Qminus))
4028 f->left_pos = 0;
4029 window_prompting |= XNegative;
4031 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
4032 && CONSP (XCDR (tem1))
4033 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (tem1)), INT_MAX))
4035 f->left_pos = - XINT (XCAR (XCDR (tem1)));
4036 window_prompting |= XNegative;
4038 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
4039 && CONSP (XCDR (tem1))
4040 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (tem1))))
4042 f->left_pos = XINT (XCAR (XCDR (tem1)));
4044 else if (EQ (tem1, Qunbound))
4045 f->left_pos = 0;
4046 else
4048 CHECK_TYPE_RANGED_INTEGER (int, tem1);
4049 f->left_pos = XINT (tem1);
4050 if (f->left_pos < 0)
4051 window_prompting |= XNegative;
4054 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
4055 window_prompting |= USPosition;
4056 else
4057 window_prompting |= PPosition;
4060 if (window_prompting & XNegative)
4062 if (window_prompting & YNegative)
4063 f->win_gravity = SouthEastGravity;
4064 else
4065 f->win_gravity = NorthEastGravity;
4067 else
4069 if (window_prompting & YNegative)
4070 f->win_gravity = SouthWestGravity;
4071 else
4072 f->win_gravity = NorthWestGravity;
4075 f->size_hint_flags = window_prompting;
4077 return window_prompting;
4082 #endif /* HAVE_WINDOW_SYSTEM */
4084 void
4085 frame_make_pointer_invisible (void)
4087 if (! NILP (Vmake_pointer_invisible))
4089 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
4095 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4097 f->mouse_moved = 0;
4098 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 1);
4099 f->pointer_invisible = 1;
4104 void
4105 frame_make_pointer_visible (void)
4107 /* We don't check Vmake_pointer_invisible here in case the
4108 pointer was invisible when Vmake_pointer_invisible was set to nil. */
4109 struct frame *f;
4111 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4112 return;
4114 f = SELECTED_FRAME ();
4115 if (f && f->pointer_invisible && f->mouse_moved
4116 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4118 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 0);
4119 f->pointer_invisible = 0;
4123 DEFUN ("frame-pointer-visible-p", Fframe_pointer_visible_p,
4124 Sframe_pointer_visible_p, 0, 1, 0,
4125 doc: /* Return t if the mouse pointer displayed on FRAME is visible.
4126 Otherwise it returns nil. FRAME omitted or nil means the
4127 selected frame. This is useful when `make-pointer-invisible' is set. */)
4128 (Lisp_Object frame)
4130 return decode_any_frame (frame)->pointer_invisible ? Qnil : Qt;
4135 /***********************************************************************
4136 Multimonitor data
4137 ***********************************************************************/
4139 #ifdef HAVE_WINDOW_SYSTEM
4141 # if (defined HAVE_NS \
4142 || (!defined USE_GTK && (defined HAVE_XINERAMA || defined HAVE_XRANDR)))
4143 void
4144 free_monitors (struct MonitorInfo *monitors, int n_monitors)
4146 int i;
4147 for (i = 0; i < n_monitors; ++i)
4148 xfree (monitors[i].name);
4149 xfree (monitors);
4151 # endif
4153 Lisp_Object
4154 make_monitor_attribute_list (struct MonitorInfo *monitors,
4155 int n_monitors,
4156 int primary_monitor,
4157 Lisp_Object monitor_frames,
4158 const char *source)
4160 Lisp_Object attributes_list = Qnil;
4161 Lisp_Object primary_monitor_attributes = Qnil;
4162 int i;
4164 for (i = 0; i < n_monitors; ++i)
4166 Lisp_Object geometry, workarea, attributes = Qnil;
4167 struct MonitorInfo *mi = &monitors[i];
4169 if (mi->geom.width == 0) continue;
4171 workarea = list4i (mi->work.x, mi->work.y,
4172 mi->work.width, mi->work.height);
4173 geometry = list4i (mi->geom.x, mi->geom.y,
4174 mi->geom.width, mi->geom.height);
4175 attributes = Fcons (Fcons (Qsource,
4176 make_string (source, strlen (source))),
4177 attributes);
4178 attributes = Fcons (Fcons (Qframes, AREF (monitor_frames, i)),
4179 attributes);
4180 attributes = Fcons (Fcons (Qmm_size,
4181 list2i (mi->mm_width, mi->mm_height)),
4182 attributes);
4183 attributes = Fcons (Fcons (Qworkarea, workarea), attributes);
4184 attributes = Fcons (Fcons (Qgeometry, geometry), attributes);
4185 if (mi->name)
4186 attributes = Fcons (Fcons (Qname, make_string (mi->name,
4187 strlen (mi->name))),
4188 attributes);
4190 if (i == primary_monitor)
4191 primary_monitor_attributes = attributes;
4192 else
4193 attributes_list = Fcons (attributes, attributes_list);
4196 if (!NILP (primary_monitor_attributes))
4197 attributes_list = Fcons (primary_monitor_attributes, attributes_list);
4198 return attributes_list;
4201 #endif /* HAVE_WINDOW_SYSTEM */
4204 /***********************************************************************
4205 Initialization
4206 ***********************************************************************/
4208 void
4209 syms_of_frame (void)
4211 DEFSYM (Qframep, "framep");
4212 DEFSYM (Qframe_live_p, "frame-live-p");
4213 DEFSYM (Qexplicit_name, "explicit-name");
4214 DEFSYM (Qheight, "height");
4215 DEFSYM (Qicon, "icon");
4216 DEFSYM (Qminibuffer, "minibuffer");
4217 DEFSYM (Qmodeline, "modeline");
4218 DEFSYM (Qonly, "only");
4219 DEFSYM (Qnone, "none");
4220 DEFSYM (Qwidth, "width");
4221 DEFSYM (Qgeometry, "geometry");
4222 DEFSYM (Qicon_left, "icon-left");
4223 DEFSYM (Qicon_top, "icon-top");
4224 DEFSYM (Qtooltip, "tooltip");
4225 DEFSYM (Qleft, "left");
4226 DEFSYM (Qright, "right");
4227 DEFSYM (Quser_position, "user-position");
4228 DEFSYM (Quser_size, "user-size");
4229 DEFSYM (Qwindow_id, "window-id");
4230 #ifdef HAVE_X_WINDOWS
4231 DEFSYM (Qouter_window_id, "outer-window-id");
4232 #endif
4233 DEFSYM (Qparent_id, "parent-id");
4234 DEFSYM (Qx, "x");
4235 DEFSYM (Qw32, "w32");
4236 DEFSYM (Qpc, "pc");
4237 DEFSYM (Qns, "ns");
4238 DEFSYM (Qvisible, "visible");
4239 DEFSYM (Qbuffer_predicate, "buffer-predicate");
4240 DEFSYM (Qbuffer_list, "buffer-list");
4241 DEFSYM (Qburied_buffer_list, "buried-buffer-list");
4242 DEFSYM (Qdisplay_type, "display-type");
4243 DEFSYM (Qbackground_mode, "background-mode");
4244 DEFSYM (Qnoelisp, "noelisp");
4245 DEFSYM (Qtty_color_mode, "tty-color-mode");
4246 DEFSYM (Qtty, "tty");
4247 DEFSYM (Qtty_type, "tty-type");
4249 DEFSYM (Qface_set_after_frame_default, "face-set-after-frame-default");
4251 DEFSYM (Qfullwidth, "fullwidth");
4252 DEFSYM (Qfullheight, "fullheight");
4253 DEFSYM (Qfullboth, "fullboth");
4254 DEFSYM (Qmaximized, "maximized");
4255 DEFSYM (Qx_resource_name, "x-resource-name");
4256 DEFSYM (Qx_frame_parameter, "x-frame-parameter");
4258 DEFSYM (Qterminal, "terminal");
4259 DEFSYM (Qterminal_live_p, "terminal-live-p");
4261 DEFSYM (Qgeometry, "geometry");
4262 DEFSYM (Qworkarea, "workarea");
4263 DEFSYM (Qmm_size, "mm-size");
4264 DEFSYM (Qframes, "frames");
4265 DEFSYM (Qsource, "source");
4267 #ifdef HAVE_NS
4268 DEFSYM (Qns_parse_geometry, "ns-parse-geometry");
4269 #endif
4272 int i;
4274 for (i = 0; i < sizeof (frame_parms) / sizeof (frame_parms[0]); i++)
4276 Lisp_Object v = intern_c_string (frame_parms[i].name);
4277 if (frame_parms[i].variable)
4279 *frame_parms[i].variable = v;
4280 staticpro (frame_parms[i].variable);
4282 Fput (v, Qx_frame_parameter, make_number (i));
4286 #ifdef HAVE_WINDOW_SYSTEM
4287 DEFVAR_LISP ("x-resource-name", Vx_resource_name,
4288 doc: /* The name Emacs uses to look up X resources.
4289 `x-get-resource' uses this as the first component of the instance name
4290 when requesting resource values.
4291 Emacs initially sets `x-resource-name' to the name under which Emacs
4292 was invoked, or to the value specified with the `-name' or `-rn'
4293 switches, if present.
4295 It may be useful to bind this variable locally around a call
4296 to `x-get-resource'. See also the variable `x-resource-class'. */);
4297 Vx_resource_name = Qnil;
4299 DEFVAR_LISP ("x-resource-class", Vx_resource_class,
4300 doc: /* The class Emacs uses to look up X resources.
4301 `x-get-resource' uses this as the first component of the instance class
4302 when requesting resource values.
4304 Emacs initially sets `x-resource-class' to "Emacs".
4306 Setting this variable permanently is not a reasonable thing to do,
4307 but binding this variable locally around a call to `x-get-resource'
4308 is a reasonable practice. See also the variable `x-resource-name'. */);
4309 Vx_resource_class = build_string (EMACS_CLASS);
4311 DEFVAR_LISP ("frame-alpha-lower-limit", Vframe_alpha_lower_limit,
4312 doc: /* The lower limit of the frame opacity (alpha transparency).
4313 The value should range from 0 (invisible) to 100 (completely opaque).
4314 You can also use a floating number between 0.0 and 1.0.
4315 The default is 20. */);
4316 Vframe_alpha_lower_limit = make_number (20);
4317 #endif
4319 DEFVAR_LISP ("default-frame-alist", Vdefault_frame_alist,
4320 doc: /* Alist of default values for frame creation.
4321 These may be set in your init file, like this:
4322 (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1)))
4323 These override values given in window system configuration data,
4324 including X Windows' defaults database.
4325 For values specific to the first Emacs frame, see `initial-frame-alist'.
4326 For window-system specific values, see `window-system-default-frame-alist'.
4327 For values specific to the separate minibuffer frame, see
4328 `minibuffer-frame-alist'.
4329 The `menu-bar-lines' element of the list controls whether new frames
4330 have menu bars; `menu-bar-mode' works by altering this element.
4331 Setting this variable does not affect existing frames, only new ones. */);
4332 Vdefault_frame_alist = Qnil;
4334 DEFVAR_LISP ("default-frame-scroll-bars", Vdefault_frame_scroll_bars,
4335 doc: /* Default position of scroll bars on this window-system. */);
4336 #ifdef HAVE_WINDOW_SYSTEM
4337 #if defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA) || (defined (USE_GTK) && defined (USE_TOOLKIT_SCROLL_BARS))
4338 /* MS-Windows, Mac OS X, and GTK have scroll bars on the right by
4339 default. */
4340 Vdefault_frame_scroll_bars = Qright;
4341 #else
4342 Vdefault_frame_scroll_bars = Qleft;
4343 #endif
4344 #else
4345 Vdefault_frame_scroll_bars = Qnil;
4346 #endif
4348 DEFVAR_BOOL ("scroll-bar-adjust-thumb-portion",
4349 scroll_bar_adjust_thumb_portion_p,
4350 doc: /* Adjust thumb for overscrolling for Gtk+ and MOTIF.
4351 Non-nil means adjust the thumb in the scroll bar so it can be dragged downwards
4352 even if the end of the buffer is shown (i.e. overscrolling).
4353 Set to nil if you want the thumb to be at the bottom when the end of the buffer
4354 is shown. Also, the thumb fills the whole scroll bar when the entire buffer
4355 is visible. In this case you can not overscroll. */);
4356 scroll_bar_adjust_thumb_portion_p = 1;
4358 DEFVAR_LISP ("terminal-frame", Vterminal_frame,
4359 doc: /* The initial frame-object, which represents Emacs's stdout. */);
4361 DEFVAR_LISP ("mouse-position-function", Vmouse_position_function,
4362 doc: /* If non-nil, function to transform normal value of `mouse-position'.
4363 `mouse-position' calls this function, passing its usual return value as
4364 argument, and returns whatever this function returns.
4365 This abnormal hook exists for the benefit of packages like `xt-mouse.el'
4366 which need to do mouse handling at the Lisp level. */);
4367 Vmouse_position_function = Qnil;
4369 DEFVAR_LISP ("mouse-highlight", Vmouse_highlight,
4370 doc: /* If non-nil, clickable text is highlighted when mouse is over it.
4371 If the value is an integer, highlighting is only shown after moving the
4372 mouse, while keyboard input turns off the highlight even when the mouse
4373 is over the clickable text. However, the mouse shape still indicates
4374 when the mouse is over clickable text. */);
4375 Vmouse_highlight = Qt;
4377 DEFVAR_LISP ("make-pointer-invisible", Vmake_pointer_invisible,
4378 doc: /* If non-nil, make pointer invisible while typing.
4379 The pointer becomes visible again when the mouse is moved. */);
4380 Vmake_pointer_invisible = Qt;
4382 DEFVAR_LISP ("delete-frame-functions", Vdelete_frame_functions,
4383 doc: /* Functions run before deleting a frame.
4384 The functions are run with one arg, the frame to be deleted.
4385 See `delete-frame'.
4387 Note that functions in this list may be called just before the frame is
4388 actually deleted, or some time later (or even both when an earlier function
4389 in `delete-frame-functions' (indirectly) calls `delete-frame'
4390 recursively). */);
4391 Vdelete_frame_functions = Qnil;
4392 DEFSYM (Qdelete_frame_functions, "delete-frame-functions");
4394 DEFVAR_LISP ("menu-bar-mode", Vmenu_bar_mode,
4395 doc: /* Non-nil if Menu-Bar mode is enabled.
4396 See the command `menu-bar-mode' for a description of this minor mode.
4397 Setting this variable directly does not take effect;
4398 either customize it (see the info node `Easy Customization')
4399 or call the function `menu-bar-mode'. */);
4400 Vmenu_bar_mode = Qt;
4402 DEFVAR_LISP ("tool-bar-mode", Vtool_bar_mode,
4403 doc: /* Non-nil if Tool-Bar mode is enabled.
4404 See the command `tool-bar-mode' for a description of this minor mode.
4405 Setting this variable directly does not take effect;
4406 either customize it (see the info node `Easy Customization')
4407 or call the function `tool-bar-mode'. */);
4408 #ifdef HAVE_WINDOW_SYSTEM
4409 Vtool_bar_mode = Qt;
4410 #else
4411 Vtool_bar_mode = Qnil;
4412 #endif
4414 DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
4415 doc: /* Minibufferless frames use this frame's minibuffer.
4417 Emacs cannot create minibufferless frames unless this is set to an
4418 appropriate surrogate.
4420 Emacs consults this variable only when creating minibufferless
4421 frames; once the frame is created, it sticks with its assigned
4422 minibuffer, no matter what this variable is set to. This means that
4423 this variable doesn't necessarily say anything meaningful about the
4424 current set of frames, or where the minibuffer is currently being
4425 displayed.
4427 This variable is local to the current terminal and cannot be buffer-local. */);
4429 DEFVAR_BOOL ("focus-follows-mouse", focus_follows_mouse,
4430 doc: /* Non-nil if window system changes focus when you move the mouse.
4431 You should set this variable to tell Emacs how your window manager
4432 handles focus, since there is no way in general for Emacs to find out
4433 automatically. See also `mouse-autoselect-window'. */);
4434 focus_follows_mouse = 0;
4436 staticpro (&Vframe_list);
4438 defsubr (&Sframep);
4439 defsubr (&Sframe_live_p);
4440 defsubr (&Swindow_system);
4441 defsubr (&Smake_terminal_frame);
4442 defsubr (&Shandle_switch_frame);
4443 defsubr (&Sselect_frame);
4444 defsubr (&Sselected_frame);
4445 defsubr (&Sframe_list);
4446 defsubr (&Snext_frame);
4447 defsubr (&Sprevious_frame);
4448 defsubr (&Sdelete_frame);
4449 defsubr (&Smouse_position);
4450 defsubr (&Smouse_pixel_position);
4451 defsubr (&Sset_mouse_position);
4452 defsubr (&Sset_mouse_pixel_position);
4453 #if 0
4454 defsubr (&Sframe_configuration);
4455 defsubr (&Srestore_frame_configuration);
4456 #endif
4457 defsubr (&Smake_frame_visible);
4458 defsubr (&Smake_frame_invisible);
4459 defsubr (&Siconify_frame);
4460 defsubr (&Sframe_visible_p);
4461 defsubr (&Svisible_frame_list);
4462 defsubr (&Sraise_frame);
4463 defsubr (&Slower_frame);
4464 defsubr (&Sredirect_frame_focus);
4465 defsubr (&Sframe_focus);
4466 defsubr (&Sframe_parameters);
4467 defsubr (&Sframe_parameter);
4468 defsubr (&Smodify_frame_parameters);
4469 defsubr (&Sframe_char_height);
4470 defsubr (&Sframe_char_width);
4471 defsubr (&Sframe_pixel_height);
4472 defsubr (&Sframe_pixel_width);
4473 defsubr (&Stool_bar_pixel_width);
4474 defsubr (&Sset_frame_height);
4475 defsubr (&Sset_frame_width);
4476 defsubr (&Sset_frame_size);
4477 defsubr (&Sset_frame_position);
4478 defsubr (&Sframe_pointer_visible_p);
4480 #ifdef HAVE_WINDOW_SYSTEM
4481 defsubr (&Sx_get_resource);
4482 defsubr (&Sx_parse_geometry);
4483 #endif