(Fset_window_scroll_bars): Fix typo in argument name.
[emacs.git] / src / frame.c
blobdbaaac0c387c77428f2f01e02335ff4df261387b
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 Vmouse_position_function;
118 Lisp_Object Vmouse_highlight;
119 Lisp_Object Vdelete_frame_functions;
121 static void
122 set_menu_bar_lines_1 (window, n)
123 Lisp_Object window;
124 int n;
126 struct window *w = XWINDOW (window);
128 XSETFASTINT (w->last_modified, 0);
129 XSETFASTINT (w->top_line, XFASTINT (w->top_line) + n);
130 XSETFASTINT (w->total_lines, XFASTINT (w->total_lines) - n);
132 if (INTEGERP (w->orig_top_line))
133 XSETFASTINT (w->orig_top_line, XFASTINT (w->orig_top_line) + n);
134 if (INTEGERP (w->orig_total_lines))
135 XSETFASTINT (w->orig_total_lines, XFASTINT (w->orig_total_lines) - n);
137 /* Handle just the top child in a vertical split. */
138 if (!NILP (w->vchild))
139 set_menu_bar_lines_1 (w->vchild, n);
141 /* Adjust all children in a horizontal split. */
142 for (window = w->hchild; !NILP (window); window = w->next)
144 w = XWINDOW (window);
145 set_menu_bar_lines_1 (window, n);
149 void
150 set_menu_bar_lines (f, value, oldval)
151 struct frame *f;
152 Lisp_Object value, oldval;
154 int nlines;
155 int olines = FRAME_MENU_BAR_LINES (f);
157 /* Right now, menu bars don't work properly in minibuf-only frames;
158 most of the commands try to apply themselves to the minibuffer
159 frame itself, and get an error because you can't switch buffers
160 in or split the minibuffer window. */
161 if (FRAME_MINIBUF_ONLY_P (f))
162 return;
164 if (INTEGERP (value))
165 nlines = XINT (value);
166 else
167 nlines = 0;
169 if (nlines != olines)
171 windows_or_buffers_changed++;
172 FRAME_WINDOW_SIZES_CHANGED (f) = 1;
173 FRAME_MENU_BAR_LINES (f) = nlines;
174 set_menu_bar_lines_1 (f->root_window, nlines - olines);
175 adjust_glyphs (f);
179 Lisp_Object Vemacs_iconified;
180 Lisp_Object Vframe_list;
182 struct x_output tty_display;
184 extern Lisp_Object Vminibuffer_list;
185 extern Lisp_Object get_minibuffer ();
186 extern Lisp_Object Fhandle_switch_frame ();
187 extern Lisp_Object Fredirect_frame_focus ();
188 extern Lisp_Object x_get_focus_frame ();
190 DEFUN ("framep", Fframep, Sframep, 1, 1, 0,
191 doc: /* Return non-nil if OBJECT is a frame.
192 Value is t for a termcap frame (a character-only terminal),
193 `x' for an Emacs frame that is really an X window,
194 `w32' for an Emacs frame that is a window on MS-Windows display,
195 `mac' for an Emacs frame on a Macintosh display,
196 `pc' for a direct-write MS-DOS frame.
197 See also `frame-live-p'. */)
198 (object)
199 Lisp_Object object;
201 if (!FRAMEP (object))
202 return Qnil;
203 switch (XFRAME (object)->output_method)
205 case output_termcap:
206 return Qt;
207 case output_x_window:
208 return Qx;
209 case output_w32:
210 return Qw32;
211 case output_msdos_raw:
212 return Qpc;
213 case output_mac:
214 return Qmac;
215 default:
216 abort ();
220 DEFUN ("frame-live-p", Fframe_live_p, Sframe_live_p, 1, 1, 0,
221 doc: /* Return non-nil if OBJECT is a frame which has not been deleted.
222 Value is nil if OBJECT is not a live frame. If object is a live
223 frame, the return value indicates what sort of output device it is
224 displayed on. See the documentation of `framep' for possible
225 return values. */)
226 (object)
227 Lisp_Object object;
229 return ((FRAMEP (object)
230 && FRAME_LIVE_P (XFRAME (object)))
231 ? Fframep (object)
232 : Qnil);
235 struct frame *
236 make_frame (mini_p)
237 int mini_p;
239 Lisp_Object frame;
240 register struct frame *f;
241 register Lisp_Object root_window;
242 register Lisp_Object mini_window;
244 f = allocate_frame ();
245 XSETFRAME (frame, f);
247 f->desired_matrix = 0;
248 f->current_matrix = 0;
249 f->desired_pool = 0;
250 f->current_pool = 0;
251 f->glyphs_initialized_p = 0;
252 f->decode_mode_spec_buffer = 0;
253 f->visible = 0;
254 f->async_visible = 0;
255 f->output_data.nothing = 0;
256 f->iconified = 0;
257 f->async_iconified = 0;
258 f->wants_modeline = 1;
259 f->auto_raise = 0;
260 f->auto_lower = 0;
261 f->no_split = 0;
262 f->garbaged = 1;
263 f->has_minibuffer = mini_p;
264 f->focus_frame = Qnil;
265 f->explicit_name = 0;
266 f->can_have_scroll_bars = 0;
267 f->vertical_scroll_bar_type = vertical_scroll_bar_none;
268 f->param_alist = Qnil;
269 f->scroll_bars = Qnil;
270 f->condemned_scroll_bars = Qnil;
271 f->face_alist = Qnil;
272 f->face_cache = NULL;
273 f->menu_bar_items = Qnil;
274 f->menu_bar_vector = Qnil;
275 f->menu_bar_items_used = 0;
276 f->buffer_predicate = Qnil;
277 f->buffer_list = Qnil;
278 #ifdef MULTI_KBOARD
279 f->kboard = initial_kboard;
280 #endif
281 f->namebuf = 0;
282 f->title = Qnil;
283 f->menu_bar_window = Qnil;
284 f->tool_bar_window = Qnil;
285 f->tool_bar_items = Qnil;
286 f->desired_tool_bar_string = f->current_tool_bar_string = Qnil;
287 f->n_tool_bar_items = 0;
288 f->left_fringe_width = f->right_fringe_width = 0;
289 f->fringe_cols = 0;
290 f->scroll_bar_actual_width = 0;
291 f->border_width = 0;
292 f->internal_border_width = 0;
293 f->column_width = 1; /* !FRAME_WINDOW_P value */
294 f->line_height = 1; /* !FRAME_WINDOW_P value */
295 f->x_pixels_diff = f->y_pixels_diff = 0;
296 f->want_fullscreen = FULLSCREEN_NONE;
297 f->size_hint_flags = 0;
298 f->win_gravity = 0;
300 root_window = make_window ();
301 if (mini_p)
303 mini_window = make_window ();
304 XWINDOW (root_window)->next = mini_window;
305 XWINDOW (mini_window)->prev = root_window;
306 XWINDOW (mini_window)->mini_p = Qt;
307 XWINDOW (mini_window)->frame = frame;
308 f->minibuffer_window = mini_window;
310 else
312 mini_window = Qnil;
313 XWINDOW (root_window)->next = Qnil;
314 f->minibuffer_window = Qnil;
317 XWINDOW (root_window)->frame = frame;
319 /* 10 is arbitrary,
320 just so that there is "something there."
321 Correct size will be set up later with change_frame_size. */
323 SET_FRAME_COLS (f, 10);
324 FRAME_LINES (f) = 10;
326 XSETFASTINT (XWINDOW (root_window)->total_cols, 10);
327 XSETFASTINT (XWINDOW (root_window)->total_lines, (mini_p ? 9 : 10));
329 if (mini_p)
331 XSETFASTINT (XWINDOW (mini_window)->total_cols, 10);
332 XSETFASTINT (XWINDOW (mini_window)->top_line, 9);
333 XSETFASTINT (XWINDOW (mini_window)->total_lines, 1);
336 /* Choose a buffer for the frame's root window. */
338 Lisp_Object buf;
340 XWINDOW (root_window)->buffer = Qt;
341 buf = Fcurrent_buffer ();
342 /* If buf is a 'hidden' buffer (i.e. one whose name starts with
343 a space), try to find another one. */
344 if (SREF (Fbuffer_name (buf), 0) == ' ')
345 buf = Fother_buffer (buf, Qnil, Qnil);
347 /* Use set_window_buffer, not Fset_window_buffer, and don't let
348 hooks be run by it. The reason is that the whole frame/window
349 arrangement is not yet fully intialized at this point. Windows
350 don't have the right size, glyph matrices aren't initialized
351 etc. Running Lisp functions at this point surely ends in a
352 SEGV. */
353 set_window_buffer (root_window, buf, 0, 0);
354 f->buffer_list = Fcons (buf, Qnil);
357 if (mini_p)
359 XWINDOW (mini_window)->buffer = Qt;
360 set_window_buffer (mini_window,
361 (NILP (Vminibuffer_list)
362 ? get_minibuffer (0)
363 : Fcar (Vminibuffer_list)),
364 0, 0);
367 f->root_window = root_window;
368 f->selected_window = root_window;
369 /* Make sure this window seems more recently used than
370 a newly-created, never-selected window. */
371 XSETFASTINT (XWINDOW (f->selected_window)->use_time, ++window_select_count);
373 return f;
376 #ifdef HAVE_WINDOW_SYSTEM
377 /* Make a frame using a separate minibuffer window on another frame.
378 MINI_WINDOW is the minibuffer window to use. nil means use the
379 default (the global minibuffer). */
381 struct frame *
382 make_frame_without_minibuffer (mini_window, kb, display)
383 register Lisp_Object mini_window;
384 KBOARD *kb;
385 Lisp_Object display;
387 register struct frame *f;
388 struct gcpro gcpro1;
390 if (!NILP (mini_window))
391 CHECK_LIVE_WINDOW (mini_window);
393 #ifdef MULTI_KBOARD
394 if (!NILP (mini_window)
395 && XFRAME (XWINDOW (mini_window)->frame)->kboard != kb)
396 error ("frame and minibuffer must be on the same display");
397 #endif
399 /* Make a frame containing just a root window. */
400 f = make_frame (0);
402 if (NILP (mini_window))
404 /* Use default-minibuffer-frame if possible. */
405 if (!FRAMEP (kb->Vdefault_minibuffer_frame)
406 || ! FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame)))
408 Lisp_Object frame_dummy;
410 XSETFRAME (frame_dummy, f);
411 GCPRO1 (frame_dummy);
412 /* If there's no minibuffer frame to use, create one. */
413 kb->Vdefault_minibuffer_frame =
414 call1 (intern ("make-initial-minibuffer-frame"), display);
415 UNGCPRO;
418 mini_window = XFRAME (kb->Vdefault_minibuffer_frame)->minibuffer_window;
421 f->minibuffer_window = mini_window;
423 /* Make the chosen minibuffer window display the proper minibuffer,
424 unless it is already showing a minibuffer. */
425 if (NILP (Fmemq (XWINDOW (mini_window)->buffer, Vminibuffer_list)))
426 Fset_window_buffer (mini_window,
427 (NILP (Vminibuffer_list)
428 ? get_minibuffer (0)
429 : Fcar (Vminibuffer_list)), Qnil);
430 return f;
433 /* Make a frame containing only a minibuffer window. */
435 struct frame *
436 make_minibuffer_frame ()
438 /* First make a frame containing just a root window, no minibuffer. */
440 register struct frame *f = make_frame (0);
441 register Lisp_Object mini_window;
442 register Lisp_Object frame;
444 XSETFRAME (frame, f);
446 f->auto_raise = 0;
447 f->auto_lower = 0;
448 f->no_split = 1;
449 f->wants_modeline = 0;
450 f->has_minibuffer = 1;
452 /* Now label the root window as also being the minibuffer.
453 Avoid infinite looping on the window chain by marking next pointer
454 as nil. */
456 mini_window = f->minibuffer_window = f->root_window;
457 XWINDOW (mini_window)->mini_p = Qt;
458 XWINDOW (mini_window)->next = Qnil;
459 XWINDOW (mini_window)->prev = Qnil;
460 XWINDOW (mini_window)->frame = frame;
462 /* Put the proper buffer in that window. */
464 Fset_window_buffer (mini_window,
465 (NILP (Vminibuffer_list)
466 ? get_minibuffer (0)
467 : Fcar (Vminibuffer_list)), Qnil);
468 return f;
470 #endif /* HAVE_WINDOW_SYSTEM */
472 /* Construct a frame that refers to the terminal (stdin and stdout). */
474 static int terminal_frame_count;
476 struct frame *
477 make_terminal_frame ()
479 register struct frame *f;
480 Lisp_Object frame;
481 char name[20];
483 #ifdef MULTI_KBOARD
484 if (!initial_kboard)
486 initial_kboard = (KBOARD *) xmalloc (sizeof (KBOARD));
487 init_kboard (initial_kboard);
488 initial_kboard->next_kboard = all_kboards;
489 all_kboards = initial_kboard;
491 #endif
493 /* The first call must initialize Vframe_list. */
494 if (! (NILP (Vframe_list) || CONSP (Vframe_list)))
495 Vframe_list = Qnil;
497 f = make_frame (1);
499 XSETFRAME (frame, f);
500 Vframe_list = Fcons (frame, Vframe_list);
502 terminal_frame_count++;
503 sprintf (name, "F%d", terminal_frame_count);
504 f->name = build_string (name);
506 f->visible = 1; /* FRAME_SET_VISIBLE wd set frame_garbaged. */
507 f->async_visible = 1; /* Don't let visible be cleared later. */
508 #ifdef MSDOS
509 f->output_data.x = &the_only_x_display;
510 if (!inhibit_window_system
511 && (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame))
512 || XFRAME (selected_frame)->output_method == output_msdos_raw))
514 f->output_method = output_msdos_raw;
515 /* This initialization of foreground and background pixels is
516 only important for the initial frame created in temacs. If
517 we don't do that, we get black background and foreground in
518 the dumped Emacs because the_only_x_display is a static
519 variable, hence it is born all-zeroes, and zero is the code
520 for the black color. Other frames all inherit their pixels
521 from what's already in the_only_x_display. */
522 if ((!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)))
523 && f->output_data.x->background_pixel == 0
524 && f->output_data.x->foreground_pixel == 0)
526 f->output_data.x->background_pixel = FACE_TTY_DEFAULT_BG_COLOR;
527 f->output_data.x->foreground_pixel = FACE_TTY_DEFAULT_FG_COLOR;
530 else
531 f->output_method = output_termcap;
532 #else
533 #ifdef WINDOWSNT
534 f->output_method = output_termcap;
535 f->output_data.x = &tty_display;
536 #else
537 #ifdef MAC_OS8
538 make_mac_terminal_frame (f);
539 #else
540 f->output_data.x = &tty_display;
541 #ifdef CANNOT_DUMP
542 FRAME_FOREGROUND_PIXEL(f) = FACE_TTY_DEFAULT_FG_COLOR;
543 FRAME_BACKGROUND_PIXEL(f) = FACE_TTY_DEFAULT_BG_COLOR;
544 #endif
545 #endif /* MAC_OS8 */
546 #endif /* WINDOWSNT */
547 #endif /* MSDOS */
549 if (!noninteractive)
550 init_frame_faces (f);
552 return f;
555 DEFUN ("make-terminal-frame", Fmake_terminal_frame, Smake_terminal_frame,
556 1, 1, 0,
557 doc: /* Create an additional terminal frame.
558 You can create multiple frames on a text-only terminal in this way.
559 Only the selected terminal frame is actually displayed.
560 This function takes one argument, an alist specifying frame parameters.
561 In practice, generally you don't need to specify any parameters.
562 Note that changing the size of one terminal frame automatically affects all. */)
563 (parms)
564 Lisp_Object parms;
566 struct frame *f;
567 Lisp_Object frame, tem;
568 struct frame *sf = SELECTED_FRAME ();
570 #ifdef MSDOS
571 if (sf->output_method != output_msdos_raw
572 && sf->output_method != output_termcap)
573 abort ();
574 #else /* not MSDOS */
576 #ifdef MAC_OS
577 if (sf->output_method != output_mac)
578 error ("Not running on a Macintosh screen; cannot make a new Macintosh frame");
579 #else
580 if (sf->output_method != output_termcap)
581 error ("Not using an ASCII terminal now; cannot make a new ASCII frame");
582 #endif
583 #endif /* not MSDOS */
585 f = make_terminal_frame ();
587 change_frame_size (f, FRAME_LINES (sf),
588 FRAME_COLS (sf), 0, 0, 0);
589 adjust_glyphs (f);
590 calculate_costs (f);
591 XSETFRAME (frame, f);
592 Fmodify_frame_parameters (frame, Vdefault_frame_alist);
593 Fmodify_frame_parameters (frame, parms);
595 /* Make the frame face alist be frame-specific, so that each
596 frame could change its face definitions independently. */
597 f->face_alist = Fcopy_alist (sf->face_alist);
598 /* Simple Fcopy_alist isn't enough, because we need the contents of
599 the vectors which are the CDRs of associations in face_alist to
600 be copied as well. */
601 for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem))
602 XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem))));
603 return frame;
607 /* Perform the switch to frame FRAME.
609 If FRAME is a switch-frame event `(switch-frame FRAME1)', use
610 FRAME1 as frame.
612 If TRACK is non-zero and the frame that currently has the focus
613 redirects its focus to the selected frame, redirect that focused
614 frame's focus to FRAME instead.
616 FOR_DELETION non-zero means that the selected frame is being
617 deleted, which includes the possibility that the frame's display
618 is dead. */
620 Lisp_Object
621 do_switch_frame (frame, track, for_deletion)
622 Lisp_Object frame;
623 int track, for_deletion;
625 struct frame *sf = SELECTED_FRAME ();
627 /* If FRAME is a switch-frame event, extract the frame we should
628 switch to. */
629 if (CONSP (frame)
630 && EQ (XCAR (frame), Qswitch_frame)
631 && CONSP (XCDR (frame)))
632 frame = XCAR (XCDR (frame));
634 /* This used to say CHECK_LIVE_FRAME, but apparently it's possible for
635 a switch-frame event to arrive after a frame is no longer live,
636 especially when deleting the initial frame during startup. */
637 CHECK_FRAME (frame);
638 if (! FRAME_LIVE_P (XFRAME (frame)))
639 return Qnil;
641 if (sf == XFRAME (frame))
642 return frame;
644 /* This is too greedy; it causes inappropriate focus redirection
645 that's hard to get rid of. */
646 #if 0
647 /* If a frame's focus has been redirected toward the currently
648 selected frame, we should change the redirection to point to the
649 newly selected frame. This means that if the focus is redirected
650 from a minibufferless frame to a surrogate minibuffer frame, we
651 can use `other-window' to switch between all the frames using
652 that minibuffer frame, and the focus redirection will follow us
653 around. */
654 if (track)
656 Lisp_Object tail;
658 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
660 Lisp_Object focus;
662 if (!FRAMEP (XCAR (tail)))
663 abort ();
665 focus = FRAME_FOCUS_FRAME (XFRAME (XCAR (tail)));
667 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
668 Fredirect_frame_focus (XCAR (tail), frame);
671 #else /* ! 0 */
672 /* Instead, apply it only to the frame we're pointing to. */
673 #ifdef HAVE_WINDOW_SYSTEM
674 if (track && FRAME_WINDOW_P (XFRAME (frame)))
676 Lisp_Object focus, xfocus;
678 xfocus = x_get_focus_frame (XFRAME (frame));
679 if (FRAMEP (xfocus))
681 focus = FRAME_FOCUS_FRAME (XFRAME (xfocus));
682 if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
683 Fredirect_frame_focus (xfocus, frame);
686 #endif /* HAVE_X_WINDOWS */
687 #endif /* ! 0 */
689 if (!for_deletion && FRAME_HAS_MINIBUF_P (sf))
690 resize_mini_window (XWINDOW (FRAME_MINIBUF_WINDOW (sf)), 1);
692 selected_frame = frame;
693 if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
694 last_nonminibuf_frame = XFRAME (selected_frame);
696 Fselect_window (XFRAME (frame)->selected_window, Qnil);
698 #ifndef WINDOWSNT
699 /* Make sure to switch the tty color mode to that of the newly
700 selected frame. */
701 sf = SELECTED_FRAME ();
702 if (FRAME_TERMCAP_P (sf))
704 Lisp_Object color_mode_spec, color_mode;
706 color_mode_spec = assq_no_quit (Qtty_color_mode, sf->param_alist);
707 if (CONSP (color_mode_spec))
708 color_mode = XCDR (color_mode_spec);
709 else
710 color_mode = make_number (0);
711 set_tty_color_mode (sf, color_mode);
713 #endif /* !WINDOWSNT */
715 /* We want to make sure that the next event generates a frame-switch
716 event to the appropriate frame. This seems kludgy to me, but
717 before you take it out, make sure that evaluating something like
718 (select-window (frame-root-window (new-frame))) doesn't end up
719 with your typing being interpreted in the new frame instead of
720 the one you're actually typing in. */
721 internal_last_event_frame = Qnil;
723 return frame;
726 DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 2, "e",
727 doc: /* Select the frame FRAME.
728 Subsequent editing commands apply to its selected window.
729 The selection of FRAME lasts until the next time the user does
730 something to select a different frame, or until the next time this
731 function is called. */)
732 (frame, no_enter)
733 Lisp_Object frame, no_enter;
735 return do_switch_frame (frame, 1, 0);
739 DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 2, "e",
740 doc: /* Handle a switch-frame event EVENT.
741 Switch-frame events are usually bound to this function.
742 A switch-frame event tells Emacs that the window manager has requested
743 that the user's events be directed to the frame mentioned in the event.
744 This function selects the selected window of the frame of EVENT.
746 If EVENT is frame object, handle it as if it were a switch-frame event
747 to that frame. */)
748 (event, no_enter)
749 Lisp_Object event, no_enter;
751 /* Preserve prefix arg that the command loop just cleared. */
752 current_kboard->Vprefix_arg = Vcurrent_prefix_arg;
753 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
754 return do_switch_frame (event, 0, 0);
757 DEFUN ("ignore-event", Fignore_event, Signore_event, 0, 0, "",
758 doc: /* Do nothing, but preserve any prefix argument already specified.
759 This is a suitable binding for `iconify-frame' and `make-frame-visible'. */)
762 current_kboard->Vprefix_arg = Vcurrent_prefix_arg;
763 return Qnil;
766 DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0,
767 doc: /* Return the frame that is now selected. */)
770 return selected_frame;
773 DEFUN ("window-frame", Fwindow_frame, Swindow_frame, 1, 1, 0,
774 doc: /* Return the frame object that window WINDOW is on. */)
775 (window)
776 Lisp_Object window;
778 CHECK_LIVE_WINDOW (window);
779 return XWINDOW (window)->frame;
782 DEFUN ("frame-first-window", Fframe_first_window, Sframe_first_window, 0, 1, 0,
783 doc: /* Returns the topmost, leftmost window of FRAME.
784 If omitted, FRAME defaults to the currently selected frame. */)
785 (frame)
786 Lisp_Object frame;
788 Lisp_Object w;
790 if (NILP (frame))
791 w = SELECTED_FRAME ()->root_window;
792 else
794 CHECK_LIVE_FRAME (frame);
795 w = XFRAME (frame)->root_window;
797 while (NILP (XWINDOW (w)->buffer))
799 if (! NILP (XWINDOW (w)->hchild))
800 w = XWINDOW (w)->hchild;
801 else if (! NILP (XWINDOW (w)->vchild))
802 w = XWINDOW (w)->vchild;
803 else
804 abort ();
806 return w;
809 DEFUN ("active-minibuffer-window", Factive_minibuffer_window,
810 Sactive_minibuffer_window, 0, 0, 0,
811 doc: /* Return the currently active minibuffer window, or nil if none. */)
814 return minibuf_level ? minibuf_window : Qnil;
817 DEFUN ("frame-root-window", Fframe_root_window, Sframe_root_window, 0, 1, 0,
818 doc: /* Returns the root-window of FRAME.
819 If omitted, FRAME defaults to the currently selected frame. */)
820 (frame)
821 Lisp_Object frame;
823 Lisp_Object window;
825 if (NILP (frame))
826 window = SELECTED_FRAME ()->root_window;
827 else
829 CHECK_LIVE_FRAME (frame);
830 window = XFRAME (frame)->root_window;
833 return window;
836 DEFUN ("frame-selected-window", Fframe_selected_window,
837 Sframe_selected_window, 0, 1, 0,
838 doc: /* Return the selected window of frame object FRAME.
839 If omitted, FRAME defaults to the currently selected frame. */)
840 (frame)
841 Lisp_Object frame;
843 Lisp_Object window;
845 if (NILP (frame))
846 window = SELECTED_FRAME ()->selected_window;
847 else
849 CHECK_LIVE_FRAME (frame);
850 window = XFRAME (frame)->selected_window;
853 return window;
856 DEFUN ("set-frame-selected-window", Fset_frame_selected_window,
857 Sset_frame_selected_window, 2, 2, 0,
858 doc: /* Set the selected window of frame object FRAME to WINDOW.
859 If FRAME is nil, the selected frame is used.
860 If FRAME is the selected frame, this makes WINDOW the selected window. */)
861 (frame, window)
862 Lisp_Object frame, window;
864 if (NILP (frame))
865 frame = selected_frame;
867 CHECK_LIVE_FRAME (frame);
868 CHECK_LIVE_WINDOW (window);
870 if (! EQ (frame, WINDOW_FRAME (XWINDOW (window))))
871 error ("In `set-frame-selected-window', WINDOW is not on FRAME");
873 if (EQ (frame, selected_frame))
874 return Fselect_window (window, Qnil);
876 return XFRAME (frame)->selected_window = window;
879 DEFUN ("frame-list", Fframe_list, Sframe_list,
880 0, 0, 0,
881 doc: /* Return a list of all frames. */)
884 Lisp_Object frames;
885 frames = Fcopy_sequence (Vframe_list);
886 #ifdef HAVE_WINDOW_SYSTEM
887 if (FRAMEP (tip_frame))
888 frames = Fdelq (tip_frame, frames);
889 #endif
890 return frames;
893 /* Return the next frame in the frame list after FRAME.
894 If MINIBUF is nil, exclude minibuffer-only frames.
895 If MINIBUF is a window, include only its own frame
896 and any frame now using that window as the minibuffer.
897 If MINIBUF is `visible', include all visible frames.
898 If MINIBUF is 0, include all visible and iconified frames.
899 Otherwise, include all frames. */
901 Lisp_Object
902 next_frame (frame, minibuf)
903 Lisp_Object frame;
904 Lisp_Object minibuf;
906 Lisp_Object tail;
907 int passed = 0;
909 /* There must always be at least one frame in Vframe_list. */
910 if (! CONSP (Vframe_list))
911 abort ();
913 /* If this frame is dead, it won't be in Vframe_list, and we'll loop
914 forever. Forestall that. */
915 CHECK_LIVE_FRAME (frame);
917 while (1)
918 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
920 Lisp_Object f;
922 f = XCAR (tail);
924 if (passed
925 && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
927 /* Decide whether this frame is eligible to be returned. */
929 /* If we've looped all the way around without finding any
930 eligible frames, return the original frame. */
931 if (EQ (f, frame))
932 return f;
934 /* Let minibuf decide if this frame is acceptable. */
935 if (NILP (minibuf))
937 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
938 return f;
940 else if (EQ (minibuf, Qvisible))
942 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
943 if (FRAME_VISIBLE_P (XFRAME (f)))
944 return f;
946 else if (INTEGERP (minibuf) && XINT (minibuf) == 0)
948 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
949 if (FRAME_VISIBLE_P (XFRAME (f))
950 || FRAME_ICONIFIED_P (XFRAME (f)))
951 return f;
953 else if (WINDOWP (minibuf))
955 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
956 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
957 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
958 FRAME_FOCUS_FRAME (XFRAME (f))))
959 return f;
961 else
962 return f;
965 if (EQ (frame, f))
966 passed++;
970 /* Return the previous frame in the frame list before FRAME.
971 If MINIBUF is nil, exclude minibuffer-only frames.
972 If MINIBUF is a window, include only its own frame
973 and any frame now using that window as the minibuffer.
974 If MINIBUF is `visible', include all visible frames.
975 If MINIBUF is 0, include all visible and iconified frames.
976 Otherwise, include all frames. */
978 Lisp_Object
979 prev_frame (frame, minibuf)
980 Lisp_Object frame;
981 Lisp_Object minibuf;
983 Lisp_Object tail;
984 Lisp_Object prev;
986 /* There must always be at least one frame in Vframe_list. */
987 if (! CONSP (Vframe_list))
988 abort ();
990 prev = Qnil;
991 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
993 Lisp_Object f;
995 f = XCAR (tail);
996 if (!FRAMEP (f))
997 abort ();
999 if (EQ (frame, f) && !NILP (prev))
1000 return prev;
1002 if (FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
1004 /* Decide whether this frame is eligible to be returned,
1005 according to minibuf. */
1006 if (NILP (minibuf))
1008 if (! FRAME_MINIBUF_ONLY_P (XFRAME (f)))
1009 prev = f;
1011 else if (WINDOWP (minibuf))
1013 if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)
1014 || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
1015 || EQ (WINDOW_FRAME (XWINDOW (minibuf)),
1016 FRAME_FOCUS_FRAME (XFRAME (f))))
1017 prev = f;
1019 else if (EQ (minibuf, Qvisible))
1021 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1022 if (FRAME_VISIBLE_P (XFRAME (f)))
1023 prev = f;
1025 else if (XFASTINT (minibuf) == 0)
1027 FRAME_SAMPLE_VISIBILITY (XFRAME (f));
1028 if (FRAME_VISIBLE_P (XFRAME (f))
1029 || FRAME_ICONIFIED_P (XFRAME (f)))
1030 prev = f;
1032 else
1033 prev = f;
1037 /* We've scanned the entire list. */
1038 if (NILP (prev))
1039 /* We went through the whole frame list without finding a single
1040 acceptable frame. Return the original frame. */
1041 return frame;
1042 else
1043 /* There were no acceptable frames in the list before FRAME; otherwise,
1044 we would have returned directly from the loop. Since PREV is the last
1045 acceptable frame in the list, return it. */
1046 return prev;
1050 DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0,
1051 doc: /* Return the next frame in the frame list after FRAME.
1052 It considers only frames on the same terminal as FRAME.
1053 By default, skip minibuffer-only frames.
1054 If omitted, FRAME defaults to the selected frame.
1055 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1056 If MINIFRAME is a window, include only its own frame
1057 and any frame now using that window as the minibuffer.
1058 If MINIFRAME is `visible', include all visible frames.
1059 If MINIFRAME is 0, include all visible and iconified frames.
1060 Otherwise, include all frames. */)
1061 (frame, miniframe)
1062 Lisp_Object frame, miniframe;
1064 if (NILP (frame))
1065 frame = selected_frame;
1067 CHECK_LIVE_FRAME (frame);
1068 return next_frame (frame, miniframe);
1071 DEFUN ("previous-frame", Fprevious_frame, Sprevious_frame, 0, 2, 0,
1072 doc: /* Return the previous frame in the frame list before FRAME.
1073 It considers only frames on the same terminal as FRAME.
1074 By default, skip minibuffer-only frames.
1075 If omitted, FRAME defaults to the selected frame.
1076 If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
1077 If MINIFRAME is a window, include only its own frame
1078 and any frame now using that window as the minibuffer.
1079 If MINIFRAME is `visible', include all visible frames.
1080 If MINIFRAME is 0, include all visible and iconified frames.
1081 Otherwise, include all frames. */)
1082 (frame, miniframe)
1083 Lisp_Object frame, miniframe;
1085 if (NILP (frame))
1086 frame = selected_frame;
1087 CHECK_LIVE_FRAME (frame);
1088 return prev_frame (frame, miniframe);
1091 /* Return 1 if it is ok to delete frame F;
1092 0 if all frames aside from F are invisible.
1093 (Exception: if F is the terminal frame, and we are using X, return 1.) */
1096 other_visible_frames (f)
1097 FRAME_PTR f;
1099 /* We know the selected frame is visible,
1100 so if F is some other frame, it can't be the sole visible one. */
1101 if (f == SELECTED_FRAME ())
1103 Lisp_Object frames;
1104 int count = 0;
1106 for (frames = Vframe_list;
1107 CONSP (frames);
1108 frames = XCDR (frames))
1110 Lisp_Object this;
1112 this = XCAR (frames);
1113 /* Verify that the frame's window still exists
1114 and we can still talk to it. And note any recent change
1115 in visibility. */
1116 #ifdef HAVE_WINDOW_SYSTEM
1117 if (FRAME_WINDOW_P (XFRAME (this)))
1119 x_sync (XFRAME (this));
1120 FRAME_SAMPLE_VISIBILITY (XFRAME (this));
1122 #endif
1124 if (FRAME_VISIBLE_P (XFRAME (this))
1125 || FRAME_ICONIFIED_P (XFRAME (this))
1126 /* Allow deleting the terminal frame when at least
1127 one X frame exists! */
1128 || (FRAME_WINDOW_P (XFRAME (this)) && !FRAME_WINDOW_P (f)))
1129 count++;
1131 return count > 1;
1133 return 1;
1136 DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 2, "",
1137 doc: /* Delete FRAME, permanently eliminating it from use.
1138 If omitted, FRAME defaults to the selected frame.
1139 A frame may not be deleted if its minibuffer is used by other frames.
1140 Normally, you may not delete a frame if all other frames are invisible,
1141 but if the second optional argument FORCE is non-nil, you may do so.
1143 This function runs `delete-frame-functions' before actually deleting the
1144 frame, unless the frame is a tooltip.
1145 The functions are run with one arg, the frame to be deleted. */)
1146 (frame, force)
1147 Lisp_Object frame, force;
1149 struct frame *f;
1150 struct frame *sf = SELECTED_FRAME ();
1151 int minibuffer_selected;
1153 if (EQ (frame, Qnil))
1155 f = sf;
1156 XSETFRAME (frame, f);
1158 else
1160 CHECK_FRAME (frame);
1161 f = XFRAME (frame);
1164 if (! FRAME_LIVE_P (f))
1165 return Qnil;
1167 if (NILP (force) && !other_visible_frames (f)
1168 #ifdef MAC_OS8
1169 /* Terminal frame deleted before any other visible frames are
1170 created. */
1171 && strcmp (SDATA (f->name), "F1") != 0
1172 #endif
1174 error ("Attempt to delete the sole visible or iconified frame");
1176 #if 0
1177 /* This is a nice idea, but x_connection_closed needs to be able
1178 to delete the last frame, if it is gone. */
1179 if (NILP (XCDR (Vframe_list)))
1180 error ("Attempt to delete the only frame");
1181 #endif
1183 /* Does this frame have a minibuffer, and is it the surrogate
1184 minibuffer for any other frame? */
1185 if (FRAME_HAS_MINIBUF_P (XFRAME (frame)))
1187 Lisp_Object frames;
1189 for (frames = Vframe_list;
1190 CONSP (frames);
1191 frames = XCDR (frames))
1193 Lisp_Object this;
1194 this = XCAR (frames);
1196 if (! EQ (this, frame)
1197 && EQ (frame,
1198 WINDOW_FRAME (XWINDOW
1199 (FRAME_MINIBUF_WINDOW (XFRAME (this))))))
1200 error ("Attempt to delete a surrogate minibuffer frame");
1204 /* Run `delete-frame-functions' unless frame is a tooltip. */
1205 if (!NILP (Vrun_hooks)
1206 && NILP (Fframe_parameter (frame, intern ("tooltip"))))
1208 Lisp_Object args[2];
1209 args[0] = intern ("delete-frame-functions");
1210 args[1] = frame;
1211 Frun_hook_with_args (2, args);
1214 minibuffer_selected = EQ (minibuf_window, selected_window);
1216 /* Don't let the frame remain selected. */
1217 if (f == sf)
1219 Lisp_Object tail, frame1;
1221 /* Look for another visible frame on the same terminal. */
1222 frame1 = next_frame (frame, Qvisible);
1224 /* If there is none, find *some* other frame. */
1225 if (NILP (frame1) || EQ (frame1, frame))
1227 FOR_EACH_FRAME (tail, frame1)
1229 if (! EQ (frame, frame1))
1230 break;
1234 do_switch_frame (frame1, 0, 1);
1235 sf = SELECTED_FRAME ();
1238 /* Don't allow minibuf_window to remain on a deleted frame. */
1239 if (EQ (f->minibuffer_window, minibuf_window))
1241 Fset_window_buffer (sf->minibuffer_window,
1242 XWINDOW (minibuf_window)->buffer, Qnil);
1243 minibuf_window = sf->minibuffer_window;
1245 /* If the dying minibuffer window was selected,
1246 select the new one. */
1247 if (minibuffer_selected)
1248 Fselect_window (minibuf_window, Qnil);
1251 /* Don't let echo_area_window to remain on a deleted frame. */
1252 if (EQ (f->minibuffer_window, echo_area_window))
1253 echo_area_window = sf->minibuffer_window;
1255 /* Clear any X selections for this frame. */
1256 #ifdef HAVE_X_WINDOWS
1257 if (FRAME_X_P (f))
1258 x_clear_frame_selections (f);
1259 #endif
1261 /* Free glyphs.
1262 This function must be called before the window tree of the
1263 frame is deleted because windows contain dynamically allocated
1264 memory. */
1265 free_glyphs (f);
1267 /* Mark all the windows that used to be on FRAME as deleted, and then
1268 remove the reference to them. */
1269 delete_all_subwindows (XWINDOW (f->root_window));
1270 f->root_window = Qnil;
1272 Vframe_list = Fdelq (frame, Vframe_list);
1273 FRAME_SET_VISIBLE (f, 0);
1275 if (f->namebuf)
1276 xfree (f->namebuf);
1277 if (FRAME_INSERT_COST (f))
1278 xfree (FRAME_INSERT_COST (f));
1279 if (FRAME_DELETEN_COST (f))
1280 xfree (FRAME_DELETEN_COST (f));
1281 if (FRAME_INSERTN_COST (f))
1282 xfree (FRAME_INSERTN_COST (f));
1283 if (FRAME_DELETE_COST (f))
1284 xfree (FRAME_DELETE_COST (f));
1285 if (FRAME_MESSAGE_BUF (f))
1286 xfree (FRAME_MESSAGE_BUF (f));
1288 /* Since some events are handled at the interrupt level, we may get
1289 an event for f at any time; if we zero out the frame's display
1290 now, then we may trip up the event-handling code. Instead, we'll
1291 promise that the display of the frame must be valid until we have
1292 called the window-system-dependent frame destruction routine. */
1294 /* I think this should be done with a hook. */
1295 #ifdef HAVE_WINDOW_SYSTEM
1296 if (FRAME_WINDOW_P (f))
1297 x_destroy_window (f);
1298 #endif
1300 f->output_data.nothing = 0;
1302 /* If we've deleted the last_nonminibuf_frame, then try to find
1303 another one. */
1304 if (f == last_nonminibuf_frame)
1306 Lisp_Object frames;
1308 last_nonminibuf_frame = 0;
1310 for (frames = Vframe_list;
1311 CONSP (frames);
1312 frames = XCDR (frames))
1314 f = XFRAME (XCAR (frames));
1315 if (!FRAME_MINIBUF_ONLY_P (f))
1317 last_nonminibuf_frame = f;
1318 break;
1323 /* If we've deleted this keyboard's default_minibuffer_frame, try to
1324 find another one. Prefer minibuffer-only frames, but also notice
1325 frames with other windows. */
1326 if (EQ (frame, FRAME_KBOARD (f)->Vdefault_minibuffer_frame))
1328 Lisp_Object frames;
1330 /* The last frame we saw with a minibuffer, minibuffer-only or not. */
1331 Lisp_Object frame_with_minibuf;
1332 /* Some frame we found on the same kboard, or nil if there are none. */
1333 Lisp_Object frame_on_same_kboard;
1335 frame_on_same_kboard = Qnil;
1336 frame_with_minibuf = Qnil;
1338 for (frames = Vframe_list;
1339 CONSP (frames);
1340 frames = XCDR (frames))
1342 Lisp_Object this;
1343 struct frame *f1;
1345 this = XCAR (frames);
1346 if (!FRAMEP (this))
1347 abort ();
1348 f1 = XFRAME (this);
1350 /* Consider only frames on the same kboard
1351 and only those with minibuffers. */
1352 if (FRAME_KBOARD (f) == FRAME_KBOARD (f1)
1353 && FRAME_HAS_MINIBUF_P (f1))
1355 frame_with_minibuf = this;
1356 if (FRAME_MINIBUF_ONLY_P (f1))
1357 break;
1360 if (FRAME_KBOARD (f) == FRAME_KBOARD (f1))
1361 frame_on_same_kboard = this;
1364 if (!NILP (frame_on_same_kboard))
1366 /* We know that there must be some frame with a minibuffer out
1367 there. If this were not true, all of the frames present
1368 would have to be minibufferless, which implies that at some
1369 point their minibuffer frames must have been deleted, but
1370 that is prohibited at the top; you can't delete surrogate
1371 minibuffer frames. */
1372 if (NILP (frame_with_minibuf))
1373 abort ();
1375 FRAME_KBOARD (f)->Vdefault_minibuffer_frame = frame_with_minibuf;
1377 else
1378 /* No frames left on this kboard--say no minibuffer either. */
1379 FRAME_KBOARD (f)->Vdefault_minibuffer_frame = Qnil;
1382 /* Cause frame titles to update--necessary if we now have just one frame. */
1383 update_mode_lines = 1;
1385 return Qnil;
1388 /* Return mouse position in character cell units. */
1390 DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0,
1391 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1392 The position is given in character cells, where (0, 0) is the
1393 upper-left corner.
1394 If Emacs is running on a mouseless terminal or hasn't been programmed
1395 to read the mouse position, it returns the selected frame for FRAME
1396 and nil for X and Y.
1397 If `mouse-position-function' is non-nil, `mouse-position' calls it,
1398 passing the normal return value to that function as an argument,
1399 and returns whatever that function returns. */)
1402 FRAME_PTR f;
1403 Lisp_Object lispy_dummy;
1404 enum scroll_bar_part party_dummy;
1405 Lisp_Object x, y, retval;
1406 int col, row;
1407 unsigned long long_dummy;
1408 struct gcpro gcpro1;
1410 f = SELECTED_FRAME ();
1411 x = y = Qnil;
1413 #ifdef HAVE_MOUSE
1414 /* It's okay for the hook to refrain from storing anything. */
1415 if (mouse_position_hook)
1416 (*mouse_position_hook) (&f, -1,
1417 &lispy_dummy, &party_dummy,
1418 &x, &y,
1419 &long_dummy);
1420 if (! NILP (x))
1422 col = XINT (x);
1423 row = XINT (y);
1424 pixel_to_glyph_coords (f, col, row, &col, &row, NULL, 1);
1425 XSETINT (x, col);
1426 XSETINT (y, row);
1428 #endif
1429 XSETFRAME (lispy_dummy, f);
1430 retval = Fcons (lispy_dummy, Fcons (x, y));
1431 GCPRO1 (retval);
1432 if (!NILP (Vmouse_position_function))
1433 retval = call1 (Vmouse_position_function, retval);
1434 RETURN_UNGCPRO (retval);
1437 DEFUN ("mouse-pixel-position", Fmouse_pixel_position,
1438 Smouse_pixel_position, 0, 0, 0,
1439 doc: /* Return a list (FRAME X . Y) giving the current mouse frame and position.
1440 The position is given in pixel units, where (0, 0) is the
1441 upper-left corner.
1442 If Emacs is running on a mouseless terminal or hasn't been programmed
1443 to read the mouse position, it returns the selected frame for FRAME
1444 and nil for X and Y. */)
1447 FRAME_PTR f;
1448 Lisp_Object lispy_dummy;
1449 enum scroll_bar_part party_dummy;
1450 Lisp_Object x, y;
1451 unsigned long long_dummy;
1453 f = SELECTED_FRAME ();
1454 x = y = Qnil;
1456 #ifdef HAVE_MOUSE
1457 /* It's okay for the hook to refrain from storing anything. */
1458 if (mouse_position_hook)
1459 (*mouse_position_hook) (&f, -1,
1460 &lispy_dummy, &party_dummy,
1461 &x, &y,
1462 &long_dummy);
1463 #endif
1464 XSETFRAME (lispy_dummy, f);
1465 return Fcons (lispy_dummy, Fcons (x, y));
1468 DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0,
1469 doc: /* Move the mouse pointer to the center of character cell (X,Y) in FRAME.
1470 Coordinates are relative to the frame, not a window,
1471 so the coordinates of the top left character in the frame
1472 may be nonzero due to left-hand scroll bars or the menu bar.
1474 This function is a no-op for an X frame that is not visible.
1475 If you have just created a frame, you must wait for it to become visible
1476 before calling this function on it, like this.
1477 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1478 (frame, x, y)
1479 Lisp_Object frame, x, y;
1481 CHECK_LIVE_FRAME (frame);
1482 CHECK_NUMBER (x);
1483 CHECK_NUMBER (y);
1485 /* I think this should be done with a hook. */
1486 #ifdef HAVE_WINDOW_SYSTEM
1487 if (FRAME_WINDOW_P (XFRAME (frame)))
1488 /* Warping the mouse will cause enternotify and focus events. */
1489 x_set_mouse_position (XFRAME (frame), XINT (x), XINT (y));
1490 #else
1491 #if defined (MSDOS) && defined (HAVE_MOUSE)
1492 if (FRAME_MSDOS_P (XFRAME (frame)))
1494 Fselect_frame (frame, Qnil);
1495 mouse_moveto (XINT (x), XINT (y));
1497 #endif
1498 #endif
1500 return Qnil;
1503 DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position,
1504 Sset_mouse_pixel_position, 3, 3, 0,
1505 doc: /* Move the mouse pointer to pixel position (X,Y) in FRAME.
1506 Note, this is a no-op for an X frame that is not visible.
1507 If you have just created a frame, you must wait for it to become visible
1508 before calling this function on it, like this.
1509 (while (not (frame-visible-p frame)) (sleep-for .5)) */)
1510 (frame, x, y)
1511 Lisp_Object frame, x, y;
1513 CHECK_LIVE_FRAME (frame);
1514 CHECK_NUMBER (x);
1515 CHECK_NUMBER (y);
1517 /* I think this should be done with a hook. */
1518 #ifdef HAVE_WINDOW_SYSTEM
1519 if (FRAME_WINDOW_P (XFRAME (frame)))
1520 /* Warping the mouse will cause enternotify and focus events. */
1521 x_set_mouse_pixel_position (XFRAME (frame), XINT (x), XINT (y));
1522 #else
1523 #if defined (MSDOS) && defined (HAVE_MOUSE)
1524 if (FRAME_MSDOS_P (XFRAME (frame)))
1526 Fselect_frame (frame, Qnil);
1527 mouse_moveto (XINT (x), XINT (y));
1529 #endif
1530 #endif
1532 return Qnil;
1535 static void make_frame_visible_1 P_ ((Lisp_Object));
1537 DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible,
1538 0, 1, "",
1539 doc: /* Make the frame FRAME visible (assuming it is an X window).
1540 If omitted, FRAME defaults to the currently selected frame. */)
1541 (frame)
1542 Lisp_Object frame;
1544 if (NILP (frame))
1545 frame = selected_frame;
1547 CHECK_LIVE_FRAME (frame);
1549 /* I think this should be done with a hook. */
1550 #ifdef HAVE_WINDOW_SYSTEM
1551 if (FRAME_WINDOW_P (XFRAME (frame)))
1553 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1554 x_make_frame_visible (XFRAME (frame));
1556 #endif
1558 make_frame_visible_1 (XFRAME (frame)->root_window);
1560 /* Make menu bar update for the Buffers and Frames menus. */
1561 windows_or_buffers_changed++;
1563 return frame;
1566 /* Update the display_time slot of the buffers shown in WINDOW
1567 and all its descendents. */
1569 static void
1570 make_frame_visible_1 (window)
1571 Lisp_Object window;
1573 struct window *w;
1575 for (;!NILP (window); window = w->next)
1577 w = XWINDOW (window);
1579 if (!NILP (w->buffer))
1580 XBUFFER (w->buffer)->display_time = Fcurrent_time ();
1582 if (!NILP (w->vchild))
1583 make_frame_visible_1 (w->vchild);
1584 if (!NILP (w->hchild))
1585 make_frame_visible_1 (w->hchild);
1589 DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible,
1590 0, 2, "",
1591 doc: /* Make the frame FRAME invisible (assuming it is an X window).
1592 If omitted, FRAME defaults to the currently selected frame.
1593 Normally you may not make FRAME invisible if all other frames are invisible,
1594 but if the second optional argument FORCE is non-nil, you may do so. */)
1595 (frame, force)
1596 Lisp_Object frame, force;
1598 if (NILP (frame))
1599 frame = selected_frame;
1601 CHECK_LIVE_FRAME (frame);
1603 if (NILP (force) && !other_visible_frames (XFRAME (frame)))
1604 error ("Attempt to make invisible the sole visible or iconified frame");
1606 #if 0 /* This isn't logically necessary, and it can do GC. */
1607 /* Don't let the frame remain selected. */
1608 if (EQ (frame, selected_frame))
1609 do_switch_frame (next_frame (frame, Qt), 0, 0)
1610 #endif
1612 /* Don't allow minibuf_window to remain on a deleted frame. */
1613 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1615 struct frame *sf = XFRAME (selected_frame);
1616 Fset_window_buffer (sf->minibuffer_window,
1617 XWINDOW (minibuf_window)->buffer, Qnil);
1618 minibuf_window = sf->minibuffer_window;
1621 /* I think this should be done with a hook. */
1622 #ifdef HAVE_WINDOW_SYSTEM
1623 if (FRAME_WINDOW_P (XFRAME (frame)))
1624 x_make_frame_invisible (XFRAME (frame));
1625 #endif
1627 /* Make menu bar update for the Buffers and Frames menus. */
1628 windows_or_buffers_changed++;
1630 return Qnil;
1633 DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame,
1634 0, 1, "",
1635 doc: /* Make the frame FRAME into an icon.
1636 If omitted, FRAME defaults to the currently selected frame. */)
1637 (frame)
1638 Lisp_Object frame;
1640 if (NILP (frame))
1641 frame = selected_frame;
1643 CHECK_LIVE_FRAME (frame);
1645 #if 0 /* This isn't logically necessary, and it can do GC. */
1646 /* Don't let the frame remain selected. */
1647 if (EQ (frame, selected_frame))
1648 Fhandle_switch_frame (next_frame (frame, Qt), Qnil);
1649 #endif
1651 /* Don't allow minibuf_window to remain on a deleted frame. */
1652 if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
1654 struct frame *sf = XFRAME (selected_frame);
1655 Fset_window_buffer (sf->minibuffer_window,
1656 XWINDOW (minibuf_window)->buffer, Qnil);
1657 minibuf_window = sf->minibuffer_window;
1660 /* I think this should be done with a hook. */
1661 #ifdef HAVE_WINDOW_SYSTEM
1662 if (FRAME_WINDOW_P (XFRAME (frame)))
1663 x_iconify_frame (XFRAME (frame));
1664 #endif
1666 /* Make menu bar update for the Buffers and Frames menus. */
1667 windows_or_buffers_changed++;
1669 return Qnil;
1672 DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p,
1673 1, 1, 0,
1674 doc: /* Return t if FRAME is now \"visible\" (actually in use for display).
1675 A frame that is not \"visible\" is not updated and, if it works through
1676 a window system, it may not show at all.
1677 Return the symbol `icon' if frame is visible only as an icon. */)
1678 (frame)
1679 Lisp_Object frame;
1681 CHECK_LIVE_FRAME (frame);
1683 FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
1685 if (FRAME_VISIBLE_P (XFRAME (frame)))
1686 return Qt;
1687 if (FRAME_ICONIFIED_P (XFRAME (frame)))
1688 return Qicon;
1689 return Qnil;
1692 DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list,
1693 0, 0, 0,
1694 doc: /* Return a list of all frames now \"visible\" (being updated). */)
1697 Lisp_Object tail, frame;
1698 struct frame *f;
1699 Lisp_Object value;
1701 value = Qnil;
1702 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1704 frame = XCAR (tail);
1705 if (!FRAMEP (frame))
1706 continue;
1707 f = XFRAME (frame);
1708 if (FRAME_VISIBLE_P (f))
1709 value = Fcons (frame, value);
1711 return value;
1715 DEFUN ("raise-frame", Fraise_frame, Sraise_frame, 0, 1, "",
1716 doc: /* Bring FRAME to the front, so it occludes any frames it overlaps.
1717 If FRAME is invisible, make it visible.
1718 If you don't specify a frame, the selected frame is used.
1719 If Emacs is displaying on an ordinary terminal or some other device which
1720 doesn't support multiple overlapping frames, this function does nothing. */)
1721 (frame)
1722 Lisp_Object frame;
1724 if (NILP (frame))
1725 frame = selected_frame;
1727 CHECK_LIVE_FRAME (frame);
1729 /* Do like the documentation says. */
1730 Fmake_frame_visible (frame);
1732 if (frame_raise_lower_hook)
1733 (*frame_raise_lower_hook) (XFRAME (frame), 1);
1735 return Qnil;
1738 /* Should we have a corresponding function called Flower_Power? */
1739 DEFUN ("lower-frame", Flower_frame, Slower_frame, 0, 1, "",
1740 doc: /* Send FRAME to the back, so it is occluded by any frames that overlap it.
1741 If you don't specify a frame, the selected frame is used.
1742 If Emacs is displaying on an ordinary terminal or some other device which
1743 doesn't support multiple overlapping frames, this function does nothing. */)
1744 (frame)
1745 Lisp_Object frame;
1747 if (NILP (frame))
1748 frame = selected_frame;
1750 CHECK_LIVE_FRAME (frame);
1752 if (frame_raise_lower_hook)
1753 (*frame_raise_lower_hook) (XFRAME (frame), 0);
1755 return Qnil;
1759 DEFUN ("redirect-frame-focus", Fredirect_frame_focus, Sredirect_frame_focus,
1760 1, 2, 0,
1761 doc: /* Arrange for keystrokes typed at FRAME to be sent to FOCUS-FRAME.
1762 In other words, switch-frame events caused by events in FRAME will
1763 request a switch to FOCUS-FRAME, and `last-event-frame' will be
1764 FOCUS-FRAME after reading an event typed at FRAME.
1766 If FOCUS-FRAME is omitted or nil, any existing redirection is
1767 cancelled, and the frame again receives its own keystrokes.
1769 Focus redirection is useful for temporarily redirecting keystrokes to
1770 a surrogate minibuffer frame when a frame doesn't have its own
1771 minibuffer window.
1773 A frame's focus redirection can be changed by select-frame. If frame
1774 FOO is selected, and then a different frame BAR is selected, any
1775 frames redirecting their focus to FOO are shifted to redirect their
1776 focus to BAR. This allows focus redirection to work properly when the
1777 user switches from one frame to another using `select-window'.
1779 This means that a frame whose focus is redirected to itself is treated
1780 differently from a frame whose focus is redirected to nil; the former
1781 is affected by select-frame, while the latter is not.
1783 The redirection lasts until `redirect-frame-focus' is called to change it. */)
1784 (frame, focus_frame)
1785 Lisp_Object frame, focus_frame;
1787 /* Note that we don't check for a live frame here. It's reasonable
1788 to redirect the focus of a frame you're about to delete, if you
1789 know what other frame should receive those keystrokes. */
1790 CHECK_FRAME (frame);
1792 if (! NILP (focus_frame))
1793 CHECK_LIVE_FRAME (focus_frame);
1795 XFRAME (frame)->focus_frame = focus_frame;
1797 if (frame_rehighlight_hook)
1798 (*frame_rehighlight_hook) (XFRAME (frame));
1800 return Qnil;
1804 DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 1, 1, 0,
1805 doc: /* Return the frame to which FRAME's keystrokes are currently being sent.
1806 This returns nil if FRAME's focus is not redirected.
1807 See `redirect-frame-focus'. */)
1808 (frame)
1809 Lisp_Object frame;
1811 CHECK_LIVE_FRAME (frame);
1813 return FRAME_FOCUS_FRAME (XFRAME (frame));
1818 /* Return the value of frame parameter PROP in frame FRAME. */
1820 Lisp_Object
1821 get_frame_param (frame, prop)
1822 register struct frame *frame;
1823 Lisp_Object prop;
1825 register Lisp_Object tem;
1827 tem = Fassq (prop, frame->param_alist);
1828 if (EQ (tem, Qnil))
1829 return tem;
1830 return Fcdr (tem);
1833 /* Return the buffer-predicate of the selected frame. */
1835 Lisp_Object
1836 frame_buffer_predicate (frame)
1837 Lisp_Object frame;
1839 return XFRAME (frame)->buffer_predicate;
1842 /* Return the buffer-list of the selected frame. */
1844 Lisp_Object
1845 frame_buffer_list (frame)
1846 Lisp_Object frame;
1848 return XFRAME (frame)->buffer_list;
1851 /* Set the buffer-list of the selected frame. */
1853 void
1854 set_frame_buffer_list (frame, list)
1855 Lisp_Object frame, list;
1857 XFRAME (frame)->buffer_list = list;
1860 /* Discard BUFFER from the buffer-list of each frame. */
1862 void
1863 frames_discard_buffer (buffer)
1864 Lisp_Object buffer;
1866 Lisp_Object frame, tail;
1868 FOR_EACH_FRAME (tail, frame)
1870 XFRAME (frame)->buffer_list
1871 = Fdelq (buffer, XFRAME (frame)->buffer_list);
1875 /* Modify the alist in *ALISTPTR to associate PROP with VAL.
1876 If the alist already has an element for PROP, we change it. */
1878 void
1879 store_in_alist (alistptr, prop, val)
1880 Lisp_Object *alistptr, val;
1881 Lisp_Object prop;
1883 register Lisp_Object tem;
1885 tem = Fassq (prop, *alistptr);
1886 if (EQ (tem, Qnil))
1887 *alistptr = Fcons (Fcons (prop, val), *alistptr);
1888 else
1889 Fsetcdr (tem, val);
1892 static int
1893 frame_name_fnn_p (str, len)
1894 char *str;
1895 int len;
1897 if (len > 1 && str[0] == 'F')
1899 char *end_ptr;
1901 strtol (str + 1, &end_ptr, 10);
1903 if (end_ptr == str + len)
1904 return 1;
1906 return 0;
1909 /* Set the name of the terminal frame. Also used by MSDOS frames.
1910 Modeled after x_set_name which is used for WINDOW frames. */
1912 void
1913 set_term_frame_name (f, name)
1914 struct frame *f;
1915 Lisp_Object name;
1917 f->explicit_name = ! NILP (name);
1919 /* If NAME is nil, set the name to F<num>. */
1920 if (NILP (name))
1922 char namebuf[20];
1924 /* Check for no change needed in this very common case
1925 before we do any consing. */
1926 if (frame_name_fnn_p (SDATA (f->name),
1927 SBYTES (f->name)))
1928 return;
1930 terminal_frame_count++;
1931 sprintf (namebuf, "F%d", terminal_frame_count);
1932 name = build_string (namebuf);
1934 else
1936 CHECK_STRING (name);
1938 /* Don't change the name if it's already NAME. */
1939 if (! NILP (Fstring_equal (name, f->name)))
1940 return;
1942 /* Don't allow the user to set the frame name to F<num>, so it
1943 doesn't clash with the names we generate for terminal frames. */
1944 if (frame_name_fnn_p (SDATA (name), SBYTES (name)))
1945 error ("Frame names of the form F<num> are usurped by Emacs");
1948 f->name = name;
1949 update_mode_lines = 1;
1952 void
1953 store_frame_param (f, prop, val)
1954 struct frame *f;
1955 Lisp_Object prop, val;
1957 register Lisp_Object old_alist_elt;
1959 /* The buffer-alist parameter is stored in a special place and is
1960 not in the alist. */
1961 if (EQ (prop, Qbuffer_list))
1963 f->buffer_list = val;
1964 return;
1967 /* If PROP is a symbol which is supposed to have frame-local values,
1968 and it is set up based on this frame, switch to the global
1969 binding. That way, we can create or alter the frame-local binding
1970 without messing up the symbol's status. */
1971 if (SYMBOLP (prop))
1973 Lisp_Object valcontents;
1974 valcontents = SYMBOL_VALUE (prop);
1975 if ((BUFFER_LOCAL_VALUEP (valcontents)
1976 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
1977 && XBUFFER_LOCAL_VALUE (valcontents)->check_frame
1978 && XFRAME (XBUFFER_LOCAL_VALUE (valcontents)->frame) == f)
1979 swap_in_global_binding (prop);
1982 #ifndef WINDOWSNT
1983 /* The tty color mode needs to be set before the frame's parameter
1984 alist is updated with the new value, because set_tty_color_mode
1985 wants to look at the old mode. */
1986 if (FRAME_TERMCAP_P (f) && EQ (prop, Qtty_color_mode))
1987 set_tty_color_mode (f, val);
1988 #endif
1990 /* Update the frame parameter alist. */
1991 old_alist_elt = Fassq (prop, f->param_alist);
1992 if (EQ (old_alist_elt, Qnil))
1993 f->param_alist = Fcons (Fcons (prop, val), f->param_alist);
1994 else
1995 Fsetcdr (old_alist_elt, val);
1997 /* Update some other special parameters in their special places
1998 in addition to the alist. */
2000 if (EQ (prop, Qbuffer_predicate))
2001 f->buffer_predicate = val;
2003 if (! FRAME_WINDOW_P (f))
2005 if (EQ (prop, Qmenu_bar_lines))
2006 set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f)));
2007 else if (EQ (prop, Qname))
2008 set_term_frame_name (f, val);
2011 if (EQ (prop, Qminibuffer) && WINDOWP (val))
2013 if (! MINI_WINDOW_P (XWINDOW (val)))
2014 error ("Surrogate minibuffer windows must be minibuffer windows.");
2016 if ((FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
2017 && !EQ (val, f->minibuffer_window))
2018 error ("Can't change the surrogate minibuffer of a frame with its own minibuffer");
2020 /* Install the chosen minibuffer window, with proper buffer. */
2021 f->minibuffer_window = val;
2025 DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0,
2026 doc: /* Return the parameters-alist of frame FRAME.
2027 It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
2028 The meaningful PARMs depend on the kind of frame.
2029 If FRAME is omitted, return information on the currently selected frame. */)
2030 (frame)
2031 Lisp_Object frame;
2033 Lisp_Object alist;
2034 FRAME_PTR f;
2035 int height, width;
2036 struct gcpro gcpro1;
2038 if (NILP (frame))
2039 frame = selected_frame;
2041 CHECK_FRAME (frame);
2042 f = XFRAME (frame);
2044 if (!FRAME_LIVE_P (f))
2045 return Qnil;
2047 alist = Fcopy_alist (f->param_alist);
2048 GCPRO1 (alist);
2050 if (!FRAME_WINDOW_P (f))
2052 int fg = FRAME_FOREGROUND_PIXEL (f);
2053 int bg = FRAME_BACKGROUND_PIXEL (f);
2054 Lisp_Object elt;
2056 /* If the frame's parameter alist says the colors are
2057 unspecified and reversed, take the frame's background pixel
2058 for foreground and vice versa. */
2059 elt = Fassq (Qforeground_color, alist);
2060 if (!NILP (elt) && CONSP (elt) && STRINGP (XCDR (elt)))
2062 if (strncmp (SDATA (XCDR (elt)),
2063 unspecified_bg,
2064 SCHARS (XCDR (elt))) == 0)
2065 store_in_alist (&alist, Qforeground_color, tty_color_name (f, bg));
2066 else if (strncmp (SDATA (XCDR (elt)),
2067 unspecified_fg,
2068 SCHARS (XCDR (elt))) == 0)
2069 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2071 else
2072 store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
2073 elt = Fassq (Qbackground_color, alist);
2074 if (!NILP (elt) && CONSP (elt) && STRINGP (XCDR (elt)))
2076 if (strncmp (SDATA (XCDR (elt)),
2077 unspecified_fg,
2078 SCHARS (XCDR (elt))) == 0)
2079 store_in_alist (&alist, Qbackground_color, tty_color_name (f, fg));
2080 else if (strncmp (SDATA (XCDR (elt)),
2081 unspecified_bg,
2082 SCHARS (XCDR (elt))) == 0)
2083 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2085 else
2086 store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
2087 store_in_alist (&alist, intern ("font"),
2088 build_string (FRAME_MSDOS_P (f)
2089 ? "ms-dos"
2090 : FRAME_W32_P (f) ? "w32term"
2091 :"tty"));
2093 store_in_alist (&alist, Qname, f->name);
2094 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2095 store_in_alist (&alist, Qheight, make_number (height));
2096 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2097 store_in_alist (&alist, Qwidth, make_number (width));
2098 store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil));
2099 store_in_alist (&alist, Qminibuffer,
2100 (! FRAME_HAS_MINIBUF_P (f) ? Qnil
2101 : FRAME_MINIBUF_ONLY_P (f) ? Qonly
2102 : FRAME_MINIBUF_WINDOW (f)));
2103 store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
2104 store_in_alist (&alist, Qbuffer_list, frame_buffer_list (frame));
2106 /* I think this should be done with a hook. */
2107 #ifdef HAVE_WINDOW_SYSTEM
2108 if (FRAME_WINDOW_P (f))
2109 x_report_frame_params (f, &alist);
2110 else
2111 #endif
2113 /* This ought to be correct in f->param_alist for an X frame. */
2114 Lisp_Object lines;
2115 XSETFASTINT (lines, FRAME_MENU_BAR_LINES (f));
2116 store_in_alist (&alist, Qmenu_bar_lines, lines);
2119 UNGCPRO;
2120 return alist;
2124 DEFUN ("frame-parameter", Fframe_parameter, Sframe_parameter, 2, 2, 0,
2125 doc: /* Return FRAME's value for parameter PARAMETER.
2126 If FRAME is nil, describe the currently selected frame. */)
2127 (frame, parameter)
2128 Lisp_Object frame, parameter;
2130 struct frame *f;
2131 Lisp_Object value;
2133 if (NILP (frame))
2134 frame = selected_frame;
2135 else
2136 CHECK_FRAME (frame);
2137 CHECK_SYMBOL (parameter);
2139 f = XFRAME (frame);
2140 value = Qnil;
2142 if (FRAME_LIVE_P (f))
2144 /* Avoid consing in frequent cases. */
2145 if (EQ (parameter, Qname))
2146 value = f->name;
2147 #ifdef HAVE_X_WINDOWS
2148 else if (EQ (parameter, Qdisplay) && FRAME_X_P (f))
2149 value = XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element);
2150 #endif /* HAVE_X_WINDOWS */
2151 else if (EQ (parameter, Qbackground_color)
2152 || EQ (parameter, Qforeground_color))
2154 value = Fassq (parameter, f->param_alist);
2155 if (CONSP (value))
2157 value = XCDR (value);
2158 /* Fframe_parameters puts the actual fg/bg color names,
2159 even if f->param_alist says otherwise. This is
2160 important when param_alist's notion of colors is
2161 "unspecified". We need to do the same here. */
2162 if (STRINGP (value) && !FRAME_WINDOW_P (f))
2164 const char *color_name;
2165 EMACS_INT csz;
2167 if (EQ (parameter, Qbackground_color))
2169 color_name = SDATA (value);
2170 csz = SCHARS (value);
2171 if (strncmp (color_name, unspecified_bg, csz) == 0)
2172 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2173 else if (strncmp (color_name, unspecified_fg, csz) == 0)
2174 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2176 else if (EQ (parameter, Qforeground_color))
2178 color_name = SDATA (value);
2179 csz = SCHARS (value);
2180 if (strncmp (color_name, unspecified_fg, csz) == 0)
2181 value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
2182 else if (strncmp (color_name, unspecified_bg, csz) == 0)
2183 value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
2187 else
2188 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2190 else if (EQ (parameter, Qdisplay_type)
2191 || EQ (parameter, Qbackground_mode))
2192 value = Fcdr (Fassq (parameter, f->param_alist));
2193 else
2194 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2197 return value;
2201 DEFUN ("modify-frame-parameters", Fmodify_frame_parameters,
2202 Smodify_frame_parameters, 2, 2, 0,
2203 doc: /* Modify the parameters of frame FRAME according to ALIST.
2204 If FRAME is nil, it defaults to the selected frame.
2205 ALIST is an alist of parameters to change and their new values.
2206 Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.
2207 The meaningful PARMs depend on the kind of frame.
2208 Undefined PARMs are ignored, but stored in the frame's parameter list
2209 so that `frame-parameters' will return them.
2211 The value of frame parameter FOO can also be accessed
2212 as a frame-local binding for the variable FOO, if you have
2213 enabled such bindings for that variable with `make-variable-frame-local'. */)
2214 (frame, alist)
2215 Lisp_Object frame, alist;
2217 FRAME_PTR f;
2218 register Lisp_Object tail, prop, val;
2219 int count = SPECPDL_INDEX ();
2221 /* Bind this to t to inhibit initialization of the default face from
2222 X resources in face-set-after-frame-default. If we don't inhibit
2223 this, modifying the `font' frame parameter, for example, while
2224 there is a `default.attributeFont' X resource, won't work,
2225 because `default's font is reset to the value of the X resource
2226 and that resets the `font' frame parameter. */
2227 specbind (Qinhibit_default_face_x_resources, Qt);
2229 if (EQ (frame, Qnil))
2230 frame = selected_frame;
2231 CHECK_LIVE_FRAME (frame);
2232 f = XFRAME (frame);
2234 /* I think this should be done with a hook. */
2235 #ifdef HAVE_WINDOW_SYSTEM
2236 if (FRAME_WINDOW_P (f))
2237 x_set_frame_parameters (f, alist);
2238 else
2239 #endif
2240 #ifdef MSDOS
2241 if (FRAME_MSDOS_P (f))
2242 IT_set_frame_parameters (f, alist);
2243 else
2244 #endif
2247 int length = XINT (Flength (alist));
2248 int i;
2249 Lisp_Object *parms
2250 = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
2251 Lisp_Object *values
2252 = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
2254 /* Extract parm names and values into those vectors. */
2256 i = 0;
2257 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
2259 Lisp_Object elt;
2261 elt = Fcar (tail);
2262 parms[i] = Fcar (elt);
2263 values[i] = Fcdr (elt);
2264 i++;
2267 /* Now process them in reverse of specified order. */
2268 for (i--; i >= 0; i--)
2270 prop = parms[i];
2271 val = values[i];
2272 store_frame_param (f, prop, val);
2276 return unbind_to (count, Qnil);
2279 DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height,
2280 0, 1, 0,
2281 doc: /* Height in pixels of a line in the font in frame FRAME.
2282 If FRAME is omitted, the selected frame is used.
2283 For a terminal frame, the value is always 1. */)
2284 (frame)
2285 Lisp_Object frame;
2287 struct frame *f;
2289 if (NILP (frame))
2290 frame = selected_frame;
2291 CHECK_FRAME (frame);
2292 f = XFRAME (frame);
2294 #ifdef HAVE_WINDOW_SYSTEM
2295 if (FRAME_WINDOW_P (f))
2296 return make_number (x_char_height (f));
2297 else
2298 #endif
2299 return make_number (1);
2303 DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width,
2304 0, 1, 0,
2305 doc: /* Width in pixels of characters in the font in frame FRAME.
2306 If FRAME is omitted, the selected frame is used.
2307 The width is the same for all characters, because
2308 currently Emacs supports only fixed-width fonts.
2309 For a terminal screen, the value is always 1. */)
2310 (frame)
2311 Lisp_Object frame;
2313 struct frame *f;
2315 if (NILP (frame))
2316 frame = selected_frame;
2317 CHECK_FRAME (frame);
2318 f = XFRAME (frame);
2320 #ifdef HAVE_WINDOW_SYSTEM
2321 if (FRAME_WINDOW_P (f))
2322 return make_number (x_char_width (f));
2323 else
2324 #endif
2325 return make_number (1);
2328 DEFUN ("frame-pixel-height", Fframe_pixel_height,
2329 Sframe_pixel_height, 0, 1, 0,
2330 doc: /* Return a FRAME's height in pixels.
2331 This counts only the height available for text lines,
2332 not menu bars on window-system Emacs frames.
2333 For a terminal frame, the result really gives the height in characters.
2334 If FRAME is omitted, the selected frame is used. */)
2335 (frame)
2336 Lisp_Object frame;
2338 struct frame *f;
2340 if (NILP (frame))
2341 frame = selected_frame;
2342 CHECK_FRAME (frame);
2343 f = XFRAME (frame);
2345 #ifdef HAVE_WINDOW_SYSTEM
2346 if (FRAME_WINDOW_P (f))
2347 return make_number (x_pixel_height (f));
2348 else
2349 #endif
2350 return make_number (FRAME_LINES (f));
2353 DEFUN ("frame-pixel-width", Fframe_pixel_width,
2354 Sframe_pixel_width, 0, 1, 0,
2355 doc: /* Return FRAME's width in pixels.
2356 For a terminal frame, the result really gives the width in characters.
2357 If FRAME is omitted, the selected frame is used. */)
2358 (frame)
2359 Lisp_Object frame;
2361 struct frame *f;
2363 if (NILP (frame))
2364 frame = selected_frame;
2365 CHECK_FRAME (frame);
2366 f = XFRAME (frame);
2368 #ifdef HAVE_WINDOW_SYSTEM
2369 if (FRAME_WINDOW_P (f))
2370 return make_number (x_pixel_width (f));
2371 else
2372 #endif
2373 return make_number (FRAME_COLS (f));
2376 DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0,
2377 doc: /* Specify that the frame FRAME has LINES lines.
2378 Optional third arg non-nil means that redisplay should use LINES lines
2379 but that the idea of the actual height of the frame should not be changed. */)
2380 (frame, lines, pretend)
2381 Lisp_Object frame, lines, pretend;
2383 register struct frame *f;
2385 CHECK_NUMBER (lines);
2386 if (NILP (frame))
2387 frame = selected_frame;
2388 CHECK_LIVE_FRAME (frame);
2389 f = XFRAME (frame);
2391 /* I think this should be done with a hook. */
2392 #ifdef HAVE_WINDOW_SYSTEM
2393 if (FRAME_WINDOW_P (f))
2395 if (XINT (lines) != FRAME_LINES (f))
2396 x_set_window_size (f, 1, FRAME_COLS (f), XINT (lines));
2397 do_pending_window_change (0);
2399 else
2400 #endif
2401 change_frame_size (f, XINT (lines), 0, !NILP (pretend), 0, 0);
2402 return Qnil;
2405 DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 3, 0,
2406 doc: /* Specify that the frame FRAME has COLS columns.
2407 Optional third arg non-nil means that redisplay should use COLS columns
2408 but that the idea of the actual width of the frame should not be changed. */)
2409 (frame, cols, pretend)
2410 Lisp_Object frame, cols, pretend;
2412 register struct frame *f;
2413 CHECK_NUMBER (cols);
2414 if (NILP (frame))
2415 frame = selected_frame;
2416 CHECK_LIVE_FRAME (frame);
2417 f = XFRAME (frame);
2419 /* I think this should be done with a hook. */
2420 #ifdef HAVE_WINDOW_SYSTEM
2421 if (FRAME_WINDOW_P (f))
2423 if (XINT (cols) != FRAME_COLS (f))
2424 x_set_window_size (f, 1, XINT (cols), FRAME_LINES (f));
2425 do_pending_window_change (0);
2427 else
2428 #endif
2429 change_frame_size (f, 0, XINT (cols), !NILP (pretend), 0, 0);
2430 return Qnil;
2433 DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0,
2434 doc: /* Sets size of FRAME to COLS by ROWS, measured in characters. */)
2435 (frame, cols, rows)
2436 Lisp_Object frame, cols, rows;
2438 register struct frame *f;
2440 CHECK_LIVE_FRAME (frame);
2441 CHECK_NUMBER (cols);
2442 CHECK_NUMBER (rows);
2443 f = XFRAME (frame);
2445 /* I think this should be done with a hook. */
2446 #ifdef HAVE_WINDOW_SYSTEM
2447 if (FRAME_WINDOW_P (f))
2449 if (XINT (rows) != FRAME_LINES (f)
2450 || XINT (cols) != FRAME_COLS (f)
2451 || f->new_text_lines || f->new_text_cols)
2452 x_set_window_size (f, 1, XINT (cols), XINT (rows));
2453 do_pending_window_change (0);
2455 else
2456 #endif
2457 change_frame_size (f, XINT (rows), XINT (cols), 0, 0, 0);
2459 return Qnil;
2462 DEFUN ("set-frame-position", Fset_frame_position,
2463 Sset_frame_position, 3, 3, 0,
2464 doc: /* Sets position of FRAME in pixels to XOFFSET by YOFFSET.
2465 This is actually the position of the upper left corner of the frame.
2466 Negative values for XOFFSET or YOFFSET are interpreted relative to
2467 the rightmost or bottommost possible position (that stays within the screen). */)
2468 (frame, xoffset, yoffset)
2469 Lisp_Object frame, xoffset, yoffset;
2471 register struct frame *f;
2473 CHECK_LIVE_FRAME (frame);
2474 CHECK_NUMBER (xoffset);
2475 CHECK_NUMBER (yoffset);
2476 f = XFRAME (frame);
2478 /* I think this should be done with a hook. */
2479 #ifdef HAVE_WINDOW_SYSTEM
2480 if (FRAME_WINDOW_P (f))
2481 x_set_offset (f, XINT (xoffset), XINT (yoffset), 1);
2482 #endif
2484 return Qt;
2488 /***********************************************************************
2489 Frame Parameters
2490 ***********************************************************************/
2492 /* Connect the frame-parameter names for X frames
2493 to the ways of passing the parameter values to the window system.
2495 The name of a parameter, as a Lisp symbol,
2496 has an `x-frame-parameter' property which is an integer in Lisp
2497 that is an index in this table. */
2499 struct frame_parm_table {
2500 char *name;
2501 Lisp_Object *variable;
2504 static struct frame_parm_table frame_parms[] =
2506 {"auto-raise", &Qauto_raise},
2507 {"auto-lower", &Qauto_lower},
2508 {"background-color", 0},
2509 {"border-color", &Qborder_color},
2510 {"border-width", &Qborder_width},
2511 {"cursor-color", &Qcursor_color},
2512 {"cursor-type", &Qcursor_type},
2513 {"font", 0},
2514 {"foreground-color", 0},
2515 {"icon-name", &Qicon_name},
2516 {"icon-type", &Qicon_type},
2517 {"internal-border-width", &Qinternal_border_width},
2518 {"menu-bar-lines", &Qmenu_bar_lines},
2519 {"mouse-color", &Qmouse_color},
2520 {"name", &Qname},
2521 {"scroll-bar-width", &Qscroll_bar_width},
2522 {"title", &Qtitle},
2523 {"unsplittable", &Qunsplittable},
2524 {"vertical-scroll-bars", &Qvertical_scroll_bars},
2525 {"visibility", &Qvisibility},
2526 {"tool-bar-lines", &Qtool_bar_lines},
2527 {"scroll-bar-foreground", &Qscroll_bar_foreground},
2528 {"scroll-bar-background", &Qscroll_bar_background},
2529 {"screen-gamma", &Qscreen_gamma},
2530 {"line-spacing", &Qline_spacing},
2531 {"left-fringe", &Qleft_fringe},
2532 {"right-fringe", &Qright_fringe},
2533 {"wait-for-wm", &Qwait_for_wm},
2534 {"fullscreen", &Qfullscreen},
2537 #ifdef HAVE_WINDOW_SYSTEM
2539 extern Lisp_Object Qbox;
2540 extern Lisp_Object Qtop;
2542 /* Calculate fullscreen size. Return in *TOP_POS and *LEFT_POS the
2543 wanted positions of the WM window (not emacs window).
2544 Return in *WIDTH and *HEIGHT the wanted width and height of Emacs
2545 window (FRAME_X_WINDOW).
2548 void
2549 x_fullscreen_adjust (f, width, height, top_pos, left_pos)
2550 struct frame *f;
2551 int *width;
2552 int *height;
2553 int *top_pos;
2554 int *left_pos;
2556 int newwidth = FRAME_COLS (f);
2557 int newheight = FRAME_LINES (f);
2559 *top_pos = f->top_pos;
2560 *left_pos = f->left_pos;
2562 if (f->want_fullscreen & FULLSCREEN_HEIGHT)
2564 int ph;
2566 ph = FRAME_X_DISPLAY_INFO (f)->height;
2567 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2568 ph = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, newheight) - f->y_pixels_diff;
2569 newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
2570 *top_pos = 0;
2573 if (f->want_fullscreen & FULLSCREEN_WIDTH)
2575 int pw;
2577 pw = FRAME_X_DISPLAY_INFO (f)->width;
2578 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2579 pw = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, newwidth) - f->x_pixels_diff;
2580 newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
2581 *left_pos = 0;
2584 *width = newwidth;
2585 *height = newheight;
2589 /* Really try to move where we want to be in case of fullscreen. Some WMs
2590 moves the window where we tell them. Some (mwm, twm) moves the outer
2591 window manager window there instead.
2592 Try to compensate for those WM here. */
2594 static void
2595 x_fullscreen_move (f, new_top, new_left)
2596 struct frame *f;
2597 int new_top;
2598 int new_left;
2600 if (new_top != f->top_pos || new_left != f->left_pos)
2602 int move_x = new_left;
2603 int move_y = new_top;
2605 #ifdef HAVE_X_WINDOWS
2606 move_x += FRAME_X_OUTPUT (f)->x_pixels_outer_diff;
2607 move_y += FRAME_X_OUTPUT (f)->y_pixels_outer_diff;
2608 #endif
2610 f->want_fullscreen |= FULLSCREEN_MOVE_WAIT;
2611 x_set_offset (f, move_x, move_y, 1);
2615 /* Change the parameters of frame F as specified by ALIST.
2616 If a parameter is not specially recognized, do nothing special;
2617 otherwise call the `x_set_...' function for that parameter.
2618 Except for certain geometry properties, always call store_frame_param
2619 to store the new value in the parameter alist. */
2621 void
2622 x_set_frame_parameters (f, alist)
2623 FRAME_PTR f;
2624 Lisp_Object alist;
2626 Lisp_Object tail;
2628 /* If both of these parameters are present, it's more efficient to
2629 set them both at once. So we wait until we've looked at the
2630 entire list before we set them. */
2631 int width, height;
2633 /* Same here. */
2634 Lisp_Object left, top;
2636 /* Same with these. */
2637 Lisp_Object icon_left, icon_top;
2639 /* Record in these vectors all the parms specified. */
2640 Lisp_Object *parms;
2641 Lisp_Object *values;
2642 int i, p;
2643 int left_no_change = 0, top_no_change = 0;
2644 int icon_left_no_change = 0, icon_top_no_change = 0;
2645 int fullscreen_is_being_set = 0;
2647 struct gcpro gcpro1, gcpro2;
2649 i = 0;
2650 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
2651 i++;
2653 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
2654 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
2656 /* Extract parm names and values into those vectors. */
2658 i = 0;
2659 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
2661 Lisp_Object elt;
2663 elt = Fcar (tail);
2664 parms[i] = Fcar (elt);
2665 values[i] = Fcdr (elt);
2666 i++;
2668 /* TAIL and ALIST are not used again below here. */
2669 alist = tail = Qnil;
2671 GCPRO2 (*parms, *values);
2672 gcpro1.nvars = i;
2673 gcpro2.nvars = i;
2675 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
2676 because their values appear in VALUES and strings are not valid. */
2677 top = left = Qunbound;
2678 icon_left = icon_top = Qunbound;
2680 /* Provide default values for HEIGHT and WIDTH. */
2681 width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
2682 height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
2684 /* Process foreground_color and background_color before anything else.
2685 They are independent of other properties, but other properties (e.g.,
2686 cursor_color) are dependent upon them. */
2687 /* Process default font as well, since fringe widths depends on it. */
2688 /* Also, process fullscreen, width and height depend upon that */
2689 for (p = 0; p < i; p++)
2691 Lisp_Object prop, val;
2693 prop = parms[p];
2694 val = values[p];
2695 if (EQ (prop, Qforeground_color)
2696 || EQ (prop, Qbackground_color)
2697 || EQ (prop, Qfont)
2698 || EQ (prop, Qfullscreen))
2700 register Lisp_Object param_index, old_value;
2702 old_value = get_frame_param (f, prop);
2703 fullscreen_is_being_set |= EQ (prop, Qfullscreen);
2705 if (NILP (Fequal (val, old_value)))
2707 store_frame_param (f, prop, val);
2709 param_index = Fget (prop, Qx_frame_parameter);
2710 if (NATNUMP (param_index)
2711 && (XFASTINT (param_index)
2712 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2713 && rif->frame_parm_handlers[XINT (param_index)])
2714 (*(rif->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2719 /* Now process them in reverse of specified order. */
2720 for (i--; i >= 0; i--)
2722 Lisp_Object prop, val;
2724 prop = parms[i];
2725 val = values[i];
2727 if (EQ (prop, Qwidth) && NUMBERP (val))
2728 width = XFASTINT (val);
2729 else if (EQ (prop, Qheight) && NUMBERP (val))
2730 height = XFASTINT (val);
2731 else if (EQ (prop, Qtop))
2732 top = val;
2733 else if (EQ (prop, Qleft))
2734 left = val;
2735 else if (EQ (prop, Qicon_top))
2736 icon_top = val;
2737 else if (EQ (prop, Qicon_left))
2738 icon_left = val;
2739 else if (EQ (prop, Qforeground_color)
2740 || EQ (prop, Qbackground_color)
2741 || EQ (prop, Qfont)
2742 || EQ (prop, Qfullscreen))
2743 /* Processed above. */
2744 continue;
2745 else
2747 register Lisp_Object param_index, old_value;
2749 old_value = get_frame_param (f, prop);
2751 store_frame_param (f, prop, val);
2753 param_index = Fget (prop, Qx_frame_parameter);
2754 if (NATNUMP (param_index)
2755 && (XFASTINT (param_index)
2756 < sizeof (frame_parms)/sizeof (frame_parms[0]))
2757 && rif->frame_parm_handlers[XINT (param_index)])
2758 (*(rif->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
2762 /* Don't die if just one of these was set. */
2763 if (EQ (left, Qunbound))
2765 left_no_change = 1;
2766 if (f->left_pos < 0)
2767 left = Fcons (Qplus, Fcons (make_number (f->left_pos), Qnil));
2768 else
2769 XSETINT (left, f->left_pos);
2771 if (EQ (top, Qunbound))
2773 top_no_change = 1;
2774 if (f->top_pos < 0)
2775 top = Fcons (Qplus, Fcons (make_number (f->top_pos), Qnil));
2776 else
2777 XSETINT (top, f->top_pos);
2780 /* If one of the icon positions was not set, preserve or default it. */
2781 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
2783 icon_left_no_change = 1;
2784 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
2785 if (NILP (icon_left))
2786 XSETINT (icon_left, 0);
2788 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
2790 icon_top_no_change = 1;
2791 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
2792 if (NILP (icon_top))
2793 XSETINT (icon_top, 0);
2796 #ifndef HAVE_CARBON
2797 /* MAC_TODO: fullscreen */
2798 if (FRAME_VISIBLE_P (f) && fullscreen_is_being_set)
2800 /* If the frame is visible already and the fullscreen parameter is
2801 being set, it is too late to set WM manager hints to specify
2802 size and position.
2803 Here we first get the width, height and position that applies to
2804 fullscreen. We then move the frame to the appropriate
2805 position. Resize of the frame is taken care of in the code after
2806 this if-statement. */
2807 int new_left, new_top;
2809 x_fullscreen_adjust (f, &width, &height, &new_top, &new_left);
2810 x_fullscreen_move (f, new_top, new_left);
2812 #endif
2814 /* Don't set these parameters unless they've been explicitly
2815 specified. The window might be mapped or resized while we're in
2816 this function, and we don't want to override that unless the lisp
2817 code has asked for it.
2819 Don't set these parameters unless they actually differ from the
2820 window's current parameters; the window may not actually exist
2821 yet. */
2823 Lisp_Object frame;
2825 check_frame_size (f, &height, &width);
2827 XSETFRAME (frame, f);
2829 if (width != FRAME_COLS (f)
2830 || height != FRAME_LINES (f)
2831 || f->new_text_lines || f->new_text_cols)
2832 Fset_frame_size (frame, make_number (width), make_number (height));
2834 if ((!NILP (left) || !NILP (top))
2835 && ! (left_no_change && top_no_change)
2836 && ! (NUMBERP (left) && XINT (left) == f->left_pos
2837 && NUMBERP (top) && XINT (top) == f->top_pos))
2839 int leftpos = 0;
2840 int toppos = 0;
2842 /* Record the signs. */
2843 f->size_hint_flags &= ~ (XNegative | YNegative);
2844 if (EQ (left, Qminus))
2845 f->size_hint_flags |= XNegative;
2846 else if (INTEGERP (left))
2848 leftpos = XINT (left);
2849 if (leftpos < 0)
2850 f->size_hint_flags |= XNegative;
2852 else if (CONSP (left) && EQ (XCAR (left), Qminus)
2853 && CONSP (XCDR (left))
2854 && INTEGERP (XCAR (XCDR (left))))
2856 leftpos = - XINT (XCAR (XCDR (left)));
2857 f->size_hint_flags |= XNegative;
2859 else if (CONSP (left) && EQ (XCAR (left), Qplus)
2860 && CONSP (XCDR (left))
2861 && INTEGERP (XCAR (XCDR (left))))
2863 leftpos = XINT (XCAR (XCDR (left)));
2866 if (EQ (top, Qminus))
2867 f->size_hint_flags |= YNegative;
2868 else if (INTEGERP (top))
2870 toppos = XINT (top);
2871 if (toppos < 0)
2872 f->size_hint_flags |= YNegative;
2874 else if (CONSP (top) && EQ (XCAR (top), Qminus)
2875 && CONSP (XCDR (top))
2876 && INTEGERP (XCAR (XCDR (top))))
2878 toppos = - XINT (XCAR (XCDR (top)));
2879 f->size_hint_flags |= YNegative;
2881 else if (CONSP (top) && EQ (XCAR (top), Qplus)
2882 && CONSP (XCDR (top))
2883 && INTEGERP (XCAR (XCDR (top))))
2885 toppos = XINT (XCAR (XCDR (top)));
2889 /* Store the numeric value of the position. */
2890 f->top_pos = toppos;
2891 f->left_pos = leftpos;
2893 f->win_gravity = NorthWestGravity;
2895 /* Actually set that position, and convert to absolute. */
2896 x_set_offset (f, leftpos, toppos, -1);
2899 if ((!NILP (icon_left) || !NILP (icon_top))
2900 && ! (icon_left_no_change && icon_top_no_change))
2901 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
2904 UNGCPRO;
2908 /* Insert a description of internally-recorded parameters of frame X
2909 into the parameter alist *ALISTPTR that is to be given to the user.
2910 Only parameters that are specific to the X window system
2911 and whose values are not correctly recorded in the frame's
2912 param_alist need to be considered here. */
2914 void
2915 x_report_frame_params (f, alistptr)
2916 struct frame *f;
2917 Lisp_Object *alistptr;
2919 char buf[16];
2920 Lisp_Object tem;
2922 /* Represent negative positions (off the top or left screen edge)
2923 in a way that Fmodify_frame_parameters will understand correctly. */
2924 XSETINT (tem, f->left_pos);
2925 if (f->left_pos >= 0)
2926 store_in_alist (alistptr, Qleft, tem);
2927 else
2928 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
2930 XSETINT (tem, f->top_pos);
2931 if (f->top_pos >= 0)
2932 store_in_alist (alistptr, Qtop, tem);
2933 else
2934 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
2936 store_in_alist (alistptr, Qborder_width,
2937 make_number (f->border_width));
2938 store_in_alist (alistptr, Qinternal_border_width,
2939 make_number (FRAME_INTERNAL_BORDER_WIDTH (f)));
2940 store_in_alist (alistptr, Qleft_fringe,
2941 make_number (FRAME_LEFT_FRINGE_WIDTH (f)));
2942 store_in_alist (alistptr, Qright_fringe,
2943 make_number (FRAME_RIGHT_FRINGE_WIDTH (f)));
2944 store_in_alist (alistptr, Qscroll_bar_width,
2945 (! FRAME_HAS_VERTICAL_SCROLL_BARS (f)
2946 ? make_number (0)
2947 : FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0
2948 ? make_number (FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
2949 /* nil means "use default width"
2950 for non-toolkit scroll bar.
2951 ruler-mode.el depends on this. */
2952 : Qnil));
2953 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
2954 store_in_alist (alistptr, Qwindow_id,
2955 build_string (buf));
2956 #ifdef HAVE_X_WINDOWS
2957 #ifdef USE_X_TOOLKIT
2958 /* Tooltip frame may not have this widget. */
2959 if (FRAME_X_OUTPUT (f)->widget)
2960 #endif
2961 sprintf (buf, "%ld", (long) FRAME_OUTER_WINDOW (f));
2962 store_in_alist (alistptr, Qouter_window_id,
2963 build_string (buf));
2964 #endif
2965 store_in_alist (alistptr, Qicon_name, f->icon_name);
2966 FRAME_SAMPLE_VISIBILITY (f);
2967 store_in_alist (alistptr, Qvisibility,
2968 (FRAME_VISIBLE_P (f) ? Qt
2969 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
2970 store_in_alist (alistptr, Qdisplay,
2971 XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
2973 #ifndef HAVE_CARBON
2974 /* A Mac Window is identified by a struct, not an integer. */
2975 if (FRAME_X_OUTPUT (f)->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
2976 tem = Qnil;
2977 else
2978 XSETFASTINT (tem, FRAME_X_OUTPUT (f)->parent_desc);
2979 store_in_alist (alistptr, Qparent_id, tem);
2980 #endif
2984 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
2985 the previous value of that parameter, NEW_VALUE is the new value. */
2987 void
2988 x_set_fullscreen (f, new_value, old_value)
2989 struct frame *f;
2990 Lisp_Object new_value, old_value;
2992 #ifndef HAVE_CARBON
2993 if (NILP (new_value))
2994 f->want_fullscreen = FULLSCREEN_NONE;
2995 else if (EQ (new_value, Qfullboth))
2996 f->want_fullscreen = FULLSCREEN_BOTH;
2997 else if (EQ (new_value, Qfullwidth))
2998 f->want_fullscreen = FULLSCREEN_WIDTH;
2999 else if (EQ (new_value, Qfullheight))
3000 f->want_fullscreen = FULLSCREEN_HEIGHT;
3001 #endif
3005 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
3006 the previous value of that parameter, NEW_VALUE is the new value. */
3008 void
3009 x_set_line_spacing (f, new_value, old_value)
3010 struct frame *f;
3011 Lisp_Object new_value, old_value;
3013 if (NILP (new_value))
3014 f->extra_line_spacing = 0;
3015 else if (NATNUMP (new_value))
3016 f->extra_line_spacing = XFASTINT (new_value);
3017 else
3018 Fsignal (Qerror, Fcons (build_string ("Invalid line-spacing"),
3019 Fcons (new_value, Qnil)));
3020 if (FRAME_VISIBLE_P (f))
3021 redraw_frame (f);
3025 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
3026 the previous value of that parameter, NEW_VALUE is the new value. */
3028 void
3029 x_set_screen_gamma (f, new_value, old_value)
3030 struct frame *f;
3031 Lisp_Object new_value, old_value;
3033 if (NILP (new_value))
3034 f->gamma = 0;
3035 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
3036 /* The value 0.4545 is the normal viewing gamma. */
3037 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
3038 else
3039 Fsignal (Qerror, Fcons (build_string ("Invalid screen-gamma"),
3040 Fcons (new_value, Qnil)));
3042 clear_face_cache (0);
3046 void
3047 x_set_font (f, arg, oldval)
3048 struct frame *f;
3049 Lisp_Object arg, oldval;
3051 Lisp_Object result;
3052 Lisp_Object fontset_name;
3053 Lisp_Object frame;
3054 int old_fontset = FRAME_FONTSET(f);
3056 CHECK_STRING (arg);
3058 fontset_name = Fquery_fontset (arg, Qnil);
3060 BLOCK_INPUT;
3061 result = (STRINGP (fontset_name)
3062 ? x_new_fontset (f, SDATA (fontset_name))
3063 : x_new_font (f, SDATA (arg)));
3064 UNBLOCK_INPUT;
3066 if (EQ (result, Qnil))
3067 error ("Font `%s' is not defined", SDATA (arg));
3068 else if (EQ (result, Qt))
3069 error ("The characters of the given font have varying widths");
3070 else if (STRINGP (result))
3072 if (STRINGP (fontset_name))
3074 /* Fontset names are built from ASCII font names, so the
3075 names may be equal despite there was a change. */
3076 if (old_fontset == FRAME_FONTSET (f))
3077 return;
3079 else if (!NILP (Fequal (result, oldval)))
3080 return;
3082 store_frame_param (f, Qfont, result);
3083 recompute_basic_faces (f);
3085 else
3086 abort ();
3088 do_pending_window_change (0);
3090 /* Don't call `face-set-after-frame-default' when faces haven't been
3091 initialized yet. This is the case when called from
3092 Fx_create_frame. In that case, the X widget or window doesn't
3093 exist either, and we can end up in x_report_frame_params with a
3094 null widget which gives a segfault. */
3095 if (FRAME_FACE_CACHE (f))
3097 XSETFRAME (frame, f);
3098 call1 (Qface_set_after_frame_default, frame);
3103 void
3104 x_set_fringe_width (f, new_value, old_value)
3105 struct frame *f;
3106 Lisp_Object new_value, old_value;
3108 compute_fringe_widths (f, 1);
3111 void
3112 x_set_border_width (f, arg, oldval)
3113 struct frame *f;
3114 Lisp_Object arg, oldval;
3116 CHECK_NUMBER (arg);
3118 if (XINT (arg) == f->border_width)
3119 return;
3121 #ifndef HAVE_CARBON
3122 if (FRAME_X_WINDOW (f) != 0)
3123 error ("Cannot change the border width of a window");
3124 #endif /* MAC_TODO */
3126 f->border_width = XINT (arg);
3129 void
3130 x_set_internal_border_width (f, arg, oldval)
3131 struct frame *f;
3132 Lisp_Object arg, oldval;
3134 int old = FRAME_INTERNAL_BORDER_WIDTH (f);
3136 CHECK_NUMBER (arg);
3137 FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
3138 if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
3139 FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
3141 #ifdef USE_X_TOOLKIT
3142 if (FRAME_X_OUTPUT (f)->edit_widget)
3143 widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
3144 #endif
3146 if (FRAME_INTERNAL_BORDER_WIDTH (f) == old)
3147 return;
3149 if (FRAME_X_WINDOW (f) != 0)
3151 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3152 SET_FRAME_GARBAGED (f);
3153 do_pending_window_change (0);
3155 else
3156 SET_FRAME_GARBAGED (f);
3159 void
3160 x_set_visibility (f, value, oldval)
3161 struct frame *f;
3162 Lisp_Object value, oldval;
3164 Lisp_Object frame;
3165 XSETFRAME (frame, f);
3167 if (NILP (value))
3168 Fmake_frame_invisible (frame, Qt);
3169 else if (EQ (value, Qicon))
3170 Ficonify_frame (frame);
3171 else
3172 Fmake_frame_visible (frame);
3175 void
3176 x_set_autoraise (f, arg, oldval)
3177 struct frame *f;
3178 Lisp_Object arg, oldval;
3180 f->auto_raise = !EQ (Qnil, arg);
3183 void
3184 x_set_autolower (f, arg, oldval)
3185 struct frame *f;
3186 Lisp_Object arg, oldval;
3188 f->auto_lower = !EQ (Qnil, arg);
3191 void
3192 x_set_unsplittable (f, arg, oldval)
3193 struct frame *f;
3194 Lisp_Object arg, oldval;
3196 f->no_split = !NILP (arg);
3199 void
3200 x_set_vertical_scroll_bars (f, arg, oldval)
3201 struct frame *f;
3202 Lisp_Object arg, oldval;
3204 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
3205 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
3206 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
3207 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
3209 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
3210 = (NILP (arg)
3211 ? vertical_scroll_bar_none
3212 : EQ (Qleft, arg)
3213 ? vertical_scroll_bar_left
3214 : EQ (Qright, arg)
3215 ? vertical_scroll_bar_right
3216 #ifdef HAVE_NTGUI
3217 /* MS-Windows has scroll bars on the right by default. */
3218 : vertical_scroll_bar_right
3219 #else
3220 : vertical_scroll_bar_left
3221 #endif
3224 /* We set this parameter before creating the X window for the
3225 frame, so we can get the geometry right from the start.
3226 However, if the window hasn't been created yet, we shouldn't
3227 call x_set_window_size. */
3228 if (FRAME_X_WINDOW (f))
3229 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3230 do_pending_window_change (0);
3234 void
3235 x_set_scroll_bar_width (f, arg, oldval)
3236 struct frame *f;
3237 Lisp_Object arg, oldval;
3239 int wid = FRAME_COLUMN_WIDTH (f);
3241 if (NILP (arg))
3243 x_set_scroll_bar_default_width (f);
3245 if (FRAME_X_WINDOW (f))
3246 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3247 do_pending_window_change (0);
3249 else if (INTEGERP (arg) && XINT (arg) > 0
3250 && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
3252 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
3253 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
3255 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg);
3256 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
3257 if (FRAME_X_WINDOW (f))
3258 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
3259 do_pending_window_change (0);
3262 change_frame_size (f, 0, FRAME_COLS (f), 0, 0, 0);
3263 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
3264 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
3269 /* Return non-nil if frame F wants a bitmap icon. */
3271 Lisp_Object
3272 x_icon_type (f)
3273 FRAME_PTR f;
3275 Lisp_Object tem;
3277 tem = assq_no_quit (Qicon_type, f->param_alist);
3278 if (CONSP (tem))
3279 return XCDR (tem);
3280 else
3281 return Qnil;
3285 /* Subroutines of creating an X frame. */
3287 /* Make sure that Vx_resource_name is set to a reasonable value.
3288 Fix it up, or set it to `emacs' if it is too hopeless. */
3290 void
3291 validate_x_resource_name ()
3293 int len = 0;
3294 /* Number of valid characters in the resource name. */
3295 int good_count = 0;
3296 /* Number of invalid characters in the resource name. */
3297 int bad_count = 0;
3298 Lisp_Object new;
3299 int i;
3301 if (!STRINGP (Vx_resource_class))
3302 Vx_resource_class = build_string (EMACS_CLASS);
3304 if (STRINGP (Vx_resource_name))
3306 unsigned char *p = SDATA (Vx_resource_name);
3307 int i;
3309 len = SBYTES (Vx_resource_name);
3311 /* Only letters, digits, - and _ are valid in resource names.
3312 Count the valid characters and count the invalid ones. */
3313 for (i = 0; i < len; i++)
3315 int c = p[i];
3316 if (! ((c >= 'a' && c <= 'z')
3317 || (c >= 'A' && c <= 'Z')
3318 || (c >= '0' && c <= '9')
3319 || c == '-' || c == '_'))
3320 bad_count++;
3321 else
3322 good_count++;
3325 else
3326 /* Not a string => completely invalid. */
3327 bad_count = 5, good_count = 0;
3329 /* If name is valid already, return. */
3330 if (bad_count == 0)
3331 return;
3333 /* If name is entirely invalid, or nearly so, use `emacs'. */
3334 if (good_count == 0
3335 || (good_count == 1 && bad_count > 0))
3337 Vx_resource_name = build_string ("emacs");
3338 return;
3341 /* Name is partly valid. Copy it and replace the invalid characters
3342 with underscores. */
3344 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
3346 for (i = 0; i < len; i++)
3348 int c = SREF (new, i);
3349 if (! ((c >= 'a' && c <= 'z')
3350 || (c >= 'A' && c <= 'Z')
3351 || (c >= '0' && c <= '9')
3352 || c == '-' || c == '_'))
3353 SSET (new, i, '_');
3358 extern char *x_get_string_resource P_ ((XrmDatabase, char *, char *));
3359 extern Display_Info *check_x_display_info P_ ((Lisp_Object));
3362 /* Get specified attribute from resource database RDB.
3363 See Fx_get_resource below for other parameters. */
3365 static Lisp_Object
3366 xrdb_get_resource (rdb, attribute, class, component, subclass)
3367 XrmDatabase rdb;
3368 Lisp_Object attribute, class, component, subclass;
3370 register char *value;
3371 char *name_key;
3372 char *class_key;
3374 CHECK_STRING (attribute);
3375 CHECK_STRING (class);
3377 if (!NILP (component))
3378 CHECK_STRING (component);
3379 if (!NILP (subclass))
3380 CHECK_STRING (subclass);
3381 if (NILP (component) != NILP (subclass))
3382 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3384 validate_x_resource_name ();
3386 /* Allocate space for the components, the dots which separate them,
3387 and the final '\0'. Make them big enough for the worst case. */
3388 name_key = (char *) alloca (SBYTES (Vx_resource_name)
3389 + (STRINGP (component)
3390 ? SBYTES (component) : 0)
3391 + SBYTES (attribute)
3392 + 3);
3394 class_key = (char *) alloca (SBYTES (Vx_resource_class)
3395 + SBYTES (class)
3396 + (STRINGP (subclass)
3397 ? SBYTES (subclass) : 0)
3398 + 3);
3400 /* Start with emacs.FRAMENAME for the name (the specific one)
3401 and with `Emacs' for the class key (the general one). */
3402 strcpy (name_key, SDATA (Vx_resource_name));
3403 strcpy (class_key, SDATA (Vx_resource_class));
3405 strcat (class_key, ".");
3406 strcat (class_key, SDATA (class));
3408 if (!NILP (component))
3410 strcat (class_key, ".");
3411 strcat (class_key, SDATA (subclass));
3413 strcat (name_key, ".");
3414 strcat (name_key, SDATA (component));
3417 strcat (name_key, ".");
3418 strcat (name_key, SDATA (attribute));
3420 value = x_get_string_resource (rdb, name_key, class_key);
3422 if (value != (char *) 0)
3423 return build_string (value);
3424 else
3425 return Qnil;
3429 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
3430 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
3431 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
3432 class, where INSTANCE is the name under which Emacs was invoked, or
3433 the name specified by the `-name' or `-rn' command-line arguments.
3435 The optional arguments COMPONENT and SUBCLASS add to the key and the
3436 class, respectively. You must specify both of them or neither.
3437 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
3438 and the class is `Emacs.CLASS.SUBCLASS'. */)
3439 (attribute, class, component, subclass)
3440 Lisp_Object attribute, class, component, subclass;
3442 #ifdef HAVE_X_WINDOWS
3443 check_x ();
3444 #endif
3446 return xrdb_get_resource (check_x_display_info (Qnil)->xrdb,
3447 attribute, class, component, subclass);
3450 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
3452 Lisp_Object
3453 display_x_get_resource (dpyinfo, attribute, class, component, subclass)
3454 Display_Info *dpyinfo;
3455 Lisp_Object attribute, class, component, subclass;
3457 return xrdb_get_resource (dpyinfo->xrdb,
3458 attribute, class, component, subclass);
3461 /* Used when C code wants a resource value. */
3463 char *
3464 x_get_resource_string (attribute, class)
3465 char *attribute, *class;
3467 char *name_key;
3468 char *class_key;
3469 struct frame *sf = SELECTED_FRAME ();
3471 /* Allocate space for the components, the dots which separate them,
3472 and the final '\0'. */
3473 name_key = (char *) alloca (SBYTES (Vinvocation_name)
3474 + strlen (attribute) + 2);
3475 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
3476 + strlen (class) + 2);
3478 sprintf (name_key, "%s.%s", SDATA (Vinvocation_name), attribute);
3479 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3481 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
3482 name_key, class_key);
3486 /* Return the value of parameter PARAM.
3488 First search ALIST, then Vdefault_frame_alist, then the X defaults
3489 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3491 Convert the resource to the type specified by desired_type.
3493 If no default is specified, return Qunbound. If you call
3494 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3495 and don't let it get stored in any Lisp-visible variables! */
3497 Lisp_Object
3498 x_get_arg (dpyinfo, alist, param, attribute, class, type)
3499 Display_Info *dpyinfo;
3500 Lisp_Object alist, param;
3501 char *attribute;
3502 char *class;
3503 enum resource_types type;
3505 register Lisp_Object tem;
3507 tem = Fassq (param, alist);
3508 if (EQ (tem, Qnil))
3509 tem = Fassq (param, Vdefault_frame_alist);
3510 if (EQ (tem, Qnil))
3512 if (attribute)
3514 tem = display_x_get_resource (dpyinfo,
3515 build_string (attribute),
3516 build_string (class),
3517 Qnil, Qnil);
3519 if (NILP (tem))
3520 return Qunbound;
3522 switch (type)
3524 case RES_TYPE_NUMBER:
3525 return make_number (atoi (SDATA (tem)));
3527 case RES_TYPE_FLOAT:
3528 return make_float (atof (SDATA (tem)));
3530 case RES_TYPE_BOOLEAN:
3531 tem = Fdowncase (tem);
3532 if (!strcmp (SDATA (tem), "on")
3533 || !strcmp (SDATA (tem), "true"))
3534 return Qt;
3535 else
3536 return Qnil;
3538 case RES_TYPE_STRING:
3539 return tem;
3541 case RES_TYPE_SYMBOL:
3542 /* As a special case, we map the values `true' and `on'
3543 to Qt, and `false' and `off' to Qnil. */
3545 Lisp_Object lower;
3546 lower = Fdowncase (tem);
3547 if (!strcmp (SDATA (lower), "on")
3548 || !strcmp (SDATA (lower), "true"))
3549 return Qt;
3550 else if (!strcmp (SDATA (lower), "off")
3551 || !strcmp (SDATA (lower), "false"))
3552 return Qnil;
3553 else
3554 return Fintern (tem, Qnil);
3557 default:
3558 abort ();
3561 else
3562 return Qunbound;
3564 return Fcdr (tem);
3567 Lisp_Object
3568 x_frame_get_arg (f, alist, param, attribute, class, type)
3569 struct frame *f;
3570 Lisp_Object alist, param;
3571 char *attribute;
3572 char *class;
3573 enum resource_types type;
3575 return x_get_arg (FRAME_X_DISPLAY_INFO (f),
3576 alist, param, attribute, class, type);
3579 /* Like x_frame_get_arg, but also record the value in f->param_alist. */
3581 Lisp_Object
3582 x_frame_get_and_record_arg (f, alist, param, attribute, class, type)
3583 struct frame *f;
3584 Lisp_Object alist, param;
3585 char *attribute;
3586 char *class;
3587 enum resource_types type;
3589 Lisp_Object value;
3591 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
3592 attribute, class, type);
3593 if (! NILP (value))
3594 store_frame_param (f, param, value);
3596 return value;
3600 /* Record in frame F the specified or default value according to ALIST
3601 of the parameter named PROP (a Lisp symbol).
3602 If no value is specified for PROP, look for an X default for XPROP
3603 on the frame named NAME.
3604 If that is not found either, use the value DEFLT. */
3606 Lisp_Object
3607 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
3608 struct frame *f;
3609 Lisp_Object alist;
3610 Lisp_Object prop;
3611 Lisp_Object deflt;
3612 char *xprop;
3613 char *xclass;
3614 enum resource_types type;
3616 Lisp_Object tem;
3618 tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type);
3619 if (EQ (tem, Qunbound))
3620 tem = deflt;
3621 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
3622 return tem;
3628 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
3629 doc: /* Parse an X-style geometry string STRING.
3630 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3631 The properties returned may include `top', `left', `height', and `width'.
3632 The value of `left' or `top' may be an integer,
3633 or a list (+ N) meaning N pixels relative to top/left corner,
3634 or a list (- N) meaning -N pixels relative to bottom/right corner. */)
3635 (string)
3636 Lisp_Object string;
3638 int geometry, x, y;
3639 unsigned int width, height;
3640 Lisp_Object result;
3642 CHECK_STRING (string);
3644 geometry = XParseGeometry ((char *) SDATA (string),
3645 &x, &y, &width, &height);
3647 #if 0
3648 if (!!(geometry & XValue) != !!(geometry & YValue))
3649 error ("Must specify both x and y position, or neither");
3650 #endif
3652 result = Qnil;
3653 if (geometry & XValue)
3655 Lisp_Object element;
3657 if (x >= 0 && (geometry & XNegative))
3658 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
3659 else if (x < 0 && ! (geometry & XNegative))
3660 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
3661 else
3662 element = Fcons (Qleft, make_number (x));
3663 result = Fcons (element, result);
3666 if (geometry & YValue)
3668 Lisp_Object element;
3670 if (y >= 0 && (geometry & YNegative))
3671 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
3672 else if (y < 0 && ! (geometry & YNegative))
3673 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
3674 else
3675 element = Fcons (Qtop, make_number (y));
3676 result = Fcons (element, result);
3679 if (geometry & WidthValue)
3680 result = Fcons (Fcons (Qwidth, make_number (width)), result);
3681 if (geometry & HeightValue)
3682 result = Fcons (Fcons (Qheight, make_number (height)), result);
3684 return result;
3687 /* Calculate the desired size and position of frame F.
3688 Return the flags saying which aspects were specified.
3690 Also set the win_gravity and size_hint_flags of F.
3692 Adjust height for toolbar if TOOLBAR_P is 1.
3694 This function does not make the coordinates positive. */
3696 #define DEFAULT_ROWS 40
3697 #define DEFAULT_COLS 80
3700 x_figure_window_size (f, parms, toolbar_p)
3701 struct frame *f;
3702 Lisp_Object parms;
3703 int toolbar_p;
3705 register Lisp_Object tem0, tem1, tem2;
3706 long window_prompting = 0;
3707 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3709 /* Default values if we fall through.
3710 Actually, if that happens we should get
3711 window manager prompting. */
3712 SET_FRAME_COLS (f, DEFAULT_COLS);
3713 FRAME_LINES (f) = DEFAULT_ROWS;
3714 /* Window managers expect that if program-specified
3715 positions are not (0,0), they're intentional, not defaults. */
3716 f->top_pos = 0;
3717 f->left_pos = 0;
3719 /* Ensure that old new_text_cols and new_text_lines will not override the
3720 values set here. */
3721 /* ++KFS: This was specific to W32, but seems ok for all platforms */
3722 f->new_text_cols = f->new_text_lines = 0;
3724 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
3725 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
3726 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
3727 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3729 if (!EQ (tem0, Qunbound))
3731 CHECK_NUMBER (tem0);
3732 FRAME_LINES (f) = XINT (tem0);
3734 if (!EQ (tem1, Qunbound))
3736 CHECK_NUMBER (tem1);
3737 SET_FRAME_COLS (f, XINT (tem1));
3739 if (!NILP (tem2) && !EQ (tem2, Qunbound))
3740 window_prompting |= USSize;
3741 else
3742 window_prompting |= PSize;
3745 f->scroll_bar_actual_width
3746 = FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f);
3748 /* This used to be done _before_ calling x_figure_window_size, but
3749 since the height is reset here, this was really a no-op. I
3750 assume that moving it here does what Gerd intended (although he
3751 no longer can remember what that was... ++KFS, 2003-03-25. */
3753 /* Add the tool-bar height to the initial frame height so that the
3754 user gets a text display area of the size he specified with -g or
3755 via .Xdefaults. Later changes of the tool-bar height don't
3756 change the frame size. This is done so that users can create
3757 tall Emacs frames without having to guess how tall the tool-bar
3758 will get. */
3759 if (toolbar_p && FRAME_TOOL_BAR_LINES (f))
3761 int margin, relief, bar_height;
3763 relief = (tool_bar_button_relief >= 0
3764 ? tool_bar_button_relief
3765 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
3767 if (INTEGERP (Vtool_bar_button_margin)
3768 && XINT (Vtool_bar_button_margin) > 0)
3769 margin = XFASTINT (Vtool_bar_button_margin);
3770 else if (CONSP (Vtool_bar_button_margin)
3771 && INTEGERP (XCDR (Vtool_bar_button_margin))
3772 && XINT (XCDR (Vtool_bar_button_margin)) > 0)
3773 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
3774 else
3775 margin = 0;
3777 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
3778 FRAME_LINES (f) += (bar_height + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f);
3781 compute_fringe_widths (f, 0);
3783 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, FRAME_COLS (f));
3784 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, FRAME_LINES (f));
3786 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
3787 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
3788 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
3789 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3791 if (EQ (tem0, Qminus))
3793 f->top_pos = 0;
3794 window_prompting |= YNegative;
3796 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
3797 && CONSP (XCDR (tem0))
3798 && INTEGERP (XCAR (XCDR (tem0))))
3800 f->top_pos = - XINT (XCAR (XCDR (tem0)));
3801 window_prompting |= YNegative;
3803 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
3804 && CONSP (XCDR (tem0))
3805 && INTEGERP (XCAR (XCDR (tem0))))
3807 f->top_pos = XINT (XCAR (XCDR (tem0)));
3809 else if (EQ (tem0, Qunbound))
3810 f->top_pos = 0;
3811 else
3813 CHECK_NUMBER (tem0);
3814 f->top_pos = XINT (tem0);
3815 if (f->top_pos < 0)
3816 window_prompting |= YNegative;
3819 if (EQ (tem1, Qminus))
3821 f->left_pos = 0;
3822 window_prompting |= XNegative;
3824 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
3825 && CONSP (XCDR (tem1))
3826 && INTEGERP (XCAR (XCDR (tem1))))
3828 f->left_pos = - XINT (XCAR (XCDR (tem1)));
3829 window_prompting |= XNegative;
3831 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
3832 && CONSP (XCDR (tem1))
3833 && INTEGERP (XCAR (XCDR (tem1))))
3835 f->left_pos = XINT (XCAR (XCDR (tem1)));
3837 else if (EQ (tem1, Qunbound))
3838 f->left_pos = 0;
3839 else
3841 CHECK_NUMBER (tem1);
3842 f->left_pos = XINT (tem1);
3843 if (f->left_pos < 0)
3844 window_prompting |= XNegative;
3847 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
3848 window_prompting |= USPosition;
3849 else
3850 window_prompting |= PPosition;
3853 if (f->want_fullscreen != FULLSCREEN_NONE)
3855 int left, top;
3856 int width, height;
3858 /* It takes both for some WM:s to place it where we want */
3859 window_prompting = USPosition | PPosition;
3860 x_fullscreen_adjust (f, &width, &height, &top, &left);
3861 FRAME_COLS (f) = width;
3862 FRAME_LINES (f) = height;
3863 FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, width);
3864 FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, height);
3865 f->left_pos = left;
3866 f->top_pos = top;
3869 if (window_prompting & XNegative)
3871 if (window_prompting & YNegative)
3872 f->win_gravity = SouthEastGravity;
3873 else
3874 f->win_gravity = NorthEastGravity;
3876 else
3878 if (window_prompting & YNegative)
3879 f->win_gravity = SouthWestGravity;
3880 else
3881 f->win_gravity = NorthWestGravity;
3884 f->size_hint_flags = window_prompting;
3886 return window_prompting;
3891 #endif /* HAVE_WINDOW_SYSTEM */
3895 /***********************************************************************
3896 Initialization
3897 ***********************************************************************/
3899 void
3900 syms_of_frame ()
3902 Qframep = intern ("framep");
3903 staticpro (&Qframep);
3904 Qframe_live_p = intern ("frame-live-p");
3905 staticpro (&Qframe_live_p);
3906 Qheight = intern ("height");
3907 staticpro (&Qheight);
3908 Qicon = intern ("icon");
3909 staticpro (&Qicon);
3910 Qminibuffer = intern ("minibuffer");
3911 staticpro (&Qminibuffer);
3912 Qmodeline = intern ("modeline");
3913 staticpro (&Qmodeline);
3914 Qonly = intern ("only");
3915 staticpro (&Qonly);
3916 Qwidth = intern ("width");
3917 staticpro (&Qwidth);
3918 Qgeometry = intern ("geometry");
3919 staticpro (&Qgeometry);
3920 Qicon_left = intern ("icon-left");
3921 staticpro (&Qicon_left);
3922 Qicon_top = intern ("icon-top");
3923 staticpro (&Qicon_top);
3924 Qleft = intern ("left");
3925 staticpro (&Qleft);
3926 Qright = intern ("right");
3927 staticpro (&Qright);
3928 Quser_position = intern ("user-position");
3929 staticpro (&Quser_position);
3930 Quser_size = intern ("user-size");
3931 staticpro (&Quser_size);
3932 Qwindow_id = intern ("window-id");
3933 staticpro (&Qwindow_id);
3934 #ifdef HAVE_X_WINDOWS
3935 Qouter_window_id = intern ("outer-window-id");
3936 staticpro (&Qouter_window_id);
3937 #endif
3938 Qparent_id = intern ("parent-id");
3939 staticpro (&Qparent_id);
3940 Qx = intern ("x");
3941 staticpro (&Qx);
3942 Qw32 = intern ("w32");
3943 staticpro (&Qw32);
3944 Qpc = intern ("pc");
3945 staticpro (&Qpc);
3946 Qmac = intern ("mac");
3947 staticpro (&Qmac);
3948 Qvisible = intern ("visible");
3949 staticpro (&Qvisible);
3950 Qbuffer_predicate = intern ("buffer-predicate");
3951 staticpro (&Qbuffer_predicate);
3952 Qbuffer_list = intern ("buffer-list");
3953 staticpro (&Qbuffer_list);
3954 Qdisplay_type = intern ("display-type");
3955 staticpro (&Qdisplay_type);
3956 Qbackground_mode = intern ("background-mode");
3957 staticpro (&Qbackground_mode);
3958 Qtty_color_mode = intern ("tty-color-mode");
3959 staticpro (&Qtty_color_mode);
3961 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
3962 staticpro (&Qface_set_after_frame_default);
3964 Qfullwidth = intern ("fullwidth");
3965 staticpro (&Qfullwidth);
3966 Qfullheight = intern ("fullheight");
3967 staticpro (&Qfullheight);
3968 Qfullboth = intern ("fullboth");
3969 staticpro (&Qfullboth);
3970 Qx_resource_name = intern ("x-resource-name");
3971 staticpro (&Qx_resource_name);
3973 Qx_frame_parameter = intern ("x-frame-parameter");
3974 staticpro (&Qx_frame_parameter);
3977 int i;
3979 for (i = 0; i < sizeof (frame_parms) / sizeof (frame_parms[0]); i++)
3981 Lisp_Object v = intern (frame_parms[i].name);
3982 if (frame_parms[i].variable)
3984 *frame_parms[i].variable = v;
3985 staticpro (frame_parms[i].variable);
3987 Fput (v, Qx_frame_parameter, make_number (i));
3991 #ifdef HAVE_WINDOW_SYSTEM
3992 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
3993 doc: /* The name Emacs uses to look up X resources.
3994 `x-get-resource' uses this as the first component of the instance name
3995 when requesting resource values.
3996 Emacs initially sets `x-resource-name' to the name under which Emacs
3997 was invoked, or to the value specified with the `-name' or `-rn'
3998 switches, if present.
4000 It may be useful to bind this variable locally around a call
4001 to `x-get-resource'. See also the variable `x-resource-class'. */);
4002 Vx_resource_name = Qnil;
4004 DEFVAR_LISP ("x-resource-class", &Vx_resource_class,
4005 doc: /* The class Emacs uses to look up X resources.
4006 `x-get-resource' uses this as the first component of the instance class
4007 when requesting resource values.
4009 Emacs initially sets `x-resource-class' to "Emacs".
4011 Setting this variable permanently is not a reasonable thing to do,
4012 but binding this variable locally around a call to `x-get-resource'
4013 is a reasonable practice. See also the variable `x-resource-name'. */);
4014 Vx_resource_class = build_string (EMACS_CLASS);
4015 #endif
4017 DEFVAR_LISP ("default-frame-alist", &Vdefault_frame_alist,
4018 doc: /* Alist of default values for frame creation.
4019 These may be set in your init file, like this:
4020 (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1))
4021 These override values given in window system configuration data,
4022 including X Windows' defaults database.
4023 For values specific to the first Emacs frame, see `initial-frame-alist'.
4024 For values specific to the separate minibuffer frame, see
4025 `minibuffer-frame-alist'.
4026 The `menu-bar-lines' element of the list controls whether new frames
4027 have menu bars; `menu-bar-mode' works by altering this element.
4028 Setting this variable does not affect existing frames, only new ones. */);
4029 Vdefault_frame_alist = Qnil;
4031 Qinhibit_default_face_x_resources
4032 = intern ("inhibit-default-face-x-resources");
4033 staticpro (&Qinhibit_default_face_x_resources);
4035 DEFVAR_LISP ("terminal-frame", &Vterminal_frame,
4036 doc: /* The initial frame-object, which represents Emacs's stdout. */);
4038 DEFVAR_LISP ("emacs-iconified", &Vemacs_iconified,
4039 doc: /* Non-nil if all of emacs is iconified and frame updates are not needed. */);
4040 Vemacs_iconified = Qnil;
4042 DEFVAR_LISP ("mouse-position-function", &Vmouse_position_function,
4043 doc: /* If non-nil, function to transform normal value of `mouse-position'.
4044 `mouse-position' calls this function, passing its usual return value as
4045 argument, and returns whatever this function returns.
4046 This abnormal hook exists for the benefit of packages like `xt-mouse.el'
4047 which need to do mouse handling at the Lisp level. */);
4048 Vmouse_position_function = Qnil;
4050 DEFVAR_LISP ("mouse-highlight", &Vmouse_highlight,
4051 doc: /* If non-nil, clickable text is highlighted when mouse is over it.
4052 If the value is an integer, highlighting is only shown after moving the
4053 mouse, while keyboard input turns off the highlight even when the mouse
4054 is over the clickable text. However, the mouse shape still indicates
4055 when the mouse is over clickable text. */);
4056 Vmouse_highlight = Qt;
4058 DEFVAR_LISP ("delete-frame-functions", &Vdelete_frame_functions,
4059 doc: /* Functions to be run before deleting a frame.
4060 The functions are run with one arg, the frame to be deleted.
4061 See `delete-frame'. */);
4062 Vdelete_frame_functions = Qnil;
4064 DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
4065 doc: /* Minibufferless frames use this frame's minibuffer.
4067 Emacs cannot create minibufferless frames unless this is set to an
4068 appropriate surrogate.
4070 Emacs consults this variable only when creating minibufferless
4071 frames; once the frame is created, it sticks with its assigned
4072 minibuffer, no matter what this variable is set to. This means that
4073 this variable doesn't necessarily say anything meaningful about the
4074 current set of frames, or where the minibuffer is currently being
4075 displayed.
4077 This variable is local to the current terminal and cannot be buffer-local. */);
4079 staticpro (&Vframe_list);
4081 defsubr (&Sactive_minibuffer_window);
4082 defsubr (&Sframep);
4083 defsubr (&Sframe_live_p);
4084 defsubr (&Smake_terminal_frame);
4085 defsubr (&Shandle_switch_frame);
4086 defsubr (&Signore_event);
4087 defsubr (&Sselect_frame);
4088 defsubr (&Sselected_frame);
4089 defsubr (&Swindow_frame);
4090 defsubr (&Sframe_root_window);
4091 defsubr (&Sframe_first_window);
4092 defsubr (&Sframe_selected_window);
4093 defsubr (&Sset_frame_selected_window);
4094 defsubr (&Sframe_list);
4095 defsubr (&Snext_frame);
4096 defsubr (&Sprevious_frame);
4097 defsubr (&Sdelete_frame);
4098 defsubr (&Smouse_position);
4099 defsubr (&Smouse_pixel_position);
4100 defsubr (&Sset_mouse_position);
4101 defsubr (&Sset_mouse_pixel_position);
4102 #if 0
4103 defsubr (&Sframe_configuration);
4104 defsubr (&Srestore_frame_configuration);
4105 #endif
4106 defsubr (&Smake_frame_visible);
4107 defsubr (&Smake_frame_invisible);
4108 defsubr (&Siconify_frame);
4109 defsubr (&Sframe_visible_p);
4110 defsubr (&Svisible_frame_list);
4111 defsubr (&Sraise_frame);
4112 defsubr (&Slower_frame);
4113 defsubr (&Sredirect_frame_focus);
4114 defsubr (&Sframe_focus);
4115 defsubr (&Sframe_parameters);
4116 defsubr (&Sframe_parameter);
4117 defsubr (&Smodify_frame_parameters);
4118 defsubr (&Sframe_char_height);
4119 defsubr (&Sframe_char_width);
4120 defsubr (&Sframe_pixel_height);
4121 defsubr (&Sframe_pixel_width);
4122 defsubr (&Sset_frame_height);
4123 defsubr (&Sset_frame_width);
4124 defsubr (&Sset_frame_size);
4125 defsubr (&Sset_frame_position);
4127 #ifdef HAVE_WINDOW_SYSTEM
4128 defsubr (&Sx_get_resource);
4129 defsubr (&Sx_parse_geometry);
4130 #endif