(comment-search-forward, comment-search-backward): Fix typos.
[emacs.git] / src / frame.c
blob934c11d98bc776dd9d229adc8905a3e2acb48c66
1 /* Generic frame functions.
2 Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2003
3 Free Software Foundation.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 #include <config.h>
24 #include <stdio.h>
25 #include "lisp.h"
26 #include "charset.h"
27 #ifdef HAVE_X_WINDOWS
28 #include "xterm.h"
29 #endif
30 #ifdef WINDOWSNT
31 #include "w32term.h"
32 #endif
33 #ifdef MAC_OS
34 #include "macterm.h"
35 #endif
36 #include "buffer.h"
37 /* These help us bind and responding to switch-frame events. */
38 #include "commands.h"
39 #include "keyboard.h"
40 #include "frame.h"
41 #ifdef HAVE_WINDOW_SYSTEM
42 #include "fontset.h"
43 #endif
44 #include "blockinput.h"
45 #include "termhooks.h"
46 #include "dispextern.h"
47 #include "window.h"
48 #ifdef MSDOS
49 #include "msdos.h"
50 #include "dosfns.h"
51 #endif
54 #ifdef HAVE_WINDOW_SYSTEM
56 /* The name we're using in resource queries. Most often "emacs". */
58 Lisp_Object Vx_resource_name;
60 /* The application class we're using in resource queries.
61 Normally "Emacs". */
63 Lisp_Object Vx_resource_class;
65 #endif
67 Lisp_Object Qframep, Qframe_live_p;
68 Lisp_Object Qicon, Qmodeline;
69 Lisp_Object Qonly;
70 Lisp_Object Qx, Qw32, Qmac, Qpc;
71 Lisp_Object Qvisible;
72 Lisp_Object Qdisplay_type;
73 Lisp_Object Qbackground_mode;
74 Lisp_Object Qinhibit_default_face_x_resources;
76 Lisp_Object Qx_frame_parameter;
77 Lisp_Object Qx_resource_name;
79 /* Frame parameters (set or reported). */
81 Lisp_Object Qauto_raise, Qauto_lower;
82 Lisp_Object Qborder_color, Qborder_width;
83 Lisp_Object Qcursor_color, Qcursor_type;
84 Lisp_Object Qgeometry; /* Not used */
85 Lisp_Object Qheight, Qwidth;
86 Lisp_Object Qleft, Qright;
87 Lisp_Object Qicon_left, Qicon_top, Qicon_type, Qicon_name;
88 Lisp_Object Qinternal_border_width;
89 Lisp_Object Qmouse_color;
90 Lisp_Object Qminibuffer;
91 Lisp_Object Qscroll_bar_width, Qvertical_scroll_bars;
92 Lisp_Object Qvisibility;
93 Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
94 Lisp_Object Qscreen_gamma;
95 Lisp_Object Qline_spacing;
96 Lisp_Object Quser_position, Quser_size;
97 Lisp_Object Qwait_for_wm;
98 Lisp_Object Qwindow_id;
99 #ifdef HAVE_X_WINDOWS
100 Lisp_Object Qouter_window_id;
101 #endif
102 Lisp_Object Qparent_id;
103 Lisp_Object Qtitle, Qname;
104 Lisp_Object Qunsplittable;
105 Lisp_Object Qmenu_bar_lines, Qtool_bar_lines;
106 Lisp_Object Qleft_fringe, Qright_fringe;
107 Lisp_Object Qbuffer_predicate, Qbuffer_list;
108 Lisp_Object Qtty_color_mode;
110 Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth;
112 Lisp_Object Qface_set_after_frame_default;
115 Lisp_Object Vterminal_frame;
116 Lisp_Object Vdefault_frame_alist;
117 Lisp_Object Vdefault_frame_scroll_bars;
118 Lisp_Object Vmouse_position_function;
119 Lisp_Object Vmouse_highlight;
120 Lisp_Object Vdelete_frame_functions;
122 static void
123 set_menu_bar_lines_1 (window, n)
124 Lisp_Object window;
125 int n;
127 struct window *w = XWINDOW (window);
129 XSETFASTINT (w->last_modified, 0);
130 XSETFASTINT (w->top_line, XFASTINT (w->top_line) + n);
131 XSETFASTINT (w->total_lines, XFASTINT (w->total_lines) - n);
133 if (INTEGERP (w->orig_top_line))
134 XSETFASTINT (w->orig_top_line, XFASTINT (w->orig_top_line) + n);
135 if (INTEGERP (w->orig_total_lines))
136 XSETFASTINT (w->orig_total_lines, XFASTINT (w->orig_total_lines) - n);
138 /* Handle just the top child in a vertical split. */
139 if (!NILP (w->vchild))
140 set_menu_bar_lines_1 (w->vchild, n);
142 /* Adjust all children in a horizontal split. */
143 for (window = w->hchild; !NILP (window); window = w->next)
145 w = XWINDOW (window);
146 set_menu_bar_lines_1 (window, n);
150 void
151 set_menu_bar_lines (f, value, oldval)
152 struct frame *f;
153 Lisp_Object value, oldval;
155 int nlines;
156 int olines = FRAME_MENU_BAR_LINES (f);
158 /* Right now, menu bars don't work properly in minibuf-only frames;
159 most of the commands try to apply themselves to the minibuffer
160 frame itself, and get an error because you can't switch buffers
161 in or split the minibuffer window. */
162 if (FRAME_MINIBUF_ONLY_P (f))
163 return;
165 if (INTEGERP (value))
166 nlines = XINT (value);
167 else
168 nlines = 0;
170 if (nlines != olines)
172 windows_or_buffers_changed++;
173 FRAME_WINDOW_SIZES_CHANGED (f) = 1;
174 FRAME_MENU_BAR_LINES (f) = nlines;
175 set_menu_bar_lines_1 (f->root_window, nlines - olines);
176 adjust_glyphs (f);
180 Lisp_Object Vemacs_iconified;
181 Lisp_Object Vframe_list;
183 struct x_output tty_display;
185 extern Lisp_Object Vminibuffer_list;
186 extern Lisp_Object get_minibuffer ();
187 extern Lisp_Object Fhandle_switch_frame ();
188 extern Lisp_Object Fredirect_frame_focus ();
189 extern Lisp_Object x_get_focus_frame ();
191 DEFUN ("framep", Fframep, Sframep, 1, 1, 0,
192 doc: /* Return non-nil if OBJECT is a frame.
193 Value is t for a termcap frame (a character-only terminal),
194 `x' for an Emacs frame that is really an X window,
195 `w32' for an Emacs frame that is a window on MS-Windows display,
196 `mac' for an Emacs frame on a Macintosh display,
197 `pc' for a direct-write MS-DOS frame.
198 See also `frame-live-p'. */)
199 (object)
200 Lisp_Object object;
202 if (!FRAMEP (object))
203 return Qnil;
204 switch (XFRAME (object)->output_method)
206 case output_termcap:
207 return Qt;
208 case output_x_window:
209 return Qx;
210 case output_w32:
211 return Qw32;
212 case output_msdos_raw:
213 return Qpc;
214 case output_mac:
215 return Qmac;
216 default:
217 abort ();
221 DEFUN ("frame-live-p", Fframe_live_p, Sframe_live_p, 1, 1, 0,
222 doc: /* Return non-nil if OBJECT is a frame which has not been deleted.
223 Value is nil if OBJECT is not a live frame. If object is a live
224 frame, the return value indicates what sort of output device it is
225 displayed on. See the documentation of `framep' for possible
226 return values. */)
227 (object)
228 Lisp_Object object;
230 return ((FRAMEP (object)
231 && FRAME_LIVE_P (XFRAME (object)))
232 ? Fframep (object)
233 : Qnil);
236 struct frame *
237 make_frame (mini_p)
238 int mini_p;
240 Lisp_Object frame;
241 register struct frame *f;
242 register Lisp_Object root_window;
243 register Lisp_Object mini_window;
245 f = allocate_frame ();
246 XSETFRAME (frame, f);
248 f->desired_matrix = 0;
249 f->current_matrix = 0;
250 f->desired_pool = 0;
251 f->current_pool = 0;
252 f->glyphs_initialized_p = 0;
253 f->decode_mode_spec_buffer = 0;
254 f->visible = 0;
255 f->async_visible = 0;
256 f->output_data.nothing = 0;
257 f->iconified = 0;
258 f->async_iconified = 0;
259 f->wants_modeline = 1;
260 f->auto_raise = 0;
261 f->auto_lower = 0;
262 f->no_split = 0;
263 f->garbaged = 1;
264 f->has_minibuffer = mini_p;
265 f->focus_frame = Qnil;
266 f->explicit_name = 0;
267 f->can_have_scroll_bars = 0;
268 f->vertical_scroll_bar_type = vertical_scroll_bar_none;
269 f->param_alist = Qnil;
270 f->scroll_bars = Qnil;
271 f->condemned_scroll_bars = Qnil;
272 f->face_alist = Qnil;
273 f->face_cache = NULL;
274 f->menu_bar_items = Qnil;
275 f->menu_bar_vector = Qnil;
276 f->menu_bar_items_used = 0;
277 f->buffer_predicate = Qnil;
278 f->buffer_list = Qnil;
279 #ifdef MULTI_KBOARD
280 f->kboard = initial_kboard;
281 #endif
282 f->namebuf = 0;
283 f->title = Qnil;
284 f->menu_bar_window = Qnil;
285 f->tool_bar_window = Qnil;
286 f->tool_bar_items = Qnil;
287 f->desired_tool_bar_string = f->current_tool_bar_string = Qnil;
288 f->n_tool_bar_items = 0;
289 f->left_fringe_width = f->right_fringe_width = 0;
290 f->fringe_cols = 0;
291 f->scroll_bar_actual_width = 0;
292 f->border_width = 0;
293 f->internal_border_width = 0;
294 f->column_width = 1; /* !FRAME_WINDOW_P value */
295 f->line_height = 1; /* !FRAME_WINDOW_P value */
296 f->x_pixels_diff = f->y_pixels_diff = 0;
297 #ifdef HAVE_WINDOW_SYSTEM
298 f->want_fullscreen = FULLSCREEN_NONE;
299 #endif
300 f->size_hint_flags = 0;
301 f->win_gravity = 0;
303 root_window = make_window ();
304 if (mini_p)
306 mini_window = make_window ();
307 XWINDOW (root_window)->next = mini_window;
308 XWINDOW (mini_window)->prev = root_window;
309 XWINDOW (mini_window)->mini_p = Qt;
310 XWINDOW (mini_window)->frame = frame;
311 f->minibuffer_window = mini_window;
313 else
315 mini_window = Qnil;
316 XWINDOW (root_window)->next = Qnil;
317 f->minibuffer_window = Qnil;
320 XWINDOW (root_window)->frame = frame;
322 /* 10 is arbitrary,
323 just so that there is "something there."
324 Correct size will be set up later with change_frame_size. */
326 SET_FRAME_COLS (f, 10);
327 FRAME_LINES (f) = 10;
329 XSETFASTINT (XWINDOW (root_window)->total_cols, 10);
330 XSETFASTINT (XWINDOW (root_window)->total_lines, (mini_p ? 9 : 10));
332 if (mini_p)
334 XSETFASTINT (XWINDOW (mini_window)->total_cols, 10);
335 XSETFASTINT (XWINDOW (mini_window)->top_line, 9);
336 XSETFASTINT (XWINDOW (mini_window)->total_lines, 1);
339 /* Choose a buffer for the frame's root window. */
341 Lisp_Object buf;
343 XWINDOW (root_window)->buffer = Qt;
344 buf = Fcurrent_buffer ();
345 /* If buf is a 'hidden' buffer (i.e. one whose name starts with
346 a space), try to find another one. */
347 if (SREF (Fbuffer_name (buf), 0) == ' ')
348 buf = Fother_buffer (buf, Qnil, Qnil);
350 /* Use set_window_buffer, not Fset_window_buffer, and don't let
351 hooks be run by it. The reason is that the whole frame/window
352 arrangement is not yet fully intialized at this point. Windows
353 don't have the right size, glyph matrices aren't initialized
354 etc. Running Lisp functions at this point surely ends in a
355 SEGV. */
356 set_window_buffer (root_window, buf, 0, 0);
357 f->buffer_list = Fcons (buf, Qnil);
360 if (mini_p)
362 XWINDOW (mini_window)->buffer = Qt;
363 set_window_buffer (mini_window,
364 (NILP (Vminibuffer_list)
365 ? get_minibuffer (0)
366 : Fcar (Vminibuffer_list)),
367 0, 0);
370 f->root_window = root_window;
371 f->selected_window = root_window;
372 /* Make sure this window seems more recently used than
373 a newly-created, never-selected window. */
374 XSETFASTINT (XWINDOW (f->selected_window)->use_time, ++window_select_count);
376 f->default_face_done_p = 0;
378 return f;
381 #ifdef HAVE_WINDOW_SYSTEM
382 /* Make a frame using a separate minibuffer window on another frame.
383 MINI_WINDOW is the minibuffer window to use. nil means use the
384 default (the global minibuffer). */
386 struct frame *
387 make_frame_without_minibuffer (mini_window, kb, display)
388 register Lisp_Object mini_window;
389 KBOARD *kb;
390 Lisp_Object display;
392 register struct frame *f;
393 struct gcpro gcpro1;
395 if (!NILP (mini_window))
396 CHECK_LIVE_WINDOW (mini_window);
398 #ifdef MULTI_KBOARD
399 if (!NILP (mini_window)
400 && XFRAME (XWINDOW (mini_window)->frame)->kboard != kb)
401 error ("frame and minibuffer must be on the same display");
402 #endif
404 /* Make a frame containing just a root window. */
405 f = make_frame (0);
407 if (NILP (mini_window))
409 /* Use default-minibuffer-frame if possible. */
410 if (!FRAMEP (kb->Vdefault_minibuffer_frame)
411 || ! FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame)))
413 Lisp_Object frame_dummy;
415 XSETFRAME (frame_dummy, f);
416 GCPRO1 (frame_dummy);
417 /* If there's no minibuffer frame to use, create one. */
418 kb->Vdefault_minibuffer_frame =
419 call1 (intern ("make-initial-minibuffer-frame"), display);
420 UNGCPRO;
423 mini_window = XFRAME (kb->Vdefault_minibuffer_frame)->minibuffer_window;
426 f->minibuffer_window = mini_window;
428 /* Make the chosen minibuffer window display the proper minibuffer,
429 unless it is already showing a minibuffer. */
430 if (NILP (Fmemq (XWINDOW (mini_window)->buffer, Vminibuffer_list)))
431 Fset_window_buffer (mini_window,
432 (NILP (Vminibuffer_list)
433 ? get_minibuffer (0)
434 : Fcar (Vminibuffer_list)), Qnil);
435 return f;
438 /* Make a frame containing only a minibuffer window. */
440 struct frame *
441 make_minibuffer_frame ()
443 /* First make a frame containing just a root window, no minibuffer. */
445 register struct frame *f = make_frame (0);
446 register Lisp_Object mini_window;
447 register Lisp_Object frame;
449 XSETFRAME (frame, f);
451 f->auto_raise = 0;
452 f->auto_lower = 0;
453 f->no_split = 1;
454 f->wants_modeline = 0;
455 f->has_minibuffer = 1;
457 /* Now label the root window as also being the minibuffer.
458 Avoid infinite looping on the window chain by marking next pointer
459 as nil. */
461 mini_window = f->minibuffer_window = f->root_window;
462 XWINDOW (mini_window)->mini_p = Qt;
463 XWINDOW (mini_window)->next = Qnil;
464 XWINDOW (mini_window)->prev = Qnil;
465 XWINDOW (mini_window)->frame = frame;
467 /* Put the proper buffer in that window. */
469 Fset_window_buffer (mini_window,
470 (NILP (Vminibuffer_list)
471 ? get_minibuffer (0)
472 : Fcar (Vminibuffer_list)), Qnil);
473 return f;
475 #endif /* HAVE_WINDOW_SYSTEM */
477 /* Construct a frame that refers to the terminal (stdin and stdout). */
479 static int terminal_frame_count;
481 struct frame *
482 make_terminal_frame ()
484 register struct frame *f;
485 Lisp_Object frame;
486 char name[20];
488 #ifdef MULTI_KBOARD
489 if (!initial_kboard)
491 initial_kboard = (KBOARD *) xmalloc (sizeof (KBOARD));
492 init_kboard (initial_kboard);
493 initial_kboard->next_kboard = all_kboards;
494 all_kboards = initial_kboard;
496 #endif
498 /* The first call must initialize Vframe_list. */
499 if (! (NILP (Vframe_list) || CONSP (Vframe_list)))
500 Vframe_list = Qnil;
502 f = make_frame (1);
504 XSETFRAME (frame, f);
505 Vframe_list = Fcons (frame, Vframe_list);
507 terminal_frame_count++;
508 sprintf (name, "F%d", terminal_frame_count);
509 f->name = build_string (name);
511 f->visible = 1; /* FRAME_SET_VISIBLE wd set frame_garbaged. */
512 f->async_visible = 1; /* Don't let visible be cleared later. */
513 #ifdef MSDOS
514 f->output_data.x = &the_only_x_display;
515 if (!inhibit_window_system
516 && (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame))
517 || XFRAME (selected_frame)->output_method == output_msdos_raw))
519 f->output_method = output_msdos_raw;
520 /* This initialization of foreground and background pixels is
521 only important for the initial frame created in temacs. If
522 we don't do that, we get black background and foreground in
523 the dumped Emacs because the_only_x_display is a static
524 variable, hence it is born all-zeroes, and zero is the code
525 for the black color. Other frames all inherit their pixels
526 from what's already in the_only_x_display. */
527 if ((!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
528 && f->output_data.x->background_pixel == 0
529 && f->output_data.x->foreground_pixel == 0)
531 f->output_data.x->background_pixel = FACE_TTY_DEFAULT_BG_COLOR;
532 f->output_data.x->foreground_pixel = FACE_TTY_DEFAULT_FG_COLOR;
535 else
536 f->output_method = output_termcap;
537 #else
538 #ifdef WINDOWSNT
539 f->output_method = output_termcap;
540 f->output_data.x = &tty_display;
541 #else
542 #ifdef MAC_OS8
543 make_mac_terminal_frame (f);
544 #else
545 f->output_data.x = &tty_display;
546 #ifdef CANNOT_DUMP
547 FRAME_FOREGROUND_PIXEL(f) = FACE_TTY_DEFAULT_FG_COLOR;
548 FRAME_BACKGROUND_PIXEL(f) = FACE_TTY_DEFAULT_BG_COLOR;
549 #endif
550 #endif /* MAC_OS8 */
551 #endif /* WINDOWSNT */
552 #endif /* MSDOS */
554 if (!noninteractive)
555 init_frame_faces (f);
557 return f;
560 DEFUN ("make-terminal-frame", Fmake_terminal_frame, Smake_terminal_frame,
561 1, 1, 0,
562 doc: /* Create an additional terminal frame.
563 You can create multiple frames on a text-only terminal in this way.
564 Only the selected terminal frame is actually displayed.
565 This function takes one argument, an alist specifying frame parameters.
566 In practice, generally you don't need to specify any parameters.
567 Note that changing the size of one terminal frame automatically affects all. */)
568 (parms)
569 Lisp_Object parms;
571 struct frame *f;
572 Lisp_Object frame, tem;
573 struct frame *sf = SELECTED_FRAME ();
575 #ifdef MSDOS
576 if (sf->output_method != output_msdos_raw
577 && sf->output_method != output_termcap)
578 abort ();
579 #else /* not MSDOS */
581 #ifdef MAC_OS
582 if (sf->output_method != output_mac)
583 error ("Not running on a Macintosh screen; cannot make a new Macintosh frame");
584 #else
585 if (sf->output_method != output_termcap)
586 error ("Not using an ASCII terminal now; cannot make a new ASCII frame");
587 #endif
588 #endif /* not MSDOS */
590 f = make_terminal_frame ();
592 change_frame_size (f, FRAME_LINES (sf),
593 FRAME_COLS (sf), 0, 0, 0);
594 adjust_glyphs (f);
595 calculate_costs (f);
596 XSETFRAME (frame, f);
597 Fmodify_frame_parameters (frame, Vdefault_frame_alist);
598 Fmodify_frame_parameters (frame, parms);
600 /* Make the frame face alist be frame-specific, so that each
601 frame could change its face definitions independently. */
602 f->face_alist = Fcopy_alist (sf->face_alist);
603 /* Simple Fcopy_alist isn't enough, because we need the contents of
604 the vectors which are the CDRs of associations in face_alist to
605 be copied as well. */
606 for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem))
607 XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem))));
608 return frame;
612 /* Perform the switch to frame FRAME.
614 If FRAME is a switch-frame event `(switch-frame FRAME1)', use
615 FRAME1 as frame.
617 If TRACK is non-zero and the frame that currently has the focus
618 redirects its focus to the selected frame, redirect that focused
619 frame's focus to FRAME instead.
621 FOR_DELETION non-zero means that the selected frame is being
622 deleted, which includes the possibility that the frame's display
623 is dead. */
625 Lisp_Object
626 do_switch_frame (frame, track, for_deletion)
627 Lisp_Object frame;
628 int track, for_deletion;
630 struct frame *sf = SELECTED_FRAME ();
632 /* If FRAME is a switch-frame event, extract the frame we should
633 switch to. */
634 if (CONSP (frame)
635 && EQ (XCAR (frame), Qswitch_frame)
636 && CONSP (XCDR (frame)))
637 frame = XCAR (XCDR (frame));
639 /* This used to say CHECK_LIVE_FRAME, but apparently it's possible for
640 a switch-frame event to arrive after a frame is no longer live,
641 especially when deleting the initial frame during startup. */
642 CHECK_FRAME (frame);
643 if (! FRAME_LIVE_P (XFRAME (frame)))
644 return Qnil;
646 if (sf == XFRAME (frame))
647 return frame;
649 /* This is too greedy; it causes inappropriate focus redirection
650 that's hard to get rid of. */
651 #if 0
652 /* If a frame's focus has been redirected toward the currently
653 selected frame, we should change the redirection to point to the
654 newly selected frame. This means that if the focus is redirected
655 from a minibufferless frame to a surrogate minibuffer frame, we
656 can use `other-window' to switch between all the frames using
657 that minibuffer frame, and the focus redirection will follow us
658 around. */
659 if (track)
661 Lisp_Object tail;
663 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
665 Lisp_Object focus;
667 if (!FRAMEP (XCAR (tail)))
668 abort ();
670 focus = FRAME_FOCUS_FRAME (XFRAME (XCAR (tail)));
672 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
673 Fredirect_frame_focus (XCAR (tail), frame);
676 #else /* ! 0 */
677 /* Instead, apply it only to the frame we're pointing to. */
678 #ifdef HAVE_WINDOW_SYSTEM
679 if (track && FRAME_WINDOW_P (XFRAME (frame)))
681 Lisp_Object focus, xfocus;
683 xfocus = x_get_focus_frame (XFRAME (frame));
684 if (FRAMEP (xfocus))
686 focus = FRAME_FOCUS_FRAME (XFRAME (xfocus));
687 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
688 Fredirect_frame_focus (xfocus, frame);
691 #endif /* HAVE_X_WINDOWS */
692 #endif /* ! 0 */
694 if (!for_deletion && FRAME_HAS_MINIBUF_P (sf))
695 resize_mini_window (XWINDOW (FRAME_MINIBUF_WINDOW (sf)), 1);
697 selected_frame = frame;
698 if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
699 last_nonminibuf_frame = XFRAME (selected_frame);
701 Fselect_window (XFRAME (frame)->selected_window, Qnil);
703 #ifndef WINDOWSNT
704 /* Make sure to switch the tty color mode to that of the newly
705 selected frame. */
706 sf = SELECTED_FRAME ();
707 if (FRAME_TERMCAP_P (sf))
709 Lisp_Object color_mode_spec, color_mode;
711 color_mode_spec = assq_no_quit (Qtty_color_mode, sf->param_alist);
712 if (CONSP (color_mode_spec))
713 color_mode = XCDR (color_mode_spec);
714 else
715 color_mode = make_number (0);
716 set_tty_color_mode (sf, color_mode);
718 #endif /* !WINDOWSNT */
720 /* We want to make sure that the next event generates a frame-switch
721 event to the appropriate frame. This seems kludgy to me, but
722 before you take it out, make sure that evaluating something like
723 (select-window (frame-root-window (new-frame))) doesn't end up
724 with your typing being interpreted in the new frame instead of
725 the one you're actually typing in. */
726 internal_last_event_frame = Qnil;
728 return frame;
731 DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 2, "e",
732 doc: /* Select the frame FRAME.
733 Subsequent editing commands apply to its selected window.
734 The selection of FRAME lasts until the next time the user does
735 something to select a different frame, or until the next time this
736 function is called. */)
737 (frame, no_enter)
738 Lisp_Object frame, no_enter;
740 return do_switch_frame (frame, 1, 0);
744 DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 2, "e",
745 doc: /* Handle a switch-frame event EVENT.
746 Switch-frame events are usually bound to this function.
747 A switch-frame event tells Emacs that the window manager has requested
748 that the user's events be directed to the frame mentioned in the event.
749 This function selects the selected window of the frame of EVENT.
751 If EVENT is frame object, handle it as if it were a switch-frame event
752 to that frame. */)
753 (event, no_enter)
754 Lisp_Object event, no_enter;
756 /* Preserve prefix arg that the command loop just cleared. */
757 current_kboard->Vprefix_arg = Vcurrent_prefix_arg;
758 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
759 return do_switch_frame (event, 0, 0);
762 DEFUN ("ignore-event", Fignore_event, Signore_event, 0, 0, "",
763 doc: /* Do nothing, but preserve any prefix argument already specified.
764 This is a suitable binding for `iconify-frame' and `make-frame-visible'. */)
767 current_kboard->Vprefix_arg = Vcurrent_prefix_arg;
768 return Qnil;
771 DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0,
772 doc: /* Return the frame that is now selected. */)
775 return selected_frame;
778 DEFUN ("window-frame", Fwindow_frame, Swindow_frame, 1, 1, 0,
779 doc: /* Return the frame object that window WINDOW is on. */)
780 (window)
781 Lisp_Object window;
783 CHECK_LIVE_WINDOW (window);
784 return XWINDOW (window)->frame;
787 DEFUN ("frame-first-window", Fframe_first_window, Sframe_first_window, 0, 1, 0,
788 doc: /* Returns the topmost, leftmost window of FRAME.
789 If omitted, FRAME defaults to the currently selected frame. */)
790 (frame)
791 Lisp_Object frame;
793 Lisp_Object w;
795 if (NILP (frame))
796 w = SELECTED_FRAME ()->root_window;
797 else
799 CHECK_LIVE_FRAME (frame);
800 w = XFRAME (frame)->root_window;
802 while (NILP (XWINDOW (w)->buffer))
804 if (! NILP (XWINDOW (w)->hchild))
805 w = XWINDOW (w)->hchild;
806 else if (! NILP (XWINDOW (w)->vchild))
807 w = XWINDOW (w)->vchild;
808 else
809 abort ();
811 return w;
814 DEFUN ("active-minibuffer-window", Factive_minibuffer_window,
815 Sactive_minibuffer_window, 0, 0, 0,
816 doc: /* Return the currently active minibuffer window, or nil if none. */)
819 return minibuf_level ? minibuf_window : Qnil;
822 DEFUN ("frame-root-window", Fframe_root_window, Sframe_root_window, 0, 1, 0,
823 doc: /* Returns the root-window of FRAME.
824 If omitted, FRAME defaults to the currently selected frame. */)
825 (frame)
826 Lisp_Object frame;
828 Lisp_Object window;
830 if (NILP (frame))
831 window = SELECTED_FRAME ()->root_window;
832 else
834 CHECK_LIVE_FRAME (frame);
835 window = XFRAME (frame)->root_window;
838 return window;
841 DEFUN ("frame-selected-window", Fframe_selected_window,
842 Sframe_selected_window, 0, 1, 0,
843 doc: /* Return the selected window of frame object FRAME.
844 If omitted, FRAME defaults to the currently selected frame. */)
845 (frame)
846 Lisp_Object frame;
848 Lisp_Object window;
850 if (NILP (frame))
851 window = SELECTED_FRAME ()->selected_window;
852 else
854 CHECK_LIVE_FRAME (frame);
855 window = XFRAME (frame)->selected_window;
858 return window;
861 DEFUN ("set-frame-selected-window", Fset_frame_selected_window,
862 Sset_frame_selected_window, 2, 2, 0,
863 doc: /* Set the selected window of frame object FRAME to WINDOW.
864 If FRAME is nil, the selected frame is used.
865 If FRAME is the selected frame, this makes WINDOW the selected window. */)
866 (frame, window)
867 Lisp_Object frame, window;
869 if (NILP (frame))
870 frame = selected_frame;
872 CHECK_LIVE_FRAME (frame);
873 CHECK_LIVE_WINDOW (window);
875 if (! EQ (frame, WINDOW_FRAME (XWINDOW (window))))
876 error ("In `set-frame-selected-window', WINDOW is not on FRAME");
878 if (EQ (frame, selected_frame))
879 return Fselect_window (window, Qnil);
881 return XFRAME (frame)->selected_window = window;
884 DEFUN ("frame-list", Fframe_list, Sframe_list,
885 0, 0, 0,
886 doc: /* Return a list of all frames. */)
889 Lisp_Object frames;
890 frames = Fcopy_sequence (Vframe_list);
891 #ifdef HAVE_WINDOW_SYSTEM
892 if (FRAMEP (tip_frame))
893 frames = Fdelq (tip_frame, frames);
894 #endif
895 return frames;
898 /* Return the next frame in the frame list after FRAME.
899 If MINIBUF is nil, exclude minibuffer-only frames.
900 If MINIBUF is a window, include only its own frame
901 and any frame now using that window as the minibuffer.
902 If MINIBUF is `visible', include all visible frames.
903 If MINIBUF is 0, include all visible and iconified frames.
904 Otherwise, include all frames. */
906 Lisp_Object
907 next_frame (frame, minibuf)
908 Lisp_Object frame;
909 Lisp_Object minibuf;
911 Lisp_Object tail;
912 int passed = 0;
914 /* There must always be at least one frame in Vframe_list. */
915 if (! CONSP (Vframe_list))
916 abort ();
918 /* If this frame is dead, it won't be in Vframe_list, and we'll loop
919 forever. Forestall that. */
920 CHECK_LIVE_FRAME (frame);
922 while (1)
923 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
925 Lisp_Object f;
927 f = XCAR (tail);
929 if (passed
930 && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
932 /* Decide whether this frame is eligible to be returned. */
934 /* If we've looped all the way around without finding any
935 eligible frames, return the original frame. */
936 if (EQ (f, frame))
937 return f;
939 /* Let minibuf decide if this frame is acceptable. */
940 if (NILP (minibuf))
942 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
943 return f;
945 else if (EQ (minibuf, Qvisible))
947 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
948 if (FRAME_VISIBLE_P (XFRAME (f)))
949 return f;
951 else if (INTEGERP (minibuf) && XINT (minibuf) == 0)
953 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
954 if (FRAME_VISIBLE_P (XFRAME (f))
955 || FRAME_ICONIFIED_P (XFRAME (f)))
956 return f;
958 else if (WINDOWP (minibuf))
960 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
961 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
962 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
963 FRAME_FOCUS_FRAME (XFRAME (f))))
964 return f;
966 else
967 return f;
970 if (EQ (frame, f))
971 passed++;
975 /* Return the previous frame in the frame list before FRAME.
976 If MINIBUF is nil, exclude minibuffer-only frames.
977 If MINIBUF is a window, include only its own frame
978 and any frame now using that window as the minibuffer.
979 If MINIBUF is `visible', include all visible frames.
980 If MINIBUF is 0, include all visible and iconified frames.
981 Otherwise, include all frames. */
983 Lisp_Object
984 prev_frame (frame, minibuf)
985 Lisp_Object frame;
986 Lisp_Object minibuf;
988 Lisp_Object tail;
989 Lisp_Object prev;
991 /* There must always be at least one frame in Vframe_list. */
992 if (! CONSP (Vframe_list))
993 abort ();
995 prev = Qnil;
996 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
998 Lisp_Object f;
1000 f = XCAR (tail);
1001 if (!FRAMEP (f))
1002 abort ();
1004 if (EQ (frame, f) && !NILP (prev))
1005 return prev;
1007 if (FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
1009 /* Decide whether this frame is eligible to be returned,
1010 according to minibuf. */
1011 if (NILP (minibuf))
1013 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
1014 prev = f;
1016 else if (WINDOWP (minibuf))
1018 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
1019 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
1020 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
1021 FRAME_FOCUS_FRAME (XFRAME (f))))
1022 prev = f;
1024 else if (EQ (minibuf, Qvisible))
1026 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1027 if (FRAME_VISIBLE_P (XFRAME (f)))
1028 prev = f;
1030 else if (XFASTINT (minibuf) == 0)
1032 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1033 if (FRAME_VISIBLE_P (XFRAME (f))
1034 || FRAME_ICONIFIED_P (XFRAME (f)))
1035 prev = f;
1037 else
1038 prev = f;
1042 /* We've scanned the entire list. */
1043 if (NILP (prev))
1044 /* We went through the whole frame list without finding a single
1045 acceptable frame. Return the original frame. */
1046 return frame;
1047 else
1048 /* There were no acceptable frames in the list before FRAME; otherwise,
1049 we would have returned directly from the loop. Since PREV is the last
1050 acceptable frame in the list, return it. */
1051 return prev;
1055 DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0,
1056 doc: /* Return the next frame in the frame list after FRAME.
1057 It considers only frames on the same terminal as FRAME.
1058 By default, skip minibuffer-only frames.
1059 If omitted, FRAME defaults to the selected frame.
1060 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1061 If MINIFRAME is a window, include only its own frame
1062 and any frame now using that window as the minibuffer.
1063 If MINIFRAME is `visible', include all visible frames.
1064 If MINIFRAME is 0, include all visible and iconified frames.
1065 Otherwise, include all frames. */)
1066 (frame, miniframe)
1067 Lisp_Object frame, miniframe;
1069 if (NILP (frame))
1070 frame = selected_frame;
1072 CHECK_LIVE_FRAME (frame);
1073 return next_frame (frame, miniframe);
1076 DEFUN ("previous-frame", Fprevious_frame, Sprevious_frame, 0, 2, 0,
1077 doc: /* Return the previous frame in the frame list before FRAME.
1078 It considers only frames on the same terminal as FRAME.
1079 By default, skip minibuffer-only frames.
1080 If omitted, FRAME defaults to the selected frame.
1081 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1082 If MINIFRAME is a window, include only its own frame
1083 and any frame now using that window as the minibuffer.
1084 If MINIFRAME is `visible', include all visible frames.
1085 If MINIFRAME is 0, include all visible and iconified frames.
1086 Otherwise, include all frames. */)
1087 (frame, miniframe)
1088 Lisp_Object frame, miniframe;
1090 if (NILP (frame))
1091 frame = selected_frame;
1092 CHECK_LIVE_FRAME (frame);
1093 return prev_frame (frame, miniframe);
1096 /* Return 1 if it is ok to delete frame F;
1097 0 if all frames aside from F are invisible.
1098 (Exception: if F is the terminal frame, and we are using X, return 1.) */
1101 other_visible_frames (f)
1102 FRAME_PTR f;
1104 /* We know the selected frame is visible,
1105 so if F is some other frame, it can't be the sole visible one. */
1106 if (f == SELECTED_FRAME ())
1108 Lisp_Object frames;
1109 int count = 0;
1111 for (frames = Vframe_list;
1112 CONSP (frames);
1113 frames = XCDR (frames))
1115 Lisp_Object this;
1117 this = XCAR (frames);
1118 /* Verify that the frame's window still exists
1119 and we can still talk to it. And note any recent change
1120 in visibility. */
1121 #ifdef HAVE_WINDOW_SYSTEM
1122 if (FRAME_WINDOW_P (XFRAME (this)))
1124 x_sync (XFRAME (this));
1125 FRAME_SAMPLE_VISIBILITY (XFRAME (this));
1127 #endif
1129 if (FRAME_VISIBLE_P (XFRAME (this))
1130 || FRAME_ICONIFIED_P (XFRAME (this))
1131 /* Allow deleting the terminal frame when at least
1132 one X frame exists! */
1133 || (FRAME_WINDOW_P (XFRAME (this)) && !FRAME_WINDOW_P (f)))
1134 count++;
1136 return count > 1;
1138 return 1;
1141 DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 2, "",
1142 doc: /* Delete FRAME, permanently eliminating it from use.
1143 If omitted, FRAME defaults to the selected frame.
1144 A frame may not be deleted if its minibuffer is used by other frames.
1145 Normally, you may not delete a frame if all other frames are invisible,
1146 but if the second optional argument FORCE is non-nil, you may do so.
1148 This function runs `delete-frame-functions' before actually deleting the
1149 frame, unless the frame is a tooltip.
1150 The functions are run with one arg, the frame to be deleted. */)
1151 (frame, force)
1152 Lisp_Object frame, force;
1154 struct frame *f;
1155 struct frame *sf = SELECTED_FRAME ();
1156 int minibuffer_selected;
1158 if (EQ (frame, Qnil))
1160 f = sf;
1161 XSETFRAME (frame, f);
1163 else
1165 CHECK_FRAME (frame);
1166 f = XFRAME (frame);
1169 if (! FRAME_LIVE_P (f))
1170 return Qnil;
1172 if (NILP (force) && !other_visible_frames (f)
1173 #ifdef MAC_OS8
1174 /* Terminal frame deleted before any other visible frames are
1175 created. */
1176 && strcmp (SDATA (f->name), "F1") != 0
1177 #endif
1179 error ("Attempt to delete the sole visible or iconified frame");
1181 #if 0
1182 /* This is a nice idea, but x_connection_closed needs to be able
1183 to delete the last frame, if it is gone. */
1184 if (NILP (XCDR (Vframe_list)))
1185 error ("Attempt to delete the only frame");
1186 #endif
1188 /* Does this frame have a minibuffer, and is it the surrogate
1189 minibuffer for any other frame? */
1190 if (FRAME_HAS_MINIBUF_P (XFRAME (frame)))
1192 Lisp_Object frames;
1194 for (frames = Vframe_list;
1195 CONSP (frames);
1196 frames = XCDR (frames))
1198 Lisp_Object this;
1199 this = XCAR (frames);
1201 if (! EQ (this, frame)
1202 && EQ (frame,
1203 WINDOW_FRAME (XWINDOW
1204 (FRAME_MINIBUF_WINDOW (XFRAME (this))))))
1205 error ("Attempt to delete a surrogate minibuffer frame");
1209 /* Run `delete-frame-functions' unless frame is a tooltip. */
1210 if (!NILP (Vrun_hooks)
1211 && NILP (Fframe_parameter (frame, intern ("tooltip"))))
1213 Lisp_Object args[2];
1214 args[0] = intern ("delete-frame-functions");
1215 args[1] = frame;
1216 Frun_hook_with_args (2, args);
1219 minibuffer_selected = EQ (minibuf_window, selected_window);
1221 /* Don't let the frame remain selected. */
1222 if (f == sf)
1224 Lisp_Object tail, frame1;
1226 /* Look for another visible frame on the same terminal. */
1227 frame1 = next_frame (frame, Qvisible);
1229 /* If there is none, find *some* other frame. */
1230 if (NILP (frame1) || EQ (frame1, frame))
1232 FOR_EACH_FRAME (tail, frame1)
1234 if (! EQ (frame, frame1))
1235 break;
1239 do_switch_frame (frame1, 0, 1);
1240 sf = SELECTED_FRAME ();
1243 /* Don't allow minibuf_window to remain on a deleted frame. */
1244 if (EQ (f->minibuffer_window, minibuf_window))
1246 Fset_window_buffer (sf->minibuffer_window,
1247 XWINDOW (minibuf_window)->buffer, Qnil);
1248 minibuf_window = sf->minibuffer_window;
1250 /* If the dying minibuffer window was selected,
1251 select the new one. */
1252 if (minibuffer_selected)
1253 Fselect_window (minibuf_window, Qnil);
1256 /* Don't let echo_area_window to remain on a deleted frame. */
1257 if (EQ (f->minibuffer_window, echo_area_window))
1258 echo_area_window = sf->minibuffer_window;
1260 /* Clear any X selections for this frame. */
1261 #ifdef HAVE_X_WINDOWS
1262 if (FRAME_X_P (f))
1263 x_clear_frame_selections (f);
1264 #endif
1266 /* Free glyphs.
1267 This function must be called before the window tree of the
1268 frame is deleted because windows contain dynamically allocated
1269 memory. */
1270 free_glyphs (f);
1272 /* Mark all the windows that used to be on FRAME as deleted, and then
1273 remove the reference to them. */
1274 delete_all_subwindows (XWINDOW (f->root_window));
1275 f->root_window = Qnil;
1277 Vframe_list = Fdelq (frame, Vframe_list);
1278 FRAME_SET_VISIBLE (f, 0);
1280 if (f->namebuf)
1281 xfree (f->namebuf);
1282 if (f->decode_mode_spec_buffer)
1283 xfree (f->decode_mode_spec_buffer);
1284 if (FRAME_INSERT_COST (f))
1285 xfree (FRAME_INSERT_COST (f));
1286 if (FRAME_DELETEN_COST (f))
1287 xfree (FRAME_DELETEN_COST (f));
1288 if (FRAME_INSERTN_COST (f))
1289 xfree (FRAME_INSERTN_COST (f));
1290 if (FRAME_DELETE_COST (f))
1291 xfree (FRAME_DELETE_COST (f));
1292 if (FRAME_MESSAGE_BUF (f))
1293 xfree (FRAME_MESSAGE_BUF (f));
1295 /* Since some events are handled at the interrupt level, we may get
1296 an event for f at any time; if we zero out the frame's display
1297 now, then we may trip up the event-handling code. Instead, we'll
1298 promise that the display of the frame must be valid until we have
1299 called the window-system-dependent frame destruction routine. */
1301 /* I think this should be done with a hook. */
1302 #ifdef HAVE_WINDOW_SYSTEM
1303 if (FRAME_WINDOW_P (f))
1304 x_destroy_window (f);
1305 #endif
1307 f->output_data.nothing = 0;
1309 /* If we've deleted the last_nonminibuf_frame, then try to find
1310 another one. */
1311 if (f == last_nonminibuf_frame)
1313 Lisp_Object frames;
1315 last_nonminibuf_frame = 0;
1317 for (frames = Vframe_list;
1318 CONSP (frames);
1319 frames = XCDR (frames))
1321 f = XFRAME (XCAR (frames));
1322 if (!FRAME_MINIBUF_ONLY_P (f))
1324 last_nonminibuf_frame = f;
1325 break;
1330 /* If we've deleted this keyboard's default_minibuffer_frame, try to
1331 find another one. Prefer minibuffer-only frames, but also notice
1332 frames with other windows. */
1333 if (EQ (frame, FRAME_KBOARD (f)->Vdefault_minibuffer_frame))
1335 Lisp_Object frames;
1337 /* The last frame we saw with a minibuffer, minibuffer-only or not. */
1338 Lisp_Object frame_with_minibuf;
1339 /* Some frame we found on the same kboard, or nil if there are none. */
1340 Lisp_Object frame_on_same_kboard;
1342 frame_on_same_kboard = Qnil;
1343 frame_with_minibuf = Qnil;
1345 for (frames = Vframe_list;
1346 CONSP (frames);
1347 frames = XCDR (frames))
1349 Lisp_Object this;
1350 struct frame *f1;
1352 this = XCAR (frames);
1353 if (!FRAMEP (this))
1354 abort ();
1355 f1 = XFRAME (this);
1357 /* Consider only frames on the same kboard
1358 and only those with minibuffers. */
1359 if (FRAME_KBOARD (f) == FRAME_KBOARD (f1)
1360 && FRAME_HAS_MINIBUF_P (f1))
1362 frame_with_minibuf = this;
1363 if (FRAME_MINIBUF_ONLY_P (f1))
1364 break;
1367 if (FRAME_KBOARD (f) == FRAME_KBOARD (f1))
1368 frame_on_same_kboard = this;
1371 if (!NILP (frame_on_same_kboard))
1373 /* We know that there must be some frame with a minibuffer out
1374 there. If this were not true, all of the frames present
1375 would have to be minibufferless, which implies that at some
1376 point their minibuffer frames must have been deleted, but
1377 that is prohibited at the top; you can't delete surrogate
1378 minibuffer frames. */
1379 if (NILP (frame_with_minibuf))
1380 abort ();
1382 FRAME_KBOARD (f)->Vdefault_minibuffer_frame = frame_with_minibuf;
1384 else
1385 /* No frames left on this kboard--say no minibuffer either. */
1386 FRAME_KBOARD (f)->Vdefault_minibuffer_frame = Qnil;
1389 /* Cause frame titles to update--necessary if we now have just one frame. */
1390 update_mode_lines = 1;
1392 return Qnil;
1395 /* Return mouse position in character cell units. */
1397 DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0,
1398 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1399 The position is given in character cells, where (0, 0) is the
1400 upper-left corner.
1401 If Emacs is running on a mouseless terminal or hasn't been programmed
1402 to read the mouse position, it returns the selected frame for FRAME
1403 and nil for X and Y.
1404 If `mouse-position-function' is non-nil, `mouse-position' calls it,
1405 passing the normal return value to that function as an argument,
1406 and returns whatever that function returns. */)
1409 FRAME_PTR f;
1410 Lisp_Object lispy_dummy;
1411 enum scroll_bar_part party_dummy;
1412 Lisp_Object x, y, retval;
1413 int col, row;
1414 unsigned long long_dummy;
1415 struct gcpro gcpro1;
1417 f = SELECTED_FRAME ();
1418 x = y = Qnil;
1420 #ifdef HAVE_MOUSE
1421 /* It's okay for the hook to refrain from storing anything. */
1422 if (mouse_position_hook)
1423 (*mouse_position_hook) (&f, -1,
1424 &lispy_dummy, &party_dummy,
1425 &x, &y,
1426 &long_dummy);
1427 if (! NILP (x))
1429 col = XINT (x);
1430 row = XINT (y);
1431 pixel_to_glyph_coords (f, col, row, &col, &row, NULL, 1);
1432 XSETINT (x, col);
1433 XSETINT (y, row);
1435 #endif
1436 XSETFRAME (lispy_dummy, f);
1437 retval = Fcons (lispy_dummy, Fcons (x, y));
1438 GCPRO1 (retval);
1439 if (!NILP (Vmouse_position_function))
1440 retval = call1 (Vmouse_position_function, retval);
1441 RETURN_UNGCPRO (retval);
1444 DEFUN ("mouse-pixel-position", Fmouse_pixel_position,
1445 Smouse_pixel_position, 0, 0, 0,
1446 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1447 The position is given in pixel units, where (0, 0) is the
1448 upper-left corner.
1449 If Emacs is running on a mouseless terminal or hasn't been programmed
1450 to read the mouse position, it returns the selected frame for FRAME
1451 and nil for X and Y. */)
1454 FRAME_PTR f;
1455 Lisp_Object lispy_dummy;
1456 enum scroll_bar_part party_dummy;
1457 Lisp_Object x, y;
1458 unsigned long long_dummy;
1460 f = SELECTED_FRAME ();
1461 x = y = Qnil;
1463 #ifdef HAVE_MOUSE
1464 /* It's okay for the hook to refrain from storing anything. */
1465 if (mouse_position_hook)
1466 (*mouse_position_hook) (&f, -1,
1467 &lispy_dummy, &party_dummy,
1468 &x, &y,
1469 &long_dummy);
1470 #endif
1471 XSETFRAME (lispy_dummy, f);
1472 return Fcons (lispy_dummy, Fcons (x, y));
1475 DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0,
1476 doc: /* Move the mouse pointer to the center of character cell (X,Y) in FRAME.
1477 Coordinates are relative to the frame, not a window,
1478 so the coordinates of the top left character in the frame
1479 may be nonzero due to left-hand scroll bars or the menu bar.
1481 This function is a no-op for an X frame that is not visible.
1482 If you have just created a frame, you must wait for it to become visible
1483 before calling this function on it, like this.
1484 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1485 (frame, x, y)
1486 Lisp_Object frame, x, y;
1488 CHECK_LIVE_FRAME (frame);
1489 CHECK_NUMBER (x);
1490 CHECK_NUMBER (y);
1492 /* I think this should be done with a hook. */
1493 #ifdef HAVE_WINDOW_SYSTEM
1494 if (FRAME_WINDOW_P (XFRAME (frame)))
1495 /* Warping the mouse will cause enternotify and focus events. */
1496 x_set_mouse_position (XFRAME (frame), XINT (x), XINT (y));
1497 #else
1498 #if defined (MSDOS) && defined (HAVE_MOUSE)
1499 if (FRAME_MSDOS_P (XFRAME (frame)))
1501 Fselect_frame (frame, Qnil);
1502 mouse_moveto (XINT (x), XINT (y));
1504 #endif
1505 #endif
1507 return Qnil;
1510 DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position,
1511 Sset_mouse_pixel_position, 3, 3, 0,
1512 doc: /* Move the mouse pointer to pixel position (X,Y) in FRAME.
1513 Note, this is a no-op for an X frame that is not visible.
1514 If you have just created a frame, you must wait for it to become visible
1515 before calling this function on it, like this.
1516 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1517 (frame, x, y)
1518 Lisp_Object frame, x, y;
1520 CHECK_LIVE_FRAME (frame);
1521 CHECK_NUMBER (x);
1522 CHECK_NUMBER (y);
1524 /* I think this should be done with a hook. */
1525 #ifdef HAVE_WINDOW_SYSTEM
1526 if (FRAME_WINDOW_P (XFRAME (frame)))
1527 /* Warping the mouse will cause enternotify and focus events. */
1528 x_set_mouse_pixel_position (XFRAME (frame), XINT (x), XINT (y));
1529 #else
1530 #if defined (MSDOS) && defined (HAVE_MOUSE)
1531 if (FRAME_MSDOS_P (XFRAME (frame)))
1533 Fselect_frame (frame, Qnil);
1534 mouse_moveto (XINT (x), XINT (y));
1536 #endif
1537 #endif
1539 return Qnil;
1542 static void make_frame_visible_1 P_ ((Lisp_Object));
1544 DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible,
1545 0, 1, "",
1546 doc: /* Make the frame FRAME visible (assuming it is an X window).
1547 If omitted, FRAME defaults to the currently selected frame. */)
1548 (frame)
1549 Lisp_Object frame;
1551 if (NILP (frame))
1552 frame = selected_frame;
1554 CHECK_LIVE_FRAME (frame);
1556 /* I think this should be done with a hook. */
1557 #ifdef HAVE_WINDOW_SYSTEM
1558 if (FRAME_WINDOW_P (XFRAME (frame)))
1560 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1561 x_make_frame_visible (XFRAME (frame));
1563 #endif
1565 make_frame_visible_1 (XFRAME (frame)->root_window);
1567 /* Make menu bar update for the Buffers and Frames menus. */
1568 windows_or_buffers_changed++;
1570 return frame;
1573 /* Update the display_time slot of the buffers shown in WINDOW
1574 and all its descendents. */
1576 static void
1577 make_frame_visible_1 (window)
1578 Lisp_Object window;
1580 struct window *w;
1582 for (;!NILP (window); window = w->next)
1584 w = XWINDOW (window);
1586 if (!NILP (w->buffer))
1587 XBUFFER (w->buffer)->display_time = Fcurrent_time ();
1589 if (!NILP (w->vchild))
1590 make_frame_visible_1 (w->vchild);
1591 if (!NILP (w->hchild))
1592 make_frame_visible_1 (w->hchild);
1596 DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible,
1597 0, 2, "",
1598 doc: /* Make the frame FRAME invisible (assuming it is an X window).
1599 If omitted, FRAME defaults to the currently selected frame.
1600 Normally you may not make FRAME invisible if all other frames are invisible,
1601 but if the second optional argument FORCE is non-nil, you may do so. */)
1602 (frame, force)
1603 Lisp_Object frame, force;
1605 if (NILP (frame))
1606 frame = selected_frame;
1608 CHECK_LIVE_FRAME (frame);
1610 if (NILP (force) && !other_visible_frames (XFRAME (frame)))
1611 error ("Attempt to make invisible the sole visible or iconified frame");
1613 #if 0 /* This isn't logically necessary, and it can do GC. */
1614 /* Don't let the frame remain selected. */
1615 if (EQ (frame, selected_frame))
1616 do_switch_frame (next_frame (frame, Qt), 0, 0)
1617 #endif
1619 /* Don't allow minibuf_window to remain on a deleted frame. */
1620 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1622 struct frame *sf = XFRAME (selected_frame);
1623 Fset_window_buffer (sf->minibuffer_window,
1624 XWINDOW (minibuf_window)->buffer, Qnil);
1625 minibuf_window = sf->minibuffer_window;
1628 /* I think this should be done with a hook. */
1629 #ifdef HAVE_WINDOW_SYSTEM
1630 if (FRAME_WINDOW_P (XFRAME (frame)))
1631 x_make_frame_invisible (XFRAME (frame));
1632 #endif
1634 /* Make menu bar update for the Buffers and Frames menus. */
1635 windows_or_buffers_changed++;
1637 return Qnil;
1640 DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame,
1641 0, 1, "",
1642 doc: /* Make the frame FRAME into an icon.
1643 If omitted, FRAME defaults to the currently selected frame. */)
1644 (frame)
1645 Lisp_Object frame;
1647 if (NILP (frame))
1648 frame = selected_frame;
1650 CHECK_LIVE_FRAME (frame);
1652 #if 0 /* This isn't logically necessary, and it can do GC. */
1653 /* Don't let the frame remain selected. */
1654 if (EQ (frame, selected_frame))
1655 Fhandle_switch_frame (next_frame (frame, Qt), Qnil);
1656 #endif
1658 /* Don't allow minibuf_window to remain on a deleted frame. */
1659 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1661 struct frame *sf = XFRAME (selected_frame);
1662 Fset_window_buffer (sf->minibuffer_window,
1663 XWINDOW (minibuf_window)->buffer, Qnil);
1664 minibuf_window = sf->minibuffer_window;
1667 /* I think this should be done with a hook. */
1668 #ifdef HAVE_WINDOW_SYSTEM
1669 if (FRAME_WINDOW_P (XFRAME (frame)))
1670 x_iconify_frame (XFRAME (frame));
1671 #endif
1673 /* Make menu bar update for the Buffers and Frames menus. */
1674 windows_or_buffers_changed++;
1676 return Qnil;
1679 DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p,
1680 1, 1, 0,
1681 doc: /* Return t if FRAME is now \"visible\" (actually in use for display).
1682 A frame that is not \"visible\" is not updated and, if it works through
1683 a window system, it may not show at all.
1684 Return the symbol `icon' if frame is visible only as an icon. */)
1685 (frame)
1686 Lisp_Object frame;
1688 CHECK_LIVE_FRAME (frame);
1690 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1692 if (FRAME_VISIBLE_P (XFRAME (frame)))
1693 return Qt;
1694 if (FRAME_ICONIFIED_P (XFRAME (frame)))
1695 return Qicon;
1696 return Qnil;
1699 DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list,
1700 0, 0, 0,
1701 doc: /* Return a list of all frames now \"visible\" (being updated). */)
1704 Lisp_Object tail, frame;
1705 struct frame *f;
1706 Lisp_Object value;
1708 value = Qnil;
1709 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1711 frame = XCAR (tail);
1712 if (!FRAMEP (frame))
1713 continue;
1714 f = XFRAME (frame);
1715 if (FRAME_VISIBLE_P (f))
1716 value = Fcons (frame, value);
1718 return value;
1722 DEFUN ("raise-frame", Fraise_frame, Sraise_frame, 0, 1, "",
1723 doc: /* Bring FRAME to the front, so it occludes any frames it overlaps.
1724 If FRAME is invisible, make it visible.
1725 If you don't specify a frame, the selected frame is used.
1726 If Emacs is displaying on an ordinary terminal or some other device which
1727 doesn't support multiple overlapping frames, this function does nothing. */)
1728 (frame)
1729 Lisp_Object frame;
1731 if (NILP (frame))
1732 frame = selected_frame;
1734 CHECK_LIVE_FRAME (frame);
1736 /* Do like the documentation says. */
1737 Fmake_frame_visible (frame);
1739 if (frame_raise_lower_hook)
1740 (*frame_raise_lower_hook) (XFRAME (frame), 1);
1742 return Qnil;
1745 /* Should we have a corresponding function called Flower_Power? */
1746 DEFUN ("lower-frame", Flower_frame, Slower_frame, 0, 1, "",
1747 doc: /* Send FRAME to the back, so it is occluded by any frames that overlap it.
1748 If you don't specify a frame, the selected frame is used.
1749 If Emacs is displaying on an ordinary terminal or some other device which
1750 doesn't support multiple overlapping frames, this function does nothing. */)
1751 (frame)
1752 Lisp_Object frame;
1754 if (NILP (frame))
1755 frame = selected_frame;
1757 CHECK_LIVE_FRAME (frame);
1759 if (frame_raise_lower_hook)
1760 (*frame_raise_lower_hook) (XFRAME (frame), 0);
1762 return Qnil;
1766 DEFUN ("redirect-frame-focus", Fredirect_frame_focus, Sredirect_frame_focus,
1767 1, 2, 0,
1768 doc: /* Arrange for keystrokes typed at FRAME to be sent to FOCUS-FRAME.
1769 In other words, switch-frame events caused by events in FRAME will
1770 request a switch to FOCUS-FRAME, and `last-event-frame' will be
1771 FOCUS-FRAME after reading an event typed at FRAME.
1773 If FOCUS-FRAME is omitted or nil, any existing redirection is
1774 cancelled, and the frame again receives its own keystrokes.
1776 Focus redirection is useful for temporarily redirecting keystrokes to
1777 a surrogate minibuffer frame when a frame doesn't have its own
1778 minibuffer window.
1780 A frame's focus redirection can be changed by select-frame. If frame
1781 FOO is selected, and then a different frame BAR is selected, any
1782 frames redirecting their focus to FOO are shifted to redirect their
1783 focus to BAR. This allows focus redirection to work properly when the
1784 user switches from one frame to another using `select-window'.
1786 This means that a frame whose focus is redirected to itself is treated
1787 differently from a frame whose focus is redirected to nil; the former
1788 is affected by select-frame, while the latter is not.
1790 The redirection lasts until `redirect-frame-focus' is called to change it. */)
1791 (frame, focus_frame)
1792 Lisp_Object frame, focus_frame;
1794 /* Note that we don't check for a live frame here. It's reasonable
1795 to redirect the focus of a frame you're about to delete, if you
1796 know what other frame should receive those keystrokes. */
1797 CHECK_FRAME (frame);
1799 if (! NILP (focus_frame))
1800 CHECK_LIVE_FRAME (focus_frame);
1802 XFRAME (frame)->focus_frame = focus_frame;
1804 if (frame_rehighlight_hook)
1805 (*frame_rehighlight_hook) (XFRAME (frame));
1807 return Qnil;
1811 DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 1, 1, 0,
1812 doc: /* Return the frame to which FRAME's keystrokes are currently being sent.
1813 This returns nil if FRAME's focus is not redirected.
1814 See `redirect-frame-focus'. */)
1815 (frame)
1816 Lisp_Object frame;
1818 CHECK_LIVE_FRAME (frame);
1820 return FRAME_FOCUS_FRAME (XFRAME (frame));
1825 /* Return the value of frame parameter PROP in frame FRAME. */
1827 Lisp_Object
1828 get_frame_param (frame, prop)
1829 register struct frame *frame;
1830 Lisp_Object prop;
1832 register Lisp_Object tem;
1834 tem = Fassq (prop, frame->param_alist);
1835 if (EQ (tem, Qnil))
1836 return tem;
1837 return Fcdr (tem);
1840 /* Return the buffer-predicate of the selected frame. */
1842 Lisp_Object
1843 frame_buffer_predicate (frame)
1844 Lisp_Object frame;
1846 return XFRAME (frame)->buffer_predicate;
1849 /* Return the buffer-list of the selected frame. */
1851 Lisp_Object
1852 frame_buffer_list (frame)
1853 Lisp_Object frame;
1855 return XFRAME (frame)->buffer_list;
1858 /* Set the buffer-list of the selected frame. */
1860 void
1861 set_frame_buffer_list (frame, list)
1862 Lisp_Object frame, list;
1864 XFRAME (frame)->buffer_list = list;
1867 /* Discard BUFFER from the buffer-list of each frame. */
1869 void
1870 frames_discard_buffer (buffer)
1871 Lisp_Object buffer;
1873 Lisp_Object frame, tail;
1875 FOR_EACH_FRAME (tail, frame)
1877 XFRAME (frame)->buffer_list
1878 = Fdelq (buffer, XFRAME (frame)->buffer_list);
1882 /* Modify the alist in *ALISTPTR to associate PROP with VAL.
1883 If the alist already has an element for PROP, we change it. */
1885 void
1886 store_in_alist (alistptr, prop, val)
1887 Lisp_Object *alistptr, val;
1888 Lisp_Object prop;
1890 register Lisp_Object tem;
1892 tem = Fassq (prop, *alistptr);
1893 if (EQ (tem, Qnil))
1894 *alistptr = Fcons (Fcons (prop, val), *alistptr);
1895 else
1896 Fsetcdr (tem, val);
1899 static int
1900 frame_name_fnn_p (str, len)
1901 char *str;
1902 int len;
1904 if (len > 1 && str[0] == 'F')
1906 char *end_ptr;
1908 strtol (str + 1, &end_ptr, 10);
1910 if (end_ptr == str + len)
1911 return 1;
1913 return 0;
1916 /* Set the name of the terminal frame. Also used by MSDOS frames.
1917 Modeled after x_set_name which is used for WINDOW frames. */
1919 void
1920 set_term_frame_name (f, name)
1921 struct frame *f;
1922 Lisp_Object name;
1924 f->explicit_name = ! NILP (name);
1926 /* If NAME is nil, set the name to F<num>. */
1927 if (NILP (name))
1929 char namebuf[20];
1931 /* Check for no change needed in this very common case
1932 before we do any consing. */
1933 if (frame_name_fnn_p (SDATA (f->name),
1934 SBYTES (f->name)))
1935 return;
1937 terminal_frame_count++;
1938 sprintf (namebuf, "F%d", terminal_frame_count);
1939 name = build_string (namebuf);
1941 else
1943 CHECK_STRING (name);
1945 /* Don't change the name if it's already NAME. */
1946 if (! NILP (Fstring_equal (name, f->name)))
1947 return;
1949 /* Don't allow the user to set the frame name to F<num>, so it
1950 doesn't clash with the names we generate for terminal frames. */
1951 if (frame_name_fnn_p (SDATA (name), SBYTES (name)))
1952 error ("Frame names of the form F<num> are usurped by Emacs");
1955 f->name = name;
1956 update_mode_lines = 1;
1959 void
1960 store_frame_param (f, prop, val)
1961 struct frame *f;
1962 Lisp_Object prop, val;
1964 register Lisp_Object old_alist_elt;
1966 /* The buffer-alist parameter is stored in a special place and is
1967 not in the alist. */
1968 if (EQ (prop, Qbuffer_list))
1970 f->buffer_list = val;
1971 return;
1974 /* If PROP is a symbol which is supposed to have frame-local values,
1975 and it is set up based on this frame, switch to the global
1976 binding. That way, we can create or alter the frame-local binding
1977 without messing up the symbol's status. */
1978 if (SYMBOLP (prop))
1980 Lisp_Object valcontents;
1981 valcontents = SYMBOL_VALUE (prop);
1982 if ((BUFFER_LOCAL_VALUEP (valcontents)
1983 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
1984 && XBUFFER_LOCAL_VALUE (valcontents)->check_frame
1985 && XFRAME (XBUFFER_LOCAL_VALUE (valcontents)->frame) == f)
1986 swap_in_global_binding (prop);
1989 #ifndef WINDOWSNT
1990 /* The tty color mode needs to be set before the frame's parameter
1991 alist is updated with the new value, because set_tty_color_mode
1992 wants to look at the old mode. */
1993 if (FRAME_TERMCAP_P (f) && EQ (prop, Qtty_color_mode))
1994 set_tty_color_mode (f, val);
1995 #endif
1997 /* Update the frame parameter alist. */
1998 old_alist_elt = Fassq (prop, f->param_alist);
1999 if (EQ (old_alist_elt, Qnil))
2000 f->param_alist = Fcons (Fcons (prop, val), f->param_alist);
2001 else
2002 Fsetcdr (old_alist_elt, val);
2004 /* Update some other special parameters in their special places
2005 in addition to the alist. */
2007 if (EQ (prop, Qbuffer_predicate))
2008 f->buffer_predicate = val;
2010 if (! FRAME_WINDOW_P (f))
2012 if (EQ (prop, Qmenu_bar_lines))
2013 set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f)));
2014 else if (EQ (prop, Qname))
2015 set_term_frame_name (f, val);
2018 if (EQ (prop, Qminibuffer) && WINDOWP (val))
2020 if (! MINI_WINDOW_P (XWINDOW (val)))
2021 error ("Surrogate minibuffer windows must be minibuffer windows");
2023 if ((FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
2024 && !EQ (val, f->minibuffer_window))
2025 error ("Can't change the surrogate minibuffer of a frame with its own minibuffer");
2027 /* Install the chosen minibuffer window, with proper buffer. */
2028 f->minibuffer_window = val;
2032 DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0,
2033 doc: /* Return the parameters-alist of frame FRAME.
2034 It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
2035 The meaningful PARMs depend on the kind of frame.
2036 If FRAME is omitted, return information on the currently selected frame. */)
2037 (frame)
2038 Lisp_Object frame;
2040 Lisp_Object alist;
2041 FRAME_PTR f;
2042 int height, width;
2043 struct gcpro gcpro1;
2045 if (NILP (frame))
2046 frame = selected_frame;
2048 CHECK_FRAME (frame);
2049 f = XFRAME (frame);
2051 if (!FRAME_LIVE_P (f))
2052 return Qnil;
2054 alist = Fcopy_alist (f->param_alist);
2055 GCPRO1 (alist);
2057 if (!FRAME_WINDOW_P (f))
2059 int fg = FRAME_FOREGROUND_PIXEL (f);
2060 int bg = FRAME_BACKGROUND_PIXEL (f);
2061 Lisp_Object elt;
2063 /* If the frame's parameter alist says the colors are
2064 unspecified and reversed, take the frame's background pixel
2065 for foreground and vice versa. */
2066 elt = Fassq (Qforeground_color, alist);
2067 if (!NILP (elt) && CONSP (elt) && STRINGP (XCDR (elt)))
2069 if (strncmp (SDATA (XCDR (elt)),
2070 unspecified_bg,
2071 SCHARS (XCDR (elt))) == 0)
2072 store_in_alist (&alist, Qforeground_color, tty_color_name (f, bg));
2073 else if (strncmp (SDATA (XCDR (elt)),
2074 unspecified_fg,
2075 SCHARS (XCDR (elt))) == 0)
2076 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2078 else
2079 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2080 elt = Fassq (Qbackground_color, alist);
2081 if (!NILP (elt) && CONSP (elt) && STRINGP (XCDR (elt)))
2083 if (strncmp (SDATA (XCDR (elt)),
2084 unspecified_fg,
2085 SCHARS (XCDR (elt))) == 0)
2086 store_in_alist (&alist, Qbackground_color, tty_color_name (f, fg));
2087 else if (strncmp (SDATA (XCDR (elt)),
2088 unspecified_bg,
2089 SCHARS (XCDR (elt))) == 0)
2090 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2092 else
2093 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2094 store_in_alist (&alist, intern ("font"),
2095 build_string (FRAME_MSDOS_P (f)
2096 ? "ms-dos"
2097 : FRAME_W32_P (f) ? "w32term"
2098 :"tty"));
2100 store_in_alist (&alist, Qname, f->name);
2101 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2102 store_in_alist (&alist, Qheight, make_number (height));
2103 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2104 store_in_alist (&alist, Qwidth, make_number (width));
2105 store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil));
2106 store_in_alist (&alist, Qminibuffer,
2107 (! FRAME_HAS_MINIBUF_P (f) ? Qnil
2108 : FRAME_MINIBUF_ONLY_P (f) ? Qonly
2109 : FRAME_MINIBUF_WINDOW (f)));
2110 store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
2111 store_in_alist (&alist, Qbuffer_list, frame_buffer_list (frame));
2113 /* I think this should be done with a hook. */
2114 #ifdef HAVE_WINDOW_SYSTEM
2115 if (FRAME_WINDOW_P (f))
2116 x_report_frame_params (f, &alist);
2117 else
2118 #endif
2120 /* This ought to be correct in f->param_alist for an X frame. */
2121 Lisp_Object lines;
2122 XSETFASTINT (lines, FRAME_MENU_BAR_LINES (f));
2123 store_in_alist (&alist, Qmenu_bar_lines, lines);
2126 UNGCPRO;
2127 return alist;
2131 DEFUN ("frame-parameter", Fframe_parameter, Sframe_parameter, 2, 2, 0,
2132 doc: /* Return FRAME's value for parameter PARAMETER.
2133 If FRAME is nil, describe the currently selected frame. */)
2134 (frame, parameter)
2135 Lisp_Object frame, parameter;
2137 struct frame *f;
2138 Lisp_Object value;
2140 if (NILP (frame))
2141 frame = selected_frame;
2142 else
2143 CHECK_FRAME (frame);
2144 CHECK_SYMBOL (parameter);
2146 f = XFRAME (frame);
2147 value = Qnil;
2149 if (FRAME_LIVE_P (f))
2151 /* Avoid consing in frequent cases. */
2152 if (EQ (parameter, Qname))
2153 value = f->name;
2154 #ifdef HAVE_X_WINDOWS
2155 else if (EQ (parameter, Qdisplay) && FRAME_X_P (f))
2156 value = XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element);
2157 #endif /* HAVE_X_WINDOWS */
2158 else if (EQ (parameter, Qbackground_color)
2159 || EQ (parameter, Qforeground_color))
2161 value = Fassq (parameter, f->param_alist);
2162 if (CONSP (value))
2164 value = XCDR (value);
2165 /* Fframe_parameters puts the actual fg/bg color names,
2166 even if f->param_alist says otherwise. This is
2167 important when param_alist's notion of colors is
2168 "unspecified". We need to do the same here. */
2169 if (STRINGP (value) && !FRAME_WINDOW_P (f))
2171 const char *color_name;
2172 EMACS_INT csz;
2174 if (EQ (parameter, Qbackground_color))
2176 color_name = SDATA (value);
2177 csz = SCHARS (value);
2178 if (strncmp (color_name, unspecified_bg, csz) == 0)
2179 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2180 else if (strncmp (color_name, unspecified_fg, csz) == 0)
2181 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2183 else if (EQ (parameter, Qforeground_color))
2185 color_name = SDATA (value);
2186 csz = SCHARS (value);
2187 if (strncmp (color_name, unspecified_fg, csz) == 0)
2188 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2189 else if (strncmp (color_name, unspecified_bg, csz) == 0)
2190 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2194 else
2195 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2197 else if (EQ (parameter, Qdisplay_type)
2198 || EQ (parameter, Qbackground_mode))
2199 value = Fcdr (Fassq (parameter, f->param_alist));
2200 else
2201 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2204 return value;
2208 DEFUN ("modify-frame-parameters", Fmodify_frame_parameters,
2209 Smodify_frame_parameters, 2, 2, 0,
2210 doc: /* Modify the parameters of frame FRAME according to ALIST.
2211 If FRAME is nil, it defaults to the selected frame.
2212 ALIST is an alist of parameters to change and their new values.
2213 Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.
2214 The meaningful PARMs depend on the kind of frame.
2215 Undefined PARMs are ignored, but stored in the frame's parameter list
2216 so that `frame-parameters' will return them.
2218 The value of frame parameter FOO can also be accessed
2219 as a frame-local binding for the variable FOO, if you have
2220 enabled such bindings for that variable with `make-variable-frame-local'. */)
2221 (frame, alist)
2222 Lisp_Object frame, alist;
2224 FRAME_PTR f;
2225 register Lisp_Object tail, prop, val;
2226 int count = SPECPDL_INDEX ();
2228 /* Bind this to t to inhibit initialization of the default face from
2229 X resources in face-set-after-frame-default. If we don't inhibit
2230 this, modifying the `font' frame parameter, for example, while
2231 there is a `default.attributeFont' X resource, won't work,
2232 because `default's font is reset to the value of the X resource
2233 and that resets the `font' frame parameter. */
2234 specbind (Qinhibit_default_face_x_resources, Qt);
2236 if (EQ (frame, Qnil))
2237 frame = selected_frame;
2238 CHECK_LIVE_FRAME (frame);
2239 f = XFRAME (frame);
2241 /* I think this should be done with a hook. */
2242 #ifdef HAVE_WINDOW_SYSTEM
2243 if (FRAME_WINDOW_P (f))
2244 x_set_frame_parameters (f, alist);
2245 else
2246 #endif
2247 #ifdef MSDOS
2248 if (FRAME_MSDOS_P (f))
2249 IT_set_frame_parameters (f, alist);
2250 else
2251 #endif
2254 int length = XINT (Flength (alist));
2255 int i;
2256 Lisp_Object *parms
2257 = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
2258 Lisp_Object *values
2259 = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
2261 /* Extract parm names and values into those vectors. */
2263 i = 0;
2264 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
2266 Lisp_Object elt;
2268 elt = Fcar (tail);
2269 parms[i] = Fcar (elt);
2270 values[i] = Fcdr (elt);
2271 i++;
2274 /* Now process them in reverse of specified order. */
2275 for (i--; i >= 0; i--)
2277 prop = parms[i];
2278 val = values[i];
2279 store_frame_param (f, prop, val);
2283 return unbind_to (count, Qnil);
2286 DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height,
2287 0, 1, 0,
2288 doc: /* Height in pixels of a line in the font in frame FRAME.
2289 If FRAME is omitted, the selected frame is used.
2290 For a terminal frame, the value is always 1. */)
2291 (frame)
2292 Lisp_Object frame;
2294 struct frame *f;
2296 if (NILP (frame))
2297 frame = selected_frame;
2298 CHECK_FRAME (frame);
2299 f = XFRAME (frame);
2301 #ifdef HAVE_WINDOW_SYSTEM
2302 if (FRAME_WINDOW_P (f))
2303 return make_number (x_char_height (f));
2304 else
2305 #endif
2306 return make_number (1);
2310 DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width,
2311 0, 1, 0,
2312 doc: /* Width in pixels of characters in the font in frame FRAME.
2313 If FRAME is omitted, the selected frame is used.
2314 The width is the same for all characters, because
2315 currently Emacs supports only fixed-width fonts.
2316 For a terminal screen, the value is always 1. */)
2317 (frame)
2318 Lisp_Object frame;
2320 struct frame *f;
2322 if (NILP (frame))
2323 frame = selected_frame;
2324 CHECK_FRAME (frame);
2325 f = XFRAME (frame);
2327 #ifdef HAVE_WINDOW_SYSTEM
2328 if (FRAME_WINDOW_P (f))
2329 return make_number (x_char_width (f));
2330 else
2331 #endif
2332 return make_number (1);
2335 DEFUN ("frame-pixel-height", Fframe_pixel_height,
2336 Sframe_pixel_height, 0, 1, 0,
2337 doc: /* Return a FRAME's height in pixels.
2338 This counts only the height available for text lines,
2339 not menu bars on window-system Emacs frames.
2340 For a terminal frame, the result really gives the height in characters.
2341 If FRAME is omitted, the selected frame is used. */)
2342 (frame)
2343 Lisp_Object frame;
2345 struct frame *f;
2347 if (NILP (frame))
2348 frame = selected_frame;
2349 CHECK_FRAME (frame);
2350 f = XFRAME (frame);
2352 #ifdef HAVE_WINDOW_SYSTEM
2353 if (FRAME_WINDOW_P (f))
2354 return make_number (x_pixel_height (f));
2355 else
2356 #endif
2357 return make_number (FRAME_LINES (f));
2360 DEFUN ("frame-pixel-width", Fframe_pixel_width,
2361 Sframe_pixel_width, 0, 1, 0,
2362 doc: /* Return FRAME's width in pixels.
2363 For a terminal frame, the result really gives the width in characters.
2364 If FRAME is omitted, the selected frame is used. */)
2365 (frame)
2366 Lisp_Object frame;
2368 struct frame *f;
2370 if (NILP (frame))
2371 frame = selected_frame;
2372 CHECK_FRAME (frame);
2373 f = XFRAME (frame);
2375 #ifdef HAVE_WINDOW_SYSTEM
2376 if (FRAME_WINDOW_P (f))
2377 return make_number (x_pixel_width (f));
2378 else
2379 #endif
2380 return make_number (FRAME_COLS (f));
2383 DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0,
2384 doc: /* Specify that the frame FRAME has LINES lines.
2385 Optional third arg non-nil means that redisplay should use LINES lines
2386 but that the idea of the actual height of the frame should not be changed. */)
2387 (frame, lines, pretend)
2388 Lisp_Object frame, lines, pretend;
2390 register struct frame *f;
2392 CHECK_NUMBER (lines);
2393 if (NILP (frame))
2394 frame = selected_frame;
2395 CHECK_LIVE_FRAME (frame);
2396 f = XFRAME (frame);
2398 /* I think this should be done with a hook. */
2399 #ifdef HAVE_WINDOW_SYSTEM
2400 if (FRAME_WINDOW_P (f))
2402 if (XINT (lines) != FRAME_LINES (f))
2403 x_set_window_size (f, 1, FRAME_COLS (f), XINT (lines));
2404 do_pending_window_change (0);
2406 else
2407 #endif
2408 change_frame_size (f, XINT (lines), 0, !NILP (pretend), 0, 0);
2409 return Qnil;
2412 DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 3, 0,
2413 doc: /* Specify that the frame FRAME has COLS columns.
2414 Optional third arg non-nil means that redisplay should use COLS columns
2415 but that the idea of the actual width of the frame should not be changed. */)
2416 (frame, cols, pretend)
2417 Lisp_Object frame, cols, pretend;
2419 register struct frame *f;
2420 CHECK_NUMBER (cols);
2421 if (NILP (frame))
2422 frame = selected_frame;
2423 CHECK_LIVE_FRAME (frame);
2424 f = XFRAME (frame);
2426 /* I think this should be done with a hook. */
2427 #ifdef HAVE_WINDOW_SYSTEM
2428 if (FRAME_WINDOW_P (f))
2430 if (XINT (cols) != FRAME_COLS (f))
2431 x_set_window_size (f, 1, XINT (cols), FRAME_LINES (f));
2432 do_pending_window_change (0);
2434 else
2435 #endif
2436 change_frame_size (f, 0, XINT (cols), !NILP (pretend), 0, 0);
2437 return Qnil;
2440 DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0,
2441 doc: /* Sets size of FRAME to COLS by ROWS, measured in characters. */)
2442 (frame, cols, rows)
2443 Lisp_Object frame, cols, rows;
2445 register struct frame *f;
2447 CHECK_LIVE_FRAME (frame);
2448 CHECK_NUMBER (cols);
2449 CHECK_NUMBER (rows);
2450 f = XFRAME (frame);
2452 /* I think this should be done with a hook. */
2453 #ifdef HAVE_WINDOW_SYSTEM
2454 if (FRAME_WINDOW_P (f))
2456 if (XINT (rows) != FRAME_LINES (f)
2457 || XINT (cols) != FRAME_COLS (f)
2458 || f->new_text_lines || f->new_text_cols)
2459 x_set_window_size (f, 1, XINT (cols), XINT (rows));
2460 do_pending_window_change (0);
2462 else
2463 #endif
2464 change_frame_size (f, XINT (rows), XINT (cols), 0, 0, 0);
2466 return Qnil;
2469 DEFUN ("set-frame-position", Fset_frame_position,
2470 Sset_frame_position, 3, 3, 0,
2471 doc: /* Sets position of FRAME in pixels to XOFFSET by YOFFSET.
2472 This is actually the position of the upper left corner of the frame.
2473 Negative values for XOFFSET or YOFFSET are interpreted relative to
2474 the rightmost or bottommost possible position (that stays within the screen). */)
2475 (frame, xoffset, yoffset)
2476 Lisp_Object frame, xoffset, yoffset;
2478 register struct frame *f;
2480 CHECK_LIVE_FRAME (frame);
2481 CHECK_NUMBER (xoffset);
2482 CHECK_NUMBER (yoffset);
2483 f = XFRAME (frame);
2485 /* I think this should be done with a hook. */
2486 #ifdef HAVE_WINDOW_SYSTEM
2487 if (FRAME_WINDOW_P (f))
2488 x_set_offset (f, XINT (xoffset), XINT (yoffset), 1);
2489 #endif
2491 return Qt;
2495 /***********************************************************************
2496 Frame Parameters
2497 ***********************************************************************/
2499 /* Connect the frame-parameter names for X frames
2500 to the ways of passing the parameter values to the window system.
2502 The name of a parameter, as a Lisp symbol,
2503 has an `x-frame-parameter' property which is an integer in Lisp
2504 that is an index in this table. */
2506 struct frame_parm_table {
2507 char *name;
2508 Lisp_Object *variable;
2511 static struct frame_parm_table frame_parms[] =
2513 {"auto-raise", &Qauto_raise},
2514 {"auto-lower", &Qauto_lower},
2515 {"background-color", 0},
2516 {"border-color", &Qborder_color},
2517 {"border-width", &Qborder_width},
2518 {"cursor-color", &Qcursor_color},
2519 {"cursor-type", &Qcursor_type},
2520 {"font", 0},
2521 {"foreground-color", 0},
2522 {"icon-name", &Qicon_name},
2523 {"icon-type", &Qicon_type},
2524 {"internal-border-width", &Qinternal_border_width},
2525 {"menu-bar-lines", &Qmenu_bar_lines},
2526 {"mouse-color", &Qmouse_color},
2527 {"name", &Qname},
2528 {"scroll-bar-width", &Qscroll_bar_width},
2529 {"title", &Qtitle},
2530 {"unsplittable", &Qunsplittable},
2531 {"vertical-scroll-bars", &Qvertical_scroll_bars},
2532 {"visibility", &Qvisibility},
2533 {"tool-bar-lines", &Qtool_bar_lines},
2534 {"scroll-bar-foreground", &Qscroll_bar_foreground},
2535 {"scroll-bar-background", &Qscroll_bar_background},
2536 {"screen-gamma", &Qscreen_gamma},
2537 {"line-spacing", &Qline_spacing},
2538 {"left-fringe", &Qleft_fringe},
2539 {"right-fringe", &Qright_fringe},
2540 {"wait-for-wm", &Qwait_for_wm},
2541 {"fullscreen", &Qfullscreen},
2544 #ifdef HAVE_WINDOW_SYSTEM
2546 extern Lisp_Object Qbox;
2547 extern Lisp_Object Qtop;
2549 /* Calculate fullscreen size. Return in *TOP_POS and *LEFT_POS the
2550 wanted positions of the WM window (not emacs window).
2551 Return in *WIDTH and *HEIGHT the wanted width and height of Emacs
2552 window (FRAME_X_WINDOW).
2555 void
2556 x_fullscreen_adjust (f, width, height, top_pos, left_pos)
2557 struct frame *f;
2558 int *width;
2559 int *height;
2560 int *top_pos;
2561 int *left_pos;
2563 int newwidth = FRAME_COLS (f);
2564 int newheight = FRAME_LINES (f);
2566 *top_pos = f->top_pos;
2567 *left_pos = f->left_pos;
2569 if (f->want_fullscreen & FULLSCREEN_HEIGHT)
2571 int ph;
2573 ph = FRAME_X_DISPLAY_INFO (f)->height;
2574 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2575 ph = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, newheight) - f->y_pixels_diff;
2576 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2577 *top_pos = 0;
2580 if (f->want_fullscreen & FULLSCREEN_WIDTH)
2582 int pw;
2584 pw = FRAME_X_DISPLAY_INFO (f)->width;
2585 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2586 pw = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, newwidth) - f->x_pixels_diff;
2587 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2588 *left_pos = 0;
2591 *width = newwidth;
2592 *height = newheight;
2596 /* Change the parameters of frame F as specified by ALIST.
2597 If a parameter is not specially recognized, do nothing special;
2598 otherwise call the `x_set_...' function for that parameter.
2599 Except for certain geometry properties, always call store_frame_param
2600 to store the new value in the parameter alist. */
2602 void
2603 x_set_frame_parameters (f, alist)
2604 FRAME_PTR f;
2605 Lisp_Object alist;
2607 Lisp_Object tail;
2609 /* If both of these parameters are present, it's more efficient to
2610 set them both at once. So we wait until we've looked at the
2611 entire list before we set them. */
2612 int width, height;
2614 /* Same here. */
2615 Lisp_Object left, top;
2617 /* Same with these. */
2618 Lisp_Object icon_left, icon_top;
2620 /* Record in these vectors all the parms specified. */
2621 Lisp_Object *parms;
2622 Lisp_Object *values;
2623 int i, p;
2624 int left_no_change = 0, top_no_change = 0;
2625 int icon_left_no_change = 0, icon_top_no_change = 0;
2626 int fullscreen_is_being_set = 0;
2628 struct gcpro gcpro1, gcpro2;
2630 i = 0;
2631 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
2632 i++;
2634 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
2635 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
2637 /* Extract parm names and values into those vectors. */
2639 i = 0;
2640 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
2642 Lisp_Object elt;
2644 elt = Fcar (tail);
2645 parms[i] = Fcar (elt);
2646 values[i] = Fcdr (elt);
2647 i++;
2649 /* TAIL and ALIST are not used again below here. */
2650 alist = tail = Qnil;
2652 GCPRO2 (*parms, *values);
2653 gcpro1.nvars = i;
2654 gcpro2.nvars = i;
2656 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
2657 because their values appear in VALUES and strings are not valid. */
2658 top = left = Qunbound;
2659 icon_left = icon_top = Qunbound;
2661 /* Provide default values for HEIGHT and WIDTH. */
2662 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2663 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2665 /* Process foreground_color and background_color before anything else.
2666 They are independent of other properties, but other properties (e.g.,
2667 cursor_color) are dependent upon them. */
2668 /* Process default font as well, since fringe widths depends on it. */
2669 /* Also, process fullscreen, width and height depend upon that */
2670 for (p = 0; p < i; p++)
2672 Lisp_Object prop, val;
2674 prop = parms[p];
2675 val = values[p];
2676 if (EQ (prop, Qforeground_color)
2677 || EQ (prop, Qbackground_color)
2678 || EQ (prop, Qfont)
2679 || EQ (prop, Qfullscreen))
2681 register Lisp_Object param_index, old_value;
2683 old_value = get_frame_param (f, prop);
2684 fullscreen_is_being_set |= EQ (prop, Qfullscreen);
2686 if (NILP (Fequal (val, old_value)))
2688 store_frame_param (f, prop, val);
2690 param_index = Fget (prop, Qx_frame_parameter);
2691 if (NATNUMP (param_index)
2692 && (XFASTINT (param_index)
2693 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2694 && rif->frame_parm_handlers[XINT (param_index)])
2695 (*(rif->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2700 /* Now process them in reverse of specified order. */
2701 for (i--; i >= 0; i--)
2703 Lisp_Object prop, val;
2705 prop = parms[i];
2706 val = values[i];
2708 if (EQ (prop, Qwidth) && NUMBERP (val))
2709 width = XFASTINT (val);
2710 else if (EQ (prop, Qheight) && NUMBERP (val))
2711 height = XFASTINT (val);
2712 else if (EQ (prop, Qtop))
2713 top = val;
2714 else if (EQ (prop, Qleft))
2715 left = val;
2716 else if (EQ (prop, Qicon_top))
2717 icon_top = val;
2718 else if (EQ (prop, Qicon_left))
2719 icon_left = val;
2720 else if (EQ (prop, Qforeground_color)
2721 || EQ (prop, Qbackground_color)
2722 || EQ (prop, Qfont)
2723 || EQ (prop, Qfullscreen))
2724 /* Processed above. */
2725 continue;
2726 else
2728 register Lisp_Object param_index, old_value;
2730 old_value = get_frame_param (f, prop);
2732 store_frame_param (f, prop, val);
2734 param_index = Fget (prop, Qx_frame_parameter);
2735 if (NATNUMP (param_index)
2736 && (XFASTINT (param_index)
2737 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2738 && rif->frame_parm_handlers[XINT (param_index)])
2739 (*(rif->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2743 /* Don't die if just one of these was set. */
2744 if (EQ (left, Qunbound))
2746 left_no_change = 1;
2747 if (f->left_pos < 0)
2748 left = Fcons (Qplus, Fcons (make_number (f->left_pos), Qnil));
2749 else
2750 XSETINT (left, f->left_pos);
2752 if (EQ (top, Qunbound))
2754 top_no_change = 1;
2755 if (f->top_pos < 0)
2756 top = Fcons (Qplus, Fcons (make_number (f->top_pos), Qnil));
2757 else
2758 XSETINT (top, f->top_pos);
2761 /* If one of the icon positions was not set, preserve or default it. */
2762 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
2764 icon_left_no_change = 1;
2765 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
2766 if (NILP (icon_left))
2767 XSETINT (icon_left, 0);
2769 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
2771 icon_top_no_change = 1;
2772 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
2773 if (NILP (icon_top))
2774 XSETINT (icon_top, 0);
2777 #ifndef HAVE_CARBON
2778 /* MAC_TODO: fullscreen */
2779 if (FRAME_VISIBLE_P (f) && fullscreen_is_being_set)
2781 /* If the frame is visible already and the fullscreen parameter is
2782 being set, it is too late to set WM manager hints to specify
2783 size and position.
2784 Here we first get the width, height and position that applies to
2785 fullscreen. We then move the frame to the appropriate
2786 position. Resize of the frame is taken care of in the code after
2787 this if-statement. */
2788 int new_left, new_top;
2790 x_fullscreen_adjust (f, &width, &height, &new_top, &new_left);
2791 if (new_top != f->top_pos || new_left != f->left_pos)
2792 x_set_offset (f, new_left, new_top, 1);
2794 #endif
2796 /* Don't set these parameters unless they've been explicitly
2797 specified. The window might be mapped or resized while we're in
2798 this function, and we don't want to override that unless the lisp
2799 code has asked for it.
2801 Don't set these parameters unless they actually differ from the
2802 window's current parameters; the window may not actually exist
2803 yet. */
2805 Lisp_Object frame;
2807 check_frame_size (f, &height, &width);
2809 XSETFRAME (frame, f);
2811 if (width != FRAME_COLS (f)
2812 || height != FRAME_LINES (f)
2813 || f->new_text_lines || f->new_text_cols)
2814 Fset_frame_size (frame, make_number (width), make_number (height));
2816 if ((!NILP (left) || !NILP (top))
2817 && ! (left_no_change && top_no_change)
2818 && ! (NUMBERP (left) && XINT (left) == f->left_pos
2819 && NUMBERP (top) && XINT (top) == f->top_pos))
2821 int leftpos = 0;
2822 int toppos = 0;
2824 /* Record the signs. */
2825 f->size_hint_flags &= ~ (XNegative | YNegative);
2826 if (EQ (left, Qminus))
2827 f->size_hint_flags |= XNegative;
2828 else if (INTEGERP (left))
2830 leftpos = XINT (left);
2831 if (leftpos < 0)
2832 f->size_hint_flags |= XNegative;
2834 else if (CONSP (left) && EQ (XCAR (left), Qminus)
2835 && CONSP (XCDR (left))
2836 && INTEGERP (XCAR (XCDR (left))))
2838 leftpos = - XINT (XCAR (XCDR (left)));
2839 f->size_hint_flags |= XNegative;
2841 else if (CONSP (left) && EQ (XCAR (left), Qplus)
2842 && CONSP (XCDR (left))
2843 && INTEGERP (XCAR (XCDR (left))))
2845 leftpos = XINT (XCAR (XCDR (left)));
2848 if (EQ (top, Qminus))
2849 f->size_hint_flags |= YNegative;
2850 else if (INTEGERP (top))
2852 toppos = XINT (top);
2853 if (toppos < 0)
2854 f->size_hint_flags |= YNegative;
2856 else if (CONSP (top) && EQ (XCAR (top), Qminus)
2857 && CONSP (XCDR (top))
2858 && INTEGERP (XCAR (XCDR (top))))
2860 toppos = - XINT (XCAR (XCDR (top)));
2861 f->size_hint_flags |= YNegative;
2863 else if (CONSP (top) && EQ (XCAR (top), Qplus)
2864 && CONSP (XCDR (top))
2865 && INTEGERP (XCAR (XCDR (top))))
2867 toppos = XINT (XCAR (XCDR (top)));
2871 /* Store the numeric value of the position. */
2872 f->top_pos = toppos;
2873 f->left_pos = leftpos;
2875 f->win_gravity = NorthWestGravity;
2877 /* Actually set that position, and convert to absolute. */
2878 x_set_offset (f, leftpos, toppos, -1);
2881 if ((!NILP (icon_left) || !NILP (icon_top))
2882 && ! (icon_left_no_change && icon_top_no_change))
2883 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
2886 UNGCPRO;
2890 /* Insert a description of internally-recorded parameters of frame X
2891 into the parameter alist *ALISTPTR that is to be given to the user.
2892 Only parameters that are specific to the X window system
2893 and whose values are not correctly recorded in the frame's
2894 param_alist need to be considered here. */
2896 void
2897 x_report_frame_params (f, alistptr)
2898 struct frame *f;
2899 Lisp_Object *alistptr;
2901 char buf[16];
2902 Lisp_Object tem;
2904 /* Represent negative positions (off the top or left screen edge)
2905 in a way that Fmodify_frame_parameters will understand correctly. */
2906 XSETINT (tem, f->left_pos);
2907 if (f->left_pos >= 0)
2908 store_in_alist (alistptr, Qleft, tem);
2909 else
2910 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
2912 XSETINT (tem, f->top_pos);
2913 if (f->top_pos >= 0)
2914 store_in_alist (alistptr, Qtop, tem);
2915 else
2916 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
2918 store_in_alist (alistptr, Qborder_width,
2919 make_number (f->border_width));
2920 store_in_alist (alistptr, Qinternal_border_width,
2921 make_number (FRAME_INTERNAL_BORDER_WIDTH (f)));
2922 store_in_alist (alistptr, Qleft_fringe,
2923 make_number (FRAME_LEFT_FRINGE_WIDTH (f)));
2924 store_in_alist (alistptr, Qright_fringe,
2925 make_number (FRAME_RIGHT_FRINGE_WIDTH (f)));
2926 store_in_alist (alistptr, Qscroll_bar_width,
2927 (! FRAME_HAS_VERTICAL_SCROLL_BARS (f)
2928 ? make_number (0)
2929 : FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0
2930 ? make_number (FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
2931 /* nil means "use default width"
2932 for non-toolkit scroll bar.
2933 ruler-mode.el depends on this. */
2934 : Qnil));
2935 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
2936 store_in_alist (alistptr, Qwindow_id,
2937 build_string (buf));
2938 #ifdef HAVE_X_WINDOWS
2939 #ifdef USE_X_TOOLKIT
2940 /* Tooltip frame may not have this widget. */
2941 if (FRAME_X_OUTPUT (f)->widget)
2942 #endif
2943 sprintf (buf, "%ld", (long) FRAME_OUTER_WINDOW (f));
2944 store_in_alist (alistptr, Qouter_window_id,
2945 build_string (buf));
2946 #endif
2947 store_in_alist (alistptr, Qicon_name, f->icon_name);
2948 FRAME_SAMPLE_VISIBILITY (f);
2949 store_in_alist (alistptr, Qvisibility,
2950 (FRAME_VISIBLE_P (f) ? Qt
2951 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
2952 store_in_alist (alistptr, Qdisplay,
2953 XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
2955 #ifndef HAVE_CARBON
2956 /* A Mac Window is identified by a struct, not an integer. */
2957 if (FRAME_X_OUTPUT (f)->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
2958 tem = Qnil;
2959 else
2960 XSETFASTINT (tem, FRAME_X_OUTPUT (f)->parent_desc);
2961 store_in_alist (alistptr, Qparent_id, tem);
2962 #endif
2966 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
2967 the previous value of that parameter, NEW_VALUE is the new value. */
2969 void
2970 x_set_fullscreen (f, new_value, old_value)
2971 struct frame *f;
2972 Lisp_Object new_value, old_value;
2974 #ifndef HAVE_CARBON
2975 if (NILP (new_value))
2976 f->want_fullscreen = FULLSCREEN_NONE;
2977 else if (EQ (new_value, Qfullboth))
2978 f->want_fullscreen = FULLSCREEN_BOTH;
2979 else if (EQ (new_value, Qfullwidth))
2980 f->want_fullscreen = FULLSCREEN_WIDTH;
2981 else if (EQ (new_value, Qfullheight))
2982 f->want_fullscreen = FULLSCREEN_HEIGHT;
2983 #endif
2987 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
2988 the previous value of that parameter, NEW_VALUE is the new value. */
2990 void
2991 x_set_line_spacing (f, new_value, old_value)
2992 struct frame *f;
2993 Lisp_Object new_value, old_value;
2995 if (NILP (new_value))
2996 f->extra_line_spacing = 0;
2997 else if (NATNUMP (new_value))
2998 f->extra_line_spacing = XFASTINT (new_value);
2999 else
3000 Fsignal (Qerror, Fcons (build_string ("Invalid line-spacing"),
3001 Fcons (new_value, Qnil)));
3002 if (FRAME_VISIBLE_P (f))
3003 redraw_frame (f);
3007 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
3008 the previous value of that parameter, NEW_VALUE is the new value. */
3010 void
3011 x_set_screen_gamma (f, new_value, old_value)
3012 struct frame *f;
3013 Lisp_Object new_value, old_value;
3015 if (NILP (new_value))
3016 f->gamma = 0;
3017 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
3018 /* The value 0.4545 is the normal viewing gamma. */
3019 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
3020 else
3021 Fsignal (Qerror, Fcons (build_string ("Invalid screen-gamma"),
3022 Fcons (new_value, Qnil)));
3024 clear_face_cache (0);
3028 void
3029 x_set_font (f, arg, oldval)
3030 struct frame *f;
3031 Lisp_Object arg, oldval;
3033 Lisp_Object result;
3034 Lisp_Object fontset_name;
3035 Lisp_Object frame;
3036 int old_fontset = FRAME_FONTSET(f);
3038 CHECK_STRING (arg);
3040 fontset_name = Fquery_fontset (arg, Qnil);
3042 BLOCK_INPUT;
3043 result = (STRINGP (fontset_name)
3044 ? x_new_fontset (f, SDATA (fontset_name))
3045 : x_new_font (f, SDATA (arg)));
3046 UNBLOCK_INPUT;
3048 if (EQ (result, Qnil))
3049 error ("Font `%s' is not defined", SDATA (arg));
3050 else if (EQ (result, Qt))
3051 error ("The characters of the given font have varying widths");
3052 else if (STRINGP (result))
3054 if (STRINGP (fontset_name))
3056 /* Fontset names are built from ASCII font names, so the
3057 names may be equal despite there was a change. */
3058 if (old_fontset == FRAME_FONTSET (f))
3059 return;
3061 else if (!NILP (Fequal (result, oldval)))
3062 return;
3064 store_frame_param (f, Qfont, result);
3065 recompute_basic_faces (f);
3067 else
3068 abort ();
3070 do_pending_window_change (0);
3072 /* Don't call `face-set-after-frame-default' when faces haven't been
3073 initialized yet. This is the case when called from
3074 Fx_create_frame. In that case, the X widget or window doesn't
3075 exist either, and we can end up in x_report_frame_params with a
3076 null widget which gives a segfault. */
3077 if (FRAME_FACE_CACHE (f))
3079 XSETFRAME (frame, f);
3080 call1 (Qface_set_after_frame_default, frame);
3085 void
3086 x_set_fringe_width (f, new_value, old_value)
3087 struct frame *f;
3088 Lisp_Object new_value, old_value;
3090 compute_fringe_widths (f, 1);
3093 void
3094 x_set_border_width (f, arg, oldval)
3095 struct frame *f;
3096 Lisp_Object arg, oldval;
3098 CHECK_NUMBER (arg);
3100 if (XINT (arg) == f->border_width)
3101 return;
3103 #ifndef HAVE_CARBON
3104 if (FRAME_X_WINDOW (f) != 0)
3105 error ("Cannot change the border width of a window");
3106 #endif /* MAC_TODO */
3108 f->border_width = XINT (arg);
3111 void
3112 x_set_internal_border_width (f, arg, oldval)
3113 struct frame *f;
3114 Lisp_Object arg, oldval;
3116 int old = FRAME_INTERNAL_BORDER_WIDTH (f);
3118 CHECK_NUMBER (arg);
3119 FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
3120 if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
3121 FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
3123 #ifdef USE_X_TOOLKIT
3124 if (FRAME_X_OUTPUT (f)->edit_widget)
3125 widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
3126 #endif
3128 if (FRAME_INTERNAL_BORDER_WIDTH (f) == old)
3129 return;
3131 if (FRAME_X_WINDOW (f) != 0)
3133 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3134 SET_FRAME_GARBAGED (f);
3135 do_pending_window_change (0);
3137 else
3138 SET_FRAME_GARBAGED (f);
3141 void
3142 x_set_visibility (f, value, oldval)
3143 struct frame *f;
3144 Lisp_Object value, oldval;
3146 Lisp_Object frame;
3147 XSETFRAME (frame, f);
3149 if (NILP (value))
3150 Fmake_frame_invisible (frame, Qt);
3151 else if (EQ (value, Qicon))
3152 Ficonify_frame (frame);
3153 else
3154 Fmake_frame_visible (frame);
3157 void
3158 x_set_autoraise (f, arg, oldval)
3159 struct frame *f;
3160 Lisp_Object arg, oldval;
3162 f->auto_raise = !EQ (Qnil, arg);
3165 void
3166 x_set_autolower (f, arg, oldval)
3167 struct frame *f;
3168 Lisp_Object arg, oldval;
3170 f->auto_lower = !EQ (Qnil, arg);
3173 void
3174 x_set_unsplittable (f, arg, oldval)
3175 struct frame *f;
3176 Lisp_Object arg, oldval;
3178 f->no_split = !NILP (arg);
3181 void
3182 x_set_vertical_scroll_bars (f, arg, oldval)
3183 struct frame *f;
3184 Lisp_Object arg, oldval;
3186 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
3187 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
3188 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
3189 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
3191 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
3192 = (NILP (arg)
3193 ? vertical_scroll_bar_none
3194 : EQ (Qleft, arg)
3195 ? vertical_scroll_bar_left
3196 : EQ (Qright, arg)
3197 ? vertical_scroll_bar_right
3198 : EQ (Qleft, Vdefault_frame_scroll_bars)
3199 ? vertical_scroll_bar_left
3200 : EQ (Qright, Vdefault_frame_scroll_bars)
3201 ? vertical_scroll_bar_right
3202 : vertical_scroll_bar_none);
3204 /* We set this parameter before creating the X window for the
3205 frame, so we can get the geometry right from the start.
3206 However, if the window hasn't been created yet, we shouldn't
3207 call x_set_window_size. */
3208 if (FRAME_X_WINDOW (f))
3209 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3210 do_pending_window_change (0);
3214 void
3215 x_set_scroll_bar_width (f, arg, oldval)
3216 struct frame *f;
3217 Lisp_Object arg, oldval;
3219 int wid = FRAME_COLUMN_WIDTH (f);
3221 if (NILP (arg))
3223 x_set_scroll_bar_default_width (f);
3225 if (FRAME_X_WINDOW (f))
3226 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3227 do_pending_window_change (0);
3229 else if (INTEGERP (arg) && XINT (arg) > 0
3230 && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3232 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
3233 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
3235 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg);
3236 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
3237 if (FRAME_X_WINDOW (f))
3238 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3239 do_pending_window_change (0);
3242 change_frame_size (f, 0, FRAME_COLS (f), 0, 0, 0);
3243 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
3244 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
3249 /* Return non-nil if frame F wants a bitmap icon. */
3251 Lisp_Object
3252 x_icon_type (f)
3253 FRAME_PTR f;
3255 Lisp_Object tem;
3257 tem = assq_no_quit (Qicon_type, f->param_alist);
3258 if (CONSP (tem))
3259 return XCDR (tem);
3260 else
3261 return Qnil;
3265 /* Subroutines of creating an X frame. */
3267 /* Make sure that Vx_resource_name is set to a reasonable value.
3268 Fix it up, or set it to `emacs' if it is too hopeless. */
3270 void
3271 validate_x_resource_name ()
3273 int len = 0;
3274 /* Number of valid characters in the resource name. */
3275 int good_count = 0;
3276 /* Number of invalid characters in the resource name. */
3277 int bad_count = 0;
3278 Lisp_Object new;
3279 int i;
3281 if (!STRINGP (Vx_resource_class))
3282 Vx_resource_class = build_string (EMACS_CLASS);
3284 if (STRINGP (Vx_resource_name))
3286 unsigned char *p = SDATA (Vx_resource_name);
3287 int i;
3289 len = SBYTES (Vx_resource_name);
3291 /* Only letters, digits, - and _ are valid in resource names.
3292 Count the valid characters and count the invalid ones. */
3293 for (i = 0; i < len; i++)
3295 int c = p[i];
3296 if (! ((c >= 'a' && c <= 'z')
3297 || (c >= 'A' && c <= 'Z')
3298 || (c >= '0' && c <= '9')
3299 || c == '-' || c == '_'))
3300 bad_count++;
3301 else
3302 good_count++;
3305 else
3306 /* Not a string => completely invalid. */
3307 bad_count = 5, good_count = 0;
3309 /* If name is valid already, return. */
3310 if (bad_count == 0)
3311 return;
3313 /* If name is entirely invalid, or nearly so, use `emacs'. */
3314 if (good_count == 0
3315 || (good_count == 1 && bad_count > 0))
3317 Vx_resource_name = build_string ("emacs");
3318 return;
3321 /* Name is partly valid. Copy it and replace the invalid characters
3322 with underscores. */
3324 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
3326 for (i = 0; i < len; i++)
3328 int c = SREF (new, i);
3329 if (! ((c >= 'a' && c <= 'z')
3330 || (c >= 'A' && c <= 'Z')
3331 || (c >= '0' && c <= '9')
3332 || c == '-' || c == '_'))
3333 SSET (new, i, '_');
3338 extern char *x_get_string_resource P_ ((XrmDatabase, char *, char *));
3339 extern Display_Info *check_x_display_info P_ ((Lisp_Object));
3342 /* Get specified attribute from resource database RDB.
3343 See Fx_get_resource below for other parameters. */
3345 static Lisp_Object
3346 xrdb_get_resource (rdb, attribute, class, component, subclass)
3347 XrmDatabase rdb;
3348 Lisp_Object attribute, class, component, subclass;
3350 register char *value;
3351 char *name_key;
3352 char *class_key;
3354 CHECK_STRING (attribute);
3355 CHECK_STRING (class);
3357 if (!NILP (component))
3358 CHECK_STRING (component);
3359 if (!NILP (subclass))
3360 CHECK_STRING (subclass);
3361 if (NILP (component) != NILP (subclass))
3362 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3364 validate_x_resource_name ();
3366 /* Allocate space for the components, the dots which separate them,
3367 and the final '\0'. Make them big enough for the worst case. */
3368 name_key = (char *) alloca (SBYTES (Vx_resource_name)
3369 + (STRINGP (component)
3370 ? SBYTES (component) : 0)
3371 + SBYTES (attribute)
3372 + 3);
3374 class_key = (char *) alloca (SBYTES (Vx_resource_class)
3375 + SBYTES (class)
3376 + (STRINGP (subclass)
3377 ? SBYTES (subclass) : 0)
3378 + 3);
3380 /* Start with emacs.FRAMENAME for the name (the specific one)
3381 and with `Emacs' for the class key (the general one). */
3382 strcpy (name_key, SDATA (Vx_resource_name));
3383 strcpy (class_key, SDATA (Vx_resource_class));
3385 strcat (class_key, ".");
3386 strcat (class_key, SDATA (class));
3388 if (!NILP (component))
3390 strcat (class_key, ".");
3391 strcat (class_key, SDATA (subclass));
3393 strcat (name_key, ".");
3394 strcat (name_key, SDATA (component));
3397 strcat (name_key, ".");
3398 strcat (name_key, SDATA (attribute));
3400 value = x_get_string_resource (rdb, name_key, class_key);
3402 if (value != (char *) 0)
3403 return build_string (value);
3404 else
3405 return Qnil;
3409 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
3410 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
3411 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
3412 class, where INSTANCE is the name under which Emacs was invoked, or
3413 the name specified by the `-name' or `-rn' command-line arguments.
3415 The optional arguments COMPONENT and SUBCLASS add to the key and the
3416 class, respectively. You must specify both of them or neither.
3417 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
3418 and the class is `Emacs.CLASS.SUBCLASS'. */)
3419 (attribute, class, component, subclass)
3420 Lisp_Object attribute, class, component, subclass;
3422 #ifdef HAVE_X_WINDOWS
3423 check_x ();
3424 #endif
3426 return xrdb_get_resource (check_x_display_info (Qnil)->xrdb,
3427 attribute, class, component, subclass);
3430 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
3432 Lisp_Object
3433 display_x_get_resource (dpyinfo, attribute, class, component, subclass)
3434 Display_Info *dpyinfo;
3435 Lisp_Object attribute, class, component, subclass;
3437 return xrdb_get_resource (dpyinfo->xrdb,
3438 attribute, class, component, subclass);
3441 /* Used when C code wants a resource value. */
3443 char *
3444 x_get_resource_string (attribute, class)
3445 char *attribute, *class;
3447 char *name_key;
3448 char *class_key;
3449 struct frame *sf = SELECTED_FRAME ();
3451 /* Allocate space for the components, the dots which separate them,
3452 and the final '\0'. */
3453 name_key = (char *) alloca (SBYTES (Vinvocation_name)
3454 + strlen (attribute) + 2);
3455 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
3456 + strlen (class) + 2);
3458 sprintf (name_key, "%s.%s", SDATA (Vinvocation_name), attribute);
3459 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3461 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
3462 name_key, class_key);
3466 /* Return the value of parameter PARAM.
3468 First search ALIST, then Vdefault_frame_alist, then the X defaults
3469 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3471 Convert the resource to the type specified by desired_type.
3473 If no default is specified, return Qunbound. If you call
3474 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3475 and don't let it get stored in any Lisp-visible variables! */
3477 Lisp_Object
3478 x_get_arg (dpyinfo, alist, param, attribute, class, type)
3479 Display_Info *dpyinfo;
3480 Lisp_Object alist, param;
3481 char *attribute;
3482 char *class;
3483 enum resource_types type;
3485 register Lisp_Object tem;
3487 tem = Fassq (param, alist);
3488 if (EQ (tem, Qnil))
3489 tem = Fassq (param, Vdefault_frame_alist);
3490 if (EQ (tem, Qnil))
3492 if (attribute)
3494 tem = display_x_get_resource (dpyinfo,
3495 build_string (attribute),
3496 build_string (class),
3497 Qnil, Qnil);
3499 if (NILP (tem))
3500 return Qunbound;
3502 switch (type)
3504 case RES_TYPE_NUMBER:
3505 return make_number (atoi (SDATA (tem)));
3507 case RES_TYPE_FLOAT:
3508 return make_float (atof (SDATA (tem)));
3510 case RES_TYPE_BOOLEAN:
3511 tem = Fdowncase (tem);
3512 if (!strcmp (SDATA (tem), "on")
3513 || !strcmp (SDATA (tem), "true"))
3514 return Qt;
3515 else
3516 return Qnil;
3518 case RES_TYPE_STRING:
3519 return tem;
3521 case RES_TYPE_SYMBOL:
3522 /* As a special case, we map the values `true' and `on'
3523 to Qt, and `false' and `off' to Qnil. */
3525 Lisp_Object lower;
3526 lower = Fdowncase (tem);
3527 if (!strcmp (SDATA (lower), "on")
3528 || !strcmp (SDATA (lower), "true"))
3529 return Qt;
3530 else if (!strcmp (SDATA (lower), "off")
3531 || !strcmp (SDATA (lower), "false"))
3532 return Qnil;
3533 else
3534 return Fintern (tem, Qnil);
3537 default:
3538 abort ();
3541 else
3542 return Qunbound;
3544 return Fcdr (tem);
3547 Lisp_Object
3548 x_frame_get_arg (f, alist, param, attribute, class, type)
3549 struct frame *f;
3550 Lisp_Object alist, param;
3551 char *attribute;
3552 char *class;
3553 enum resource_types type;
3555 return x_get_arg (FRAME_X_DISPLAY_INFO (f),
3556 alist, param, attribute, class, type);
3559 /* Like x_frame_get_arg, but also record the value in f->param_alist. */
3561 Lisp_Object
3562 x_frame_get_and_record_arg (f, alist, param, attribute, class, type)
3563 struct frame *f;
3564 Lisp_Object alist, param;
3565 char *attribute;
3566 char *class;
3567 enum resource_types type;
3569 Lisp_Object value;
3571 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
3572 attribute, class, type);
3573 if (! NILP (value))
3574 store_frame_param (f, param, value);
3576 return value;
3580 /* Record in frame F the specified or default value according to ALIST
3581 of the parameter named PROP (a Lisp symbol).
3582 If no value is specified for PROP, look for an X default for XPROP
3583 on the frame named NAME.
3584 If that is not found either, use the value DEFLT. */
3586 Lisp_Object
3587 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
3588 struct frame *f;
3589 Lisp_Object alist;
3590 Lisp_Object prop;
3591 Lisp_Object deflt;
3592 char *xprop;
3593 char *xclass;
3594 enum resource_types type;
3596 Lisp_Object tem;
3598 tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type);
3599 if (EQ (tem, Qunbound))
3600 tem = deflt;
3601 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
3602 return tem;
3608 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
3609 doc: /* Parse an X-style geometry string STRING.
3610 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3611 The properties returned may include `top', `left', `height', and `width'.
3612 The value of `left' or `top' may be an integer,
3613 or a list (+ N) meaning N pixels relative to top/left corner,
3614 or a list (- N) meaning -N pixels relative to bottom/right corner. */)
3615 (string)
3616 Lisp_Object string;
3618 int geometry, x, y;
3619 unsigned int width, height;
3620 Lisp_Object result;
3622 CHECK_STRING (string);
3624 geometry = XParseGeometry ((char *) SDATA (string),
3625 &x, &y, &width, &height);
3627 #if 0
3628 if (!!(geometry & XValue) != !!(geometry & YValue))
3629 error ("Must specify both x and y position, or neither");
3630 #endif
3632 result = Qnil;
3633 if (geometry & XValue)
3635 Lisp_Object element;
3637 if (x >= 0 && (geometry & XNegative))
3638 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
3639 else if (x < 0 && ! (geometry & XNegative))
3640 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
3641 else
3642 element = Fcons (Qleft, make_number (x));
3643 result = Fcons (element, result);
3646 if (geometry & YValue)
3648 Lisp_Object element;
3650 if (y >= 0 && (geometry & YNegative))
3651 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
3652 else if (y < 0 && ! (geometry & YNegative))
3653 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
3654 else
3655 element = Fcons (Qtop, make_number (y));
3656 result = Fcons (element, result);
3659 if (geometry & WidthValue)
3660 result = Fcons (Fcons (Qwidth, make_number (width)), result);
3661 if (geometry & HeightValue)
3662 result = Fcons (Fcons (Qheight, make_number (height)), result);
3664 return result;
3667 /* Calculate the desired size and position of frame F.
3668 Return the flags saying which aspects were specified.
3670 Also set the win_gravity and size_hint_flags of F.
3672 Adjust height for toolbar if TOOLBAR_P is 1.
3674 This function does not make the coordinates positive. */
3676 #define DEFAULT_ROWS 40
3677 #define DEFAULT_COLS 80
3680 x_figure_window_size (f, parms, toolbar_p)
3681 struct frame *f;
3682 Lisp_Object parms;
3683 int toolbar_p;
3685 register Lisp_Object tem0, tem1, tem2;
3686 long window_prompting = 0;
3687 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3689 /* Default values if we fall through.
3690 Actually, if that happens we should get
3691 window manager prompting. */
3692 SET_FRAME_COLS (f, DEFAULT_COLS);
3693 FRAME_LINES (f) = DEFAULT_ROWS;
3694 /* Window managers expect that if program-specified
3695 positions are not (0,0), they're intentional, not defaults. */
3696 f->top_pos = 0;
3697 f->left_pos = 0;
3699 /* Ensure that old new_text_cols and new_text_lines will not override the
3700 values set here. */
3701 /* ++KFS: This was specific to W32, but seems ok for all platforms */
3702 f->new_text_cols = f->new_text_lines = 0;
3704 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
3705 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
3706 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
3707 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3709 if (!EQ (tem0, Qunbound))
3711 CHECK_NUMBER (tem0);
3712 FRAME_LINES (f) = XINT (tem0);
3714 if (!EQ (tem1, Qunbound))
3716 CHECK_NUMBER (tem1);
3717 SET_FRAME_COLS (f, XINT (tem1));
3719 if (!NILP (tem2) && !EQ (tem2, Qunbound))
3720 window_prompting |= USSize;
3721 else
3722 window_prompting |= PSize;
3725 f->scroll_bar_actual_width
3726 = FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f);
3728 /* This used to be done _before_ calling x_figure_window_size, but
3729 since the height is reset here, this was really a no-op. I
3730 assume that moving it here does what Gerd intended (although he
3731 no longer can remember what that was... ++KFS, 2003-03-25. */
3733 /* Add the tool-bar height to the initial frame height so that the
3734 user gets a text display area of the size he specified with -g or
3735 via .Xdefaults. Later changes of the tool-bar height don't
3736 change the frame size. This is done so that users can create
3737 tall Emacs frames without having to guess how tall the tool-bar
3738 will get. */
3739 if (toolbar_p && FRAME_TOOL_BAR_LINES (f))
3741 int margin, relief, bar_height;
3743 relief = (tool_bar_button_relief >= 0
3744 ? tool_bar_button_relief
3745 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
3747 if (INTEGERP (Vtool_bar_button_margin)
3748 && XINT (Vtool_bar_button_margin) > 0)
3749 margin = XFASTINT (Vtool_bar_button_margin);
3750 else if (CONSP (Vtool_bar_button_margin)
3751 && INTEGERP (XCDR (Vtool_bar_button_margin))
3752 && XINT (XCDR (Vtool_bar_button_margin)) > 0)
3753 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
3754 else
3755 margin = 0;
3757 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
3758 FRAME_LINES (f) += (bar_height + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f);
3761 compute_fringe_widths (f, 0);
3763 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, FRAME_COLS (f));
3764 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, FRAME_LINES (f));
3766 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
3767 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
3768 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
3769 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3771 if (EQ (tem0, Qminus))
3773 f->top_pos = 0;
3774 window_prompting |= YNegative;
3776 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
3777 && CONSP (XCDR (tem0))
3778 && INTEGERP (XCAR (XCDR (tem0))))
3780 f->top_pos = - XINT (XCAR (XCDR (tem0)));
3781 window_prompting |= YNegative;
3783 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
3784 && CONSP (XCDR (tem0))
3785 && INTEGERP (XCAR (XCDR (tem0))))
3787 f->top_pos = XINT (XCAR (XCDR (tem0)));
3789 else if (EQ (tem0, Qunbound))
3790 f->top_pos = 0;
3791 else
3793 CHECK_NUMBER (tem0);
3794 f->top_pos = XINT (tem0);
3795 if (f->top_pos < 0)
3796 window_prompting |= YNegative;
3799 if (EQ (tem1, Qminus))
3801 f->left_pos = 0;
3802 window_prompting |= XNegative;
3804 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
3805 && CONSP (XCDR (tem1))
3806 && INTEGERP (XCAR (XCDR (tem1))))
3808 f->left_pos = - XINT (XCAR (XCDR (tem1)));
3809 window_prompting |= XNegative;
3811 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
3812 && CONSP (XCDR (tem1))
3813 && INTEGERP (XCAR (XCDR (tem1))))
3815 f->left_pos = XINT (XCAR (XCDR (tem1)));
3817 else if (EQ (tem1, Qunbound))
3818 f->left_pos = 0;
3819 else
3821 CHECK_NUMBER (tem1);
3822 f->left_pos = XINT (tem1);
3823 if (f->left_pos < 0)
3824 window_prompting |= XNegative;
3827 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
3828 window_prompting |= USPosition;
3829 else
3830 window_prompting |= PPosition;
3833 if (f->want_fullscreen != FULLSCREEN_NONE)
3835 int left, top;
3836 int width, height;
3838 /* It takes both for some WM:s to place it where we want */
3839 window_prompting = USPosition | PPosition;
3840 x_fullscreen_adjust (f, &width, &height, &top, &left);
3841 FRAME_COLS (f) = width;
3842 FRAME_LINES (f) = height;
3843 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, width);
3844 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, height);
3845 f->left_pos = left;
3846 f->top_pos = top;
3849 if (window_prompting & XNegative)
3851 if (window_prompting & YNegative)
3852 f->win_gravity = SouthEastGravity;
3853 else
3854 f->win_gravity = NorthEastGravity;
3856 else
3858 if (window_prompting & YNegative)
3859 f->win_gravity = SouthWestGravity;
3860 else
3861 f->win_gravity = NorthWestGravity;
3864 f->size_hint_flags = window_prompting;
3866 return window_prompting;
3871 #endif /* HAVE_WINDOW_SYSTEM */
3875 /***********************************************************************
3876 Initialization
3877 ***********************************************************************/
3879 void
3880 syms_of_frame ()
3882 Qframep = intern ("framep");
3883 staticpro (&Qframep);
3884 Qframe_live_p = intern ("frame-live-p");
3885 staticpro (&Qframe_live_p);
3886 Qheight = intern ("height");
3887 staticpro (&Qheight);
3888 Qicon = intern ("icon");
3889 staticpro (&Qicon);
3890 Qminibuffer = intern ("minibuffer");
3891 staticpro (&Qminibuffer);
3892 Qmodeline = intern ("modeline");
3893 staticpro (&Qmodeline);
3894 Qonly = intern ("only");
3895 staticpro (&Qonly);
3896 Qwidth = intern ("width");
3897 staticpro (&Qwidth);
3898 Qgeometry = intern ("geometry");
3899 staticpro (&Qgeometry);
3900 Qicon_left = intern ("icon-left");
3901 staticpro (&Qicon_left);
3902 Qicon_top = intern ("icon-top");
3903 staticpro (&Qicon_top);
3904 Qleft = intern ("left");
3905 staticpro (&Qleft);
3906 Qright = intern ("right");
3907 staticpro (&Qright);
3908 Quser_position = intern ("user-position");
3909 staticpro (&Quser_position);
3910 Quser_size = intern ("user-size");
3911 staticpro (&Quser_size);
3912 Qwindow_id = intern ("window-id");
3913 staticpro (&Qwindow_id);
3914 #ifdef HAVE_X_WINDOWS
3915 Qouter_window_id = intern ("outer-window-id");
3916 staticpro (&Qouter_window_id);
3917 #endif
3918 Qparent_id = intern ("parent-id");
3919 staticpro (&Qparent_id);
3920 Qx = intern ("x");
3921 staticpro (&Qx);
3922 Qw32 = intern ("w32");
3923 staticpro (&Qw32);
3924 Qpc = intern ("pc");
3925 staticpro (&Qpc);
3926 Qmac = intern ("mac");
3927 staticpro (&Qmac);
3928 Qvisible = intern ("visible");
3929 staticpro (&Qvisible);
3930 Qbuffer_predicate = intern ("buffer-predicate");
3931 staticpro (&Qbuffer_predicate);
3932 Qbuffer_list = intern ("buffer-list");
3933 staticpro (&Qbuffer_list);
3934 Qdisplay_type = intern ("display-type");
3935 staticpro (&Qdisplay_type);
3936 Qbackground_mode = intern ("background-mode");
3937 staticpro (&Qbackground_mode);
3938 Qtty_color_mode = intern ("tty-color-mode");
3939 staticpro (&Qtty_color_mode);
3941 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
3942 staticpro (&Qface_set_after_frame_default);
3944 Qfullwidth = intern ("fullwidth");
3945 staticpro (&Qfullwidth);
3946 Qfullheight = intern ("fullheight");
3947 staticpro (&Qfullheight);
3948 Qfullboth = intern ("fullboth");
3949 staticpro (&Qfullboth);
3950 Qx_resource_name = intern ("x-resource-name");
3951 staticpro (&Qx_resource_name);
3953 Qx_frame_parameter = intern ("x-frame-parameter");
3954 staticpro (&Qx_frame_parameter);
3957 int i;
3959 for (i = 0; i < sizeof (frame_parms) / sizeof (frame_parms[0]); i++)
3961 Lisp_Object v = intern (frame_parms[i].name);
3962 if (frame_parms[i].variable)
3964 *frame_parms[i].variable = v;
3965 staticpro (frame_parms[i].variable);
3967 Fput (v, Qx_frame_parameter, make_number (i));
3971 #ifdef HAVE_WINDOW_SYSTEM
3972 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
3973 doc: /* The name Emacs uses to look up X resources.
3974 `x-get-resource' uses this as the first component of the instance name
3975 when requesting resource values.
3976 Emacs initially sets `x-resource-name' to the name under which Emacs
3977 was invoked, or to the value specified with the `-name' or `-rn'
3978 switches, if present.
3980 It may be useful to bind this variable locally around a call
3981 to `x-get-resource'. See also the variable `x-resource-class'. */);
3982 Vx_resource_name = Qnil;
3984 DEFVAR_LISP ("x-resource-class", &Vx_resource_class,
3985 doc: /* The class Emacs uses to look up X resources.
3986 `x-get-resource' uses this as the first component of the instance class
3987 when requesting resource values.
3989 Emacs initially sets `x-resource-class' to "Emacs".
3991 Setting this variable permanently is not a reasonable thing to do,
3992 but binding this variable locally around a call to `x-get-resource'
3993 is a reasonable practice. See also the variable `x-resource-name'. */);
3994 Vx_resource_class = build_string (EMACS_CLASS);
3995 #endif
3997 DEFVAR_LISP ("default-frame-alist", &Vdefault_frame_alist,
3998 doc: /* Alist of default values for frame creation.
3999 These may be set in your init file, like this:
4000 (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1))
4001 These override values given in window system configuration data,
4002 including X Windows' defaults database.
4003 For values specific to the first Emacs frame, see `initial-frame-alist'.
4004 For values specific to the separate minibuffer frame, see
4005 `minibuffer-frame-alist'.
4006 The `menu-bar-lines' element of the list controls whether new frames
4007 have menu bars; `menu-bar-mode' works by altering this element.
4008 Setting this variable does not affect existing frames, only new ones. */);
4009 Vdefault_frame_alist = Qnil;
4011 DEFVAR_LISP ("default-frame-scroll-bars", &Vdefault_frame_scroll_bars,
4012 doc: /* Default position of scroll bars on this window-system. */);
4013 #ifdef HAVE_WINDOW_SYSTEM
4014 #if defined(HAVE_NTGUI) || defined(HAVE_CARBON)
4015 /* MS-Windows has scroll bars on the right by default. */
4016 Vdefault_frame_scroll_bars = Qright;
4017 #else
4018 Vdefault_frame_scroll_bars = Qleft;
4019 #endif
4020 #else
4021 Vdefault_frame_scroll_bars = Qnil;
4022 #endif
4024 Qinhibit_default_face_x_resources
4025 = intern ("inhibit-default-face-x-resources");
4026 staticpro (&Qinhibit_default_face_x_resources);
4028 DEFVAR_LISP ("terminal-frame", &Vterminal_frame,
4029 doc: /* The initial frame-object, which represents Emacs's stdout. */);
4031 DEFVAR_LISP ("emacs-iconified", &Vemacs_iconified,
4032 doc: /* Non-nil if all of emacs is iconified and frame updates are not needed. */);
4033 Vemacs_iconified = Qnil;
4035 DEFVAR_LISP ("mouse-position-function", &Vmouse_position_function,
4036 doc: /* If non-nil, function to transform normal value of `mouse-position'.
4037 `mouse-position' calls this function, passing its usual return value as
4038 argument, and returns whatever this function returns.
4039 This abnormal hook exists for the benefit of packages like `xt-mouse.el'
4040 which need to do mouse handling at the Lisp level. */);
4041 Vmouse_position_function = Qnil;
4043 DEFVAR_LISP ("mouse-highlight", &Vmouse_highlight,
4044 doc: /* If non-nil, clickable text is highlighted when mouse is over it.
4045 If the value is an integer, highlighting is only shown after moving the
4046 mouse, while keyboard input turns off the highlight even when the mouse
4047 is over the clickable text. However, the mouse shape still indicates
4048 when the mouse is over clickable text. */);
4049 Vmouse_highlight = Qt;
4051 DEFVAR_LISP ("delete-frame-functions", &Vdelete_frame_functions,
4052 doc: /* Functions to be run before deleting a frame.
4053 The functions are run with one arg, the frame to be deleted.
4054 See `delete-frame'. */);
4055 Vdelete_frame_functions = Qnil;
4057 DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
4058 doc: /* Minibufferless frames use this frame's minibuffer.
4060 Emacs cannot create minibufferless frames unless this is set to an
4061 appropriate surrogate.
4063 Emacs consults this variable only when creating minibufferless
4064 frames; once the frame is created, it sticks with its assigned
4065 minibuffer, no matter what this variable is set to. This means that
4066 this variable doesn't necessarily say anything meaningful about the
4067 current set of frames, or where the minibuffer is currently being
4068 displayed.
4070 This variable is local to the current terminal and cannot be buffer-local. */);
4072 staticpro (&Vframe_list);
4074 defsubr (&Sactive_minibuffer_window);
4075 defsubr (&Sframep);
4076 defsubr (&Sframe_live_p);
4077 defsubr (&Smake_terminal_frame);
4078 defsubr (&Shandle_switch_frame);
4079 defsubr (&Signore_event);
4080 defsubr (&Sselect_frame);
4081 defsubr (&Sselected_frame);
4082 defsubr (&Swindow_frame);
4083 defsubr (&Sframe_root_window);
4084 defsubr (&Sframe_first_window);
4085 defsubr (&Sframe_selected_window);
4086 defsubr (&Sset_frame_selected_window);
4087 defsubr (&Sframe_list);
4088 defsubr (&Snext_frame);
4089 defsubr (&Sprevious_frame);
4090 defsubr (&Sdelete_frame);
4091 defsubr (&Smouse_position);
4092 defsubr (&Smouse_pixel_position);
4093 defsubr (&Sset_mouse_position);
4094 defsubr (&Sset_mouse_pixel_position);
4095 #if 0
4096 defsubr (&Sframe_configuration);
4097 defsubr (&Srestore_frame_configuration);
4098 #endif
4099 defsubr (&Smake_frame_visible);
4100 defsubr (&Smake_frame_invisible);
4101 defsubr (&Siconify_frame);
4102 defsubr (&Sframe_visible_p);
4103 defsubr (&Svisible_frame_list);
4104 defsubr (&Sraise_frame);
4105 defsubr (&Slower_frame);
4106 defsubr (&Sredirect_frame_focus);
4107 defsubr (&Sframe_focus);
4108 defsubr (&Sframe_parameters);
4109 defsubr (&Sframe_parameter);
4110 defsubr (&Smodify_frame_parameters);
4111 defsubr (&Sframe_char_height);
4112 defsubr (&Sframe_char_width);
4113 defsubr (&Sframe_pixel_height);
4114 defsubr (&Sframe_pixel_width);
4115 defsubr (&Sset_frame_height);
4116 defsubr (&Sset_frame_width);
4117 defsubr (&Sset_frame_size);
4118 defsubr (&Sset_frame_position);
4120 #ifdef HAVE_WINDOW_SYSTEM
4121 defsubr (&Sx_get_resource);
4122 defsubr (&Sx_parse_geometry);
4123 #endif
4127 /* arch-tag: 7dbf2c69-9aad-45f8-8296-db893d6dd039
4128 (do not change this comment) */