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