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