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