Fix bug #14822 with decoding when inhibit-null-byte-detection is non-nil.
[emacs.git] / src / frame.c
blob648687a7cb4e9ce7629a49ad05097d41a74bcf97
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 tem = make_natnum ((uintptr_t) 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 if (FLOATP (new_value))
2969 int new_spacing = XFLOAT_DATA (new_value) * FRAME_LINE_HEIGHT (f) + 0.5;
2971 if (new_spacing >= 0)
2972 f->extra_line_spacing = new_spacing;
2973 else
2974 signal_error ("Invalid line-spacing", new_value);
2976 else
2977 signal_error ("Invalid line-spacing", new_value);
2978 if (FRAME_VISIBLE_P (f))
2979 redraw_frame (f);
2983 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
2984 the previous value of that parameter, NEW_VALUE is the new value. */
2986 void
2987 x_set_screen_gamma (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
2989 Lisp_Object bgcolor;
2991 if (NILP (new_value))
2992 f->gamma = 0;
2993 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
2994 /* The value 0.4545 is the normal viewing gamma. */
2995 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
2996 else
2997 signal_error ("Invalid screen-gamma", new_value);
2999 /* Apply the new gamma value to the frame background. */
3000 bgcolor = Fassq (Qbackground_color, f->param_alist);
3001 if (CONSP (bgcolor) && (bgcolor = XCDR (bgcolor), STRINGP (bgcolor)))
3003 Lisp_Object parm_index = Fget (Qbackground_color, Qx_frame_parameter);
3004 if (NATNUMP (parm_index)
3005 && (XFASTINT (parm_index)
3006 < sizeof (frame_parms)/sizeof (frame_parms[0]))
3007 && FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
3008 (*FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
3009 (f, bgcolor, Qnil);
3012 Fclear_face_cache (Qnil);
3016 void
3017 x_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3019 Lisp_Object font_object;
3020 int fontset = -1;
3021 #ifdef HAVE_X_WINDOWS
3022 Lisp_Object font_param = arg;
3023 #endif
3025 /* Set the frame parameter back to the old value because we may
3026 fail to use ARG as the new parameter value. */
3027 store_frame_param (f, Qfont, oldval);
3029 /* ARG is a fontset name, a font name, a cons of fontset name and a
3030 font object, or a font object. In the last case, this function
3031 never fail. */
3032 if (STRINGP (arg))
3034 fontset = fs_query_fontset (arg, 0);
3035 if (fontset < 0)
3037 font_object = font_open_by_name (f, arg);
3038 if (NILP (font_object))
3039 error ("Font `%s' is not defined", SSDATA (arg));
3040 arg = AREF (font_object, FONT_NAME_INDEX);
3042 else if (fontset > 0)
3044 font_object = font_open_by_name (f, fontset_ascii (fontset));
3045 if (NILP (font_object))
3046 error ("Font `%s' is not defined", SDATA (arg));
3047 arg = AREF (font_object, FONT_NAME_INDEX);
3049 else
3050 error ("The default fontset can't be used for a frame font");
3052 else if (CONSP (arg) && STRINGP (XCAR (arg)) && FONT_OBJECT_P (XCDR (arg)))
3054 /* This is the case that the ASCII font of F's fontset XCAR
3055 (arg) is changed to the font XCDR (arg) by
3056 `set-fontset-font'. */
3057 fontset = fs_query_fontset (XCAR (arg), 0);
3058 if (fontset < 0)
3059 error ("Unknown fontset: %s", SDATA (XCAR (arg)));
3060 font_object = XCDR (arg);
3061 arg = AREF (font_object, FONT_NAME_INDEX);
3062 #ifdef HAVE_X_WINDOWS
3063 font_param = Ffont_get (font_object, QCname);
3064 #endif
3066 else if (FONT_OBJECT_P (arg))
3068 font_object = arg;
3069 #ifdef HAVE_X_WINDOWS
3070 font_param = Ffont_get (font_object, QCname);
3071 #endif
3072 /* This is to store the XLFD font name in the frame parameter for
3073 backward compatibility. We should store the font-object
3074 itself in the future. */
3075 arg = AREF (font_object, FONT_NAME_INDEX);
3076 fontset = FRAME_FONTSET (f);
3077 /* Check if we can use the current fontset. If not, set FONTSET
3078 to -1 to generate a new fontset from FONT-OBJECT. */
3079 if (fontset >= 0)
3081 Lisp_Object ascii_font = fontset_ascii (fontset);
3082 Lisp_Object spec = font_spec_from_name (ascii_font);
3084 if (NILP (spec))
3085 signal_error ("Invalid font name", ascii_font);
3087 if (! font_match_p (spec, font_object))
3088 fontset = -1;
3091 else
3092 signal_error ("Invalid font", arg);
3094 if (! NILP (Fequal (font_object, oldval)))
3095 return;
3097 x_new_font (f, font_object, fontset);
3098 store_frame_param (f, Qfont, arg);
3099 #ifdef HAVE_X_WINDOWS
3100 store_frame_param (f, Qfont_param, font_param);
3101 #endif
3102 /* Recalculate toolbar height. */
3103 f->n_tool_bar_rows = 0;
3104 /* Ensure we redraw it. */
3105 clear_current_matrices (f);
3107 recompute_basic_faces (f);
3109 do_pending_window_change (0);
3111 /* We used to call face-set-after-frame-default here, but it leads to
3112 recursive calls (since that function can set the `default' face's
3113 font which in turns changes the frame's `font' parameter).
3114 Also I don't know what this call is meant to do, but it seems the
3115 wrong way to do it anyway (it does a lot more work than what seems
3116 reasonable in response to a change to `font'). */
3120 void
3121 x_set_font_backend (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3123 if (! NILP (new_value)
3124 && !CONSP (new_value))
3126 char *p0, *p1;
3128 CHECK_STRING (new_value);
3129 p0 = p1 = SSDATA (new_value);
3130 new_value = Qnil;
3131 while (*p0)
3133 while (*p1 && ! c_isspace (*p1) && *p1 != ',') p1++;
3134 if (p0 < p1)
3135 new_value = Fcons (Fintern (make_string (p0, p1 - p0), Qnil),
3136 new_value);
3137 if (*p1)
3139 int c;
3141 while ((c = *++p1) && c_isspace (c));
3143 p0 = p1;
3145 new_value = Fnreverse (new_value);
3148 if (! NILP (old_value) && ! NILP (Fequal (old_value, new_value)))
3149 return;
3151 if (FRAME_FONT (f))
3152 free_all_realized_faces (Qnil);
3154 new_value = font_update_drivers (f, NILP (new_value) ? Qt : new_value);
3155 if (NILP (new_value))
3157 if (NILP (old_value))
3158 error ("No font backend available");
3159 font_update_drivers (f, old_value);
3160 error ("None of specified font backends are available");
3162 store_frame_param (f, Qfont_backend, new_value);
3164 if (FRAME_FONT (f))
3166 Lisp_Object frame;
3168 XSETFRAME (frame, f);
3169 x_set_font (f, Fframe_parameter (frame, Qfont), Qnil);
3170 ++face_change_count;
3171 ++windows_or_buffers_changed;
3176 void
3177 x_set_fringe_width (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3179 compute_fringe_widths (f, 1);
3180 #ifdef HAVE_X_WINDOWS
3181 /* Must adjust this so window managers report correct number of columns. */
3182 if (FRAME_X_WINDOW (f) != 0)
3183 x_wm_set_size_hint (f, 0, 0);
3184 #endif
3187 void
3188 x_set_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3190 CHECK_TYPE_RANGED_INTEGER (int, arg);
3192 if (XINT (arg) == f->border_width)
3193 return;
3195 if (FRAME_X_WINDOW (f) != 0)
3196 error ("Cannot change the border width of a frame");
3198 f->border_width = XINT (arg);
3201 void
3202 x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3204 int old = FRAME_INTERNAL_BORDER_WIDTH (f);
3206 CHECK_TYPE_RANGED_INTEGER (int, arg);
3207 FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
3208 if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
3209 FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
3211 #ifdef USE_X_TOOLKIT
3212 if (FRAME_X_OUTPUT (f)->edit_widget)
3213 widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
3214 #endif
3216 if (FRAME_INTERNAL_BORDER_WIDTH (f) == old)
3217 return;
3219 if (FRAME_X_WINDOW (f) != 0)
3221 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3222 SET_FRAME_GARBAGED (f);
3223 do_pending_window_change (0);
3225 else
3226 SET_FRAME_GARBAGED (f);
3229 void
3230 x_set_visibility (struct frame *f, Lisp_Object value, Lisp_Object oldval)
3232 Lisp_Object frame;
3233 XSETFRAME (frame, f);
3235 if (NILP (value))
3236 Fmake_frame_invisible (frame, Qt);
3237 else if (EQ (value, Qicon))
3238 Ficonify_frame (frame);
3239 else
3240 Fmake_frame_visible (frame);
3243 void
3244 x_set_autoraise (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3246 f->auto_raise = !EQ (Qnil, arg);
3249 void
3250 x_set_autolower (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3252 f->auto_lower = !EQ (Qnil, arg);
3255 void
3256 x_set_unsplittable (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3258 f->no_split = !NILP (arg);
3261 void
3262 x_set_vertical_scroll_bars (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3264 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
3265 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
3266 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
3267 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
3269 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
3270 = (NILP (arg)
3271 ? vertical_scroll_bar_none
3272 : EQ (Qleft, arg)
3273 ? vertical_scroll_bar_left
3274 : EQ (Qright, arg)
3275 ? vertical_scroll_bar_right
3276 : EQ (Qleft, Vdefault_frame_scroll_bars)
3277 ? vertical_scroll_bar_left
3278 : EQ (Qright, Vdefault_frame_scroll_bars)
3279 ? vertical_scroll_bar_right
3280 : vertical_scroll_bar_none);
3282 /* We set this parameter before creating the X window for the
3283 frame, so we can get the geometry right from the start.
3284 However, if the window hasn't been created yet, we shouldn't
3285 call x_set_window_size. */
3286 if (FRAME_X_WINDOW (f))
3287 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3288 do_pending_window_change (0);
3292 void
3293 x_set_scroll_bar_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3295 int wid = FRAME_COLUMN_WIDTH (f);
3297 if (NILP (arg))
3299 x_set_scroll_bar_default_width (f);
3301 if (FRAME_X_WINDOW (f))
3302 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3303 do_pending_window_change (0);
3305 else if (RANGED_INTEGERP (1, arg, INT_MAX)
3306 && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3308 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
3309 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
3311 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg);
3312 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
3313 if (FRAME_X_WINDOW (f))
3314 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3315 do_pending_window_change (0);
3318 change_frame_size (f, 0, FRAME_COLS (f), 0, 0, 0);
3319 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
3320 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
3325 /* Return non-nil if frame F wants a bitmap icon. */
3327 Lisp_Object
3328 x_icon_type (FRAME_PTR f)
3330 Lisp_Object tem;
3332 tem = assq_no_quit (Qicon_type, f->param_alist);
3333 if (CONSP (tem))
3334 return XCDR (tem);
3335 else
3336 return Qnil;
3339 void
3340 x_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3342 double alpha = 1.0;
3343 double newval[2];
3344 int i;
3345 Lisp_Object item;
3347 for (i = 0; i < 2; i++)
3349 newval[i] = 1.0;
3350 if (CONSP (arg))
3352 item = CAR (arg);
3353 arg = CDR (arg);
3355 else
3356 item = arg;
3358 if (NILP (item))
3359 alpha = - 1.0;
3360 else if (FLOATP (item))
3362 alpha = XFLOAT_DATA (item);
3363 if (! (0 <= alpha && alpha <= 1.0))
3364 args_out_of_range (make_float (0.0), make_float (1.0));
3366 else if (INTEGERP (item))
3368 EMACS_INT ialpha = XINT (item);
3369 if (! (0 <= ialpha && alpha <= 100))
3370 args_out_of_range (make_number (0), make_number (100));
3371 alpha = ialpha / 100.0;
3373 else
3374 wrong_type_argument (Qnumberp, item);
3375 newval[i] = alpha;
3378 for (i = 0; i < 2; i++)
3379 f->alpha[i] = newval[i];
3381 #if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA)
3382 block_input ();
3383 x_set_frame_alpha (f);
3384 unblock_input ();
3385 #endif
3387 return;
3391 /* Subroutines of creating an X frame. */
3393 /* Make sure that Vx_resource_name is set to a reasonable value.
3394 Fix it up, or set it to `emacs' if it is too hopeless. */
3396 void
3397 validate_x_resource_name (void)
3399 ptrdiff_t len = 0;
3400 /* Number of valid characters in the resource name. */
3401 ptrdiff_t good_count = 0;
3402 /* Number of invalid characters in the resource name. */
3403 ptrdiff_t bad_count = 0;
3404 Lisp_Object new;
3405 ptrdiff_t i;
3407 if (!STRINGP (Vx_resource_class))
3408 Vx_resource_class = build_string (EMACS_CLASS);
3410 if (STRINGP (Vx_resource_name))
3412 unsigned char *p = SDATA (Vx_resource_name);
3414 len = SBYTES (Vx_resource_name);
3416 /* Only letters, digits, - and _ are valid in resource names.
3417 Count the valid characters and count the invalid ones. */
3418 for (i = 0; i < len; i++)
3420 int c = p[i];
3421 if (! ((c >= 'a' && c <= 'z')
3422 || (c >= 'A' && c <= 'Z')
3423 || (c >= '0' && c <= '9')
3424 || c == '-' || c == '_'))
3425 bad_count++;
3426 else
3427 good_count++;
3430 else
3431 /* Not a string => completely invalid. */
3432 bad_count = 5, good_count = 0;
3434 /* If name is valid already, return. */
3435 if (bad_count == 0)
3436 return;
3438 /* If name is entirely invalid, or nearly so, or is so implausibly
3439 large that alloca might not work, use `emacs'. */
3440 if (good_count < 2 || MAX_ALLOCA - sizeof ".customization" < len)
3442 Vx_resource_name = build_string ("emacs");
3443 return;
3446 /* Name is partly valid. Copy it and replace the invalid characters
3447 with underscores. */
3449 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
3451 for (i = 0; i < len; i++)
3453 int c = SREF (new, i);
3454 if (! ((c >= 'a' && c <= 'z')
3455 || (c >= 'A' && c <= 'Z')
3456 || (c >= '0' && c <= '9')
3457 || c == '-' || c == '_'))
3458 SSET (new, i, '_');
3463 extern char *x_get_string_resource (XrmDatabase, const char *, const char *);
3464 extern Display_Info *check_x_display_info (Lisp_Object);
3467 /* Get specified attribute from resource database RDB.
3468 See Fx_get_resource below for other parameters. */
3470 static Lisp_Object
3471 xrdb_get_resource (XrmDatabase rdb, Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3473 register char *value;
3474 char *name_key;
3475 char *class_key;
3477 CHECK_STRING (attribute);
3478 CHECK_STRING (class);
3480 if (!NILP (component))
3481 CHECK_STRING (component);
3482 if (!NILP (subclass))
3483 CHECK_STRING (subclass);
3484 if (NILP (component) != NILP (subclass))
3485 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3487 validate_x_resource_name ();
3489 /* Allocate space for the components, the dots which separate them,
3490 and the final '\0'. Make them big enough for the worst case. */
3491 name_key = alloca (SBYTES (Vx_resource_name)
3492 + (STRINGP (component)
3493 ? SBYTES (component) : 0)
3494 + SBYTES (attribute)
3495 + 3);
3497 class_key = alloca (SBYTES (Vx_resource_class)
3498 + SBYTES (class)
3499 + (STRINGP (subclass)
3500 ? SBYTES (subclass) : 0)
3501 + 3);
3503 /* Start with emacs.FRAMENAME for the name (the specific one)
3504 and with `Emacs' for the class key (the general one). */
3505 strcpy (name_key, SSDATA (Vx_resource_name));
3506 strcpy (class_key, SSDATA (Vx_resource_class));
3508 strcat (class_key, ".");
3509 strcat (class_key, SSDATA (class));
3511 if (!NILP (component))
3513 strcat (class_key, ".");
3514 strcat (class_key, SSDATA (subclass));
3516 strcat (name_key, ".");
3517 strcat (name_key, SSDATA (component));
3520 strcat (name_key, ".");
3521 strcat (name_key, SSDATA (attribute));
3523 value = x_get_string_resource (rdb, name_key, class_key);
3525 if (value != (char *) 0 && *value)
3526 return build_string (value);
3527 else
3528 return Qnil;
3532 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
3533 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
3534 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
3535 class, where INSTANCE is the name under which Emacs was invoked, or
3536 the name specified by the `-name' or `-rn' command-line arguments.
3538 The optional arguments COMPONENT and SUBCLASS add to the key and the
3539 class, respectively. You must specify both of them or neither.
3540 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
3541 and the class is `Emacs.CLASS.SUBCLASS'. */)
3542 (Lisp_Object attribute, Lisp_Object class, Lisp_Object component,
3543 Lisp_Object subclass)
3545 check_window_system (NULL);
3547 return xrdb_get_resource (check_x_display_info (Qnil)->xrdb,
3548 attribute, class, component, subclass);
3551 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
3553 Lisp_Object
3554 display_x_get_resource (Display_Info *dpyinfo, Lisp_Object attribute,
3555 Lisp_Object class, Lisp_Object component,
3556 Lisp_Object subclass)
3558 return xrdb_get_resource (dpyinfo->xrdb,
3559 attribute, class, component, subclass);
3562 #if defined HAVE_X_WINDOWS && !defined USE_X_TOOLKIT
3563 /* Used when C code wants a resource value. */
3564 /* Called from oldXMenu/Create.c. */
3565 char *
3566 x_get_resource_string (const char *attribute, const char *class)
3568 char *result;
3569 struct frame *sf = SELECTED_FRAME ();
3570 ptrdiff_t invocation_namelen = SBYTES (Vinvocation_name);
3571 USE_SAFE_ALLOCA;
3573 /* Allocate space for the components, the dots which separate them,
3574 and the final '\0'. */
3575 char *name_key = SAFE_ALLOCA (invocation_namelen + strlen (attribute) + 2);
3576 char *class_key = alloca ((sizeof (EMACS_CLASS) - 1) + strlen (class) + 2);
3578 esprintf (name_key, "%s.%s", SSDATA (Vinvocation_name), attribute);
3579 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3581 result = x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
3582 name_key, class_key);
3583 SAFE_FREE ();
3584 return result;
3586 #endif
3588 /* Return the value of parameter PARAM.
3590 First search ALIST, then Vdefault_frame_alist, then the X defaults
3591 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3593 Convert the resource to the type specified by desired_type.
3595 If no default is specified, return Qunbound. If you call
3596 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3597 and don't let it get stored in any Lisp-visible variables! */
3599 Lisp_Object
3600 x_get_arg (Display_Info *dpyinfo, Lisp_Object alist, Lisp_Object param,
3601 const char *attribute, const char *class, enum resource_types type)
3603 register Lisp_Object tem;
3605 tem = Fassq (param, alist);
3607 if (!NILP (tem))
3609 /* If we find this parm in ALIST, clear it out
3610 so that it won't be "left over" at the end. */
3611 Lisp_Object tail;
3612 XSETCAR (tem, Qnil);
3613 /* In case the parameter appears more than once in the alist,
3614 clear it out. */
3615 for (tail = alist; CONSP (tail); tail = XCDR (tail))
3616 if (CONSP (XCAR (tail))
3617 && EQ (XCAR (XCAR (tail)), param))
3618 XSETCAR (XCAR (tail), Qnil);
3620 else
3621 tem = Fassq (param, Vdefault_frame_alist);
3623 /* If it wasn't specified in ALIST or the Lisp-level defaults,
3624 look in the X resources. */
3625 if (EQ (tem, Qnil))
3627 if (attribute && dpyinfo)
3629 tem = display_x_get_resource (dpyinfo,
3630 build_string (attribute),
3631 build_string (class),
3632 Qnil, Qnil);
3634 if (NILP (tem))
3635 return Qunbound;
3637 switch (type)
3639 case RES_TYPE_NUMBER:
3640 return make_number (atoi (SSDATA (tem)));
3642 case RES_TYPE_BOOLEAN_NUMBER:
3643 if (!strcmp (SSDATA (tem), "on")
3644 || !strcmp (SSDATA (tem), "true"))
3645 return make_number (1);
3646 return make_number (atoi (SSDATA (tem)));
3647 break;
3649 case RES_TYPE_FLOAT:
3650 return make_float (atof (SSDATA (tem)));
3652 case RES_TYPE_BOOLEAN:
3653 tem = Fdowncase (tem);
3654 if (!strcmp (SSDATA (tem), "on")
3655 #ifdef HAVE_NS
3656 || !strcmp (SSDATA (tem), "yes")
3657 #endif
3658 || !strcmp (SSDATA (tem), "true"))
3659 return Qt;
3660 else
3661 return Qnil;
3663 case RES_TYPE_STRING:
3664 return tem;
3666 case RES_TYPE_SYMBOL:
3667 /* As a special case, we map the values `true' and `on'
3668 to Qt, and `false' and `off' to Qnil. */
3670 Lisp_Object lower;
3671 lower = Fdowncase (tem);
3672 if (!strcmp (SSDATA (lower), "on")
3673 #ifdef HAVE_NS
3674 || !strcmp (SSDATA (lower), "yes")
3675 #endif
3676 || !strcmp (SSDATA (lower), "true"))
3677 return Qt;
3678 else if (!strcmp (SSDATA (lower), "off")
3679 #ifdef HAVE_NS
3680 || !strcmp (SSDATA (lower), "no")
3681 #endif
3682 || !strcmp (SSDATA (lower), "false"))
3683 return Qnil;
3684 else
3685 return Fintern (tem, Qnil);
3688 default:
3689 emacs_abort ();
3692 else
3693 return Qunbound;
3695 return Fcdr (tem);
3698 static Lisp_Object
3699 x_frame_get_arg (struct frame *f, Lisp_Object alist, Lisp_Object param,
3700 const char *attribute, const char *class,
3701 enum resource_types type)
3703 return x_get_arg (FRAME_X_DISPLAY_INFO (f),
3704 alist, param, attribute, class, type);
3707 /* Like x_frame_get_arg, but also record the value in f->param_alist. */
3709 Lisp_Object
3710 x_frame_get_and_record_arg (struct frame *f, Lisp_Object alist,
3711 Lisp_Object param,
3712 const char *attribute, const char *class,
3713 enum resource_types type)
3715 Lisp_Object value;
3717 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
3718 attribute, class, type);
3719 if (! NILP (value) && ! EQ (value, Qunbound))
3720 store_frame_param (f, param, value);
3722 return value;
3726 /* Record in frame F the specified or default value according to ALIST
3727 of the parameter named PROP (a Lisp symbol).
3728 If no value is specified for PROP, look for an X default for XPROP
3729 on the frame named NAME.
3730 If that is not found either, use the value DEFLT. */
3732 Lisp_Object
3733 x_default_parameter (struct frame *f, Lisp_Object alist, Lisp_Object prop,
3734 Lisp_Object deflt, const char *xprop, const char *xclass,
3735 enum resource_types type)
3737 Lisp_Object tem;
3739 tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type);
3740 if (EQ (tem, Qunbound))
3741 tem = deflt;
3742 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
3743 return tem;
3747 #if !defined (HAVE_X_WINDOWS) && defined (NoValue)
3750 * XParseGeometry parses strings of the form
3751 * "=<width>x<height>{+-}<xoffset>{+-}<yoffset>", where
3752 * width, height, xoffset, and yoffset are unsigned integers.
3753 * Example: "=80x24+300-49"
3754 * The equal sign is optional.
3755 * It returns a bitmask that indicates which of the four values
3756 * were actually found in the string. For each value found,
3757 * the corresponding argument is updated; for each value
3758 * not found, the corresponding argument is left unchanged.
3761 static int
3762 XParseGeometry (char *string,
3763 int *x, int *y,
3764 unsigned int *width, unsigned int *height)
3766 int mask = NoValue;
3767 char *strind;
3768 unsigned long int tempWidth, tempHeight;
3769 long int tempX, tempY;
3770 char *nextCharacter;
3772 if (string == NULL || *string == '\0')
3773 return mask;
3774 if (*string == '=')
3775 string++; /* ignore possible '=' at beg of geometry spec */
3777 strind = string;
3778 if (*strind != '+' && *strind != '-' && *strind != 'x')
3780 tempWidth = strtoul (strind, &nextCharacter, 10);
3781 if (strind == nextCharacter)
3782 return 0;
3783 strind = nextCharacter;
3784 mask |= WidthValue;
3787 if (*strind == 'x' || *strind == 'X')
3789 strind++;
3790 tempHeight = strtoul (strind, &nextCharacter, 10);
3791 if (strind == nextCharacter)
3792 return 0;
3793 strind = nextCharacter;
3794 mask |= HeightValue;
3797 if (*strind == '+' || *strind == '-')
3799 if (*strind == '-')
3800 mask |= XNegative;
3801 tempX = strtol (strind, &nextCharacter, 10);
3802 if (strind == nextCharacter)
3803 return 0;
3804 strind = nextCharacter;
3805 mask |= XValue;
3806 if (*strind == '+' || *strind == '-')
3808 if (*strind == '-')
3809 mask |= YNegative;
3810 tempY = strtol (strind, &nextCharacter, 10);
3811 if (strind == nextCharacter)
3812 return 0;
3813 strind = nextCharacter;
3814 mask |= YValue;
3818 /* If strind isn't at the end of the string then it's an invalid
3819 geometry specification. */
3821 if (*strind != '\0')
3822 return 0;
3824 if (mask & XValue)
3825 *x = clip_to_bounds (INT_MIN, tempX, INT_MAX);
3826 if (mask & YValue)
3827 *y = clip_to_bounds (INT_MIN, tempY, INT_MAX);
3828 if (mask & WidthValue)
3829 *width = min (tempWidth, UINT_MAX);
3830 if (mask & HeightValue)
3831 *height = min (tempHeight, UINT_MAX);
3832 return mask;
3835 #endif /* !defined (HAVE_X_WINDOWS) && defined (NoValue) */
3838 /* NS used to define x-parse-geometry in ns-win.el, but that confused
3839 make-docfile: the documentation string in ns-win.el was used for
3840 x-parse-geometry even in non-NS builds.
3842 With two definitions of x-parse-geometry in this file, various
3843 things still get confused (eg M-x apropos documentation), so that
3844 it is best if the two definitions just share the same doc-string.
3846 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
3847 doc: /* Parse a display geometry string STRING.
3848 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3849 The properties returned may include `top', `left', `height', and `width'.
3850 For X, the value of `left' or `top' may be an integer,
3851 or a list (+ N) meaning N pixels relative to top/left corner,
3852 or a list (- N) meaning -N pixels relative to bottom/right corner.
3853 On Nextstep, this just calls `ns-parse-geometry'. */)
3854 (Lisp_Object string)
3856 int geometry, x, y;
3857 unsigned int width, height;
3858 Lisp_Object result;
3860 CHECK_STRING (string);
3862 #ifdef HAVE_NS
3863 if (strchr (SSDATA (string), ' ') != NULL)
3864 return call1 (Qns_parse_geometry, string);
3865 #endif
3866 geometry = XParseGeometry (SSDATA (string),
3867 &x, &y, &width, &height);
3868 result = Qnil;
3869 if (geometry & XValue)
3871 Lisp_Object element;
3873 if (x >= 0 && (geometry & XNegative))
3874 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
3875 else if (x < 0 && ! (geometry & XNegative))
3876 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
3877 else
3878 element = Fcons (Qleft, make_number (x));
3879 result = Fcons (element, result);
3882 if (geometry & YValue)
3884 Lisp_Object element;
3886 if (y >= 0 && (geometry & YNegative))
3887 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
3888 else if (y < 0 && ! (geometry & YNegative))
3889 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
3890 else
3891 element = Fcons (Qtop, make_number (y));
3892 result = Fcons (element, result);
3895 if (geometry & WidthValue)
3896 result = Fcons (Fcons (Qwidth, make_number (width)), result);
3897 if (geometry & HeightValue)
3898 result = Fcons (Fcons (Qheight, make_number (height)), result);
3900 return result;
3904 /* Calculate the desired size and position of frame F.
3905 Return the flags saying which aspects were specified.
3907 Also set the win_gravity and size_hint_flags of F.
3909 Adjust height for toolbar if TOOLBAR_P is 1.
3911 This function does not make the coordinates positive. */
3913 #define DEFAULT_ROWS 35
3914 #define DEFAULT_COLS 80
3917 x_figure_window_size (struct frame *f, Lisp_Object parms, int toolbar_p)
3919 register Lisp_Object tem0, tem1, tem2;
3920 long window_prompting = 0;
3921 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3923 /* Default values if we fall through.
3924 Actually, if that happens we should get
3925 window manager prompting. */
3926 SET_FRAME_COLS (f, DEFAULT_COLS);
3927 FRAME_LINES (f) = DEFAULT_ROWS;
3928 /* Window managers expect that if program-specified
3929 positions are not (0,0), they're intentional, not defaults. */
3930 f->top_pos = 0;
3931 f->left_pos = 0;
3933 /* Ensure that old new_text_cols and new_text_lines will not override the
3934 values set here. */
3935 /* ++KFS: This was specific to W32, but seems ok for all platforms */
3936 f->new_text_cols = f->new_text_lines = 0;
3938 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
3939 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
3940 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
3941 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3943 if (!EQ (tem0, Qunbound))
3945 CHECK_NUMBER (tem0);
3946 if (! (0 <= XINT (tem0) && XINT (tem0) <= INT_MAX))
3947 xsignal1 (Qargs_out_of_range, tem0);
3948 FRAME_LINES (f) = XINT (tem0);
3950 if (!EQ (tem1, Qunbound))
3952 CHECK_NUMBER (tem1);
3953 if (! (0 <= XINT (tem1) && XINT (tem1) <= INT_MAX))
3954 xsignal1 (Qargs_out_of_range, tem1);
3955 SET_FRAME_COLS (f, XINT (tem1));
3957 if (!NILP (tem2) && !EQ (tem2, Qunbound))
3958 window_prompting |= USSize;
3959 else
3960 window_prompting |= PSize;
3963 f->scroll_bar_actual_width
3964 = FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f);
3966 /* This used to be done _before_ calling x_figure_window_size, but
3967 since the height is reset here, this was really a no-op. I
3968 assume that moving it here does what Gerd intended (although he
3969 no longer can remember what that was... ++KFS, 2003-03-25. */
3971 /* Add the tool-bar height to the initial frame height so that the
3972 user gets a text display area of the size he specified with -g or
3973 via .Xdefaults. Later changes of the tool-bar height don't
3974 change the frame size. This is done so that users can create
3975 tall Emacs frames without having to guess how tall the tool-bar
3976 will get. */
3977 if (toolbar_p && FRAME_TOOL_BAR_LINES (f))
3979 int margin, relief, bar_height;
3981 relief = (tool_bar_button_relief >= 0
3982 ? tool_bar_button_relief
3983 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
3985 if (RANGED_INTEGERP (1, Vtool_bar_button_margin, INT_MAX))
3986 margin = XFASTINT (Vtool_bar_button_margin);
3987 else if (CONSP (Vtool_bar_button_margin)
3988 && RANGED_INTEGERP (1, XCDR (Vtool_bar_button_margin), INT_MAX))
3989 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
3990 else
3991 margin = 0;
3993 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
3994 FRAME_LINES (f) += (bar_height + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f);
3997 compute_fringe_widths (f, 0);
3999 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, FRAME_COLS (f));
4000 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, FRAME_LINES (f));
4002 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
4003 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
4004 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
4005 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4007 if (EQ (tem0, Qminus))
4009 f->top_pos = 0;
4010 window_prompting |= YNegative;
4012 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
4013 && CONSP (XCDR (tem0))
4014 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (tem0)), INT_MAX))
4016 f->top_pos = - XINT (XCAR (XCDR (tem0)));
4017 window_prompting |= YNegative;
4019 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
4020 && CONSP (XCDR (tem0))
4021 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (tem0))))
4023 f->top_pos = XINT (XCAR (XCDR (tem0)));
4025 else if (EQ (tem0, Qunbound))
4026 f->top_pos = 0;
4027 else
4029 CHECK_TYPE_RANGED_INTEGER (int, tem0);
4030 f->top_pos = XINT (tem0);
4031 if (f->top_pos < 0)
4032 window_prompting |= YNegative;
4035 if (EQ (tem1, Qminus))
4037 f->left_pos = 0;
4038 window_prompting |= XNegative;
4040 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
4041 && CONSP (XCDR (tem1))
4042 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (tem1)), INT_MAX))
4044 f->left_pos = - XINT (XCAR (XCDR (tem1)));
4045 window_prompting |= XNegative;
4047 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
4048 && CONSP (XCDR (tem1))
4049 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (tem1))))
4051 f->left_pos = XINT (XCAR (XCDR (tem1)));
4053 else if (EQ (tem1, Qunbound))
4054 f->left_pos = 0;
4055 else
4057 CHECK_TYPE_RANGED_INTEGER (int, tem1);
4058 f->left_pos = XINT (tem1);
4059 if (f->left_pos < 0)
4060 window_prompting |= XNegative;
4063 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
4064 window_prompting |= USPosition;
4065 else
4066 window_prompting |= PPosition;
4069 if (window_prompting & XNegative)
4071 if (window_prompting & YNegative)
4072 f->win_gravity = SouthEastGravity;
4073 else
4074 f->win_gravity = NorthEastGravity;
4076 else
4078 if (window_prompting & YNegative)
4079 f->win_gravity = SouthWestGravity;
4080 else
4081 f->win_gravity = NorthWestGravity;
4084 f->size_hint_flags = window_prompting;
4086 return window_prompting;
4091 #endif /* HAVE_WINDOW_SYSTEM */
4093 void
4094 frame_make_pointer_invisible (void)
4096 if (! NILP (Vmake_pointer_invisible))
4098 struct frame *f;
4099 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4100 return;
4102 f = SELECTED_FRAME ();
4103 if (f && !f->pointer_invisible
4104 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4106 f->mouse_moved = 0;
4107 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 1);
4108 f->pointer_invisible = 1;
4113 void
4114 frame_make_pointer_visible (void)
4116 /* We don't check Vmake_pointer_invisible here in case the
4117 pointer was invisible when Vmake_pointer_invisible was set to nil. */
4118 struct frame *f;
4120 if (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
4121 return;
4123 f = SELECTED_FRAME ();
4124 if (f && f->pointer_invisible && f->mouse_moved
4125 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4127 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 0);
4128 f->pointer_invisible = 0;
4132 DEFUN ("frame-pointer-visible-p", Fframe_pointer_visible_p,
4133 Sframe_pointer_visible_p, 0, 1, 0,
4134 doc: /* Return t if the mouse pointer displayed on FRAME is visible.
4135 Otherwise it returns nil. FRAME omitted or nil means the
4136 selected frame. This is useful when `make-pointer-invisible' is set. */)
4137 (Lisp_Object frame)
4139 return decode_any_frame (frame)->pointer_invisible ? Qnil : Qt;
4144 /***********************************************************************
4145 Multimonitor data
4146 ***********************************************************************/
4148 #ifdef HAVE_WINDOW_SYSTEM
4150 # if (defined HAVE_NS \
4151 || (!defined USE_GTK && (defined HAVE_XINERAMA || defined HAVE_XRANDR)))
4152 void
4153 free_monitors (struct MonitorInfo *monitors, int n_monitors)
4155 int i;
4156 for (i = 0; i < n_monitors; ++i)
4157 xfree (monitors[i].name);
4158 xfree (monitors);
4160 # endif
4162 Lisp_Object
4163 make_monitor_attribute_list (struct MonitorInfo *monitors,
4164 int n_monitors,
4165 int primary_monitor,
4166 Lisp_Object monitor_frames,
4167 const char *source)
4169 Lisp_Object attributes_list = Qnil;
4170 Lisp_Object primary_monitor_attributes = Qnil;
4171 int i;
4173 for (i = 0; i < n_monitors; ++i)
4175 Lisp_Object geometry, workarea, attributes = Qnil;
4176 struct MonitorInfo *mi = &monitors[i];
4178 if (mi->geom.width == 0) continue;
4180 workarea = list4i (mi->work.x, mi->work.y,
4181 mi->work.width, mi->work.height);
4182 geometry = list4i (mi->geom.x, mi->geom.y,
4183 mi->geom.width, mi->geom.height);
4184 attributes = Fcons (Fcons (Qsource,
4185 make_string (source, strlen (source))),
4186 attributes);
4187 attributes = Fcons (Fcons (Qframes, AREF (monitor_frames, i)),
4188 attributes);
4189 attributes = Fcons (Fcons (Qmm_size,
4190 list2i (mi->mm_width, mi->mm_height)),
4191 attributes);
4192 attributes = Fcons (Fcons (Qworkarea, workarea), attributes);
4193 attributes = Fcons (Fcons (Qgeometry, geometry), attributes);
4194 if (mi->name)
4195 attributes = Fcons (Fcons (Qname, make_string (mi->name,
4196 strlen (mi->name))),
4197 attributes);
4199 if (i == primary_monitor)
4200 primary_monitor_attributes = attributes;
4201 else
4202 attributes_list = Fcons (attributes, attributes_list);
4205 if (!NILP (primary_monitor_attributes))
4206 attributes_list = Fcons (primary_monitor_attributes, attributes_list);
4207 return attributes_list;
4210 #endif /* HAVE_WINDOW_SYSTEM */
4213 /***********************************************************************
4214 Initialization
4215 ***********************************************************************/
4217 void
4218 syms_of_frame (void)
4220 DEFSYM (Qframep, "framep");
4221 DEFSYM (Qframe_live_p, "frame-live-p");
4222 DEFSYM (Qexplicit_name, "explicit-name");
4223 DEFSYM (Qheight, "height");
4224 DEFSYM (Qicon, "icon");
4225 DEFSYM (Qminibuffer, "minibuffer");
4226 DEFSYM (Qmodeline, "modeline");
4227 DEFSYM (Qonly, "only");
4228 DEFSYM (Qnone, "none");
4229 DEFSYM (Qwidth, "width");
4230 DEFSYM (Qgeometry, "geometry");
4231 DEFSYM (Qicon_left, "icon-left");
4232 DEFSYM (Qicon_top, "icon-top");
4233 DEFSYM (Qtooltip, "tooltip");
4234 DEFSYM (Qleft, "left");
4235 DEFSYM (Qright, "right");
4236 DEFSYM (Quser_position, "user-position");
4237 DEFSYM (Quser_size, "user-size");
4238 DEFSYM (Qwindow_id, "window-id");
4239 #ifdef HAVE_X_WINDOWS
4240 DEFSYM (Qouter_window_id, "outer-window-id");
4241 #endif
4242 DEFSYM (Qparent_id, "parent-id");
4243 DEFSYM (Qx, "x");
4244 DEFSYM (Qw32, "w32");
4245 DEFSYM (Qpc, "pc");
4246 DEFSYM (Qns, "ns");
4247 DEFSYM (Qvisible, "visible");
4248 DEFSYM (Qbuffer_predicate, "buffer-predicate");
4249 DEFSYM (Qbuffer_list, "buffer-list");
4250 DEFSYM (Qburied_buffer_list, "buried-buffer-list");
4251 DEFSYM (Qdisplay_type, "display-type");
4252 DEFSYM (Qbackground_mode, "background-mode");
4253 DEFSYM (Qnoelisp, "noelisp");
4254 DEFSYM (Qtty_color_mode, "tty-color-mode");
4255 DEFSYM (Qtty, "tty");
4256 DEFSYM (Qtty_type, "tty-type");
4258 DEFSYM (Qface_set_after_frame_default, "face-set-after-frame-default");
4260 DEFSYM (Qfullwidth, "fullwidth");
4261 DEFSYM (Qfullheight, "fullheight");
4262 DEFSYM (Qfullboth, "fullboth");
4263 DEFSYM (Qmaximized, "maximized");
4264 DEFSYM (Qx_resource_name, "x-resource-name");
4265 DEFSYM (Qx_frame_parameter, "x-frame-parameter");
4267 DEFSYM (Qterminal, "terminal");
4268 DEFSYM (Qterminal_live_p, "terminal-live-p");
4270 DEFSYM (Qgeometry, "geometry");
4271 DEFSYM (Qworkarea, "workarea");
4272 DEFSYM (Qmm_size, "mm-size");
4273 DEFSYM (Qframes, "frames");
4274 DEFSYM (Qsource, "source");
4276 #ifdef HAVE_NS
4277 DEFSYM (Qns_parse_geometry, "ns-parse-geometry");
4278 #endif
4281 int i;
4283 for (i = 0; i < sizeof (frame_parms) / sizeof (frame_parms[0]); i++)
4285 Lisp_Object v = intern_c_string (frame_parms[i].name);
4286 if (frame_parms[i].variable)
4288 *frame_parms[i].variable = v;
4289 staticpro (frame_parms[i].variable);
4291 Fput (v, Qx_frame_parameter, make_number (i));
4295 #ifdef HAVE_WINDOW_SYSTEM
4296 DEFVAR_LISP ("x-resource-name", Vx_resource_name,
4297 doc: /* The name Emacs uses to look up X resources.
4298 `x-get-resource' uses this as the first component of the instance name
4299 when requesting resource values.
4300 Emacs initially sets `x-resource-name' to the name under which Emacs
4301 was invoked, or to the value specified with the `-name' or `-rn'
4302 switches, if present.
4304 It may be useful to bind this variable locally around a call
4305 to `x-get-resource'. See also the variable `x-resource-class'. */);
4306 Vx_resource_name = Qnil;
4308 DEFVAR_LISP ("x-resource-class", Vx_resource_class,
4309 doc: /* The class Emacs uses to look up X resources.
4310 `x-get-resource' uses this as the first component of the instance class
4311 when requesting resource values.
4313 Emacs initially sets `x-resource-class' to "Emacs".
4315 Setting this variable permanently is not a reasonable thing to do,
4316 but binding this variable locally around a call to `x-get-resource'
4317 is a reasonable practice. See also the variable `x-resource-name'. */);
4318 Vx_resource_class = build_string (EMACS_CLASS);
4320 DEFVAR_LISP ("frame-alpha-lower-limit", Vframe_alpha_lower_limit,
4321 doc: /* The lower limit of the frame opacity (alpha transparency).
4322 The value should range from 0 (invisible) to 100 (completely opaque).
4323 You can also use a floating number between 0.0 and 1.0.
4324 The default is 20. */);
4325 Vframe_alpha_lower_limit = make_number (20);
4326 #endif
4328 DEFVAR_LISP ("default-frame-alist", Vdefault_frame_alist,
4329 doc: /* Alist of default values for frame creation.
4330 These may be set in your init file, like this:
4331 (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1)))
4332 These override values given in window system configuration data,
4333 including X Windows' defaults database.
4334 For values specific to the first Emacs frame, see `initial-frame-alist'.
4335 For window-system specific values, see `window-system-default-frame-alist'.
4336 For values specific to the separate minibuffer frame, see
4337 `minibuffer-frame-alist'.
4338 The `menu-bar-lines' element of the list controls whether new frames
4339 have menu bars; `menu-bar-mode' works by altering this element.
4340 Setting this variable does not affect existing frames, only new ones. */);
4341 Vdefault_frame_alist = Qnil;
4343 DEFVAR_LISP ("default-frame-scroll-bars", Vdefault_frame_scroll_bars,
4344 doc: /* Default position of scroll bars on this window-system. */);
4345 #ifdef HAVE_WINDOW_SYSTEM
4346 #if defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA) || (defined (USE_GTK) && defined (USE_TOOLKIT_SCROLL_BARS))
4347 /* MS-Windows, Mac OS X, and GTK have scroll bars on the right by
4348 default. */
4349 Vdefault_frame_scroll_bars = Qright;
4350 #else
4351 Vdefault_frame_scroll_bars = Qleft;
4352 #endif
4353 #else
4354 Vdefault_frame_scroll_bars = Qnil;
4355 #endif
4357 DEFVAR_BOOL ("scroll-bar-adjust-thumb-portion",
4358 scroll_bar_adjust_thumb_portion_p,
4359 doc: /* Adjust thumb for overscrolling for Gtk+ and MOTIF.
4360 Non-nil means adjust the thumb in the scroll bar so it can be dragged downwards
4361 even if the end of the buffer is shown (i.e. overscrolling).
4362 Set to nil if you want the thumb to be at the bottom when the end of the buffer
4363 is shown. Also, the thumb fills the whole scroll bar when the entire buffer
4364 is visible. In this case you can not overscroll. */);
4365 scroll_bar_adjust_thumb_portion_p = 1;
4367 DEFVAR_LISP ("terminal-frame", Vterminal_frame,
4368 doc: /* The initial frame-object, which represents Emacs's stdout. */);
4370 DEFVAR_LISP ("mouse-position-function", Vmouse_position_function,
4371 doc: /* If non-nil, function to transform normal value of `mouse-position'.
4372 `mouse-position' calls this function, passing its usual return value as
4373 argument, and returns whatever this function returns.
4374 This abnormal hook exists for the benefit of packages like `xt-mouse.el'
4375 which need to do mouse handling at the Lisp level. */);
4376 Vmouse_position_function = Qnil;
4378 DEFVAR_LISP ("mouse-highlight", Vmouse_highlight,
4379 doc: /* If non-nil, clickable text is highlighted when mouse is over it.
4380 If the value is an integer, highlighting is only shown after moving the
4381 mouse, while keyboard input turns off the highlight even when the mouse
4382 is over the clickable text. However, the mouse shape still indicates
4383 when the mouse is over clickable text. */);
4384 Vmouse_highlight = Qt;
4386 DEFVAR_LISP ("make-pointer-invisible", Vmake_pointer_invisible,
4387 doc: /* If non-nil, make pointer invisible while typing.
4388 The pointer becomes visible again when the mouse is moved. */);
4389 Vmake_pointer_invisible = Qt;
4391 DEFVAR_LISP ("delete-frame-functions", Vdelete_frame_functions,
4392 doc: /* Functions run before deleting a frame.
4393 The functions are run with one arg, the frame to be deleted.
4394 See `delete-frame'.
4396 Note that functions in this list may be called just before the frame is
4397 actually deleted, or some time later (or even both when an earlier function
4398 in `delete-frame-functions' (indirectly) calls `delete-frame'
4399 recursively). */);
4400 Vdelete_frame_functions = Qnil;
4401 DEFSYM (Qdelete_frame_functions, "delete-frame-functions");
4403 DEFVAR_LISP ("menu-bar-mode", Vmenu_bar_mode,
4404 doc: /* Non-nil if Menu-Bar mode is enabled.
4405 See the command `menu-bar-mode' for a description of this minor mode.
4406 Setting this variable directly does not take effect;
4407 either customize it (see the info node `Easy Customization')
4408 or call the function `menu-bar-mode'. */);
4409 Vmenu_bar_mode = Qt;
4411 DEFVAR_LISP ("tool-bar-mode", Vtool_bar_mode,
4412 doc: /* Non-nil if Tool-Bar mode is enabled.
4413 See the command `tool-bar-mode' for a description of this minor mode.
4414 Setting this variable directly does not take effect;
4415 either customize it (see the info node `Easy Customization')
4416 or call the function `tool-bar-mode'. */);
4417 #ifdef HAVE_WINDOW_SYSTEM
4418 Vtool_bar_mode = Qt;
4419 #else
4420 Vtool_bar_mode = Qnil;
4421 #endif
4423 DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
4424 doc: /* Minibufferless frames use this frame's minibuffer.
4426 Emacs cannot create minibufferless frames unless this is set to an
4427 appropriate surrogate.
4429 Emacs consults this variable only when creating minibufferless
4430 frames; once the frame is created, it sticks with its assigned
4431 minibuffer, no matter what this variable is set to. This means that
4432 this variable doesn't necessarily say anything meaningful about the
4433 current set of frames, or where the minibuffer is currently being
4434 displayed.
4436 This variable is local to the current terminal and cannot be buffer-local. */);
4438 DEFVAR_BOOL ("focus-follows-mouse", focus_follows_mouse,
4439 doc: /* Non-nil if window system changes focus when you move the mouse.
4440 You should set this variable to tell Emacs how your window manager
4441 handles focus, since there is no way in general for Emacs to find out
4442 automatically. See also `mouse-autoselect-window'. */);
4443 focus_follows_mouse = 0;
4445 staticpro (&Vframe_list);
4447 defsubr (&Sframep);
4448 defsubr (&Sframe_live_p);
4449 defsubr (&Swindow_system);
4450 defsubr (&Smake_terminal_frame);
4451 defsubr (&Shandle_switch_frame);
4452 defsubr (&Sselect_frame);
4453 defsubr (&Sselected_frame);
4454 defsubr (&Sframe_list);
4455 defsubr (&Snext_frame);
4456 defsubr (&Sprevious_frame);
4457 defsubr (&Sdelete_frame);
4458 defsubr (&Smouse_position);
4459 defsubr (&Smouse_pixel_position);
4460 defsubr (&Sset_mouse_position);
4461 defsubr (&Sset_mouse_pixel_position);
4462 #if 0
4463 defsubr (&Sframe_configuration);
4464 defsubr (&Srestore_frame_configuration);
4465 #endif
4466 defsubr (&Smake_frame_visible);
4467 defsubr (&Smake_frame_invisible);
4468 defsubr (&Siconify_frame);
4469 defsubr (&Sframe_visible_p);
4470 defsubr (&Svisible_frame_list);
4471 defsubr (&Sraise_frame);
4472 defsubr (&Slower_frame);
4473 defsubr (&Sredirect_frame_focus);
4474 defsubr (&Sframe_focus);
4475 defsubr (&Sframe_parameters);
4476 defsubr (&Sframe_parameter);
4477 defsubr (&Smodify_frame_parameters);
4478 defsubr (&Sframe_char_height);
4479 defsubr (&Sframe_char_width);
4480 defsubr (&Sframe_pixel_height);
4481 defsubr (&Sframe_pixel_width);
4482 defsubr (&Stool_bar_pixel_width);
4483 defsubr (&Sset_frame_height);
4484 defsubr (&Sset_frame_width);
4485 defsubr (&Sset_frame_size);
4486 defsubr (&Sset_frame_position);
4487 defsubr (&Sframe_pointer_visible_p);
4489 #ifdef HAVE_WINDOW_SYSTEM
4490 defsubr (&Sx_get_resource);
4491 defsubr (&Sx_parse_geometry);
4492 #endif