comparison src/frame.c @ 0:376386a54a3c r19-14

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