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