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