Mercurial > hg > xemacs-beta
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 } |