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