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