Merged in changes from CVS trunk. (Long time no see!) :-)
[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 if (STRINGP (fontset_name))
3325 {
3326 /* Fontset names are built from ASCII font names, so the
3327 names may be equal despite there was a change. */
3328 if (old_fontset == FRAME_FONTSET (f))
3329 return;
3330 }
3331 else if (!NILP (Fequal (result, oldval)))
3332 return;
3333
3334 store_frame_param (f, Qfont, result);
3335 recompute_basic_faces (f);
3336 }
3337 else
3338 abort ();
3339
3340 do_pending_window_change (0);
3341
3342 /* Don't call `face-set-after-frame-default' when faces haven't been
3343 initialized yet. This is the case when called from
3344 Fx_create_frame. In that case, the X widget or window doesn't
3345 exist either, and we can end up in x_report_frame_params with a
3346 null widget which gives a segfault. */
3347 if (FRAME_FACE_CACHE (f))
3348 {
3349 XSETFRAME (frame, f);
3350 call1 (Qface_set_after_frame_default, frame);
3351 }
3352 }
3353
3354
3355 void
3356 x_set_fringe_width (f, new_value, old_value)
3357 struct frame *f;
3358 Lisp_Object new_value, old_value;
3359 {
3360 compute_fringe_widths (f, 1);
3361 }
3362
3363 void
3364 x_set_border_width (f, arg, oldval)
3365 struct frame *f;
3366 Lisp_Object arg, oldval;
3367 {
3368 CHECK_NUMBER (arg);
3369
3370 if (XINT (arg) == f->border_width)
3371 return;
3372
3373 #ifndef MAC_OS
3374 if (FRAME_X_WINDOW (f) != 0)
3375 error ("Cannot change the border width of a window");
3376 #endif /* MAC_TODO */
3377
3378 f->border_width = XINT (arg);
3379 }
3380
3381 void
3382 x_set_internal_border_width (f, arg, oldval)
3383 struct frame *f;
3384 Lisp_Object arg, oldval;
3385 {
3386 int old = FRAME_INTERNAL_BORDER_WIDTH (f);
3387
3388 CHECK_NUMBER (arg);
3389 FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
3390 if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
3391 FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
3392
3393 #ifdef USE_X_TOOLKIT
3394 if (FRAME_X_OUTPUT (f)->edit_widget)
3395 widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
3396 #endif
3397
3398 if (FRAME_INTERNAL_BORDER_WIDTH (f) == old)
3399 return;
3400
3401 if (FRAME_X_WINDOW (f) != 0)
3402 {
3403 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3404 SET_FRAME_GARBAGED (f);
3405 do_pending_window_change (0);
3406 }
3407 else
3408 SET_FRAME_GARBAGED (f);
3409 }
3410
3411 void
3412 x_set_visibility (f, value, oldval)
3413 struct frame *f;
3414 Lisp_Object value, oldval;
3415 {
3416 Lisp_Object frame;
3417 XSETFRAME (frame, f);
3418
3419 if (NILP (value))
3420 Fmake_frame_invisible (frame, Qt);
3421 else if (EQ (value, Qicon))
3422 Ficonify_frame (frame);
3423 else
3424 Fmake_frame_visible (frame);
3425 }
3426
3427 void
3428 x_set_autoraise (f, arg, oldval)
3429 struct frame *f;
3430 Lisp_Object arg, oldval;
3431 {
3432 f->auto_raise = !EQ (Qnil, arg);
3433 }
3434
3435 void
3436 x_set_autolower (f, arg, oldval)
3437 struct frame *f;
3438 Lisp_Object arg, oldval;
3439 {
3440 f->auto_lower = !EQ (Qnil, arg);
3441 }
3442
3443 void
3444 x_set_unsplittable (f, arg, oldval)
3445 struct frame *f;
3446 Lisp_Object arg, oldval;
3447 {
3448 f->no_split = !NILP (arg);
3449 }
3450
3451 void
3452 x_set_vertical_scroll_bars (f, arg, oldval)
3453 struct frame *f;
3454 Lisp_Object arg, oldval;
3455 {
3456 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
3457 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
3458 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
3459 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
3460 {
3461 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
3462 = (NILP (arg)
3463 ? vertical_scroll_bar_none
3464 : EQ (Qleft, arg)
3465 ? vertical_scroll_bar_left
3466 : EQ (Qright, arg)
3467 ? vertical_scroll_bar_right
3468 : EQ (Qleft, Vdefault_frame_scroll_bars)
3469 ? vertical_scroll_bar_left
3470 : EQ (Qright, Vdefault_frame_scroll_bars)
3471 ? vertical_scroll_bar_right
3472 : vertical_scroll_bar_none);
3473
3474 /* We set this parameter before creating the X window for the
3475 frame, so we can get the geometry right from the start.
3476 However, if the window hasn't been created yet, we shouldn't
3477 call x_set_window_size. */
3478 if (FRAME_X_WINDOW (f))
3479 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3480 do_pending_window_change (0);
3481 }
3482 }
3483
3484 void
3485 x_set_scroll_bar_width (f, arg, oldval)
3486 struct frame *f;
3487 Lisp_Object arg, oldval;
3488 {
3489 int wid = FRAME_COLUMN_WIDTH (f);
3490
3491 if (NILP (arg))
3492 {
3493 x_set_scroll_bar_default_width (f);
3494
3495 if (FRAME_X_WINDOW (f))
3496 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3497 do_pending_window_change (0);
3498 }
3499 else if (INTEGERP (arg) && XINT (arg) > 0
3500 && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3501 {
3502 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
3503 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
3504
3505 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg);
3506 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
3507 if (FRAME_X_WINDOW (f))
3508 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3509 do_pending_window_change (0);
3510 }
3511
3512 change_frame_size (f, 0, FRAME_COLS (f), 0, 0, 0);
3513 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
3514 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
3515 }
3516
3517
3518
3519 /* Return non-nil if frame F wants a bitmap icon. */
3520
3521 Lisp_Object
3522 x_icon_type (f)
3523 FRAME_PTR f;
3524 {
3525 Lisp_Object tem;
3526
3527 tem = assq_no_quit (Qicon_type, f->param_alist);
3528 if (CONSP (tem))
3529 return XCDR (tem);
3530 else
3531 return Qnil;
3532 }
3533
3534 \f
3535 /* Subroutines of creating an X frame. */
3536
3537 /* Make sure that Vx_resource_name is set to a reasonable value.
3538 Fix it up, or set it to `emacs' if it is too hopeless. */
3539
3540 void
3541 validate_x_resource_name ()
3542 {
3543 int len = 0;
3544 /* Number of valid characters in the resource name. */
3545 int good_count = 0;
3546 /* Number of invalid characters in the resource name. */
3547 int bad_count = 0;
3548 Lisp_Object new;
3549 int i;
3550
3551 if (!STRINGP (Vx_resource_class))
3552 Vx_resource_class = build_string (EMACS_CLASS);
3553
3554 if (STRINGP (Vx_resource_name))
3555 {
3556 unsigned char *p = SDATA (Vx_resource_name);
3557 int i;
3558
3559 len = SBYTES (Vx_resource_name);
3560
3561 /* Only letters, digits, - and _ are valid in resource names.
3562 Count the valid characters and count the invalid ones. */
3563 for (i = 0; i < len; i++)
3564 {
3565 int c = p[i];
3566 if (! ((c >= 'a' && c <= 'z')
3567 || (c >= 'A' && c <= 'Z')
3568 || (c >= '0' && c <= '9')
3569 || c == '-' || c == '_'))
3570 bad_count++;
3571 else
3572 good_count++;
3573 }
3574 }
3575 else
3576 /* Not a string => completely invalid. */
3577 bad_count = 5, good_count = 0;
3578
3579 /* If name is valid already, return. */
3580 if (bad_count == 0)
3581 return;
3582
3583 /* If name is entirely invalid, or nearly so, use `emacs'. */
3584 if (good_count == 0
3585 || (good_count == 1 && bad_count > 0))
3586 {
3587 Vx_resource_name = build_string ("emacs");
3588 return;
3589 }
3590
3591 /* Name is partly valid. Copy it and replace the invalid characters
3592 with underscores. */
3593
3594 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
3595
3596 for (i = 0; i < len; i++)
3597 {
3598 int c = SREF (new, i);
3599 if (! ((c >= 'a' && c <= 'z')
3600 || (c >= 'A' && c <= 'Z')
3601 || (c >= '0' && c <= '9')
3602 || c == '-' || c == '_'))
3603 SSET (new, i, '_');
3604 }
3605 }
3606
3607
3608 extern char *x_get_string_resource P_ ((XrmDatabase, char *, char *));
3609 extern Display_Info *check_x_display_info P_ ((Lisp_Object));
3610
3611
3612 /* Get specified attribute from resource database RDB.
3613 See Fx_get_resource below for other parameters. */
3614
3615 static Lisp_Object
3616 xrdb_get_resource (rdb, attribute, class, component, subclass)
3617 XrmDatabase rdb;
3618 Lisp_Object attribute, class, component, subclass;
3619 {
3620 register char *value;
3621 char *name_key;
3622 char *class_key;
3623
3624 CHECK_STRING (attribute);
3625 CHECK_STRING (class);
3626
3627 if (!NILP (component))
3628 CHECK_STRING (component);
3629 if (!NILP (subclass))
3630 CHECK_STRING (subclass);
3631 if (NILP (component) != NILP (subclass))
3632 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3633
3634 validate_x_resource_name ();
3635
3636 /* Allocate space for the components, the dots which separate them,
3637 and the final '\0'. Make them big enough for the worst case. */
3638 name_key = (char *) alloca (SBYTES (Vx_resource_name)
3639 + (STRINGP (component)
3640 ? SBYTES (component) : 0)
3641 + SBYTES (attribute)
3642 + 3);
3643
3644 class_key = (char *) alloca (SBYTES (Vx_resource_class)
3645 + SBYTES (class)
3646 + (STRINGP (subclass)
3647 ? SBYTES (subclass) : 0)
3648 + 3);
3649
3650 /* Start with emacs.FRAMENAME for the name (the specific one)
3651 and with `Emacs' for the class key (the general one). */
3652 strcpy (name_key, SDATA (Vx_resource_name));
3653 strcpy (class_key, SDATA (Vx_resource_class));
3654
3655 strcat (class_key, ".");
3656 strcat (class_key, SDATA (class));
3657
3658 if (!NILP (component))
3659 {
3660 strcat (class_key, ".");
3661 strcat (class_key, SDATA (subclass));
3662
3663 strcat (name_key, ".");
3664 strcat (name_key, SDATA (component));
3665 }
3666
3667 strcat (name_key, ".");
3668 strcat (name_key, SDATA (attribute));
3669
3670 value = x_get_string_resource (rdb, name_key, class_key);
3671
3672 if (value != (char *) 0)
3673 return build_string (value);
3674 else
3675 return Qnil;
3676 }
3677
3678
3679 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
3680 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
3681 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
3682 class, where INSTANCE is the name under which Emacs was invoked, or
3683 the name specified by the `-name' or `-rn' command-line arguments.
3684
3685 The optional arguments COMPONENT and SUBCLASS add to the key and the
3686 class, respectively. You must specify both of them or neither.
3687 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
3688 and the class is `Emacs.CLASS.SUBCLASS'. */)
3689 (attribute, class, component, subclass)
3690 Lisp_Object attribute, class, component, subclass;
3691 {
3692 #ifdef HAVE_X_WINDOWS
3693 check_x ();
3694 #endif
3695
3696 return xrdb_get_resource (check_x_display_info (Qnil)->xrdb,
3697 attribute, class, component, subclass);
3698 }
3699
3700 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
3701
3702 Lisp_Object
3703 display_x_get_resource (dpyinfo, attribute, class, component, subclass)
3704 Display_Info *dpyinfo;
3705 Lisp_Object attribute, class, component, subclass;
3706 {
3707 return xrdb_get_resource (dpyinfo->xrdb,
3708 attribute, class, component, subclass);
3709 }
3710
3711 /* Used when C code wants a resource value. */
3712
3713 char *
3714 x_get_resource_string (attribute, class)
3715 char *attribute, *class;
3716 {
3717 char *name_key;
3718 char *class_key;
3719 struct frame *sf = SELECTED_FRAME ();
3720
3721 /* Allocate space for the components, the dots which separate them,
3722 and the final '\0'. */
3723 name_key = (char *) alloca (SBYTES (Vinvocation_name)
3724 + strlen (attribute) + 2);
3725 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
3726 + strlen (class) + 2);
3727
3728 sprintf (name_key, "%s.%s", SDATA (Vinvocation_name), attribute);
3729 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3730
3731 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
3732 name_key, class_key);
3733 }
3734
3735
3736 /* Return the value of parameter PARAM.
3737
3738 First search ALIST, then Vdefault_frame_alist, then the X defaults
3739 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3740
3741 Convert the resource to the type specified by desired_type.
3742
3743 If no default is specified, return Qunbound. If you call
3744 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3745 and don't let it get stored in any Lisp-visible variables! */
3746
3747 Lisp_Object
3748 x_get_arg (dpyinfo, alist, param, attribute, class, type)
3749 Display_Info *dpyinfo;
3750 Lisp_Object alist, param;
3751 char *attribute;
3752 char *class;
3753 enum resource_types type;
3754 {
3755 register Lisp_Object tem;
3756
3757 tem = Fassq (param, alist);
3758 if (EQ (tem, Qnil))
3759 tem = Fassq (param, Vdefault_frame_alist);
3760 if (EQ (tem, Qnil))
3761 {
3762 if (attribute)
3763 {
3764 tem = display_x_get_resource (dpyinfo,
3765 build_string (attribute),
3766 build_string (class),
3767 Qnil, Qnil);
3768
3769 if (NILP (tem))
3770 return Qunbound;
3771
3772 switch (type)
3773 {
3774 case RES_TYPE_NUMBER:
3775 return make_number (atoi (SDATA (tem)));
3776
3777 case RES_TYPE_FLOAT:
3778 return make_float (atof (SDATA (tem)));
3779
3780 case RES_TYPE_BOOLEAN:
3781 tem = Fdowncase (tem);
3782 if (!strcmp (SDATA (tem), "on")
3783 || !strcmp (SDATA (tem), "true"))
3784 return Qt;
3785 else
3786 return Qnil;
3787
3788 case RES_TYPE_STRING:
3789 return tem;
3790
3791 case RES_TYPE_SYMBOL:
3792 /* As a special case, we map the values `true' and `on'
3793 to Qt, and `false' and `off' to Qnil. */
3794 {
3795 Lisp_Object lower;
3796 lower = Fdowncase (tem);
3797 if (!strcmp (SDATA (lower), "on")
3798 || !strcmp (SDATA (lower), "true"))
3799 return Qt;
3800 else if (!strcmp (SDATA (lower), "off")
3801 || !strcmp (SDATA (lower), "false"))
3802 return Qnil;
3803 else
3804 return Fintern (tem, Qnil);
3805 }
3806
3807 default:
3808 abort ();
3809 }
3810 }
3811 else
3812 return Qunbound;
3813 }
3814 return Fcdr (tem);
3815 }
3816
3817 Lisp_Object
3818 x_frame_get_arg (f, alist, param, attribute, class, type)
3819 struct frame *f;
3820 Lisp_Object alist, param;
3821 char *attribute;
3822 char *class;
3823 enum resource_types type;
3824 {
3825 return x_get_arg (FRAME_X_DISPLAY_INFO (f),
3826 alist, param, attribute, class, type);
3827 }
3828
3829 /* Like x_frame_get_arg, but also record the value in f->param_alist. */
3830
3831 Lisp_Object
3832 x_frame_get_and_record_arg (f, alist, param, attribute, class, type)
3833 struct frame *f;
3834 Lisp_Object alist, param;
3835 char *attribute;
3836 char *class;
3837 enum resource_types type;
3838 {
3839 Lisp_Object value;
3840
3841 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
3842 attribute, class, type);
3843 if (! NILP (value))
3844 store_frame_param (f, param, value);
3845
3846 return value;
3847 }
3848
3849
3850 /* Record in frame F the specified or default value according to ALIST
3851 of the parameter named PROP (a Lisp symbol).
3852 If no value is specified for PROP, look for an X default for XPROP
3853 on the frame named NAME.
3854 If that is not found either, use the value DEFLT. */
3855
3856 Lisp_Object
3857 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
3858 struct frame *f;
3859 Lisp_Object alist;
3860 Lisp_Object prop;
3861 Lisp_Object deflt;
3862 char *xprop;
3863 char *xclass;
3864 enum resource_types type;
3865 {
3866 Lisp_Object tem;
3867
3868 tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type);
3869 if (EQ (tem, Qunbound))
3870 tem = deflt;
3871 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
3872 return tem;
3873 }
3874
3875
3876
3877 \f
3878 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
3879 doc: /* Parse an X-style geometry string STRING.
3880 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3881 The properties returned may include `top', `left', `height', and `width'.
3882 The value of `left' or `top' may be an integer,
3883 or a list (+ N) meaning N pixels relative to top/left corner,
3884 or a list (- N) meaning -N pixels relative to bottom/right corner. */)
3885 (string)
3886 Lisp_Object string;
3887 {
3888 int geometry, x, y;
3889 unsigned int width, height;
3890 Lisp_Object result;
3891
3892 CHECK_STRING (string);
3893
3894 geometry = XParseGeometry ((char *) SDATA (string),
3895 &x, &y, &width, &height);
3896
3897 #if 0
3898 if (!!(geometry & XValue) != !!(geometry & YValue))
3899 error ("Must specify both x and y position, or neither");
3900 #endif
3901
3902 result = Qnil;
3903 if (geometry & XValue)
3904 {
3905 Lisp_Object element;
3906
3907 if (x >= 0 && (geometry & XNegative))
3908 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
3909 else if (x < 0 && ! (geometry & XNegative))
3910 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
3911 else
3912 element = Fcons (Qleft, make_number (x));
3913 result = Fcons (element, result);
3914 }
3915
3916 if (geometry & YValue)
3917 {
3918 Lisp_Object element;
3919
3920 if (y >= 0 && (geometry & YNegative))
3921 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
3922 else if (y < 0 && ! (geometry & YNegative))
3923 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
3924 else
3925 element = Fcons (Qtop, make_number (y));
3926 result = Fcons (element, result);
3927 }
3928
3929 if (geometry & WidthValue)
3930 result = Fcons (Fcons (Qwidth, make_number (width)), result);
3931 if (geometry & HeightValue)
3932 result = Fcons (Fcons (Qheight, make_number (height)), result);
3933
3934 return result;
3935 }
3936
3937 /* Calculate the desired size and position of frame F.
3938 Return the flags saying which aspects were specified.
3939
3940 Also set the win_gravity and size_hint_flags of F.
3941
3942 Adjust height for toolbar if TOOLBAR_P is 1.
3943
3944 This function does not make the coordinates positive. */
3945
3946 #define DEFAULT_ROWS 40
3947 #define DEFAULT_COLS 80
3948
3949 int
3950 x_figure_window_size (f, parms, toolbar_p)
3951 struct frame *f;
3952 Lisp_Object parms;
3953 int toolbar_p;
3954 {
3955 register Lisp_Object tem0, tem1, tem2;
3956 long window_prompting = 0;
3957 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3958
3959 /* Default values if we fall through.
3960 Actually, if that happens we should get
3961 window manager prompting. */
3962 SET_FRAME_COLS (f, DEFAULT_COLS);
3963 FRAME_LINES (f) = DEFAULT_ROWS;
3964 /* Window managers expect that if program-specified
3965 positions are not (0,0), they're intentional, not defaults. */
3966 f->top_pos = 0;
3967 f->left_pos = 0;
3968
3969 /* Ensure that old new_text_cols and new_text_lines will not override the
3970 values set here. */
3971 /* ++KFS: This was specific to W32, but seems ok for all platforms */
3972 f->new_text_cols = f->new_text_lines = 0;
3973
3974 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
3975 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
3976 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
3977 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3978 {
3979 if (!EQ (tem0, Qunbound))
3980 {
3981 CHECK_NUMBER (tem0);
3982 FRAME_LINES (f) = XINT (tem0);
3983 }
3984 if (!EQ (tem1, Qunbound))
3985 {
3986 CHECK_NUMBER (tem1);
3987 SET_FRAME_COLS (f, XINT (tem1));
3988 }
3989 if (!NILP (tem2) && !EQ (tem2, Qunbound))
3990 window_prompting |= USSize;
3991 else
3992 window_prompting |= PSize;
3993 }
3994
3995 f->scroll_bar_actual_width
3996 = FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f);
3997
3998 /* This used to be done _before_ calling x_figure_window_size, but
3999 since the height is reset here, this was really a no-op. I
4000 assume that moving it here does what Gerd intended (although he
4001 no longer can remember what that was... ++KFS, 2003-03-25. */
4002
4003 /* Add the tool-bar height to the initial frame height so that the
4004 user gets a text display area of the size he specified with -g or
4005 via .Xdefaults. Later changes of the tool-bar height don't
4006 change the frame size. This is done so that users can create
4007 tall Emacs frames without having to guess how tall the tool-bar
4008 will get. */
4009 if (toolbar_p && FRAME_TOOL_BAR_LINES (f))
4010 {
4011 int margin, relief, bar_height;
4012
4013 relief = (tool_bar_button_relief >= 0
4014 ? tool_bar_button_relief
4015 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
4016
4017 if (INTEGERP (Vtool_bar_button_margin)
4018 && XINT (Vtool_bar_button_margin) > 0)
4019 margin = XFASTINT (Vtool_bar_button_margin);
4020 else if (CONSP (Vtool_bar_button_margin)
4021 && INTEGERP (XCDR (Vtool_bar_button_margin))
4022 && XINT (XCDR (Vtool_bar_button_margin)) > 0)
4023 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
4024 else
4025 margin = 0;
4026
4027 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
4028 FRAME_LINES (f) += (bar_height + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f);
4029 }
4030
4031 compute_fringe_widths (f, 0);
4032
4033 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, FRAME_COLS (f));
4034 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, FRAME_LINES (f));
4035
4036 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
4037 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
4038 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
4039 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
4040 {
4041 if (EQ (tem0, Qminus))
4042 {
4043 f->top_pos = 0;
4044 window_prompting |= YNegative;
4045 }
4046 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
4047 && CONSP (XCDR (tem0))
4048 && INTEGERP (XCAR (XCDR (tem0))))
4049 {
4050 f->top_pos = - XINT (XCAR (XCDR (tem0)));
4051 window_prompting |= YNegative;
4052 }
4053 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
4054 && CONSP (XCDR (tem0))
4055 && INTEGERP (XCAR (XCDR (tem0))))
4056 {
4057 f->top_pos = XINT (XCAR (XCDR (tem0)));
4058 }
4059 else if (EQ (tem0, Qunbound))
4060 f->top_pos = 0;
4061 else
4062 {
4063 CHECK_NUMBER (tem0);
4064 f->top_pos = XINT (tem0);
4065 if (f->top_pos < 0)
4066 window_prompting |= YNegative;
4067 }
4068
4069 if (EQ (tem1, Qminus))
4070 {
4071 f->left_pos = 0;
4072 window_prompting |= XNegative;
4073 }
4074 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
4075 && CONSP (XCDR (tem1))
4076 && INTEGERP (XCAR (XCDR (tem1))))
4077 {
4078 f->left_pos = - XINT (XCAR (XCDR (tem1)));
4079 window_prompting |= XNegative;
4080 }
4081 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
4082 && CONSP (XCDR (tem1))
4083 && INTEGERP (XCAR (XCDR (tem1))))
4084 {
4085 f->left_pos = XINT (XCAR (XCDR (tem1)));
4086 }
4087 else if (EQ (tem1, Qunbound))
4088 f->left_pos = 0;
4089 else
4090 {
4091 CHECK_NUMBER (tem1);
4092 f->left_pos = XINT (tem1);
4093 if (f->left_pos < 0)
4094 window_prompting |= XNegative;
4095 }
4096
4097 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
4098 window_prompting |= USPosition;
4099 else
4100 window_prompting |= PPosition;
4101 }
4102
4103 if (f->want_fullscreen != FULLSCREEN_NONE)
4104 {
4105 int left, top;
4106 int width, height;
4107
4108 /* It takes both for some WM:s to place it where we want */
4109 window_prompting = USPosition | PPosition;
4110 x_fullscreen_adjust (f, &width, &height, &top, &left);
4111 FRAME_COLS (f) = width;
4112 FRAME_LINES (f) = height;
4113 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, width);
4114 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, height);
4115 f->left_pos = left;
4116 f->top_pos = top;
4117 }
4118
4119 if (window_prompting & XNegative)
4120 {
4121 if (window_prompting & YNegative)
4122 f->win_gravity = SouthEastGravity;
4123 else
4124 f->win_gravity = NorthEastGravity;
4125 }
4126 else
4127 {
4128 if (window_prompting & YNegative)
4129 f->win_gravity = SouthWestGravity;
4130 else
4131 f->win_gravity = NorthWestGravity;
4132 }
4133
4134 f->size_hint_flags = window_prompting;
4135
4136 return window_prompting;
4137 }
4138
4139
4140
4141 #endif /* HAVE_WINDOW_SYSTEM */
4142
4143
4144 \f
4145 /***********************************************************************
4146 Initialization
4147 ***********************************************************************/
4148
4149 void
4150 syms_of_frame ()
4151 {
4152 Qframep = intern ("framep");
4153 staticpro (&Qframep);
4154 Qframe_live_p = intern ("frame-live-p");
4155 staticpro (&Qframe_live_p);
4156 Qheight = intern ("height");
4157 staticpro (&Qheight);
4158 Qicon = intern ("icon");
4159 staticpro (&Qicon);
4160 Qminibuffer = intern ("minibuffer");
4161 staticpro (&Qminibuffer);
4162 Qmodeline = intern ("modeline");
4163 staticpro (&Qmodeline);
4164 Qonly = intern ("only");
4165 staticpro (&Qonly);
4166 Qwidth = intern ("width");
4167 staticpro (&Qwidth);
4168 Qgeometry = intern ("geometry");
4169 staticpro (&Qgeometry);
4170 Qicon_left = intern ("icon-left");
4171 staticpro (&Qicon_left);
4172 Qicon_top = intern ("icon-top");
4173 staticpro (&Qicon_top);
4174 Qleft = intern ("left");
4175 staticpro (&Qleft);
4176 Qright = intern ("right");
4177 staticpro (&Qright);
4178 Quser_position = intern ("user-position");
4179 staticpro (&Quser_position);
4180 Quser_size = intern ("user-size");
4181 staticpro (&Quser_size);
4182 Qwindow_id = intern ("window-id");
4183 staticpro (&Qwindow_id);
4184 #ifdef HAVE_X_WINDOWS
4185 Qouter_window_id = intern ("outer-window-id");
4186 staticpro (&Qouter_window_id);
4187 #endif
4188 Qparent_id = intern ("parent-id");
4189 staticpro (&Qparent_id);
4190 Qx = intern ("x");
4191 staticpro (&Qx);
4192 Qw32 = intern ("w32");
4193 staticpro (&Qw32);
4194 Qpc = intern ("pc");
4195 staticpro (&Qpc);
4196 Qmac = intern ("mac");
4197 staticpro (&Qmac);
4198 Qvisible = intern ("visible");
4199 staticpro (&Qvisible);
4200 Qbuffer_predicate = intern ("buffer-predicate");
4201 staticpro (&Qbuffer_predicate);
4202 Qbuffer_list = intern ("buffer-list");
4203 staticpro (&Qbuffer_list);
4204 Qdisplay_type = intern ("display-type");
4205 staticpro (&Qdisplay_type);
4206 Qbackground_mode = intern ("background-mode");
4207 staticpro (&Qbackground_mode);
4208 Qtty_color_mode = intern ("tty-color-mode");
4209 staticpro (&Qtty_color_mode);
4210 Qtty = intern ("tty");
4211 staticpro (&Qtty);
4212 Qtty_type = intern ("tty-type");
4213 staticpro (&Qtty_type);
4214 Qwindow_system = intern ("window-system");
4215 staticpro (&Qwindow_system);
4216
4217 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
4218 staticpro (&Qface_set_after_frame_default);
4219
4220 Qfullwidth = intern ("fullwidth");
4221 staticpro (&Qfullwidth);
4222 Qfullheight = intern ("fullheight");
4223 staticpro (&Qfullheight);
4224 Qfullboth = intern ("fullboth");
4225 staticpro (&Qfullboth);
4226 Qx_resource_name = intern ("x-resource-name");
4227 staticpro (&Qx_resource_name);
4228
4229 Qx_frame_parameter = intern ("x-frame-parameter");
4230 staticpro (&Qx_frame_parameter);
4231
4232 Qdisplay_id = intern ("display-id");
4233 staticpro (&Qdisplay_id);
4234 Qdisplay_live_p = intern ("display-live-p");
4235 staticpro (&Qdisplay_live_p);
4236
4237 {
4238 int i;
4239
4240 for (i = 0; i < sizeof (frame_parms) / sizeof (frame_parms[0]); i++)
4241 {
4242 Lisp_Object v = intern (frame_parms[i].name);
4243 if (frame_parms[i].variable)
4244 {
4245 *frame_parms[i].variable = v;
4246 staticpro (frame_parms[i].variable);
4247 }
4248 Fput (v, Qx_frame_parameter, make_number (i));
4249 }
4250 }
4251
4252 #ifdef HAVE_WINDOW_SYSTEM
4253 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
4254 doc: /* The name Emacs uses to look up X resources.
4255 `x-get-resource' uses this as the first component of the instance name
4256 when requesting resource values.
4257 Emacs initially sets `x-resource-name' to the name under which Emacs
4258 was invoked, or to the value specified with the `-name' or `-rn'
4259 switches, if present.
4260
4261 It may be useful to bind this variable locally around a call
4262 to `x-get-resource'. See also the variable `x-resource-class'. */);
4263 Vx_resource_name = Qnil;
4264
4265 DEFVAR_LISP ("x-resource-class", &Vx_resource_class,
4266 doc: /* The class Emacs uses to look up X resources.
4267 `x-get-resource' uses this as the first component of the instance class
4268 when requesting resource values.
4269
4270 Emacs initially sets `x-resource-class' to "Emacs".
4271
4272 Setting this variable permanently is not a reasonable thing to do,
4273 but binding this variable locally around a call to `x-get-resource'
4274 is a reasonable practice. See also the variable `x-resource-name'. */);
4275 Vx_resource_class = build_string (EMACS_CLASS);
4276 #endif
4277
4278 DEFVAR_LISP ("default-frame-alist", &Vdefault_frame_alist,
4279 doc: /* Alist of default values for frame creation.
4280 These may be set in your init file, like this:
4281 (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1)))
4282 These override values given in window system configuration data,
4283 including X Windows' defaults database.
4284 For values specific to the first Emacs frame, see `initial-frame-alist'.
4285 For values specific to the separate minibuffer frame, see
4286 `minibuffer-frame-alist'.
4287 The `menu-bar-lines' element of the list controls whether new frames
4288 have menu bars; `menu-bar-mode' works by altering this element.
4289 Setting this variable does not affect existing frames, only new ones. */);
4290 Vdefault_frame_alist = Qnil;
4291
4292 DEFVAR_LISP ("default-frame-scroll-bars", &Vdefault_frame_scroll_bars,
4293 doc: /* Default position of scroll bars on this window-system. */);
4294 #ifdef HAVE_WINDOW_SYSTEM
4295 #if defined(HAVE_NTGUI) || defined(MAC_OS)
4296 /* MS-Windows has scroll bars on the right by default. */
4297 Vdefault_frame_scroll_bars = Qright;
4298 #else
4299 Vdefault_frame_scroll_bars = Qleft;
4300 #endif
4301 #else
4302 Vdefault_frame_scroll_bars = Qnil;
4303 #endif
4304
4305 Qinhibit_default_face_x_resources
4306 = intern ("inhibit-default-face-x-resources");
4307 staticpro (&Qinhibit_default_face_x_resources);
4308
4309 DEFVAR_LISP ("terminal-frame", &Vterminal_frame,
4310 doc: /* The initial frame-object, which represents Emacs's stdout. */);
4311
4312 DEFVAR_LISP ("emacs-iconified", &Vemacs_iconified,
4313 doc: /* Non-nil if all of emacs is iconified and frame updates are not needed. */);
4314 Vemacs_iconified = Qnil;
4315
4316 DEFVAR_LISP ("mouse-position-function", &Vmouse_position_function,
4317 doc: /* If non-nil, function to transform normal value of `mouse-position'.
4318 `mouse-position' calls this function, passing its usual return value as
4319 argument, and returns whatever this function returns.
4320 This abnormal hook exists for the benefit of packages like `xt-mouse.el'
4321 which need to do mouse handling at the Lisp level. */);
4322 Vmouse_position_function = Qnil;
4323
4324 DEFVAR_LISP ("mouse-highlight", &Vmouse_highlight,
4325 doc: /* If non-nil, clickable text is highlighted when mouse is over it.
4326 If the value is an integer, highlighting is only shown after moving the
4327 mouse, while keyboard input turns off the highlight even when the mouse
4328 is over the clickable text. However, the mouse shape still indicates
4329 when the mouse is over clickable text. */);
4330 Vmouse_highlight = Qt;
4331
4332 DEFVAR_LISP ("delete-frame-functions", &Vdelete_frame_functions,
4333 doc: /* Functions to be run before deleting a frame.
4334 The functions are run with one arg, the frame to be deleted.
4335 See `delete-frame'. */);
4336 Vdelete_frame_functions = Qnil;
4337
4338 DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
4339 doc: /* Minibufferless frames use this frame's minibuffer.
4340
4341 Emacs cannot create minibufferless frames unless this is set to an
4342 appropriate surrogate.
4343
4344 Emacs consults this variable only when creating minibufferless
4345 frames; once the frame is created, it sticks with its assigned
4346 minibuffer, no matter what this variable is set to. This means that
4347 this variable doesn't necessarily say anything meaningful about the
4348 current set of frames, or where the minibuffer is currently being
4349 displayed.
4350
4351 This variable is local to the current terminal and cannot be buffer-local. */);
4352
4353 staticpro (&Vframe_list);
4354
4355 defsubr (&Sactive_minibuffer_window);
4356 defsubr (&Sframep);
4357 defsubr (&Sframe_live_p);
4358 defsubr (&Swindow_system);
4359 defsubr (&Smake_terminal_frame);
4360 defsubr (&Shandle_switch_frame);
4361 defsubr (&Signore_event);
4362 defsubr (&Sselect_frame);
4363 defsubr (&Sselected_frame);
4364 defsubr (&Swindow_frame);
4365 defsubr (&Sframe_root_window);
4366 defsubr (&Sframe_first_window);
4367 defsubr (&Sframe_selected_window);
4368 defsubr (&Sset_frame_selected_window);
4369 defsubr (&Sframe_display);
4370 defsubr (&Sframe_list);
4371 defsubr (&Snext_frame);
4372 defsubr (&Sprevious_frame);
4373 defsubr (&Sdelete_frame);
4374 defsubr (&Smouse_position);
4375 defsubr (&Smouse_pixel_position);
4376 defsubr (&Sset_mouse_position);
4377 defsubr (&Sset_mouse_pixel_position);
4378 #if 0
4379 defsubr (&Sframe_configuration);
4380 defsubr (&Srestore_frame_configuration);
4381 #endif
4382 defsubr (&Smake_frame_visible);
4383 defsubr (&Smake_frame_invisible);
4384 defsubr (&Siconify_frame);
4385 defsubr (&Sframe_visible_p);
4386 defsubr (&Svisible_frame_list);
4387 defsubr (&Sraise_frame);
4388 defsubr (&Slower_frame);
4389 defsubr (&Sredirect_frame_focus);
4390 defsubr (&Sframe_focus);
4391 defsubr (&Sframe_parameters);
4392 defsubr (&Sframe_parameter);
4393 defsubr (&Smodify_frame_parameters);
4394 defsubr (&Sframe_char_height);
4395 defsubr (&Sframe_char_width);
4396 defsubr (&Sframe_pixel_height);
4397 defsubr (&Sframe_pixel_width);
4398 defsubr (&Sset_frame_height);
4399 defsubr (&Sset_frame_width);
4400 defsubr (&Sset_frame_size);
4401 defsubr (&Sset_frame_position);
4402
4403 #ifdef HAVE_WINDOW_SYSTEM
4404 defsubr (&Sx_get_resource);
4405 defsubr (&Sx_parse_geometry);
4406 #endif
4407
4408 }
4409
4410 /* arch-tag: 7dbf2c69-9aad-45f8-8296-db893d6dd039
4411 (do not change this comment) */