]> code.delx.au - gnu-emacs/blob - src/frame.c
* chartab.c (char_table_translate): Move to...
[gnu-emacs] / src / frame.c
1 /* Generic frame functions.
2
3 Copyright (C) 1993-1995, 1997, 1999-2014 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
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.
11
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.
16
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/>. */
19
20 #include <config.h>
21
22 #include <stdio.h>
23 #include <errno.h>
24 #include <limits.h>
25
26 #include <c-ctype.h>
27
28 #include "lisp.h"
29 #include "character.h"
30
31 #ifdef HAVE_WINDOW_SYSTEM
32 #include TERM_HEADER
33 #endif /* HAVE_WINDOW_SYSTEM */
34
35 #include "buffer.h"
36 /* These help us bind and responding to switch-frame events. */
37 #include "commands.h"
38 #include "keyboard.h"
39 #include "frame.h"
40 #include "blockinput.h"
41 #include "termchar.h"
42 #include "termhooks.h"
43 #include "dispextern.h"
44 #include "window.h"
45 #include "font.h"
46 #ifdef HAVE_WINDOW_SYSTEM
47 #include "fontset.h"
48 #endif
49 #include "cm.h"
50 #ifdef MSDOS
51 #include "msdos.h"
52 #include "dosfns.h"
53 #endif
54 #ifdef USE_X_TOOLKIT
55 #include "widget.h"
56 #endif
57
58 #ifdef HAVE_NS
59 Lisp_Object Qns_parse_geometry;
60 #endif
61
62 Lisp_Object Qframep, Qframe_live_p;
63 Lisp_Object Qicon, Qmodeline;
64 Lisp_Object Qonly, Qnone;
65 Lisp_Object Qx, Qw32, Qpc, Qns;
66 Lisp_Object Qvisible;
67 Lisp_Object Qdisplay_type;
68 static Lisp_Object Qbackground_mode;
69 Lisp_Object Qnoelisp;
70
71 static Lisp_Object Qx_frame_parameter;
72 Lisp_Object Qx_resource_name;
73 Lisp_Object Qterminal;
74
75 /* Frame parameters (set or reported). */
76
77 Lisp_Object Qauto_raise, Qauto_lower;
78 Lisp_Object Qborder_color, Qborder_width;
79 Lisp_Object Qcursor_color, Qcursor_type;
80 Lisp_Object Qheight, Qwidth;
81 Lisp_Object Qleft, Qright;
82 Lisp_Object Qicon_left, Qicon_top, Qicon_type, Qicon_name;
83 Lisp_Object Qtooltip;
84 Lisp_Object Qinternal_border_width;
85 Lisp_Object Qright_divider_width, Qbottom_divider_width;
86 Lisp_Object Qmouse_color;
87 Lisp_Object Qminibuffer;
88 Lisp_Object Qscroll_bar_width, Qvertical_scroll_bars;
89 Lisp_Object Qvisibility;
90 Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
91 Lisp_Object Qscreen_gamma;
92 Lisp_Object Qline_spacing;
93 static Lisp_Object Quser_position, Quser_size;
94 Lisp_Object Qwait_for_wm;
95 static Lisp_Object Qwindow_id;
96 #ifdef HAVE_X_WINDOWS
97 static Lisp_Object Qouter_window_id;
98 #endif
99 Lisp_Object Qparent_id;
100 Lisp_Object Qtitle, Qname;
101 static Lisp_Object Qexplicit_name;
102 Lisp_Object Qunsplittable;
103 Lisp_Object Qmenu_bar_lines, Qtool_bar_lines, Qtool_bar_position;
104 Lisp_Object Qleft_fringe, Qright_fringe;
105 Lisp_Object Qbuffer_predicate;
106 static Lisp_Object Qbuffer_list, Qburied_buffer_list;
107 Lisp_Object Qtty_color_mode;
108 Lisp_Object Qtty, Qtty_type;
109
110 Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth, Qmaximized;
111 Lisp_Object Qsticky;
112 Lisp_Object Qfont_backend;
113 Lisp_Object Qalpha;
114
115 Lisp_Object Qface_set_after_frame_default;
116
117 static Lisp_Object Qfocus_in_hook;
118 static Lisp_Object Qfocus_out_hook;
119 static Lisp_Object Qdelete_frame_functions;
120
121 static Lisp_Object Qgeometry, Qworkarea, Qmm_size, Qframes, Qsource;
122
123 /* The currently selected frame. */
124
125 Lisp_Object selected_frame;
126
127 /* A frame which is not just a mini-buffer, or NULL if there are no such
128 frames. This is usually the most recent such frame that was selected. */
129
130 static struct frame *last_nonminibuf_frame;
131
132 /* False means there are no visible garbaged frames. */
133 bool frame_garbaged;
134
135 #ifdef HAVE_WINDOW_SYSTEM
136 static void x_report_frame_params (struct frame *, Lisp_Object *);
137 #endif
138
139 /* These setters are used only in this file, so they can be private. */
140 static void
141 fset_buffer_predicate (struct frame *f, Lisp_Object val)
142 {
143 f->buffer_predicate = val;
144 }
145 static void
146 fset_minibuffer_window (struct frame *f, Lisp_Object val)
147 {
148 f->minibuffer_window = val;
149 }
150
151 struct frame *
152 decode_live_frame (register Lisp_Object frame)
153 {
154 if (NILP (frame))
155 frame = selected_frame;
156 CHECK_LIVE_FRAME (frame);
157 return XFRAME (frame);
158 }
159
160 struct frame *
161 decode_any_frame (register Lisp_Object frame)
162 {
163 if (NILP (frame))
164 frame = selected_frame;
165 CHECK_FRAME (frame);
166 return XFRAME (frame);
167 }
168
169 #ifdef HAVE_WINDOW_SYSTEM
170
171 bool
172 window_system_available (struct frame *f)
173 {
174 return f ? FRAME_WINDOW_P (f) || FRAME_MSDOS_P (f) : x_display_list != NULL;
175 }
176
177 #endif /* HAVE_WINDOW_SYSTEM */
178
179 struct frame *
180 decode_window_system_frame (Lisp_Object frame)
181 {
182 struct frame *f = decode_live_frame (frame);
183
184 if (!window_system_available (f))
185 error ("Window system frame should be used");
186 return f;
187 }
188
189 void
190 check_window_system (struct frame *f)
191 {
192 if (!window_system_available (f))
193 error (f ? "Window system frame should be used"
194 : "Window system is not in use or not initialized");
195 }
196
197 static void
198 set_menu_bar_lines_1 (Lisp_Object window, int n)
199 {
200 struct window *w = XWINDOW (window);
201 struct frame *f = XFRAME (WINDOW_FRAME (w));
202
203 w->top_line += n;
204 w->pixel_top += n * FRAME_LINE_HEIGHT (f);
205 w->total_lines -= n;
206 w->pixel_height -= n * FRAME_LINE_HEIGHT (f);
207
208 /* Handle just the top child in a vertical split. */
209 if (WINDOW_VERTICAL_COMBINATION_P (w))
210 set_menu_bar_lines_1 (w->contents, n);
211 else if (WINDOW_HORIZONTAL_COMBINATION_P (w))
212 /* Adjust all children in a horizontal split. */
213 for (window = w->contents; !NILP (window); window = w->next)
214 {
215 w = XWINDOW (window);
216 set_menu_bar_lines_1 (window, n);
217 }
218 }
219
220 void
221 set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
222 {
223 int nlines;
224 int olines = FRAME_MENU_BAR_LINES (f);
225
226 /* Right now, menu bars don't work properly in minibuf-only frames;
227 most of the commands try to apply themselves to the minibuffer
228 frame itself, and get an error because you can't switch buffers
229 in or split the minibuffer window. */
230 if (FRAME_MINIBUF_ONLY_P (f))
231 return;
232
233 if (TYPE_RANGED_INTEGERP (int, value))
234 nlines = XINT (value);
235 else
236 nlines = 0;
237
238 if (nlines != olines)
239 {
240 windows_or_buffers_changed = 14;
241 FRAME_WINDOW_SIZES_CHANGED (f) = 1;
242 FRAME_MENU_BAR_LINES (f) = nlines;
243 FRAME_MENU_BAR_HEIGHT (f) = nlines * FRAME_LINE_HEIGHT (f);
244 set_menu_bar_lines_1 (f->root_window, nlines - olines);
245 adjust_frame_glyphs (f);
246 }
247 }
248 \f
249 Lisp_Object Vframe_list;
250
251 \f
252 DEFUN ("framep", Fframep, Sframep, 1, 1, 0,
253 doc: /* Return non-nil if OBJECT is a frame.
254 Value is:
255 t for a termcap frame (a character-only terminal),
256 'x' for an Emacs frame that is really an X window,
257 'w32' for an Emacs frame that is a window on MS-Windows display,
258 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
259 'pc' for a direct-write MS-DOS frame.
260 See also `frame-live-p'. */)
261 (Lisp_Object object)
262 {
263 if (!FRAMEP (object))
264 return Qnil;
265 switch (XFRAME (object)->output_method)
266 {
267 case output_initial: /* The initial frame is like a termcap frame. */
268 case output_termcap:
269 return Qt;
270 case output_x_window:
271 return Qx;
272 case output_w32:
273 return Qw32;
274 case output_msdos_raw:
275 return Qpc;
276 case output_ns:
277 return Qns;
278 default:
279 emacs_abort ();
280 }
281 }
282
283 DEFUN ("frame-live-p", Fframe_live_p, Sframe_live_p, 1, 1, 0,
284 doc: /* Return non-nil if OBJECT is a frame which has not been deleted.
285 Value is nil if OBJECT is not a live frame. If object is a live
286 frame, the return value indicates what sort of terminal device it is
287 displayed on. See the documentation of `framep' for possible
288 return values. */)
289 (Lisp_Object object)
290 {
291 return ((FRAMEP (object)
292 && FRAME_LIVE_P (XFRAME (object)))
293 ? Fframep (object)
294 : Qnil);
295 }
296
297 DEFUN ("window-system", Fwindow_system, Swindow_system, 0, 1, 0,
298 doc: /* The name of the window system that FRAME is displaying through.
299 The value is a symbol:
300 nil for a termcap frame (a character-only terminal),
301 'x' for an Emacs frame that is really an X window,
302 'w32' for an Emacs frame that is a window on MS-Windows display,
303 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
304 'pc' for a direct-write MS-DOS frame.
305
306 FRAME defaults to the currently selected frame.
307
308 Use of this function as a predicate is deprecated. Instead,
309 use `display-graphic-p' or any of the other `display-*-p'
310 predicates which report frame's specific UI-related capabilities. */)
311 (Lisp_Object frame)
312 {
313 Lisp_Object type;
314 if (NILP (frame))
315 frame = selected_frame;
316
317 type = Fframep (frame);
318
319 if (NILP (type))
320 wrong_type_argument (Qframep, frame);
321
322 if (EQ (type, Qt))
323 return Qnil;
324 else
325 return type;
326 }
327
328 struct frame *
329 make_frame (bool mini_p)
330 {
331 Lisp_Object frame;
332 register struct frame *f;
333 register struct window *rw, *mw;
334 register Lisp_Object root_window;
335 register Lisp_Object mini_window;
336
337 f = allocate_frame ();
338 XSETFRAME (frame, f);
339
340 /* Initialize Lisp data. Note that allocate_frame initializes all
341 Lisp data to nil, so do it only for slots which should not be nil. */
342 fset_tool_bar_position (f, Qtop);
343
344 /* Initialize non-Lisp data. Note that allocate_frame zeroes out all
345 non-Lisp data, so do it only for slots which should not be zero.
346 To avoid subtle bugs and for the sake of readability, it's better to
347 initialize enum members explicitly even if their values are zero. */
348 f->wants_modeline = true;
349 f->redisplay = true;
350 f->garbaged = true;
351 f->vertical_scroll_bar_type = vertical_scroll_bar_none;
352 f->column_width = 1; /* !FRAME_WINDOW_P value. */
353 f->line_height = 1; /* !FRAME_WINDOW_P value. */
354 #ifdef HAVE_WINDOW_SYSTEM
355 f->want_fullscreen = FULLSCREEN_NONE;
356 #if ! defined (USE_GTK) && ! defined (HAVE_NS)
357 f->last_tool_bar_item = -1;
358 #endif
359 #endif
360
361 root_window = make_window ();
362 rw = XWINDOW (root_window);
363 if (mini_p)
364 {
365 mini_window = make_window ();
366 mw = XWINDOW (mini_window);
367 wset_next (rw, mini_window);
368 wset_prev (mw, root_window);
369 mw->mini = 1;
370 wset_frame (mw, frame);
371 fset_minibuffer_window (f, mini_window);
372 }
373 else
374 {
375 mini_window = Qnil;
376 wset_next (rw, Qnil);
377 fset_minibuffer_window (f, Qnil);
378 }
379
380 wset_frame (rw, frame);
381
382 /* 10 is arbitrary,
383 just so that there is "something there."
384 Correct size will be set up later with change_frame_size. */
385
386 SET_FRAME_COLS (f, 10);
387 FRAME_LINES (f) = 10;
388 SET_FRAME_WIDTH (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f));
389 SET_FRAME_HEIGHT (f, FRAME_LINES (f) * FRAME_LINE_HEIGHT (f));
390
391 rw->total_cols = 10;
392 rw->pixel_width = rw->total_cols * FRAME_COLUMN_WIDTH (f);
393 rw->total_lines = mini_p ? 9 : 10;
394 rw->pixel_height = rw->total_lines * FRAME_LINE_HEIGHT (f);
395
396 if (mini_p)
397 {
398 mw->top_line = rw->total_lines;
399 mw->pixel_top = rw->pixel_height;
400 mw->total_cols = rw->total_cols;
401 mw->pixel_width = rw->pixel_width;
402 mw->total_lines = 1;
403 mw->pixel_height = FRAME_LINE_HEIGHT (f);
404 }
405
406 /* Choose a buffer for the frame's root window. */
407 {
408 Lisp_Object buf = Fcurrent_buffer ();
409
410 /* If current buffer is hidden, try to find another one. */
411 if (BUFFER_HIDDEN_P (XBUFFER (buf)))
412 buf = other_buffer_safely (buf);
413
414 /* Use set_window_buffer, not Fset_window_buffer, and don't let
415 hooks be run by it. The reason is that the whole frame/window
416 arrangement is not yet fully initialized at this point. Windows
417 don't have the right size, glyph matrices aren't initialized
418 etc. Running Lisp functions at this point surely ends in a
419 SEGV. */
420 set_window_buffer (root_window, buf, 0, 0);
421 fset_buffer_list (f, list1 (buf));
422 }
423
424 if (mini_p)
425 set_window_buffer (mini_window,
426 (NILP (Vminibuffer_list)
427 ? get_minibuffer (0)
428 : Fcar (Vminibuffer_list)),
429 0, 0);
430
431 fset_root_window (f, root_window);
432 fset_selected_window (f, root_window);
433 /* Make sure this window seems more recently used than
434 a newly-created, never-selected window. */
435 XWINDOW (f->selected_window)->use_time = ++window_select_count;
436
437 return f;
438 }
439 \f
440 #ifdef HAVE_WINDOW_SYSTEM
441 /* Make a frame using a separate minibuffer window on another frame.
442 MINI_WINDOW is the minibuffer window to use. nil means use the
443 default (the global minibuffer). */
444
445 struct frame *
446 make_frame_without_minibuffer (register Lisp_Object mini_window, KBOARD *kb, Lisp_Object display)
447 {
448 register struct frame *f;
449 struct gcpro gcpro1;
450
451 if (!NILP (mini_window))
452 CHECK_LIVE_WINDOW (mini_window);
453
454 if (!NILP (mini_window)
455 && FRAME_KBOARD (XFRAME (XWINDOW (mini_window)->frame)) != kb)
456 error ("Frame and minibuffer must be on the same terminal");
457
458 /* Make a frame containing just a root window. */
459 f = make_frame (0);
460
461 if (NILP (mini_window))
462 {
463 /* Use default-minibuffer-frame if possible. */
464 if (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
465 || ! FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))
466 {
467 Lisp_Object frame_dummy;
468
469 XSETFRAME (frame_dummy, f);
470 GCPRO1 (frame_dummy);
471 /* If there's no minibuffer frame to use, create one. */
472 kset_default_minibuffer_frame
473 (kb, call1 (intern ("make-initial-minibuffer-frame"), display));
474 UNGCPRO;
475 }
476
477 mini_window
478 = XFRAME (KVAR (kb, Vdefault_minibuffer_frame))->minibuffer_window;
479 }
480
481 fset_minibuffer_window (f, mini_window);
482
483 /* Make the chosen minibuffer window display the proper minibuffer,
484 unless it is already showing a minibuffer. */
485 if (NILP (Fmemq (XWINDOW (mini_window)->contents, Vminibuffer_list)))
486 /* Use set_window_buffer instead of Fset_window_buffer (see
487 discussion of bug#11984, bug#12025, bug#12026). */
488 set_window_buffer (mini_window,
489 (NILP (Vminibuffer_list)
490 ? get_minibuffer (0)
491 : Fcar (Vminibuffer_list)), 0, 0);
492 return f;
493 }
494
495 /* Make a frame containing only a minibuffer window. */
496
497 struct frame *
498 make_minibuffer_frame (void)
499 {
500 /* First make a frame containing just a root window, no minibuffer. */
501
502 register struct frame *f = make_frame (0);
503 register Lisp_Object mini_window;
504 register Lisp_Object frame;
505
506 XSETFRAME (frame, f);
507
508 f->auto_raise = 0;
509 f->auto_lower = 0;
510 f->no_split = 1;
511 f->wants_modeline = 0;
512
513 /* Now label the root window as also being the minibuffer.
514 Avoid infinite looping on the window chain by marking next pointer
515 as nil. */
516
517 mini_window = f->root_window;
518 fset_minibuffer_window (f, mini_window);
519 XWINDOW (mini_window)->mini = 1;
520 wset_next (XWINDOW (mini_window), Qnil);
521 wset_prev (XWINDOW (mini_window), Qnil);
522 wset_frame (XWINDOW (mini_window), frame);
523
524 /* Put the proper buffer in that window. */
525
526 /* Use set_window_buffer instead of Fset_window_buffer (see
527 discussion of bug#11984, bug#12025, bug#12026). */
528 set_window_buffer (mini_window,
529 (NILP (Vminibuffer_list)
530 ? get_minibuffer (0)
531 : Fcar (Vminibuffer_list)), 0, 0);
532 return f;
533 }
534 #endif /* HAVE_WINDOW_SYSTEM */
535 \f
536 /* Construct a frame that refers to a terminal. */
537
538 static printmax_t tty_frame_count;
539
540 struct frame *
541 make_initial_frame (void)
542 {
543 struct frame *f;
544 struct terminal *terminal;
545 Lisp_Object frame;
546
547 eassert (initial_kboard);
548
549 /* The first call must initialize Vframe_list. */
550 if (! (NILP (Vframe_list) || CONSP (Vframe_list)))
551 Vframe_list = Qnil;
552
553 terminal = init_initial_terminal ();
554
555 f = make_frame (1);
556 XSETFRAME (frame, f);
557
558 Vframe_list = Fcons (frame, Vframe_list);
559
560 tty_frame_count = 1;
561 fset_name (f, build_pure_c_string ("F1"));
562
563 SET_FRAME_VISIBLE (f, 1);
564
565 f->output_method = terminal->type;
566 f->terminal = terminal;
567 f->terminal->reference_count++;
568 f->output_data.nothing = 0;
569
570 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
571 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
572
573 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
574
575 /* The default value of menu-bar-mode is t. */
576 set_menu_bar_lines (f, make_number (1), Qnil);
577
578 if (!noninteractive)
579 init_frame_faces (f);
580
581 last_nonminibuf_frame = f;
582
583 return f;
584 }
585
586
587 static struct frame *
588 make_terminal_frame (struct terminal *terminal)
589 {
590 register struct frame *f;
591 Lisp_Object frame;
592 char name[sizeof "F" + INT_STRLEN_BOUND (printmax_t)];
593
594 if (!terminal->name)
595 error ("Terminal is not live, can't create new frames on it");
596
597 f = make_frame (1);
598
599 XSETFRAME (frame, f);
600 Vframe_list = Fcons (frame, Vframe_list);
601
602 fset_name (f, make_formatted_string (name, "F%"pMd, ++tty_frame_count));
603
604 SET_FRAME_VISIBLE (f, 1);
605
606 f->terminal = terminal;
607 f->terminal->reference_count++;
608 #ifdef MSDOS
609 f->output_data.tty->display_info = &the_only_display_info;
610 if (!inhibit_window_system
611 && (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame))
612 || XFRAME (selected_frame)->output_method == output_msdos_raw))
613 f->output_method = output_msdos_raw;
614 else
615 f->output_method = output_termcap;
616 #else /* not MSDOS */
617 f->output_method = output_termcap;
618 create_tty_output (f);
619 FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
620 FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
621 #endif /* not MSDOS */
622
623 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
624 FRAME_MENU_BAR_LINES (f) = NILP (Vmenu_bar_mode) ? 0 : 1;
625 FRAME_MENU_BAR_HEIGHT (f) = FRAME_MENU_BAR_LINES (f) * FRAME_LINE_HEIGHT (f);
626
627 /* Set the top frame to the newly created frame. */
628 if (FRAMEP (FRAME_TTY (f)->top_frame)
629 && FRAME_LIVE_P (XFRAME (FRAME_TTY (f)->top_frame)))
630 SET_FRAME_VISIBLE (XFRAME (FRAME_TTY (f)->top_frame), 2); /* obscured */
631
632 FRAME_TTY (f)->top_frame = frame;
633
634 if (!noninteractive)
635 init_frame_faces (f);
636
637 return f;
638 }
639
640 /* Get a suitable value for frame parameter PARAMETER for a newly
641 created frame, based on (1) the user-supplied frame parameter
642 alist SUPPLIED_PARMS, and (2) CURRENT_VALUE. */
643
644 static Lisp_Object
645 get_future_frame_param (Lisp_Object parameter,
646 Lisp_Object supplied_parms,
647 char *current_value)
648 {
649 Lisp_Object result;
650
651 result = Fassq (parameter, supplied_parms);
652 if (NILP (result))
653 result = Fassq (parameter, XFRAME (selected_frame)->param_alist);
654 if (NILP (result) && current_value != NULL)
655 result = build_string (current_value);
656 if (!NILP (result) && !STRINGP (result))
657 result = XCDR (result);
658 if (NILP (result) || !STRINGP (result))
659 result = Qnil;
660
661 return result;
662 }
663
664 DEFUN ("make-terminal-frame", Fmake_terminal_frame, Smake_terminal_frame,
665 1, 1, 0,
666 doc: /* Create an additional terminal frame, possibly on another terminal.
667 This function takes one argument, an alist specifying frame parameters.
668
669 You can create multiple frames on a single text terminal, but only one
670 of them (the selected terminal frame) is actually displayed.
671
672 In practice, generally you don't need to specify any parameters,
673 except when you want to create a new frame on another terminal.
674 In that case, the `tty' parameter specifies the device file to open,
675 and the `tty-type' parameter specifies the terminal type. Example:
676
677 (make-terminal-frame '((tty . "/dev/pts/5") (tty-type . "xterm")))
678
679 Note that changing the size of one terminal frame automatically
680 affects all frames on the same terminal device. */)
681 (Lisp_Object parms)
682 {
683 struct frame *f;
684 struct terminal *t = NULL;
685 Lisp_Object frame, tem;
686 struct frame *sf = SELECTED_FRAME ();
687
688 #ifdef MSDOS
689 if (sf->output_method != output_msdos_raw
690 && sf->output_method != output_termcap)
691 emacs_abort ();
692 #else /* not MSDOS */
693
694 #ifdef WINDOWSNT /* This should work now! */
695 if (sf->output_method != output_termcap)
696 error ("Not using an ASCII terminal now; cannot make a new ASCII frame");
697 #endif
698 #endif /* not MSDOS */
699
700 {
701 Lisp_Object terminal;
702
703 terminal = Fassq (Qterminal, parms);
704 if (CONSP (terminal))
705 {
706 terminal = XCDR (terminal);
707 t = get_terminal (terminal, 1);
708 }
709 #ifdef MSDOS
710 if (t && t != the_only_display_info.terminal)
711 /* msdos.c assumes a single tty_display_info object. */
712 error ("Multiple terminals are not supported on this platform");
713 if (!t)
714 t = the_only_display_info.terminal;
715 #endif
716 }
717
718 if (!t)
719 {
720 char *name = 0, *type = 0;
721 Lisp_Object tty, tty_type;
722
723 tty = get_future_frame_param
724 (Qtty, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
725 ? FRAME_TTY (XFRAME (selected_frame))->name
726 : NULL));
727 if (!NILP (tty))
728 name = xlispstrdupa (tty);
729
730 tty_type = get_future_frame_param
731 (Qtty_type, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
732 ? FRAME_TTY (XFRAME (selected_frame))->type
733 : NULL));
734 if (!NILP (tty_type))
735 type = xlispstrdupa (tty_type);
736
737 t = init_tty (name, type, 0); /* Errors are not fatal. */
738 }
739
740 f = make_terminal_frame (t);
741
742 {
743 int width, height;
744 get_tty_size (fileno (FRAME_TTY (f)->input), &width, &height);
745 change_frame_size (f, width, height, 0, 0, 0, 0);
746 }
747
748 adjust_frame_glyphs (f);
749 calculate_costs (f);
750 XSETFRAME (frame, f);
751
752 store_in_alist (&parms, Qtty_type, build_string (t->display_info.tty->type));
753 store_in_alist (&parms, Qtty,
754 (t->display_info.tty->name
755 ? build_string (t->display_info.tty->name)
756 : Qnil));
757 Fmodify_frame_parameters (frame, parms);
758
759 /* Make the frame face alist be frame-specific, so that each
760 frame could change its face definitions independently. */
761 fset_face_alist (f, Fcopy_alist (sf->face_alist));
762 /* Simple Fcopy_alist isn't enough, because we need the contents of
763 the vectors which are the CDRs of associations in face_alist to
764 be copied as well. */
765 for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem))
766 XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem))));
767 return frame;
768 }
769
770 \f
771 /* Perform the switch to frame FRAME.
772
773 If FRAME is a switch-frame event `(switch-frame FRAME1)', use
774 FRAME1 as frame.
775
776 If TRACK is non-zero and the frame that currently has the focus
777 redirects its focus to the selected frame, redirect that focused
778 frame's focus to FRAME instead.
779
780 FOR_DELETION non-zero means that the selected frame is being
781 deleted, which includes the possibility that the frame's terminal
782 is dead.
783
784 The value of NORECORD is passed as argument to Fselect_window. */
785
786 Lisp_Object
787 do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object norecord)
788 {
789 struct frame *sf = SELECTED_FRAME ();
790
791 /* If FRAME is a switch-frame event, extract the frame we should
792 switch to. */
793 if (CONSP (frame)
794 && EQ (XCAR (frame), Qswitch_frame)
795 && CONSP (XCDR (frame)))
796 frame = XCAR (XCDR (frame));
797
798 /* This used to say CHECK_LIVE_FRAME, but apparently it's possible for
799 a switch-frame event to arrive after a frame is no longer live,
800 especially when deleting the initial frame during startup. */
801 CHECK_FRAME (frame);
802 if (! FRAME_LIVE_P (XFRAME (frame)))
803 return Qnil;
804
805 if (sf == XFRAME (frame))
806 return frame;
807
808 /* If a frame's focus has been redirected toward the currently
809 selected frame, we should change the redirection to point to the
810 newly selected frame. This means that if the focus is redirected
811 from a minibufferless frame to a surrogate minibuffer frame, we
812 can use `other-window' to switch between all the frames using
813 that minibuffer frame, and the focus redirection will follow us
814 around. */
815 #if 0
816 /* This is too greedy; it causes inappropriate focus redirection
817 that's hard to get rid of. */
818 if (track)
819 {
820 Lisp_Object tail;
821
822 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
823 {
824 Lisp_Object focus;
825
826 if (!FRAMEP (XCAR (tail)))
827 emacs_abort ();
828
829 focus = FRAME_FOCUS_FRAME (XFRAME (XCAR (tail)));
830
831 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
832 Fredirect_frame_focus (XCAR (tail), frame);
833 }
834 }
835 #else /* ! 0 */
836 /* Instead, apply it only to the frame we're pointing to. */
837 #ifdef HAVE_WINDOW_SYSTEM
838 if (track && FRAME_WINDOW_P (XFRAME (frame)))
839 {
840 Lisp_Object focus, xfocus;
841
842 xfocus = x_get_focus_frame (XFRAME (frame));
843 if (FRAMEP (xfocus))
844 {
845 focus = FRAME_FOCUS_FRAME (XFRAME (xfocus));
846 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
847 Fredirect_frame_focus (xfocus, frame);
848 }
849 }
850 #endif /* HAVE_X_WINDOWS */
851 #endif /* ! 0 */
852
853 if (!for_deletion && FRAME_HAS_MINIBUF_P (sf))
854 resize_mini_window (XWINDOW (FRAME_MINIBUF_WINDOW (sf)), 1);
855
856 if (FRAME_TERMCAP_P (XFRAME (frame)) || FRAME_MSDOS_P (XFRAME (frame)))
857 {
858 struct frame *f = XFRAME (frame);
859 struct tty_display_info *tty = FRAME_TTY (f);
860 Lisp_Object top_frame = tty->top_frame;
861
862 /* Don't mark the frame garbaged and/or obscured if we are
863 switching to the frame that is already the top frame of that
864 TTY. */
865 if (!EQ (frame, top_frame))
866 {
867 if (FRAMEP (top_frame))
868 /* Mark previously displayed frame as now obscured. */
869 SET_FRAME_VISIBLE (XFRAME (top_frame), 2);
870 SET_FRAME_VISIBLE (f, 1);
871 /* If the new TTY frame changed dimensions, we need to
872 resync term.c's idea of the frame size with the new
873 frame's data. */
874 if (FRAME_COLS (f) != FrameCols (tty))
875 FrameCols (tty) = FRAME_COLS (f);
876 if (FRAME_LINES (f) != FrameRows (tty))
877 FrameRows (tty) = FRAME_LINES (f);
878 }
879 tty->top_frame = frame;
880 }
881
882 selected_frame = frame;
883 if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
884 last_nonminibuf_frame = XFRAME (selected_frame);
885
886 Fselect_window (XFRAME (frame)->selected_window, norecord);
887
888 /* We want to make sure that the next event generates a frame-switch
889 event to the appropriate frame. This seems kludgy to me, but
890 before you take it out, make sure that evaluating something like
891 (select-window (frame-root-window (new-frame))) doesn't end up
892 with your typing being interpreted in the new frame instead of
893 the one you're actually typing in. */
894 internal_last_event_frame = Qnil;
895
896 return frame;
897 }
898
899 DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 2, "e",
900 doc: /* Select FRAME.
901 Subsequent editing commands apply to its selected window.
902 Optional argument NORECORD means to neither change the order of
903 recently selected windows nor the buffer list.
904
905 The selection of FRAME lasts until the next time the user does
906 something to select a different frame, or until the next time
907 this function is called. If you are using a window system, the
908 previously selected frame may be restored as the selected frame
909 when returning to the command loop, because it still may have
910 the window system's input focus. On a text terminal, the next
911 redisplay will display FRAME.
912
913 This function returns FRAME, or nil if FRAME has been deleted. */)
914 (Lisp_Object frame, Lisp_Object norecord)
915 {
916 return do_switch_frame (frame, 1, 0, norecord);
917 }
918
919 DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 1, "e",
920 doc: /* Handle a switch-frame event EVENT.
921 Switch-frame events are usually bound to this function.
922 A switch-frame event tells Emacs that the window manager has requested
923 that the user's events be directed to the frame mentioned in the event.
924 This function selects the selected window of the frame of EVENT.
925
926 If EVENT is frame object, handle it as if it were a switch-frame event
927 to that frame. */)
928 (Lisp_Object event)
929 {
930 /* Preserve prefix arg that the command loop just cleared. */
931 kset_prefix_arg (current_kboard, Vcurrent_prefix_arg);
932 Frun_hooks (1, &Qmouse_leave_buffer_hook);
933 /* `switch-frame' implies a focus in. */
934 call1 (intern ("handle-focus-in"), event);
935 return do_switch_frame (event, 0, 0, Qnil);
936 }
937
938 DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0,
939 doc: /* Return the frame that is now selected. */)
940 (void)
941 {
942 return selected_frame;
943 }
944 \f
945 DEFUN ("frame-list", Fframe_list, Sframe_list,
946 0, 0, 0,
947 doc: /* Return a list of all live frames. */)
948 (void)
949 {
950 Lisp_Object frames;
951 frames = Fcopy_sequence (Vframe_list);
952 #ifdef HAVE_WINDOW_SYSTEM
953 if (FRAMEP (tip_frame))
954 frames = Fdelq (tip_frame, frames);
955 #endif
956 return frames;
957 }
958
959 /* Return CANDIDATE if it can be used as 'other-than-FRAME' frame on the
960 same tty (for tty frames) or among frames which uses FRAME's keyboard.
961 If MINIBUF is nil, do not consider minibuffer-only candidate.
962 If MINIBUF is `visible', do not consider an invisible candidate.
963 If MINIBUF is a window, consider only its own frame and candidate now
964 using that window as the minibuffer.
965 If MINIBUF is 0, consider candidate if it is visible or iconified.
966 Otherwise consider any candidate and return nil if CANDIDATE is not
967 acceptable. */
968
969 static Lisp_Object
970 candidate_frame (Lisp_Object candidate, Lisp_Object frame, Lisp_Object minibuf)
971 {
972 struct frame *c = XFRAME (candidate), *f = XFRAME (frame);
973
974 if ((!FRAME_TERMCAP_P (c) && !FRAME_TERMCAP_P (f)
975 && FRAME_KBOARD (c) == FRAME_KBOARD (f))
976 || (FRAME_TERMCAP_P (c) && FRAME_TERMCAP_P (f)
977 && FRAME_TTY (c) == FRAME_TTY (f)))
978 {
979 if (NILP (minibuf))
980 {
981 if (!FRAME_MINIBUF_ONLY_P (c))
982 return candidate;
983 }
984 else if (EQ (minibuf, Qvisible))
985 {
986 if (FRAME_VISIBLE_P (c))
987 return candidate;
988 }
989 else if (WINDOWP (minibuf))
990 {
991 if (EQ (FRAME_MINIBUF_WINDOW (c), minibuf)
992 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), candidate)
993 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
994 FRAME_FOCUS_FRAME (c)))
995 return candidate;
996 }
997 else if (XFASTINT (minibuf) == 0)
998 {
999 if (FRAME_VISIBLE_P (c) || FRAME_ICONIFIED_P (c))
1000 return candidate;
1001 }
1002 else
1003 return candidate;
1004 }
1005 return Qnil;
1006 }
1007
1008 /* Return the next frame in the frame list after FRAME. */
1009
1010 static Lisp_Object
1011 next_frame (Lisp_Object frame, Lisp_Object minibuf)
1012 {
1013 Lisp_Object f, tail;
1014 int passed = 0;
1015
1016 /* There must always be at least one frame in Vframe_list. */
1017 eassert (CONSP (Vframe_list));
1018
1019 while (passed < 2)
1020 FOR_EACH_FRAME (tail, f)
1021 {
1022 if (passed)
1023 {
1024 f = candidate_frame (f, frame, minibuf);
1025 if (!NILP (f))
1026 return f;
1027 }
1028 if (EQ (frame, f))
1029 passed++;
1030 }
1031 return frame;
1032 }
1033
1034 /* Return the previous frame in the frame list before FRAME. */
1035
1036 static Lisp_Object
1037 prev_frame (Lisp_Object frame, Lisp_Object minibuf)
1038 {
1039 Lisp_Object f, tail, prev = Qnil;
1040
1041 /* There must always be at least one frame in Vframe_list. */
1042 eassert (CONSP (Vframe_list));
1043
1044 FOR_EACH_FRAME (tail, f)
1045 {
1046 if (EQ (frame, f) && !NILP (prev))
1047 return prev;
1048 f = candidate_frame (f, frame, minibuf);
1049 if (!NILP (f))
1050 prev = f;
1051 }
1052
1053 /* We've scanned the entire list. */
1054 if (NILP (prev))
1055 /* We went through the whole frame list without finding a single
1056 acceptable frame. Return the original frame. */
1057 return frame;
1058 else
1059 /* There were no acceptable frames in the list before FRAME; otherwise,
1060 we would have returned directly from the loop. Since PREV is the last
1061 acceptable frame in the list, return it. */
1062 return prev;
1063 }
1064
1065
1066 DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0,
1067 doc: /* Return the next frame in the frame list after FRAME.
1068 It considers only frames on the same terminal as FRAME.
1069 By default, skip minibuffer-only frames.
1070 If omitted, FRAME defaults to the selected frame.
1071 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1072 If MINIFRAME is a window, include only its own frame
1073 and any frame now using that window as the minibuffer.
1074 If MINIFRAME is `visible', include all visible frames.
1075 If MINIFRAME is 0, include all visible and iconified frames.
1076 Otherwise, include all frames. */)
1077 (Lisp_Object frame, Lisp_Object miniframe)
1078 {
1079 if (NILP (frame))
1080 frame = selected_frame;
1081 CHECK_LIVE_FRAME (frame);
1082 return next_frame (frame, miniframe);
1083 }
1084
1085 DEFUN ("previous-frame", Fprevious_frame, Sprevious_frame, 0, 2, 0,
1086 doc: /* Return the previous frame in the frame list before FRAME.
1087 It considers only frames on the same terminal as FRAME.
1088 By default, skip minibuffer-only frames.
1089 If omitted, FRAME defaults to the selected frame.
1090 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1091 If MINIFRAME is a window, include only its own frame
1092 and any frame now using that window as the minibuffer.
1093 If MINIFRAME is `visible', include all visible frames.
1094 If MINIFRAME is 0, include all visible and iconified frames.
1095 Otherwise, include all frames. */)
1096 (Lisp_Object frame, Lisp_Object miniframe)
1097 {
1098 if (NILP (frame))
1099 frame = selected_frame;
1100 CHECK_LIVE_FRAME (frame);
1101 return prev_frame (frame, miniframe);
1102 }
1103
1104 DEFUN ("last-nonminibuffer-frame", Flast_nonminibuf_frame,
1105 Slast_nonminibuf_frame, 0, 0, 0,
1106 doc: /* Return last non-minibuffer frame selected. */)
1107 (void)
1108 {
1109 Lisp_Object frame = Qnil;
1110
1111 if (last_nonminibuf_frame)
1112 XSETFRAME (frame, last_nonminibuf_frame);
1113
1114 return frame;
1115 }
1116 \f
1117 /* Return 1 if it is ok to delete frame F;
1118 0 if all frames aside from F are invisible.
1119 (Exception: if F is the terminal frame, and we are using X, return 1.) */
1120
1121 static int
1122 other_visible_frames (struct frame *f)
1123 {
1124 Lisp_Object frames, this;
1125
1126 FOR_EACH_FRAME (frames, this)
1127 {
1128 if (f == XFRAME (this))
1129 continue;
1130
1131 /* Verify that we can still talk to the frame's X window,
1132 and note any recent change in visibility. */
1133 #ifdef HAVE_X_WINDOWS
1134 if (FRAME_WINDOW_P (XFRAME (this)))
1135 x_sync (XFRAME (this));
1136 #endif
1137
1138 if (FRAME_VISIBLE_P (XFRAME (this))
1139 || FRAME_ICONIFIED_P (XFRAME (this))
1140 /* Allow deleting the terminal frame when at least one X
1141 frame exists. */
1142 || (FRAME_WINDOW_P (XFRAME (this)) && !FRAME_WINDOW_P (f)))
1143 return 1;
1144 }
1145 return 0;
1146 }
1147
1148 /* Make sure that minibuf_window doesn't refer to FRAME's minibuffer
1149 window. Preferably use the selected frame's minibuffer window
1150 instead. If the selected frame doesn't have one, get some other
1151 frame's minibuffer window. SELECT non-zero means select the new
1152 minibuffer window. */
1153 static void
1154 check_minibuf_window (Lisp_Object frame, int select)
1155 {
1156 struct frame *f = decode_live_frame (frame);
1157
1158 XSETFRAME (frame, f);
1159
1160 if (WINDOWP (minibuf_window) && EQ (f->minibuffer_window, minibuf_window))
1161 {
1162 Lisp_Object frames, this, window = make_number (0);
1163
1164 if (!EQ (frame, selected_frame)
1165 && FRAME_HAS_MINIBUF_P (XFRAME (selected_frame)))
1166 window = FRAME_MINIBUF_WINDOW (XFRAME (selected_frame));
1167 else
1168 FOR_EACH_FRAME (frames, this)
1169 {
1170 if (!EQ (this, frame) && FRAME_HAS_MINIBUF_P (XFRAME (this)))
1171 {
1172 window = FRAME_MINIBUF_WINDOW (XFRAME (this));
1173 break;
1174 }
1175 }
1176
1177 /* Don't abort if no window was found (Bug#15247). */
1178 if (WINDOWP (window))
1179 {
1180 /* Use set_window_buffer instead of Fset_window_buffer (see
1181 discussion of bug#11984, bug#12025, bug#12026). */
1182 set_window_buffer (window, XWINDOW (minibuf_window)->contents, 0, 0);
1183 minibuf_window = window;
1184
1185 /* SELECT non-zero usually means that FRAME's minibuffer
1186 window was selected; select the new one. */
1187 if (select)
1188 Fselect_window (minibuf_window, Qnil);
1189 }
1190 }
1191 }
1192
1193
1194 /* Delete FRAME. When FORCE equals Qnoelisp, delete FRAME
1195 unconditionally. x_connection_closed and delete_terminal use
1196 this. Any other value of FORCE implements the semantics
1197 described for Fdelete_frame. */
1198 Lisp_Object
1199 delete_frame (Lisp_Object frame, Lisp_Object force)
1200 {
1201 struct frame *f = decode_any_frame (frame);
1202 struct frame *sf;
1203 struct kboard *kb;
1204
1205 int minibuffer_selected, is_tooltip_frame;
1206
1207 if (! FRAME_LIVE_P (f))
1208 return Qnil;
1209
1210 if (NILP (force) && !other_visible_frames (f))
1211 error ("Attempt to delete the sole visible or iconified frame");
1212
1213 /* x_connection_closed must have set FORCE to `noelisp' in order
1214 to delete the last frame, if it is gone. */
1215 if (NILP (XCDR (Vframe_list)) && !EQ (force, Qnoelisp))
1216 error ("Attempt to delete the only frame");
1217
1218 XSETFRAME (frame, f);
1219
1220 /* Does this frame have a minibuffer, and is it the surrogate
1221 minibuffer for any other frame? */
1222 if (FRAME_HAS_MINIBUF_P (f))
1223 {
1224 Lisp_Object frames, this;
1225
1226 FOR_EACH_FRAME (frames, this)
1227 {
1228 Lisp_Object fminiw;
1229
1230 if (EQ (this, frame))
1231 continue;
1232
1233 fminiw = FRAME_MINIBUF_WINDOW (XFRAME (this));
1234
1235 if (WINDOWP (fminiw) && EQ (frame, WINDOW_FRAME (XWINDOW (fminiw))))
1236 {
1237 /* If we MUST delete this frame, delete the other first.
1238 But do this only if FORCE equals `noelisp'. */
1239 if (EQ (force, Qnoelisp))
1240 delete_frame (this, Qnoelisp);
1241 else
1242 error ("Attempt to delete a surrogate minibuffer frame");
1243 }
1244 }
1245 }
1246
1247 is_tooltip_frame = !NILP (Fframe_parameter (frame, intern ("tooltip")));
1248
1249 /* Run `delete-frame-functions' unless FORCE is `noelisp' or
1250 frame is a tooltip. FORCE is set to `noelisp' when handling
1251 a disconnect from the terminal, so we don't dare call Lisp
1252 code. */
1253 if (NILP (Vrun_hooks) || is_tooltip_frame)
1254 ;
1255 else if (EQ (force, Qnoelisp))
1256 pending_funcalls
1257 = Fcons (list3 (Qrun_hook_with_args, Qdelete_frame_functions, frame),
1258 pending_funcalls);
1259 else
1260 {
1261 #ifdef HAVE_X_WINDOWS
1262 /* Also, save clipboard to the clipboard manager. */
1263 x_clipboard_manager_save_frame (frame);
1264 #endif
1265
1266 safe_call2 (Qrun_hook_with_args, Qdelete_frame_functions, frame);
1267 }
1268
1269 /* The hook may sometimes (indirectly) cause the frame to be deleted. */
1270 if (! FRAME_LIVE_P (f))
1271 return Qnil;
1272
1273 /* At this point, we are committed to deleting the frame.
1274 There is no more chance for errors to prevent it. */
1275
1276 minibuffer_selected = EQ (minibuf_window, selected_window);
1277 sf = SELECTED_FRAME ();
1278 /* Don't let the frame remain selected. */
1279 if (f == sf)
1280 {
1281 Lisp_Object tail;
1282 Lisp_Object frame1 = Qnil;
1283
1284 /* Look for another visible frame on the same terminal.
1285 Do not call next_frame here because it may loop forever.
1286 See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=15025. */
1287 FOR_EACH_FRAME (tail, frame1)
1288 if (!EQ (frame, frame1)
1289 && (FRAME_TERMINAL (XFRAME (frame))
1290 == FRAME_TERMINAL (XFRAME (frame1)))
1291 && FRAME_VISIBLE_P (XFRAME (frame1)))
1292 break;
1293
1294 /* If there is none, find *some* other frame. */
1295 if (NILP (frame1) || EQ (frame1, frame))
1296 {
1297 FOR_EACH_FRAME (tail, frame1)
1298 {
1299 if (! EQ (frame, frame1) && FRAME_LIVE_P (XFRAME (frame1)))
1300 {
1301 /* Do not change a text terminal's top-frame. */
1302 struct frame *f1 = XFRAME (frame1);
1303 if (FRAME_TERMCAP_P (f1) || FRAME_MSDOS_P (f1))
1304 {
1305 Lisp_Object top_frame = FRAME_TTY (f1)->top_frame;
1306 if (!EQ (top_frame, frame))
1307 frame1 = top_frame;
1308 }
1309 break;
1310 }
1311 }
1312 }
1313 #ifdef NS_IMPL_COCOA
1314 else
1315 /* Under NS, there is no system mechanism for choosing a new
1316 window to get focus -- it is left to application code.
1317 So the portion of THIS application interfacing with NS
1318 needs to know about it. We call Fraise_frame, but the
1319 purpose is really to transfer focus. */
1320 Fraise_frame (frame1);
1321 #endif
1322
1323 do_switch_frame (frame1, 0, 1, Qnil);
1324 sf = SELECTED_FRAME ();
1325 }
1326
1327 /* Don't allow minibuf_window to remain on a deleted frame. */
1328 check_minibuf_window (frame, minibuffer_selected);
1329
1330 /* Don't let echo_area_window to remain on a deleted frame. */
1331 if (EQ (f->minibuffer_window, echo_area_window))
1332 echo_area_window = sf->minibuffer_window;
1333
1334 /* Clear any X selections for this frame. */
1335 #ifdef HAVE_X_WINDOWS
1336 if (FRAME_X_P (f))
1337 x_clear_frame_selections (f);
1338 #endif
1339
1340 /* Free glyphs.
1341 This function must be called before the window tree of the
1342 frame is deleted because windows contain dynamically allocated
1343 memory. */
1344 free_glyphs (f);
1345
1346 #ifdef HAVE_WINDOW_SYSTEM
1347 /* Give chance to each font driver to free a frame specific data. */
1348 font_update_drivers (f, Qnil);
1349 #endif
1350
1351 /* Mark all the windows that used to be on FRAME as deleted, and then
1352 remove the reference to them. */
1353 delete_all_child_windows (f->root_window);
1354 fset_root_window (f, Qnil);
1355
1356 Vframe_list = Fdelq (frame, Vframe_list);
1357 SET_FRAME_VISIBLE (f, 0);
1358
1359 /* Allow the vector of menu bar contents to be freed in the next
1360 garbage collection. The frame object itself may not be garbage
1361 collected until much later, because recent_keys and other data
1362 structures can still refer to it. */
1363 fset_menu_bar_vector (f, Qnil);
1364
1365 /* If FRAME's buffer lists contains killed
1366 buffers, this helps GC to reclaim them. */
1367 fset_buffer_list (f, Qnil);
1368 fset_buried_buffer_list (f, Qnil);
1369
1370 free_font_driver_list (f);
1371 xfree (f->namebuf);
1372 xfree (f->decode_mode_spec_buffer);
1373 xfree (FRAME_INSERT_COST (f));
1374 xfree (FRAME_DELETEN_COST (f));
1375 xfree (FRAME_INSERTN_COST (f));
1376 xfree (FRAME_DELETE_COST (f));
1377
1378 /* Since some events are handled at the interrupt level, we may get
1379 an event for f at any time; if we zero out the frame's terminal
1380 now, then we may trip up the event-handling code. Instead, we'll
1381 promise that the terminal of the frame must be valid until we
1382 have called the window-system-dependent frame destruction
1383 routine. */
1384
1385
1386 {
1387 struct terminal *terminal;
1388 block_input ();
1389 if (FRAME_TERMINAL (f)->delete_frame_hook)
1390 (*FRAME_TERMINAL (f)->delete_frame_hook) (f);
1391 terminal = FRAME_TERMINAL (f);
1392 f->output_data.nothing = 0;
1393 f->terminal = 0; /* Now the frame is dead. */
1394 unblock_input ();
1395
1396 /* If needed, delete the terminal that this frame was on.
1397 (This must be done after the frame is killed.) */
1398 terminal->reference_count--;
1399 #ifdef USE_GTK
1400 /* FIXME: Deleting the terminal crashes emacs because of a GTK
1401 bug.
1402 http://lists.gnu.org/archive/html/emacs-devel/2011-10/msg00363.html */
1403 if (terminal->reference_count == 0 && terminal->type == output_x_window)
1404 terminal->reference_count = 1;
1405 #endif /* USE_GTK */
1406 if (terminal->reference_count == 0)
1407 {
1408 Lisp_Object tmp;
1409 XSETTERMINAL (tmp, terminal);
1410
1411 kb = NULL;
1412 Fdelete_terminal (tmp, NILP (force) ? Qt : force);
1413 }
1414 else
1415 kb = terminal->kboard;
1416 }
1417
1418 /* If we've deleted the last_nonminibuf_frame, then try to find
1419 another one. */
1420 if (f == last_nonminibuf_frame)
1421 {
1422 Lisp_Object frames, this;
1423
1424 last_nonminibuf_frame = 0;
1425
1426 FOR_EACH_FRAME (frames, this)
1427 {
1428 f = XFRAME (this);
1429 if (!FRAME_MINIBUF_ONLY_P (f))
1430 {
1431 last_nonminibuf_frame = f;
1432 break;
1433 }
1434 }
1435 }
1436
1437 /* If there's no other frame on the same kboard, get out of
1438 single-kboard state if we're in it for this kboard. */
1439 if (kb != NULL)
1440 {
1441 Lisp_Object frames, this;
1442 /* Some frame we found on the same kboard, or nil if there are none. */
1443 Lisp_Object frame_on_same_kboard = Qnil;
1444
1445 FOR_EACH_FRAME (frames, this)
1446 if (kb == FRAME_KBOARD (XFRAME (this)))
1447 frame_on_same_kboard = this;
1448
1449 if (NILP (frame_on_same_kboard))
1450 not_single_kboard_state (kb);
1451 }
1452
1453
1454 /* If we've deleted this keyboard's default_minibuffer_frame, try to
1455 find another one. Prefer minibuffer-only frames, but also notice
1456 frames with other windows. */
1457 if (kb != NULL && EQ (frame, KVAR (kb, Vdefault_minibuffer_frame)))
1458 {
1459 Lisp_Object frames, this;
1460
1461 /* The last frame we saw with a minibuffer, minibuffer-only or not. */
1462 Lisp_Object frame_with_minibuf = Qnil;
1463 /* Some frame we found on the same kboard, or nil if there are none. */
1464 Lisp_Object frame_on_same_kboard = Qnil;
1465
1466 FOR_EACH_FRAME (frames, this)
1467 {
1468 struct frame *f1 = XFRAME (this);
1469
1470 /* Consider only frames on the same kboard
1471 and only those with minibuffers. */
1472 if (kb == FRAME_KBOARD (f1)
1473 && FRAME_HAS_MINIBUF_P (f1))
1474 {
1475 frame_with_minibuf = this;
1476 if (FRAME_MINIBUF_ONLY_P (f1))
1477 break;
1478 }
1479
1480 if (kb == FRAME_KBOARD (f1))
1481 frame_on_same_kboard = this;
1482 }
1483
1484 if (!NILP (frame_on_same_kboard))
1485 {
1486 /* We know that there must be some frame with a minibuffer out
1487 there. If this were not true, all of the frames present
1488 would have to be minibufferless, which implies that at some
1489 point their minibuffer frames must have been deleted, but
1490 that is prohibited at the top; you can't delete surrogate
1491 minibuffer frames. */
1492 if (NILP (frame_with_minibuf))
1493 emacs_abort ();
1494
1495 kset_default_minibuffer_frame (kb, frame_with_minibuf);
1496 }
1497 else
1498 /* No frames left on this kboard--say no minibuffer either. */
1499 kset_default_minibuffer_frame (kb, Qnil);
1500 }
1501
1502 /* Cause frame titles to update--necessary if we now have just one frame. */
1503 if (!is_tooltip_frame)
1504 update_mode_lines = 15;
1505
1506 return Qnil;
1507 }
1508
1509 DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 2, "",
1510 doc: /* Delete FRAME, permanently eliminating it from use.
1511 FRAME defaults to the selected frame.
1512
1513 A frame may not be deleted if its minibuffer is used by other frames.
1514 Normally, you may not delete a frame if all other frames are invisible,
1515 but if the second optional argument FORCE is non-nil, you may do so.
1516
1517 This function runs `delete-frame-functions' before actually
1518 deleting the frame, unless the frame is a tooltip.
1519 The functions are run with one argument, the frame to be deleted. */)
1520 (Lisp_Object frame, Lisp_Object force)
1521 {
1522 return delete_frame (frame, !NILP (force) ? Qt : Qnil);
1523 }
1524
1525 \f
1526 /* Return mouse position in character cell units. */
1527
1528 DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0,
1529 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1530 The position is given in character cells, where (0, 0) is the
1531 upper-left corner of the frame, X is the horizontal offset, and Y is
1532 the vertical offset.
1533 If Emacs is running on a mouseless terminal or hasn't been programmed
1534 to read the mouse position, it returns the selected frame for FRAME
1535 and nil for X and Y.
1536 If `mouse-position-function' is non-nil, `mouse-position' calls it,
1537 passing the normal return value to that function as an argument,
1538 and returns whatever that function returns. */)
1539 (void)
1540 {
1541 struct frame *f;
1542 Lisp_Object lispy_dummy;
1543 Lisp_Object x, y, retval;
1544 struct gcpro gcpro1;
1545
1546 f = SELECTED_FRAME ();
1547 x = y = Qnil;
1548
1549 /* It's okay for the hook to refrain from storing anything. */
1550 if (FRAME_TERMINAL (f)->mouse_position_hook)
1551 {
1552 enum scroll_bar_part party_dummy;
1553 Time time_dummy;
1554 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1555 &lispy_dummy, &party_dummy,
1556 &x, &y,
1557 &time_dummy);
1558 }
1559
1560 if (! NILP (x))
1561 {
1562 int col = XINT (x);
1563 int row = XINT (y);
1564 pixel_to_glyph_coords (f, col, row, &col, &row, NULL, 1);
1565 XSETINT (x, col);
1566 XSETINT (y, row);
1567 }
1568 XSETFRAME (lispy_dummy, f);
1569 retval = Fcons (lispy_dummy, Fcons (x, y));
1570 GCPRO1 (retval);
1571 if (!NILP (Vmouse_position_function))
1572 retval = call1 (Vmouse_position_function, retval);
1573 RETURN_UNGCPRO (retval);
1574 }
1575
1576 DEFUN ("mouse-pixel-position", Fmouse_pixel_position,
1577 Smouse_pixel_position, 0, 0, 0,
1578 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1579 The position is given in pixel units, where (0, 0) is the
1580 upper-left corner of the frame, X is the horizontal offset, and Y is
1581 the vertical offset.
1582 If Emacs is running on a mouseless terminal or hasn't been programmed
1583 to read the mouse position, it returns the selected frame for FRAME
1584 and nil for X and Y. */)
1585 (void)
1586 {
1587 struct frame *f;
1588 Lisp_Object lispy_dummy;
1589 Lisp_Object x, y;
1590
1591 f = SELECTED_FRAME ();
1592 x = y = Qnil;
1593
1594 /* It's okay for the hook to refrain from storing anything. */
1595 if (FRAME_TERMINAL (f)->mouse_position_hook)
1596 {
1597 enum scroll_bar_part party_dummy;
1598 Time time_dummy;
1599 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
1600 &lispy_dummy, &party_dummy,
1601 &x, &y,
1602 &time_dummy);
1603 }
1604
1605 XSETFRAME (lispy_dummy, f);
1606 return Fcons (lispy_dummy, Fcons (x, y));
1607 }
1608
1609 #ifdef HAVE_WINDOW_SYSTEM
1610
1611 /* On frame F, convert character coordinates X and Y to pixel
1612 coordinates *PIX_X and *PIX_Y. */
1613
1614 static void
1615 frame_char_to_pixel_position (struct frame *f, int x, int y,
1616 int *pix_x, int *pix_y)
1617 {
1618 *pix_x = FRAME_COL_TO_PIXEL_X (f, x) + FRAME_COLUMN_WIDTH (f) / 2;
1619 *pix_y = FRAME_LINE_TO_PIXEL_Y (f, y) + FRAME_LINE_HEIGHT (f) / 2;
1620
1621 if (*pix_x < 0)
1622 *pix_x = 0;
1623 if (*pix_x > FRAME_PIXEL_WIDTH (f))
1624 *pix_x = FRAME_PIXEL_WIDTH (f);
1625
1626 if (*pix_y < 0)
1627 *pix_y = 0;
1628 if (*pix_y > FRAME_PIXEL_HEIGHT (f))
1629 *pix_y = FRAME_PIXEL_HEIGHT (f);
1630 }
1631
1632 /* On frame F, reposition mouse pointer to character coordinates X and Y. */
1633
1634 static void
1635 frame_set_mouse_position (struct frame *f, int x, int y)
1636 {
1637 int pix_x, pix_y;
1638
1639 frame_char_to_pixel_position (f, x, y, &pix_x, &pix_y);
1640 frame_set_mouse_pixel_position (f, pix_x, pix_y);
1641 }
1642
1643 #endif /* HAVE_WINDOW_SYSTEM */
1644
1645 DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0,
1646 doc: /* Move the mouse pointer to the center of character cell (X,Y) in FRAME.
1647 Coordinates are relative to the frame, not a window,
1648 so the coordinates of the top left character in the frame
1649 may be nonzero due to left-hand scroll bars or the menu bar.
1650
1651 The position is given in character cells, where (0, 0) is the
1652 upper-left corner of the frame, X is the horizontal offset, and Y is
1653 the vertical offset.
1654
1655 This function is a no-op for an X frame that is not visible.
1656 If you have just created a frame, you must wait for it to become visible
1657 before calling this function on it, like this.
1658 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1659 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1660 {
1661 CHECK_LIVE_FRAME (frame);
1662 CHECK_TYPE_RANGED_INTEGER (int, x);
1663 CHECK_TYPE_RANGED_INTEGER (int, y);
1664
1665 /* I think this should be done with a hook. */
1666 #ifdef HAVE_WINDOW_SYSTEM
1667 if (FRAME_WINDOW_P (XFRAME (frame)))
1668 /* Warping the mouse will cause enternotify and focus events. */
1669 frame_set_mouse_position (XFRAME (frame), XINT (x), XINT (y));
1670 #else
1671 #if defined (MSDOS)
1672 if (FRAME_MSDOS_P (XFRAME (frame)))
1673 {
1674 Fselect_frame (frame, Qnil);
1675 mouse_moveto (XINT (x), XINT (y));
1676 }
1677 #else
1678 #ifdef HAVE_GPM
1679 {
1680 Fselect_frame (frame, Qnil);
1681 term_mouse_moveto (XINT (x), XINT (y));
1682 }
1683 #endif
1684 #endif
1685 #endif
1686
1687 return Qnil;
1688 }
1689
1690 DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position,
1691 Sset_mouse_pixel_position, 3, 3, 0,
1692 doc: /* Move the mouse pointer to pixel position (X,Y) in FRAME.
1693 The position is given in pixels, where (0, 0) is the upper-left corner
1694 of the frame, X is the horizontal offset, and Y is the vertical offset.
1695
1696 Note, this is a no-op for an X frame that is not visible.
1697 If you have just created a frame, you must wait for it to become visible
1698 before calling this function on it, like this.
1699 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1700 (Lisp_Object frame, Lisp_Object x, Lisp_Object y)
1701 {
1702 CHECK_LIVE_FRAME (frame);
1703 CHECK_TYPE_RANGED_INTEGER (int, x);
1704 CHECK_TYPE_RANGED_INTEGER (int, y);
1705
1706 /* I think this should be done with a hook. */
1707 #ifdef HAVE_WINDOW_SYSTEM
1708 if (FRAME_WINDOW_P (XFRAME (frame)))
1709 /* Warping the mouse will cause enternotify and focus events. */
1710 frame_set_mouse_pixel_position (XFRAME (frame), XINT (x), XINT (y));
1711 #else
1712 #if defined (MSDOS)
1713 if (FRAME_MSDOS_P (XFRAME (frame)))
1714 {
1715 Fselect_frame (frame, Qnil);
1716 mouse_moveto (XINT (x), XINT (y));
1717 }
1718 #else
1719 #ifdef HAVE_GPM
1720 {
1721 Fselect_frame (frame, Qnil);
1722 term_mouse_moveto (XINT (x), XINT (y));
1723 }
1724 #endif
1725 #endif
1726 #endif
1727
1728 return Qnil;
1729 }
1730 \f
1731 static void make_frame_visible_1 (Lisp_Object);
1732
1733 DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible,
1734 0, 1, "",
1735 doc: /* Make the frame FRAME visible (assuming it is an X window).
1736 If omitted, FRAME defaults to the currently selected frame. */)
1737 (Lisp_Object frame)
1738 {
1739 struct frame *f = decode_live_frame (frame);
1740
1741 /* I think this should be done with a hook. */
1742 #ifdef HAVE_WINDOW_SYSTEM
1743 if (FRAME_WINDOW_P (f))
1744 x_make_frame_visible (f);
1745 #endif
1746
1747 make_frame_visible_1 (f->root_window);
1748
1749 /* Make menu bar update for the Buffers and Frames menus. */
1750 /* windows_or_buffers_changed = 15; FIXME: Why? */
1751
1752 XSETFRAME (frame, f);
1753 return frame;
1754 }
1755
1756 /* Update the display_time slot of the buffers shown in WINDOW
1757 and all its descendants. */
1758
1759 static void
1760 make_frame_visible_1 (Lisp_Object window)
1761 {
1762 struct window *w;
1763
1764 for (; !NILP (window); window = w->next)
1765 {
1766 w = XWINDOW (window);
1767 if (WINDOWP (w->contents))
1768 make_frame_visible_1 (w->contents);
1769 else
1770 bset_display_time (XBUFFER (w->contents), Fcurrent_time ());
1771 }
1772 }
1773
1774 DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible,
1775 0, 2, "",
1776 doc: /* Make the frame FRAME invisible.
1777 If omitted, FRAME defaults to the currently selected frame.
1778 On graphical displays, invisible frames are not updated and are
1779 usually not displayed at all, even in a window system's \"taskbar\".
1780
1781 Normally you may not make FRAME invisible if all other frames are invisible,
1782 but if the second optional argument FORCE is non-nil, you may do so.
1783
1784 This function has no effect on text terminal frames. Such frames are
1785 always considered visible, whether or not they are currently being
1786 displayed in the terminal. */)
1787 (Lisp_Object frame, Lisp_Object force)
1788 {
1789 struct frame *f = decode_live_frame (frame);
1790
1791 if (NILP (force) && !other_visible_frames (f))
1792 error ("Attempt to make invisible the sole visible or iconified frame");
1793
1794 /* Don't allow minibuf_window to remain on an invisible frame. */
1795 check_minibuf_window (frame, EQ (minibuf_window, selected_window));
1796
1797 /* I think this should be done with a hook. */
1798 #ifdef HAVE_WINDOW_SYSTEM
1799 if (FRAME_WINDOW_P (f))
1800 x_make_frame_invisible (f);
1801 #endif
1802
1803 /* Make menu bar update for the Buffers and Frames menus. */
1804 windows_or_buffers_changed = 16;
1805
1806 return Qnil;
1807 }
1808
1809 DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame,
1810 0, 1, "",
1811 doc: /* Make the frame FRAME into an icon.
1812 If omitted, FRAME defaults to the currently selected frame. */)
1813 (Lisp_Object frame)
1814 {
1815 struct frame *f = decode_live_frame (frame);
1816
1817 /* Don't allow minibuf_window to remain on an iconified frame. */
1818 check_minibuf_window (frame, EQ (minibuf_window, selected_window));
1819
1820 /* I think this should be done with a hook. */
1821 #ifdef HAVE_WINDOW_SYSTEM
1822 if (FRAME_WINDOW_P (f))
1823 x_iconify_frame (f);
1824 #endif
1825
1826 /* Make menu bar update for the Buffers and Frames menus. */
1827 windows_or_buffers_changed = 17;
1828
1829 return Qnil;
1830 }
1831
1832 DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p,
1833 1, 1, 0,
1834 doc: /* Return t if FRAME is \"visible\" (actually in use for display).
1835 Return the symbol `icon' if FRAME is iconified or \"minimized\".
1836 Return nil if FRAME was made invisible, via `make-frame-invisible'.
1837 On graphical displays, invisible frames are not updated and are
1838 usually not displayed at all, even in a window system's \"taskbar\".
1839
1840 If FRAME is a text terminal frame, this always returns t.
1841 Such frames are always considered visible, whether or not they are
1842 currently being displayed on the terminal. */)
1843 (Lisp_Object frame)
1844 {
1845 CHECK_LIVE_FRAME (frame);
1846
1847 if (FRAME_VISIBLE_P (XFRAME (frame)))
1848 return Qt;
1849 if (FRAME_ICONIFIED_P (XFRAME (frame)))
1850 return Qicon;
1851 return Qnil;
1852 }
1853
1854 DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list,
1855 0, 0, 0,
1856 doc: /* Return a list of all frames now \"visible\" (being updated). */)
1857 (void)
1858 {
1859 Lisp_Object tail, frame, value = Qnil;
1860
1861 FOR_EACH_FRAME (tail, frame)
1862 if (FRAME_VISIBLE_P (XFRAME (frame)))
1863 value = Fcons (frame, value);
1864
1865 return value;
1866 }
1867
1868
1869 DEFUN ("raise-frame", Fraise_frame, Sraise_frame, 0, 1, "",
1870 doc: /* Bring FRAME to the front, so it occludes any frames it overlaps.
1871 If FRAME is invisible or iconified, make it visible.
1872 If you don't specify a frame, the selected frame is used.
1873 If Emacs is displaying on an ordinary terminal or some other device which
1874 doesn't support multiple overlapping frames, this function selects FRAME. */)
1875 (Lisp_Object frame)
1876 {
1877 struct frame *f = decode_live_frame (frame);
1878
1879 XSETFRAME (frame, f);
1880
1881 if (FRAME_TERMCAP_P (f))
1882 /* On a text terminal select FRAME. */
1883 Fselect_frame (frame, Qnil);
1884 else
1885 /* Do like the documentation says. */
1886 Fmake_frame_visible (frame);
1887
1888 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
1889 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 1);
1890
1891 return Qnil;
1892 }
1893
1894 /* Should we have a corresponding function called Flower_Power? */
1895 DEFUN ("lower-frame", Flower_frame, Slower_frame, 0, 1, "",
1896 doc: /* Send FRAME to the back, so it is occluded by any frames that overlap it.
1897 If you don't specify a frame, the selected frame is used.
1898 If Emacs is displaying on an ordinary terminal or some other device which
1899 doesn't support multiple overlapping frames, this function does nothing. */)
1900 (Lisp_Object frame)
1901 {
1902 struct frame *f = decode_live_frame (frame);
1903
1904 if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
1905 (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 0);
1906
1907 return Qnil;
1908 }
1909
1910 \f
1911 DEFUN ("redirect-frame-focus", Fredirect_frame_focus, Sredirect_frame_focus,
1912 1, 2, 0,
1913 doc: /* Arrange for keystrokes typed at FRAME to be sent to FOCUS-FRAME.
1914 In other words, switch-frame events caused by events in FRAME will
1915 request a switch to FOCUS-FRAME, and `last-event-frame' will be
1916 FOCUS-FRAME after reading an event typed at FRAME.
1917
1918 If FOCUS-FRAME is nil, any existing redirection is canceled, and the
1919 frame again receives its own keystrokes.
1920
1921 Focus redirection is useful for temporarily redirecting keystrokes to
1922 a surrogate minibuffer frame when a frame doesn't have its own
1923 minibuffer window.
1924
1925 A frame's focus redirection can be changed by `select-frame'. If frame
1926 FOO is selected, and then a different frame BAR is selected, any
1927 frames redirecting their focus to FOO are shifted to redirect their
1928 focus to BAR. This allows focus redirection to work properly when the
1929 user switches from one frame to another using `select-window'.
1930
1931 This means that a frame whose focus is redirected to itself is treated
1932 differently from a frame whose focus is redirected to nil; the former
1933 is affected by `select-frame', while the latter is not.
1934
1935 The redirection lasts until `redirect-frame-focus' is called to change it. */)
1936 (Lisp_Object frame, Lisp_Object focus_frame)
1937 {
1938 /* Note that we don't check for a live frame here. It's reasonable
1939 to redirect the focus of a frame you're about to delete, if you
1940 know what other frame should receive those keystrokes. */
1941 struct frame *f = decode_any_frame (frame);
1942
1943 if (! NILP (focus_frame))
1944 CHECK_LIVE_FRAME (focus_frame);
1945
1946 fset_focus_frame (f, focus_frame);
1947
1948 if (FRAME_TERMINAL (f)->frame_rehighlight_hook)
1949 (*FRAME_TERMINAL (f)->frame_rehighlight_hook) (f);
1950
1951 return Qnil;
1952 }
1953
1954
1955 DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 0, 1, 0,
1956 doc: /* Return the frame to which FRAME's keystrokes are currently being sent.
1957 If FRAME is omitted or nil, the selected frame is used.
1958 Return nil if FRAME's focus is not redirected.
1959 See `redirect-frame-focus'. */)
1960 (Lisp_Object frame)
1961 {
1962 return FRAME_FOCUS_FRAME (decode_live_frame (frame));
1963 }
1964
1965 DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
1966 doc: /* Set the input focus to FRAME.
1967 FRAME nil means use the selected frame.
1968 If there is no window system support, this function does nothing. */)
1969 (Lisp_Object frame)
1970 {
1971 #ifdef HAVE_WINDOW_SYSTEM
1972 x_focus_frame (decode_window_system_frame (frame));
1973 #endif
1974 return Qnil;
1975 }
1976
1977 \f
1978 /* Return the value of frame parameter PROP in frame FRAME. */
1979
1980 #ifdef HAVE_WINDOW_SYSTEM
1981 Lisp_Object
1982 get_frame_param (register struct frame *frame, Lisp_Object prop)
1983 {
1984 register Lisp_Object tem;
1985
1986 tem = Fassq (prop, frame->param_alist);
1987 if (EQ (tem, Qnil))
1988 return tem;
1989 return Fcdr (tem);
1990 }
1991 #endif
1992
1993 /* Discard BUFFER from the buffer-list and buried-buffer-list of each frame. */
1994
1995 void
1996 frames_discard_buffer (Lisp_Object buffer)
1997 {
1998 Lisp_Object frame, tail;
1999
2000 FOR_EACH_FRAME (tail, frame)
2001 {
2002 fset_buffer_list
2003 (XFRAME (frame), Fdelq (buffer, XFRAME (frame)->buffer_list));
2004 fset_buried_buffer_list
2005 (XFRAME (frame), Fdelq (buffer, XFRAME (frame)->buried_buffer_list));
2006 }
2007 }
2008
2009 /* Modify the alist in *ALISTPTR to associate PROP with VAL.
2010 If the alist already has an element for PROP, we change it. */
2011
2012 void
2013 store_in_alist (Lisp_Object *alistptr, Lisp_Object prop, Lisp_Object val)
2014 {
2015 register Lisp_Object tem;
2016
2017 tem = Fassq (prop, *alistptr);
2018 if (EQ (tem, Qnil))
2019 *alistptr = Fcons (Fcons (prop, val), *alistptr);
2020 else
2021 Fsetcdr (tem, val);
2022 }
2023
2024 static int
2025 frame_name_fnn_p (char *str, ptrdiff_t len)
2026 {
2027 if (len > 1 && str[0] == 'F' && '0' <= str[1] && str[1] <= '9')
2028 {
2029 char *p = str + 2;
2030 while ('0' <= *p && *p <= '9')
2031 p++;
2032 if (p == str + len)
2033 return 1;
2034 }
2035 return 0;
2036 }
2037
2038 /* Set the name of the terminal frame. Also used by MSDOS frames.
2039 Modeled after x_set_name which is used for WINDOW frames. */
2040
2041 static void
2042 set_term_frame_name (struct frame *f, Lisp_Object name)
2043 {
2044 f->explicit_name = ! NILP (name);
2045
2046 /* If NAME is nil, set the name to F<num>. */
2047 if (NILP (name))
2048 {
2049 char namebuf[sizeof "F" + INT_STRLEN_BOUND (printmax_t)];
2050
2051 /* Check for no change needed in this very common case
2052 before we do any consing. */
2053 if (frame_name_fnn_p (SSDATA (f->name), SBYTES (f->name)))
2054 return;
2055
2056 name = make_formatted_string (namebuf, "F%"pMd, ++tty_frame_count);
2057 }
2058 else
2059 {
2060 CHECK_STRING (name);
2061
2062 /* Don't change the name if it's already NAME. */
2063 if (! NILP (Fstring_equal (name, f->name)))
2064 return;
2065
2066 /* Don't allow the user to set the frame name to F<num>, so it
2067 doesn't clash with the names we generate for terminal frames. */
2068 if (frame_name_fnn_p (SSDATA (name), SBYTES (name)))
2069 error ("Frame names of the form F<num> are usurped by Emacs");
2070 }
2071
2072 fset_name (f, name);
2073 update_mode_lines = 16;
2074 }
2075
2076 #ifdef HAVE_NTGUI
2077 void
2078 set_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
2079 {
2080 register Lisp_Object old_alist_elt;
2081
2082 old_alist_elt = Fassq (prop, f->param_alist);
2083 if (EQ (old_alist_elt, Qnil))
2084 fset_param_alist (f, Fcons (Fcons (prop, val), f->param_alist));
2085 else
2086 Fsetcdr (old_alist_elt, val);
2087 }
2088 #endif
2089
2090 void
2091 store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
2092 {
2093 register Lisp_Object old_alist_elt;
2094
2095 /* The buffer-list parameters are stored in a special place and not
2096 in the alist. All buffers must be live. */
2097 if (EQ (prop, Qbuffer_list))
2098 {
2099 Lisp_Object list = Qnil;
2100 for (; CONSP (val); val = XCDR (val))
2101 if (!NILP (Fbuffer_live_p (XCAR (val))))
2102 list = Fcons (XCAR (val), list);
2103 fset_buffer_list (f, Fnreverse (list));
2104 return;
2105 }
2106 if (EQ (prop, Qburied_buffer_list))
2107 {
2108 Lisp_Object list = Qnil;
2109 for (; CONSP (val); val = XCDR (val))
2110 if (!NILP (Fbuffer_live_p (XCAR (val))))
2111 list = Fcons (XCAR (val), list);
2112 fset_buried_buffer_list (f, Fnreverse (list));
2113 return;
2114 }
2115
2116 /* If PROP is a symbol which is supposed to have frame-local values,
2117 and it is set up based on this frame, switch to the global
2118 binding. That way, we can create or alter the frame-local binding
2119 without messing up the symbol's status. */
2120 if (SYMBOLP (prop))
2121 {
2122 struct Lisp_Symbol *sym = XSYMBOL (prop);
2123 start:
2124 switch (sym->redirect)
2125 {
2126 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
2127 case SYMBOL_PLAINVAL: case SYMBOL_FORWARDED: break;
2128 case SYMBOL_LOCALIZED:
2129 { struct Lisp_Buffer_Local_Value *blv = sym->val.blv;
2130 if (blv->frame_local && blv_found (blv) && XFRAME (blv->where) == f)
2131 swap_in_global_binding (sym);
2132 break;
2133 }
2134 default: emacs_abort ();
2135 }
2136 }
2137
2138 /* The tty color needed to be set before the frame's parameter
2139 alist was updated with the new value. This is not true any more,
2140 but we still do this test early on. */
2141 if (FRAME_TERMCAP_P (f) && EQ (prop, Qtty_color_mode)
2142 && f == FRAME_TTY (f)->previous_frame)
2143 /* Force redisplay of this tty. */
2144 FRAME_TTY (f)->previous_frame = NULL;
2145
2146 /* Update the frame parameter alist. */
2147 old_alist_elt = Fassq (prop, f->param_alist);
2148 if (EQ (old_alist_elt, Qnil))
2149 fset_param_alist (f, Fcons (Fcons (prop, val), f->param_alist));
2150 else
2151 Fsetcdr (old_alist_elt, val);
2152
2153 /* Update some other special parameters in their special places
2154 in addition to the alist. */
2155
2156 if (EQ (prop, Qbuffer_predicate))
2157 fset_buffer_predicate (f, val);
2158
2159 if (! FRAME_WINDOW_P (f))
2160 {
2161 if (EQ (prop, Qmenu_bar_lines))
2162 set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f)));
2163 else if (EQ (prop, Qname))
2164 set_term_frame_name (f, val);
2165 }
2166
2167 if (EQ (prop, Qminibuffer) && WINDOWP (val))
2168 {
2169 if (! MINI_WINDOW_P (XWINDOW (val)))
2170 error ("Surrogate minibuffer windows must be minibuffer windows");
2171
2172 if ((FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
2173 && !EQ (val, f->minibuffer_window))
2174 error ("Can't change the surrogate minibuffer of a frame with its own minibuffer");
2175
2176 /* Install the chosen minibuffer window, with proper buffer. */
2177 fset_minibuffer_window (f, val);
2178 }
2179 }
2180
2181 DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0,
2182 doc: /* Return the parameters-alist of frame FRAME.
2183 It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
2184 The meaningful PARMs depend on the kind of frame.
2185 If FRAME is omitted or nil, return information on the currently selected frame. */)
2186 (Lisp_Object frame)
2187 {
2188 Lisp_Object alist;
2189 struct frame *f = decode_any_frame (frame);
2190 int height, width;
2191 struct gcpro gcpro1;
2192
2193 if (!FRAME_LIVE_P (f))
2194 return Qnil;
2195
2196 alist = Fcopy_alist (f->param_alist);
2197 GCPRO1 (alist);
2198
2199 if (!FRAME_WINDOW_P (f))
2200 {
2201 int fg = FRAME_FOREGROUND_PIXEL (f);
2202 int bg = FRAME_BACKGROUND_PIXEL (f);
2203 Lisp_Object elt;
2204
2205 /* If the frame's parameter alist says the colors are
2206 unspecified and reversed, take the frame's background pixel
2207 for foreground and vice versa. */
2208 elt = Fassq (Qforeground_color, alist);
2209 if (CONSP (elt) && STRINGP (XCDR (elt)))
2210 {
2211 if (strncmp (SSDATA (XCDR (elt)),
2212 unspecified_bg,
2213 SCHARS (XCDR (elt))) == 0)
2214 store_in_alist (&alist, Qforeground_color, tty_color_name (f, bg));
2215 else if (strncmp (SSDATA (XCDR (elt)),
2216 unspecified_fg,
2217 SCHARS (XCDR (elt))) == 0)
2218 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2219 }
2220 else
2221 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2222 elt = Fassq (Qbackground_color, alist);
2223 if (CONSP (elt) && STRINGP (XCDR (elt)))
2224 {
2225 if (strncmp (SSDATA (XCDR (elt)),
2226 unspecified_fg,
2227 SCHARS (XCDR (elt))) == 0)
2228 store_in_alist (&alist, Qbackground_color, tty_color_name (f, fg));
2229 else if (strncmp (SSDATA (XCDR (elt)),
2230 unspecified_bg,
2231 SCHARS (XCDR (elt))) == 0)
2232 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2233 }
2234 else
2235 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2236 store_in_alist (&alist, intern ("font"),
2237 build_string (FRAME_MSDOS_P (f)
2238 ? "ms-dos"
2239 : FRAME_W32_P (f) ? "w32term"
2240 :"tty"));
2241 }
2242 store_in_alist (&alist, Qname, f->name);
2243 height = (f->new_height
2244 ? (f->new_pixelwise
2245 ? (f->new_height / FRAME_LINE_HEIGHT (f))
2246 : f->new_height)
2247 : FRAME_LINES (f));
2248 store_in_alist (&alist, Qheight, make_number (height));
2249 width = (f->new_width
2250 ? (f->new_pixelwise
2251 ? (f->new_width / FRAME_COLUMN_WIDTH (f))
2252 : f->new_width)
2253 : FRAME_COLS (f));
2254 store_in_alist (&alist, Qwidth, make_number (width));
2255 store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil));
2256 store_in_alist (&alist, Qminibuffer,
2257 (! FRAME_HAS_MINIBUF_P (f) ? Qnil
2258 : FRAME_MINIBUF_ONLY_P (f) ? Qonly
2259 : FRAME_MINIBUF_WINDOW (f)));
2260 store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
2261 store_in_alist (&alist, Qbuffer_list, f->buffer_list);
2262 store_in_alist (&alist, Qburied_buffer_list, f->buried_buffer_list);
2263
2264 /* I think this should be done with a hook. */
2265 #ifdef HAVE_WINDOW_SYSTEM
2266 if (FRAME_WINDOW_P (f))
2267 x_report_frame_params (f, &alist);
2268 else
2269 #endif
2270 {
2271 /* This ought to be correct in f->param_alist for an X frame. */
2272 Lisp_Object lines;
2273 XSETFASTINT (lines, FRAME_MENU_BAR_LINES (f));
2274 store_in_alist (&alist, Qmenu_bar_lines, lines);
2275 }
2276
2277 UNGCPRO;
2278 return alist;
2279 }
2280
2281
2282 DEFUN ("frame-parameter", Fframe_parameter, Sframe_parameter, 2, 2, 0,
2283 doc: /* Return FRAME's value for parameter PARAMETER.
2284 If FRAME is nil, describe the currently selected frame. */)
2285 (Lisp_Object frame, Lisp_Object parameter)
2286 {
2287 struct frame *f = decode_any_frame (frame);
2288 Lisp_Object value = Qnil;
2289
2290 CHECK_SYMBOL (parameter);
2291
2292 XSETFRAME (frame, f);
2293
2294 if (FRAME_LIVE_P (f))
2295 {
2296 /* Avoid consing in frequent cases. */
2297 if (EQ (parameter, Qname))
2298 value = f->name;
2299 #ifdef HAVE_X_WINDOWS
2300 else if (EQ (parameter, Qdisplay) && FRAME_X_P (f))
2301 value = XCAR (FRAME_DISPLAY_INFO (f)->name_list_element);
2302 #endif /* HAVE_X_WINDOWS */
2303 else if (EQ (parameter, Qbackground_color)
2304 || EQ (parameter, Qforeground_color))
2305 {
2306 value = Fassq (parameter, f->param_alist);
2307 if (CONSP (value))
2308 {
2309 value = XCDR (value);
2310 /* Fframe_parameters puts the actual fg/bg color names,
2311 even if f->param_alist says otherwise. This is
2312 important when param_alist's notion of colors is
2313 "unspecified". We need to do the same here. */
2314 if (STRINGP (value) && !FRAME_WINDOW_P (f))
2315 {
2316 const char *color_name;
2317 ptrdiff_t csz;
2318
2319 if (EQ (parameter, Qbackground_color))
2320 {
2321 color_name = SSDATA (value);
2322 csz = SCHARS (value);
2323 if (strncmp (color_name, unspecified_bg, csz) == 0)
2324 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2325 else if (strncmp (color_name, unspecified_fg, csz) == 0)
2326 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2327 }
2328 else if (EQ (parameter, Qforeground_color))
2329 {
2330 color_name = SSDATA (value);
2331 csz = SCHARS (value);
2332 if (strncmp (color_name, unspecified_fg, csz) == 0)
2333 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2334 else if (strncmp (color_name, unspecified_bg, csz) == 0)
2335 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2336 }
2337 }
2338 }
2339 else
2340 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2341 }
2342 else if (EQ (parameter, Qdisplay_type)
2343 || EQ (parameter, Qbackground_mode))
2344 value = Fcdr (Fassq (parameter, f->param_alist));
2345 else
2346 /* FIXME: Avoid this code path at all (as well as code duplication)
2347 by sharing more code with Fframe_parameters. */
2348 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2349 }
2350
2351 return value;
2352 }
2353
2354
2355 DEFUN ("modify-frame-parameters", Fmodify_frame_parameters,
2356 Smodify_frame_parameters, 2, 2, 0,
2357 doc: /* Modify the parameters of frame FRAME according to ALIST.
2358 If FRAME is nil, it defaults to the selected frame.
2359 ALIST is an alist of parameters to change and their new values.
2360 Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.
2361 The meaningful PARMs depend on the kind of frame.
2362 Undefined PARMs are ignored, but stored in the frame's parameter list
2363 so that `frame-parameters' will return them.
2364
2365 The value of frame parameter FOO can also be accessed
2366 as a frame-local binding for the variable FOO, if you have
2367 enabled such bindings for that variable with `make-variable-frame-local'.
2368 Note that this functionality is obsolete as of Emacs 22.2, and its
2369 use is not recommended. Explicitly check for a frame-parameter instead. */)
2370 (Lisp_Object frame, Lisp_Object alist)
2371 {
2372 struct frame *f = decode_live_frame (frame);
2373 register Lisp_Object prop, val;
2374
2375 CHECK_LIST (alist);
2376
2377 /* I think this should be done with a hook. */
2378 #ifdef HAVE_WINDOW_SYSTEM
2379 if (FRAME_WINDOW_P (f))
2380 x_set_frame_parameters (f, alist);
2381 else
2382 #endif
2383 #ifdef MSDOS
2384 if (FRAME_MSDOS_P (f))
2385 IT_set_frame_parameters (f, alist);
2386 else
2387 #endif
2388
2389 {
2390 EMACS_INT length = XFASTINT (Flength (alist));
2391 ptrdiff_t i;
2392 Lisp_Object *parms;
2393 Lisp_Object *values;
2394 USE_SAFE_ALLOCA;
2395 SAFE_ALLOCA_LISP (parms, 2 * length);
2396 values = parms + length;
2397
2398 /* Extract parm names and values into those vectors. */
2399
2400 for (i = 0; CONSP (alist); alist = XCDR (alist))
2401 {
2402 Lisp_Object elt;
2403
2404 elt = XCAR (alist);
2405 parms[i] = Fcar (elt);
2406 values[i] = Fcdr (elt);
2407 i++;
2408 }
2409
2410 /* Now process them in reverse of specified order. */
2411 while (--i >= 0)
2412 {
2413 prop = parms[i];
2414 val = values[i];
2415 store_frame_param (f, prop, val);
2416
2417 if (EQ (prop, Qforeground_color)
2418 || EQ (prop, Qbackground_color))
2419 update_face_from_frame_parameter (f, prop, val);
2420 }
2421
2422 SAFE_FREE ();
2423 }
2424 return Qnil;
2425 }
2426 \f
2427 DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height,
2428 0, 1, 0,
2429 doc: /* Height in pixels of a line in the font in frame FRAME.
2430 If FRAME is omitted or nil, the selected frame is used.
2431 For a terminal frame, the value is always 1. */)
2432 (Lisp_Object frame)
2433 {
2434 #ifdef HAVE_WINDOW_SYSTEM
2435 struct frame *f = decode_any_frame (frame);
2436
2437 if (FRAME_WINDOW_P (f))
2438 return make_number (FRAME_LINE_HEIGHT (f));
2439 else
2440 #endif
2441 return make_number (1);
2442 }
2443
2444
2445 DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width,
2446 0, 1, 0,
2447 doc: /* Width in pixels of characters in the font in frame FRAME.
2448 If FRAME is omitted or nil, the selected frame is used.
2449 On a graphical screen, the width is the standard width of the default font.
2450 For a terminal screen, the value is always 1. */)
2451 (Lisp_Object frame)
2452 {
2453 #ifdef HAVE_WINDOW_SYSTEM
2454 struct frame *f = decode_any_frame (frame);
2455
2456 if (FRAME_WINDOW_P (f))
2457 return make_number (FRAME_COLUMN_WIDTH (f));
2458 else
2459 #endif
2460 return make_number (1);
2461 }
2462
2463 DEFUN ("frame-pixel-height", Fframe_pixel_height,
2464 Sframe_pixel_height, 0, 1, 0,
2465 doc: /* Return a FRAME's height in pixels.
2466 If FRAME is omitted or nil, the selected frame is used. The exact value
2467 of the result depends on the window-system and toolkit in use:
2468
2469 In the Gtk+ version of Emacs, it includes only any window (including
2470 the minibuffer or echo area), mode line, and header line. It does not
2471 include the tool bar or menu bar.
2472
2473 With other graphical versions, it also includes the tool bar and the
2474 menu bar.
2475
2476 For a text terminal, it includes the menu bar. In this case, the
2477 result is really in characters rather than pixels (i.e., is identical
2478 to `frame-height'). */)
2479 (Lisp_Object frame)
2480 {
2481 struct frame *f = decode_any_frame (frame);
2482
2483 #ifdef HAVE_WINDOW_SYSTEM
2484 if (FRAME_WINDOW_P (f))
2485 return make_number (FRAME_PIXEL_HEIGHT (f));
2486 else
2487 #endif
2488 return make_number (FRAME_LINES (f));
2489 }
2490
2491 DEFUN ("frame-pixel-width", Fframe_pixel_width,
2492 Sframe_pixel_width, 0, 1, 0,
2493 doc: /* Return FRAME's width in pixels.
2494 For a terminal frame, the result really gives the width in characters.
2495 If FRAME is omitted or nil, the selected frame is used. */)
2496 (Lisp_Object frame)
2497 {
2498 struct frame *f = decode_any_frame (frame);
2499
2500 #ifdef HAVE_WINDOW_SYSTEM
2501 if (FRAME_WINDOW_P (f))
2502 return make_number (FRAME_PIXEL_WIDTH (f));
2503 else
2504 #endif
2505 return make_number (FRAME_COLS (f));
2506 }
2507
2508 DEFUN ("tool-bar-pixel-width", Ftool_bar_pixel_width,
2509 Stool_bar_pixel_width, 0, 1, 0,
2510 doc: /* Return width in pixels of FRAME's tool bar.
2511 The result is greater than zero only when the tool bar is on the left
2512 or right side of FRAME. If FRAME is omitted or nil, the selected frame
2513 is used. */)
2514 (Lisp_Object frame)
2515 {
2516 #ifdef FRAME_TOOLBAR_WIDTH
2517 struct frame *f = decode_any_frame (frame);
2518
2519 if (FRAME_WINDOW_P (f))
2520 return make_number (FRAME_TOOLBAR_WIDTH (f));
2521 #endif
2522 return make_number (0);
2523 }
2524
2525 DEFUN ("frame-text-cols", Fframe_text_cols, Sframe_text_cols, 0, 1, 0,
2526 doc: /* Return width in columns of FRAME's text area. */)
2527 (Lisp_Object frame)
2528 {
2529 return make_number (FRAME_COLS (decode_any_frame (frame)));
2530 }
2531
2532 DEFUN ("frame-text-lines", Fframe_text_lines, Sframe_text_lines, 0, 1, 0,
2533 doc: /* Return height in lines of FRAME's text area. */)
2534 (Lisp_Object frame)
2535 {
2536 return make_number (FRAME_LINES (decode_any_frame (frame)));
2537 }
2538
2539 DEFUN ("frame-total-cols", Fframe_total_cols, Sframe_total_cols, 0, 1, 0,
2540 doc: /* Return total columns of FRAME. */)
2541 (Lisp_Object frame)
2542 {
2543 return make_number (FRAME_TOTAL_COLS (decode_any_frame (frame)));
2544 }
2545
2546 DEFUN ("frame-text-width", Fframe_text_width, Sframe_text_width, 0, 1, 0,
2547 doc: /* Return text area width of FRAME in pixels. */)
2548 (Lisp_Object frame)
2549 {
2550 return make_number (FRAME_TEXT_WIDTH (decode_any_frame (frame)));
2551 }
2552
2553 DEFUN ("frame-text-height", Fframe_text_height, Sframe_text_height, 0, 1, 0,
2554 doc: /* Return text area height of FRAME in pixels. */)
2555 (Lisp_Object frame)
2556 {
2557 return make_number (FRAME_TEXT_HEIGHT (decode_any_frame (frame)));
2558 }
2559
2560 DEFUN ("frame-scroll-bar-width", Fscroll_bar_width, Sscroll_bar_width, 0, 1, 0,
2561 doc: /* Return scroll bar width of FRAME in pixels. */)
2562 (Lisp_Object frame)
2563 {
2564 return make_number (FRAME_SCROLL_BAR_AREA_WIDTH (decode_any_frame (frame)));
2565 }
2566
2567 DEFUN ("frame-fringe-width", Ffringe_width, Sfringe_width, 0, 1, 0,
2568 doc: /* Return fringe width of FRAME in pixels. */)
2569 (Lisp_Object frame)
2570 {
2571 return make_number (FRAME_TOTAL_FRINGE_WIDTH (decode_any_frame (frame)));
2572 }
2573
2574 DEFUN ("frame-border-width", Fborder_width, Sborder_width, 0, 1, 0,
2575 doc: /* Return border width of FRAME in pixels. */)
2576 (Lisp_Object frame)
2577 {
2578 return make_number (FRAME_INTERNAL_BORDER_WIDTH (decode_any_frame (frame)));
2579 }
2580
2581 DEFUN ("frame-right-divider-width", Fright_divider_width, Sright_divider_width, 0, 1, 0,
2582 doc: /* Return width (in pixels) of vertical window dividers on FRAME. */)
2583 (Lisp_Object frame)
2584 {
2585 return make_number (FRAME_RIGHT_DIVIDER_WIDTH (decode_any_frame (frame)));
2586 }
2587
2588 DEFUN ("frame-bottom-divider-width", Fbottom_divider_width, Sbottom_divider_width, 0, 1, 0,
2589 doc: /* Return width (in pixels) of horizontal window dividers on FRAME. */)
2590 (Lisp_Object frame)
2591 {
2592 return make_number (FRAME_BOTTOM_DIVIDER_WIDTH (decode_any_frame (frame)));
2593 }
2594 \f
2595 DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 4, 0,
2596 doc: /* Specify that the frame FRAME has HEIGHT text lines.
2597 Optional third arg PRETEND non-nil means that redisplay should use
2598 HEIGHT lines but that the idea of the actual height of the frame should
2599 not be changed. Optional fourth argument PIXELWISE non-nil means that
2600 FRAME should be HEIGHT pixels high. */)
2601 (Lisp_Object frame, Lisp_Object height, Lisp_Object pretend, Lisp_Object pixelwise)
2602 {
2603 register struct frame *f = decode_live_frame (frame);
2604
2605 CHECK_TYPE_RANGED_INTEGER (int, height);
2606
2607 /* I think this should be done with a hook. */
2608 #ifdef HAVE_WINDOW_SYSTEM
2609 if (FRAME_WINDOW_P (f))
2610 {
2611 if (NILP (pixelwise))
2612 {
2613 if (XINT (height) != FRAME_LINES (f))
2614 x_set_window_size (f, 1, FRAME_COLS (f), XINT (height), 0);
2615
2616 do_pending_window_change (0);
2617 }
2618 else if (XINT (height) != FRAME_TEXT_HEIGHT (f))
2619 {
2620 x_set_window_size (f, 1, FRAME_TEXT_WIDTH (f), XINT (height), 1);
2621 do_pending_window_change (0);
2622 }
2623 }
2624 else
2625 #endif
2626 change_frame_size (f, 0, XINT (height), !NILP (pretend), 0, 0,
2627 NILP (pixelwise) ? 0 : 1);
2628 return Qnil;
2629 }
2630
2631 DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 4, 0,
2632 doc: /* Specify that the frame FRAME has WIDTH columns.
2633 Optional third arg PRETEND non-nil means that redisplay should use WIDTH
2634 columns but that the idea of the actual width of the frame should not
2635 be changed. Optional fourth argument PIXELWISE non-nil means that FRAME
2636 should be WIDTH pixels wide. */)
2637 (Lisp_Object frame, Lisp_Object width, Lisp_Object pretend, Lisp_Object pixelwise)
2638 {
2639 register struct frame *f = decode_live_frame (frame);
2640
2641 CHECK_TYPE_RANGED_INTEGER (int, width);
2642
2643 /* I think this should be done with a hook. */
2644 #ifdef HAVE_WINDOW_SYSTEM
2645 if (FRAME_WINDOW_P (f))
2646 {
2647 if (NILP (pixelwise))
2648 {
2649 if (XINT (width) != FRAME_COLS (f))
2650 x_set_window_size (f, 1, XINT (width), FRAME_LINES (f), 0);
2651
2652 do_pending_window_change (0);
2653 }
2654 else if (XINT (width) != FRAME_TEXT_WIDTH (f))
2655 {
2656 x_set_window_size (f, 1, XINT (width), FRAME_TEXT_HEIGHT (f), 1);
2657 do_pending_window_change (0);
2658 }
2659 }
2660 else
2661 #endif
2662 change_frame_size (f, XINT (width), 0, !NILP (pretend), 0, 0,
2663 NILP (pixelwise) ? 0 : 1);
2664 return Qnil;
2665 }
2666
2667 DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 4, 0,
2668 doc: /* Sets size of FRAME to WIDTH by HEIGHT, measured in characters.
2669 Optional argument PIXELWISE non-nil means to measure in pixels. */)
2670 (Lisp_Object frame, Lisp_Object width, Lisp_Object height, Lisp_Object pixelwise)
2671 {
2672 register struct frame *f = decode_live_frame (frame);
2673
2674 CHECK_TYPE_RANGED_INTEGER (int, width);
2675 CHECK_TYPE_RANGED_INTEGER (int, height);
2676
2677 /* I think this should be done with a hook. */
2678 #ifdef HAVE_WINDOW_SYSTEM
2679 if (FRAME_WINDOW_P (f))
2680 {
2681 if (!NILP (pixelwise)
2682 ? (XINT (width) != FRAME_TEXT_WIDTH (f)
2683 || XINT (height) != FRAME_TEXT_HEIGHT (f)
2684 || f->new_height || f->new_width)
2685 : (XINT (width) != FRAME_COLS (f)
2686 || XINT (height) != FRAME_LINES (f)
2687 || f->new_height || f->new_width))
2688 {
2689 x_set_window_size (f, 1, XINT (width), XINT (height),
2690 NILP (pixelwise) ? 0 : 1);
2691 do_pending_window_change (0);
2692 }
2693 }
2694 else
2695 #endif
2696 change_frame_size (f, XINT (width), XINT (height), 0, 0, 0,
2697 NILP (pixelwise) ? 0 : 1);
2698
2699 return Qnil;
2700 }
2701
2702 DEFUN ("set-frame-position", Fset_frame_position,
2703 Sset_frame_position, 3, 3, 0,
2704 doc: /* Sets position of FRAME in pixels to XOFFSET by YOFFSET.
2705 If FRAME is nil, the selected frame is used. XOFFSET and YOFFSET are
2706 actually the position of the upper left corner of the frame. Negative
2707 values for XOFFSET or YOFFSET are interpreted relative to the rightmost
2708 or bottommost possible position (that stays within the screen). */)
2709 (Lisp_Object frame, Lisp_Object xoffset, Lisp_Object yoffset)
2710 {
2711 register struct frame *f = decode_live_frame (frame);
2712
2713 CHECK_TYPE_RANGED_INTEGER (int, xoffset);
2714 CHECK_TYPE_RANGED_INTEGER (int, yoffset);
2715
2716 /* I think this should be done with a hook. */
2717 #ifdef HAVE_WINDOW_SYSTEM
2718 if (FRAME_WINDOW_P (f))
2719 x_set_offset (f, XINT (xoffset), XINT (yoffset), 1);
2720 #endif
2721
2722 return Qt;
2723 }
2724
2725 \f
2726 /***********************************************************************
2727 Frame Parameters
2728 ***********************************************************************/
2729
2730 /* Connect the frame-parameter names for X frames
2731 to the ways of passing the parameter values to the window system.
2732
2733 The name of a parameter, as a Lisp symbol,
2734 has an `x-frame-parameter' property which is an integer in Lisp
2735 that is an index in this table. */
2736
2737 struct frame_parm_table {
2738 const char *name;
2739 Lisp_Object *variable;
2740 };
2741
2742 static const struct frame_parm_table frame_parms[] =
2743 {
2744 {"auto-raise", &Qauto_raise},
2745 {"auto-lower", &Qauto_lower},
2746 {"background-color", 0},
2747 {"border-color", &Qborder_color},
2748 {"border-width", &Qborder_width},
2749 {"cursor-color", &Qcursor_color},
2750 {"cursor-type", &Qcursor_type},
2751 {"font", 0},
2752 {"foreground-color", 0},
2753 {"icon-name", &Qicon_name},
2754 {"icon-type", &Qicon_type},
2755 {"internal-border-width", &Qinternal_border_width},
2756 {"right-divider-width", &Qright_divider_width},
2757 {"bottom-divider-width", &Qbottom_divider_width},
2758 {"menu-bar-lines", &Qmenu_bar_lines},
2759 {"mouse-color", &Qmouse_color},
2760 {"name", &Qname},
2761 {"scroll-bar-width", &Qscroll_bar_width},
2762 {"title", &Qtitle},
2763 {"unsplittable", &Qunsplittable},
2764 {"vertical-scroll-bars", &Qvertical_scroll_bars},
2765 {"visibility", &Qvisibility},
2766 {"tool-bar-lines", &Qtool_bar_lines},
2767 {"scroll-bar-foreground", &Qscroll_bar_foreground},
2768 {"scroll-bar-background", &Qscroll_bar_background},
2769 {"screen-gamma", &Qscreen_gamma},
2770 {"line-spacing", &Qline_spacing},
2771 {"left-fringe", &Qleft_fringe},
2772 {"right-fringe", &Qright_fringe},
2773 {"wait-for-wm", &Qwait_for_wm},
2774 {"fullscreen", &Qfullscreen},
2775 {"font-backend", &Qfont_backend},
2776 {"alpha", &Qalpha},
2777 {"sticky", &Qsticky},
2778 {"tool-bar-position", &Qtool_bar_position},
2779 };
2780
2781 #ifdef HAVE_NTGUI
2782
2783 /* Calculate fullscreen size. Return in *TOP_POS and *LEFT_POS the
2784 wanted positions of the WM window (not Emacs window).
2785 Return in *WIDTH and *HEIGHT the wanted width and height of Emacs
2786 window (FRAME_X_WINDOW).
2787 */
2788
2789 void
2790 x_fullscreen_adjust (struct frame *f, int *width, int *height, int *top_pos, int *left_pos)
2791 {
2792 int newwidth = FRAME_COLS (f);
2793 int newheight = FRAME_LINES (f);
2794 Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f);
2795
2796 *top_pos = f->top_pos;
2797 *left_pos = f->left_pos;
2798
2799 if (f->want_fullscreen & FULLSCREEN_HEIGHT)
2800 {
2801 int ph;
2802
2803 ph = x_display_pixel_height (dpyinfo);
2804 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2805 ph = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, newheight) - f->y_pixels_diff;
2806 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2807 *top_pos = 0;
2808 }
2809
2810 if (f->want_fullscreen & FULLSCREEN_WIDTH)
2811 {
2812 int pw;
2813
2814 pw = x_display_pixel_width (dpyinfo);
2815 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2816 pw = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, newwidth) - f->x_pixels_diff;
2817 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2818 *left_pos = 0;
2819 }
2820
2821 *width = newwidth;
2822 *height = newheight;
2823 }
2824
2825 #endif /* HAVE_NTGUI */
2826
2827 #ifdef HAVE_WINDOW_SYSTEM
2828
2829 /* Change the parameters of frame F as specified by ALIST.
2830 If a parameter is not specially recognized, do nothing special;
2831 otherwise call the `x_set_...' function for that parameter.
2832 Except for certain geometry properties, always call store_frame_param
2833 to store the new value in the parameter alist. */
2834
2835 void
2836 x_set_frame_parameters (struct frame *f, Lisp_Object alist)
2837 {
2838 Lisp_Object tail;
2839
2840 /* If both of these parameters are present, it's more efficient to
2841 set them both at once. So we wait until we've looked at the
2842 entire list before we set them. */
2843 int width = 0, height = 0;
2844 bool width_change = 0, height_change = 0;
2845
2846 /* Same here. */
2847 Lisp_Object left, top;
2848
2849 /* Same with these. */
2850 Lisp_Object icon_left, icon_top;
2851
2852 /* Record in these vectors all the parms specified. */
2853 Lisp_Object *parms;
2854 Lisp_Object *values;
2855 ptrdiff_t i, p;
2856 bool left_no_change = 0, top_no_change = 0;
2857 #ifdef HAVE_X_WINDOWS
2858 bool icon_left_no_change = 0, icon_top_no_change = 0;
2859 #endif
2860 struct gcpro gcpro1, gcpro2;
2861
2862 i = 0;
2863 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2864 i++;
2865
2866 parms = alloca (i * sizeof *parms);
2867 values = alloca (i * sizeof *values);
2868
2869 /* Extract parm names and values into those vectors. */
2870
2871 i = 0;
2872 for (tail = alist; CONSP (tail); tail = XCDR (tail))
2873 {
2874 Lisp_Object elt;
2875
2876 elt = XCAR (tail);
2877 parms[i] = Fcar (elt);
2878 values[i] = Fcdr (elt);
2879 i++;
2880 }
2881 /* TAIL and ALIST are not used again below here. */
2882 alist = tail = Qnil;
2883
2884 GCPRO2 (*parms, *values);
2885 gcpro1.nvars = i;
2886 gcpro2.nvars = i;
2887
2888 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
2889 because their values appear in VALUES and strings are not valid. */
2890 top = left = Qunbound;
2891 icon_left = icon_top = Qunbound;
2892
2893 /* Process foreground_color and background_color before anything else.
2894 They are independent of other properties, but other properties (e.g.,
2895 cursor_color) are dependent upon them. */
2896 /* Process default font as well, since fringe widths depends on it. */
2897 for (p = 0; p < i; p++)
2898 {
2899 Lisp_Object prop, val;
2900
2901 prop = parms[p];
2902 val = values[p];
2903 if (EQ (prop, Qforeground_color)
2904 || EQ (prop, Qbackground_color)
2905 || EQ (prop, Qfont))
2906 {
2907 register Lisp_Object param_index, old_value;
2908
2909 old_value = get_frame_param (f, prop);
2910 if (NILP (Fequal (val, old_value)))
2911 {
2912 store_frame_param (f, prop, val);
2913
2914 param_index = Fget (prop, Qx_frame_parameter);
2915 if (NATNUMP (param_index)
2916 && XFASTINT (param_index) < ARRAYELTS (frame_parms)
2917 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
2918 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2919 }
2920 }
2921 }
2922
2923 /* Now process them in reverse of specified order. */
2924 while (i-- != 0)
2925 {
2926 Lisp_Object prop, val;
2927
2928 prop = parms[i];
2929 val = values[i];
2930
2931 if (EQ (prop, Qwidth) && RANGED_INTEGERP (0, val, INT_MAX))
2932 {
2933 width_change = 1;
2934 width = XFASTINT (val) * FRAME_COLUMN_WIDTH (f) ;
2935 }
2936 else if (EQ (prop, Qheight) && RANGED_INTEGERP (0, val, INT_MAX))
2937 {
2938 height_change = 1;
2939 height = XFASTINT (val) * FRAME_LINE_HEIGHT (f);
2940 }
2941 else if (EQ (prop, Qtop))
2942 top = val;
2943 else if (EQ (prop, Qleft))
2944 left = val;
2945 else if (EQ (prop, Qicon_top))
2946 icon_top = val;
2947 else if (EQ (prop, Qicon_left))
2948 icon_left = val;
2949 else if (EQ (prop, Qforeground_color)
2950 || EQ (prop, Qbackground_color)
2951 || EQ (prop, Qfont))
2952 /* Processed above. */
2953 continue;
2954 else
2955 {
2956 register Lisp_Object param_index, old_value;
2957
2958 old_value = get_frame_param (f, prop);
2959
2960 store_frame_param (f, prop, val);
2961
2962 param_index = Fget (prop, Qx_frame_parameter);
2963 if (NATNUMP (param_index)
2964 && XFASTINT (param_index) < ARRAYELTS (frame_parms)
2965 && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
2966 (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2967 }
2968 }
2969
2970 /* Don't die if just one of these was set. */
2971 if (EQ (left, Qunbound))
2972 {
2973 left_no_change = 1;
2974 if (f->left_pos < 0)
2975 left = list2 (Qplus, make_number (f->left_pos));
2976 else
2977 XSETINT (left, f->left_pos);
2978 }
2979 if (EQ (top, Qunbound))
2980 {
2981 top_no_change = 1;
2982 if (f->top_pos < 0)
2983 top = list2 (Qplus, make_number (f->top_pos));
2984 else
2985 XSETINT (top, f->top_pos);
2986 }
2987
2988 /* If one of the icon positions was not set, preserve or default it. */
2989 if (! TYPE_RANGED_INTEGERP (int, icon_left))
2990 {
2991 #ifdef HAVE_X_WINDOWS
2992 icon_left_no_change = 1;
2993 #endif
2994 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
2995 if (NILP (icon_left))
2996 XSETINT (icon_left, 0);
2997 }
2998 if (! TYPE_RANGED_INTEGERP (int, icon_top))
2999 {
3000 #ifdef HAVE_X_WINDOWS
3001 icon_top_no_change = 1;
3002 #endif
3003 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
3004 if (NILP (icon_top))
3005 XSETINT (icon_top, 0);
3006 }
3007
3008 /* Don't set these parameters unless they've been explicitly
3009 specified. The window might be mapped or resized while we're in
3010 this function, and we don't want to override that unless the lisp
3011 code has asked for it.
3012
3013 Don't set these parameters unless they actually differ from the
3014 window's current parameters; the window may not actually exist
3015 yet. */
3016 {
3017 Lisp_Object frame;
3018
3019 /* Make this 1, eventually. */
3020 check_frame_size (f, &width, &height, 1);
3021
3022 XSETFRAME (frame, f);
3023
3024 if ((width_change || height_change)
3025 && (width != FRAME_TEXT_WIDTH (f)
3026 || height != FRAME_TEXT_HEIGHT (f)
3027 || f->new_height || f->new_width))
3028 {
3029 /* If necessary provide default values for HEIGHT and WIDTH. Do
3030 that here since otherwise a size change implied by an
3031 intermittent font change may get lost as in Bug#17142. */
3032 if (!width_change)
3033 width = (f->new_width
3034 ? (f->new_pixelwise
3035 ? f->new_width
3036 : (f->new_width * FRAME_COLUMN_WIDTH (f)))
3037 : FRAME_TEXT_WIDTH (f));
3038
3039 if (!height_change)
3040 height = (f->new_height
3041 ? (f->new_pixelwise
3042 ? f->new_height
3043 : (f->new_height * FRAME_LINE_HEIGHT (f)))
3044 : FRAME_TEXT_HEIGHT (f));
3045
3046 Fset_frame_size (frame, make_number (width), make_number (height), Qt);
3047 }
3048
3049 if ((!NILP (left) || !NILP (top))
3050 && ! (left_no_change && top_no_change)
3051 && ! (NUMBERP (left) && XINT (left) == f->left_pos
3052 && NUMBERP (top) && XINT (top) == f->top_pos))
3053 {
3054 int leftpos = 0;
3055 int toppos = 0;
3056
3057 /* Record the signs. */
3058 f->size_hint_flags &= ~ (XNegative | YNegative);
3059 if (EQ (left, Qminus))
3060 f->size_hint_flags |= XNegative;
3061 else if (TYPE_RANGED_INTEGERP (int, left))
3062 {
3063 leftpos = XINT (left);
3064 if (leftpos < 0)
3065 f->size_hint_flags |= XNegative;
3066 }
3067 else if (CONSP (left) && EQ (XCAR (left), Qminus)
3068 && CONSP (XCDR (left))
3069 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (left)), INT_MAX))
3070 {
3071 leftpos = - XINT (XCAR (XCDR (left)));
3072 f->size_hint_flags |= XNegative;
3073 }
3074 else if (CONSP (left) && EQ (XCAR (left), Qplus)
3075 && CONSP (XCDR (left))
3076 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (left))))
3077 {
3078 leftpos = XINT (XCAR (XCDR (left)));
3079 }
3080
3081 if (EQ (top, Qminus))
3082 f->size_hint_flags |= YNegative;
3083 else if (TYPE_RANGED_INTEGERP (int, top))
3084 {
3085 toppos = XINT (top);
3086 if (toppos < 0)
3087 f->size_hint_flags |= YNegative;
3088 }
3089 else if (CONSP (top) && EQ (XCAR (top), Qminus)
3090 && CONSP (XCDR (top))
3091 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (top)), INT_MAX))
3092 {
3093 toppos = - XINT (XCAR (XCDR (top)));
3094 f->size_hint_flags |= YNegative;
3095 }
3096 else if (CONSP (top) && EQ (XCAR (top), Qplus)
3097 && CONSP (XCDR (top))
3098 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (top))))
3099 {
3100 toppos = XINT (XCAR (XCDR (top)));
3101 }
3102
3103
3104 /* Store the numeric value of the position. */
3105 f->top_pos = toppos;
3106 f->left_pos = leftpos;
3107
3108 f->win_gravity = NorthWestGravity;
3109
3110 /* Actually set that position, and convert to absolute. */
3111 x_set_offset (f, leftpos, toppos, -1);
3112 }
3113 #ifdef HAVE_X_WINDOWS
3114 if ((!NILP (icon_left) || !NILP (icon_top))
3115 && ! (icon_left_no_change && icon_top_no_change))
3116 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
3117 #endif /* HAVE_X_WINDOWS */
3118 }
3119
3120 UNGCPRO;
3121 }
3122
3123
3124 /* Insert a description of internally-recorded parameters of frame X
3125 into the parameter alist *ALISTPTR that is to be given to the user.
3126 Only parameters that are specific to the X window system
3127 and whose values are not correctly recorded in the frame's
3128 param_alist need to be considered here. */
3129
3130 void
3131 x_report_frame_params (struct frame *f, Lisp_Object *alistptr)
3132 {
3133 Lisp_Object tem;
3134 uprintmax_t w;
3135 char buf[INT_BUFSIZE_BOUND (w)];
3136
3137 /* Represent negative positions (off the top or left screen edge)
3138 in a way that Fmodify_frame_parameters will understand correctly. */
3139 XSETINT (tem, f->left_pos);
3140 if (f->left_pos >= 0)
3141 store_in_alist (alistptr, Qleft, tem);
3142 else
3143 store_in_alist (alistptr, Qleft, list2 (Qplus, tem));
3144
3145 XSETINT (tem, f->top_pos);
3146 if (f->top_pos >= 0)
3147 store_in_alist (alistptr, Qtop, tem);
3148 else
3149 store_in_alist (alistptr, Qtop, list2 (Qplus, tem));
3150
3151 store_in_alist (alistptr, Qborder_width,
3152 make_number (f->border_width));
3153 store_in_alist (alistptr, Qinternal_border_width,
3154 make_number (FRAME_INTERNAL_BORDER_WIDTH (f)));
3155 store_in_alist (alistptr, Qright_divider_width,
3156 make_number (FRAME_RIGHT_DIVIDER_WIDTH (f)));
3157 store_in_alist (alistptr, Qbottom_divider_width,
3158 make_number (FRAME_BOTTOM_DIVIDER_WIDTH (f)));
3159 store_in_alist (alistptr, Qleft_fringe,
3160 make_number (FRAME_LEFT_FRINGE_WIDTH (f)));
3161 store_in_alist (alistptr, Qright_fringe,
3162 make_number (FRAME_RIGHT_FRINGE_WIDTH (f)));
3163 store_in_alist (alistptr, Qscroll_bar_width,
3164 (! FRAME_HAS_VERTICAL_SCROLL_BARS (f)
3165 ? make_number (0)
3166 : FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0
3167 ? make_number (FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3168 /* nil means "use default width"
3169 for non-toolkit scroll bar.
3170 ruler-mode.el depends on this. */
3171 : Qnil));
3172 /* FRAME_X_WINDOW is not guaranteed to return an integer. E.g., on
3173 MS-Windows it returns a value whose type is HANDLE, which is
3174 actually a pointer. Explicit casting avoids compiler
3175 warnings. */
3176 w = (uintptr_t) FRAME_X_WINDOW (f);
3177 store_in_alist (alistptr, Qwindow_id,
3178 make_formatted_string (buf, "%"pMu, w));
3179 #ifdef HAVE_X_WINDOWS
3180 #ifdef USE_X_TOOLKIT
3181 /* Tooltip frame may not have this widget. */
3182 if (FRAME_X_OUTPUT (f)->widget)
3183 #endif
3184 w = (uintptr_t) FRAME_OUTER_WINDOW (f);
3185 store_in_alist (alistptr, Qouter_window_id,
3186 make_formatted_string (buf, "%"pMu, w));
3187 #endif
3188 store_in_alist (alistptr, Qicon_name, f->icon_name);
3189 store_in_alist (alistptr, Qvisibility,
3190 (FRAME_VISIBLE_P (f) ? Qt
3191 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
3192 store_in_alist (alistptr, Qdisplay,
3193 XCAR (FRAME_DISPLAY_INFO (f)->name_list_element));
3194
3195 if (FRAME_X_OUTPUT (f)->parent_desc == FRAME_DISPLAY_INFO (f)->root_window)
3196 tem = Qnil;
3197 else
3198 tem = make_natnum ((uintptr_t) FRAME_X_OUTPUT (f)->parent_desc);
3199 store_in_alist (alistptr, Qexplicit_name, (f->explicit_name ? Qt : Qnil));
3200 store_in_alist (alistptr, Qparent_id, tem);
3201 store_in_alist (alistptr, Qtool_bar_position, f->tool_bar_position);
3202 }
3203
3204
3205 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
3206 the previous value of that parameter, NEW_VALUE is the new value. */
3207
3208 void
3209 x_set_fullscreen (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3210 {
3211 if (NILP (new_value))
3212 f->want_fullscreen = FULLSCREEN_NONE;
3213 else if (EQ (new_value, Qfullboth) || EQ (new_value, Qfullscreen))
3214 f->want_fullscreen = FULLSCREEN_BOTH;
3215 else if (EQ (new_value, Qfullwidth))
3216 f->want_fullscreen = FULLSCREEN_WIDTH;
3217 else if (EQ (new_value, Qfullheight))
3218 f->want_fullscreen = FULLSCREEN_HEIGHT;
3219 else if (EQ (new_value, Qmaximized))
3220 f->want_fullscreen = FULLSCREEN_MAXIMIZED;
3221
3222 if (FRAME_TERMINAL (f)->fullscreen_hook != NULL)
3223 FRAME_TERMINAL (f)->fullscreen_hook (f);
3224 }
3225
3226
3227 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
3228 the previous value of that parameter, NEW_VALUE is the new value. */
3229
3230 void
3231 x_set_line_spacing (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3232 {
3233 if (NILP (new_value))
3234 f->extra_line_spacing = 0;
3235 else if (RANGED_INTEGERP (0, new_value, INT_MAX))
3236 f->extra_line_spacing = XFASTINT (new_value);
3237 else if (FLOATP (new_value))
3238 {
3239 int new_spacing = XFLOAT_DATA (new_value) * FRAME_LINE_HEIGHT (f) + 0.5;
3240
3241 if (new_spacing >= 0)
3242 f->extra_line_spacing = new_spacing;
3243 else
3244 signal_error ("Invalid line-spacing", new_value);
3245 }
3246 else
3247 signal_error ("Invalid line-spacing", new_value);
3248 if (FRAME_VISIBLE_P (f))
3249 redraw_frame (f);
3250 }
3251
3252
3253 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
3254 the previous value of that parameter, NEW_VALUE is the new value. */
3255
3256 void
3257 x_set_screen_gamma (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3258 {
3259 Lisp_Object bgcolor;
3260
3261 if (NILP (new_value))
3262 f->gamma = 0;
3263 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
3264 /* The value 0.4545 is the normal viewing gamma. */
3265 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
3266 else
3267 signal_error ("Invalid screen-gamma", new_value);
3268
3269 /* Apply the new gamma value to the frame background. */
3270 bgcolor = Fassq (Qbackground_color, f->param_alist);
3271 if (CONSP (bgcolor) && (bgcolor = XCDR (bgcolor), STRINGP (bgcolor)))
3272 {
3273 Lisp_Object parm_index = Fget (Qbackground_color, Qx_frame_parameter);
3274 if (NATNUMP (parm_index)
3275 && XFASTINT (parm_index) < ARRAYELTS (frame_parms)
3276 && FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
3277 (*FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
3278 (f, bgcolor, Qnil);
3279 }
3280
3281 Fclear_face_cache (Qnil);
3282 }
3283
3284
3285 void
3286 x_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3287 {
3288 Lisp_Object font_object;
3289 int fontset = -1;
3290 #ifdef HAVE_X_WINDOWS
3291 Lisp_Object font_param = arg;
3292 #endif
3293
3294 /* Set the frame parameter back to the old value because we may
3295 fail to use ARG as the new parameter value. */
3296 store_frame_param (f, Qfont, oldval);
3297
3298 /* ARG is a fontset name, a font name, a cons of fontset name and a
3299 font object, or a font object. In the last case, this function
3300 never fail. */
3301 if (STRINGP (arg))
3302 {
3303 fontset = fs_query_fontset (arg, 0);
3304 if (fontset < 0)
3305 {
3306 font_object = font_open_by_name (f, arg);
3307 if (NILP (font_object))
3308 error ("Font `%s' is not defined", SSDATA (arg));
3309 arg = AREF (font_object, FONT_NAME_INDEX);
3310 }
3311 else if (fontset > 0)
3312 {
3313 font_object = font_open_by_name (f, fontset_ascii (fontset));
3314 if (NILP (font_object))
3315 error ("Font `%s' is not defined", SDATA (arg));
3316 arg = AREF (font_object, FONT_NAME_INDEX);
3317 }
3318 else
3319 error ("The default fontset can't be used for a frame font");
3320 }
3321 else if (CONSP (arg) && STRINGP (XCAR (arg)) && FONT_OBJECT_P (XCDR (arg)))
3322 {
3323 /* This is the case that the ASCII font of F's fontset XCAR
3324 (arg) is changed to the font XCDR (arg) by
3325 `set-fontset-font'. */
3326 fontset = fs_query_fontset (XCAR (arg), 0);
3327 if (fontset < 0)
3328 error ("Unknown fontset: %s", SDATA (XCAR (arg)));
3329 font_object = XCDR (arg);
3330 arg = AREF (font_object, FONT_NAME_INDEX);
3331 #ifdef HAVE_X_WINDOWS
3332 font_param = Ffont_get (font_object, QCname);
3333 #endif
3334 }
3335 else if (FONT_OBJECT_P (arg))
3336 {
3337 font_object = arg;
3338 #ifdef HAVE_X_WINDOWS
3339 font_param = Ffont_get (font_object, QCname);
3340 #endif
3341 /* This is to store the XLFD font name in the frame parameter for
3342 backward compatibility. We should store the font-object
3343 itself in the future. */
3344 arg = AREF (font_object, FONT_NAME_INDEX);
3345 fontset = FRAME_FONTSET (f);
3346 /* Check if we can use the current fontset. If not, set FONTSET
3347 to -1 to generate a new fontset from FONT-OBJECT. */
3348 if (fontset >= 0)
3349 {
3350 Lisp_Object ascii_font = fontset_ascii (fontset);
3351 Lisp_Object spec = font_spec_from_name (ascii_font);
3352
3353 if (NILP (spec))
3354 signal_error ("Invalid font name", ascii_font);
3355
3356 if (! font_match_p (spec, font_object))
3357 fontset = -1;
3358 }
3359 }
3360 else
3361 signal_error ("Invalid font", arg);
3362
3363 if (! NILP (Fequal (font_object, oldval)))
3364 return;
3365
3366 x_new_font (f, font_object, fontset);
3367 store_frame_param (f, Qfont, arg);
3368 #ifdef HAVE_X_WINDOWS
3369 store_frame_param (f, Qfont_param, font_param);
3370 #endif
3371 /* Recalculate toolbar height. */
3372 f->n_tool_bar_rows = 0;
3373
3374 /* Ensure we redraw it. */
3375 clear_current_matrices (f);
3376
3377 /* Attempt to hunt down bug#16028. */
3378 SET_FRAME_GARBAGED (f);
3379
3380 recompute_basic_faces (f);
3381
3382 do_pending_window_change (0);
3383
3384 /* We used to call face-set-after-frame-default here, but it leads to
3385 recursive calls (since that function can set the `default' face's
3386 font which in turns changes the frame's `font' parameter).
3387 Also I don't know what this call is meant to do, but it seems the
3388 wrong way to do it anyway (it does a lot more work than what seems
3389 reasonable in response to a change to `font'). */
3390 }
3391
3392
3393 void
3394 x_set_font_backend (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3395 {
3396 if (! NILP (new_value)
3397 && !CONSP (new_value))
3398 {
3399 char *p0, *p1;
3400
3401 CHECK_STRING (new_value);
3402 p0 = p1 = SSDATA (new_value);
3403 new_value = Qnil;
3404 while (*p0)
3405 {
3406 while (*p1 && ! c_isspace (*p1) && *p1 != ',') p1++;
3407 if (p0 < p1)
3408 new_value = Fcons (Fintern (make_string (p0, p1 - p0), Qnil),
3409 new_value);
3410 if (*p1)
3411 {
3412 int c;
3413
3414 while ((c = *++p1) && c_isspace (c));
3415 }
3416 p0 = p1;
3417 }
3418 new_value = Fnreverse (new_value);
3419 }
3420
3421 if (! NILP (old_value) && ! NILP (Fequal (old_value, new_value)))
3422 return;
3423
3424 if (FRAME_FONT (f))
3425 free_all_realized_faces (Qnil);
3426
3427 new_value = font_update_drivers (f, NILP (new_value) ? Qt : new_value);
3428 if (NILP (new_value))
3429 {
3430 if (NILP (old_value))
3431 error ("No font backend available");
3432 font_update_drivers (f, old_value);
3433 error ("None of specified font backends are available");
3434 }
3435 store_frame_param (f, Qfont_backend, new_value);
3436
3437 if (FRAME_FONT (f))
3438 {
3439 Lisp_Object frame;
3440
3441 XSETFRAME (frame, f);
3442 x_set_font (f, Fframe_parameter (frame, Qfont), Qnil);
3443 ++face_change_count;
3444 windows_or_buffers_changed = 18;
3445 }
3446 }
3447
3448
3449 void
3450 x_set_fringe_width (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
3451 {
3452 compute_fringe_widths (f, 1);
3453 #ifdef HAVE_X_WINDOWS
3454 /* Must adjust this so window managers report correct number of columns. */
3455 if (FRAME_X_WINDOW (f) != 0)
3456 x_wm_set_size_hint (f, 0, 0);
3457 #endif
3458 }
3459
3460 void
3461 x_set_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3462 {
3463 CHECK_TYPE_RANGED_INTEGER (int, arg);
3464
3465 if (XINT (arg) == f->border_width)
3466 return;
3467
3468 if (FRAME_X_WINDOW (f) != 0)
3469 error ("Cannot change the border width of a frame");
3470
3471 f->border_width = XINT (arg);
3472 }
3473
3474 void
3475 x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3476 {
3477 int old = FRAME_INTERNAL_BORDER_WIDTH (f);
3478
3479 CHECK_TYPE_RANGED_INTEGER (int, arg);
3480 FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
3481 if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
3482 FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
3483
3484 #ifdef USE_X_TOOLKIT
3485 if (FRAME_X_OUTPUT (f)->edit_widget)
3486 widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
3487 #endif
3488
3489 if (FRAME_INTERNAL_BORDER_WIDTH (f) == old)
3490 return;
3491
3492 if (FRAME_X_WINDOW (f) != 0)
3493 {
3494 x_set_window_size (f, 0, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 1);
3495 SET_FRAME_GARBAGED (f);
3496 do_pending_window_change (0);
3497 }
3498 else
3499 SET_FRAME_GARBAGED (f);
3500 }
3501
3502 void
3503 x_set_right_divider_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3504 {
3505 int old = FRAME_RIGHT_DIVIDER_WIDTH (f);
3506
3507 CHECK_TYPE_RANGED_INTEGER (int, arg);
3508 FRAME_RIGHT_DIVIDER_WIDTH (f) = XINT (arg);
3509 if (FRAME_RIGHT_DIVIDER_WIDTH (f) < 0)
3510 FRAME_RIGHT_DIVIDER_WIDTH (f) = 0;
3511
3512 if (FRAME_RIGHT_DIVIDER_WIDTH (f) == old)
3513 return;
3514
3515 if (FRAME_X_WINDOW (f) != 0)
3516 {
3517 x_set_window_size (f, 0, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 1);
3518 SET_FRAME_GARBAGED (f);
3519 do_pending_window_change (0);
3520 }
3521 else
3522 SET_FRAME_GARBAGED (f);
3523 }
3524
3525 void
3526 x_set_bottom_divider_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3527 {
3528 int old = FRAME_BOTTOM_DIVIDER_WIDTH (f);
3529
3530 CHECK_TYPE_RANGED_INTEGER (int, arg);
3531 FRAME_BOTTOM_DIVIDER_WIDTH (f) = XINT (arg);
3532 if (FRAME_BOTTOM_DIVIDER_WIDTH (f) < 0)
3533 FRAME_BOTTOM_DIVIDER_WIDTH (f) = 0;
3534
3535 if (FRAME_BOTTOM_DIVIDER_WIDTH (f) == old)
3536 return;
3537
3538 if (FRAME_X_WINDOW (f) != 0)
3539 {
3540 x_set_window_size (f, 0, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 1);
3541 SET_FRAME_GARBAGED (f);
3542 do_pending_window_change (0);
3543 }
3544 else
3545 SET_FRAME_GARBAGED (f);
3546 }
3547
3548 void
3549 x_set_visibility (struct frame *f, Lisp_Object value, Lisp_Object oldval)
3550 {
3551 Lisp_Object frame;
3552 XSETFRAME (frame, f);
3553
3554 if (NILP (value))
3555 Fmake_frame_invisible (frame, Qt);
3556 else if (EQ (value, Qicon))
3557 Ficonify_frame (frame);
3558 else
3559 Fmake_frame_visible (frame);
3560 }
3561
3562 void
3563 x_set_autoraise (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3564 {
3565 f->auto_raise = !EQ (Qnil, arg);
3566 }
3567
3568 void
3569 x_set_autolower (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3570 {
3571 f->auto_lower = !EQ (Qnil, arg);
3572 }
3573
3574 void
3575 x_set_unsplittable (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3576 {
3577 f->no_split = !NILP (arg);
3578 }
3579
3580 void
3581 x_set_vertical_scroll_bars (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3582 {
3583 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
3584 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
3585 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
3586 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
3587 {
3588 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
3589 = (NILP (arg)
3590 ? vertical_scroll_bar_none
3591 : EQ (Qleft, arg)
3592 ? vertical_scroll_bar_left
3593 : EQ (Qright, arg)
3594 ? vertical_scroll_bar_right
3595 : EQ (Qleft, Vdefault_frame_scroll_bars)
3596 ? vertical_scroll_bar_left
3597 : EQ (Qright, Vdefault_frame_scroll_bars)
3598 ? vertical_scroll_bar_right
3599 : vertical_scroll_bar_none);
3600
3601 /* We set this parameter before creating the X window for the
3602 frame, so we can get the geometry right from the start.
3603 However, if the window hasn't been created yet, we shouldn't
3604 call x_set_window_size. */
3605 if (FRAME_X_WINDOW (f))
3606 x_set_window_size (f, 0, FRAME_TEXT_WIDTH (f),
3607 FRAME_TEXT_HEIGHT (f), 1);
3608 do_pending_window_change (0);
3609 }
3610 }
3611
3612 void
3613 x_set_scroll_bar_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3614 {
3615 int unit = FRAME_COLUMN_WIDTH (f);
3616
3617 if (NILP (arg))
3618 {
3619 x_set_scroll_bar_default_width (f);
3620
3621 if (FRAME_X_WINDOW (f))
3622 x_set_window_size (f, 0, FRAME_TEXT_WIDTH (f),
3623 FRAME_TEXT_HEIGHT (f), 1);
3624 do_pending_window_change (0);
3625 }
3626 else if (RANGED_INTEGERP (1, arg, INT_MAX)
3627 && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3628 {
3629 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg);
3630 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + unit - 1) / unit;
3631 if (FRAME_X_WINDOW (f))
3632 x_set_window_size (f, 0, FRAME_TEXT_WIDTH (f),
3633 FRAME_TEXT_HEIGHT (f), 1);
3634 do_pending_window_change (0);
3635 }
3636
3637 /* Eventually remove the following call. It should have been done by
3638 x_set_window_size already. */
3639 change_frame_size (f, 0, 0, 0, 0, 0, 1);
3640 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
3641 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
3642 }
3643
3644 void
3645 x_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3646 {
3647 double alpha = 1.0;
3648 double newval[2];
3649 int i;
3650 Lisp_Object item;
3651
3652 for (i = 0; i < 2; i++)
3653 {
3654 newval[i] = 1.0;
3655 if (CONSP (arg))
3656 {
3657 item = CAR (arg);
3658 arg = CDR (arg);
3659 }
3660 else
3661 item = arg;
3662
3663 if (NILP (item))
3664 alpha = - 1.0;
3665 else if (FLOATP (item))
3666 {
3667 alpha = XFLOAT_DATA (item);
3668 if (! (0 <= alpha && alpha <= 1.0))
3669 args_out_of_range (make_float (0.0), make_float (1.0));
3670 }
3671 else if (INTEGERP (item))
3672 {
3673 EMACS_INT ialpha = XINT (item);
3674 if (! (0 <= ialpha && alpha <= 100))
3675 args_out_of_range (make_number (0), make_number (100));
3676 alpha = ialpha / 100.0;
3677 }
3678 else
3679 wrong_type_argument (Qnumberp, item);
3680 newval[i] = alpha;
3681 }
3682
3683 for (i = 0; i < 2; i++)
3684 f->alpha[i] = newval[i];
3685
3686 #if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA)
3687 block_input ();
3688 x_set_frame_alpha (f);
3689 unblock_input ();
3690 #endif
3691
3692 return;
3693 }
3694
3695 #ifndef HAVE_NS
3696
3697 /* Non-zero if mouse is grabbed on DPYINFO
3698 and we know the frame where it is. */
3699
3700 bool x_mouse_grabbed (Display_Info *dpyinfo)
3701 {
3702 return (dpyinfo->grabbed
3703 && dpyinfo->last_mouse_frame
3704 && FRAME_LIVE_P (dpyinfo->last_mouse_frame));
3705 }
3706
3707 /* Re-highlight something with mouse-face properties
3708 on DPYINFO using saved frame and mouse position. */
3709
3710 void
3711 x_redo_mouse_highlight (Display_Info *dpyinfo)
3712 {
3713 if (dpyinfo->last_mouse_motion_frame
3714 && FRAME_LIVE_P (dpyinfo->last_mouse_motion_frame))
3715 note_mouse_highlight (dpyinfo->last_mouse_motion_frame,
3716 dpyinfo->last_mouse_motion_x,
3717 dpyinfo->last_mouse_motion_y);
3718 }
3719
3720 #endif /* HAVE_NS */
3721
3722 /* Subroutines of creating an X frame. */
3723
3724 /* Make sure that Vx_resource_name is set to a reasonable value.
3725 Fix it up, or set it to `emacs' if it is too hopeless. */
3726
3727 void
3728 validate_x_resource_name (void)
3729 {
3730 ptrdiff_t len = 0;
3731 /* Number of valid characters in the resource name. */
3732 ptrdiff_t good_count = 0;
3733 /* Number of invalid characters in the resource name. */
3734 ptrdiff_t bad_count = 0;
3735 Lisp_Object new;
3736 ptrdiff_t i;
3737
3738 if (!STRINGP (Vx_resource_class))
3739 Vx_resource_class = build_string (EMACS_CLASS);
3740
3741 if (STRINGP (Vx_resource_name))
3742 {
3743 unsigned char *p = SDATA (Vx_resource_name);
3744
3745 len = SBYTES (Vx_resource_name);
3746
3747 /* Only letters, digits, - and _ are valid in resource names.
3748 Count the valid characters and count the invalid ones. */
3749 for (i = 0; i < len; i++)
3750 {
3751 int c = p[i];
3752 if (! ((c >= 'a' && c <= 'z')
3753 || (c >= 'A' && c <= 'Z')
3754 || (c >= '0' && c <= '9')
3755 || c == '-' || c == '_'))
3756 bad_count++;
3757 else
3758 good_count++;
3759 }
3760 }
3761 else
3762 /* Not a string => completely invalid. */
3763 bad_count = 5, good_count = 0;
3764
3765 /* If name is valid already, return. */
3766 if (bad_count == 0)
3767 return;
3768
3769 /* If name is entirely invalid, or nearly so, or is so implausibly
3770 large that alloca might not work, use `emacs'. */
3771 if (good_count < 2 || MAX_ALLOCA - sizeof ".customization" < len)
3772 {
3773 Vx_resource_name = build_string ("emacs");
3774 return;
3775 }
3776
3777 /* Name is partly valid. Copy it and replace the invalid characters
3778 with underscores. */
3779
3780 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
3781
3782 for (i = 0; i < len; i++)
3783 {
3784 int c = SREF (new, i);
3785 if (! ((c >= 'a' && c <= 'z')
3786 || (c >= 'A' && c <= 'Z')
3787 || (c >= '0' && c <= '9')
3788 || c == '-' || c == '_'))
3789 SSET (new, i, '_');
3790 }
3791 }
3792
3793 /* Get specified attribute from resource database RDB.
3794 See Fx_get_resource below for other parameters. */
3795
3796 static Lisp_Object
3797 xrdb_get_resource (XrmDatabase rdb, Lisp_Object attribute, Lisp_Object class, Lisp_Object component, Lisp_Object subclass)
3798 {
3799 register char *value;
3800 char *name_key;
3801 char *class_key;
3802
3803 CHECK_STRING (attribute);
3804 CHECK_STRING (class);
3805
3806 if (!NILP (component))
3807 CHECK_STRING (component);
3808 if (!NILP (subclass))
3809 CHECK_STRING (subclass);
3810 if (NILP (component) != NILP (subclass))
3811 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3812
3813 validate_x_resource_name ();
3814
3815 /* Allocate space for the components, the dots which separate them,
3816 and the final '\0'. Make them big enough for the worst case. */
3817 name_key = alloca (SBYTES (Vx_resource_name)
3818 + (STRINGP (component)
3819 ? SBYTES (component) : 0)
3820 + SBYTES (attribute)
3821 + 3);
3822
3823 class_key = alloca (SBYTES (Vx_resource_class)
3824 + SBYTES (class)
3825 + (STRINGP (subclass)
3826 ? SBYTES (subclass) : 0)
3827 + 3);
3828
3829 /* Start with emacs.FRAMENAME for the name (the specific one)
3830 and with `Emacs' for the class key (the general one). */
3831 strcpy (name_key, SSDATA (Vx_resource_name));
3832 strcpy (class_key, SSDATA (Vx_resource_class));
3833
3834 strcat (class_key, ".");
3835 strcat (class_key, SSDATA (class));
3836
3837 if (!NILP (component))
3838 {
3839 strcat (class_key, ".");
3840 strcat (class_key, SSDATA (subclass));
3841
3842 strcat (name_key, ".");
3843 strcat (name_key, SSDATA (component));
3844 }
3845
3846 strcat (name_key, ".");
3847 strcat (name_key, SSDATA (attribute));
3848
3849 value = x_get_string_resource (rdb, name_key, class_key);
3850
3851 if (value && *value)
3852 return build_string (value);
3853 else
3854 return Qnil;
3855 }
3856
3857
3858 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
3859 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
3860 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
3861 class, where INSTANCE is the name under which Emacs was invoked, or
3862 the name specified by the `-name' or `-rn' command-line arguments.
3863
3864 The optional arguments COMPONENT and SUBCLASS add to the key and the
3865 class, respectively. You must specify both of them or neither.
3866 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
3867 and the class is `Emacs.CLASS.SUBCLASS'. */)
3868 (Lisp_Object attribute, Lisp_Object class, Lisp_Object component,
3869 Lisp_Object subclass)
3870 {
3871 check_window_system (NULL);
3872
3873 return xrdb_get_resource (check_x_display_info (Qnil)->xrdb,
3874 attribute, class, component, subclass);
3875 }
3876
3877 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
3878
3879 Lisp_Object
3880 display_x_get_resource (Display_Info *dpyinfo, Lisp_Object attribute,
3881 Lisp_Object class, Lisp_Object component,
3882 Lisp_Object subclass)
3883 {
3884 return xrdb_get_resource (dpyinfo->xrdb,
3885 attribute, class, component, subclass);
3886 }
3887
3888 #if defined HAVE_X_WINDOWS && !defined USE_X_TOOLKIT
3889 /* Used when C code wants a resource value. */
3890 /* Called from oldXMenu/Create.c. */
3891 char *
3892 x_get_resource_string (const char *attribute, const char *class)
3893 {
3894 char *result;
3895 struct frame *sf = SELECTED_FRAME ();
3896 ptrdiff_t invocation_namelen = SBYTES (Vinvocation_name);
3897 USE_SAFE_ALLOCA;
3898
3899 /* Allocate space for the components, the dots which separate them,
3900 and the final '\0'. */
3901 char *name_key = SAFE_ALLOCA (invocation_namelen + strlen (attribute) + 2);
3902 char *class_key = alloca ((sizeof (EMACS_CLASS) - 1) + strlen (class) + 2);
3903
3904 esprintf (name_key, "%s.%s", SSDATA (Vinvocation_name), attribute);
3905 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3906
3907 result = x_get_string_resource (FRAME_DISPLAY_INFO (sf)->xrdb,
3908 name_key, class_key);
3909 SAFE_FREE ();
3910 return result;
3911 }
3912 #endif
3913
3914 /* Return the value of parameter PARAM.
3915
3916 First search ALIST, then Vdefault_frame_alist, then the X defaults
3917 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3918
3919 Convert the resource to the type specified by desired_type.
3920
3921 If no default is specified, return Qunbound. If you call
3922 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3923 and don't let it get stored in any Lisp-visible variables! */
3924
3925 Lisp_Object
3926 x_get_arg (Display_Info *dpyinfo, Lisp_Object alist, Lisp_Object param,
3927 const char *attribute, const char *class, enum resource_types type)
3928 {
3929 register Lisp_Object tem;
3930
3931 tem = Fassq (param, alist);
3932
3933 if (!NILP (tem))
3934 {
3935 /* If we find this parm in ALIST, clear it out
3936 so that it won't be "left over" at the end. */
3937 Lisp_Object tail;
3938 XSETCAR (tem, Qnil);
3939 /* In case the parameter appears more than once in the alist,
3940 clear it out. */
3941 for (tail = alist; CONSP (tail); tail = XCDR (tail))
3942 if (CONSP (XCAR (tail))
3943 && EQ (XCAR (XCAR (tail)), param))
3944 XSETCAR (XCAR (tail), Qnil);
3945 }
3946 else
3947 tem = Fassq (param, Vdefault_frame_alist);
3948
3949 /* If it wasn't specified in ALIST or the Lisp-level defaults,
3950 look in the X resources. */
3951 if (EQ (tem, Qnil))
3952 {
3953 if (attribute && dpyinfo)
3954 {
3955 tem = display_x_get_resource (dpyinfo,
3956 build_string (attribute),
3957 build_string (class),
3958 Qnil, Qnil);
3959
3960 if (NILP (tem))
3961 return Qunbound;
3962
3963 switch (type)
3964 {
3965 case RES_TYPE_NUMBER:
3966 return make_number (atoi (SSDATA (tem)));
3967
3968 case RES_TYPE_BOOLEAN_NUMBER:
3969 if (!strcmp (SSDATA (tem), "on")
3970 || !strcmp (SSDATA (tem), "true"))
3971 return make_number (1);
3972 return make_number (atoi (SSDATA (tem)));
3973 break;
3974
3975 case RES_TYPE_FLOAT:
3976 return make_float (atof (SSDATA (tem)));
3977
3978 case RES_TYPE_BOOLEAN:
3979 tem = Fdowncase (tem);
3980 if (!strcmp (SSDATA (tem), "on")
3981 #ifdef HAVE_NS
3982 || !strcmp (SSDATA (tem), "yes")
3983 #endif
3984 || !strcmp (SSDATA (tem), "true"))
3985 return Qt;
3986 else
3987 return Qnil;
3988
3989 case RES_TYPE_STRING:
3990 return tem;
3991
3992 case RES_TYPE_SYMBOL:
3993 /* As a special case, we map the values `true' and `on'
3994 to Qt, and `false' and `off' to Qnil. */
3995 {
3996 Lisp_Object lower;
3997 lower = Fdowncase (tem);
3998 if (!strcmp (SSDATA (lower), "on")
3999 #ifdef HAVE_NS
4000 || !strcmp (SSDATA (lower), "yes")
4001 #endif
4002 || !strcmp (SSDATA (lower), "true"))
4003 return Qt;
4004 else if (!strcmp (SSDATA (lower), "off")
4005 #ifdef HAVE_NS
4006 || !strcmp (SSDATA (lower), "no")
4007 #endif
4008 || !strcmp (SSDATA (lower), "false"))
4009 return Qnil;
4010 else
4011 return Fintern (tem, Qnil);
4012 }
4013
4014 default:
4015 emacs_abort ();
4016 }
4017 }
4018 else
4019 return Qunbound;
4020 }
4021 return Fcdr (tem);
4022 }
4023
4024 static Lisp_Object
4025 x_frame_get_arg (struct frame *f, Lisp_Object alist, Lisp_Object param,
4026 const char *attribute, const char *class,
4027 enum resource_types type)
4028 {
4029 return x_get_arg (FRAME_DISPLAY_INFO (f),
4030 alist, param, attribute, class, type);
4031 }
4032
4033 /* Like x_frame_get_arg, but also record the value in f->param_alist. */
4034
4035 Lisp_Object
4036 x_frame_get_and_record_arg (struct frame *f, Lisp_Object alist,
4037 Lisp_Object param,
4038 const char *attribute, const char *class,
4039 enum resource_types type)
4040 {
4041 Lisp_Object value;
4042
4043 value = x_get_arg (FRAME_DISPLAY_INFO (f), alist, param,
4044 attribute, class, type);
4045 if (! NILP (value) && ! EQ (value, Qunbound))
4046 store_frame_param (f, param, value);
4047
4048 return value;
4049 }
4050
4051
4052 /* Record in frame F the specified or default value according to ALIST
4053 of the parameter named PROP (a Lisp symbol).
4054 If no value is specified for PROP, look for an X default for XPROP
4055 on the frame named NAME.
4056 If that is not found either, use the value DEFLT. */
4057
4058 Lisp_Object
4059 x_default_parameter (struct frame *f, Lisp_Object alist, Lisp_Object prop,
4060 Lisp_Object deflt, const char *xprop, const char *xclass,
4061 enum resource_types type)
4062 {
4063 Lisp_Object tem;
4064
4065 tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type);
4066 if (EQ (tem, Qunbound))
4067 tem = deflt;
4068 x_set_frame_parameters (f, list1 (Fcons (prop, tem)));
4069 return tem;
4070 }
4071
4072
4073 #if !defined (HAVE_X_WINDOWS) && defined (NoValue)
4074
4075 /*
4076 * XParseGeometry parses strings of the form
4077 * "=<width>x<height>{+-}<xoffset>{+-}<yoffset>", where
4078 * width, height, xoffset, and yoffset are unsigned integers.
4079 * Example: "=80x24+300-49"
4080 * The equal sign is optional.
4081 * It returns a bitmask that indicates which of the four values
4082 * were actually found in the string. For each value found,
4083 * the corresponding argument is updated; for each value
4084 * not found, the corresponding argument is left unchanged.
4085 */
4086
4087 static int
4088 XParseGeometry (char *string,
4089 int *x, int *y,
4090 unsigned int *width, unsigned int *height)
4091 {
4092 int mask = NoValue;
4093 char *strind;
4094 unsigned long tempWidth, tempHeight;
4095 long int tempX, tempY;
4096 char *nextCharacter;
4097
4098 if (string == NULL || *string == '\0')
4099 return mask;
4100 if (*string == '=')
4101 string++; /* ignore possible '=' at beg of geometry spec */
4102
4103 strind = string;
4104 if (*strind != '+' && *strind != '-' && *strind != 'x')
4105 {
4106 tempWidth = strtoul (strind, &nextCharacter, 10);
4107 if (strind == nextCharacter)
4108 return 0;
4109 strind = nextCharacter;
4110 mask |= WidthValue;
4111 }
4112
4113 if (*strind == 'x' || *strind == 'X')
4114 {
4115 strind++;
4116 tempHeight = strtoul (strind, &nextCharacter, 10);
4117 if (strind == nextCharacter)
4118 return 0;
4119 strind = nextCharacter;
4120 mask |= HeightValue;
4121 }
4122
4123 if (*strind == '+' || *strind == '-')
4124 {
4125 if (*strind == '-')
4126 mask |= XNegative;
4127 tempX = strtol (strind, &nextCharacter, 10);
4128 if (strind == nextCharacter)
4129 return 0;
4130 strind = nextCharacter;
4131 mask |= XValue;
4132 if (*strind == '+' || *strind == '-')
4133 {
4134 if (*strind == '-')
4135 mask |= YNegative;
4136 tempY = strtol (strind, &nextCharacter, 10);
4137 if (strind == nextCharacter)
4138 return 0;
4139 strind = nextCharacter;
4140 mask |= YValue;
4141 }
4142 }
4143
4144 /* If strind isn't at the end of the string then it's an invalid
4145 geometry specification. */
4146
4147 if (*strind != '\0')
4148 return 0;
4149
4150 if (mask & XValue)
4151 *x = clip_to_bounds (INT_MIN, tempX, INT_MAX);
4152 if (mask & YValue)
4153 *y = clip_to_bounds (INT_MIN, tempY, INT_MAX);
4154 if (mask & WidthValue)
4155 *width = min (tempWidth, UINT_MAX);
4156 if (mask & HeightValue)
4157 *height = min (tempHeight, UINT_MAX);
4158 return mask;
4159 }
4160
4161 #endif /* !defined (HAVE_X_WINDOWS) && defined (NoValue) */
4162
4163 \f
4164 /* NS used to define x-parse-geometry in ns-win.el, but that confused
4165 make-docfile: the documentation string in ns-win.el was used for
4166 x-parse-geometry even in non-NS builds.
4167
4168 With two definitions of x-parse-geometry in this file, various
4169 things still get confused (eg M-x apropos documentation), so that
4170 it is best if the two definitions just share the same doc-string.
4171 */
4172 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
4173 doc: /* Parse a display geometry string STRING.
4174 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
4175 The properties returned may include `top', `left', `height', and `width'.
4176 For X, the value of `left' or `top' may be an integer,
4177 or a list (+ N) meaning N pixels relative to top/left corner,
4178 or a list (- N) meaning -N pixels relative to bottom/right corner.
4179 On Nextstep, this just calls `ns-parse-geometry'. */)
4180 (Lisp_Object string)
4181 {
4182 int geometry, x, y;
4183 unsigned int width, height;
4184 Lisp_Object result;
4185
4186 CHECK_STRING (string);
4187
4188 #ifdef HAVE_NS
4189 if (strchr (SSDATA (string), ' ') != NULL)
4190 return call1 (Qns_parse_geometry, string);
4191 #endif
4192 geometry = XParseGeometry (SSDATA (string),
4193 &x, &y, &width, &height);
4194 result = Qnil;
4195 if (geometry & XValue)
4196 {
4197 Lisp_Object element;
4198
4199 if (x >= 0 && (geometry & XNegative))
4200 element = list3 (Qleft, Qminus, make_number (-x));
4201 else if (x < 0 && ! (geometry & XNegative))
4202 element = list3 (Qleft, Qplus, make_number (x));
4203 else
4204 element = Fcons (Qleft, make_number (x));
4205 result = Fcons (element, result);
4206 }
4207
4208 if (geometry & YValue)
4209 {
4210 Lisp_Object element;
4211
4212 if (y >= 0 && (geometry & YNegative))
4213 element = list3 (Qtop, Qminus, make_number (-y));
4214 else if (y < 0 && ! (geometry & YNegative))
4215 element = list3 (Qtop, Qplus, make_number (y));
4216 else
4217 element = Fcons (Qtop, make_number (y));
4218 result = Fcons (element, result);
4219 }
4220
4221 if (geometry & WidthValue)
4222 result = Fcons (Fcons (Qwidth, make_number (width)), result);
4223 if (geometry & HeightValue)
4224 result = Fcons (Fcons (Qheight, make_number (height)), result);
4225
4226 return result;
4227 }
4228
4229
4230 /* Calculate the desired size and position of frame F.
4231 Return the flags saying which aspects were specified.
4232
4233 Also set the win_gravity and size_hint_flags of F.
4234
4235 Adjust height for toolbar if TOOLBAR_P is 1.
4236
4237 This function does not make the coordinates positive. */
4238
4239 #define DEFAULT_ROWS 35
4240 #define DEFAULT_COLS 80
4241
4242 long
4243 x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p)
4244 {
4245 register Lisp_Object tem0, tem1, tem2;
4246 long window_prompting = 0;
4247 Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f);
4248
4249 /* Default values if we fall through.
4250 Actually, if that happens we should get
4251 window manager prompting. */
4252 SET_FRAME_WIDTH (f, DEFAULT_COLS * FRAME_COLUMN_WIDTH (f));
4253 SET_FRAME_COLS (f, DEFAULT_COLS);
4254 SET_FRAME_HEIGHT (f, DEFAULT_ROWS * FRAME_LINE_HEIGHT (f));
4255 FRAME_LINES (f) = DEFAULT_ROWS;
4256
4257 /* Window managers expect that if program-specified
4258 positions are not (0,0), they're intentional, not defaults. */
4259 f->top_pos = 0;
4260 f->left_pos = 0;
4261
4262 /* Ensure that old new_width and new_height will not override the
4263 values set here. */
4264 /* ++KFS: This was specific to W32, but seems ok for all platforms */
4265 f->new_width = f->new_height = f->new_pixelwise = 0;
4266
4267 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
4268 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
4269 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
4270 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4271 {
4272 if (!EQ (tem0, Qunbound))
4273 {
4274 CHECK_NUMBER (tem0);
4275 if (! (0 <= XINT (tem0) && XINT (tem0) <= INT_MAX))
4276 xsignal1 (Qargs_out_of_range, tem0);
4277 FRAME_LINES (f) = XINT (tem0);
4278 }
4279 if (!EQ (tem1, Qunbound))
4280 {
4281 CHECK_NUMBER (tem1);
4282 if (! (0 <= XINT (tem1) && XINT (tem1) <= INT_MAX))
4283 xsignal1 (Qargs_out_of_range, tem1);
4284 SET_FRAME_COLS (f, XINT (tem1));
4285 }
4286 if (!NILP (tem2) && !EQ (tem2, Qunbound))
4287 window_prompting |= USSize;
4288 else
4289 window_prompting |= PSize;
4290 }
4291
4292
4293 /* This used to be done _before_ calling x_figure_window_size, but
4294 since the height is reset here, this was really a no-op. I
4295 assume that moving it here does what Gerd intended (although he
4296 no longer can remember what that was... ++KFS, 2003-03-25. */
4297
4298 /* Add the tool-bar height to the initial frame height so that the
4299 user gets a text display area of the size he specified with -g or
4300 via .Xdefaults. Later changes of the tool-bar height don't
4301 change the frame size. This is done so that users can create
4302 tall Emacs frames without having to guess how tall the tool-bar
4303 will get. */
4304 if (toolbar_p && FRAME_TOOL_BAR_HEIGHT (f))
4305 {
4306 int margin, relief, bar_height;
4307
4308 relief = (tool_bar_button_relief >= 0
4309 ? tool_bar_button_relief
4310 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
4311
4312 if (RANGED_INTEGERP (1, Vtool_bar_button_margin, INT_MAX))
4313 margin = XFASTINT (Vtool_bar_button_margin);
4314 else if (CONSP (Vtool_bar_button_margin)
4315 && RANGED_INTEGERP (1, XCDR (Vtool_bar_button_margin), INT_MAX))
4316 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
4317 else
4318 margin = 0;
4319
4320 /* PXW: We should be able to not round here. */
4321 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
4322 FRAME_LINES (f) += (bar_height + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f);
4323 }
4324
4325 compute_fringe_widths (f, 0);
4326
4327 SET_FRAME_WIDTH (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f));
4328 SET_FRAME_HEIGHT(f, FRAME_LINES (f) * FRAME_LINE_HEIGHT (f));
4329
4330 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
4331 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
4332 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
4333 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4334 {
4335 if (EQ (tem0, Qminus))
4336 {
4337 f->top_pos = 0;
4338 window_prompting |= YNegative;
4339 }
4340 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
4341 && CONSP (XCDR (tem0))
4342 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (tem0)), INT_MAX))
4343 {
4344 f->top_pos = - XINT (XCAR (XCDR (tem0)));
4345 window_prompting |= YNegative;
4346 }
4347 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
4348 && CONSP (XCDR (tem0))
4349 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (tem0))))
4350 {
4351 f->top_pos = XINT (XCAR (XCDR (tem0)));
4352 }
4353 else if (EQ (tem0, Qunbound))
4354 f->top_pos = 0;
4355 else
4356 {
4357 CHECK_TYPE_RANGED_INTEGER (int, tem0);
4358 f->top_pos = XINT (tem0);
4359 if (f->top_pos < 0)
4360 window_prompting |= YNegative;
4361 }
4362
4363 if (EQ (tem1, Qminus))
4364 {
4365 f->left_pos = 0;
4366 window_prompting |= XNegative;
4367 }
4368 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
4369 && CONSP (XCDR (tem1))
4370 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (tem1)), INT_MAX))
4371 {
4372 f->left_pos = - XINT (XCAR (XCDR (tem1)));
4373 window_prompting |= XNegative;
4374 }
4375 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
4376 && CONSP (XCDR (tem1))
4377 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (tem1))))
4378 {
4379 f->left_pos = XINT (XCAR (XCDR (tem1)));
4380 }
4381 else if (EQ (tem1, Qunbound))
4382 f->left_pos = 0;
4383 else
4384 {
4385 CHECK_TYPE_RANGED_INTEGER (int, tem1);
4386 f->left_pos = XINT (tem1);
4387 if (f->left_pos < 0)
4388 window_prompting |= XNegative;
4389 }
4390
4391 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
4392 window_prompting |= USPosition;
4393 else
4394 window_prompting |= PPosition;
4395 }
4396
4397 if (window_prompting & XNegative)
4398 {
4399 if (window_prompting & YNegative)
4400 f->win_gravity = SouthEastGravity;
4401 else
4402 f->win_gravity = NorthEastGravity;
4403 }
4404 else
4405 {
4406 if (window_prompting & YNegative)
4407 f->win_gravity = SouthWestGravity;
4408 else
4409 f->win_gravity = NorthWestGravity;
4410 }
4411
4412 f->size_hint_flags = window_prompting;
4413
4414 return window_prompting;
4415 }
4416
4417
4418
4419 #endif /* HAVE_WINDOW_SYSTEM */
4420
4421 void
4422 frame_make_pointer_invisible (struct frame *f)
4423 {
4424 if (! NILP (Vmake_pointer_invisible))
4425 {
4426 if (f && FRAME_LIVE_P (f) && !f->pointer_invisible
4427 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4428 {
4429 f->mouse_moved = 0;
4430 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 1);
4431 f->pointer_invisible = 1;
4432 }
4433 }
4434 }
4435
4436 void
4437 frame_make_pointer_visible (struct frame *f)
4438 {
4439 /* We don't check Vmake_pointer_invisible here in case the
4440 pointer was invisible when Vmake_pointer_invisible was set to nil. */
4441 if (f && FRAME_LIVE_P (f) && f->pointer_invisible && f->mouse_moved
4442 && FRAME_TERMINAL (f)->toggle_invisible_pointer_hook)
4443 {
4444 FRAME_TERMINAL (f)->toggle_invisible_pointer_hook (f, 0);
4445 f->pointer_invisible = 0;
4446 }
4447 }
4448
4449 DEFUN ("frame-pointer-visible-p", Fframe_pointer_visible_p,
4450 Sframe_pointer_visible_p, 0, 1, 0,
4451 doc: /* Return t if the mouse pointer displayed on FRAME is visible.
4452 Otherwise it returns nil. FRAME omitted or nil means the
4453 selected frame. This is useful when `make-pointer-invisible' is set. */)
4454 (Lisp_Object frame)
4455 {
4456 return decode_any_frame (frame)->pointer_invisible ? Qnil : Qt;
4457 }
4458
4459
4460 \f
4461 /***********************************************************************
4462 Multimonitor data
4463 ***********************************************************************/
4464
4465 #ifdef HAVE_WINDOW_SYSTEM
4466
4467 # if (defined HAVE_NS \
4468 || (!defined USE_GTK && (defined HAVE_XINERAMA || defined HAVE_XRANDR)))
4469 void
4470 free_monitors (struct MonitorInfo *monitors, int n_monitors)
4471 {
4472 int i;
4473 for (i = 0; i < n_monitors; ++i)
4474 xfree (monitors[i].name);
4475 xfree (monitors);
4476 }
4477 # endif
4478
4479 Lisp_Object
4480 make_monitor_attribute_list (struct MonitorInfo *monitors,
4481 int n_monitors,
4482 int primary_monitor,
4483 Lisp_Object monitor_frames,
4484 const char *source)
4485 {
4486 Lisp_Object attributes_list = Qnil;
4487 Lisp_Object primary_monitor_attributes = Qnil;
4488 int i;
4489
4490 for (i = 0; i < n_monitors; ++i)
4491 {
4492 Lisp_Object geometry, workarea, attributes = Qnil;
4493 struct MonitorInfo *mi = &monitors[i];
4494
4495 if (mi->geom.width == 0) continue;
4496
4497 workarea = list4i (mi->work.x, mi->work.y,
4498 mi->work.width, mi->work.height);
4499 geometry = list4i (mi->geom.x, mi->geom.y,
4500 mi->geom.width, mi->geom.height);
4501 attributes = Fcons (Fcons (Qsource, build_string (source)),
4502 attributes);
4503 attributes = Fcons (Fcons (Qframes, AREF (monitor_frames, i)),
4504 attributes);
4505 attributes = Fcons (Fcons (Qmm_size,
4506 list2i (mi->mm_width, mi->mm_height)),
4507 attributes);
4508 attributes = Fcons (Fcons (Qworkarea, workarea), attributes);
4509 attributes = Fcons (Fcons (Qgeometry, geometry), attributes);
4510 if (mi->name)
4511 attributes = Fcons (Fcons (Qname, make_string (mi->name,
4512 strlen (mi->name))),
4513 attributes);
4514
4515 if (i == primary_monitor)
4516 primary_monitor_attributes = attributes;
4517 else
4518 attributes_list = Fcons (attributes, attributes_list);
4519 }
4520
4521 if (!NILP (primary_monitor_attributes))
4522 attributes_list = Fcons (primary_monitor_attributes, attributes_list);
4523 return attributes_list;
4524 }
4525
4526 #endif /* HAVE_WINDOW_SYSTEM */
4527
4528 \f
4529 /***********************************************************************
4530 Initialization
4531 ***********************************************************************/
4532
4533 void
4534 syms_of_frame (void)
4535 {
4536 DEFSYM (Qframep, "framep");
4537 DEFSYM (Qframe_live_p, "frame-live-p");
4538 DEFSYM (Qexplicit_name, "explicit-name");
4539 DEFSYM (Qheight, "height");
4540 DEFSYM (Qicon, "icon");
4541 DEFSYM (Qminibuffer, "minibuffer");
4542 DEFSYM (Qmodeline, "modeline");
4543 DEFSYM (Qonly, "only");
4544 DEFSYM (Qnone, "none");
4545 DEFSYM (Qwidth, "width");
4546 DEFSYM (Qgeometry, "geometry");
4547 DEFSYM (Qicon_left, "icon-left");
4548 DEFSYM (Qicon_top, "icon-top");
4549 DEFSYM (Qtooltip, "tooltip");
4550 DEFSYM (Qleft, "left");
4551 DEFSYM (Qright, "right");
4552 DEFSYM (Quser_position, "user-position");
4553 DEFSYM (Quser_size, "user-size");
4554 DEFSYM (Qwindow_id, "window-id");
4555 #ifdef HAVE_X_WINDOWS
4556 DEFSYM (Qouter_window_id, "outer-window-id");
4557 #endif
4558 DEFSYM (Qparent_id, "parent-id");
4559 DEFSYM (Qx, "x");
4560 DEFSYM (Qw32, "w32");
4561 DEFSYM (Qpc, "pc");
4562 DEFSYM (Qns, "ns");
4563 DEFSYM (Qvisible, "visible");
4564 DEFSYM (Qbuffer_predicate, "buffer-predicate");
4565 DEFSYM (Qbuffer_list, "buffer-list");
4566 DEFSYM (Qburied_buffer_list, "buried-buffer-list");
4567 DEFSYM (Qdisplay_type, "display-type");
4568 DEFSYM (Qbackground_mode, "background-mode");
4569 DEFSYM (Qnoelisp, "noelisp");
4570 DEFSYM (Qtty_color_mode, "tty-color-mode");
4571 DEFSYM (Qtty, "tty");
4572 DEFSYM (Qtty_type, "tty-type");
4573
4574 DEFSYM (Qface_set_after_frame_default, "face-set-after-frame-default");
4575
4576 DEFSYM (Qfullwidth, "fullwidth");
4577 DEFSYM (Qfullheight, "fullheight");
4578 DEFSYM (Qfullboth, "fullboth");
4579 DEFSYM (Qmaximized, "maximized");
4580 DEFSYM (Qx_resource_name, "x-resource-name");
4581 DEFSYM (Qx_frame_parameter, "x-frame-parameter");
4582
4583 DEFSYM (Qterminal, "terminal");
4584
4585 DEFSYM (Qgeometry, "geometry");
4586 DEFSYM (Qworkarea, "workarea");
4587 DEFSYM (Qmm_size, "mm-size");
4588 DEFSYM (Qframes, "frames");
4589 DEFSYM (Qsource, "source");
4590
4591 #ifdef HAVE_NS
4592 DEFSYM (Qns_parse_geometry, "ns-parse-geometry");
4593 #endif
4594
4595 {
4596 int i;
4597
4598 for (i = 0; i < ARRAYELTS (frame_parms); i++)
4599 {
4600 Lisp_Object v = intern_c_string (frame_parms[i].name);
4601 if (frame_parms[i].variable)
4602 {
4603 *frame_parms[i].variable = v;
4604 staticpro (frame_parms[i].variable);
4605 }
4606 Fput (v, Qx_frame_parameter, make_number (i));
4607 }
4608 }
4609
4610 #ifdef HAVE_WINDOW_SYSTEM
4611 DEFVAR_LISP ("x-resource-name", Vx_resource_name,
4612 doc: /* The name Emacs uses to look up X resources.
4613 `x-get-resource' uses this as the first component of the instance name
4614 when requesting resource values.
4615 Emacs initially sets `x-resource-name' to the name under which Emacs
4616 was invoked, or to the value specified with the `-name' or `-rn'
4617 switches, if present.
4618
4619 It may be useful to bind this variable locally around a call
4620 to `x-get-resource'. See also the variable `x-resource-class'. */);
4621 Vx_resource_name = Qnil;
4622
4623 DEFVAR_LISP ("x-resource-class", Vx_resource_class,
4624 doc: /* The class Emacs uses to look up X resources.
4625 `x-get-resource' uses this as the first component of the instance class
4626 when requesting resource values.
4627
4628 Emacs initially sets `x-resource-class' to "Emacs".
4629
4630 Setting this variable permanently is not a reasonable thing to do,
4631 but binding this variable locally around a call to `x-get-resource'
4632 is a reasonable practice. See also the variable `x-resource-name'. */);
4633 Vx_resource_class = build_string (EMACS_CLASS);
4634
4635 DEFVAR_LISP ("frame-alpha-lower-limit", Vframe_alpha_lower_limit,
4636 doc: /* The lower limit of the frame opacity (alpha transparency).
4637 The value should range from 0 (invisible) to 100 (completely opaque).
4638 You can also use a floating number between 0.0 and 1.0. */);
4639 Vframe_alpha_lower_limit = make_number (20);
4640 #endif
4641
4642 DEFVAR_LISP ("default-frame-alist", Vdefault_frame_alist,
4643 doc: /* Alist of default values for frame creation.
4644 These may be set in your init file, like this:
4645 (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1)))
4646 These override values given in window system configuration data,
4647 including X Windows' defaults database.
4648 For values specific to the first Emacs frame, see `initial-frame-alist'.
4649 For window-system specific values, see `window-system-default-frame-alist'.
4650 For values specific to the separate minibuffer frame, see
4651 `minibuffer-frame-alist'.
4652 The `menu-bar-lines' element of the list controls whether new frames
4653 have menu bars; `menu-bar-mode' works by altering this element.
4654 Setting this variable does not affect existing frames, only new ones. */);
4655 Vdefault_frame_alist = Qnil;
4656
4657 DEFVAR_LISP ("default-frame-scroll-bars", Vdefault_frame_scroll_bars,
4658 doc: /* Default position of scroll bars on this window-system. */);
4659 #ifdef HAVE_WINDOW_SYSTEM
4660 #if defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA) || (defined (USE_GTK) && defined (USE_TOOLKIT_SCROLL_BARS))
4661 /* MS-Windows, Mac OS X, and GTK have scroll bars on the right by
4662 default. */
4663 Vdefault_frame_scroll_bars = Qright;
4664 #else
4665 Vdefault_frame_scroll_bars = Qleft;
4666 #endif
4667 #else
4668 Vdefault_frame_scroll_bars = Qnil;
4669 #endif
4670
4671 DEFVAR_BOOL ("scroll-bar-adjust-thumb-portion",
4672 scroll_bar_adjust_thumb_portion_p,
4673 doc: /* Adjust thumb for overscrolling for Gtk+ and MOTIF.
4674 Non-nil means adjust the thumb in the scroll bar so it can be dragged downwards
4675 even if the end of the buffer is shown (i.e. overscrolling).
4676 Set to nil if you want the thumb to be at the bottom when the end of the buffer
4677 is shown. Also, the thumb fills the whole scroll bar when the entire buffer
4678 is visible. In this case you can not overscroll. */);
4679 scroll_bar_adjust_thumb_portion_p = 1;
4680
4681 DEFVAR_LISP ("terminal-frame", Vterminal_frame,
4682 doc: /* The initial frame-object, which represents Emacs's stdout. */);
4683
4684 DEFVAR_LISP ("mouse-position-function", Vmouse_position_function,
4685 doc: /* If non-nil, function to transform normal value of `mouse-position'.
4686 `mouse-position' calls this function, passing its usual return value as
4687 argument, and returns whatever this function returns.
4688 This abnormal hook exists for the benefit of packages like `xt-mouse.el'
4689 which need to do mouse handling at the Lisp level. */);
4690 Vmouse_position_function = Qnil;
4691
4692 DEFVAR_LISP ("mouse-highlight", Vmouse_highlight,
4693 doc: /* If non-nil, clickable text is highlighted when mouse is over it.
4694 If the value is an integer, highlighting is only shown after moving the
4695 mouse, while keyboard input turns off the highlight even when the mouse
4696 is over the clickable text. However, the mouse shape still indicates
4697 when the mouse is over clickable text. */);
4698 Vmouse_highlight = Qt;
4699
4700 DEFVAR_LISP ("make-pointer-invisible", Vmake_pointer_invisible,
4701 doc: /* If non-nil, make pointer invisible while typing.
4702 The pointer becomes visible again when the mouse is moved. */);
4703 Vmake_pointer_invisible = Qt;
4704
4705 DEFVAR_LISP ("focus-in-hook", Vfocus_in_hook,
4706 doc: /* Normal hook run when a frame gains input focus. */);
4707 Vfocus_in_hook = Qnil;
4708 DEFSYM (Qfocus_in_hook, "focus-in-hook");
4709
4710 DEFVAR_LISP ("focus-out-hook", Vfocus_out_hook,
4711 doc: /* Normal hook run when a frame loses input focus. */);
4712 Vfocus_out_hook = Qnil;
4713 DEFSYM (Qfocus_out_hook, "focus-out-hook");
4714
4715 DEFVAR_LISP ("delete-frame-functions", Vdelete_frame_functions,
4716 doc: /* Functions run before deleting a frame.
4717 The functions are run with one arg, the frame to be deleted.
4718 See `delete-frame'.
4719
4720 Note that functions in this list may be called just before the frame is
4721 actually deleted, or some time later (or even both when an earlier function
4722 in `delete-frame-functions' (indirectly) calls `delete-frame'
4723 recursively). */);
4724 Vdelete_frame_functions = Qnil;
4725 DEFSYM (Qdelete_frame_functions, "delete-frame-functions");
4726
4727 DEFVAR_LISP ("menu-bar-mode", Vmenu_bar_mode,
4728 doc: /* Non-nil if Menu-Bar mode is enabled.
4729 See the command `menu-bar-mode' for a description of this minor mode.
4730 Setting this variable directly does not take effect;
4731 either customize it (see the info node `Easy Customization')
4732 or call the function `menu-bar-mode'. */);
4733 Vmenu_bar_mode = Qt;
4734
4735 DEFVAR_LISP ("tool-bar-mode", Vtool_bar_mode,
4736 doc: /* Non-nil if Tool-Bar mode is enabled.
4737 See the command `tool-bar-mode' for a description of this minor mode.
4738 Setting this variable directly does not take effect;
4739 either customize it (see the info node `Easy Customization')
4740 or call the function `tool-bar-mode'. */);
4741 #ifdef HAVE_WINDOW_SYSTEM
4742 Vtool_bar_mode = Qt;
4743 #else
4744 Vtool_bar_mode = Qnil;
4745 #endif
4746
4747 DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
4748 doc: /* Minibufferless frames use this frame's minibuffer.
4749 Emacs cannot create minibufferless frames unless this is set to an
4750 appropriate surrogate.
4751
4752 Emacs consults this variable only when creating minibufferless
4753 frames; once the frame is created, it sticks with its assigned
4754 minibuffer, no matter what this variable is set to. This means that
4755 this variable doesn't necessarily say anything meaningful about the
4756 current set of frames, or where the minibuffer is currently being
4757 displayed.
4758
4759 This variable is local to the current terminal and cannot be buffer-local. */);
4760
4761 DEFVAR_BOOL ("focus-follows-mouse", focus_follows_mouse,
4762 doc: /* Non-nil if window system changes focus when you move the mouse.
4763 You should set this variable to tell Emacs how your window manager
4764 handles focus, since there is no way in general for Emacs to find out
4765 automatically. See also `mouse-autoselect-window'. */);
4766 focus_follows_mouse = 0;
4767
4768 DEFVAR_BOOL ("frame-resize-pixelwise", frame_resize_pixelwise,
4769 doc: /* Non-nil means resize frames pixelwise.
4770 If this option is nil, resizing a frame rounds its sizes to the frame's
4771 current values of `frame-char-height' and `frame-char-width'. If this
4772 is non-nil, no rounding occurs, hence frame sizes can increase/decrease
4773 by one pixel.
4774
4775 With some window managers you have to set this to non-nil in order to
4776 fully maximize frames. To resize your initial frame pixelwise,
4777 set this option to a non-nil value in your init file. */);
4778 frame_resize_pixelwise = 0;
4779
4780 staticpro (&Vframe_list);
4781
4782 defsubr (&Sframep);
4783 defsubr (&Sframe_live_p);
4784 defsubr (&Swindow_system);
4785 defsubr (&Smake_terminal_frame);
4786 defsubr (&Shandle_switch_frame);
4787 defsubr (&Sselect_frame);
4788 defsubr (&Sselected_frame);
4789 defsubr (&Sframe_list);
4790 defsubr (&Snext_frame);
4791 defsubr (&Sprevious_frame);
4792 defsubr (&Slast_nonminibuf_frame);
4793 defsubr (&Sdelete_frame);
4794 defsubr (&Smouse_position);
4795 defsubr (&Smouse_pixel_position);
4796 defsubr (&Sset_mouse_position);
4797 defsubr (&Sset_mouse_pixel_position);
4798 #if 0
4799 defsubr (&Sframe_configuration);
4800 defsubr (&Srestore_frame_configuration);
4801 #endif
4802 defsubr (&Smake_frame_visible);
4803 defsubr (&Smake_frame_invisible);
4804 defsubr (&Siconify_frame);
4805 defsubr (&Sframe_visible_p);
4806 defsubr (&Svisible_frame_list);
4807 defsubr (&Sraise_frame);
4808 defsubr (&Slower_frame);
4809 defsubr (&Sx_focus_frame);
4810 defsubr (&Sredirect_frame_focus);
4811 defsubr (&Sframe_focus);
4812 defsubr (&Sframe_parameters);
4813 defsubr (&Sframe_parameter);
4814 defsubr (&Smodify_frame_parameters);
4815 defsubr (&Sframe_char_height);
4816 defsubr (&Sframe_char_width);
4817 defsubr (&Sframe_pixel_height);
4818 defsubr (&Sframe_pixel_width);
4819 defsubr (&Sframe_text_cols);
4820 defsubr (&Sframe_text_lines);
4821 defsubr (&Sframe_total_cols);
4822 defsubr (&Sframe_text_width);
4823 defsubr (&Sframe_text_height);
4824 defsubr (&Sscroll_bar_width);
4825 defsubr (&Sfringe_width);
4826 defsubr (&Sborder_width);
4827 defsubr (&Sright_divider_width);
4828 defsubr (&Sbottom_divider_width);
4829 defsubr (&Stool_bar_pixel_width);
4830 defsubr (&Sset_frame_height);
4831 defsubr (&Sset_frame_width);
4832 defsubr (&Sset_frame_size);
4833 defsubr (&Sset_frame_position);
4834 defsubr (&Sframe_pointer_visible_p);
4835
4836 #ifdef HAVE_WINDOW_SYSTEM
4837 defsubr (&Sx_get_resource);
4838 defsubr (&Sx_parse_geometry);
4839 #endif
4840
4841 }