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