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