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