Initial check-in: changes for building Emacs under Mac OS.
[bpt/emacs.git] / src / frame.c
1 /* Generic frame functions.
2 Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000 Free Software Foundation.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21 #include <config.h>
22
23 #include <stdio.h>
24 #include "lisp.h"
25 #include "charset.h"
26 #ifdef HAVE_X_WINDOWS
27 #include "xterm.h"
28 #endif
29 #ifdef WINDOWSNT
30 #include "w32term.h"
31 #endif
32 #ifdef macintosh
33 #include "macterm.h"
34 #endif
35 #include "buffer.h"
36 /* These help us bind and responding to switch-frame events. */
37 #include "commands.h"
38 #include "keyboard.h"
39 #include "frame.h"
40 #ifdef HAVE_WINDOW_SYSTEM
41 #include "fontset.h"
42 #endif
43 #include "termhooks.h"
44 #include "dispextern.h"
45 #include "window.h"
46 #ifdef MSDOS
47 #include "msdos.h"
48 #include "dosfns.h"
49 #endif
50
51 /* Evaluate this expression to rebuild the section of syms_of_frame
52 that initializes and staticpros the symbols declared below. Note
53 that Emacs 18 has a bug that keeps C-x C-e from being able to
54 evaluate this expression.
55
56 (progn
57 ;; Accumulate a list of the symbols we want to initialize from the
58 ;; declarations at the top of the file.
59 (goto-char (point-min))
60 (search-forward "/\*&&& symbols declared here &&&*\/\n")
61 (let (symbol-list)
62 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
63 (setq symbol-list
64 (cons (buffer-substring (match-beginning 1) (match-end 1))
65 symbol-list))
66 (forward-line 1))
67 (setq symbol-list (nreverse symbol-list))
68 ;; Delete the section of syms_of_... where we initialize the symbols.
69 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
70 (let ((start (point)))
71 (while (looking-at "^ Q")
72 (forward-line 2))
73 (kill-region start (point)))
74 ;; Write a new symbol initialization section.
75 (while symbol-list
76 (insert (format " %s = intern (\"" (car symbol-list)))
77 (let ((start (point)))
78 (insert (substring (car symbol-list) 1))
79 (subst-char-in-region start (point) ?_ ?-))
80 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
81 (setq symbol-list (cdr symbol-list)))))
82 */
83
84 /*&&& symbols declared here &&&*/
85 Lisp_Object Qframep;
86 Lisp_Object Qframe_live_p;
87 Lisp_Object Qheight;
88 Lisp_Object Qicon;
89 Lisp_Object Qminibuffer;
90 Lisp_Object Qmodeline;
91 Lisp_Object Qname;
92 Lisp_Object Qonly;
93 Lisp_Object Qunsplittable;
94 Lisp_Object Qmenu_bar_lines;
95 Lisp_Object Qtool_bar_lines;
96 Lisp_Object Qwidth;
97 Lisp_Object Qx;
98 Lisp_Object Qw32;
99 Lisp_Object Qpc;
100 Lisp_Object Qmac;
101 Lisp_Object Qvisible;
102 Lisp_Object Qbuffer_predicate;
103 Lisp_Object Qbuffer_list;
104 Lisp_Object Qtitle;
105 Lisp_Object Qdisplay_type;
106 Lisp_Object Qbackground_mode;
107
108 Lisp_Object Vterminal_frame;
109 Lisp_Object Vdefault_frame_alist;
110 Lisp_Object Vmouse_position_function;
111
112 static void
113 syms_of_frame_1 ()
114 {
115 /*&&& init symbols here &&&*/
116 Qframep = intern ("framep");
117 staticpro (&Qframep);
118 Qframe_live_p = intern ("frame-live-p");
119 staticpro (&Qframe_live_p);
120 Qheight = intern ("height");
121 staticpro (&Qheight);
122 Qicon = intern ("icon");
123 staticpro (&Qicon);
124 Qminibuffer = intern ("minibuffer");
125 staticpro (&Qminibuffer);
126 Qmodeline = intern ("modeline");
127 staticpro (&Qmodeline);
128 Qname = intern ("name");
129 staticpro (&Qname);
130 Qonly = intern ("only");
131 staticpro (&Qonly);
132 Qunsplittable = intern ("unsplittable");
133 staticpro (&Qunsplittable);
134 Qmenu_bar_lines = intern ("menu-bar-lines");
135 staticpro (&Qmenu_bar_lines);
136 Qtool_bar_lines = intern ("tool-bar-lines");
137 staticpro (&Qtool_bar_lines);
138 Qwidth = intern ("width");
139 staticpro (&Qwidth);
140 Qx = intern ("x");
141 staticpro (&Qx);
142 Qw32 = intern ("w32");
143 staticpro (&Qw32);
144 Qpc = intern ("pc");
145 staticpro (&Qpc);
146 Qmac = intern ("mac");
147 staticpro (&Qmac);
148 Qvisible = intern ("visible");
149 staticpro (&Qvisible);
150 Qbuffer_predicate = intern ("buffer-predicate");
151 staticpro (&Qbuffer_predicate);
152 Qbuffer_list = intern ("buffer-list");
153 staticpro (&Qbuffer_list);
154 Qtitle = intern ("title");
155 staticpro (&Qtitle);
156 Qdisplay_type = intern ("display-type");
157 staticpro (&Qdisplay_type);
158 Qbackground_mode = intern ("background-mode");
159 staticpro (&Qbackground_mode);
160
161 DEFVAR_LISP ("default-frame-alist", &Vdefault_frame_alist,
162 "Alist of default values for frame creation.\n\
163 These may be set in your init file, like this:\n\
164 (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1))\n\
165 These override values given in window system configuration data,\n\
166 including X Windows' defaults database.\n\
167 For values specific to the first Emacs frame, see `initial-frame-alist'.\n\
168 For values specific to the separate minibuffer frame, see\n\
169 `minibuffer-frame-alist'.\n\
170 The `menu-bar-lines' element of the list controls whether new frames\n\
171 have menu bars; `menu-bar-mode' works by altering this element.");
172 Vdefault_frame_alist = Qnil;
173 }
174 \f
175 static void
176 set_menu_bar_lines_1 (window, n)
177 Lisp_Object window;
178 int n;
179 {
180 struct window *w = XWINDOW (window);
181
182 XSETFASTINT (w->last_modified, 0);
183 XSETFASTINT (w->top, XFASTINT (w->top) + n);
184 XSETFASTINT (w->height, XFASTINT (w->height) - n);
185
186 if (INTEGERP (w->orig_top))
187 XSETFASTINT (w->orig_top, XFASTINT (w->orig_top) + n);
188 if (INTEGERP (w->orig_height))
189 XSETFASTINT (w->orig_height, XFASTINT (w->orig_height) - n);
190
191 /* Handle just the top child in a vertical split. */
192 if (!NILP (w->vchild))
193 set_menu_bar_lines_1 (w->vchild, n);
194
195 /* Adjust all children in a horizontal split. */
196 for (window = w->hchild; !NILP (window); window = w->next)
197 {
198 w = XWINDOW (window);
199 set_menu_bar_lines_1 (window, n);
200 }
201 }
202
203 void
204 set_menu_bar_lines (f, value, oldval)
205 struct frame *f;
206 Lisp_Object value, oldval;
207 {
208 int nlines;
209 int olines = FRAME_MENU_BAR_LINES (f);
210
211 /* Right now, menu bars don't work properly in minibuf-only frames;
212 most of the commands try to apply themselves to the minibuffer
213 frame itself, and get an error because you can't switch buffers
214 in or split the minibuffer window. */
215 if (FRAME_MINIBUF_ONLY_P (f))
216 return;
217
218 if (INTEGERP (value))
219 nlines = XINT (value);
220 else
221 nlines = 0;
222
223 if (nlines != olines)
224 {
225 windows_or_buffers_changed++;
226 FRAME_WINDOW_SIZES_CHANGED (f) = 1;
227 FRAME_MENU_BAR_LINES (f) = nlines;
228 set_menu_bar_lines_1 (f->root_window, nlines - olines);
229 adjust_glyphs (f);
230 }
231 }
232 \f
233 Lisp_Object Vemacs_iconified;
234 Lisp_Object Vframe_list;
235
236 struct x_output tty_display;
237
238 extern Lisp_Object Vminibuffer_list;
239 extern Lisp_Object get_minibuffer ();
240 extern Lisp_Object Fhandle_switch_frame ();
241 extern Lisp_Object Fredirect_frame_focus ();
242 extern Lisp_Object x_get_focus_frame ();
243 \f
244 DEFUN ("framep", Fframep, Sframep, 1, 1, 0,
245 "Return non-nil if OBJECT is a frame.\n\
246 Value is t for a termcap frame (a character-only terminal),\n\
247 `x' for an Emacs frame that is really an X window,\n\
248 `w32' for an Emacs frame that is a window on MS-Windows display,\n\
249 `mac' for an Emacs frame on a Macintosh display,\n\
250 `pc' for a direct-write MS-DOS frame.\n\
251 See also `frame-live-p'.")
252 (object)
253 Lisp_Object object;
254 {
255 if (!FRAMEP (object))
256 return Qnil;
257 switch (XFRAME (object)->output_method)
258 {
259 case output_termcap:
260 return Qt;
261 case output_x_window:
262 return Qx;
263 case output_w32:
264 return Qw32;
265 case output_msdos_raw:
266 return Qpc;
267 case output_mac:
268 return Qmac;
269 default:
270 abort ();
271 }
272 }
273
274 DEFUN ("frame-live-p", Fframe_live_p, Sframe_live_p, 1, 1, 0,
275 "Return non-nil if OBJECT is a frame which has not been deleted.\n\
276 Value is nil if OBJECT is not a live frame. If object is a live\n\
277 frame, the return value indicates what sort of output device it is\n\
278 displayed on. Value is t for a termcap frame (a character-only\n\
279 terminal), `x' for an Emacs frame being displayed in an X window.")
280 (object)
281 Lisp_Object object;
282 {
283 return ((FRAMEP (object)
284 && FRAME_LIVE_P (XFRAME (object)))
285 ? Fframep (object)
286 : Qnil);
287 }
288
289 struct frame *
290 make_frame (mini_p)
291 int mini_p;
292 {
293 Lisp_Object frame;
294 register struct frame *f;
295 register Lisp_Object root_window;
296 register Lisp_Object mini_window;
297 register struct Lisp_Vector *vec;
298 int i;
299
300 vec = allocate_vectorlike ((EMACS_INT) VECSIZE (struct frame));
301 for (i = 0; i < VECSIZE (struct frame); i++)
302 XSETFASTINT (vec->contents[i], 0);
303 vec->size = VECSIZE (struct frame);
304 f = (struct frame *)vec;
305 XSETFRAME (frame, f);
306
307 f->desired_matrix = 0;
308 f->current_matrix = 0;
309 f->desired_pool = 0;
310 f->current_pool = 0;
311 f->glyphs_initialized_p = 0;
312 f->decode_mode_spec_buffer = 0;
313 f->visible = 0;
314 f->async_visible = 0;
315 f->output_data.nothing = 0;
316 f->iconified = 0;
317 f->async_iconified = 0;
318 f->wants_modeline = 1;
319 f->auto_raise = 0;
320 f->auto_lower = 0;
321 f->no_split = 0;
322 f->garbaged = 1;
323 f->has_minibuffer = mini_p;
324 f->focus_frame = Qnil;
325 f->explicit_name = 0;
326 f->can_have_scroll_bars = 0;
327 f->vertical_scroll_bar_type = vertical_scroll_bar_none;
328 f->param_alist = Qnil;
329 f->scroll_bars = Qnil;
330 f->condemned_scroll_bars = Qnil;
331 f->face_alist = Qnil;
332 f->face_cache = NULL;
333 f->menu_bar_items = Qnil;
334 f->menu_bar_vector = Qnil;
335 f->menu_bar_items_used = 0;
336 f->buffer_predicate = Qnil;
337 f->buffer_list = Qnil;
338 #ifdef MULTI_KBOARD
339 f->kboard = initial_kboard;
340 #endif
341 f->namebuf = 0;
342 f->title = Qnil;
343 f->menu_bar_window = Qnil;
344 f->tool_bar_window = Qnil;
345 f->desired_tool_bar_items = f->current_tool_bar_items = Qnil;
346 f->desired_tool_bar_string = f->current_tool_bar_string = Qnil;
347 f->n_desired_tool_bar_items = f->n_current_tool_bar_items = 0;
348
349 root_window = make_window ();
350 if (mini_p)
351 {
352 mini_window = make_window ();
353 XWINDOW (root_window)->next = mini_window;
354 XWINDOW (mini_window)->prev = root_window;
355 XWINDOW (mini_window)->mini_p = Qt;
356 XWINDOW (mini_window)->frame = frame;
357 f->minibuffer_window = mini_window;
358 }
359 else
360 {
361 mini_window = Qnil;
362 XWINDOW (root_window)->next = Qnil;
363 f->minibuffer_window = Qnil;
364 }
365
366 XWINDOW (root_window)->frame = frame;
367
368 /* 10 is arbitrary,
369 just so that there is "something there."
370 Correct size will be set up later with change_frame_size. */
371
372 SET_FRAME_WIDTH (f, 10);
373 f->height = 10;
374
375 XSETFASTINT (XWINDOW (root_window)->width, 10);
376 XSETFASTINT (XWINDOW (root_window)->height, (mini_p ? 9 : 10));
377
378 if (mini_p)
379 {
380 XSETFASTINT (XWINDOW (mini_window)->width, 10);
381 XSETFASTINT (XWINDOW (mini_window)->top, 9);
382 XSETFASTINT (XWINDOW (mini_window)->height, 1);
383 }
384
385 /* Choose a buffer for the frame's root window. */
386 {
387 Lisp_Object buf;
388
389 XWINDOW (root_window)->buffer = Qt;
390 buf = Fcurrent_buffer ();
391 /* If buf is a 'hidden' buffer (i.e. one whose name starts with
392 a space), try to find another one. */
393 if (XSTRING (Fbuffer_name (buf))->data[0] == ' ')
394 buf = Fother_buffer (buf, Qnil, Qnil);
395
396 /* Use set_window_buffer, not Fset_window_buffer, and don't let
397 hooks be run by it. The reason is that the whole frame/window
398 arrangement is not yet fully intialized at this point. Windows
399 don't have the right size, glyph matrices aren't initialized
400 etc. Running Lisp functions at this point surely ends in a
401 SEGV. */
402 set_window_buffer (root_window, buf, 0);
403 f->buffer_list = Fcons (buf, Qnil);
404 }
405
406 if (mini_p)
407 {
408 XWINDOW (mini_window)->buffer = Qt;
409 set_window_buffer (mini_window,
410 (NILP (Vminibuffer_list)
411 ? get_minibuffer (0)
412 : Fcar (Vminibuffer_list)),
413 0);
414 }
415
416 f->root_window = root_window;
417 f->selected_window = root_window;
418 /* Make sure this window seems more recently used than
419 a newly-created, never-selected window. */
420 XSETFASTINT (XWINDOW (f->selected_window)->use_time, ++window_select_count);
421
422 return f;
423 }
424 \f
425 #ifdef HAVE_WINDOW_SYSTEM
426 /* Make a frame using a separate minibuffer window on another frame.
427 MINI_WINDOW is the minibuffer window to use. nil means use the
428 default (the global minibuffer). */
429
430 struct frame *
431 make_frame_without_minibuffer (mini_window, kb, display)
432 register Lisp_Object mini_window;
433 KBOARD *kb;
434 Lisp_Object display;
435 {
436 register struct frame *f;
437 struct gcpro gcpro1;
438
439 if (!NILP (mini_window))
440 CHECK_LIVE_WINDOW (mini_window, 0);
441
442 #ifdef MULTI_KBOARD
443 if (!NILP (mini_window)
444 && XFRAME (XWINDOW (mini_window)->frame)->kboard != kb)
445 error ("frame and minibuffer must be on the same display");
446 #endif
447
448 /* Make a frame containing just a root window. */
449 f = make_frame (0);
450
451 if (NILP (mini_window))
452 {
453 /* Use default-minibuffer-frame if possible. */
454 if (!FRAMEP (kb->Vdefault_minibuffer_frame)
455 || ! FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame)))
456 {
457 Lisp_Object frame_dummy;
458
459 XSETFRAME (frame_dummy, f);
460 GCPRO1 (frame_dummy);
461 /* If there's no minibuffer frame to use, create one. */
462 kb->Vdefault_minibuffer_frame =
463 call1 (intern ("make-initial-minibuffer-frame"), display);
464 UNGCPRO;
465 }
466
467 mini_window = XFRAME (kb->Vdefault_minibuffer_frame)->minibuffer_window;
468 }
469
470 f->minibuffer_window = mini_window;
471
472 /* Make the chosen minibuffer window display the proper minibuffer,
473 unless it is already showing a minibuffer. */
474 if (NILP (Fmemq (XWINDOW (mini_window)->buffer, Vminibuffer_list)))
475 Fset_window_buffer (mini_window,
476 (NILP (Vminibuffer_list)
477 ? get_minibuffer (0)
478 : Fcar (Vminibuffer_list)));
479 return f;
480 }
481
482 /* Make a frame containing only a minibuffer window. */
483
484 struct frame *
485 make_minibuffer_frame ()
486 {
487 /* First make a frame containing just a root window, no minibuffer. */
488
489 register struct frame *f = make_frame (0);
490 register Lisp_Object mini_window;
491 register Lisp_Object frame;
492
493 XSETFRAME (frame, f);
494
495 f->auto_raise = 0;
496 f->auto_lower = 0;
497 f->no_split = 1;
498 f->wants_modeline = 0;
499 f->has_minibuffer = 1;
500
501 /* Now label the root window as also being the minibuffer.
502 Avoid infinite looping on the window chain by marking next pointer
503 as nil. */
504
505 mini_window = f->minibuffer_window = f->root_window;
506 XWINDOW (mini_window)->mini_p = Qt;
507 XWINDOW (mini_window)->next = Qnil;
508 XWINDOW (mini_window)->prev = Qnil;
509 XWINDOW (mini_window)->frame = frame;
510
511 /* Put the proper buffer in that window. */
512
513 Fset_window_buffer (mini_window,
514 (NILP (Vminibuffer_list)
515 ? get_minibuffer (0)
516 : Fcar (Vminibuffer_list)));
517 return f;
518 }
519 #endif /* HAVE_WINDOW_SYSTEM */
520 \f
521 /* Construct a frame that refers to the terminal (stdin and stdout). */
522
523 static int terminal_frame_count;
524
525 struct frame *
526 make_terminal_frame ()
527 {
528 register struct frame *f;
529 Lisp_Object frame;
530 char name[20];
531
532 #ifdef MULTI_KBOARD
533 if (!initial_kboard)
534 {
535 initial_kboard = (KBOARD *) xmalloc (sizeof (KBOARD));
536 init_kboard (initial_kboard);
537 initial_kboard->next_kboard = all_kboards;
538 all_kboards = initial_kboard;
539 }
540 #endif
541
542 /* The first call must initialize Vframe_list. */
543 if (! (NILP (Vframe_list) || CONSP (Vframe_list)))
544 Vframe_list = Qnil;
545
546 f = make_frame (1);
547
548 XSETFRAME (frame, f);
549 Vframe_list = Fcons (frame, Vframe_list);
550
551 terminal_frame_count++;
552 sprintf (name, "F%d", terminal_frame_count);
553 f->name = build_string (name);
554
555 f->visible = 1; /* FRAME_SET_VISIBLE wd set frame_garbaged. */
556 f->async_visible = 1; /* Don't let visible be cleared later. */
557 #ifdef MSDOS
558 f->output_data.x = &the_only_x_display;
559 if (!inhibit_window_system
560 && (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame))
561 || XFRAME (selected_frame)->output_method == output_msdos_raw))
562 {
563 f->output_method = output_msdos_raw;
564 /* This initialization of foreground and background pixels is
565 only important for the initial frame created in temacs. If
566 we don't do that, we get black background and foreground in
567 the dumped Emacs because the_only_x_display is a static
568 variable, hence it is born all-zeroes, and zero is the code
569 for the black color. Other frames all inherit their pixels
570 from what's already in the_only_x_display. */
571 if ((!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
572 && f->output_data.x->background_pixel == 0
573 && f->output_data.x->foreground_pixel == 0)
574 {
575 f->output_data.x->background_pixel = FACE_TTY_DEFAULT_BG_COLOR;
576 f->output_data.x->foreground_pixel = FACE_TTY_DEFAULT_FG_COLOR;
577 }
578 }
579 else
580 f->output_method = output_termcap;
581 #else
582 #ifdef macintosh
583 make_mac_terminal_frame (f);
584 #else
585 f->output_data.x = &tty_display;
586 #endif /* macintosh */
587 #endif /* MSDOS */
588
589 if (!noninteractive)
590 init_frame_faces (f);
591
592 return f;
593 }
594
595 DEFUN ("make-terminal-frame", Fmake_terminal_frame, Smake_terminal_frame,
596 1, 1, 0, "Create an additional terminal frame.\n\
597 You can create multiple frames on a text-only terminal in this way.\n\
598 Only the selected terminal frame is actually displayed.\n\
599 This function takes one argument, an alist specifying frame parameters.\n\
600 In practice, generally you don't need to specify any parameters.\n\
601 Note that changing the size of one terminal frame automatically affects all.")
602 (parms)
603 Lisp_Object parms;
604 {
605 struct frame *f;
606 Lisp_Object frame, tem;
607 struct frame *sf = SELECTED_FRAME ();
608
609 #ifdef MSDOS
610 if (sf->output_method != output_msdos_raw
611 && sf->output_method != output_termcap)
612 abort ();
613 #else /* not MSDOS */
614
615 #ifdef macintosh
616 if (sf->output_method != output_mac)
617 error ("Not running on a Macintosh screen; cannot make a new Macintosh frame");
618 #else
619 if (sf->output_method != output_termcap)
620 error ("Not using an ASCII terminal now; cannot make a new ASCII frame");
621 #endif
622 #endif /* not MSDOS */
623
624 f = make_terminal_frame ();
625
626 change_frame_size (f, FRAME_HEIGHT (sf),
627 FRAME_WIDTH (sf), 0, 0, 0);
628 adjust_glyphs (f);
629 calculate_costs (f);
630 XSETFRAME (frame, f);
631 Fmodify_frame_parameters (frame, Vdefault_frame_alist);
632 Fmodify_frame_parameters (frame, parms);
633
634 /* Make the frame face alist be frame-specific, so that each
635 frame could change its face definitions independently. */
636 f->face_alist = Fcopy_alist (sf->face_alist);
637 /* Simple Fcopy_alist isn't enough, because we need the contents of
638 the vectors which are the CDRs of associations in face_alist to
639 be copied as well. */
640 for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem))
641 XCDR (XCAR (tem)) = Fcopy_sequence (XCDR (XCAR (tem)));
642 return frame;
643 }
644 \f
645 Lisp_Object
646 do_switch_frame (frame, no_enter, track)
647 Lisp_Object frame, no_enter;
648 int track;
649 {
650 struct frame *sf = SELECTED_FRAME ();
651
652 /* If FRAME is a switch-frame event, extract the frame we should
653 switch to. */
654 if (CONSP (frame)
655 && EQ (XCAR (frame), Qswitch_frame)
656 && CONSP (XCDR (frame)))
657 frame = XCAR (XCDR (frame));
658
659 /* This used to say CHECK_LIVE_FRAME, but apparently it's possible for
660 a switch-frame event to arrive after a frame is no longer live,
661 especially when deleting the initial frame during startup. */
662 CHECK_FRAME (frame, 0);
663 if (! FRAME_LIVE_P (XFRAME (frame)))
664 return Qnil;
665
666 if (sf == XFRAME (frame))
667 return frame;
668
669 /* This is too greedy; it causes inappropriate focus redirection
670 that's hard to get rid of. */
671 #if 0
672 /* If a frame's focus has been redirected toward the currently
673 selected frame, we should change the redirection to point to the
674 newly selected frame. This means that if the focus is redirected
675 from a minibufferless frame to a surrogate minibuffer frame, we
676 can use `other-window' to switch between all the frames using
677 that minibuffer frame, and the focus redirection will follow us
678 around. */
679 if (track)
680 {
681 Lisp_Object tail;
682
683 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
684 {
685 Lisp_Object focus;
686
687 if (!FRAMEP (XCAR (tail)))
688 abort ();
689
690 focus = FRAME_FOCUS_FRAME (XFRAME (XCAR (tail)));
691
692 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
693 Fredirect_frame_focus (XCAR (tail), frame);
694 }
695 }
696 #else /* ! 0 */
697 /* Instead, apply it only to the frame we're pointing to. */
698 #ifdef HAVE_WINDOW_SYSTEM
699 if (track && (FRAME_WINDOW_P (XFRAME (frame))))
700 {
701 Lisp_Object focus, xfocus;
702
703 xfocus = x_get_focus_frame (XFRAME (frame));
704 if (FRAMEP (xfocus))
705 {
706 focus = FRAME_FOCUS_FRAME (XFRAME (xfocus));
707 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
708 Fredirect_frame_focus (xfocus, frame);
709 }
710 }
711 #endif /* HAVE_X_WINDOWS */
712 #endif /* ! 0 */
713
714 selected_frame = frame;
715 if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
716 last_nonminibuf_frame = XFRAME (selected_frame);
717
718 Fselect_window (XFRAME (frame)->selected_window);
719
720 /* We want to make sure that the next event generates a frame-switch
721 event to the appropriate frame. This seems kludgy to me, but
722 before you take it out, make sure that evaluating something like
723 (select-window (frame-root-window (new-frame))) doesn't end up
724 with your typing being interpreted in the new frame instead of
725 the one you're actually typing in. */
726 internal_last_event_frame = Qnil;
727
728 return frame;
729 }
730
731 DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 2, "e",
732 "Select the frame FRAME.\n\
733 Subsequent editing commands apply to its selected window.\n\
734 The selection of FRAME lasts until the next time the user does\n\
735 something to select a different frame, or until the next time this\n\
736 function is called.")
737 (frame, no_enter)
738 Lisp_Object frame, no_enter;
739 {
740 return do_switch_frame (frame, no_enter, 1);
741 }
742
743
744 DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 2, "e",
745 "Handle a switch-frame event EVENT.\n\
746 Switch-frame events are usually bound to this function.\n\
747 A switch-frame event tells Emacs that the window manager has requested\n\
748 that the user's events be directed to the frame mentioned in the event.\n\
749 This function selects the selected window of the frame of EVENT.\n\
750 \n\
751 If EVENT is frame object, handle it as if it were a switch-frame event\n\
752 to that frame.")
753 (event, no_enter)
754 Lisp_Object event, no_enter;
755 {
756 /* Preserve prefix arg that the command loop just cleared. */
757 current_kboard->Vprefix_arg = Vcurrent_prefix_arg;
758 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
759 return do_switch_frame (event, no_enter, 0);
760 }
761
762 DEFUN ("ignore-event", Fignore_event, Signore_event, 0, 0, "",
763 "Do nothing, but preserve any prefix argument already specified.\n\
764 This is a suitable binding for iconify-frame and make-frame-visible.")
765 ()
766 {
767 current_kboard->Vprefix_arg = Vcurrent_prefix_arg;
768 return Qnil;
769 }
770
771 DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0,
772 "Return the frame that is now selected.")
773 ()
774 {
775 return selected_frame;
776 }
777 \f
778 DEFUN ("window-frame", Fwindow_frame, Swindow_frame, 1, 1, 0,
779 "Return the frame object that window WINDOW is on.")
780 (window)
781 Lisp_Object window;
782 {
783 CHECK_LIVE_WINDOW (window, 0);
784 return XWINDOW (window)->frame;
785 }
786
787 DEFUN ("frame-first-window", Fframe_first_window, Sframe_first_window, 0, 1, 0,
788 "Returns the topmost, leftmost window of FRAME.\n\
789 If omitted, FRAME defaults to the currently selected frame.")
790 (frame)
791 Lisp_Object frame;
792 {
793 Lisp_Object w;
794
795 if (NILP (frame))
796 w = SELECTED_FRAME ()->root_window;
797 else
798 {
799 CHECK_LIVE_FRAME (frame, 0);
800 w = XFRAME (frame)->root_window;
801 }
802 while (NILP (XWINDOW (w)->buffer))
803 {
804 if (! NILP (XWINDOW (w)->hchild))
805 w = XWINDOW (w)->hchild;
806 else if (! NILP (XWINDOW (w)->vchild))
807 w = XWINDOW (w)->vchild;
808 else
809 abort ();
810 }
811 return w;
812 }
813
814 DEFUN ("active-minibuffer-window", Factive_minibuffer_window,
815 Sactive_minibuffer_window, 0, 0, 0,
816 "Return the currently active minibuffer window, or nil if none.")
817 ()
818 {
819 return minibuf_level ? minibuf_window : Qnil;
820 }
821
822 DEFUN ("frame-root-window", Fframe_root_window, Sframe_root_window, 0, 1, 0,
823 "Returns the root-window of FRAME.\n\
824 If omitted, FRAME defaults to the currently selected frame.")
825 (frame)
826 Lisp_Object frame;
827 {
828 Lisp_Object window;
829
830 if (NILP (frame))
831 window = SELECTED_FRAME ()->root_window;
832 else
833 {
834 CHECK_LIVE_FRAME (frame, 0);
835 window = XFRAME (frame)->root_window;
836 }
837
838 return window;
839 }
840
841 DEFUN ("frame-selected-window", Fframe_selected_window,
842 Sframe_selected_window, 0, 1, 0,
843 "Return the selected window of frame object FRAME.\n\
844 If omitted, FRAME defaults to the currently selected frame.")
845 (frame)
846 Lisp_Object frame;
847 {
848 Lisp_Object window;
849
850 if (NILP (frame))
851 window = SELECTED_FRAME ()->selected_window;
852 else
853 {
854 CHECK_LIVE_FRAME (frame, 0);
855 window = XFRAME (frame)->selected_window;
856 }
857
858 return window;
859 }
860
861 DEFUN ("set-frame-selected-window", Fset_frame_selected_window,
862 Sset_frame_selected_window, 2, 2, 0,
863 "Set the selected window of frame object FRAME to WINDOW.\n\
864 If FRAME is nil, the selected frame is used.\n\
865 If FRAME is the selected frame, this makes WINDOW the selected window.")
866 (frame, window)
867 Lisp_Object frame, window;
868 {
869 if (NILP (frame))
870 frame = selected_frame;
871
872 CHECK_LIVE_FRAME (frame, 0);
873 CHECK_LIVE_WINDOW (window, 1);
874
875 if (! EQ (frame, WINDOW_FRAME (XWINDOW (window))))
876 error ("In `set-frame-selected-window', WINDOW is not on FRAME");
877
878 if (EQ (frame, selected_frame))
879 return Fselect_window (window);
880
881 return XFRAME (frame)->selected_window = window;
882 }
883 \f
884 DEFUN ("frame-list", Fframe_list, Sframe_list,
885 0, 0, 0,
886 "Return a list of all frames.")
887 ()
888 {
889 return Fcopy_sequence (Vframe_list);
890 }
891
892 /* Return the next frame in the frame list after FRAME.
893 If MINIBUF is nil, exclude minibuffer-only frames.
894 If MINIBUF is a window, include only its own frame
895 and any frame now using that window as the minibuffer.
896 If MINIBUF is `visible', include all visible frames.
897 If MINIBUF is 0, include all visible and iconified frames.
898 Otherwise, include all frames. */
899
900 Lisp_Object
901 next_frame (frame, minibuf)
902 Lisp_Object frame;
903 Lisp_Object minibuf;
904 {
905 Lisp_Object tail;
906 int passed = 0;
907
908 /* There must always be at least one frame in Vframe_list. */
909 if (! CONSP (Vframe_list))
910 abort ();
911
912 /* If this frame is dead, it won't be in Vframe_list, and we'll loop
913 forever. Forestall that. */
914 CHECK_LIVE_FRAME (frame, 0);
915
916 while (1)
917 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
918 {
919 Lisp_Object f;
920
921 f = XCAR (tail);
922
923 if (passed
924 && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
925 {
926 /* Decide whether this frame is eligible to be returned. */
927
928 /* If we've looped all the way around without finding any
929 eligible frames, return the original frame. */
930 if (EQ (f, frame))
931 return f;
932
933 /* Let minibuf decide if this frame is acceptable. */
934 if (NILP (minibuf))
935 {
936 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
937 return f;
938 }
939 else if (EQ (minibuf, Qvisible))
940 {
941 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
942 if (FRAME_VISIBLE_P (XFRAME (f)))
943 return f;
944 }
945 else if (INTEGERP (minibuf) && XINT (minibuf) == 0)
946 {
947 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
948 if (FRAME_VISIBLE_P (XFRAME (f))
949 || FRAME_ICONIFIED_P (XFRAME (f)))
950 return f;
951 }
952 else if (WINDOWP (minibuf))
953 {
954 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
955 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
956 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
957 FRAME_FOCUS_FRAME (XFRAME (f))))
958 return f;
959 }
960 else
961 return f;
962 }
963
964 if (EQ (frame, f))
965 passed++;
966 }
967 }
968
969 /* Return the previous frame in the frame list before FRAME.
970 If MINIBUF is nil, exclude minibuffer-only frames.
971 If MINIBUF is a window, include only its own frame
972 and any frame now using that window as the minibuffer.
973 If MINIBUF is `visible', include all visible frames.
974 If MINIBUF is 0, include all visible and iconified frames.
975 Otherwise, include all frames. */
976
977 Lisp_Object
978 prev_frame (frame, minibuf)
979 Lisp_Object frame;
980 Lisp_Object minibuf;
981 {
982 Lisp_Object tail;
983 Lisp_Object prev;
984
985 /* There must always be at least one frame in Vframe_list. */
986 if (! CONSP (Vframe_list))
987 abort ();
988
989 prev = Qnil;
990 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
991 {
992 Lisp_Object f;
993
994 f = XCAR (tail);
995 if (!FRAMEP (f))
996 abort ();
997
998 if (EQ (frame, f) && !NILP (prev))
999 return prev;
1000
1001 if (FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
1002 {
1003 /* Decide whether this frame is eligible to be returned,
1004 according to minibuf. */
1005 if (NILP (minibuf))
1006 {
1007 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
1008 prev = f;
1009 }
1010 else if (WINDOWP (minibuf))
1011 {
1012 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
1013 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
1014 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
1015 FRAME_FOCUS_FRAME (XFRAME (f))))
1016 prev = f;
1017 }
1018 else if (EQ (minibuf, Qvisible))
1019 {
1020 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1021 if (FRAME_VISIBLE_P (XFRAME (f)))
1022 prev = f;
1023 }
1024 else if (XFASTINT (minibuf) == 0)
1025 {
1026 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1027 if (FRAME_VISIBLE_P (XFRAME (f))
1028 || FRAME_ICONIFIED_P (XFRAME (f)))
1029 prev = f;
1030 }
1031 else
1032 prev = f;
1033 }
1034 }
1035
1036 /* We've scanned the entire list. */
1037 if (NILP (prev))
1038 /* We went through the whole frame list without finding a single
1039 acceptable frame. Return the original frame. */
1040 return frame;
1041 else
1042 /* There were no acceptable frames in the list before FRAME; otherwise,
1043 we would have returned directly from the loop. Since PREV is the last
1044 acceptable frame in the list, return it. */
1045 return prev;
1046 }
1047
1048
1049 DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0,
1050 "Return the next frame in the frame list after FRAME.\n\
1051 It considers only frames on the same terminal as FRAME.\n\
1052 By default, skip minibuffer-only frames.\n\
1053 If omitted, FRAME defaults to the selected frame.\n\
1054 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.\n\
1055 If MINIFRAME is a window, include only its own frame\n\
1056 and any frame now using that window as the minibuffer.\n\
1057 If MINIFRAME is `visible', include all visible frames.\n\
1058 If MINIFRAME is 0, include all visible and iconified frames.\n\
1059 Otherwise, include all frames.")
1060 (frame, miniframe)
1061 Lisp_Object frame, miniframe;
1062 {
1063 if (NILP (frame))
1064 frame = selected_frame;
1065
1066 CHECK_LIVE_FRAME (frame, 0);
1067 return next_frame (frame, miniframe);
1068 }
1069
1070 DEFUN ("previous-frame", Fprevious_frame, Sprevious_frame, 0, 2, 0,
1071 "Return the previous frame in the frame list before FRAME.\n\
1072 It considers only frames on the same terminal as FRAME.\n\
1073 By default, skip minibuffer-only frames.\n\
1074 If omitted, FRAME defaults to the selected frame.\n\
1075 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.\n\
1076 If MINIFRAME is a window, include only its own frame\n\
1077 and any frame now using that window as the minibuffer.\n\
1078 If MINIFRAME is `visible', include all visible frames.\n\
1079 If MINIFRAME is 0, include all visible and iconified frames.\n\
1080 Otherwise, include all frames.")
1081 (frame, miniframe)
1082 Lisp_Object frame, miniframe;
1083 {
1084 if (NILP (frame))
1085 frame = selected_frame;
1086 CHECK_LIVE_FRAME (frame, 0);
1087 return prev_frame (frame, miniframe);
1088 }
1089 \f
1090 /* Return 1 if it is ok to delete frame F;
1091 0 if all frames aside from F are invisible.
1092 (Exception: if F is the terminal frame, and we are using X, return 1.) */
1093
1094 int
1095 other_visible_frames (f)
1096 FRAME_PTR f;
1097 {
1098 /* We know the selected frame is visible,
1099 so if F is some other frame, it can't be the sole visible one. */
1100 if (f == SELECTED_FRAME ())
1101 {
1102 Lisp_Object frames;
1103 int count = 0;
1104
1105 for (frames = Vframe_list;
1106 CONSP (frames);
1107 frames = XCDR (frames))
1108 {
1109 Lisp_Object this;
1110
1111 this = XCAR (frames);
1112 /* Verify that the frame's window still exists
1113 and we can still talk to it. And note any recent change
1114 in visibility. */
1115 #ifdef HAVE_WINDOW_SYSTEM
1116 if (FRAME_WINDOW_P (XFRAME (this)))
1117 {
1118 x_sync (XFRAME (this));
1119 FRAME_SAMPLE_VISIBILITY (XFRAME (this));
1120 }
1121 #endif
1122
1123 if (FRAME_VISIBLE_P (XFRAME (this))
1124 || FRAME_ICONIFIED_P (XFRAME (this))
1125 /* Allow deleting the terminal frame when at least
1126 one X frame exists! */
1127 || (FRAME_WINDOW_P (XFRAME (this)) && !FRAME_WINDOW_P (f)))
1128 count++;
1129 }
1130 return count > 1;
1131 }
1132 return 1;
1133 }
1134
1135 DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 2, "",
1136 "Delete FRAME, permanently eliminating it from use.\n\
1137 If omitted, FRAME defaults to the selected frame.\n\
1138 A frame may not be deleted if its minibuffer is used by other frames.\n\
1139 Normally, you may not delete a frame if all other frames are invisible,\n\
1140 but if the second optional argument FORCE is non-nil, you may do so.")
1141 (frame, force)
1142 Lisp_Object frame, force;
1143 {
1144 struct frame *f;
1145 struct frame *sf = SELECTED_FRAME ();
1146 int minibuffer_selected;
1147
1148 if (EQ (frame, Qnil))
1149 {
1150 f = sf;
1151 XSETFRAME (frame, f);
1152 }
1153 else
1154 {
1155 CHECK_FRAME (frame, 0);
1156 f = XFRAME (frame);
1157 }
1158
1159 if (! FRAME_LIVE_P (f))
1160 return Qnil;
1161
1162 if (NILP (force) && !other_visible_frames (f))
1163 error ("Attempt to delete the sole visible or iconified frame");
1164
1165 #if 0
1166 /* This is a nice idea, but x_connection_closed needs to be able
1167 to delete the last frame, if it is gone. */
1168 if (NILP (XCDR (Vframe_list)))
1169 error ("Attempt to delete the only frame");
1170 #endif
1171
1172 /* Does this frame have a minibuffer, and is it the surrogate
1173 minibuffer for any other frame? */
1174 if (FRAME_HAS_MINIBUF_P (XFRAME (frame)))
1175 {
1176 Lisp_Object frames;
1177
1178 for (frames = Vframe_list;
1179 CONSP (frames);
1180 frames = XCDR (frames))
1181 {
1182 Lisp_Object this;
1183 this = XCAR (frames);
1184
1185 if (! EQ (this, frame)
1186 && EQ (frame,
1187 WINDOW_FRAME (XWINDOW
1188 (FRAME_MINIBUF_WINDOW (XFRAME (this))))))
1189 error ("Attempt to delete a surrogate minibuffer frame");
1190 }
1191 }
1192
1193 minibuffer_selected = EQ (minibuf_window, selected_window);
1194
1195 /* Don't let the frame remain selected. */
1196 if (f == sf)
1197 {
1198 Lisp_Object tail, frame1;
1199
1200 /* Look for another visible frame on the same terminal. */
1201 frame1 = next_frame (frame, Qvisible);
1202
1203 /* If there is none, find *some* other frame. */
1204 if (NILP (frame1) || EQ (frame1, frame))
1205 {
1206 FOR_EACH_FRAME (tail, frame1)
1207 {
1208 if (! EQ (frame, frame1))
1209 break;
1210 }
1211 }
1212
1213 do_switch_frame (frame1, Qnil, 0);
1214 sf = SELECTED_FRAME ();
1215 }
1216
1217 /* Don't allow minibuf_window to remain on a deleted frame. */
1218 if (EQ (f->minibuffer_window, minibuf_window))
1219 {
1220 Fset_window_buffer (sf->minibuffer_window,
1221 XWINDOW (minibuf_window)->buffer);
1222 minibuf_window = sf->minibuffer_window;
1223
1224 /* If the dying minibuffer window was selected,
1225 select the new one. */
1226 if (minibuffer_selected)
1227 Fselect_window (minibuf_window);
1228 }
1229
1230 /* Don't let echo_area_window to remain on a deleted frame. */
1231 if (EQ (f->minibuffer_window, echo_area_window))
1232 echo_area_window = sf->minibuffer_window;
1233
1234 /* Clear any X selections for this frame. */
1235 #ifdef HAVE_X_WINDOWS
1236 if (FRAME_X_P (f))
1237 x_clear_frame_selections (f);
1238 #endif
1239
1240 /* Free glyphs.
1241 This function must be called before the window tree of the
1242 frame is deleted because windows contain dynamically allocated
1243 memory. */
1244 free_glyphs (f);
1245
1246 /* Mark all the windows that used to be on FRAME as deleted, and then
1247 remove the reference to them. */
1248 delete_all_subwindows (XWINDOW (f->root_window));
1249 f->root_window = Qnil;
1250
1251 Vframe_list = Fdelq (frame, Vframe_list);
1252 FRAME_SET_VISIBLE (f, 0);
1253
1254 if (f->namebuf)
1255 xfree (f->namebuf);
1256 if (FRAME_INSERT_COST (f))
1257 xfree (FRAME_INSERT_COST (f));
1258 if (FRAME_DELETEN_COST (f))
1259 xfree (FRAME_DELETEN_COST (f));
1260 if (FRAME_INSERTN_COST (f))
1261 xfree (FRAME_INSERTN_COST (f));
1262 if (FRAME_DELETE_COST (f))
1263 xfree (FRAME_DELETE_COST (f));
1264 if (FRAME_MESSAGE_BUF (f))
1265 xfree (FRAME_MESSAGE_BUF (f));
1266
1267 /* Since some events are handled at the interrupt level, we may get
1268 an event for f at any time; if we zero out the frame's display
1269 now, then we may trip up the event-handling code. Instead, we'll
1270 promise that the display of the frame must be valid until we have
1271 called the window-system-dependent frame destruction routine. */
1272
1273 /* I think this should be done with a hook. */
1274 #ifdef HAVE_WINDOW_SYSTEM
1275 if (FRAME_WINDOW_P (f))
1276 x_destroy_window (f);
1277 #endif
1278
1279 f->output_data.nothing = 0;
1280
1281 /* If we've deleted the last_nonminibuf_frame, then try to find
1282 another one. */
1283 if (f == last_nonminibuf_frame)
1284 {
1285 Lisp_Object frames;
1286
1287 last_nonminibuf_frame = 0;
1288
1289 for (frames = Vframe_list;
1290 CONSP (frames);
1291 frames = XCDR (frames))
1292 {
1293 f = XFRAME (XCAR (frames));
1294 if (!FRAME_MINIBUF_ONLY_P (f))
1295 {
1296 last_nonminibuf_frame = f;
1297 break;
1298 }
1299 }
1300 }
1301
1302 /* If we've deleted this keyboard's default_minibuffer_frame, try to
1303 find another one. Prefer minibuffer-only frames, but also notice
1304 frames with other windows. */
1305 if (EQ (frame, FRAME_KBOARD (f)->Vdefault_minibuffer_frame))
1306 {
1307 Lisp_Object frames;
1308
1309 /* The last frame we saw with a minibuffer, minibuffer-only or not. */
1310 Lisp_Object frame_with_minibuf;
1311 /* Some frame we found on the same kboard, or nil if there are none. */
1312 Lisp_Object frame_on_same_kboard;
1313
1314 frame_on_same_kboard = Qnil;
1315 frame_with_minibuf = Qnil;
1316
1317 for (frames = Vframe_list;
1318 CONSP (frames);
1319 frames = XCDR (frames))
1320 {
1321 Lisp_Object this;
1322 struct frame *f1;
1323
1324 this = XCAR (frames);
1325 if (!FRAMEP (this))
1326 abort ();
1327 f1 = XFRAME (this);
1328
1329 /* Consider only frames on the same kboard
1330 and only those with minibuffers. */
1331 if (FRAME_KBOARD (f) == FRAME_KBOARD (f1)
1332 && FRAME_HAS_MINIBUF_P (f1))
1333 {
1334 frame_with_minibuf = this;
1335 if (FRAME_MINIBUF_ONLY_P (f1))
1336 break;
1337 }
1338
1339 if (FRAME_KBOARD (f) == FRAME_KBOARD (f1))
1340 frame_on_same_kboard = this;
1341 }
1342
1343 if (!NILP (frame_on_same_kboard))
1344 {
1345 /* We know that there must be some frame with a minibuffer out
1346 there. If this were not true, all of the frames present
1347 would have to be minibufferless, which implies that at some
1348 point their minibuffer frames must have been deleted, but
1349 that is prohibited at the top; you can't delete surrogate
1350 minibuffer frames. */
1351 if (NILP (frame_with_minibuf))
1352 abort ();
1353
1354 FRAME_KBOARD (f)->Vdefault_minibuffer_frame = frame_with_minibuf;
1355 }
1356 else
1357 /* No frames left on this kboard--say no minibuffer either. */
1358 FRAME_KBOARD (f)->Vdefault_minibuffer_frame = Qnil;
1359 }
1360
1361 /* Cause frame titles to update--necessary if we now have just one frame. */
1362 update_mode_lines = 1;
1363
1364 return Qnil;
1365 }
1366 \f
1367 /* Return mouse position in character cell units. */
1368
1369 DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0,
1370 "Return a list (FRAME X . Y) giving the current mouse frame and position.\n\
1371 The position is given in character cells, where (0, 0) is the\n\
1372 upper-left corner.\n\
1373 If Emacs is running on a mouseless terminal or hasn't been programmed\n\
1374 to read the mouse position, it returns the selected frame for FRAME\n\
1375 and nil for X and Y.\n\
1376 Runs the abnormal hook `mouse-position-function' with the normal return\n\
1377 value as argument.")
1378 ()
1379 {
1380 FRAME_PTR f;
1381 Lisp_Object lispy_dummy;
1382 enum scroll_bar_part party_dummy;
1383 Lisp_Object x, y, retval;
1384 int col, row;
1385 unsigned long long_dummy;
1386 struct gcpro gcpro1;
1387
1388 f = SELECTED_FRAME ();
1389 x = y = Qnil;
1390
1391 #ifdef HAVE_MOUSE
1392 /* It's okay for the hook to refrain from storing anything. */
1393 if (mouse_position_hook)
1394 (*mouse_position_hook) (&f, -1,
1395 &lispy_dummy, &party_dummy,
1396 &x, &y,
1397 &long_dummy);
1398 if (! NILP (x))
1399 {
1400 col = XINT (x);
1401 row = XINT (y);
1402 pixel_to_glyph_coords (f, col, row, &col, &row, NULL, 1);
1403 XSETINT (x, col);
1404 XSETINT (y, row);
1405 }
1406 #endif
1407 XSETFRAME (lispy_dummy, f);
1408 retval = Fcons (lispy_dummy, Fcons (x, y));
1409 GCPRO1 (retval);
1410 if (!NILP (Vmouse_position_function))
1411 retval = call1 (Vmouse_position_function, retval);
1412 RETURN_UNGCPRO (retval);
1413 }
1414
1415 DEFUN ("mouse-pixel-position", Fmouse_pixel_position,
1416 Smouse_pixel_position, 0, 0, 0,
1417 "Return a list (FRAME X . Y) giving the current mouse frame and position.\n\
1418 The position is given in pixel units, where (0, 0) is the\n\
1419 upper-left corner.\n\
1420 If Emacs is running on a mouseless terminal or hasn't been programmed\n\
1421 to read the mouse position, it returns the selected frame for FRAME\n\
1422 and nil for X and Y.")
1423 ()
1424 {
1425 FRAME_PTR f;
1426 Lisp_Object lispy_dummy;
1427 enum scroll_bar_part party_dummy;
1428 Lisp_Object x, y;
1429 unsigned long long_dummy;
1430
1431 f = SELECTED_FRAME ();
1432 x = y = Qnil;
1433
1434 #ifdef HAVE_MOUSE
1435 /* It's okay for the hook to refrain from storing anything. */
1436 if (mouse_position_hook)
1437 (*mouse_position_hook) (&f, -1,
1438 &lispy_dummy, &party_dummy,
1439 &x, &y,
1440 &long_dummy);
1441 #endif
1442 XSETFRAME (lispy_dummy, f);
1443 return Fcons (lispy_dummy, Fcons (x, y));
1444 }
1445
1446 DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0,
1447 "Move the mouse pointer to the center of character cell (X,Y) in FRAME.\n\
1448 Coordinates are relative to the frame, not a window,\n\
1449 so the coordinates of the top left character in the frame\n\
1450 may be nonzero due to left-hand scroll bars or the menu bar.\n\
1451 \n\
1452 This function is a no-op for an X frame that is not visible.\n\
1453 If you have just created a frame, you must wait for it to become visible\n\
1454 before calling this function on it, like this.\n\
1455 (while (not (frame-visible-p frame)) (sleep-for .5))")
1456 (frame, x, y)
1457 Lisp_Object frame, x, y;
1458 {
1459 CHECK_LIVE_FRAME (frame, 0);
1460 CHECK_NUMBER (x, 2);
1461 CHECK_NUMBER (y, 1);
1462
1463 /* I think this should be done with a hook. */
1464 #ifdef HAVE_WINDOW_SYSTEM
1465 if (FRAME_WINDOW_P (XFRAME (frame)))
1466 /* Warping the mouse will cause enternotify and focus events. */
1467 x_set_mouse_position (XFRAME (frame), XINT (x), XINT (y));
1468 #else
1469 #if defined (MSDOS) && defined (HAVE_MOUSE)
1470 if (FRAME_MSDOS_P (XFRAME (frame)))
1471 {
1472 Fselect_frame (frame, Qnil);
1473 mouse_moveto (XINT (x), XINT (y));
1474 }
1475 #endif
1476 #endif
1477
1478 return Qnil;
1479 }
1480
1481 DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position,
1482 Sset_mouse_pixel_position, 3, 3, 0,
1483 "Move the mouse pointer to pixel position (X,Y) in FRAME.\n\
1484 Note, this is a no-op for an X frame that is not visible.\n\
1485 If you have just created a frame, you must wait for it to become visible\n\
1486 before calling this function on it, like this.\n\
1487 (while (not (frame-visible-p frame)) (sleep-for .5))")
1488 (frame, x, y)
1489 Lisp_Object frame, x, y;
1490 {
1491 CHECK_LIVE_FRAME (frame, 0);
1492 CHECK_NUMBER (x, 2);
1493 CHECK_NUMBER (y, 1);
1494
1495 /* I think this should be done with a hook. */
1496 #ifdef HAVE_WINDOW_SYSTEM
1497 if (FRAME_WINDOW_P (XFRAME (frame)))
1498 /* Warping the mouse will cause enternotify and focus events. */
1499 x_set_mouse_pixel_position (XFRAME (frame), XINT (x), XINT (y));
1500 #else
1501 #if defined (MSDOS) && defined (HAVE_MOUSE)
1502 if (FRAME_MSDOS_P (XFRAME (frame)))
1503 {
1504 Fselect_frame (frame, Qnil);
1505 mouse_moveto (XINT (x), XINT (y));
1506 }
1507 #endif
1508 #endif
1509
1510 return Qnil;
1511 }
1512 \f
1513 static void make_frame_visible_1 P_ ((Lisp_Object));
1514
1515 DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible,
1516 0, 1, "",
1517 "Make the frame FRAME visible (assuming it is an X-window).\n\
1518 If omitted, FRAME defaults to the currently selected frame.")
1519 (frame)
1520 Lisp_Object frame;
1521 {
1522 if (NILP (frame))
1523 frame = selected_frame;
1524
1525 CHECK_LIVE_FRAME (frame, 0);
1526
1527 /* I think this should be done with a hook. */
1528 #ifdef HAVE_WINDOW_SYSTEM
1529 if (FRAME_WINDOW_P (XFRAME (frame)))
1530 {
1531 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1532 x_make_frame_visible (XFRAME (frame));
1533 }
1534 #endif
1535
1536 make_frame_visible_1 (XFRAME (frame)->root_window);
1537
1538 /* Make menu bar update for the Buffers and Frams menus. */
1539 windows_or_buffers_changed++;
1540
1541 return frame;
1542 }
1543
1544 /* Update the display_time slot of the buffers shown in WINDOW
1545 and all its descendents. */
1546
1547 static void
1548 make_frame_visible_1 (window)
1549 Lisp_Object window;
1550 {
1551 struct window *w;
1552
1553 for (;!NILP (window); window = w->next)
1554 {
1555 w = XWINDOW (window);
1556
1557 if (!NILP (w->buffer))
1558 XBUFFER (w->buffer)->display_time = Fcurrent_time ();
1559
1560 if (!NILP (w->vchild))
1561 make_frame_visible_1 (w->vchild);
1562 if (!NILP (w->hchild))
1563 make_frame_visible_1 (w->hchild);
1564 }
1565 }
1566
1567 DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible,
1568 0, 2, "",
1569 "Make the frame FRAME invisible (assuming it is an X-window).\n\
1570 If omitted, FRAME defaults to the currently selected frame.\n\
1571 Normally you may not make FRAME invisible if all other frames are invisible,\n\
1572 but if the second optional argument FORCE is non-nil, you may do so.")
1573 (frame, force)
1574 Lisp_Object frame, force;
1575 {
1576 if (NILP (frame))
1577 frame = selected_frame;
1578
1579 CHECK_LIVE_FRAME (frame, 0);
1580
1581 if (NILP (force) && !other_visible_frames (XFRAME (frame)))
1582 error ("Attempt to make invisible the sole visible or iconified frame");
1583
1584 #if 0 /* This isn't logically necessary, and it can do GC. */
1585 /* Don't let the frame remain selected. */
1586 if (EQ (frame, selected_frame))
1587 do_switch_frame (next_frame (frame, Qt), Qnil, 0)
1588 #endif
1589
1590 /* Don't allow minibuf_window to remain on a deleted frame. */
1591 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1592 {
1593 struct frame *sf = XFRAME (selected_frame);
1594 Fset_window_buffer (sf->minibuffer_window,
1595 XWINDOW (minibuf_window)->buffer);
1596 minibuf_window = sf->minibuffer_window;
1597 }
1598
1599 /* I think this should be done with a hook. */
1600 #ifdef HAVE_WINDOW_SYSTEM
1601 if (FRAME_WINDOW_P (XFRAME (frame)))
1602 x_make_frame_invisible (XFRAME (frame));
1603 #endif
1604
1605 /* Make menu bar update for the Buffers and Frams menus. */
1606 windows_or_buffers_changed++;
1607
1608 return Qnil;
1609 }
1610
1611 DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame,
1612 0, 1, "",
1613 "Make the frame FRAME into an icon.\n\
1614 If omitted, FRAME defaults to the currently selected frame.")
1615 (frame)
1616 Lisp_Object frame;
1617 {
1618 if (NILP (frame))
1619 frame = selected_frame;
1620
1621 CHECK_LIVE_FRAME (frame, 0);
1622
1623 #if 0 /* This isn't logically necessary, and it can do GC. */
1624 /* Don't let the frame remain selected. */
1625 if (EQ (frame, selected_frame))
1626 Fhandle_switch_frame (next_frame (frame, Qt), Qnil);
1627 #endif
1628
1629 /* Don't allow minibuf_window to remain on a deleted frame. */
1630 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1631 {
1632 struct frame *sf = XFRAME (selected_frame);
1633 Fset_window_buffer (sf->minibuffer_window,
1634 XWINDOW (minibuf_window)->buffer);
1635 minibuf_window = sf->minibuffer_window;
1636 }
1637
1638 /* I think this should be done with a hook. */
1639 #ifdef HAVE_WINDOW_SYSTEM
1640 if (FRAME_WINDOW_P (XFRAME (frame)))
1641 x_iconify_frame (XFRAME (frame));
1642 #endif
1643
1644 /* Make menu bar update for the Buffers and Frams menus. */
1645 windows_or_buffers_changed++;
1646
1647 return Qnil;
1648 }
1649
1650 DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p,
1651 1, 1, 0,
1652 "Return t if FRAME is now \"visible\" (actually in use for display).\n\
1653 A frame that is not \"visible\" is not updated and, if it works through\n\
1654 a window system, it may not show at all.\n\
1655 Return the symbol `icon' if frame is visible only as an icon.")
1656 (frame)
1657 Lisp_Object frame;
1658 {
1659 CHECK_LIVE_FRAME (frame, 0);
1660
1661 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1662
1663 if (FRAME_VISIBLE_P (XFRAME (frame)))
1664 return Qt;
1665 if (FRAME_ICONIFIED_P (XFRAME (frame)))
1666 return Qicon;
1667 return Qnil;
1668 }
1669
1670 DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list,
1671 0, 0, 0,
1672 "Return a list of all frames now \"visible\" (being updated).")
1673 ()
1674 {
1675 Lisp_Object tail, frame;
1676 struct frame *f;
1677 Lisp_Object value;
1678
1679 value = Qnil;
1680 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1681 {
1682 frame = XCAR (tail);
1683 if (!FRAMEP (frame))
1684 continue;
1685 f = XFRAME (frame);
1686 if (FRAME_VISIBLE_P (f))
1687 value = Fcons (frame, value);
1688 }
1689 return value;
1690 }
1691
1692
1693 DEFUN ("raise-frame", Fraise_frame, Sraise_frame, 0, 1, "",
1694 "Bring FRAME to the front, so it occludes any frames it overlaps.\n\
1695 If FRAME is invisible, make it visible.\n\
1696 If you don't specify a frame, the selected frame is used.\n\
1697 If Emacs is displaying on an ordinary terminal or some other device which\n\
1698 doesn't support multiple overlapping frames, this function does nothing.")
1699 (frame)
1700 Lisp_Object frame;
1701 {
1702 if (NILP (frame))
1703 frame = selected_frame;
1704
1705 CHECK_LIVE_FRAME (frame, 0);
1706
1707 /* Do like the documentation says. */
1708 Fmake_frame_visible (frame);
1709
1710 if (frame_raise_lower_hook)
1711 (*frame_raise_lower_hook) (XFRAME (frame), 1);
1712
1713 return Qnil;
1714 }
1715
1716 /* Should we have a corresponding function called Flower_Power? */
1717 DEFUN ("lower-frame", Flower_frame, Slower_frame, 0, 1, "",
1718 "Send FRAME to the back, so it is occluded by any frames that overlap it.\n\
1719 If you don't specify a frame, the selected frame is used.\n\
1720 If Emacs is displaying on an ordinary terminal or some other device which\n\
1721 doesn't support multiple overlapping frames, this function does nothing.")
1722 (frame)
1723 Lisp_Object frame;
1724 {
1725 if (NILP (frame))
1726 frame = selected_frame;
1727
1728 CHECK_LIVE_FRAME (frame, 0);
1729
1730 if (frame_raise_lower_hook)
1731 (*frame_raise_lower_hook) (XFRAME (frame), 0);
1732
1733 return Qnil;
1734 }
1735
1736 \f
1737 DEFUN ("redirect-frame-focus", Fredirect_frame_focus, Sredirect_frame_focus,
1738 1, 2, 0,
1739 "Arrange for keystrokes typed at FRAME to be sent to FOCUS-FRAME.\n\
1740 In other words, switch-frame events caused by events in FRAME will\n\
1741 request a switch to FOCUS-FRAME, and `last-event-frame' will be\n\
1742 FOCUS-FRAME after reading an event typed at FRAME.\n\
1743 \n\
1744 If FOCUS-FRAME is omitted or nil, any existing redirection is\n\
1745 cancelled, and the frame again receives its own keystrokes.\n\
1746 \n\
1747 Focus redirection is useful for temporarily redirecting keystrokes to\n\
1748 a surrogate minibuffer frame when a frame doesn't have its own\n\
1749 minibuffer window.\n\
1750 \n\
1751 A frame's focus redirection can be changed by select-frame. If frame\n\
1752 FOO is selected, and then a different frame BAR is selected, any\n\
1753 frames redirecting their focus to FOO are shifted to redirect their\n\
1754 focus to BAR. This allows focus redirection to work properly when the\n\
1755 user switches from one frame to another using `select-window'.\n\
1756 \n\
1757 This means that a frame whose focus is redirected to itself is treated\n\
1758 differently from a frame whose focus is redirected to nil; the former\n\
1759 is affected by select-frame, while the latter is not.\n\
1760 \n\
1761 The redirection lasts until `redirect-frame-focus' is called to change it.")
1762 (frame, focus_frame)
1763 Lisp_Object frame, focus_frame;
1764 {
1765 /* Note that we don't check for a live frame here. It's reasonable
1766 to redirect the focus of a frame you're about to delete, if you
1767 know what other frame should receive those keystrokes. */
1768 CHECK_FRAME (frame, 0);
1769
1770 if (! NILP (focus_frame))
1771 CHECK_LIVE_FRAME (focus_frame, 1);
1772
1773 XFRAME (frame)->focus_frame = focus_frame;
1774
1775 if (frame_rehighlight_hook)
1776 (*frame_rehighlight_hook) (XFRAME (frame));
1777
1778 return Qnil;
1779 }
1780
1781
1782 DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 1, 1, 0,
1783 "Return the frame to which FRAME's keystrokes are currently being sent.\n\
1784 This returns nil if FRAME's focus is not redirected.\n\
1785 See `redirect-frame-focus'.")
1786 (frame)
1787 Lisp_Object frame;
1788 {
1789 CHECK_LIVE_FRAME (frame, 0);
1790
1791 return FRAME_FOCUS_FRAME (XFRAME (frame));
1792 }
1793
1794
1795 \f
1796 /* Return the value of frame parameter PROP in frame FRAME. */
1797
1798 Lisp_Object
1799 get_frame_param (frame, prop)
1800 register struct frame *frame;
1801 Lisp_Object prop;
1802 {
1803 register Lisp_Object tem;
1804
1805 tem = Fassq (prop, frame->param_alist);
1806 if (EQ (tem, Qnil))
1807 return tem;
1808 return Fcdr (tem);
1809 }
1810
1811 /* Return the buffer-predicate of the selected frame. */
1812
1813 Lisp_Object
1814 frame_buffer_predicate (frame)
1815 Lisp_Object frame;
1816 {
1817 return XFRAME (frame)->buffer_predicate;
1818 }
1819
1820 /* Return the buffer-list of the selected frame. */
1821
1822 Lisp_Object
1823 frame_buffer_list (frame)
1824 Lisp_Object frame;
1825 {
1826 return XFRAME (frame)->buffer_list;
1827 }
1828
1829 /* Set the buffer-list of the selected frame. */
1830
1831 void
1832 set_frame_buffer_list (frame, list)
1833 Lisp_Object frame, list;
1834 {
1835 XFRAME (frame)->buffer_list = list;
1836 }
1837
1838 /* Discard BUFFER from the buffer-list of each frame. */
1839
1840 void
1841 frames_discard_buffer (buffer)
1842 Lisp_Object buffer;
1843 {
1844 Lisp_Object frame, tail;
1845
1846 FOR_EACH_FRAME (tail, frame)
1847 {
1848 XFRAME (frame)->buffer_list
1849 = Fdelq (buffer, XFRAME (frame)->buffer_list);
1850 }
1851 }
1852
1853 /* Move BUFFER to the end of the buffer-list of each frame. */
1854
1855 void
1856 frames_bury_buffer (buffer)
1857 Lisp_Object buffer;
1858 {
1859 Lisp_Object frame, tail;
1860
1861 FOR_EACH_FRAME (tail, frame)
1862 {
1863 struct frame *f = XFRAME (frame);
1864 Lisp_Object found;
1865
1866 found = Fmemq (buffer, f->buffer_list);
1867 if (!NILP (found))
1868 f->buffer_list = nconc2 (Fdelq (buffer, f->buffer_list),
1869 Fcons (buffer, Qnil));
1870 }
1871 }
1872
1873 /* Modify the alist in *ALISTPTR to associate PROP with VAL.
1874 If the alist already has an element for PROP, we change it. */
1875
1876 void
1877 store_in_alist (alistptr, prop, val)
1878 Lisp_Object *alistptr, val;
1879 Lisp_Object prop;
1880 {
1881 register Lisp_Object tem;
1882
1883 tem = Fassq (prop, *alistptr);
1884 if (EQ (tem, Qnil))
1885 *alistptr = Fcons (Fcons (prop, val), *alistptr);
1886 else
1887 Fsetcdr (tem, val);
1888 }
1889
1890 static int
1891 frame_name_fnn_p (str, len)
1892 char *str;
1893 int len;
1894 {
1895 if (len > 1 && str[0] == 'F')
1896 {
1897 char *end_ptr;
1898
1899 strtol (str + 1, &end_ptr, 10);
1900
1901 if (end_ptr == str + len)
1902 return 1;
1903 }
1904 return 0;
1905 }
1906
1907 /* Set the name of the terminal frame. Also used by MSDOS frames.
1908 Modeled after x_set_name which is used for WINDOW frames. */
1909
1910 void
1911 set_term_frame_name (f, name)
1912 struct frame *f;
1913 Lisp_Object name;
1914 {
1915 f->explicit_name = ! NILP (name);
1916
1917 /* If NAME is nil, set the name to F<num>. */
1918 if (NILP (name))
1919 {
1920 char namebuf[20];
1921
1922 /* Check for no change needed in this very common case
1923 before we do any consing. */
1924 if (frame_name_fnn_p (XSTRING (f->name)->data,
1925 STRING_BYTES (XSTRING (f->name))))
1926 return;
1927
1928 terminal_frame_count++;
1929 sprintf (namebuf, "F%d", terminal_frame_count);
1930 name = build_string (namebuf);
1931 }
1932 else
1933 {
1934 CHECK_STRING (name, 0);
1935
1936 /* Don't change the name if it's already NAME. */
1937 if (! NILP (Fstring_equal (name, f->name)))
1938 return;
1939
1940 /* Don't allow the user to set the frame name to F<num>, so it
1941 doesn't clash with the names we generate for terminal frames. */
1942 if (frame_name_fnn_p (XSTRING (name)->data, STRING_BYTES (XSTRING (name))))
1943 error ("Frame names of the form F<num> are usurped by Emacs");
1944 }
1945
1946 f->name = name;
1947 update_mode_lines = 1;
1948 }
1949
1950 void
1951 store_frame_param (f, prop, val)
1952 struct frame *f;
1953 Lisp_Object prop, val;
1954 {
1955 register Lisp_Object old_alist_elt;
1956
1957 /* The buffer-alist parameter is stored in a special place and is
1958 not in the alist. */
1959 if (EQ (prop, Qbuffer_list))
1960 {
1961 f->buffer_list = val;
1962 return;
1963 }
1964
1965 /* If PROP is a symbol which is supposed to have frame-local values,
1966 and it is set up based on this frame, switch to the global
1967 binding. That way, we can create or alter the frame-local binding
1968 without messing up the symbol's status. */
1969 if (SYMBOLP (prop))
1970 {
1971 Lisp_Object valcontents;
1972 valcontents = XSYMBOL (prop)->value;
1973 if ((BUFFER_LOCAL_VALUEP (valcontents)
1974 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
1975 && XBUFFER_LOCAL_VALUE (valcontents)->check_frame
1976 && XFRAME (XBUFFER_LOCAL_VALUE (valcontents)->frame) == f)
1977 swap_in_global_binding (prop);
1978 }
1979
1980 /* Update the frame parameter alist. */
1981 old_alist_elt = Fassq (prop, f->param_alist);
1982 if (EQ (old_alist_elt, Qnil))
1983 f->param_alist = Fcons (Fcons (prop, val), f->param_alist);
1984 else
1985 Fsetcdr (old_alist_elt, val);
1986
1987 /* Update some other special parameters in their special places
1988 in addition to the alist. */
1989
1990 if (EQ (prop, Qbuffer_predicate))
1991 f->buffer_predicate = val;
1992
1993 if (! FRAME_WINDOW_P (f))
1994 {
1995 if (EQ (prop, Qmenu_bar_lines))
1996 set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f)));
1997 else if (EQ (prop, Qname))
1998 set_term_frame_name (f, val);
1999 }
2000
2001 if (EQ (prop, Qminibuffer) && WINDOWP (val))
2002 {
2003 if (! MINI_WINDOW_P (XWINDOW (val)))
2004 error ("Surrogate minibuffer windows must be minibuffer windows.");
2005
2006 if ((FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
2007 && !EQ (val, f->minibuffer_window))
2008 error ("Can't change the surrogate minibuffer of a frame with its own minibuffer");
2009
2010 /* Install the chosen minibuffer window, with proper buffer. */
2011 f->minibuffer_window = val;
2012 }
2013 }
2014
2015 DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0,
2016 "Return the parameters-alist of frame FRAME.\n\
2017 It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.\n\
2018 The meaningful PARMs depend on the kind of frame.\n\
2019 If FRAME is omitted, return information on the currently selected frame.")
2020 (frame)
2021 Lisp_Object frame;
2022 {
2023 Lisp_Object alist;
2024 FRAME_PTR f;
2025 int height, width;
2026 struct gcpro gcpro1;
2027
2028 if (EQ (frame, Qnil))
2029 frame = selected_frame;
2030
2031 CHECK_FRAME (frame, 0);
2032 f = XFRAME (frame);
2033
2034 if (!FRAME_LIVE_P (f))
2035 return Qnil;
2036
2037 alist = Fcopy_alist (f->param_alist);
2038 GCPRO1 (alist);
2039
2040 if (!FRAME_WINDOW_P (f))
2041 {
2042 int fg = FRAME_FOREGROUND_PIXEL (f);
2043 int bg = FRAME_BACKGROUND_PIXEL (f);
2044 Lisp_Object elt;
2045
2046 /* If the frame's parameter alist says the colors are
2047 unspecified and reversed, take the frame's background pixel
2048 for foreground and vice versa. */
2049 elt = Fassq (Qforeground_color, alist);
2050 if (!NILP (elt) && CONSP (elt)
2051 && STRINGP (XCDR (elt))
2052 && strncmp (XSTRING (XCDR (elt))->data,
2053 unspecified_bg,
2054 XSTRING (XCDR (elt))->size) == 0)
2055 store_in_alist (&alist, Qforeground_color, tty_color_name (f, bg));
2056 else
2057 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2058 elt = Fassq (Qbackground_color, alist);
2059 if (!NILP (elt) && CONSP (elt)
2060 && STRINGP (XCDR (elt))
2061 && strncmp (XSTRING (XCDR (elt))->data,
2062 unspecified_fg,
2063 XSTRING (XCDR (elt))->size) == 0)
2064 store_in_alist (&alist, Qbackground_color, tty_color_name (f, fg));
2065 else
2066 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2067 store_in_alist (&alist, intern ("font"),
2068 build_string (FRAME_MSDOS_P (f)
2069 ? "ms-dos"
2070 : FRAME_W32_P (f) ? "w32term" : "tty"));
2071 }
2072 store_in_alist (&alist, Qname, f->name);
2073 height = (FRAME_NEW_HEIGHT (f) ? FRAME_NEW_HEIGHT (f) : FRAME_HEIGHT (f));
2074 store_in_alist (&alist, Qheight, make_number (height));
2075 width = (FRAME_NEW_WIDTH (f) ? FRAME_NEW_WIDTH (f) : FRAME_WIDTH (f));
2076 store_in_alist (&alist, Qwidth, make_number (width));
2077 store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil));
2078 store_in_alist (&alist, Qminibuffer,
2079 (! FRAME_HAS_MINIBUF_P (f) ? Qnil
2080 : FRAME_MINIBUF_ONLY_P (f) ? Qonly
2081 : FRAME_MINIBUF_WINDOW (f)));
2082 store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
2083 store_in_alist (&alist, Qbuffer_list,
2084 frame_buffer_list (selected_frame));
2085
2086 /* I think this should be done with a hook. */
2087 #ifdef HAVE_WINDOW_SYSTEM
2088 if (FRAME_WINDOW_P (f))
2089 x_report_frame_params (f, &alist);
2090 else
2091 #endif
2092 {
2093 /* This ought to be correct in f->param_alist for an X frame. */
2094 Lisp_Object lines;
2095 XSETFASTINT (lines, FRAME_MENU_BAR_LINES (f));
2096 store_in_alist (&alist, Qmenu_bar_lines, lines);
2097 }
2098
2099 UNGCPRO;
2100 return alist;
2101 }
2102
2103
2104 DEFUN ("frame-parameter", Fframe_parameter, Sframe_parameter, 2, 2, 0,
2105 "Return FRAME's value for parameter PARAMETER.\n\
2106 If FRAME is nil, describe the currently selected frame.")
2107 (frame, parameter)
2108 Lisp_Object frame, parameter;
2109 {
2110 struct frame *f;
2111 Lisp_Object value;
2112
2113 if (NILP (frame))
2114 frame = selected_frame;
2115 else
2116 CHECK_FRAME (frame, 0);
2117 CHECK_SYMBOL (parameter, 1);
2118
2119 f = XFRAME (frame);
2120 value = Qnil;
2121
2122 if (FRAME_LIVE_P (f))
2123 {
2124 if (EQ (parameter, Qname))
2125 value = f->name;
2126 #ifdef HAVE_X_WINDOWS
2127 else if (EQ (parameter, Qdisplay) && FRAME_X_P (f))
2128 value = XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element);
2129 #endif /* HAVE_X_WINDOWS */
2130 else
2131 {
2132 value = Fassq (parameter, f->param_alist);
2133 if (CONSP (value))
2134 {
2135 value = XCDR (value);
2136 /* Fframe_parameters puts the actual fg/bg color names,
2137 even if f->param_alist says otherwise. This is
2138 important when param_alist's notion of colors is
2139 "unspecified". We need to do the same here. */
2140 if (STRINGP (value) && !FRAME_WINDOW_P (f))
2141 {
2142 char *color_name;
2143 EMACS_INT csz;
2144
2145 if (EQ (parameter, Qbackground_color))
2146 {
2147 color_name = XSTRING (value)->data;
2148 csz = XSTRING (value)->size;
2149 if (strncmp (color_name, unspecified_bg, csz) == 0)
2150 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2151 else if (strncmp (color_name, unspecified_fg, csz) == 0)
2152 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2153 }
2154 else if (EQ (parameter, Qforeground_color))
2155 {
2156 color_name = XSTRING (value)->data;
2157 csz = XSTRING (value)->size;
2158 if (strncmp (color_name, unspecified_fg, csz) == 0)
2159 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2160 else if (strncmp (color_name, unspecified_bg, csz) == 0)
2161 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2162 }
2163 }
2164 }
2165 else if (EQ (parameter, Qdisplay_type)
2166 || EQ (parameter, Qbackground_mode))
2167 /* Avoid consing in frequent cases. */
2168 value = Qnil;
2169 else
2170 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2171 }
2172 }
2173
2174 return value;
2175 }
2176
2177
2178 DEFUN ("modify-frame-parameters", Fmodify_frame_parameters,
2179 Smodify_frame_parameters, 2, 2, 0,
2180 "Modify the parameters of frame FRAME according to ALIST.\n\
2181 ALIST is an alist of parameters to change and their new values.\n\
2182 Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.\n\
2183 The meaningful PARMs depend on the kind of frame.\n\
2184 Undefined PARMs are ignored, but stored in the frame's parameter list\n\
2185 so that `frame-parameters' will return them.\n\
2186 \n\
2187 The value of frame parameter FOO can also be accessed\n\
2188 as a frame-local binding for the variable FOO, if you have\n\
2189 enabled such bindings for that variable with `make-variable-frame-local'.")
2190 (frame, alist)
2191 Lisp_Object frame, alist;
2192 {
2193 FRAME_PTR f;
2194 register Lisp_Object tail, prop, val;
2195
2196 if (EQ (frame, Qnil))
2197 frame = selected_frame;
2198 CHECK_LIVE_FRAME (frame, 0);
2199 f = XFRAME (frame);
2200
2201 /* I think this should be done with a hook. */
2202 #ifdef HAVE_WINDOW_SYSTEM
2203 if (FRAME_WINDOW_P (f))
2204 x_set_frame_parameters (f, alist);
2205 else
2206 #endif
2207 #ifdef MSDOS
2208 if (FRAME_MSDOS_P (f))
2209 IT_set_frame_parameters (f, alist);
2210 else
2211 #endif
2212
2213 {
2214 int length = XINT (Flength (alist));
2215 int i;
2216 Lisp_Object *parms
2217 = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
2218 Lisp_Object *values
2219 = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
2220
2221 /* Extract parm names and values into those vectors. */
2222
2223 i = 0;
2224 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
2225 {
2226 Lisp_Object elt;
2227
2228 elt = Fcar (tail);
2229 parms[i] = Fcar (elt);
2230 values[i] = Fcdr (elt);
2231 i++;
2232 }
2233
2234 /* Now process them in reverse of specified order. */
2235 for (i--; i >= 0; i--)
2236 {
2237 prop = parms[i];
2238 val = values[i];
2239 store_frame_param (f, prop, val);
2240 }
2241 }
2242
2243 return Qnil;
2244 }
2245 \f
2246 DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height,
2247 0, 1, 0,
2248 "Height in pixels of a line in the font in frame FRAME.\n\
2249 If FRAME is omitted, the selected frame is used.\n\
2250 For a terminal frame, the value is always 1.")
2251 (frame)
2252 Lisp_Object frame;
2253 {
2254 struct frame *f;
2255
2256 if (NILP (frame))
2257 frame = selected_frame;
2258 CHECK_FRAME (frame, 0);
2259 f = XFRAME (frame);
2260
2261 #ifdef HAVE_WINDOW_SYSTEM
2262 if (FRAME_WINDOW_P (f))
2263 return make_number (x_char_height (f));
2264 else
2265 #endif
2266 return make_number (1);
2267 }
2268
2269
2270 DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width,
2271 0, 1, 0,
2272 "Width in pixels of characters in the font in frame FRAME.\n\
2273 If FRAME is omitted, the selected frame is used.\n\
2274 The width is the same for all characters, because\n\
2275 currently Emacs supports only fixed-width fonts.\n\
2276 For a terminal screen, the value is always 1.")
2277 (frame)
2278 Lisp_Object frame;
2279 {
2280 struct frame *f;
2281
2282 if (NILP (frame))
2283 frame = selected_frame;
2284 CHECK_FRAME (frame, 0);
2285 f = XFRAME (frame);
2286
2287 #ifdef HAVE_WINDOW_SYSTEM
2288 if (FRAME_WINDOW_P (f))
2289 return make_number (x_char_width (f));
2290 else
2291 #endif
2292 return make_number (1);
2293 }
2294
2295 DEFUN ("frame-pixel-height", Fframe_pixel_height,
2296 Sframe_pixel_height, 0, 1, 0,
2297 "Return a FRAME's height in pixels.\n\
2298 This counts only the height available for text lines,\n\
2299 not menu bars on window-system Emacs frames.\n\
2300 For a terminal frame, the result really gives the height in characters.\n\
2301 If FRAME is omitted, the selected frame is used.")
2302 (frame)
2303 Lisp_Object frame;
2304 {
2305 struct frame *f;
2306
2307 if (NILP (frame))
2308 frame = selected_frame;
2309 CHECK_FRAME (frame, 0);
2310 f = XFRAME (frame);
2311
2312 #ifdef HAVE_WINDOW_SYSTEM
2313 if (FRAME_WINDOW_P (f))
2314 return make_number (x_pixel_height (f));
2315 else
2316 #endif
2317 return make_number (FRAME_HEIGHT (f));
2318 }
2319
2320 DEFUN ("frame-pixel-width", Fframe_pixel_width,
2321 Sframe_pixel_width, 0, 1, 0,
2322 "Return FRAME's width in pixels.\n\
2323 For a terminal frame, the result really gives the width in characters.\n\
2324 If FRAME is omitted, the selected frame is used.")
2325 (frame)
2326 Lisp_Object frame;
2327 {
2328 struct frame *f;
2329
2330 if (NILP (frame))
2331 frame = selected_frame;
2332 CHECK_FRAME (frame, 0);
2333 f = XFRAME (frame);
2334
2335 #ifdef HAVE_WINDOW_SYSTEM
2336 if (FRAME_WINDOW_P (f))
2337 return make_number (x_pixel_width (f));
2338 else
2339 #endif
2340 return make_number (FRAME_WIDTH (f));
2341 }
2342 \f
2343 DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0,
2344 "Specify that the frame FRAME has LINES lines.\n\
2345 Optional third arg non-nil means that redisplay should use LINES lines\n\
2346 but that the idea of the actual height of the frame should not be changed.")
2347 (frame, lines, pretend)
2348 Lisp_Object frame, lines, pretend;
2349 {
2350 register struct frame *f;
2351
2352 CHECK_NUMBER (lines, 0);
2353 if (NILP (frame))
2354 frame = selected_frame;
2355 CHECK_LIVE_FRAME (frame, 0);
2356 f = XFRAME (frame);
2357
2358 /* I think this should be done with a hook. */
2359 #ifdef HAVE_WINDOW_SYSTEM
2360 if (FRAME_WINDOW_P (f))
2361 {
2362 if (XINT (lines) != f->height)
2363 x_set_window_size (f, 1, f->width, XINT (lines));
2364 do_pending_window_change (0);
2365 }
2366 else
2367 #endif
2368 change_frame_size (f, XINT (lines), 0, !NILP (pretend), 0, 0);
2369 return Qnil;
2370 }
2371
2372 DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 3, 0,
2373 "Specify that the frame FRAME has COLS columns.\n\
2374 Optional third arg non-nil means that redisplay should use COLS columns\n\
2375 but that the idea of the actual width of the frame should not be changed.")
2376 (frame, cols, pretend)
2377 Lisp_Object frame, cols, pretend;
2378 {
2379 register struct frame *f;
2380 CHECK_NUMBER (cols, 0);
2381 if (NILP (frame))
2382 frame = selected_frame;
2383 CHECK_LIVE_FRAME (frame, 0);
2384 f = XFRAME (frame);
2385
2386 /* I think this should be done with a hook. */
2387 #ifdef HAVE_WINDOW_SYSTEM
2388 if (FRAME_WINDOW_P (f))
2389 {
2390 if (XINT (cols) != f->width)
2391 x_set_window_size (f, 1, XINT (cols), f->height);
2392 do_pending_window_change (0);
2393 }
2394 else
2395 #endif
2396 change_frame_size (f, 0, XINT (cols), !NILP (pretend), 0, 0);
2397 return Qnil;
2398 }
2399
2400 DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0,
2401 "Sets size of FRAME to COLS by ROWS, measured in characters.")
2402 (frame, cols, rows)
2403 Lisp_Object frame, cols, rows;
2404 {
2405 register struct frame *f;
2406
2407 CHECK_LIVE_FRAME (frame, 0);
2408 CHECK_NUMBER (cols, 2);
2409 CHECK_NUMBER (rows, 1);
2410 f = XFRAME (frame);
2411
2412 /* I think this should be done with a hook. */
2413 #ifdef HAVE_WINDOW_SYSTEM
2414 if (FRAME_WINDOW_P (f))
2415 {
2416 if (XINT (rows) != f->height || XINT (cols) != f->width
2417 || FRAME_NEW_HEIGHT (f) || FRAME_NEW_WIDTH (f))
2418 x_set_window_size (f, 1, XINT (cols), XINT (rows));
2419 do_pending_window_change (0);
2420 }
2421 else
2422 #endif
2423 change_frame_size (f, XINT (rows), XINT (cols), 0, 0, 0);
2424
2425 return Qnil;
2426 }
2427
2428 DEFUN ("set-frame-position", Fset_frame_position,
2429 Sset_frame_position, 3, 3, 0,
2430 "Sets position of FRAME in pixels to XOFFSET by YOFFSET.\n\
2431 This is actually the position of the upper left corner of the frame.\n\
2432 Negative values for XOFFSET or YOFFSET are interpreted relative to\n\
2433 the rightmost or bottommost possible position (that stays within the screen).")
2434 (frame, xoffset, yoffset)
2435 Lisp_Object frame, xoffset, yoffset;
2436 {
2437 register struct frame *f;
2438
2439 CHECK_LIVE_FRAME (frame, 0);
2440 CHECK_NUMBER (xoffset, 1);
2441 CHECK_NUMBER (yoffset, 2);
2442 f = XFRAME (frame);
2443
2444 /* I think this should be done with a hook. */
2445 #ifdef HAVE_WINDOW_SYSTEM
2446 if (FRAME_WINDOW_P (f))
2447 x_set_offset (f, XINT (xoffset), XINT (yoffset), 1);
2448 #endif
2449
2450 return Qt;
2451 }
2452
2453 \f
2454 void
2455 syms_of_frame ()
2456 {
2457 syms_of_frame_1 ();
2458
2459 staticpro (&Vframe_list);
2460
2461 DEFVAR_LISP ("terminal-frame", &Vterminal_frame,
2462 "The initial frame-object, which represents Emacs's stdout.");
2463
2464 DEFVAR_LISP ("emacs-iconified", &Vemacs_iconified,
2465 "Non-nil if all of emacs is iconified and frame updates are not needed.");
2466 Vemacs_iconified = Qnil;
2467
2468 DEFVAR_LISP ("mouse-position-function", &Vmouse_position_function,
2469 "If non-nil, function applied to the normal result of `mouse-position'.\n\
2470 This abnormal hook exists for the benefit of packages like XTerm-mouse\n\
2471 which need to do mouse handling at the Lisp level.");
2472 Vmouse_position_function = Qnil;
2473
2474 DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
2475 "Minibufferless frames use this frame's minibuffer.\n\
2476 \n\
2477 Emacs cannot create minibufferless frames unless this is set to an\n\
2478 appropriate surrogate.\n\
2479 \n\
2480 Emacs consults this variable only when creating minibufferless\n\
2481 frames; once the frame is created, it sticks with its assigned\n\
2482 minibuffer, no matter what this variable is set to. This means that\n\
2483 this variable doesn't necessarily say anything meaningful about the\n\
2484 current set of frames, or where the minibuffer is currently being\n\
2485 displayed.");
2486
2487 defsubr (&Sactive_minibuffer_window);
2488 defsubr (&Sframep);
2489 defsubr (&Sframe_live_p);
2490 defsubr (&Smake_terminal_frame);
2491 defsubr (&Shandle_switch_frame);
2492 defsubr (&Signore_event);
2493 defsubr (&Sselect_frame);
2494 defsubr (&Sselected_frame);
2495 defsubr (&Swindow_frame);
2496 defsubr (&Sframe_root_window);
2497 defsubr (&Sframe_first_window);
2498 defsubr (&Sframe_selected_window);
2499 defsubr (&Sset_frame_selected_window);
2500 defsubr (&Sframe_list);
2501 defsubr (&Snext_frame);
2502 defsubr (&Sprevious_frame);
2503 defsubr (&Sdelete_frame);
2504 defsubr (&Smouse_position);
2505 defsubr (&Smouse_pixel_position);
2506 defsubr (&Sset_mouse_position);
2507 defsubr (&Sset_mouse_pixel_position);
2508 #if 0
2509 defsubr (&Sframe_configuration);
2510 defsubr (&Srestore_frame_configuration);
2511 #endif
2512 defsubr (&Smake_frame_visible);
2513 defsubr (&Smake_frame_invisible);
2514 defsubr (&Siconify_frame);
2515 defsubr (&Sframe_visible_p);
2516 defsubr (&Svisible_frame_list);
2517 defsubr (&Sraise_frame);
2518 defsubr (&Slower_frame);
2519 defsubr (&Sredirect_frame_focus);
2520 defsubr (&Sframe_focus);
2521 defsubr (&Sframe_parameters);
2522 defsubr (&Sframe_parameter);
2523 defsubr (&Smodify_frame_parameters);
2524 defsubr (&Sframe_char_height);
2525 defsubr (&Sframe_char_width);
2526 defsubr (&Sframe_pixel_height);
2527 defsubr (&Sframe_pixel_width);
2528 defsubr (&Sset_frame_height);
2529 defsubr (&Sset_frame_width);
2530 defsubr (&Sset_frame_size);
2531 defsubr (&Sset_frame_position);
2532 }
2533
2534 void
2535 keys_of_frame ()
2536 {
2537 initial_define_lispy_key (global_map, "switch-frame", "handle-switch-frame");
2538 initial_define_lispy_key (global_map, "delete-frame", "handle-delete-frame");
2539 initial_define_lispy_key (global_map, "iconify-frame", "ignore-event");
2540 initial_define_lispy_key (global_map, "make-frame-visible", "ignore-event");
2541 }