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