This commit was generated by cvs2svn to compensate for changes in r52, which
[chise/xemacs-chise.git.1] / src / frame.c
1 /* Generic frame functions.
2    Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
3    Copyright (C) 1995, 1996 Ben Wing.
4    Copyright (C) 1995 Sun Microsystems, Inc.
5
6 This file is part of XEmacs.
7
8 XEmacs is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the
10 Free Software Foundation; either version 2, or (at your option) any
11 later version.
12
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
16 for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with XEmacs; see the file COPYING.  If not, write to
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 Boston, MA 02111-1307, USA.  */
22
23 /* Synched up with: FSF 19.30. */
24
25 /* This file has been Mule-ized. */
26
27 #include <config.h>
28 #include "lisp.h"
29
30 #include "buffer.h"             /* for Vbuffer_alist */
31 #include "console.h"
32 #include "events.h"
33 #include "extents.h"
34 #include "faces.h"
35 #include "frame.h"
36 #include "glyphs.h"
37 #include "menubar.h"
38 #include "redisplay.h"
39 #include "scrollbar.h"
40 #include "window.h"
41
42 #include <errno.h>
43 #include "sysdep.h"
44
45 Lisp_Object Vselect_frame_hook, Qselect_frame_hook;
46 Lisp_Object Vdeselect_frame_hook, Qdeselect_frame_hook;
47 Lisp_Object Vcreate_frame_hook, Qcreate_frame_hook;
48 Lisp_Object Vdelete_frame_hook, Qdelete_frame_hook;
49 Lisp_Object Vmouse_enter_frame_hook, Qmouse_enter_frame_hook;
50 Lisp_Object Vmouse_leave_frame_hook, Qmouse_leave_frame_hook;
51 Lisp_Object Vmap_frame_hook, Qmap_frame_hook;
52 Lisp_Object Vunmap_frame_hook, Qunmap_frame_hook;
53 int  allow_deletion_of_last_visible_frame;
54 Lisp_Object Vadjust_frame_function;
55 Lisp_Object Vmouse_motion_handler;
56 Lisp_Object Vsynchronize_minibuffers;
57 Lisp_Object Qsynchronize_minibuffers;
58 Lisp_Object Qbuffer_predicate;
59 Lisp_Object Qmake_initial_minibuffer_frame;
60 Lisp_Object Qcustom_initialize_frame;
61
62 /* We declare all these frame properties here even though many of them
63    are currently only used in frame-x.c, because we should generalize
64    them. */
65
66 Lisp_Object Qminibuffer;
67 Lisp_Object Qunsplittable;
68 Lisp_Object Qinternal_border_width;
69 Lisp_Object Qtop_toolbar_shadow_color;
70 Lisp_Object Qbottom_toolbar_shadow_color;
71 Lisp_Object Qbackground_toolbar_color;
72 Lisp_Object Qtop_toolbar_shadow_pixmap;
73 Lisp_Object Qbottom_toolbar_shadow_pixmap;
74 Lisp_Object Qtoolbar_shadow_thickness;
75 Lisp_Object Qscrollbar_placement;
76 Lisp_Object Qinter_line_space;
77 Lisp_Object Qvisual_bell;
78 Lisp_Object Qbell_volume;
79 Lisp_Object Qpointer_background;
80 Lisp_Object Qpointer_color;
81 Lisp_Object Qtext_pointer;
82 Lisp_Object Qspace_pointer;
83 Lisp_Object Qmodeline_pointer;
84 Lisp_Object Qgc_pointer;
85 Lisp_Object Qinitially_unmapped;
86 Lisp_Object Quse_backing_store;
87 Lisp_Object Qborder_color;
88 Lisp_Object Qborder_width;
89
90 Lisp_Object Qframep, Qframe_live_p;
91 Lisp_Object Qframe_x_p, Qframe_tty_p;
92 Lisp_Object Qdelete_frame;
93
94 Lisp_Object Qframe_title_format, Vframe_title_format;
95 Lisp_Object Qframe_icon_title_format, Vframe_icon_title_format;
96
97 Lisp_Object Vdefault_frame_name;
98 Lisp_Object Vdefault_frame_plist;
99
100 Lisp_Object Vframe_icon_glyph;
101
102 Lisp_Object Qhidden;
103
104 Lisp_Object Qvisible, Qiconic, Qinvisible, Qvisible_iconic, Qinvisible_iconic;
105 Lisp_Object Qnomini, Qvisible_nomini, Qiconic_nomini, Qinvisible_nomini;
106 Lisp_Object Qvisible_iconic_nomini, Qinvisible_iconic_nomini;
107
108 Lisp_Object Qset_specifier, Qset_glyph_image, Qset_face_property;
109 Lisp_Object Qface_property_instance;
110
111 Lisp_Object Qframe_property_alias;
112
113 /* If this is non-nil, it is the frame that make-frame is currently
114    creating.  We can't set the current frame to this in case the
115    debugger goes off because it would try and display to it.  However,
116    there are some places which need to reference it which have no
117    other way of getting it if it isn't the selected frame. */
118 Lisp_Object Vframe_being_created;
119 Lisp_Object Qframe_being_created;
120
121 static void store_minibuf_frame_prop (struct frame *f, Lisp_Object val);
122
123 EXFUN (Fset_frame_properties, 2);
124
125 \f
126 static Lisp_Object
127 mark_frame (Lisp_Object obj, void (*markobj) (Lisp_Object))
128 {
129   struct frame *f = XFRAME (obj);
130
131 #define MARKED_SLOT(x) ((markobj) (f->x));
132 #include "frameslots.h"
133
134   if (FRAME_LIVE_P (f)) /* device is nil for a dead frame */
135     MAYBE_FRAMEMETH (f, mark_frame, (f, markobj));
136
137   return Qnil;
138 }
139
140 static void
141 print_frame (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
142 {
143   struct frame *frm = XFRAME (obj);
144   char buf[200];
145
146   if (print_readably)
147     error ("printing unreadable object #<frame %s 0x%x>",
148            XSTRING_DATA (frm->name), frm->header.uid);
149
150   sprintf (buf, "#<%s-frame ", !FRAME_LIVE_P (frm) ? "dead" :
151            FRAME_TYPE_NAME (frm));
152   write_c_string (buf, printcharfun);
153   print_internal (frm->name, printcharfun, 1);
154   sprintf (buf, " 0x%x>", frm->header.uid);
155   write_c_string (buf, printcharfun);
156 }
157
158 DEFINE_LRECORD_IMPLEMENTATION ("frame", frame,
159                                mark_frame, print_frame, 0, 0, 0,
160                                struct frame);
161 \f
162 static void
163 nuke_all_frame_slots (struct frame *f)
164 {
165 #define MARKED_SLOT(x)  f->x = Qnil;
166 #include "frameslots.h"
167 }
168
169 /* Allocate a new frame object and set all its fields to reasonable
170    values.  The root window is created but the minibuffer will be done
171    later. */
172
173 static struct frame *
174 allocate_frame_core (Lisp_Object device)
175 {
176   /* This function can GC */
177   Lisp_Object frame;
178   Lisp_Object root_window;
179   struct frame *f = alloc_lcrecord_type (struct frame, lrecord_frame);
180
181   zero_lcrecord (f);
182   nuke_all_frame_slots (f);
183   XSETFRAME (frame, f);
184
185   f->device = device;
186   f->framemeths = XDEVICE (device)->devmeths;
187   f->buffer_alist = Fcopy_sequence (Vbuffer_alist);
188
189   root_window = allocate_window ();
190   XWINDOW (root_window)->frame = frame;
191
192   /* 10 is arbitrary,
193      just so that there is "something there."
194      Correct size will be set up later with change_frame_size.  */
195
196   f->width = 10;
197   f->height = 10;
198
199   XWINDOW (root_window)->pixel_width = 10;
200   XWINDOW (root_window)->pixel_height = 9;
201
202   /* The size of the minibuffer window is now set in x_create_frame
203      in xfns.c. */
204
205   f->root_window = root_window;
206   f->selected_window = root_window;
207   f->last_nonminibuf_window = root_window;
208
209   /* Choose a buffer for the frame's root window.  */
210   XWINDOW (root_window)->buffer = Qt;
211   {
212     Lisp_Object buf;
213
214     buf = Fcurrent_buffer ();
215     /* If buf is a 'hidden' buffer (i.e. one whose name starts with
216        a space), try to find another one.  */
217     if (string_char (XSTRING (Fbuffer_name (buf)), 0) == ' ')
218       buf = Fother_buffer (buf, Qnil, Qnil);
219     Fset_window_buffer (root_window, buf);
220   }
221
222   return f;
223 }
224
225 static void
226 setup_normal_frame (struct frame *f)
227 {
228   Lisp_Object mini_window;
229   Lisp_Object frame;
230
231   XSETFRAME (frame, f);
232
233   mini_window = allocate_window ();
234   XWINDOW (f->root_window)->next = mini_window;
235   XWINDOW (mini_window)->prev = f->root_window;
236   XWINDOW (mini_window)->mini_p = Qt;
237   XWINDOW (mini_window)->frame = frame;
238   f->minibuffer_window = mini_window;
239   f->has_minibuffer = 1;
240
241   XWINDOW (mini_window)->buffer = Qt;
242   Fset_window_buffer (mini_window, Vminibuffer_zero);
243 }
244
245 /* Make a frame using a separate minibuffer window on another frame.
246    MINI_WINDOW is the minibuffer window to use.  nil means use the
247    default-minibuffer-frame.  */
248
249 static void
250 setup_frame_without_minibuffer (struct frame *f, Lisp_Object mini_window)
251 {
252   /* This function can GC */
253   Lisp_Object device = f->device;
254
255   if (!NILP (mini_window))
256     CHECK_LIVE_WINDOW (mini_window);
257
258   if (!NILP (mini_window)
259       && !EQ (DEVICE_CONSOLE (XDEVICE (device)),
260               FRAME_CONSOLE (XFRAME (XWINDOW (mini_window)->frame))))
261     error ("frame and minibuffer must be on the same console");
262
263   if (NILP (mini_window))
264     {
265       struct console *con = XCONSOLE (FRAME_CONSOLE (f));
266       /* Use default-minibuffer-frame if possible.  */
267       if (!FRAMEP (con->default_minibuffer_frame)
268           || ! FRAME_LIVE_P (XFRAME (con->default_minibuffer_frame)))
269         {
270           /* If there's no minibuffer frame to use, create one.  */
271           con->default_minibuffer_frame
272             = call1 (Qmake_initial_minibuffer_frame, device);
273         }
274       mini_window = XFRAME (con->default_minibuffer_frame)->minibuffer_window;
275     }
276
277   /* Install the chosen minibuffer window, with proper buffer.  */
278   store_minibuf_frame_prop (f, mini_window);
279   Fset_window_buffer (mini_window, Vminibuffer_zero);
280 }
281
282 /* Make a frame containing only a minibuffer window.  */
283
284 static void
285 setup_minibuffer_frame (struct frame *f)
286 {
287   /* This function can GC */
288   /* First make a frame containing just a root window, no minibuffer.  */
289   Lisp_Object mini_window;
290   Lisp_Object frame;
291
292   XSETFRAME (frame, f);
293
294   f->no_split = 1;
295   f->has_minibuffer = 1;
296
297   /* Now label the root window as also being the minibuffer.
298      Avoid infinite looping on the window chain by marking next pointer
299      as nil. */
300
301   mini_window = f->minibuffer_window = f->root_window;
302   XWINDOW (mini_window)->mini_p = Qt;
303   XWINDOW (mini_window)->next   = Qnil;
304   XWINDOW (mini_window)->prev   = Qnil;
305   XWINDOW (mini_window)->frame  = frame;
306
307   /* Put the proper buffer in that window.  */
308
309   Fset_window_buffer (mini_window, Vminibuffer_zero);
310 }
311
312 static Lisp_Object
313 make_sure_its_a_fresh_plist (Lisp_Object foolist)
314 {
315   if (CONSP (Fcar (foolist)))
316     {
317       /* looks like an alist to me. */
318       foolist = Fcopy_alist (foolist);
319       foolist = Fdestructive_alist_to_plist (foolist);
320     }
321   else
322     foolist = Fcopy_sequence (foolist);
323
324   return foolist;
325 }
326
327 DEFUN ("make-frame", Fmake_frame, 0, 2, "", /*
328 Create and return a new frame, displaying the current buffer.
329 Runs the functions listed in `create-frame-hook' after frame creation.
330
331 Optional argument PROPS is a property list (a list of alternating
332 keyword-value specifications) of properties for the new frame.
333 \(An alist is accepted for backward compatibility but should not
334 be passed in.)
335
336 See `set-frame-properties', `default-x-frame-plist', and
337 `default-tty-frame-plist' for the specially-recognized properties.
338 */
339        (props, device))
340 {
341   struct frame *f;
342   struct device *d;
343   Lisp_Object frame = Qnil, name = Qnil, minibuf;
344   struct gcpro gcpro1, gcpro2, gcpro3;
345   int speccount = specpdl_depth ();
346   int first_frame_on_device = 0;
347   int first_frame_on_console = 0;
348
349   d = decode_device (device);
350   XSETDEVICE (device, d);
351
352   /* PROPS and NAME may be freshly-created, so make sure to GCPRO. */
353   GCPRO3 (frame, props, name);
354
355   props = make_sure_its_a_fresh_plist (props);
356   if (DEVICE_SPECIFIC_FRAME_PROPS (d))
357     /* Put the device-specific props before the more general ones so
358        that they override them. */
359     props = nconc2 (props,
360                     make_sure_its_a_fresh_plist
361                     (*DEVICE_SPECIFIC_FRAME_PROPS (d)));
362   props = nconc2 (props, make_sure_its_a_fresh_plist (Vdefault_frame_plist));
363   Fcanonicalize_lax_plist (props, Qnil);
364
365   name = Flax_plist_get (props, Qname, Qnil);
366   if (!NILP (name))
367     CHECK_STRING (name);
368   else if (STRINGP (Vdefault_frame_name))
369     name = Vdefault_frame_name;
370   else
371     name = build_string ("emacs");
372
373   if (!NILP (Fstring_match (make_string ((CONST Bufbyte *) "\\.", 2), name,
374                             Qnil, Qnil)))
375     signal_simple_error (". not allowed in frame names", name);
376
377   f = allocate_frame_core (device);
378   XSETFRAME (frame, f);
379
380   specbind (Qframe_being_created, name);
381   f->name = name;
382
383   FRAMEMETH (f, init_frame_1, (f, props));
384
385   minibuf = Flax_plist_get (props, Qminibuffer, Qunbound);
386   if (UNBOUNDP (minibuf))
387     {
388       /* If minibuf is unspecified, then look for a minibuffer X resource. */
389       /* #### Not implemented any more.  We need to fix things up so
390          that we search out all X resources and append them to the end of
391          props, above.  This is the only way in general to assure
392          coherent behavior for all frame properties/resources/etc. */
393     }
394   else
395     props = Flax_plist_remprop (props, Qminibuffer);
396
397   if (EQ (minibuf, Qnone) || NILP (minibuf))
398     setup_frame_without_minibuffer (f, Qnil);
399   else if (EQ (minibuf, Qonly))
400     setup_minibuffer_frame (f);
401   else if (WINDOWP (minibuf))
402     setup_frame_without_minibuffer (f, minibuf);
403   else if (EQ (minibuf, Qt) || UNBOUNDP (minibuf))
404     setup_normal_frame (f);
405   else
406     signal_simple_error ("Invalid value for `minibuffer'", minibuf);
407
408   update_frame_window_mirror (f);
409
410   if (initialized)
411     {
412       if (!NILP (f->minibuffer_window))
413         reset_face_cachels (XWINDOW (f->minibuffer_window));
414       reset_face_cachels (XWINDOW (f->root_window));
415     }
416
417   /* If no frames on this device formerly existed, say this is the
418      first frame.  It kind of assumes that frameless devices don't
419      exist, but it shouldn't be too harmful.  */
420   if (NILP (DEVICE_FRAME_LIST (d)))
421     first_frame_on_device = 1;
422
423   /* This *must* go before the init_*() methods.  Those functions
424      call Lisp code, and if any of them causes a warning to be displayed
425      and the *Warnings* buffer to be created, it won't get added to
426      the frame-specific version of the buffer-alist unless the frame
427      is accessible from the device. */
428
429 #if 0
430   DEVICE_FRAME_LIST (d) = nconc2 (DEVICE_FRAME_LIST (d), Fcons (frame, Qnil));
431 #endif
432   DEVICE_FRAME_LIST (d) = Fcons (frame, DEVICE_FRAME_LIST (d));
433   RESET_CHANGED_SET_FLAGS;
434
435   /* Now make sure that the initial cached values are set correctly.
436      Do this after the init_frame method is called because that may
437      do things (e.g. create widgets) that are necessary for the
438      specifier value-changed methods to work OK. */
439   recompute_all_cached_specifiers_in_frame (f);
440
441   if (!DEVICE_STREAM_P (d))
442     {
443       init_frame_faces (f);
444
445 #ifdef HAVE_SCROLLBARS
446       /* Finish up resourcing the scrollbars. */
447       init_frame_scrollbars (f);
448 #endif
449
450 #ifdef HAVE_TOOLBARS
451       /* Create the initial toolbars.  We have to do this after the frame
452          methods are called because it may potentially call some things itself
453          which depend on the normal frame methods having initialized
454          things. */
455       init_frame_toolbars (f);
456 #endif
457
458       reset_face_cachels (XWINDOW (FRAME_SELECTED_WINDOW (f)));
459       reset_glyph_cachels (XWINDOW (FRAME_SELECTED_WINDOW (f)));
460       change_frame_size (f, f->height, f->width, 0);
461     }
462
463   MAYBE_FRAMEMETH (f, init_frame_2, (f, props));
464   Fset_frame_properties (frame, props);
465   MAYBE_FRAMEMETH (f, init_frame_3, (f));
466
467   /* Hallelujah, praise the lord. */
468   f->init_finished = 1;
469
470   /* If this is the first frame on the device, make it the selected one. */
471   if (first_frame_on_device && NILP (DEVICE_SELECTED_FRAME (d)))
472     set_device_selected_frame (d, frame);
473
474   /* If at startup or if the current console is a stream console
475      (usually also at startup), make this console the selected one
476      so that messages show up on it. */
477   if (NILP (Fselected_console ()) ||
478       CONSOLE_STREAM_P (XCONSOLE (Fselected_console ())))
479     Fselect_console (DEVICE_CONSOLE (d));
480
481   first_frame_on_console =
482     (first_frame_on_device &&
483      XINT (Flength (CONSOLE_DEVICE_LIST (XCONSOLE (DEVICE_CONSOLE (d)))))
484      == 1);
485
486   /* #### all this calling of frame methods at various odd times
487      is somewhat of a mess.  It's necessary to do it this way due
488      to strange console-type-specific things that need to be done. */
489   MAYBE_FRAMEMETH (f, after_init_frame, (f, first_frame_on_device,
490                                          first_frame_on_console));
491
492   if (first_frame_on_device)
493     {
494       if (first_frame_on_console)
495         va_run_hook_with_args (Qcreate_console_hook, 1, DEVICE_CONSOLE (d));
496       va_run_hook_with_args (Qcreate_device_hook, 1, device);
497     }
498   va_run_hook_with_args (Qcreate_frame_hook, 1, frame);
499
500   /* Initialize custom-specific stuff. */
501   if (!UNBOUNDP (symbol_function (XSYMBOL (Qcustom_initialize_frame))))
502     call1 (Qcustom_initialize_frame, frame);
503
504   unbind_to (speccount, Qnil);
505
506   UNGCPRO;
507   return frame;
508 }
509
510 \f
511 /* this function should be used in most cases when a Lisp function is passed
512    a FRAME argument.  Use this unless you don't accept nil == current frame
513    (in which case, do a CHECK_LIVE_FRAME() and then an XFRAME()) or you
514    allow dead frames.  Note that very few functions should accept dead
515    frames.  It could be argued that functions should just do nothing when
516    given a dead frame, but the presence of a dead frame usually indicates
517    an oversight in the Lisp code that could potentially lead to strange
518    results and so it is better to catch the error early.
519
520    If you only accept X frames, use decode_x_frame(), which does what this
521    function does but also makes sure the frame is an X frame. */
522
523 struct frame *
524 decode_frame (Lisp_Object frame)
525 {
526   if (NILP (frame))
527     return selected_frame ();
528
529   CHECK_LIVE_FRAME (frame);
530   return XFRAME (frame);
531 }
532
533 struct frame *
534 decode_frame_or_selected (Lisp_Object cdf)
535 {
536   if (CONSOLEP (cdf))
537     cdf = CONSOLE_SELECTED_DEVICE (decode_console (cdf));
538   if (DEVICEP (cdf))
539     cdf = DEVICE_SELECTED_FRAME (decode_device (cdf));
540   return decode_frame (cdf);
541 }
542
543 Lisp_Object
544 make_frame (struct frame *f)
545 {
546   Lisp_Object frame;
547   XSETFRAME (frame, f);
548   return frame;
549 }
550
551 \f
552 /*
553  * window size changes are held up during critical regions.  Afterwards,
554  * we want to deal with any delayed changes.
555  */
556 void
557 hold_frame_size_changes (void)
558 {
559   in_display = 1;
560 }
561
562 void
563 unhold_one_frame_size_changes (struct frame *f)
564 {
565   in_display = 0;
566
567   if (f->size_change_pending)
568     change_frame_size (f, f->new_height, f->new_width, 0);
569 }
570
571 void
572 unhold_frame_size_changes (void)
573 {
574   Lisp_Object frmcons, devcons, concons;
575
576   FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
577     unhold_one_frame_size_changes (XFRAME (XCAR (frmcons)));
578 }
579
580 void
581 invalidate_vertical_divider_cache_in_frame (struct frame *f)
582 {
583   /* Invalidate cached value of needs_vertical_divider_p in 
584      every and all windows */
585   map_windows (f, invalidate_vertical_divider_cache_in_window, 0);
586 }
587 \f
588 /*
589  * Frame size may change due to changes in scrollbars, toolbars,
590  * default font etc. These changes are applied early in redisplay
591  * frame.
592  */
593 void
594 adjust_frame_size (struct frame *f)
595 {
596   int keep_char_size = 0;
597   Lisp_Object frame;
598   XSETFRAME (frame, f);
599
600   if (!f->size_slipped)
601     return;
602
603   /* Don't adjust tty frames. #### May break when TTY have menubars.
604      Then, write an Vadjust_frame_function which will return t for TTY
605      frames. Another solution is frame_size_fixed_p method for TTYs,
606      which always returned yes it's fixed.
607   */
608   if (!FRAME_WIN_P (f))
609     {
610       CLEAR_FRAME_SIZE_SLIPPED (f);
611       return;
612     }
613
614   /* frame_size_fixed_p tells that frame size cannot currently
615      be changed change due to external conditions */
616   if (!FRAMEMETH_OR_GIVEN (f, frame_size_fixed_p, (f), 0))
617     {
618       if (NILP (Vadjust_frame_function))
619         keep_char_size = 1;
620       else if (EQ (Vadjust_frame_function, Qt))
621         keep_char_size = 0;
622       else
623         keep_char_size =
624           NILP (call1_trapping_errors ("Error in adjust-frame-function",
625                                        Vadjust_frame_function, frame));
626
627       if (keep_char_size)
628         Fset_frame_size (frame, make_int (FRAME_CHARWIDTH(f)),
629                          make_int (FRAME_CHARHEIGHT(f)), Qnil);
630     }
631
632   if (!keep_char_size)
633     {
634       int height, width;
635       pixel_to_char_size (f, FRAME_PIXWIDTH(f), FRAME_PIXHEIGHT(f),
636                           &width, &height);
637       change_frame_size (f, height, width, 0);
638       CLEAR_FRAME_SIZE_SLIPPED (f);
639     }
640 }
641
642 /*
643  * This is a "specifier changed in frame" handler for various specifiers
644  * changing which causes frame size adjustment
645  */
646 void
647 frame_size_slipped (Lisp_Object specifier, struct frame *f,
648                     Lisp_Object oldval)
649 {
650   MARK_FRAME_SIZE_SLIPPED(f);
651 }
652 \f
653 DEFUN ("framep", Fframep, 1, 1, 0, /*
654 Return non-nil if OBJECT is a frame.
655 Also see `frame-live-p'.
656 Note that FSF Emacs kludgily returns a value indicating what type of
657 frame this is.  Use the cleaner function `frame-type' for that.
658 */
659        (object))
660 {
661   return FRAMEP (object) ? Qt : Qnil;
662 }
663
664 DEFUN ("frame-live-p", Fframe_live_p, 1, 1, 0, /*
665 Return non-nil if OBJECT is a frame which has not been deleted.
666 */
667        (object))
668 {
669   return FRAMEP (object) && FRAME_LIVE_P (XFRAME (object)) ? Qt : Qnil;
670 }
671
672 \f
673 DEFUN ("focus-frame", Ffocus_frame, 1, 1, 0, /*
674 Select FRAME and give it the window system focus.
675 This function is not affected by the value of `focus-follows-mouse'.
676 */
677        (frame))
678 {
679   CHECK_LIVE_FRAME (frame);
680
681   MAYBE_DEVMETH (XDEVICE (FRAME_DEVICE (XFRAME (frame))), focus_on_frame,
682                  (XFRAME (frame)));
683   /* FRAME will be selected by the time we receive the next event.
684      However, it is better to select it explicitly now, in case the
685      Lisp code depends on frame being selected.  */
686   Fselect_frame (frame);
687   return Qnil;
688 }
689
690 /* Called from Fselect_window() */
691 void
692 select_frame_1 (Lisp_Object frame)
693 {
694   struct frame *f = XFRAME (frame);
695   Lisp_Object old_selected_frame = Fselected_frame (Qnil);
696
697   if (EQ (frame, old_selected_frame))
698     return;
699
700   /* now select the frame's device */
701   set_device_selected_frame (XDEVICE (FRAME_DEVICE (f)), frame);
702   select_device_1 (FRAME_DEVICE (f));
703
704   update_frame_window_mirror (f);
705 }
706
707 DEFUN ("select-frame", Fselect_frame, 1, 1, 0, /*
708 Select the frame FRAME.
709 Subsequent editing commands apply to its selected window.
710 The selection of FRAME lasts until the next time the user does
711 something to select a different frame, or until the next time this
712 function is called.
713
714 Note that this does not actually cause the window-system focus to be
715 set to this frame, or the `select-frame-hook' or `deselect-frame-hook'
716 to be run, until the next time that XEmacs is waiting for an event.
717
718 Also note that when focus-follows-mouse is non-nil, the frame
719 selection is temporary and is reverted when the current command
720 terminates, much like the buffer selected by `set-buffer'.  In order
721 to effect a permanent focus change, use `focus-frame'.
722 */
723        (frame))
724 {
725   CHECK_LIVE_FRAME (frame);
726
727   /* select the frame's selected window.  This will call
728      selected_frame_1(). */
729   Fselect_window (FRAME_SELECTED_WINDOW (XFRAME (frame)), Qnil);
730
731   /* Nothing should be depending on the return value of this function.
732      But, of course, there is stuff out there which is. */
733   return frame;
734 }
735
736 /* use this to retrieve the currently selected frame.  You should use
737    this in preference to Fselected_frame (Qnil) unless you are prepared
738    to handle the possibility of there being no selected frame (this
739    happens at some points during startup). */
740
741 struct frame *
742 selected_frame (void)
743 {
744   Lisp_Object device = Fselected_device (Qnil);
745   Lisp_Object frame = DEVICE_SELECTED_FRAME (XDEVICE (device));
746   if (NILP (frame))
747     signal_simple_error ("No frames exist on device", device);
748   return XFRAME (frame);
749 }
750
751 /* use this instead of XFRAME (DEVICE_SELECTED_FRAME (d)) to catch
752    the possibility of there being no frames on the device (just created).
753    There is no point doing this inside of redisplay because errors
754    cause an abort(), indicating a flaw in the logic, and error_check_frame()
755    will catch this just as well. */
756
757 struct frame *
758 device_selected_frame (struct device *d)
759 {
760   Lisp_Object frame = DEVICE_SELECTED_FRAME (d);
761   if (NILP (frame))
762     {
763       Lisp_Object device;
764       XSETDEVICE (device, d);
765       signal_simple_error ("No frames exist on device", device);
766     }
767   return XFRAME (frame);
768 }
769
770 #if 0 /* FSFmacs */
771
772 xxDEFUN ("handle-switch-frame", Fhandle_switch_frame, 1, 2, "e", /*
773 Handle a switch-frame event EVENT.
774 Switch-frame events are usually bound to this function.
775 A switch-frame event tells Emacs that the window manager has requested
776 that the user's events be directed to the frame mentioned in the event.
777 This function selects the selected window of the frame of EVENT.
778
779 If EVENT is frame object, handle it as if it were a switch-frame event
780 to that frame.
781 */
782          (frame, no_enter))
783 {
784   /* Preserve prefix arg that the command loop just cleared.  */
785   XCONSOLE (Vselected_console)->prefix_arg = Vcurrent_prefix_arg;
786 #if 0 /* unclean! */
787   run_hook (Qmouse_leave_buffer_hook);
788 #endif
789   return do_switch_frame (frame, no_enter, 0);
790 }
791
792 /* A load of garbage. */
793 xxDEFUN ("ignore-event", Fignore_event, 0, 0, "", /*
794 Do nothing, but preserve any prefix argument already specified.
795 This is a suitable binding for iconify-frame and make-frame-visible.
796 */
797          ())
798 {
799   struct console *c = XCONSOLE (Vselected_console);
800
801   c->prefix_arg = Vcurrent_prefix_arg;
802   return Qnil;
803 }
804
805 #endif /* 0 */
806
807 DEFUN ("selected-frame", Fselected_frame, 0, 1, 0, /*
808 Return the frame that is now selected on device DEVICE.
809 If DEVICE is not specified, the selected device will be used.
810 If no frames exist on the device, nil is returned.
811 */
812        (device))
813 {
814   if (NILP (device) && NILP (Fselected_device (Qnil)))
815     return Qnil; /* happens early in temacs */
816   return DEVICE_SELECTED_FRAME (decode_device (device));
817 }
818
819 Lisp_Object
820 frame_first_window (struct frame *f)
821 {
822   Lisp_Object w = f->root_window;
823
824   while (1)
825     {
826       if (! NILP (XWINDOW (w)->hchild))
827         w = XWINDOW (w)->hchild;
828       else if (! NILP (XWINDOW (w)->vchild))
829         w = XWINDOW (w)->vchild;
830       else
831         break;
832     }
833
834   return w;
835 }
836
837 DEFUN ("active-minibuffer-window", Factive_minibuffer_window, 0, 0, 0, /*
838 Return the currently active minibuffer window, or nil if none.
839 */
840        ())
841 {
842   return minibuf_level ? minibuf_window : Qnil;
843 }
844
845 DEFUN ("last-nonminibuf-frame", Flast_nonminibuf_frame, 0, 1, 0, /*
846 Return the most-recently-selected non-minibuffer-only frame on CONSOLE.
847 This will always be the same as (selected-frame device) unless the
848 selected frame is a minibuffer-only frame.
849 CONSOLE defaults to the selected console if omitted.
850 */
851        (console))
852 {
853   Lisp_Object result;
854
855   XSETCONSOLE (console, decode_console (console));
856   /* Just in case the machinations in delete_frame_internal() resulted
857      in the last-nonminibuf-frame getting out of sync, make sure and
858      return the selected frame if it's acceptable. */
859   result = Fselected_frame (CONSOLE_SELECTED_DEVICE (XCONSOLE (console)));
860   if (!NILP (result) && !FRAME_MINIBUF_ONLY_P (XFRAME (result)))
861     return result;
862   return CONSOLE_LAST_NONMINIBUF_FRAME (XCONSOLE (console));
863 }
864
865 DEFUN ("frame-root-window", Fframe_root_window, 0, 1, 0, /*
866 Return the root-window of FRAME.
867 If omitted, FRAME defaults to the currently selected frame.
868 */
869        (frame))
870 {
871   struct frame *f = decode_frame (frame);
872   return FRAME_ROOT_WINDOW (f);
873 }
874
875 DEFUN ("frame-selected-window", Fframe_selected_window, 0, 1, 0, /*
876 Return the selected window of frame object FRAME.
877 If omitted, FRAME defaults to the currently selected frame.
878 */
879        (frame))
880 {
881   struct frame *f = decode_frame (frame);
882   return FRAME_SELECTED_WINDOW (f);
883 }
884
885 void
886 set_frame_selected_window (struct frame *f, Lisp_Object window)
887 {
888   assert (XFRAME (WINDOW_FRAME (XWINDOW (window))) == f);
889   f->selected_window = window;
890   if (!MINI_WINDOW_P (XWINDOW (window)) || FRAME_MINIBUF_ONLY_P (f))
891     {
892 #ifdef HAVE_TOOLBARS
893       if (!EQ (f->last_nonminibuf_window, window))
894         MARK_TOOLBAR_CHANGED;
895 #endif      
896       f->last_nonminibuf_window = window;
897     }
898 }
899
900 DEFUN ("set-frame-selected-window", Fset_frame_selected_window, 2, 2, 0, /*
901 Set the selected window of frame object FRAME to WINDOW.
902 If FRAME is nil, the selected frame is used.
903 If FRAME is the selected frame, this makes WINDOW the selected window.
904 */
905        (frame, window))
906 {
907   XSETFRAME (frame, decode_frame (frame));
908   CHECK_LIVE_WINDOW (window);
909
910   if (! EQ (frame, WINDOW_FRAME (XWINDOW (window))))
911     error ("In `set-frame-selected-window', WINDOW is not on FRAME");
912
913   if (XFRAME (frame) == selected_frame ())
914     return Fselect_window (window, Qnil);
915
916   set_frame_selected_window (XFRAME (frame), window);
917   return window;
918 }
919
920 \f
921 DEFUN ("frame-device", Fframe_device, 0, 1, 0, /*
922 Return the device that FRAME is on.
923 If omitted, FRAME defaults to the currently selected frame.
924 */
925        (frame))
926 {
927   return FRAME_DEVICE (decode_frame (frame));
928 }
929
930 int
931 is_surrogate_for_selected_frame (struct frame *f)
932 {
933   struct device *d = XDEVICE (f->device);
934   struct frame *dsf = device_selected_frame (d);
935
936   /* Can't be a surrogate for ourselves. */
937   if (f == dsf)
938     return 0;
939
940   if (!FRAME_HAS_MINIBUF_P (dsf) &&
941       f == XFRAME (WINDOW_FRAME (XWINDOW (FRAME_MINIBUF_WINDOW (dsf)))))
942     return 1;
943   else
944     return 0;
945 }
946
947 static int
948 frame_matches_frametype (Lisp_Object frame, Lisp_Object type)
949 {
950   struct frame *f = XFRAME (frame);
951
952   if (WINDOWP (type))
953     {
954       CHECK_LIVE_WINDOW (type);
955
956       if (EQ (FRAME_MINIBUF_WINDOW (f), type)
957           /* Check that F either is, or has forwarded
958              its focus to, TYPE's frame.  */
959           && (EQ (WINDOW_FRAME (XWINDOW (type)), frame)
960               || EQ (WINDOW_FRAME (XWINDOW (type)),
961                      FRAME_FOCUS_FRAME (f))))
962         return 1;
963       else
964         return 0;
965     }
966
967 #if 0 /* FSFmacs */
968   if (EQ (type, Qvisible) || EQ (type, Qiconic) || EQ (type, Qvisible_iconic)
969       || EQ (type, Qvisible_nomini) || EQ (type, Qiconic_nomini)
970       || EQ (type, Qvisible_iconic_nomini))
971     FRAME_SAMPLE_VISIBILITY (f);
972 #endif
973
974   if (NILP (type))
975     type = Qnomini;
976   if (ZEROP (type))
977     type = Qvisible_iconic;
978
979   if (EQ (type, Qvisible))
980     return FRAME_VISIBLE_P (f);
981   if (EQ (type, Qiconic))
982     return FRAME_ICONIFIED_P (f);
983   if (EQ (type, Qinvisible))
984     return !FRAME_VISIBLE_P (f) && !FRAME_ICONIFIED_P (f);
985   if (EQ (type, Qvisible_iconic))
986     return FRAME_VISIBLE_P (f) || FRAME_ICONIFIED_P (f);
987   if (EQ (type, Qinvisible_iconic))
988     return !FRAME_VISIBLE_P (f);
989
990   if (EQ (type, Qnomini))
991     return !FRAME_MINIBUF_ONLY_P (f);
992   if (EQ (type, Qvisible_nomini))
993     return FRAME_VISIBLE_P (f) && !FRAME_MINIBUF_ONLY_P (f);
994   if (EQ (type, Qiconic_nomini))
995     return FRAME_ICONIFIED_P (f) && !FRAME_MINIBUF_ONLY_P (f);
996   if (EQ (type, Qinvisible_nomini))
997     return !FRAME_VISIBLE_P (f) && !FRAME_ICONIFIED_P (f) &&
998       !FRAME_MINIBUF_ONLY_P (f);
999   if (EQ (type, Qvisible_iconic_nomini))
1000     return ((FRAME_VISIBLE_P (f) || FRAME_ICONIFIED_P (f))
1001             && !FRAME_MINIBUF_ONLY_P (f));
1002   if (EQ (type, Qinvisible_iconic_nomini))
1003     return !FRAME_VISIBLE_P (f) && !FRAME_MINIBUF_ONLY_P (f);
1004
1005   return 1;
1006 }
1007
1008 int
1009 device_matches_console_spec (Lisp_Object frame, Lisp_Object device,
1010                              Lisp_Object console)
1011 {
1012   if (EQ (console, Qwindow_system))
1013     return DEVICE_WIN_P (XDEVICE (device));
1014   if (NILP (console))
1015     console = (DEVICE_CONSOLE (XDEVICE (FRAME_DEVICE (XFRAME (frame)))));
1016   if (DEVICEP (console))
1017     return EQ (device, console);
1018   if (CONSOLEP (console))
1019     return EQ (DEVICE_CONSOLE (XDEVICE (device)), console);
1020   if (valid_console_type_p (console))
1021     return EQ (DEVICE_TYPE (XDEVICE (device)), console);
1022   return 1;
1023 }
1024
1025 /* Return the next frame in the frame list after FRAME.
1026    FRAMETYPE and CONSOLE control which frames and devices
1027    are considered; see `next-frame'. */
1028
1029 static Lisp_Object
1030 next_frame_internal (Lisp_Object frame, Lisp_Object frametype,
1031                      Lisp_Object console, int called_from_delete_device)
1032 {
1033   int passed = 0;
1034   int started_over = 0;
1035
1036   /* If this frame is dead, it won't be in frame_list, and we'll loop
1037      forever.  Forestall that.  */
1038   CHECK_LIVE_FRAME (frame);
1039
1040   while (1)
1041     {
1042       Lisp_Object devcons, concons;
1043
1044       DEVICE_LOOP_NO_BREAK (devcons, concons)
1045         {
1046           Lisp_Object device = XCAR (devcons);
1047           Lisp_Object frmcons;
1048
1049           if (!device_matches_console_spec (frame, device, console))
1050             continue;
1051
1052           DEVICE_FRAME_LOOP (frmcons, XDEVICE (device))
1053             {
1054               Lisp_Object f = XCAR (frmcons);
1055               if (passed)
1056                 {
1057                   /* #### Doing this here is bad and is now
1058                      unnecessary.  The real bug was that f->iconified
1059                      was never, ever updated unless a user explicitly
1060                      called frame-iconified-p.  That has now been
1061                      fixed.  With this change removed all of the other
1062                      changes made to support this routine having the
1063                      called_from_delete_device arg could be removed.
1064                      But it is too close to release to do that now. */
1065 #if 0
1066                   /* Make sure the visibility and iconified flags are
1067                      up-to-date unless we're being deleted. */
1068                   if (!called_from_delete_device)
1069                     {
1070                       Fframe_iconified_p (f);
1071                       Fframe_visible_p (f);
1072                     }
1073 #endif
1074
1075                   /* Decide whether this frame is eligible to be returned.  */
1076
1077                   /* If we've looped all the way around without finding any
1078                      eligible frames, return the original frame.  */
1079                   if (EQ (f, frame))
1080                     return f;
1081
1082                   if (frame_matches_frametype (f, frametype))
1083                     return f;
1084                 }
1085
1086               if (EQ (frame, f))
1087                 passed++;
1088             }
1089         }
1090       /* We hit the end of the list, and need to start over again. */
1091       if (started_over)
1092         return Qnil;
1093       started_over++;
1094     }
1095 }
1096
1097 Lisp_Object
1098 next_frame (Lisp_Object frame, Lisp_Object frametype, Lisp_Object console)
1099 {
1100   return next_frame_internal (frame, frametype, console, 0);
1101 }
1102
1103 /* Return the previous frame in the frame list before FRAME.
1104    FRAMETYPE and CONSOLE control which frames and devices
1105    are considered; see `next-frame'. */
1106
1107 Lisp_Object
1108 prev_frame (Lisp_Object frame, Lisp_Object frametype, Lisp_Object console)
1109 {
1110   Lisp_Object devcons, concons;
1111   Lisp_Object prev;
1112
1113   /* If this frame is dead, it won't be in frame_list, and we'll loop
1114      forever.  Forestall that.  */
1115   CHECK_LIVE_FRAME (frame);
1116
1117   prev = Qnil;
1118   DEVICE_LOOP_NO_BREAK (devcons, concons)
1119     {
1120       Lisp_Object device = XCAR (devcons);
1121       Lisp_Object frmcons;
1122
1123       if (!device_matches_console_spec (frame, device, console))
1124         continue;
1125
1126       DEVICE_FRAME_LOOP (frmcons, XDEVICE (device))
1127         {
1128           Lisp_Object f = XCAR (frmcons);
1129
1130           if (EQ (frame, f) && !NILP (prev))
1131             return prev;
1132
1133           /* Decide whether this frame is eligible to be returned,
1134              according to frametype.  */
1135
1136           if (frame_matches_frametype (f, frametype))
1137             prev = f;
1138
1139         }
1140     }
1141
1142   /* We've scanned the entire list.  */
1143   if (NILP (prev))
1144     /* We went through the whole frame list without finding a single
1145        acceptable frame.  Return the original frame.  */
1146     return frame;
1147   else
1148     /* There were no acceptable frames in the list before FRAME; otherwise,
1149        we would have returned directly from the loop.  Since PREV is the last
1150        acceptable frame in the list, return it.  */
1151     return prev;
1152 }
1153
1154 DEFUN ("next-frame", Fnext_frame, 0, 3, 0, /*
1155 Return the next frame of the right type in the frame list after FRAME.
1156 FRAMETYPE controls which frames are eligible to be returned; all
1157 others will be skipped.  Note that if there is only one eligible
1158 frame, then `next-frame' called repeatedly will always return
1159 the same frame, and if there is no eligible frame, then FRAME is
1160 returned.
1161
1162 Possible values for FRAMETYPE are
1163
1164 'visible                 Consider only frames that are visible.
1165 'iconic                  Consider only frames that are iconic.
1166 'invisible               Consider only frames that are invisible
1167                          (this is different from iconic).
1168 'visible-iconic          Consider frames that are visible or iconic.
1169 'invisible-iconic        Consider frames that are invisible or iconic.
1170 'nomini                  Consider all frames except minibuffer-only ones.
1171 'visible-nomini          Like `visible' but omits minibuffer-only frames.
1172 'iconic-nomini           Like `iconic' but omits minibuffer-only frames.
1173 'invisible-nomini        Like `invisible' but omits minibuffer-only frames.
1174 'visible-iconic-nomini   Like `visible-iconic' but omits minibuffer-only
1175                          frames.
1176 'invisible-iconic-nomini Like `invisible-iconic' but omits minibuffer-only
1177                          frames.
1178 any other value          Consider all frames.
1179
1180 If FRAMETYPE is omitted, 'nomini is used.  A FRAMETYPE of 0 (a number)
1181 is treated like 'iconic, for backwards compatibility.
1182
1183 If FRAMETYPE is a window, include only its own frame and any frame now
1184 using that window as the minibuffer.
1185
1186 Optional third argument CONSOLE controls which consoles or devices the
1187 returned frame may be on.  If CONSOLE is a console, return frames only
1188 on that console.  If CONSOLE is a device, return frames only on that
1189 device.  If CONSOLE is a console type, return frames only on consoles
1190 of that type.  If CONSOLE is 'window-system, return any frames on any
1191 window-system consoles.  If CONSOLE is nil or omitted, return frames only
1192 on the FRAME's console.  Otherwise, all frames are considered.
1193 */
1194        (frame, frametype, console))
1195 {
1196   XSETFRAME (frame, decode_frame (frame));
1197
1198   return next_frame (frame, frametype, console);
1199 }
1200
1201 DEFUN ("previous-frame", Fprevious_frame, 0, 3, 0, /*
1202 Return the next frame of the right type in the frame list after FRAME.
1203 FRAMETYPE controls which frames are eligible to be returned; all
1204 others will be skipped.  Note that if there is only one eligible
1205 frame, then `previous-frame' called repeatedly will always return
1206 the same frame, and if there is no eligible frame, then FRAME is
1207 returned.
1208
1209 See `next-frame' for an explanation of the FRAMETYPE and CONSOLE
1210 arguments.
1211 */
1212        (frame, frametype, console))
1213 {
1214   XSETFRAME (frame, decode_frame (frame));
1215
1216   return prev_frame (frame, frametype, console);
1217 }
1218
1219 /* Return any frame for which PREDICATE is non-zero, or return Qnil
1220    if there aren't any. */
1221
1222 Lisp_Object
1223 find_some_frame (int (*predicate) (Lisp_Object, void *),
1224                  void *closure)
1225 {
1226   Lisp_Object framecons, devcons, concons;
1227
1228   FRAME_LOOP_NO_BREAK (framecons, devcons, concons)
1229     {
1230       Lisp_Object frame = XCAR (framecons);
1231
1232       if ((predicate) (frame, closure))
1233         return frame;
1234     }
1235
1236   return Qnil;
1237 }
1238
1239 \f
1240
1241 /* extern void free_line_insertion_deletion_costs (struct frame *f); */
1242
1243 /* Return 1 if it is ok to delete frame F;
1244    0 if all frames aside from F are invisible.
1245    (Exception: if F is a stream frame, it's OK to delete if
1246    any other frames exist.) */
1247
1248 static int
1249 other_visible_frames_internal (struct frame *f, int called_from_delete_device)
1250 {
1251   Lisp_Object frame;
1252
1253   XSETFRAME (frame, f);
1254   if (FRAME_STREAM_P (f))
1255     return !EQ (frame, next_frame_internal (frame, Qt, Qt,
1256                                             called_from_delete_device));
1257   return !EQ (frame, next_frame_internal (frame, Qvisible_iconic_nomini, Qt,
1258                                           called_from_delete_device));
1259 }
1260
1261 int
1262 other_visible_frames (struct frame *f)
1263 {
1264   return other_visible_frames_internal (f, 0);
1265 }
1266
1267 /* Delete frame F.
1268
1269    If FORCE is non-zero, allow deletion of the only frame.
1270
1271    If CALLED_FROM_DELETE_DEVICE is non-zero, then, if
1272    deleting the last frame on a device, just delete it,
1273    instead of calling `delete-device'.
1274
1275    If FROM_IO_ERROR is non-zero, then the frame is gone due
1276    to an I/O error.  This affects what happens if we exit
1277    (we do an emergency exit instead of `save-buffers-kill-emacs'.)
1278 */
1279
1280 void
1281 delete_frame_internal (struct frame *f, int force,
1282                        int called_from_delete_device,
1283                        int from_io_error)
1284 {
1285   /* This function can GC */
1286   int minibuffer_selected;
1287   struct device *d;
1288   struct console *con;
1289   Lisp_Object frame;
1290   Lisp_Object device;
1291   Lisp_Object console;
1292   struct gcpro gcpro1;
1293
1294   /* OK to delete an already deleted frame. */
1295   if (! FRAME_LIVE_P (f))
1296     return;
1297
1298   XSETFRAME (frame, f);
1299   GCPRO1 (frame);
1300
1301   device = FRAME_DEVICE (f);
1302   d = XDEVICE (device);
1303   console = DEVICE_CONSOLE (d);
1304   con = XCONSOLE (console);
1305
1306   if (!called_from_delete_device)
1307     {
1308       /* If we're deleting the only non-minibuffer frame on the
1309          device, delete the device. */
1310       if (EQ (frame, next_frame (frame, Qnomini, FRAME_DEVICE (f))))
1311         {
1312           delete_device_internal (d, force, 0, from_io_error);
1313           UNGCPRO;
1314           return;
1315         }
1316     }
1317
1318   /* In FSF, delete-frame will not normally allow you to delete the
1319      last visible frame.  This was too annoying, so we changed it to the
1320      only frame.  However, this would let people shoot themselves by
1321      deleting all frames which were either visible or iconified and thus
1322      losing any way of communicating with the still running XEmacs process.
1323      So we put it back.  */
1324   if (!force && !allow_deletion_of_last_visible_frame &&
1325       !other_visible_frames_internal (f, called_from_delete_device))
1326     error ("Attempt to delete the sole visible or iconified frame");
1327
1328   /* Does this frame have a minibuffer, and is it the surrogate
1329      minibuffer for any other frame?  */
1330   if (FRAME_HAS_MINIBUF_P (f))
1331     {
1332       Lisp_Object frmcons, devcons, concons;
1333
1334       FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
1335         {
1336           Lisp_Object this = XCAR (frmcons);
1337
1338           if (! EQ (this, frame)
1339               && EQ (frame, (WINDOW_FRAME
1340                              (XWINDOW
1341                               (FRAME_MINIBUF_WINDOW (XFRAME (this)))))))
1342             {
1343               /* We've found another frame whose minibuffer is on
1344                  this frame. */
1345               signal_simple_error
1346                 ("Attempt to delete a surrogate minibuffer frame", frame);
1347             }
1348         }
1349     }
1350
1351   /* Test for popup frames hanging around. */
1352   /* Deletion of a parent frame with popups is deadly. */
1353   {
1354     Lisp_Object frmcons, devcons, concons;
1355
1356     FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
1357       {
1358         Lisp_Object this = XCAR (frmcons);
1359
1360
1361         if (! EQ (this, frame))
1362           {
1363             struct device *devcons_d = XDEVICE (XCAR (devcons));
1364             if (EQ (frame, DEVMETH_OR_GIVEN (devcons_d, get_frame_parent,
1365                                              (XFRAME (this)),
1366                                              Qnil)))
1367               /* We've found a popup frame whose parent is this frame. */
1368               signal_simple_error
1369                 ("Attempt to delete a frame with live popups", frame);
1370           }
1371       }
1372   }
1373
1374   /* Before here, we haven't made any dangerous changes (just checked for
1375      error conditions).  Now run the delete-frame-hook.  Remember that
1376      user code there could do any number of dangerous things, including
1377      signalling an error. */
1378
1379   va_run_hook_with_args (Qdelete_frame_hook, 1, frame);
1380
1381   if (!FRAME_LIVE_P (f)) /* Make sure the delete-frame-hook didn't */
1382     {                    /* go ahead and delete anything. */
1383       UNGCPRO;
1384       return;
1385     }
1386
1387   /* Call the delete-device-hook and delete-console-hook now if
1388      appropriate, before we do any dangerous things -- they too could
1389      signal an error. */
1390   if (XINT (Flength (DEVICE_FRAME_LIST (d))) == 1)
1391     {
1392       va_run_hook_with_args (Qdelete_device_hook, 1, device);
1393       if (!FRAME_LIVE_P (f)) /* Make sure the delete-device-hook didn't */
1394         {                    /* go ahead and delete anything. */
1395           UNGCPRO;
1396           return;
1397         }
1398
1399       if (XINT (Flength (CONSOLE_DEVICE_LIST (con))) == 1)
1400         {
1401           va_run_hook_with_args (Qdelete_console_hook, 1, console);
1402           if (!FRAME_LIVE_P (f)) /* Make sure the delete-console-hook didn't */
1403             {                    /* go ahead and delete anything. */
1404               UNGCPRO;
1405               return;
1406             }
1407         }
1408     }
1409
1410   minibuffer_selected = EQ (minibuf_window, Fselected_window (Qnil));
1411
1412   /* If we were focused on this frame, then we're not any more.
1413      Assume that we lost the focus; that way, the call to
1414      Fselect_frame() below won't end up making us explicitly
1415      focus on another frame, which is generally undesirable in
1416      a point-to-type world.  If our mouse ends up sitting over
1417      another frame, we will receive a FocusIn event and end up
1418      making that frame the selected frame.
1419
1420      #### This may not be an ideal solution in a click-to-type
1421      world (in that case, we might want to explicitly choose
1422      another frame to have the focus, rather than relying on
1423      the WM, which might focus on a frame in a different app
1424      or focus on nothing at all).  But there's no easy way
1425      to detect which focus model we're running on, and the
1426      alternative is more heinous. */
1427
1428   if (EQ (frame, DEVICE_FRAME_WITH_FOCUS_REAL (d)))
1429     DEVICE_FRAME_WITH_FOCUS_REAL (d) = Qnil;
1430   if (EQ (frame, DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)))
1431     DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d) = Qnil;
1432   if (EQ (frame, DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d)))
1433     DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = Qnil;
1434
1435   /* Don't allow the deleted frame to remain selected.
1436      Note that in the former scheme of things, this would
1437      have caused us to regain the focus.  This no longer
1438      applies (see above); I think the new behavior is more
1439      logical.  If someone disagrees, it can always be
1440      changed (or a new user variable can be introduced, ugh.) */
1441   if (EQ (frame, DEVICE_SELECTED_FRAME (d)))
1442     {
1443       Lisp_Object next;
1444
1445       /* If this is a popup frame, select its parent if possible.
1446          Otherwise, find another visible frame; if none, just take any frame.
1447          First try the same device, then the same console. */
1448
1449       next = DEVMETH_OR_GIVEN (d, get_frame_parent, (f), Qnil);
1450       if (NILP (next) || EQ (next, frame) || ! FRAME_LIVE_P (XFRAME (next)))
1451         next = next_frame_internal (frame, Qvisible, device,
1452                                     called_from_delete_device);
1453       if (NILP (next) || EQ (next, frame))
1454         next = next_frame_internal (frame, Qvisible, console,
1455                                     called_from_delete_device);
1456       if (NILP (next) || EQ (next, frame))
1457         next = next_frame_internal (frame, Qvisible, Qt,
1458                                     called_from_delete_device);
1459       if (NILP (next) || EQ (next, frame))
1460         next = next_frame_internal (frame, Qt, device,
1461                                     called_from_delete_device);
1462       if (NILP (next) || EQ (next, frame))
1463         next = next_frame_internal (frame, Qt, console,
1464                                     called_from_delete_device);
1465       if (NILP (next) || EQ (next, frame))
1466         next = next_frame_internal (frame, Qt, Qt, called_from_delete_device);
1467
1468       /* if we haven't found another frame at this point
1469          then there aren't any. */
1470       if (NILP (next) || EQ (next, frame))
1471         ;
1472       else
1473         {
1474           int did_select = 0;
1475           /* if this is the global selected frame, select another one. */
1476           if (EQ (frame, Fselected_frame (Qnil)))
1477             {
1478                 Fselect_frame (next);
1479                 did_select = 1;
1480             }
1481           /*
1482            * If the new frame we just selected is on a different
1483            * device then we still need to change DEVICE_SELECTED_FRAME(d)
1484            * to a live frame, if there are any left on this device.
1485            */
1486           if (!EQ (device, FRAME_DEVICE(XFRAME(next))))
1487             {
1488                 Lisp_Object next_f =
1489                     next_frame_internal (frame, Qt, device,
1490                                          called_from_delete_device);
1491                 if (NILP (next_f) || EQ (next_f, frame))
1492                   ;
1493                 else
1494                   set_device_selected_frame (d, next_f);
1495             }
1496           else if (! did_select)
1497             set_device_selected_frame (d, next);
1498
1499         }
1500     }
1501
1502   /* Don't allow minibuf_window to remain on a deleted frame.  */
1503   if (EQ (f->minibuffer_window, minibuf_window))
1504     {
1505       struct frame *sel_frame = selected_frame ();
1506       Fset_window_buffer (sel_frame->minibuffer_window,
1507                           XWINDOW (minibuf_window)->buffer);
1508       minibuf_window = sel_frame->minibuffer_window;
1509
1510       /* If the dying minibuffer window was selected,
1511          select the new one.  */
1512       if (minibuffer_selected)
1513         Fselect_window (minibuf_window, Qnil);
1514     }
1515
1516   /* After this point, no errors must be allowed to occur. */
1517
1518 #ifdef HAVE_MENUBARS
1519   free_frame_menubars (f);
1520 #endif
1521 #ifdef HAVE_SCROLLBARS
1522   free_frame_scrollbars (f);
1523 #endif
1524 #ifdef HAVE_TOOLBARS
1525   free_frame_toolbars (f);
1526 #endif
1527
1528   /* This must be done before the window and window_mirror structures
1529      are freed.  The scrollbar information is attached to them. */
1530   MAYBE_FRAMEMETH (f, delete_frame, (f));
1531
1532   /* Mark all the windows that used to be on FRAME as deleted, and then
1533      remove the reference to them.  */
1534   delete_all_subwindows (XWINDOW (f->root_window));
1535   f->root_window = Qnil;
1536
1537   /* Remove the frame now from the list.  This way, any events generated
1538      on this frame by the maneuvers below will disperse themselves. */
1539
1540   /* This used to be Fdelq(), but that will cause a seg fault if the
1541      QUIT checker happens to get invoked, because the frame list is in
1542      an inconsistent state. */
1543   d->frame_list = delq_no_quit (frame, d->frame_list);
1544   RESET_CHANGED_SET_FLAGS;
1545
1546   f->dead = 1;
1547   f->visible = 0;
1548
1549   free_window_mirror (f->root_mirror);
1550 /*  free_line_insertion_deletion_costs (f); */
1551
1552   /* If we've deleted the last non-minibuf frame, then try to find
1553      another one.  */
1554   if (EQ (frame, CONSOLE_LAST_NONMINIBUF_FRAME (con)))
1555     {
1556       Lisp_Object frmcons, devcons;
1557
1558       set_console_last_nonminibuf_frame (con, Qnil);
1559
1560       CONSOLE_FRAME_LOOP_NO_BREAK (frmcons, devcons, con)
1561         {
1562           Lisp_Object ecran = XCAR (frmcons);
1563           if (!FRAME_MINIBUF_ONLY_P (XFRAME (ecran)))
1564             {
1565               set_console_last_nonminibuf_frame (con, ecran);
1566               goto double_break_1;
1567             }
1568         }
1569     }
1570  double_break_1:
1571
1572 #if 0
1573   /* The following test is degenerate FALSE */
1574   if (called_from_delete_device < 0)
1575     /* then we're being called from delete-console, and we shouldn't
1576        try to find another default-minibuffer frame for the console.
1577        */
1578     con->default_minibuffer_frame = Qnil;
1579 #endif
1580
1581   /* If we've deleted this console's default_minibuffer_frame, try to
1582      find another one.  Prefer minibuffer-only frames, but also notice
1583      frames with other windows.  */
1584   if (EQ (frame, con->default_minibuffer_frame))
1585     {
1586       Lisp_Object frmcons, devcons;
1587       /* The last frame we saw with a minibuffer, minibuffer-only or not.  */
1588       Lisp_Object frame_with_minibuf;
1589       /* Some frame we found on the same console, or nil if there are none. */
1590       Lisp_Object frame_on_same_console;
1591
1592       frame_on_same_console = Qnil;
1593       frame_with_minibuf = Qnil;
1594
1595       set_console_last_nonminibuf_frame (con, Qnil);
1596
1597       CONSOLE_FRAME_LOOP_NO_BREAK (frmcons, devcons, con)
1598         {
1599           Lisp_Object this;
1600           struct frame *f1;
1601
1602           this = XCAR (frmcons);
1603           f1 = XFRAME (this);
1604
1605           /* Consider only frames on the same console
1606              and only those with minibuffers.  */
1607           if (FRAME_HAS_MINIBUF_P (f1))
1608             {
1609               frame_with_minibuf = this;
1610               if (FRAME_MINIBUF_ONLY_P (f1))
1611                 goto double_break_2;
1612             }
1613
1614           frame_on_same_console = this;
1615         }
1616     double_break_2:
1617
1618       if (!NILP (frame_on_same_console))
1619         {
1620           /* We know that there must be some frame with a minibuffer out
1621              there.  If this were not true, all of the frames present
1622              would have to be minibuffer-less, which implies that at some
1623              point their minibuffer frames must have been deleted, but
1624              that is prohibited at the top; you can't delete surrogate
1625              minibuffer frames.  */
1626           if (NILP (frame_with_minibuf))
1627             abort ();
1628
1629           con->default_minibuffer_frame = frame_with_minibuf;
1630         }
1631       else
1632         /* No frames left on this console--say no minibuffer either.  */
1633         con->default_minibuffer_frame = Qnil;
1634     }
1635
1636   nuke_all_frame_slots (f); /* nobody should be accessing the device
1637                                or anything else any more, and making
1638                                them Qnil allows for better GC'ing
1639                                in case a pointer to the dead frame
1640                                continues to hang around. */
1641   f->framemeths = dead_console_methods;
1642   UNGCPRO;
1643 }
1644
1645 void
1646 io_error_delete_frame (Lisp_Object frame)
1647 {
1648   delete_frame_internal (XFRAME (frame), 1, 0, 1);
1649 }
1650
1651 DEFUN ("delete-frame", Fdelete_frame, 0, 2, "", /*
1652 Delete FRAME, permanently eliminating it from use.
1653 If omitted, FRAME defaults to the selected frame.
1654 A frame may not be deleted if its minibuffer is used by other frames.
1655 Normally, you cannot delete the last non-minibuffer-only frame (you must
1656 use `save-buffers-kill-emacs' or `kill-emacs').  However, if optional
1657 second argument FORCE is non-nil, you can delete the last frame. (This
1658 will automatically call `save-buffers-kill-emacs'.)
1659 */
1660        (frame, force))
1661 {
1662   /* This function can GC */
1663   struct frame *f;
1664
1665   if (NILP (frame))
1666     {
1667       f = selected_frame ();
1668       XSETFRAME (frame, f);
1669     }
1670   else
1671     {
1672       CHECK_FRAME (frame);
1673       f = XFRAME (frame);
1674     }
1675
1676   delete_frame_internal (f, !NILP (force), 0, 0);
1677   return Qnil;
1678 }
1679
1680 \f
1681 /* Return mouse position in character cell units.  */
1682
1683 static int
1684 mouse_pixel_position_1 (struct device *d, Lisp_Object *frame,
1685                         int *x, int *y)
1686 {
1687   switch (DEVMETH_OR_GIVEN (d, get_mouse_position, (d, frame, x, y), -1))
1688     {
1689     case 1:
1690       return 1;
1691
1692     case 0:
1693       *frame = Qnil;
1694       break;
1695
1696     case -1:
1697       *frame = DEVICE_SELECTED_FRAME (d);
1698       break;
1699
1700     default:
1701       abort (); /* method is incorrectly written */
1702     }
1703
1704   return 0;
1705 }
1706
1707 DEFUN ("mouse-pixel-position", Fmouse_pixel_position, 0, 1, 0, /*
1708 Return a list (WINDOW X . Y) giving the current mouse window and position.
1709 The position is given in pixel units, where (0, 0) is the upper-left corner.
1710
1711 When the cursor is not over a window, the return value is a list (nil nil).
1712
1713 DEVICE specifies the device on which to read the mouse position, and
1714 defaults to the selected device.  If the device is a mouseless terminal
1715 or Emacs hasn't been programmed to read its mouse position, it returns
1716 the device's selected window for WINDOW and nil for X and Y.
1717 */
1718        (device))
1719 {
1720   struct device *d = decode_device (device);
1721   Lisp_Object frame;
1722   Lisp_Object window = Qnil;
1723   Lisp_Object x = Qnil;
1724   Lisp_Object y = Qnil;
1725   int intx, inty;
1726
1727   if (mouse_pixel_position_1 (d, &frame, &intx, &inty) > 0)
1728     {
1729       struct window *w =
1730         find_window_by_pixel_pos (intx, inty, XFRAME (frame)->root_window);
1731       if (w)
1732         {
1733           XSETWINDOW (window, w);
1734
1735           /* Adjust the position to be relative to the window. */
1736           intx -= w->pixel_left;
1737           inty -= w->pixel_top;
1738           XSETINT (x, intx);
1739           XSETINT (y, inty);
1740         }
1741     }
1742   else if (FRAMEP (frame))
1743     window = FRAME_SELECTED_WINDOW (XFRAME (frame));
1744
1745   return Fcons (window, Fcons (x, y));
1746 }
1747
1748 DEFUN ("mouse-position", Fmouse_position, 0, 1, 0, /*
1749 Return a list (WINDOW X . Y) giving the current mouse window and position.
1750 The position is of a character under cursor, where (0, 0) is the upper-left
1751 corner of the window.
1752
1753 When the cursor is not over a character, or not over a window, the return
1754 value is a list (nil nil).
1755
1756 DEVICE specifies the device on which to read the mouse position, and
1757 defaults to the selected device.  If the device is a mouseless terminal
1758 or Emacs hasn't been programmed to read its mouse position, it returns
1759 the device's selected window for WINDOW and nil for X and Y.
1760 */
1761        (device))
1762 {
1763   struct device *d = decode_device (device);
1764   struct window *w;
1765   Lisp_Object frame, window = Qnil, lisp_x = Qnil, lisp_y = Qnil;
1766   int x, y, obj_x, obj_y;
1767   Bufpos bufpos, closest;
1768   Charcount modeline_closest;
1769   Lisp_Object obj1, obj2;
1770
1771   if (mouse_pixel_position_1 (d, &frame, &x, &y) > 0)
1772     {
1773       int res = pixel_to_glyph_translation (XFRAME (frame), x, y, &x, &y,
1774                                             &obj_x, &obj_y, &w, &bufpos,
1775                                             &closest, &modeline_closest,
1776                                             &obj1, &obj2);
1777       if (res == OVER_TEXT)
1778         {
1779           lisp_x = make_int (x);
1780           lisp_y = make_int (y);
1781           XSETWINDOW (window, w);
1782         }
1783     }
1784   else if (FRAMEP (frame))
1785     window = FRAME_SELECTED_WINDOW (XFRAME (frame));
1786
1787   return Fcons (window, Fcons (lisp_x, lisp_y));
1788 }
1789
1790 DEFUN ("mouse-position-as-motion-event", Fmouse_position_as_motion_event, 0, 1, 0, /*
1791 Return the current mouse position as a motion event.
1792 This allows you to call the standard event functions such as
1793 `event-over-toolbar-p' to determine where the mouse is.
1794
1795 DEVICE specifies the device on which to read the mouse position, and
1796 defaults to the selected device.  If the mouse position can't be determined
1797 \(e.g. DEVICE is a TTY device), nil is returned instead of an event.
1798 */
1799        (device))
1800 {
1801   struct device *d = decode_device (device);
1802   Lisp_Object frame;
1803   int intx, inty;
1804
1805   if (mouse_pixel_position_1 (d, &frame, &intx, &inty))
1806     {
1807       Lisp_Object event = Fmake_event (Qnil, Qnil);
1808       XEVENT (event)->event_type = pointer_motion_event;
1809       XEVENT (event)->channel = frame;
1810       XEVENT (event)->event.motion.x = intx;
1811       XEVENT (event)->event.motion.y = inty;
1812       return event;
1813     }
1814   else
1815     return Qnil;
1816 }
1817
1818 DEFUN ("set-mouse-position", Fset_mouse_position, 3, 3, 0, /*
1819 Move the mouse pointer to the center of character cell (X,Y) in WINDOW.
1820 Note, this is a no-op for an X frame that is not visible.
1821 If you have just created a frame, you must wait for it to become visible
1822 before calling this function on it, like this.
1823   (while (not (frame-visible-p frame)) (sleep-for .5))
1824 Note also: Warping the mouse is contrary to the ICCCM, so be very sure
1825  that the behavior won't end up being obnoxious!
1826 */
1827        (window, x, y))
1828 {
1829   struct window *w;
1830   int pix_x, pix_y;
1831
1832   CHECK_WINDOW (window);
1833   CHECK_INT (x);
1834   CHECK_INT (y);
1835
1836   /* Warping the mouse will cause EnterNotify and Focus events under X. */
1837   w = XWINDOW (window);
1838   glyph_to_pixel_translation (w, XINT (x), XINT (y), &pix_x, &pix_y);
1839
1840   MAYBE_FRAMEMETH (XFRAME (w->frame), set_mouse_position, (w, pix_x, pix_y));
1841
1842   return Qnil;
1843 }
1844
1845 DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position, 3, 3, 0, /*
1846 Move the mouse pointer to pixel position (X,Y) in WINDOW.
1847 Note, this is a no-op for an X frame that is not visible.
1848 If you have just created a frame, you must wait for it to become visible
1849 before calling this function on it, like this.
1850   (while (not (frame-visible-p frame)) (sleep-for .5))
1851 */
1852        (window, x, y))
1853 {
1854   struct window *w;
1855
1856   CHECK_WINDOW (window);
1857   CHECK_INT (x);
1858   CHECK_INT (y);
1859
1860   /* Warping the mouse will cause EnterNotify and Focus events under X. */
1861   w = XWINDOW (window);
1862   FRAMEMETH (XFRAME (w->frame), set_mouse_position, (w, XINT (x), XINT (y)));
1863
1864   return Qnil;
1865 }
1866 \f
1867 DEFUN ("make-frame-visible", Fmake_frame_visible, 0, 1, 0, /*
1868 Make the frame FRAME visible (assuming it is an X-window).
1869 If omitted, FRAME defaults to the currently selected frame.
1870 Also raises the frame so that nothing obscures it.
1871 */
1872        (frame))
1873 {
1874   struct frame *f = decode_frame (frame);
1875
1876   MAYBE_FRAMEMETH (f, make_frame_visible, (f));
1877   return frame;
1878 }
1879
1880 DEFUN ("make-frame-invisible", Fmake_frame_invisible, 0, 2, 0, /*
1881 Unconditionally removes frame from the display (assuming it is an X-window).
1882 If omitted, FRAME defaults to the currently selected frame.
1883 If what you want to do is iconify the frame (if the window manager uses
1884 icons) then you should call `iconify-frame' instead.
1885 Normally you may not make FRAME invisible if all other frames are invisible
1886 and uniconified, but if the second optional argument FORCE is non-nil,
1887 you may do so.
1888 */
1889        (frame, force))
1890 {
1891   struct frame *f, *sel_frame;
1892   struct device *d;
1893
1894   f = decode_frame (frame);
1895   d = XDEVICE (FRAME_DEVICE (f));
1896   sel_frame = XFRAME (DEVICE_SELECTED_FRAME (d));
1897
1898   if (NILP (force) && !other_visible_frames (f))
1899     error ("Attempt to make invisible the sole visible or iconified frame");
1900
1901   /* Don't allow minibuf_window to remain on a deleted frame.  */
1902   if (EQ (f->minibuffer_window, minibuf_window))
1903     {
1904       Fset_window_buffer (sel_frame->minibuffer_window,
1905                           XWINDOW (minibuf_window)->buffer);
1906       minibuf_window = sel_frame->minibuffer_window;
1907     }
1908
1909   MAYBE_FRAMEMETH (f, make_frame_invisible, (f));
1910
1911   return Qnil;
1912 }
1913
1914 DEFUN ("iconify-frame", Ficonify_frame, 0, 1, "", /*
1915 Make the frame FRAME into an icon, if the window manager supports icons.
1916 If omitted, FRAME defaults to the currently selected frame.
1917 */
1918        (frame))
1919 {
1920   struct frame *f, *sel_frame;
1921   struct device *d;
1922
1923   f = decode_frame (frame);
1924   d = XDEVICE (FRAME_DEVICE (f));
1925   sel_frame = XFRAME (DEVICE_SELECTED_FRAME (d));
1926
1927   /* Don't allow minibuf_window to remain on a deleted frame.  */
1928   if (EQ (f->minibuffer_window, minibuf_window))
1929     {
1930       Fset_window_buffer (sel_frame->minibuffer_window,
1931                           XWINDOW (minibuf_window)->buffer);
1932       minibuf_window = sel_frame->minibuffer_window;
1933     }
1934
1935   MAYBE_FRAMEMETH (f, iconify_frame, (f));
1936
1937   return Qnil;
1938 }
1939
1940 DEFUN ("deiconify-frame", Fdeiconify_frame, 0, 1, 0, /*
1941 Open (de-iconify) the iconified frame FRAME.
1942 Under X, this is currently the same as `make-frame-visible'.
1943 If omitted, FRAME defaults to the currently selected frame.
1944 Also raises the frame so that nothing obscures it.
1945 */
1946        (frame))
1947 {
1948   return Fmake_frame_visible (frame);
1949 }
1950
1951 /* FSF returns 'icon for iconized frames.  What a crock! */
1952
1953 DEFUN ("frame-visible-p", Fframe_visible_p, 0, 1, 0, /*
1954 Return non NIL if FRAME is now "visible" (actually in use for display).
1955 A frame that is not visible is not updated, and, if it works through a
1956 window system, may not show at all.
1957 N.B. Under X "visible" means Mapped. It the window is mapped but not
1958 actually visible on screen then frame_visible returns 'hidden.
1959 */
1960        (frame))
1961 {
1962   struct frame *f = decode_frame (frame);
1963   int visible = FRAMEMETH_OR_GIVEN (f, frame_visible_p, (f), f->visible);
1964   return visible ? ( visible > 0 ? Qt : Qhidden ) : Qnil;
1965 }
1966
1967 DEFUN ("frame-totally-visible-p", Fframe_totally_visible_p, 0, 1, 0, /*
1968 Return t if frame is not obscured by any other window system windows.
1969 Always returns t for tty frames.
1970 */
1971        (frame))
1972 {
1973   struct frame *f = decode_frame (frame);
1974   return (FRAMEMETH_OR_GIVEN (f, frame_totally_visible_p, (f), f->visible)
1975           ? Qt : Qnil);
1976 }
1977
1978 DEFUN ("frame-iconified-p", Fframe_iconified_p, 0, 1, 0, /*
1979 Return t if FRAME is iconified.
1980 Not all window managers use icons; some merely unmap the window, so this
1981 function is not the inverse of `frame-visible-p'.  It is possible for a
1982 frame to not be visible and not be iconified either.  However, if the
1983 frame is iconified, it will not be visible.
1984 */
1985        (frame))
1986 {
1987   struct frame *f = decode_frame (frame);
1988   if (f->visible)
1989     return Qnil;
1990   f->iconified = FRAMEMETH_OR_GIVEN (f, frame_iconified_p, (f), 0);
1991   return f->iconified ? Qt : Qnil;
1992 }
1993
1994 DEFUN ("visible-frame-list", Fvisible_frame_list, 0, 1, 0, /*
1995 Return a list of all frames now "visible" (being updated).
1996 If DEVICE is specified only frames on that device will be returned.
1997 Note that under virtual window managers not all these frame are necessarily
1998 really updated.
1999 */
2000        (device))
2001 {
2002   Lisp_Object devcons, concons;
2003   struct frame *f;
2004   Lisp_Object value;
2005
2006   value = Qnil;
2007
2008   DEVICE_LOOP_NO_BREAK (devcons, concons)
2009     {
2010       assert (DEVICEP (XCAR (devcons)));
2011
2012       if (NILP (device) || EQ (device, XCAR (devcons)))
2013         {
2014           Lisp_Object frmcons;
2015
2016           DEVICE_FRAME_LOOP (frmcons, XDEVICE (XCAR (devcons)))
2017             {
2018               Lisp_Object frame = XCAR (frmcons);
2019               f = XFRAME (frame);
2020               if (FRAME_VISIBLE_P(f))
2021                 value = Fcons (frame, value);
2022             }
2023         }
2024     }
2025
2026   return value;
2027 }
2028
2029 \f
2030 DEFUN ("raise-frame", Fraise_frame, 0, 1, "", /*
2031 Bring FRAME to the front, so it occludes any frames it overlaps.
2032 If omitted, FRAME defaults to the currently selected frame.
2033 If FRAME is invisible, make it visible.
2034 If Emacs is displaying on an ordinary terminal or some other device which
2035 doesn't support multiple overlapping frames, this function does nothing.
2036 */
2037        (frame))
2038 {
2039   struct frame *f = decode_frame (frame);
2040
2041   /* Do like the documentation says. */
2042   Fmake_frame_visible (frame);
2043   MAYBE_FRAMEMETH (f, raise_frame, (f));
2044   return Qnil;
2045 }
2046
2047 DEFUN ("lower-frame", Flower_frame, 0, 1, "", /*
2048 Send FRAME to the back, so it is occluded by any frames that overlap it.
2049 If omitted, FRAME defaults to the currently selected frame.
2050 If Emacs is displaying on an ordinary terminal or some other device which
2051 doesn't support multiple overlapping frames, this function does nothing.
2052 */
2053        (frame))
2054 {
2055   struct frame *f = decode_frame (frame);
2056
2057   MAYBE_FRAMEMETH (f, lower_frame, (f));
2058   return Qnil;
2059 }
2060
2061 /* Ben thinks there is no need for `redirect-frame-focus' or `frame-focus',
2062    crockish FSFmacs functions.  See summary on focus in event-stream.c. */
2063
2064 \f
2065 /***************************************************************************/
2066 /*                           frame properties                              */
2067 /***************************************************************************/
2068
2069 static void internal_set_frame_size (struct frame *f, int cols, int rows,
2070                                      int pretend);
2071
2072 static void
2073 store_minibuf_frame_prop (struct frame *f, Lisp_Object val)
2074 {
2075   Lisp_Object frame;
2076   XSETFRAME (frame, f);
2077
2078   if (WINDOWP (val))
2079     {
2080       if (! MINI_WINDOW_P (XWINDOW (val)))
2081         signal_simple_error
2082           ("Surrogate minibuffer windows must be minibuffer windows",
2083            val);
2084
2085       if (FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
2086         signal_simple_error
2087           ("Can't change the surrogate minibuffer of a frame with its own minibuffer", frame);
2088
2089       /* Install the chosen minibuffer window, with proper buffer.  */
2090       f->minibuffer_window = val;
2091     }
2092   else if (EQ (val, Qt))
2093     {
2094       if (FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
2095         signal_simple_error
2096           ("Frame already has its own minibuffer", frame);
2097       else
2098         {
2099           setup_normal_frame (f);
2100           f->mirror_dirty = 1;
2101
2102           update_frame_window_mirror (f);
2103           internal_set_frame_size (f, f->width, f->height, 1);
2104         }
2105     }
2106 }
2107
2108 #if 0
2109
2110 /* possible code if you want to have symbols such as `default-background'
2111    map to setting the background of `default', etc. */
2112
2113 static int
2114 dissect_as_face_setting (Lisp_Object sym, Lisp_Object *face_out,
2115                          Lisp_Object *face_prop_out)
2116 {
2117   Lisp_Object list = Vbuilt_in_face_specifiers;
2118   struct Lisp_String *s;
2119
2120   if (!SYMBOLP (sym))
2121     return 0;
2122
2123   s = symbol_name (XSYMBOL (sym));
2124
2125   while (!NILP (list))
2126     {
2127       Lisp_Object prop = Fcar (list);
2128       struct Lisp_String *prop_name;
2129
2130       if (!SYMBOLP (prop))
2131         continue;
2132       prop_name = symbol_name (XSYMBOL (prop));
2133       if (string_length (s) > string_length (prop_name) + 1
2134           && !memcmp (string_data (prop_name),
2135                       string_data (s) + string_length (s)
2136                       - string_length (prop_name),
2137                       string_length (prop_name))
2138           && string_data (s)[string_length (s) - string_length (prop_name)
2139                              - 1] == '-')
2140         {
2141           Lisp_Object face =
2142             Ffind_face (make_string (string_data (s),
2143                                      string_length (s)
2144                                      - string_length (prop_name)
2145                                      - 1));
2146           if (!NILP (face))
2147             {
2148               *face_out = face;
2149               *face_prop_out = prop;
2150               return 1;
2151             }
2152         }
2153
2154       list = Fcdr (list);
2155     }
2156
2157   return 0;
2158 }
2159
2160 #endif /* 0 */
2161
2162 static Lisp_Object
2163 get_property_alias (Lisp_Object prop)
2164 {
2165   while (1)
2166     {
2167       Lisp_Object alias = Qnil;
2168
2169       if (SYMBOLP (prop))
2170         alias = Fget (prop, Qframe_property_alias, Qnil);
2171       if (NILP (alias))
2172         break;
2173       prop = alias;
2174       QUIT;
2175     }
2176
2177   return prop;
2178 }
2179
2180 /* #### Using this to modify the internal border width has no effect
2181    because the change isn't propagated to the windows.  Are there
2182    other properties which this claims to handle, but doesn't?
2183
2184    But of course.  This stuff needs more work, but it's a lot closer
2185    to sanity now than before with the horrible frame-params stuff. */
2186
2187 DEFUN ("set-frame-properties", Fset_frame_properties, 2, 2, 0, /*
2188 Change some properties of a frame.
2189 PLIST is a property list.
2190 You can also change frame properties individually using `set-frame-property',
2191 but it may be more efficient to change many properties at once.
2192
2193 Frame properties can be retrieved using `frame-property' or `frame-properties'.
2194
2195 The following symbols etc. have predefined meanings:
2196
2197  name           Name of the frame.  Used with X resources.
2198                 Unchangeable after creation.
2199
2200  height         Height of the frame, in lines.
2201
2202  width          Width of the frame, in characters.
2203
2204  minibuffer     Gives the minibuffer behavior for this frame.  Either
2205                 t (frame has its own minibuffer), `only' (frame is
2206                 a minibuffer-only frame), or a window (frame uses that
2207                 window, which is on another frame, as the minibuffer).
2208
2209  unsplittable   If non-nil, frame cannot be split by `display-buffer'.
2210
2211  current-display-table, menubar-visible-p, left-margin-width,
2212  right-margin-width, minimum-line-ascent, minimum-line-descent,
2213  use-left-overflow, use-right-overflow, scrollbar-width, scrollbar-height,
2214  default-toolbar, top-toolbar, bottom-toolbar, left-toolbar, right-toolbar,
2215  default-toolbar-height, default-toolbar-width, top-toolbar-height,
2216  bottom-toolbar-height, left-toolbar-width, right-toolbar-width,
2217  default-toolbar-visible-p, top-toolbar-visible-p, bottom-toolbar-visible-p,
2218  left-toolbar-visible-p, right-toolbar-visible-p, toolbar-buttons-captioned-p,
2219  top-toolbar-border-width, bottom-toolbar-border-width,
2220  left-toolbar-border-width, right-toolbar-border-width,
2221  modeline-shadow-thickness, has-modeline-p
2222                 [Giving the name of any built-in specifier variable is
2223                 equivalent to calling `set-specifier' on the specifier,
2224                 with a locale of FRAME.  Giving the name to `frame-property'
2225                 calls `specifier-instance' on the specifier.]
2226
2227  text-pointer-glyph, nontext-pointer-glyph, modeline-pointer-glyph,
2228  selection-pointer-glyph, busy-pointer-glyph, toolbar-pointer-glyph,
2229  menubar-pointer-glyph, scrollbar-pointer-glyph, gc-pointer-glyph,
2230  octal-escape-glyph, control-arrow-glyph, invisible-text-glyph,
2231  hscroll-glyph, truncation-glyph, continuation-glyph
2232                 [Giving the name of any glyph variable is equivalent to
2233                 calling `set-glyph-image' on the glyph, with a locale
2234                 of FRAME.  Giving the name to `frame-property' calls
2235                 `glyph-image-instance' on the glyph.]
2236
2237  [default foreground], [default background], [default font],
2238  [modeline foreground], [modeline background], [modeline font],
2239  etc.
2240                 [Giving a vector of a face and a property is equivalent
2241                 to calling `set-face-property' on the face and property,
2242                 with a locale of FRAME.  Giving the vector to
2243                 `frame-property' calls `face-property-instance' on the
2244                 face and property.]
2245
2246 Finally, if a frame property symbol has the property `frame-property-alias'
2247 on it, then the value will be used in place of that symbol when looking
2248 up and setting frame property values.  This allows you to alias one
2249 frame property name to another.
2250
2251 See the variables `default-x-frame-plist', `default-tty-frame-plist'
2252 and `default-mswindows-frame-plist' for a description of the properties
2253 recognized for particular types of frames.
2254 */
2255        (frame, plist))
2256 {
2257   struct frame *f = decode_frame (frame);
2258   Lisp_Object tail;
2259   Lisp_Object *tailp;
2260   struct gcpro gcpro1, gcpro2;
2261
2262   XSETFRAME (frame, f);
2263   GCPRO2 (frame, plist);
2264   Fcheck_valid_plist (plist);
2265   plist = Fcopy_sequence (plist);
2266   Fcanonicalize_lax_plist (plist, Qnil);
2267   for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail)))
2268     {
2269       Lisp_Object prop = Fcar (tail);
2270       Lisp_Object val = Fcar (Fcdr (tail));
2271
2272       prop = get_property_alias (prop);
2273
2274 #if 0
2275       /* mly wants this, but it's not reasonable to change the name of a
2276          frame after it has been created, because the old name was used
2277          for resource lookup. */
2278       if (EQ (prop, Qname))
2279         {
2280           CHECK_STRING (val);
2281           f->name = val;
2282         }
2283 #endif /* 0 */
2284       if (EQ (prop, Qminibuffer))
2285         store_minibuf_frame_prop (f, val);
2286       if (EQ (prop, Qunsplittable))
2287         f->no_split = !NILP (val);
2288       if (EQ (prop, Qbuffer_predicate))
2289         f->buffer_predicate = val;
2290       if (SYMBOLP (prop) && EQ (Fbuilt_in_variable_type (prop),
2291                                 Qconst_specifier))
2292         call3 (Qset_specifier, Fsymbol_value (prop), val, frame);
2293       if (SYMBOLP (prop) && !NILP (Fget (prop, Qconst_glyph_variable, Qnil)))
2294         call3 (Qset_glyph_image, Fsymbol_value (prop), val, frame);
2295       if (VECTORP (prop) && XVECTOR_LENGTH (prop) == 2)
2296         {
2297           Lisp_Object face_prop = XVECTOR_DATA (prop)[1];
2298           CHECK_SYMBOL (face_prop);
2299           call4 (Qset_face_property,
2300                  Fget_face (XVECTOR_DATA (prop)[0]),
2301                  face_prop, val, frame);
2302         }
2303     }
2304
2305   MAYBE_FRAMEMETH (f, set_frame_properties, (f, plist));
2306   for (tailp = &plist; !NILP (*tailp);)
2307     {
2308       Lisp_Object *next_tailp;
2309       Lisp_Object next;
2310       Lisp_Object prop;
2311
2312       next = Fcdr (*tailp);
2313       CHECK_CONS (next);
2314       next_tailp = &XCDR (next);
2315       prop = Fcar (*tailp);
2316
2317       prop = get_property_alias (prop);
2318
2319       if (EQ (prop, Qminibuffer)
2320           || EQ (prop, Qunsplittable)
2321           || EQ (prop, Qbuffer_predicate)
2322           || EQ (prop, Qheight)
2323           || EQ (prop, Qwidth)
2324           || (SYMBOLP (prop) && EQ (Fbuilt_in_variable_type (prop),
2325                                     Qconst_specifier))
2326           || (SYMBOLP (prop) && !NILP (Fget (prop, Qconst_glyph_variable,
2327                                              Qnil)))
2328           || (VECTORP (prop) && XVECTOR_LENGTH (prop) == 2)
2329           || FRAMEMETH_OR_GIVEN (f, internal_frame_property_p, (f, prop), 0))
2330         *tailp = *next_tailp;
2331       tailp = next_tailp;
2332     }
2333
2334   f->plist = nconc2 (plist, f->plist);
2335   Fcanonicalize_lax_plist (f->plist, Qnil);
2336   UNGCPRO;
2337   return Qnil;
2338 }
2339
2340 DEFUN ("frame-property", Fframe_property, 2, 3, 0, /*
2341 Return FRAME's value for property PROPERTY.
2342 See `set-frame-properties' for the built-in property names.
2343 */
2344        (frame, property, default_))
2345 {
2346   struct frame *f = decode_frame (frame);
2347   Lisp_Object value;
2348
2349   XSETFRAME (frame, f);
2350
2351   property = get_property_alias (property);
2352
2353   if (EQ (Qname, property)) return f->name;
2354
2355   if (EQ (Qheight, property) || EQ (Qwidth, property))
2356     {
2357       if (window_system_pixelated_geometry (frame))
2358         {
2359           int width, height;
2360           pixel_to_real_char_size (f, FRAME_PIXWIDTH (f), FRAME_PIXHEIGHT (f),
2361                                    &width, &height);
2362           return make_int (EQ (Qheight, property) ? height: width);
2363         }
2364       else
2365         return make_int (EQ (Qheight, property) ?
2366                          FRAME_HEIGHT (f) :
2367                          FRAME_WIDTH  (f));
2368     }
2369
2370   /* NOTE: FSF returns Qnil instead of Qt for FRAME_HAS_MINIBUF_P.
2371      This is over-the-top bogosity, because it's inconsistent with
2372      the semantics of `minibuffer' when passed to `make-frame'.
2373      Returning Qt makes things consistent. */
2374   if (EQ (Qminibuffer, property))
2375     return (FRAME_MINIBUF_ONLY_P (f) ? Qonly :
2376             FRAME_HAS_MINIBUF_P  (f) ? Qt    :
2377             FRAME_MINIBUF_WINDOW (f));
2378   if (EQ (Qunsplittable, property))
2379     return FRAME_NO_SPLIT_P (f) ? Qt : Qnil;
2380   if (EQ (Qbuffer_predicate, property))
2381     return f->buffer_predicate;
2382
2383   if (SYMBOLP (property))
2384     {
2385       if (EQ (Fbuilt_in_variable_type (property), Qconst_specifier))
2386         return Fspecifier_instance (Fsymbol_value (property),
2387                                     frame, default_, Qnil);
2388       if (!NILP (Fget (property, Qconst_glyph_variable, Qnil)))
2389         {
2390           Lisp_Object glyph = Fsymbol_value (property);
2391           CHECK_GLYPH (glyph);
2392           return Fspecifier_instance (XGLYPH_IMAGE (glyph),
2393                                       frame, default_, Qnil);
2394         }
2395     }
2396
2397   if (VECTORP (property) && XVECTOR_LENGTH (property) == 2)
2398     {
2399       Lisp_Object face_prop = XVECTOR_DATA (property)[1];
2400       CHECK_SYMBOL (face_prop);
2401       return call3 (Qface_property_instance,
2402                     Fget_face (XVECTOR_DATA (property)[0]),
2403                     face_prop, frame);
2404     }
2405
2406   if (HAS_FRAMEMETH_P (f, frame_property))
2407     if (!UNBOUNDP (value = FRAMEMETH (f, frame_property, (f, property))))
2408       return value;
2409
2410   if (!UNBOUNDP (value = external_plist_get (&f->plist, property, 1, ERROR_ME)))
2411     return value;
2412
2413   return default_;
2414 }
2415
2416 DEFUN ("frame-properties", Fframe_properties, 0, 1, 0, /*
2417 Return a property list of the properties of FRAME.
2418 Do not modify this list; use `set-frame-property' instead.
2419 */
2420        (frame))
2421 {
2422   struct frame *f = decode_frame (frame);
2423   Lisp_Object result = Qnil;
2424   struct gcpro gcpro1;
2425
2426   GCPRO1 (result);
2427
2428   XSETFRAME (frame, f);
2429
2430   /* #### for the moment (since old code uses `frame-parameters'),
2431      we call `copy-sequence' on f->plist.  That allows frame-parameters
2432      to destructively convert the plist into an alist, which is more
2433      efficient than doing it non-destructively.  At some point we
2434      should remove the call to copy-sequence. */
2435   result = Fcopy_sequence (f->plist);
2436
2437   /* #### should we be adding all the specifiers and glyphs?
2438      That would entail having a list of them all. */
2439   if (HAS_FRAMEMETH_P (f, frame_properties))
2440     result = nconc2 (FRAMEMETH (f, frame_properties, (f)), result);
2441
2442   if (!NILP (f->buffer_predicate))
2443     result = cons3 (Qbuffer_predicate, f->buffer_predicate, result);
2444
2445   if (FRAME_NO_SPLIT_P (f))
2446     result = cons3 (Qunsplittable, Qt, result);
2447
2448   /* NOTE: FSF returns Qnil instead of Qt for FRAME_HAS_MINIBUF_P.
2449      This is over-the-top bogosity, because it's inconsistent with
2450      the semantics of `minibuffer' when passed to `make-frame'.
2451      Returning Qt makes things consistent. */
2452   result = cons3 (Qminibuffer,
2453                   (FRAME_MINIBUF_ONLY_P (f) ? Qonly :
2454                    FRAME_HAS_MINIBUF_P  (f) ? Qt    :
2455                    FRAME_MINIBUF_WINDOW (f)),
2456                   result);
2457   {
2458     int width, height;
2459
2460     if (window_system_pixelated_geometry (frame))
2461       {
2462         pixel_to_real_char_size (f, FRAME_PIXWIDTH (f), FRAME_PIXHEIGHT (f),
2463                                  &width, &height);
2464       }
2465     else
2466       {
2467         height = FRAME_HEIGHT (f);
2468         width = FRAME_WIDTH (f);
2469       }
2470     result = cons3 (Qwidth , make_int (width),  result);
2471     result = cons3 (Qheight, make_int (height), result);
2472   }
2473
2474   result = cons3 (Qname, f->name, result);
2475
2476   UNGCPRO;
2477   return result;
2478 }
2479
2480 \f
2481 DEFUN ("frame-pixel-height", Fframe_pixel_height, 0, 1, 0, /*
2482 Return the height in pixels of FRAME.
2483 */
2484        (frame))
2485 {
2486   return make_int (decode_frame (frame)->pixheight);
2487 }
2488
2489 DEFUN ("frame-pixel-width", Fframe_pixel_width, 0, 1, 0, /*
2490 Return the width in pixels of FRAME.
2491 */
2492        (frame))
2493 {
2494   return make_int (decode_frame (frame)->pixwidth);
2495 }
2496
2497 DEFUN ("frame-name", Fframe_name, 0, 1, 0, /*
2498 Return the name of FRAME (defaulting to the selected frame).
2499 This is not the same as the `title' of the frame.
2500 */
2501        (frame))
2502 {
2503   return decode_frame (frame)->name;
2504 }
2505
2506 DEFUN ("frame-modified-tick", Fframe_modified_tick, 0, 1, 0, /*
2507 Return FRAME's tick counter, incremented for each change to the frame.
2508 Each frame has a tick counter which is incremented each time the frame
2509 is resized, a window is resized, added, or deleted, a face is changed,
2510 `set-window-buffer' or `select-window' is called on a window in the
2511 frame, the window-start of a window in the frame has changed, or
2512 anything else interesting has happened.  It wraps around occasionally.
2513 No argument or nil as argument means use selected frame as FRAME.
2514 */
2515        (frame))
2516 {
2517   return make_int (decode_frame (frame)->modiff);
2518 }
2519
2520 static void
2521 internal_set_frame_size (struct frame *f, int cols, int rows, int pretend)
2522 {
2523   /* An explicit size change cancels any pending frame size adjustment */
2524   CLEAR_FRAME_SIZE_SLIPPED(f);
2525
2526   if (pretend || !HAS_FRAMEMETH_P (f, set_frame_size))
2527     change_frame_size (f, rows, cols, 0);
2528   else
2529     FRAMEMETH (f, set_frame_size, (f, cols, rows));
2530 }
2531
2532 DEFUN ("set-frame-height", Fset_frame_height, 2, 3, 0, /*
2533 Specify that the frame FRAME has LINES lines.
2534 Optional third arg non-nil means that redisplay should use LINES lines
2535 but that the idea of the actual height of the frame should not be changed.
2536 */
2537        (frame, rows, pretend))
2538 {
2539   struct frame *f = decode_frame (frame);
2540   int height, width;
2541   XSETFRAME (frame, f);
2542   CHECK_INT (rows);
2543
2544   if (window_system_pixelated_geometry (frame))
2545     {
2546       char_to_real_pixel_size (f, 0, XINT (rows), 0, &height);
2547       width = FRAME_PIXWIDTH (f);
2548     }
2549   else
2550     {
2551       height = XINT (rows);
2552       width = FRAME_WIDTH (f);
2553     }
2554
2555   internal_set_frame_size (f, width, height, !NILP (pretend));
2556   return frame;
2557 }
2558
2559 DEFUN ("set-frame-width", Fset_frame_width, 2, 3, 0, /*
2560 Specify that the frame FRAME has COLS columns.
2561 Optional third arg non-nil means that redisplay should use COLS columns
2562 but that the idea of the actual width of the frame should not be changed.
2563 */
2564        (frame, cols, pretend))
2565 {
2566   struct frame *f = decode_frame (frame);
2567   int width, height;
2568   XSETFRAME (frame, f);
2569   CHECK_INT (cols);
2570
2571   if (window_system_pixelated_geometry (frame))
2572     {
2573       char_to_real_pixel_size (f, XINT (cols), 0, &width, 0);
2574       height = FRAME_PIXHEIGHT (f);
2575     }
2576   else
2577     {
2578       width = XINT (cols);
2579       height = FRAME_HEIGHT (f);
2580     }
2581
2582   internal_set_frame_size (f, width, height, !NILP (pretend));
2583   return frame;
2584 }
2585
2586 DEFUN ("set-frame-size", Fset_frame_size, 3, 4, 0, /*
2587 Set the size of FRAME to COLS by ROWS.
2588 Optional fourth arg non-nil means that redisplay should use COLS by ROWS
2589 but that the idea of the actual size of the frame should not be changed.
2590 */
2591        (frame, cols, rows, pretend))
2592 {
2593   struct frame *f = decode_frame (frame);
2594   int height, width;
2595   XSETFRAME (frame, f);
2596   CHECK_INT (cols);
2597   CHECK_INT (rows);
2598
2599   if (window_system_pixelated_geometry (frame))
2600     char_to_real_pixel_size (f, XINT (cols), XINT (rows), &width, &height);
2601   else
2602     {
2603       height = XINT (rows);
2604       width = XINT (cols);
2605     }
2606
2607   internal_set_frame_size (f, width, height, !NILP (pretend));
2608   return frame;
2609 }
2610
2611 DEFUN ("set-frame-position", Fset_frame_position, 3, 3, 0, /*
2612 Set position of FRAME in pixels to XOFFSET by YOFFSET.
2613 This is actually the position of the upper left corner of the frame.
2614 Negative values for XOFFSET or YOFFSET are interpreted relative to
2615 the rightmost or bottommost possible position (that stays within the screen).
2616 */
2617        (frame, xoffset, yoffset))
2618 {
2619   struct frame *f = decode_frame (frame);
2620   CHECK_INT (xoffset);
2621   CHECK_INT (yoffset);
2622
2623   MAYBE_FRAMEMETH (f, set_frame_position, (f, XINT (xoffset), XINT (yoffset)));
2624
2625   return Qt;
2626 }
2627
2628 \f
2629
2630 /* Frame size conversion functions moved here from EmacsFrame.c
2631    because they're generic and really don't belong in that file.
2632    Function get_default_char_pixel_size() removed because it's
2633    exactly the same as default_face_height_and_width(). */
2634 static void
2635 frame_conversion_internal (struct frame *f, int pixel_to_char,
2636                            int *pixel_width, int *pixel_height,
2637                            int *char_width, int *char_height,
2638                            int real_face)
2639 {
2640   int cpw;
2641   int cph;
2642   int egw;
2643   int obw, obh, bdr;
2644   Lisp_Object frame, window;
2645
2646   XSETFRAME (frame, f);
2647   if (real_face)
2648     default_face_height_and_width (frame, &cph, &cpw);
2649   else
2650     default_face_height_and_width_1 (frame, &cph, &cpw);
2651
2652   window = FRAME_SELECTED_WINDOW (f);
2653
2654   egw = max (glyph_width (Vcontinuation_glyph, Vdefault_face, 0, window),
2655              glyph_width (Vtruncation_glyph, Vdefault_face, 0, window));
2656   egw = max (egw, cpw);
2657   bdr = 2 * f->internal_border_width;
2658   obw = FRAME_SCROLLBAR_WIDTH (f) + FRAME_THEORETICAL_LEFT_TOOLBAR_WIDTH (f) +
2659     FRAME_THEORETICAL_RIGHT_TOOLBAR_WIDTH (f) +
2660     2 * FRAME_THEORETICAL_LEFT_TOOLBAR_BORDER_WIDTH (f) +
2661     2 * FRAME_THEORETICAL_RIGHT_TOOLBAR_BORDER_WIDTH (f);
2662   obh = FRAME_SCROLLBAR_HEIGHT (f) + FRAME_THEORETICAL_TOP_TOOLBAR_HEIGHT (f) +
2663     FRAME_THEORETICAL_BOTTOM_TOOLBAR_HEIGHT (f) +
2664     2 * FRAME_THEORETICAL_TOP_TOOLBAR_BORDER_WIDTH (f) +
2665     2 * FRAME_THEORETICAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f);
2666
2667   if (pixel_to_char)
2668     {
2669       if (char_width)
2670         *char_width = 1 + ((*pixel_width - egw) - bdr - obw) / cpw;
2671       if (char_height)
2672         *char_height = (*pixel_height - bdr - obh) / cph;
2673     }
2674   else
2675     {
2676       if (pixel_width)
2677         *pixel_width = (*char_width - 1) * cpw + egw + bdr + obw;
2678       if (pixel_height)
2679         *pixel_height = *char_height * cph + bdr + obh;
2680     }
2681 }
2682
2683 /* This takes the size in pixels of the text area, and returns the number
2684    of characters that will fit there, taking into account the internal
2685    border width, and the pixel width of the line terminator glyphs (which
2686    always count as one "character" wide, even if they are not the same size
2687    as the default character size of the default font).  The frame scrollbar
2688    width and left and right toolbar widths are also subtracted out of the
2689    available width.  The frame scrollbar height and top and bottom toolbar
2690    heights are subtracted out of the available height.
2691
2692    Therefore the result is not necessarily a multiple of anything in
2693    particular.  */
2694 void
2695 pixel_to_char_size (struct frame *f, int pixel_width, int pixel_height,
2696                     int *char_width, int *char_height)
2697 {
2698   frame_conversion_internal (f, 1, &pixel_width, &pixel_height, char_width,
2699                              char_height, 0);
2700 }
2701
2702 /* Given a character size, this returns the minimum number of pixels
2703    necessary to display that many characters, taking into account the
2704    internal border width, scrollbar height and width, toolbar heights and
2705    widths and the size of the line terminator glyphs (assuming the line
2706    terminators take up exactly one character position).
2707
2708    Therefore the result is not necessarily a multiple of anything in
2709    particular.  */
2710 void
2711 char_to_pixel_size (struct frame *f, int char_width, int char_height,
2712                     int *pixel_width, int *pixel_height)
2713 {
2714   frame_conversion_internal (f, 0, pixel_width, pixel_height, &char_width,
2715                              &char_height, 0);
2716 }
2717
2718 /* Given a pixel size, rounds DOWN to the smallest size in pixels necessary
2719    to display the same number of characters as are displayable now.
2720  */
2721 void
2722 round_size_to_char (struct frame *f, int in_width, int in_height,
2723                     int *out_width, int *out_height)
2724 {
2725   int char_width;
2726   int char_height;
2727   pixel_to_char_size (f, in_width, in_height, &char_width, &char_height);
2728   char_to_pixel_size (f, char_width, char_height, out_width, out_height);
2729 }
2730
2731 /* Versions of the above which always account for real font metrics.
2732  */
2733 void
2734 pixel_to_real_char_size (struct frame *f, int pixel_width, int pixel_height,
2735                          int *char_width, int *char_height)
2736 {
2737   frame_conversion_internal (f, 1, &pixel_width, &pixel_height, char_width,
2738                              char_height, 1);
2739 }
2740
2741 void
2742 char_to_real_pixel_size (struct frame *f, int char_width, int char_height,
2743                          int *pixel_width, int *pixel_height)
2744 {
2745   frame_conversion_internal (f, 0, pixel_width, pixel_height, &char_width,
2746                              &char_height, 1);
2747 }
2748
2749 void
2750 round_size_to_real_char (struct frame *f, int in_width, int in_height,
2751                          int *out_width, int *out_height)
2752 {
2753   int char_width;
2754   int char_height;
2755   pixel_to_real_char_size (f, in_width, in_height, &char_width, &char_height);
2756   char_to_real_pixel_size (f, char_width, char_height, out_width, out_height);
2757 }
2758
2759 /* Change the frame height and/or width.  Values may be given as zero to
2760    indicate no change is to take place. */
2761 static void
2762 change_frame_size_1 (struct frame *f, int newheight, int newwidth)
2763 {
2764   Lisp_Object frame;
2765   int new_pixheight, new_pixwidth;
2766   int font_height, real_font_height, font_width;
2767
2768   /* #### Chuck -- shouldn't we be checking to see if the frame
2769      is being "changed" to its existing size, and do nothing if so? */
2770   /* No, because it would hose toolbar updates.  The toolbar
2771      update code relies on this function to cause window `top' and
2772      `left' coordinates to be recomputed even though no frame size
2773      change occurs. --kyle */
2774   if (in_display)
2775     abort ();
2776
2777   XSETFRAME (frame, f);
2778
2779   default_face_height_and_width (frame, &real_font_height, 0);
2780   default_face_height_and_width_1 (frame, &font_height, &font_width);
2781
2782   /* This size-change overrides any pending one for this frame.  */
2783   FRAME_NEW_HEIGHT (f) = 0;
2784   FRAME_NEW_WIDTH (f) = 0;
2785
2786   new_pixheight = newheight * font_height;
2787   new_pixwidth = (newwidth - 1) * font_width;
2788
2789   /* #### dependency on FRAME_WIN_P should be removed. */
2790   if (FRAME_WIN_P (f))
2791     {
2792       new_pixheight += FRAME_SCROLLBAR_HEIGHT (f);
2793       new_pixwidth += FRAME_SCROLLBAR_WIDTH (f);
2794     }
2795
2796   /* when frame_conversion_internal() calculated the number of rows/cols
2797      in the frame, the theoretical toolbar sizes were subtracted out.
2798      The caluclations below adjust for real toolbar height/width in
2799      frame, which may be different from frame spec, taking the above
2800      fact into account */
2801   new_pixheight +=
2802     + FRAME_THEORETICAL_TOP_TOOLBAR_HEIGHT (f)
2803     + 2 * FRAME_THEORETICAL_TOP_TOOLBAR_BORDER_WIDTH (f)
2804     - FRAME_REAL_TOP_TOOLBAR_HEIGHT (f)
2805     - 2 * FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f);
2806   
2807   new_pixheight +=
2808     + FRAME_THEORETICAL_BOTTOM_TOOLBAR_HEIGHT (f)
2809     + 2 * FRAME_THEORETICAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f)
2810     - FRAME_REAL_BOTTOM_TOOLBAR_HEIGHT (f)
2811     - 2 * FRAME_REAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f);
2812
2813   new_pixwidth +=
2814     + FRAME_THEORETICAL_LEFT_TOOLBAR_WIDTH (f)
2815     + 2 * FRAME_THEORETICAL_LEFT_TOOLBAR_BORDER_WIDTH (f)
2816     - FRAME_REAL_LEFT_TOOLBAR_WIDTH (f)
2817     - 2 * FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f);
2818   
2819   new_pixwidth +=
2820     + FRAME_THEORETICAL_RIGHT_TOOLBAR_WIDTH (f)
2821     + 2 * FRAME_THEORETICAL_RIGHT_TOOLBAR_BORDER_WIDTH (f)
2822     - FRAME_REAL_RIGHT_TOOLBAR_WIDTH (f)
2823     - 2 * FRAME_REAL_RIGHT_TOOLBAR_BORDER_WIDTH (f);
2824   
2825   /* Adjust the width for the end glyph which may be a different width
2826      than the default character width. */
2827   {
2828     int adjustment, trunc_width, cont_width;
2829
2830     trunc_width = glyph_width (Vtruncation_glyph, Vdefault_face, 0,
2831                                FRAME_SELECTED_WINDOW (f));
2832     cont_width = glyph_width (Vcontinuation_glyph, Vdefault_face, 0,
2833                               FRAME_SELECTED_WINDOW (f));
2834     adjustment = max (trunc_width, cont_width);
2835     adjustment = max (adjustment, font_width);
2836
2837     new_pixwidth += adjustment;
2838   }
2839
2840   /* If we don't have valid values, exit. */
2841   if (!new_pixheight && !new_pixwidth)
2842     return;
2843
2844   if (new_pixheight)
2845     {
2846       XWINDOW (FRAME_ROOT_WINDOW (f))->pixel_top = FRAME_TOP_BORDER_END (f);
2847
2848       if (FRAME_HAS_MINIBUF_P (f)
2849           && ! FRAME_MINIBUF_ONLY_P (f))
2850         /* Frame has both root and minibuffer.  */
2851         {
2852           /*
2853            * Leave the minibuffer height the same if the frame has
2854            * been initialized, and the minibuffer height is tall
2855            * enough to display at least one line of text in the default
2856            * font, and the old minibuffer height is a multiple of the
2857            * default font height.  This should cause the minibuffer
2858            * height to be recomputed on font changes but not for
2859            * other frame size changes, which seems reasonable.
2860            */
2861           int old_minibuf_height =
2862             XWINDOW(FRAME_MINIBUF_WINDOW(f))->pixel_height;
2863           int minibuf_height =
2864             f->init_finished && (old_minibuf_height % real_font_height) == 0 ?
2865             max(old_minibuf_height, real_font_height) :
2866             real_font_height;
2867           set_window_pixheight (FRAME_ROOT_WINDOW (f),
2868                                 /* - font_height for minibuffer */
2869                                 new_pixheight - minibuf_height, 0);
2870
2871           XWINDOW (FRAME_MINIBUF_WINDOW (f))->pixel_top =
2872             new_pixheight - minibuf_height + FRAME_TOP_BORDER_END (f);
2873
2874           set_window_pixheight (FRAME_MINIBUF_WINDOW (f), minibuf_height, 0);
2875         }
2876       else
2877         /* Frame has just one top-level window.  */
2878         set_window_pixheight (FRAME_ROOT_WINDOW (f), new_pixheight, 0);
2879
2880       FRAME_HEIGHT (f) = newheight;
2881       if (FRAME_TTY_P (f))
2882         f->pixheight = newheight;
2883     }
2884
2885   if (new_pixwidth)
2886     {
2887       XWINDOW (FRAME_ROOT_WINDOW (f))->pixel_left = FRAME_LEFT_BORDER_END (f);
2888       set_window_pixwidth (FRAME_ROOT_WINDOW (f), new_pixwidth, 0);
2889
2890       if (FRAME_HAS_MINIBUF_P (f))
2891         {
2892           XWINDOW (FRAME_MINIBUF_WINDOW (f))->pixel_left =
2893             FRAME_LEFT_BORDER_END (f);
2894           set_window_pixwidth (FRAME_MINIBUF_WINDOW (f), new_pixwidth, 0);
2895         }
2896
2897       FRAME_WIDTH (f) = newwidth;
2898       if (FRAME_TTY_P (f))
2899         f->pixwidth = newwidth;
2900     }
2901
2902   if (window_system_pixelated_geometry (frame))
2903     pixel_to_real_char_size (f, FRAME_PIXWIDTH (f), FRAME_PIXHEIGHT (f),
2904                              &FRAME_CHARWIDTH (f), &FRAME_CHARHEIGHT (f));
2905   else
2906     {
2907       FRAME_CHARWIDTH (f) = FRAME_WIDTH (f);
2908       FRAME_CHARHEIGHT (f) = FRAME_HEIGHT (f);
2909     }
2910       
2911   MARK_FRAME_TOOLBARS_CHANGED (f);
2912   MARK_FRAME_CHANGED (f);
2913   f->echo_area_garbaged = 1;
2914 }
2915
2916 void
2917 change_frame_size (struct frame *f, int newheight, int newwidth, int delay)
2918 {
2919   /* sometimes we get passed a size that's too small (esp. when a
2920      client widget gets resized, since we have no control over this).
2921      So deal. */
2922   check_frame_size (f, &newheight, &newwidth);
2923
2924   if (delay || in_display || gc_in_progress)
2925     {
2926       MARK_FRAME_SIZE_CHANGED (f);
2927       f->new_width = newwidth;
2928       f->new_height = newheight;
2929       return;
2930     }
2931
2932   f->size_change_pending = 0;
2933   /* For TTY frames, it's like one, like all ...
2934      Can't have two TTY frames of different sizes on the same device. */
2935   if (FRAME_TTY_P (f))
2936     {
2937       Lisp_Object frmcons;
2938
2939       DEVICE_FRAME_LOOP (frmcons, XDEVICE (FRAME_DEVICE (f)))
2940         change_frame_size_1 (XFRAME (XCAR (frmcons)), newheight, newwidth);
2941     }
2942   else
2943     change_frame_size_1 (f, newheight, newwidth);
2944 }
2945
2946 \f
2947 void
2948 update_frame_title (struct frame *f)
2949 {
2950   struct window *w = XWINDOW (FRAME_SELECTED_WINDOW (f));
2951   Lisp_Object title_format;
2952   Lisp_Object icon_format;
2953   Bufbyte *title;
2954
2955   /* We don't change the title for the minibuffer unless the frame
2956      only has a minibuffer. */
2957   if (MINI_WINDOW_P (w) && !FRAME_MINIBUF_ONLY_P (f))
2958     return;
2959
2960   /* And we don't want dead buffers to blow up on us. */
2961   if (!BUFFER_LIVE_P (XBUFFER (w->buffer)))
2962     return;
2963
2964   title = NULL;
2965   title_format = symbol_value_in_buffer (Qframe_title_format,      w->buffer);
2966   icon_format  = symbol_value_in_buffer (Qframe_icon_title_format, w->buffer);
2967
2968   if (HAS_FRAMEMETH_P (f, set_title_from_bufbyte))
2969     {
2970       title = generate_formatted_string (w, title_format, Qnil,
2971                                          DEFAULT_INDEX, CURRENT_DISP);
2972       FRAMEMETH (f, set_title_from_bufbyte, (f, title));
2973     }
2974
2975   if (HAS_FRAMEMETH_P (f, set_icon_name_from_bufbyte))
2976     {
2977       if (!EQ (icon_format, title_format) || !title)
2978         {
2979           if (title)
2980             xfree (title);
2981
2982           title = generate_formatted_string (w, icon_format, Qnil,
2983                                              DEFAULT_INDEX, CURRENT_DISP);
2984         }
2985       FRAMEMETH (f, set_icon_name_from_bufbyte, (f, title));
2986     }
2987
2988   if (title)
2989     xfree (title);
2990 }
2991
2992 \f
2993 DEFUN ("set-frame-pointer", Fset_frame_pointer, 2, 2, 0, /*
2994 Set the mouse pointer of FRAME to the given pointer image instance.
2995 You should not call this function directly.  Instead, set one of
2996 the variables `text-pointer-glyph', `nontext-pointer-glyph',
2997 `modeline-pointer-glyph', `selection-pointer-glyph',
2998 `busy-pointer-glyph', or `toolbar-pointer-glyph'.
2999 */
3000        (frame, image_instance))
3001 {
3002   struct frame *f = decode_frame (frame);
3003   CHECK_POINTER_IMAGE_INSTANCE (image_instance);
3004   if (!EQ (f->pointer, image_instance))
3005     {
3006       f->pointer = image_instance;
3007       MAYBE_FRAMEMETH (f, set_frame_pointer, (f));
3008     }
3009   return Qnil;
3010 }
3011
3012 \f
3013 void
3014 update_frame_icon (struct frame *f)
3015 {
3016   if (f->icon_changed || f->windows_changed)
3017     {
3018       Lisp_Object frame;
3019       Lisp_Object new_icon;
3020
3021       XSETFRAME (frame, f);
3022       new_icon = glyph_image_instance (Vframe_icon_glyph, frame,
3023                                        ERROR_ME_WARN, 0);
3024       if (!EQ (new_icon, f->icon))
3025         {
3026           f->icon = new_icon;
3027           MAYBE_FRAMEMETH (f, set_frame_icon, (f));
3028         }
3029     }
3030
3031   f->icon_changed = 0;
3032 }
3033
3034 static void
3035 icon_glyph_changed (Lisp_Object glyph, Lisp_Object property,
3036                     Lisp_Object locale)
3037 {
3038   MARK_ICON_CHANGED;
3039 }
3040
3041 \f
3042 void
3043 syms_of_frame (void)
3044 {
3045   defsymbol (&Qdelete_frame_hook, "delete-frame-hook");
3046   defsymbol (&Qselect_frame_hook, "select-frame-hook");
3047   defsymbol (&Qdeselect_frame_hook, "deselect-frame-hook");
3048   defsymbol (&Qcreate_frame_hook, "create-frame-hook");
3049   defsymbol (&Qcustom_initialize_frame, "custom-initialize-frame");
3050   defsymbol (&Qmouse_enter_frame_hook, "mouse-enter-frame-hook");
3051   defsymbol (&Qmouse_leave_frame_hook, "mouse-leave-frame-hook");
3052   defsymbol (&Qmap_frame_hook, "map-frame-hook");
3053   defsymbol (&Qunmap_frame_hook, "unmap-frame-hook");
3054
3055   defsymbol (&Qframep, "framep");
3056   defsymbol (&Qframe_live_p, "frame-live-p");
3057   defsymbol (&Qframe_x_p, "frame-x-p");
3058   defsymbol (&Qframe_tty_p, "frame-tty-p");
3059   defsymbol (&Qdelete_frame, "delete-frame");
3060   defsymbol (&Qsynchronize_minibuffers, "synchronize-minibuffers");
3061   defsymbol (&Qbuffer_predicate, "buffer-predicate");
3062   defsymbol (&Qframe_being_created, "frame-being-created");
3063   defsymbol (&Qmake_initial_minibuffer_frame, "make-initial-minibuffer-frame");
3064
3065   defsymbol (&Qframe_title_format, "frame-title-format");
3066   defsymbol (&Qframe_icon_title_format, "frame-icon-title-format");
3067
3068   defsymbol (&Qhidden, "hidden");
3069   defsymbol (&Qvisible, "visible");
3070   defsymbol (&Qiconic, "iconic");
3071   defsymbol (&Qinvisible, "invisible");
3072   defsymbol (&Qvisible_iconic, "visible-iconic");
3073   defsymbol (&Qinvisible_iconic, "invisible-iconic");
3074   defsymbol (&Qnomini, "nomini");
3075   defsymbol (&Qvisible_nomini, "visible-nomini");
3076   defsymbol (&Qiconic_nomini, "iconic-nomini");
3077   defsymbol (&Qinvisible_nomini, "invisible-nomini");
3078   defsymbol (&Qvisible_iconic_nomini, "visible-iconic-nomini");
3079   defsymbol (&Qinvisible_iconic_nomini, "invisible-iconic-nomini");
3080
3081   defsymbol (&Qminibuffer, "minibuffer");
3082   defsymbol (&Qunsplittable, "unsplittable");
3083   defsymbol (&Qinternal_border_width, "internal-border-width");
3084   defsymbol (&Qtop_toolbar_shadow_color, "top-toolbar-shadow-color");
3085   defsymbol (&Qbottom_toolbar_shadow_color, "bottom-toolbar-shadow-color");
3086   defsymbol (&Qbackground_toolbar_color, "background-toolbar-color");
3087   defsymbol (&Qtop_toolbar_shadow_pixmap, "top-toolbar-shadow-pixmap");
3088   defsymbol (&Qbottom_toolbar_shadow_pixmap, "bottom-toolbar-shadow-pixmap");
3089   defsymbol (&Qtoolbar_shadow_thickness, "toolbar-shadow-thickness");
3090   defsymbol (&Qscrollbar_placement, "scrollbar-placement");
3091   defsymbol (&Qinter_line_space, "inter-line-space");
3092   /* Qiconic already in this function. */
3093   defsymbol (&Qvisual_bell, "visual-bell");
3094   defsymbol (&Qbell_volume, "bell-volume");
3095   defsymbol (&Qpointer_background, "pointer-background");
3096   defsymbol (&Qpointer_color, "pointer-color");
3097   defsymbol (&Qtext_pointer, "text-pointer");
3098   defsymbol (&Qspace_pointer, "space-pointer");
3099   defsymbol (&Qmodeline_pointer, "modeline-pointer");
3100   defsymbol (&Qgc_pointer, "gc-pointer");
3101   defsymbol (&Qinitially_unmapped, "initially-unmapped");
3102   defsymbol (&Quse_backing_store, "use-backing-store");
3103   defsymbol (&Qborder_color, "border-color");
3104   defsymbol (&Qborder_width, "border-width");
3105   /* Qwidth, Qheight, Qleft, Qtop in general.c */
3106   defsymbol (&Qset_specifier, "set-specifier");
3107   defsymbol (&Qset_glyph_image, "set-glyph-image");
3108   defsymbol (&Qset_face_property, "set-face-property");
3109   defsymbol (&Qface_property_instance, "face-property-instance");
3110   defsymbol (&Qframe_property_alias, "frame-property-alias");
3111
3112   DEFSUBR (Fmake_frame);
3113   DEFSUBR (Fframep);
3114   DEFSUBR (Fframe_live_p);
3115 #if 0 /* FSFmacs */
3116   DEFSUBR (Fignore_event);
3117 #endif
3118   DEFSUBR (Ffocus_frame);
3119   DEFSUBR (Fselect_frame);
3120   DEFSUBR (Fselected_frame);
3121   DEFSUBR (Factive_minibuffer_window);
3122   DEFSUBR (Flast_nonminibuf_frame);
3123   DEFSUBR (Fframe_root_window);
3124   DEFSUBR (Fframe_selected_window);
3125   DEFSUBR (Fset_frame_selected_window);
3126   DEFSUBR (Fframe_device);
3127   DEFSUBR (Fnext_frame);
3128   DEFSUBR (Fprevious_frame);
3129   DEFSUBR (Fdelete_frame);
3130   DEFSUBR (Fmouse_position);
3131   DEFSUBR (Fmouse_pixel_position);
3132   DEFSUBR (Fmouse_position_as_motion_event);
3133   DEFSUBR (Fset_mouse_position);
3134   DEFSUBR (Fset_mouse_pixel_position);
3135   DEFSUBR (Fmake_frame_visible);
3136   DEFSUBR (Fmake_frame_invisible);
3137   DEFSUBR (Ficonify_frame);
3138   DEFSUBR (Fdeiconify_frame);
3139   DEFSUBR (Fframe_visible_p);
3140   DEFSUBR (Fframe_totally_visible_p);
3141   DEFSUBR (Fframe_iconified_p);
3142   DEFSUBR (Fvisible_frame_list);
3143   DEFSUBR (Fraise_frame);
3144   DEFSUBR (Flower_frame);
3145   DEFSUBR (Fframe_property);
3146   DEFSUBR (Fframe_properties);
3147   DEFSUBR (Fset_frame_properties);
3148   DEFSUBR (Fframe_pixel_height);
3149   DEFSUBR (Fframe_pixel_width);
3150   DEFSUBR (Fframe_name);
3151   DEFSUBR (Fframe_modified_tick);
3152   DEFSUBR (Fset_frame_height);
3153   DEFSUBR (Fset_frame_width);
3154   DEFSUBR (Fset_frame_size);
3155   DEFSUBR (Fset_frame_position);
3156   DEFSUBR (Fset_frame_pointer);
3157 }
3158
3159 void
3160 vars_of_frame (void)
3161 {
3162   /* */
3163   Vframe_being_created = Qnil;
3164   staticpro (&Vframe_being_created);
3165
3166 #ifdef HAVE_CDE
3167   Fprovide (intern ("cde"));
3168 #endif
3169
3170 #ifdef HAVE_OFFIX_DND
3171   Fprovide (intern ("offix"));
3172 #endif
3173
3174 #if 0 /* FSFmacs stupidity */
3175   xxDEFVAR_LISP ("emacs-iconified", &Vemacs_iconified /*
3176 Non-nil if all of emacs is iconified and frame updates are not needed.
3177 */ );
3178   Vemacs_iconified = Qnil;
3179 #endif
3180
3181   DEFVAR_LISP ("select-frame-hook", &Vselect_frame_hook /*
3182 Function or functions to run just after a new frame is given the focus.
3183 Note that calling `select-frame' does not necessarily set the focus:
3184 The actual window-system focus will not be changed until the next time
3185 that XEmacs is waiting for an event, and even then, the window manager
3186 may refuse the focus-change request.
3187 */ );
3188   Vselect_frame_hook = Qnil;
3189
3190   DEFVAR_LISP ("deselect-frame-hook", &Vdeselect_frame_hook /*
3191 Function or functions to run just before a frame loses the focus.
3192 See `select-frame-hook'.
3193 */ );
3194   Vdeselect_frame_hook = Qnil;
3195
3196   DEFVAR_LISP ("delete-frame-hook", &Vdelete_frame_hook /*
3197 Function or functions to call when a frame is deleted.
3198 One argument, the about-to-be-deleted frame.
3199 */ );
3200   Vdelete_frame_hook = Qnil;
3201
3202   DEFVAR_LISP ("create-frame-hook", &Vcreate_frame_hook /*
3203 Function or functions to call when a frame is created.
3204 One argument, the newly-created frame.
3205 */ );
3206   Vcreate_frame_hook = Qnil;
3207
3208   DEFVAR_LISP ("mouse-enter-frame-hook", &Vmouse_enter_frame_hook /*
3209 Function or functions to call when the mouse enters a frame.
3210 One argument, the frame.
3211 Be careful not to make assumptions about the window manager's focus model.
3212 In most cases, the `deselect-frame-hook' is more appropriate.
3213 */ );
3214   Vmouse_enter_frame_hook = Qnil;
3215
3216   DEFVAR_LISP ("mouse-leave-frame-hook", &Vmouse_leave_frame_hook /*
3217 Function or functions to call when the mouse leaves a frame.
3218 One argument, the frame.
3219 Be careful not to make assumptions about the window manager's focus model.
3220 In most cases, the `select-frame-hook' is more appropriate.
3221 */ );
3222   Vmouse_leave_frame_hook = Qnil;
3223
3224   DEFVAR_LISP ("map-frame-hook", &Vmap_frame_hook /*
3225 Function or functions to call when a frame is mapped.
3226 One argument, the frame.
3227 */ );
3228   Vmap_frame_hook = Qnil;
3229
3230   DEFVAR_LISP ("unmap-frame-hook", &Vunmap_frame_hook /*
3231 Function or functions to call when a frame is unmapped.
3232 One argument, the frame.
3233 */ );
3234   Vunmap_frame_hook = Qnil;
3235
3236   DEFVAR_BOOL ("allow-deletion-of-last-visible-frame",
3237                &allow_deletion_of_last_visible_frame /*
3238 *Non-nil means to assume the force option to delete-frame.
3239 */ );
3240   allow_deletion_of_last_visible_frame = 0;
3241
3242   DEFVAR_LISP ("adjust-frame-function", &Vadjust_frame_function /*
3243 Function or constant controlling adjustment of frame.
3244 When scrollbars, toolbars, default font etc. change in frame, the frame
3245 needs to be adjusted. The adjustment is controlled by this variable.
3246 Legal values are:
3247   nil to keep character frame size unchanged when possible (resize)
3248   t   to keep pixel size unchanged (never resize)
3249   function symbol or lambda form. This function must return boolean
3250       value which is treated as above. Function is passed one parameter,
3251       the frame being adjusted. It function should not modify or delete
3252       the frame.
3253 */ );
3254   Vadjust_frame_function = Qnil;
3255
3256   DEFVAR_LISP ("mouse-motion-handler", &Vmouse_motion_handler /*
3257 Handler for motion events.  One arg, the event.
3258 For most applications, you should use `mode-motion-hook' instead of this.
3259 */ );
3260   Vmouse_motion_handler = Qnil;
3261
3262   DEFVAR_LISP ("synchronize-minibuffers",&Vsynchronize_minibuffers /*
3263 Set to t if all minibuffer windows are to be synchronized.
3264 This will cause echo area messages to appear in the minibuffers of all
3265 visible frames.
3266 */ );
3267   Vsynchronize_minibuffers = Qnil;
3268
3269   DEFVAR_LISP ("frame-title-format", &Vframe_title_format /*
3270 Controls the title of the X window corresponding to the selected frame.
3271 This is the same format as `modeline-format' with the exception that
3272 %- is ignored.
3273 */ );
3274   Vframe_title_format = Fpurecopy (build_string ("%S: %b"));
3275
3276   DEFVAR_LISP ("frame-icon-title-format", &Vframe_icon_title_format /*
3277 Controls the title of the icon corresponding to the selected frame.
3278 See also the variable `frame-title-format'.
3279 */ );
3280   Vframe_icon_title_format = Fpurecopy (build_string ("%b"));
3281
3282   DEFVAR_LISP ("default-frame-name", &Vdefault_frame_name /*
3283 The default name to assign to newly-created frames.
3284 This can be overridden by arguments to `make-frame'.
3285 This must be a string.
3286 */ );
3287 #ifndef INFODOCK
3288   Vdefault_frame_name = Fpurecopy (build_string ("emacs"));
3289 #else
3290   Vdefault_frame_name = Fpurecopy (build_string ("InfoDock"));
3291 #endif
3292
3293   DEFVAR_LISP ("default-frame-plist", &Vdefault_frame_plist /*
3294 Plist of default values for frame creation, other than the first one.
3295 These may be set in your init file, like this:
3296
3297   \(setq default-frame-plist '(width 80 height 55))
3298
3299 The properties may be in alist format for backward compatibility
3300 but you should not rely on this behavior.
3301
3302 These override values given in window system configuration data,
3303  including X Windows' defaults database.
3304
3305 Since the first X frame is created before loading your .emacs file,
3306 you must use the X resource database for that.
3307
3308 For values specific to the first Emacs frame, see `initial-frame-plist'.
3309 For values specific to the separate minibuffer frame, see
3310  `minibuffer-frame-plist'.
3311
3312 See also the variables `default-x-frame-plist' and
3313 `default-tty-frame-plist', which are like `default-frame-plist'
3314 except that they apply only to X or tty frames, respectively
3315 \(whereas `default-frame-plist' applies to all types of frames).
3316 */ );
3317   Vdefault_frame_plist = Qnil;
3318
3319   DEFVAR_LISP ("frame-icon-glyph", &Vframe_icon_glyph /*
3320 Icon glyph used to iconify a frame.
3321 */ );
3322 }
3323
3324 void
3325 complex_vars_of_frame (void)
3326 {
3327   Vframe_icon_glyph = allocate_glyph (GLYPH_ICON, icon_glyph_changed);
3328 }