X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/53588795b102283a55261a4db18c99faaa0e63e4..a63643cd04cda0e835077a8bdcacb5513b1f6338:/src/frame.c diff --git a/src/frame.c b/src/frame.c index 33bb571fe9..204eec3083 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1,5 +1,5 @@ /* Generic frame functions. - Copyright (C) 1993, 1994, 1995 Free Software Foundation. + Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000 Free Software Foundation. This file is part of GNU Emacs. @@ -15,55 +15,39 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to -the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ #include #include #include "lisp.h" +#include "charset.h" +#ifdef HAVE_X_WINDOWS +#include "xterm.h" +#endif +#ifdef WINDOWSNT +#include "w32term.h" +#endif +#ifdef macintosh +#include "macterm.h" +#endif +#include "buffer.h" +/* These help us bind and responding to switch-frame events. */ +#include "commands.h" +#include "keyboard.h" #include "frame.h" +#ifdef HAVE_WINDOW_SYSTEM +#include "fontset.h" +#endif #include "termhooks.h" +#include "dispextern.h" #include "window.h" #ifdef MSDOS #include "msdos.h" +#include "dosfns.h" #endif -/* Evaluate this expression to rebuild the section of syms_of_frame - that initializes and staticpros the symbols declared below. Note - that Emacs 18 has a bug that keeps C-x C-e from being able to - evaluate this expression. - -(progn - ;; Accumulate a list of the symbols we want to initialize from the - ;; declarations at the top of the file. - (goto-char (point-min)) - (search-forward "/\*&&& symbols declared here &&&*\/\n") - (let (symbol-list) - (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)") - (setq symbol-list - (cons (buffer-substring (match-beginning 1) (match-end 1)) - symbol-list)) - (forward-line 1)) - (setq symbol-list (nreverse symbol-list)) - ;; Delete the section of syms_of_... where we initialize the symbols. - (search-forward "\n /\*&&& init symbols here &&&*\/\n") - (let ((start (point))) - (while (looking-at "^ Q") - (forward-line 2)) - (kill-region start (point))) - ;; Write a new symbol initialization section. - (while symbol-list - (insert (format " %s = intern (\"" (car symbol-list))) - (let ((start (point))) - (insert (substring (car symbol-list) 1)) - (subst-char-in-region start (point) ?_ ?-)) - (insert (format "\");\n staticpro (&%s);\n" (car symbol-list))) - (setq symbol-list (cdr symbol-list))))) - */ - -/* We need most of these symbols even if not MULTI_FRAME; - easiest to define them all, all of the time. */ -/*&&& symbols declared here &&&*/ Lisp_Object Qframep; Lisp_Object Qframe_live_p; Lisp_Object Qheight; @@ -74,68 +58,23 @@ Lisp_Object Qname; Lisp_Object Qonly; Lisp_Object Qunsplittable; Lisp_Object Qmenu_bar_lines; +Lisp_Object Qtool_bar_lines; Lisp_Object Qwidth; Lisp_Object Qx; -Lisp_Object Qwin32; +Lisp_Object Qw32; +Lisp_Object Qpc; +Lisp_Object Qmac; Lisp_Object Qvisible; Lisp_Object Qbuffer_predicate; +Lisp_Object Qbuffer_list; +Lisp_Object Qtitle; +Lisp_Object Qdisplay_type; +Lisp_Object Qbackground_mode; +Lisp_Object Qinhibit_default_face_x_resources; Lisp_Object Vterminal_frame; Lisp_Object Vdefault_frame_alist; - -Lisp_Object Qmouse_leave_buffer_hook; - -static void -syms_of_frame_1 () -{ - /*&&& init symbols here &&&*/ - Qframep = intern ("framep"); - staticpro (&Qframep); - Qframe_live_p = intern ("frame-live-p"); - staticpro (&Qframe_live_p); - Qheight = intern ("height"); - staticpro (&Qheight); - Qicon = intern ("icon"); - staticpro (&Qicon); - Qminibuffer = intern ("minibuffer"); - staticpro (&Qminibuffer); - Qmodeline = intern ("modeline"); - staticpro (&Qmodeline); - Qname = intern ("name"); - staticpro (&Qname); - Qonly = intern ("only"); - staticpro (&Qonly); - Qunsplittable = intern ("unsplittable"); - staticpro (&Qunsplittable); - Qmenu_bar_lines = intern ("menu-bar-lines"); - staticpro (&Qmenu_bar_lines); - Qwidth = intern ("width"); - staticpro (&Qwidth); - Qx = intern ("x"); - staticpro (&Qx); - Qwin32 = intern ("win32"); - staticpro (&Qwin32); - Qvisible = intern ("visible"); - staticpro (&Qvisible); - Qbuffer_predicate = intern ("buffer-predicate"); - staticpro (&Qbuffer_predicate); - - Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook"); - staticpro (&Qmouse_leave_buffer_hook); - - DEFVAR_LISP ("default-frame-alist", &Vdefault_frame_alist, - "Alist of default values for frame creation.\n\ -These may be set in your init file, like this:\n\ - (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1))\n\ -These override values given in window system configuration data,\n\ - including X Windows' defaults database.\n\ -For values specific to the first Emacs frame, see `initial-frame-alist'.\n\ -For values specific to the separate minibuffer frame, see\n\ - `minibuffer-frame-alist'.\n\ -The `menu-bar-lines' element of the list controls whether new frames\n\ - have menu bars; `menu-bar-mode' works by altering this element."); - Vdefault_frame_alist = Qnil; -} +Lisp_Object Vmouse_position_function; static void set_menu_bar_lines_1 (window, n) @@ -147,6 +86,11 @@ set_menu_bar_lines_1 (window, n) XSETFASTINT (w->last_modified, 0); XSETFASTINT (w->top, XFASTINT (w->top) + n); XSETFASTINT (w->height, XFASTINT (w->height) - n); + + if (INTEGERP (w->orig_top)) + XSETFASTINT (w->orig_top, XFASTINT (w->orig_top) + n); + if (INTEGERP (w->orig_height)) + XSETFASTINT (w->orig_height, XFASTINT (w->orig_height) - n); /* Handle just the top child in a vertical split. */ if (!NILP (w->vchild)) @@ -160,7 +104,7 @@ set_menu_bar_lines_1 (window, n) } } -static void +void set_menu_bar_lines (f, value, oldval) struct frame *f; Lisp_Object value, oldval; @@ -170,7 +114,7 @@ set_menu_bar_lines (f, value, oldval) /* Right now, menu bars don't work properly in minibuf-only frames; most of the commands try to apply themselves to the minibuffer - frame itslef, and get an error because you can't switch buffers + frame itself, and get an error because you can't switch buffers in or split the minibuffer window. */ if (FRAME_MINIBUF_ONLY_P (f)) return; @@ -186,20 +130,15 @@ set_menu_bar_lines (f, value, oldval) FRAME_WINDOW_SIZES_CHANGED (f) = 1; FRAME_MENU_BAR_LINES (f) = nlines; set_menu_bar_lines_1 (f->root_window, nlines - olines); + adjust_glyphs (f); } } -#ifdef MULTI_FRAME - -#include "buffer.h" - -/* These help us bind and responding to switch-frame events. */ -#include "commands.h" -#include "keyboard.h" - Lisp_Object Vemacs_iconified; Lisp_Object Vframe_list; +struct x_output tty_display; + extern Lisp_Object Vminibuffer_list; extern Lisp_Object get_minibuffer (); extern Lisp_Object Fhandle_switch_frame (); @@ -210,6 +149,8 @@ DEFUN ("framep", Fframep, Sframep, 1, 1, 0, "Return non-nil if OBJECT is a frame.\n\ Value is t for a termcap frame (a character-only terminal),\n\ `x' for an Emacs frame that is really an X window,\n\ +`w32' for an Emacs frame that is a window on MS-Windows display,\n\ +`mac' for an Emacs frame on a Macintosh display,\n\ `pc' for a direct-write MS-DOS frame.\n\ See also `frame-live-p'.") (object) @@ -223,9 +164,12 @@ See also `frame-live-p'.") return Qt; case output_x_window: return Qx; - case output_win32: - return Qwin32; - /* The `pc' case is in the Fframep below. */ + case output_w32: + return Qw32; + case output_msdos_raw: + return Qpc; + case output_mac: + return Qmac; default: abort (); } @@ -264,10 +208,12 @@ make_frame (mini_p) f = (struct frame *)vec; XSETFRAME (frame, f); - f->cursor_x = 0; - f->cursor_y = 0; - f->current_glyphs = 0; - f->desired_glyphs = 0; + f->desired_matrix = 0; + f->current_matrix = 0; + f->desired_pool = 0; + f->current_pool = 0; + f->glyphs_initialized_p = 0; + f->decode_mode_spec_buffer = 0; f->visible = 0; f->async_visible = 0; f->output_data.nothing = 0; @@ -277,24 +223,32 @@ make_frame (mini_p) f->auto_raise = 0; f->auto_lower = 0; f->no_split = 0; - f->garbaged = 0; + f->garbaged = 1; f->has_minibuffer = mini_p; f->focus_frame = Qnil; f->explicit_name = 0; f->can_have_scroll_bars = 0; - f->has_vertical_scroll_bars = 0; + f->vertical_scroll_bar_type = vertical_scroll_bar_none; f->param_alist = Qnil; f->scroll_bars = Qnil; f->condemned_scroll_bars = Qnil; f->face_alist = Qnil; + f->face_cache = NULL; f->menu_bar_items = Qnil; f->menu_bar_vector = Qnil; f->menu_bar_items_used = 0; f->buffer_predicate = Qnil; + f->buffer_list = Qnil; #ifdef MULTI_KBOARD f->kboard = initial_kboard; #endif f->namebuf = 0; + f->title = Qnil; + f->menu_bar_window = Qnil; + f->tool_bar_window = Qnil; + f->tool_bar_items = Qnil; + f->desired_tool_bar_string = f->current_tool_bar_string = Qnil; + f->n_tool_bar_items = 0; root_window = make_window (); if (mini_p) @@ -319,7 +273,7 @@ make_frame (mini_p) just so that there is "something there." Correct size will be set up later with change_frame_size. */ - f->width = 10; + SET_FRAME_WIDTH (f, 10); f->height = 10; XSETFASTINT (XWINDOW (root_window)->width, 10); @@ -341,17 +295,26 @@ make_frame (mini_p) /* If buf is a 'hidden' buffer (i.e. one whose name starts with a space), try to find another one. */ if (XSTRING (Fbuffer_name (buf))->data[0] == ' ') - buf = Fother_buffer (buf, Qnil); - Fset_window_buffer (root_window, buf); + buf = Fother_buffer (buf, Qnil, Qnil); + + /* Use set_window_buffer, not Fset_window_buffer, and don't let + hooks be run by it. The reason is that the whole frame/window + arrangement is not yet fully intialized at this point. Windows + don't have the right size, glyph matrices aren't initialized + etc. Running Lisp functions at this point surely ends in a + SEGV. */ + set_window_buffer (root_window, buf, 0); + f->buffer_list = Fcons (buf, Qnil); } if (mini_p) { XWINDOW (mini_window)->buffer = Qt; - Fset_window_buffer (mini_window, - (NILP (Vminibuffer_list) - ? get_minibuffer (0) - : Fcar (Vminibuffer_list))); + set_window_buffer (mini_window, + (NILP (Vminibuffer_list) + ? get_minibuffer (0) + : Fcar (Vminibuffer_list)), + 0); } f->root_window = root_window; @@ -363,6 +326,7 @@ make_frame (mini_p) return f; } +#ifdef HAVE_WINDOW_SYSTEM /* Make a frame using a separate minibuffer window on another frame. MINI_WINDOW is the minibuffer window to use. nil means use the default (the global minibuffer). */ @@ -374,6 +338,7 @@ make_frame_without_minibuffer (mini_window, kb, display) Lisp_Object display; { register struct frame *f; + struct gcpro gcpro1; if (!NILP (mini_window)) CHECK_LIVE_WINDOW (mini_window, 0); @@ -393,18 +358,28 @@ make_frame_without_minibuffer (mini_window, kb, display) if (!FRAMEP (kb->Vdefault_minibuffer_frame) || ! FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame))) { + Lisp_Object frame_dummy; + + XSETFRAME (frame_dummy, f); + GCPRO1 (frame_dummy); /* If there's no minibuffer frame to use, create one. */ - kb->Vdefault_minibuffer_frame - = call1 (intern ("make-initial-minibuffer-frame"), display); + kb->Vdefault_minibuffer_frame = + call1 (intern ("make-initial-minibuffer-frame"), display); + UNGCPRO; } + mini_window = XFRAME (kb->Vdefault_minibuffer_frame)->minibuffer_window; } - /* Install the chosen minibuffer window, with proper buffer. */ + f->minibuffer_window = mini_window; - Fset_window_buffer (mini_window, - (NILP (Vminibuffer_list) - ? get_minibuffer (0) - : Fcar (Vminibuffer_list))); + + /* Make the chosen minibuffer window display the proper minibuffer, + unless it is already showing a minibuffer. */ + if (NILP (Fmemq (XWINDOW (mini_window)->buffer, Vminibuffer_list))) + Fset_window_buffer (mini_window, + (NILP (Vminibuffer_list) + ? get_minibuffer (0) + : Fcar (Vminibuffer_list))); return f; } @@ -445,6 +420,7 @@ make_minibuffer_frame () : Fcar (Vminibuffer_list))); return f; } +#endif /* HAVE_WINDOW_SYSTEM */ /* Construct a frame that refers to the terminal (stdin and stdout). */ @@ -477,19 +453,51 @@ make_terminal_frame () Vframe_list = Fcons (frame, Vframe_list); terminal_frame_count++; - if (terminal_frame_count == 1) + sprintf (name, "F%d", terminal_frame_count); + f->name = build_string (name); + + f->visible = 1; /* FRAME_SET_VISIBLE wd set frame_garbaged. */ + f->async_visible = 1; /* Don't let visible be cleared later. */ +#ifdef MSDOS + f->output_data.x = &the_only_x_display; + if (!inhibit_window_system + && (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)) + || XFRAME (selected_frame)->output_method == output_msdos_raw)) { - f->name = build_string ("Emacs"); + f->output_method = output_msdos_raw; + /* This initialization of foreground and background pixels is + only important for the initial frame created in temacs. If + we don't do that, we get black background and foreground in + the dumped Emacs because the_only_x_display is a static + variable, hence it is born all-zeroes, and zero is the code + for the black color. Other frames all inherit their pixels + from what's already in the_only_x_display. */ + if ((!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame))) + && f->output_data.x->background_pixel == 0 + && f->output_data.x->foreground_pixel == 0) + { + f->output_data.x->background_pixel = FACE_TTY_DEFAULT_BG_COLOR; + f->output_data.x->foreground_pixel = FACE_TTY_DEFAULT_FG_COLOR; + } } else - { - sprintf (name, "Emacs-%d", terminal_frame_count); - f->name = build_string (name); - } + f->output_method = output_termcap; +#else +#ifdef WINDOWSNT + f->output_method = output_termcap; + f->output_data.x = &tty_display; +#else +#ifdef macintosh + make_mac_terminal_frame (f); +#else + f->output_data.x = &tty_display; +#endif /* macintosh */ +#endif /* WINDOWSNT */ +#endif /* MSDOS */ + + if (!noninteractive) + init_frame_faces (f); - f->visible = 1; /* FRAME_SET_VISIBLE wd set frame_garbaged. */ - f->async_visible = 1; /* Don't let visible be cleared later. */ - f->output_data.nothing = 1; /* Nonzero means frame isn't deleted. */ return f; } @@ -504,19 +512,42 @@ Note that changing the size of one terminal frame automatically affects all.") Lisp_Object parms; { struct frame *f; - Lisp_Object frame; + Lisp_Object frame, tem; + struct frame *sf = SELECTED_FRAME (); + +#ifdef MSDOS + if (sf->output_method != output_msdos_raw + && sf->output_method != output_termcap) + abort (); +#else /* not MSDOS */ - if (selected_frame->output_method != output_termcap) +#ifdef macintosh + if (sf->output_method != output_mac) + error ("Not running on a Macintosh screen; cannot make a new Macintosh frame"); +#else + if (sf->output_method != output_termcap) error ("Not using an ASCII terminal now; cannot make a new ASCII frame"); +#endif +#endif /* not MSDOS */ f = make_terminal_frame (); - change_frame_size (f, FRAME_HEIGHT (selected_frame), - FRAME_WIDTH (selected_frame), 0, 0); - remake_frame_glyphs (f); + + change_frame_size (f, FRAME_HEIGHT (sf), + FRAME_WIDTH (sf), 0, 0, 0); + adjust_glyphs (f); calculate_costs (f); XSETFRAME (frame, f); + Fmodify_frame_parameters (frame, Vdefault_frame_alist); Fmodify_frame_parameters (frame, parms); - f->face_alist = selected_frame->face_alist; + + /* Make the frame face alist be frame-specific, so that each + frame could change its face definitions independently. */ + f->face_alist = Fcopy_alist (sf->face_alist); + /* Simple Fcopy_alist isn't enough, because we need the contents of + the vectors which are the CDRs of associations in face_alist to + be copied as well. */ + for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem)) + XCDR (XCAR (tem)) = Fcopy_sequence (XCDR (XCAR (tem))); return frame; } @@ -525,12 +556,14 @@ do_switch_frame (frame, no_enter, track) Lisp_Object frame, no_enter; int track; { + struct frame *sf = SELECTED_FRAME (); + /* If FRAME is a switch-frame event, extract the frame we should switch to. */ if (CONSP (frame) - && EQ (XCONS (frame)->car, Qswitch_frame) - && CONSP (XCONS (frame)->cdr)) - frame = XCONS (XCONS (frame)->cdr)->car; + && EQ (XCAR (frame), Qswitch_frame) + && CONSP (XCDR (frame))) + frame = XCAR (XCDR (frame)); /* This used to say CHECK_LIVE_FRAME, but apparently it's possible for a switch-frame event to arrive after a frame is no longer live, @@ -539,7 +572,7 @@ do_switch_frame (frame, no_enter, track) if (! FRAME_LIVE_P (XFRAME (frame))) return Qnil; - if (selected_frame == XFRAME (frame)) + if (sf == XFRAME (frame)) return frame; /* This is too greedy; it causes inappropriate focus redirection @@ -556,17 +589,17 @@ do_switch_frame (frame, no_enter, track) { Lisp_Object tail; - for (tail = Vframe_list; CONSP (tail); tail = XCONS (tail)->cdr) + for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail)) { Lisp_Object focus; - if (!FRAMEP (XCONS (tail)->car)) + if (!FRAMEP (XCAR (tail))) abort (); - focus = FRAME_FOCUS_FRAME (XFRAME (XCONS (tail)->car)); + focus = FRAME_FOCUS_FRAME (XFRAME (XCAR (tail))); - if (FRAMEP (focus) && XFRAME (focus) == selected_frame) - Fredirect_frame_focus (XCONS (tail)->car, frame); + if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ()) + Fredirect_frame_focus (XCAR (tail), frame); } } #else /* ! 0 */ @@ -580,16 +613,19 @@ do_switch_frame (frame, no_enter, track) if (FRAMEP (xfocus)) { focus = FRAME_FOCUS_FRAME (XFRAME (xfocus)); - if (FRAMEP (focus) && XFRAME (focus) == selected_frame) + if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ()) Fredirect_frame_focus (xfocus, frame); } } #endif /* HAVE_X_WINDOWS */ #endif /* ! 0 */ - selected_frame = XFRAME (frame); - if (! FRAME_MINIBUF_ONLY_P (selected_frame)) - last_nonminibuf_frame = selected_frame; + if (FRAME_HAS_MINIBUF_P (sf)) + resize_mini_window (XWINDOW (FRAME_MINIBUF_WINDOW (sf)), 1); + + selected_frame = frame; + if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame))) + last_nonminibuf_frame = XFRAME (selected_frame); Fselect_window (XFRAME (frame)->selected_window); @@ -626,13 +662,13 @@ This function selects the selected window of the frame of EVENT.\n\ \n\ If EVENT is frame object, handle it as if it were a switch-frame event\n\ to that frame.") - (frame, no_enter) - Lisp_Object frame, no_enter; + (event, no_enter) + Lisp_Object event, no_enter; { /* Preserve prefix arg that the command loop just cleared. */ current_kboard->Vprefix_arg = Vcurrent_prefix_arg; call1 (Vrun_hooks, Qmouse_leave_buffer_hook); - return do_switch_frame (frame, no_enter, 0); + return do_switch_frame (event, no_enter, 0); } DEFUN ("ignore-event", Fignore_event, Signore_event, 0, 0, "", @@ -648,9 +684,7 @@ DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0, "Return the frame that is now selected.") () { - Lisp_Object tem; - XSETFRAME (tem, selected_frame); - return tem; + return selected_frame; } DEFUN ("window-frame", Fwindow_frame, Swindow_frame, 1, 1, 0, @@ -671,7 +705,7 @@ If omitted, FRAME defaults to the currently selected frame.") Lisp_Object w; if (NILP (frame)) - w = selected_frame->root_window; + w = SELECTED_FRAME ()->root_window; else { CHECK_LIVE_FRAME (frame, 0); @@ -703,12 +737,17 @@ If omitted, FRAME defaults to the currently selected frame.") (frame) Lisp_Object frame; { + Lisp_Object window; + if (NILP (frame)) - XSETFRAME (frame, selected_frame); + window = SELECTED_FRAME ()->root_window; else - CHECK_LIVE_FRAME (frame, 0); - - return XFRAME (frame)->root_window; + { + CHECK_LIVE_FRAME (frame, 0); + window = XFRAME (frame)->root_window; + } + + return window; } DEFUN ("frame-selected-window", Fframe_selected_window, @@ -718,12 +757,17 @@ If omitted, FRAME defaults to the currently selected frame.") (frame) Lisp_Object frame; { + Lisp_Object window; + if (NILP (frame)) - XSETFRAME (frame, selected_frame); + window = SELECTED_FRAME ()->selected_window; else - CHECK_LIVE_FRAME (frame, 0); + { + CHECK_LIVE_FRAME (frame, 0); + window = XFRAME (frame)->selected_window; + } - return XFRAME (frame)->selected_window; + return window; } DEFUN ("set-frame-selected-window", Fset_frame_selected_window, @@ -735,16 +779,15 @@ If FRAME is the selected frame, this makes WINDOW the selected window.") Lisp_Object frame, window; { if (NILP (frame)) - XSETFRAME (frame, selected_frame); - else - CHECK_LIVE_FRAME (frame, 0); - + frame = selected_frame; + + CHECK_LIVE_FRAME (frame, 0); CHECK_LIVE_WINDOW (window, 1); if (! EQ (frame, WINDOW_FRAME (XWINDOW (window)))) error ("In `set-frame-selected-window', WINDOW is not on FRAME"); - if (XFRAME (frame) == selected_frame) + if (EQ (frame, selected_frame)) return Fselect_window (window); return XFRAME (frame)->selected_window = window; @@ -783,11 +826,11 @@ next_frame (frame, minibuf) CHECK_LIVE_FRAME (frame, 0); while (1) - for (tail = Vframe_list; CONSP (tail); tail = XCONS (tail)->cdr) + for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail)) { Lisp_Object f; - f = XCONS (tail)->car; + f = XCAR (tail); if (passed && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame))) @@ -811,7 +854,7 @@ next_frame (frame, minibuf) if (FRAME_VISIBLE_P (XFRAME (f))) return f; } - else if (XFASTINT (minibuf) == 0) + else if (INTEGERP (minibuf) && XINT (minibuf) == 0) { FRAME_SAMPLE_VISIBILITY (XFRAME (f)); if (FRAME_VISIBLE_P (XFRAME (f)) @@ -821,11 +864,9 @@ next_frame (frame, minibuf) else if (WINDOWP (minibuf)) { if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf) - /* Check that F either is, or has forwarded its focus to, - MINIBUF's frame. */ - && (EQ (WINDOW_FRAME (XWINDOW (minibuf)), f) - || EQ (WINDOW_FRAME (XWINDOW (minibuf)), - FRAME_FOCUS_FRAME (XFRAME (f))))) + || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f) + || EQ (WINDOW_FRAME (XWINDOW (minibuf)), + FRAME_FOCUS_FRAME (XFRAME (f)))) return f; } else @@ -858,11 +899,11 @@ prev_frame (frame, minibuf) abort (); prev = Qnil; - for (tail = Vframe_list; CONSP (tail); tail = XCONS (tail)->cdr) + for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail)) { Lisp_Object f; - f = XCONS (tail)->car; + f = XCAR (tail); if (!FRAMEP (f)) abort (); @@ -881,11 +922,9 @@ prev_frame (frame, minibuf) else if (WINDOWP (minibuf)) { if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf) - /* Check that F either is, or has forwarded its focus to, - MINIBUF's frame. */ - && (EQ (WINDOW_FRAME (XWINDOW (minibuf)), f) - || EQ (WINDOW_FRAME (XWINDOW (minibuf)), - FRAME_FOCUS_FRAME (XFRAME (f))))) + || EQ (WINDOW_FRAME (XWINDOW (minibuf)), f) + || EQ (WINDOW_FRAME (XWINDOW (minibuf)), + FRAME_FOCUS_FRAME (XFRAME (f)))) prev = f; } else if (EQ (minibuf, Qvisible)) @@ -933,13 +972,10 @@ Otherwise, include all frames.") (frame, miniframe) Lisp_Object frame, miniframe; { - Lisp_Object tail; - if (NILP (frame)) - XSETFRAME (frame, selected_frame); - else - CHECK_LIVE_FRAME (frame, 0); - + frame = selected_frame; + + CHECK_LIVE_FRAME (frame, 0); return next_frame (frame, miniframe); } @@ -957,13 +993,9 @@ Otherwise, include all frames.") (frame, miniframe) Lisp_Object frame, miniframe; { - Lisp_Object tail; - if (NILP (frame)) - XSETFRAME (frame, selected_frame); - else - CHECK_LIVE_FRAME (frame, 0); - + frame = selected_frame; + CHECK_LIVE_FRAME (frame, 0); return prev_frame (frame, miniframe); } @@ -977,18 +1009,18 @@ other_visible_frames (f) { /* We know the selected frame is visible, so if F is some other frame, it can't be the sole visible one. */ - if (f == selected_frame) + if (f == SELECTED_FRAME ()) { Lisp_Object frames; int count = 0; for (frames = Vframe_list; CONSP (frames); - frames = XCONS (frames)->cdr) + frames = XCDR (frames)) { Lisp_Object this; - this = XCONS (frames)->car; + this = XCAR (frames); /* Verify that the frame's window still exists and we can still talk to it. And note any recent change in visibility. */ @@ -1017,16 +1049,20 @@ DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 2, "", If omitted, FRAME defaults to the selected frame.\n\ A frame may not be deleted if its minibuffer is used by other frames.\n\ Normally, you may not delete a frame if all other frames are invisible,\n\ -but if the second optional argument FORCE is non-nil, you may do so.") +but if the second optional argument FORCE is non-nil, you may do so.\n\ +\n\ +This function runs `delete-frame-hook' before actually deleting the\n\ +frame. The hook is called with one argument FRAME.") (frame, force) Lisp_Object frame, force; { struct frame *f; + struct frame *sf = SELECTED_FRAME (); int minibuffer_selected; if (EQ (frame, Qnil)) { - f = selected_frame; + f = sf; XSETFRAME (frame, f); } else @@ -1038,9 +1074,22 @@ but if the second optional argument FORCE is non-nil, you may do so.") if (! FRAME_LIVE_P (f)) return Qnil; - if (NILP (force) && !other_visible_frames (f)) + if (NILP (force) && !other_visible_frames (f) +#ifdef macintosh + /* Terminal frame deleted before any other visible frames are + created. */ + && strcmp (XSTRING (f->name)->data, "F1") != 0 +#endif + ) error ("Attempt to delete the sole visible or iconified frame"); +#if 0 + /* This is a nice idea, but x_connection_closed needs to be able + to delete the last frame, if it is gone. */ + if (NILP (XCDR (Vframe_list))) + error ("Attempt to delete the only frame"); +#endif + /* Does this frame have a minibuffer, and is it the surrogate minibuffer for any other frame? */ if (FRAME_HAS_MINIBUF_P (XFRAME (frame))) @@ -1049,10 +1098,10 @@ but if the second optional argument FORCE is non-nil, you may do so.") for (frames = Vframe_list; CONSP (frames); - frames = XCONS (frames)->cdr) + frames = XCDR (frames)) { Lisp_Object this; - this = XCONS (frames)->car; + this = XCAR (frames); if (! EQ (this, frame) && EQ (frame, @@ -1062,10 +1111,19 @@ but if the second optional argument FORCE is non-nil, you may do so.") } } + /* Run `delete-frame-hook'. */ + if (!NILP (Vrun_hooks)) + { + Lisp_Object args[2]; + args[0] = intern ("delete-frame-hook"); + args[1] = frame; + Frun_hook_with_args (2, args); + } + minibuffer_selected = EQ (minibuf_window, selected_window); /* Don't let the frame remain selected. */ - if (f == selected_frame) + if (f == sf) { Lisp_Object tail, frame1; @@ -1083,14 +1141,15 @@ but if the second optional argument FORCE is non-nil, you may do so.") } do_switch_frame (frame1, Qnil, 0); + sf = SELECTED_FRAME (); } /* Don't allow minibuf_window to remain on a deleted frame. */ if (EQ (f->minibuffer_window, minibuf_window)) { - Fset_window_buffer (selected_frame->minibuffer_window, + Fset_window_buffer (sf->minibuffer_window, XWINDOW (minibuf_window)->buffer); - minibuf_window = selected_frame->minibuffer_window; + minibuf_window = sf->minibuffer_window; /* If the dying minibuffer window was selected, select the new one. */ @@ -1098,12 +1157,22 @@ but if the second optional argument FORCE is non-nil, you may do so.") Fselect_window (minibuf_window); } + /* Don't let echo_area_window to remain on a deleted frame. */ + if (EQ (f->minibuffer_window, echo_area_window)) + echo_area_window = sf->minibuffer_window; + /* Clear any X selections for this frame. */ #ifdef HAVE_X_WINDOWS if (FRAME_X_P (f)) x_clear_frame_selections (f); #endif + /* Free glyphs. + This function must be called before the window tree of the + frame is deleted because windows contain dynamically allocated + memory. */ + free_glyphs (f); + /* Mark all the windows that used to be on FRAME as deleted, and then remove the reference to them. */ delete_all_subwindows (XWINDOW (f->root_window)); @@ -1113,21 +1182,17 @@ but if the second optional argument FORCE is non-nil, you may do so.") FRAME_SET_VISIBLE (f, 0); if (f->namebuf) - free (f->namebuf); - if (FRAME_CURRENT_GLYPHS (f)) - free_frame_glyphs (f, FRAME_CURRENT_GLYPHS (f)); - if (FRAME_DESIRED_GLYPHS (f)) - free_frame_glyphs (f, FRAME_DESIRED_GLYPHS (f)); - if (FRAME_TEMP_GLYPHS (f)) - free_frame_glyphs (f, FRAME_TEMP_GLYPHS (f)); + xfree (f->namebuf); if (FRAME_INSERT_COST (f)) - free (FRAME_INSERT_COST (f)); + xfree (FRAME_INSERT_COST (f)); if (FRAME_DELETEN_COST (f)) - free (FRAME_DELETEN_COST (f)); + xfree (FRAME_DELETEN_COST (f)); if (FRAME_INSERTN_COST (f)) - free (FRAME_INSERTN_COST (f)); + xfree (FRAME_INSERTN_COST (f)); if (FRAME_DELETE_COST (f)) - free (FRAME_DELETE_COST (f)); + xfree (FRAME_DELETE_COST (f)); + if (FRAME_MESSAGE_BUF (f)) + xfree (FRAME_MESSAGE_BUF (f)); /* Since some events are handled at the interrupt level, we may get an event for f at any time; if we zero out the frame's display @@ -1153,9 +1218,9 @@ but if the second optional argument FORCE is non-nil, you may do so.") for (frames = Vframe_list; CONSP (frames); - frames = XCONS (frames)->cdr) + frames = XCDR (frames)) { - f = XFRAME (XCONS (frames)->car); + f = XFRAME (XCAR (frames)); if (!FRAME_MINIBUF_ONLY_P (f)) { last_nonminibuf_frame = f; @@ -1181,12 +1246,12 @@ but if the second optional argument FORCE is non-nil, you may do so.") for (frames = Vframe_list; CONSP (frames); - frames = XCONS (frames)->cdr) + frames = XCDR (frames)) { Lisp_Object this; struct frame *f1; - this = XCONS (frames)->car; + this = XCAR (frames); if (!FRAMEP (this)) abort (); f1 = XFRAME (this); @@ -1223,6 +1288,9 @@ but if the second optional argument FORCE is non-nil, you may do so.") FRAME_KBOARD (f)->Vdefault_minibuffer_frame = Qnil; } + /* Cause frame titles to update--necessary if we now have just one frame. */ + update_mode_lines = 1; + return Qnil; } @@ -1234,23 +1302,26 @@ The position is given in character cells, where (0, 0) is the\n\ upper-left corner.\n\ If Emacs is running on a mouseless terminal or hasn't been programmed\n\ to read the mouse position, it returns the selected frame for FRAME\n\ -and nil for X and Y.") +and nil for X and Y.\n\ +Runs the abnormal hook `mouse-position-function' with the normal return\n\ +value as argument.") () { FRAME_PTR f; Lisp_Object lispy_dummy; enum scroll_bar_part party_dummy; - Lisp_Object x, y; + Lisp_Object x, y, retval; int col, row; unsigned long long_dummy; + struct gcpro gcpro1; - f = selected_frame; + f = SELECTED_FRAME (); x = y = Qnil; #ifdef HAVE_MOUSE /* It's okay for the hook to refrain from storing anything. */ if (mouse_position_hook) - (*mouse_position_hook) (&f, 0, + (*mouse_position_hook) (&f, -1, &lispy_dummy, &party_dummy, &x, &y, &long_dummy); @@ -1264,7 +1335,11 @@ and nil for X and Y.") } #endif XSETFRAME (lispy_dummy, f); - return Fcons (lispy_dummy, Fcons (x, y)); + retval = Fcons (lispy_dummy, Fcons (x, y)); + GCPRO1 (retval); + if (!NILP (Vmouse_position_function)) + retval = call1 (Vmouse_position_function, retval); + RETURN_UNGCPRO (retval); } DEFUN ("mouse-pixel-position", Fmouse_pixel_position, @@ -1281,16 +1356,15 @@ and nil for X and Y.") Lisp_Object lispy_dummy; enum scroll_bar_part party_dummy; Lisp_Object x, y; - int col, row; unsigned long long_dummy; - f = selected_frame; + f = SELECTED_FRAME (); x = y = Qnil; #ifdef HAVE_MOUSE /* It's okay for the hook to refrain from storing anything. */ if (mouse_position_hook) - (*mouse_position_hook) (&f, 0, + (*mouse_position_hook) (&f, -1, &lispy_dummy, &party_dummy, &x, &y, &long_dummy); @@ -1301,7 +1375,11 @@ and nil for X and Y.") DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0, "Move the mouse pointer to the center of character cell (X,Y) in FRAME.\n\ -Note, this is a no-op for an X frame that is not visible.\n\ +Coordinates are relative to the frame, not a window,\n\ +so the coordinates of the top left character in the frame\n\ +may be nonzero due to left-hand scroll bars or the menu bar.\n\ +\n\ +This function is a no-op for an X frame that is not visible.\n\ If you have just created a frame, you must wait for it to become visible\n\ before calling this function on it, like this.\n\ (while (not (frame-visible-p frame)) (sleep-for .5))") @@ -1316,7 +1394,15 @@ before calling this function on it, like this.\n\ #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (XFRAME (frame))) /* Warping the mouse will cause enternotify and focus events. */ - x_set_mouse_position (XFRAME (frame), x, y); + x_set_mouse_position (XFRAME (frame), XINT (x), XINT (y)); +#else +#if defined (MSDOS) && defined (HAVE_MOUSE) + if (FRAME_MSDOS_P (XFRAME (frame))) + { + Fselect_frame (frame, Qnil); + mouse_moveto (XINT (x), XINT (y)); + } +#endif #endif return Qnil; @@ -1340,12 +1426,22 @@ before calling this function on it, like this.\n\ #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (XFRAME (frame))) /* Warping the mouse will cause enternotify and focus events. */ - x_set_mouse_pixel_position (XFRAME (frame), x, y); + x_set_mouse_pixel_position (XFRAME (frame), XINT (x), XINT (y)); +#else +#if defined (MSDOS) && defined (HAVE_MOUSE) + if (FRAME_MSDOS_P (XFRAME (frame))) + { + Fselect_frame (frame, Qnil); + mouse_moveto (XINT (x), XINT (y)); + } +#endif #endif return Qnil; } +static void make_frame_visible_1 P_ ((Lisp_Object)); + DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible, 0, 1, "", "Make the frame FRAME visible (assuming it is an X-window).\n\ @@ -1354,7 +1450,7 @@ If omitted, FRAME defaults to the currently selected frame.") Lisp_Object frame; { if (NILP (frame)) - XSETFRAME (frame, selected_frame); + frame = selected_frame; CHECK_LIVE_FRAME (frame, 0); @@ -1367,12 +1463,37 @@ If omitted, FRAME defaults to the currently selected frame.") } #endif + make_frame_visible_1 (XFRAME (frame)->root_window); + /* Make menu bar update for the Buffers and Frams menus. */ windows_or_buffers_changed++; return frame; } +/* Update the display_time slot of the buffers shown in WINDOW + and all its descendents. */ + +static void +make_frame_visible_1 (window) + Lisp_Object window; +{ + struct window *w; + + for (;!NILP (window); window = w->next) + { + w = XWINDOW (window); + + if (!NILP (w->buffer)) + XBUFFER (w->buffer)->display_time = Fcurrent_time (); + + if (!NILP (w->vchild)) + make_frame_visible_1 (w->vchild); + if (!NILP (w->hchild)) + make_frame_visible_1 (w->hchild); + } +} + DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible, 0, 2, "", "Make the frame FRAME invisible (assuming it is an X-window).\n\ @@ -1383,7 +1504,7 @@ but if the second optional argument FORCE is non-nil, you may do so.") Lisp_Object frame, force; { if (NILP (frame)) - XSETFRAME (frame, selected_frame); + frame = selected_frame; CHECK_LIVE_FRAME (frame, 0); @@ -1392,16 +1513,17 @@ but if the second optional argument FORCE is non-nil, you may do so.") #if 0 /* This isn't logically necessary, and it can do GC. */ /* Don't let the frame remain selected. */ - if (XFRAME (frame) == selected_frame) + if (EQ (frame, selected_frame)) do_switch_frame (next_frame (frame, Qt), Qnil, 0) #endif /* Don't allow minibuf_window to remain on a deleted frame. */ if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window)) { - Fset_window_buffer (selected_frame->minibuffer_window, + struct frame *sf = XFRAME (selected_frame); + Fset_window_buffer (sf->minibuffer_window, XWINDOW (minibuf_window)->buffer); - minibuf_window = selected_frame->minibuffer_window; + minibuf_window = sf->minibuffer_window; } /* I think this should be done with a hook. */ @@ -1424,22 +1546,23 @@ If omitted, FRAME defaults to the currently selected frame.") Lisp_Object frame; { if (NILP (frame)) - XSETFRAME (frame, selected_frame); + frame = selected_frame; CHECK_LIVE_FRAME (frame, 0); #if 0 /* This isn't logically necessary, and it can do GC. */ /* Don't let the frame remain selected. */ - if (XFRAME (frame) == selected_frame) + if (EQ (frame, selected_frame)) Fhandle_switch_frame (next_frame (frame, Qt), Qnil); #endif /* Don't allow minibuf_window to remain on a deleted frame. */ if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window)) { - Fset_window_buffer (selected_frame->minibuffer_window, + struct frame *sf = XFRAME (selected_frame); + Fset_window_buffer (sf->minibuffer_window, XWINDOW (minibuf_window)->buffer); - minibuf_window = selected_frame->minibuffer_window; + minibuf_window = sf->minibuffer_window; } /* I think this should be done with a hook. */ @@ -1484,9 +1607,9 @@ DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list, Lisp_Object value; value = Qnil; - for (tail = Vframe_list; CONSP (tail); tail = XCONS (tail)->cdr) + for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail)) { - frame = XCONS (tail)->car; + frame = XCAR (tail); if (!FRAMEP (frame)) continue; f = XFRAME (frame); @@ -1507,7 +1630,7 @@ doesn't support multiple overlapping frames, this function does nothing.") Lisp_Object frame; { if (NILP (frame)) - XSETFRAME (frame, selected_frame); + frame = selected_frame; CHECK_LIVE_FRAME (frame, 0); @@ -1530,7 +1653,7 @@ doesn't support multiple overlapping frames, this function does nothing.") Lisp_Object frame; { if (NILP (frame)) - XSETFRAME (frame, selected_frame); + frame = selected_frame; CHECK_LIVE_FRAME (frame, 0); @@ -1579,13 +1702,6 @@ The redirection lasts until `redirect-frame-focus' is called to change it.") XFRAME (frame)->focus_frame = focus_frame; - /* I think this should be done with a hook. */ -#ifdef HAVE_WINDOW_SYSTEM - if (!NILP (focus_frame) && ! EQ (focus_frame, frame) - && (FRAME_WINDOW_P (XFRAME (focus_frame)))) - Ffocus_frame (focus_frame); -#endif - if (frame_rehighlight_hook) (*frame_rehighlight_hook) (XFRAME (frame)); @@ -1625,9 +1741,63 @@ get_frame_param (frame, prop) /* Return the buffer-predicate of the selected frame. */ Lisp_Object -frame_buffer_predicate () +frame_buffer_predicate (frame) + Lisp_Object frame; +{ + return XFRAME (frame)->buffer_predicate; +} + +/* Return the buffer-list of the selected frame. */ + +Lisp_Object +frame_buffer_list (frame) + Lisp_Object frame; +{ + return XFRAME (frame)->buffer_list; +} + +/* Set the buffer-list of the selected frame. */ + +void +set_frame_buffer_list (frame, list) + Lisp_Object frame, list; +{ + XFRAME (frame)->buffer_list = list; +} + +/* Discard BUFFER from the buffer-list of each frame. */ + +void +frames_discard_buffer (buffer) + Lisp_Object buffer; +{ + Lisp_Object frame, tail; + + FOR_EACH_FRAME (tail, frame) + { + XFRAME (frame)->buffer_list + = Fdelq (buffer, XFRAME (frame)->buffer_list); + } +} + +/* Move BUFFER to the end of the buffer-list of each frame. */ + +void +frames_bury_buffer (buffer) + Lisp_Object buffer; { - return selected_frame->buffer_predicate; + Lisp_Object frame, tail; + + FOR_EACH_FRAME (tail, frame) + { + struct frame *f = XFRAME (frame); + Lisp_Object found; + + found = Fmemq (buffer, f->buffer_list); + if (!NILP (found)) + f->buffer_list = nconc2 (Fdelq (buffer, f->buffer_list), + Fcons (buffer, Qnil)); + } } /* Modify the alist in *ALISTPTR to associate PROP with VAL. @@ -1647,33 +1817,125 @@ store_in_alist (alistptr, prop, val) Fsetcdr (tem, val); } +static int +frame_name_fnn_p (str, len) + char *str; + int len; +{ + if (len > 1 && str[0] == 'F') + { + char *end_ptr; + + strtol (str + 1, &end_ptr, 10); + + if (end_ptr == str + len) + return 1; + } + return 0; +} + +/* Set the name of the terminal frame. Also used by MSDOS frames. + Modeled after x_set_name which is used for WINDOW frames. */ + +void +set_term_frame_name (f, name) + struct frame *f; + Lisp_Object name; +{ + f->explicit_name = ! NILP (name); + + /* If NAME is nil, set the name to F. */ + if (NILP (name)) + { + char namebuf[20]; + + /* Check for no change needed in this very common case + before we do any consing. */ + if (frame_name_fnn_p (XSTRING (f->name)->data, + STRING_BYTES (XSTRING (f->name)))) + return; + + terminal_frame_count++; + sprintf (namebuf, "F%d", terminal_frame_count); + name = build_string (namebuf); + } + else + { + CHECK_STRING (name, 0); + + /* Don't change the name if it's already NAME. */ + if (! NILP (Fstring_equal (name, f->name))) + return; + + /* Don't allow the user to set the frame name to F, so it + doesn't clash with the names we generate for terminal frames. */ + if (frame_name_fnn_p (XSTRING (name)->data, STRING_BYTES (XSTRING (name)))) + error ("Frame names of the form F are usurped by Emacs"); + } + + f->name = name; + update_mode_lines = 1; +} + void store_frame_param (f, prop, val) struct frame *f; Lisp_Object prop, val; { - register Lisp_Object tem; + register Lisp_Object old_alist_elt; - tem = Fassq (prop, f->param_alist); - if (EQ (tem, Qnil)) + /* The buffer-alist parameter is stored in a special place and is + not in the alist. */ + if (EQ (prop, Qbuffer_list)) + { + f->buffer_list = val; + return; + } + + /* If PROP is a symbol which is supposed to have frame-local values, + and it is set up based on this frame, switch to the global + binding. That way, we can create or alter the frame-local binding + without messing up the symbol's status. */ + if (SYMBOLP (prop)) + { + Lisp_Object valcontents; + valcontents = XSYMBOL (prop)->value; + if ((BUFFER_LOCAL_VALUEP (valcontents) + || SOME_BUFFER_LOCAL_VALUEP (valcontents)) + && XBUFFER_LOCAL_VALUE (valcontents)->check_frame + && XFRAME (XBUFFER_LOCAL_VALUE (valcontents)->frame) == f) + swap_in_global_binding (prop); + } + + /* Update the frame parameter alist. */ + old_alist_elt = Fassq (prop, f->param_alist); + if (EQ (old_alist_elt, Qnil)) f->param_alist = Fcons (Fcons (prop, val), f->param_alist); else - Fsetcdr (tem, val); + Fsetcdr (old_alist_elt, val); + /* Update some other special parameters in their special places + in addition to the alist. */ + if (EQ (prop, Qbuffer_predicate)) f->buffer_predicate = val; if (! FRAME_WINDOW_P (f)) - if (EQ (prop, Qmenu_bar_lines)) - set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f))); + { + if (EQ (prop, Qmenu_bar_lines)) + set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f))); + else if (EQ (prop, Qname)) + set_term_frame_name (f, val); + } if (EQ (prop, Qminibuffer) && WINDOWP (val)) { if (! MINI_WINDOW_P (XWINDOW (val))) error ("Surrogate minibuffer windows must be minibuffer windows."); - if (FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f)) - error ("can't change the surrogate minibuffer of a frame with its own minibuffer"); + if ((FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f)) + && !EQ (val, f->minibuffer_window)) + error ("Can't change the surrogate minibuffer of a frame with its own minibuffer"); /* Install the chosen minibuffer window, with proper buffer. */ f->minibuffer_window = val; @@ -1690,28 +1952,77 @@ If FRAME is omitted, return information on the currently selected frame.") { Lisp_Object alist; FRAME_PTR f; + int height, width; + struct gcpro gcpro1; if (EQ (frame, Qnil)) - f = selected_frame; - else - { - CHECK_FRAME (frame, 0); - f = XFRAME (frame); - } + frame = selected_frame; + + CHECK_FRAME (frame, 0); + f = XFRAME (frame); if (!FRAME_LIVE_P (f)) return Qnil; alist = Fcopy_alist (f->param_alist); + GCPRO1 (alist); + + if (!FRAME_WINDOW_P (f)) + { + int fg = FRAME_FOREGROUND_PIXEL (f); + int bg = FRAME_BACKGROUND_PIXEL (f); + Lisp_Object elt; + + /* If the frame's parameter alist says the colors are + unspecified and reversed, take the frame's background pixel + for foreground and vice versa. */ + elt = Fassq (Qforeground_color, alist); + if (!NILP (elt) && CONSP (elt) && STRINGP (XCDR (elt))) + { + if (strncmp (XSTRING (XCDR (elt))->data, + unspecified_bg, + XSTRING (XCDR (elt))->size) == 0) + store_in_alist (&alist, Qforeground_color, tty_color_name (f, bg)); + else if (strncmp (XSTRING (XCDR (elt))->data, + unspecified_fg, + XSTRING (XCDR (elt))->size) == 0) + store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg)); + } + else + store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg)); + elt = Fassq (Qbackground_color, alist); + if (!NILP (elt) && CONSP (elt) && STRINGP (XCDR (elt))) + { + if (strncmp (XSTRING (XCDR (elt))->data, + unspecified_fg, + XSTRING (XCDR (elt))->size) == 0) + store_in_alist (&alist, Qbackground_color, tty_color_name (f, fg)); + else if (strncmp (XSTRING (XCDR (elt))->data, + unspecified_bg, + XSTRING (XCDR (elt))->size) == 0) + store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg)); + } + else + store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg)); + store_in_alist (&alist, intern ("font"), + build_string (FRAME_MSDOS_P (f) + ? "ms-dos" + : FRAME_W32_P (f) ? "w32term" + :"tty")); + } store_in_alist (&alist, Qname, f->name); - store_in_alist (&alist, Qheight, make_number (FRAME_HEIGHT (f))); - store_in_alist (&alist, Qwidth, make_number (FRAME_WIDTH (f))); + height = (FRAME_NEW_HEIGHT (f) ? FRAME_NEW_HEIGHT (f) : FRAME_HEIGHT (f)); + store_in_alist (&alist, Qheight, make_number (height)); + width = (FRAME_NEW_WIDTH (f) ? FRAME_NEW_WIDTH (f) : FRAME_WIDTH (f)); + store_in_alist (&alist, Qwidth, make_number (width)); store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil)); store_in_alist (&alist, Qminibuffer, (! FRAME_HAS_MINIBUF_P (f) ? Qnil : FRAME_MINIBUF_ONLY_P (f) ? Qonly : FRAME_MINIBUF_WINDOW (f))); store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil)); + store_in_alist (&alist, Qbuffer_list, + frame_buffer_list (selected_frame)); /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM @@ -1725,28 +2036,117 @@ If FRAME is omitted, return information on the currently selected frame.") XSETFASTINT (lines, FRAME_MENU_BAR_LINES (f)); store_in_alist (&alist, Qmenu_bar_lines, lines); } + + UNGCPRO; return alist; } -DEFUN ("modify-frame-parameters", Fmodify_frame_parameters, - Smodify_frame_parameters, 2, 2, 0, - "Modify the parameters of frame FRAME according to ALIST.\n\ -ALIST is an alist of parameters to change and their new values.\n\ -Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.\n\ -The meaningful PARMs depend on the kind of frame; undefined PARMs are ignored.") - (frame, alist) - Lisp_Object frame, alist; + +DEFUN ("frame-parameter", Fframe_parameter, Sframe_parameter, 2, 2, 0, + "Return FRAME's value for parameter PARAMETER.\n\ +If FRAME is nil, describe the currently selected frame.") + (frame, parameter) + Lisp_Object frame, parameter; { - FRAME_PTR f; - register Lisp_Object tail, elt, prop, val; + struct frame *f; + Lisp_Object value; - if (EQ (frame, Qnil)) - f = selected_frame; + if (NILP (frame)) + frame = selected_frame; else + CHECK_FRAME (frame, 0); + CHECK_SYMBOL (parameter, 1); + + f = XFRAME (frame); + value = Qnil; + + if (FRAME_LIVE_P (f)) { - CHECK_LIVE_FRAME (frame, 0); - f = XFRAME (frame); + if (EQ (parameter, Qname)) + value = f->name; +#ifdef HAVE_X_WINDOWS + else if (EQ (parameter, Qdisplay) && FRAME_X_P (f)) + value = XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element); +#endif /* HAVE_X_WINDOWS */ + else + { + value = Fassq (parameter, f->param_alist); + if (CONSP (value)) + { + value = XCDR (value); + /* Fframe_parameters puts the actual fg/bg color names, + even if f->param_alist says otherwise. This is + important when param_alist's notion of colors is + "unspecified". We need to do the same here. */ + if (STRINGP (value) && !FRAME_WINDOW_P (f)) + { + char *color_name; + EMACS_INT csz; + + if (EQ (parameter, Qbackground_color)) + { + color_name = XSTRING (value)->data; + csz = XSTRING (value)->size; + if (strncmp (color_name, unspecified_bg, csz) == 0) + value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f)); + else if (strncmp (color_name, unspecified_fg, csz) == 0) + value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f)); + } + else if (EQ (parameter, Qforeground_color)) + { + color_name = XSTRING (value)->data; + csz = XSTRING (value)->size; + if (strncmp (color_name, unspecified_fg, csz) == 0) + value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f)); + else if (strncmp (color_name, unspecified_bg, csz) == 0) + value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f)); + } + } + } + else if (EQ (parameter, Qdisplay_type) + || EQ (parameter, Qbackground_mode)) + /* Avoid consing in frequent cases. */ + value = Qnil; + else + value = Fcdr (Fassq (parameter, Fframe_parameters (frame))); + } } + + return value; +} + + +DEFUN ("modify-frame-parameters", Fmodify_frame_parameters, + Smodify_frame_parameters, 2, 2, 0, + "Modify the parameters of frame FRAME according to ALIST.\n\ +ALIST is an alist of parameters to change and their new values.\n\ +Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.\n\ +The meaningful PARMs depend on the kind of frame.\n\ +Undefined PARMs are ignored, but stored in the frame's parameter list\n\ +so that `frame-parameters' will return them.\n\ +\n\ +The value of frame parameter FOO can also be accessed\n\ +as a frame-local binding for the variable FOO, if you have\n\ +enabled such bindings for that variable with `make-variable-frame-local'.") + (frame, alist) + Lisp_Object frame, alist; +{ + FRAME_PTR f; + register Lisp_Object tail, prop, val; + int count = BINDING_STACK_SIZE (); + + /* Bind this to t to inhibit initialization of the default face from + X resources in face-set-after-frame-default. If we don't inhibit + this, modifying the `font' frame parameter, for example, while + there is a `default.attributeFont' X resource, won't work, + because `default's font is reset to the value of the X resource + and that resets the `font' frame parameter. */ + specbind (Qinhibit_default_face_x_resources, Qt); + + if (EQ (frame, Qnil)) + frame = selected_frame; + CHECK_LIVE_FRAME (frame, 0); + f = XFRAME (frame); /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM @@ -1754,15 +2154,43 @@ The meaningful PARMs depend on the kind of frame; undefined PARMs are ignored.") x_set_frame_parameters (f, alist); else #endif - for (tail = alist; !EQ (tail, Qnil); tail = Fcdr (tail)) - { - elt = Fcar (tail); - prop = Fcar (elt); - val = Fcdr (elt); - store_frame_param (f, prop, val); - } +#ifdef MSDOS + if (FRAME_MSDOS_P (f)) + IT_set_frame_parameters (f, alist); + else +#endif - return Qnil; + { + int length = XINT (Flength (alist)); + int i; + Lisp_Object *parms + = (Lisp_Object *) alloca (length * sizeof (Lisp_Object)); + Lisp_Object *values + = (Lisp_Object *) alloca (length * sizeof (Lisp_Object)); + + /* Extract parm names and values into those vectors. */ + + i = 0; + for (tail = alist; CONSP (tail); tail = Fcdr (tail)) + { + Lisp_Object elt; + + elt = Fcar (tail); + parms[i] = Fcar (elt); + values[i] = Fcdr (elt); + i++; + } + + /* Now process them in reverse of specified order. */ + for (i--; i >= 0; i--) + { + prop = parms[i]; + val = values[i]; + store_frame_param (f, prop, val); + } + } + + return unbind_to (count, Qnil); } DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height, @@ -1776,12 +2204,9 @@ For a terminal frame, the value is always 1.") struct frame *f; if (NILP (frame)) - f = selected_frame; - else - { - CHECK_FRAME (frame, 0); - f = XFRAME (frame); - } + frame = selected_frame; + CHECK_FRAME (frame, 0); + f = XFRAME (frame); #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) @@ -1805,12 +2230,9 @@ For a terminal screen, the value is always 1.") struct frame *f; if (NILP (frame)) - f = selected_frame; - else - { - CHECK_FRAME (frame, 0); - f = XFRAME (frame); - } + frame = selected_frame; + CHECK_FRAME (frame, 0); + f = XFRAME (frame); #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) @@ -1823,6 +2245,8 @@ For a terminal screen, the value is always 1.") DEFUN ("frame-pixel-height", Fframe_pixel_height, Sframe_pixel_height, 0, 1, 0, "Return a FRAME's height in pixels.\n\ +This counts only the height available for text lines,\n\ +not menu bars on window-system Emacs frames.\n\ For a terminal frame, the result really gives the height in characters.\n\ If FRAME is omitted, the selected frame is used.") (frame) @@ -1831,12 +2255,9 @@ If FRAME is omitted, the selected frame is used.") struct frame *f; if (NILP (frame)) - f = selected_frame; - else - { - CHECK_FRAME (frame, 0); - f = XFRAME (frame); - } + frame = selected_frame; + CHECK_FRAME (frame, 0); + f = XFRAME (frame); #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) @@ -1857,12 +2278,9 @@ If FRAME is omitted, the selected frame is used.") struct frame *f; if (NILP (frame)) - f = selected_frame; - else - { - CHECK_FRAME (frame, 0); - f = XFRAME (frame); - } + frame = selected_frame; + CHECK_FRAME (frame, 0); + f = XFRAME (frame); #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) @@ -1876,30 +2294,28 @@ DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0, "Specify that the frame FRAME has LINES lines.\n\ Optional third arg non-nil means that redisplay should use LINES lines\n\ but that the idea of the actual height of the frame should not be changed.") - (frame, rows, pretend) - Lisp_Object frame, rows, pretend; + (frame, lines, pretend) + Lisp_Object frame, lines, pretend; { register struct frame *f; - CHECK_NUMBER (rows, 0); + CHECK_NUMBER (lines, 0); if (NILP (frame)) - f = selected_frame; - else - { - CHECK_LIVE_FRAME (frame, 0); - f = XFRAME (frame); - } + frame = selected_frame; + CHECK_LIVE_FRAME (frame, 0); + f = XFRAME (frame); /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) { - if (XINT (rows) != f->height) - x_set_window_size (f, 1, f->width, XINT (rows)); + if (XINT (lines) != f->height) + x_set_window_size (f, 1, f->width, XINT (lines)); + do_pending_window_change (0); } else #endif - change_frame_size (f, XINT (rows), 0, !NILP (pretend), 0); + change_frame_size (f, XINT (lines), 0, !NILP (pretend), 0, 0); return Qnil; } @@ -1913,12 +2329,9 @@ but that the idea of the actual width of the frame should not be changed.") register struct frame *f; CHECK_NUMBER (cols, 0); if (NILP (frame)) - f = selected_frame; - else - { - CHECK_LIVE_FRAME (frame, 0); - f = XFRAME (frame); - } + frame = selected_frame; + CHECK_LIVE_FRAME (frame, 0); + f = XFRAME (frame); /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM @@ -1926,10 +2339,11 @@ but that the idea of the actual width of the frame should not be changed.") { if (XINT (cols) != f->width) x_set_window_size (f, 1, XINT (cols), f->height); + do_pending_window_change (0); } else #endif - change_frame_size (f, 0, XINT (cols), !NILP (pretend), 0); + change_frame_size (f, 0, XINT (cols), !NILP (pretend), 0, 0); return Qnil; } @@ -1939,7 +2353,6 @@ DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0, Lisp_Object frame, cols, rows; { register struct frame *f; - int mask; CHECK_LIVE_FRAME (frame, 0); CHECK_NUMBER (cols, 2); @@ -1950,12 +2363,14 @@ DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0, #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) { - if (XINT (rows) != f->height || XINT (cols) != f->width) + if (XINT (rows) != f->height || XINT (cols) != f->width + || FRAME_NEW_HEIGHT (f) || FRAME_NEW_WIDTH (f)) x_set_window_size (f, 1, XINT (cols), XINT (rows)); + do_pending_window_change (0); } else #endif - change_frame_size (f, XINT (rows), XINT (cols), 0, 0); + change_frame_size (f, XINT (rows), XINT (cols), 0, 0, 0); return Qnil; } @@ -1970,7 +2385,6 @@ the rightmost or bottommost possible position (that stays within the screen).") Lisp_Object frame, xoffset, yoffset; { register struct frame *f; - int mask; CHECK_LIVE_FRAME (frame, 0); CHECK_NUMBER (xoffset, 1); @@ -1987,11 +2401,70 @@ the rightmost or bottommost possible position (that stays within the screen).") } +void syms_of_frame () { - syms_of_frame_1 (); + Qframep = intern ("framep"); + staticpro (&Qframep); + Qframe_live_p = intern ("frame-live-p"); + staticpro (&Qframe_live_p); + Qheight = intern ("height"); + staticpro (&Qheight); + Qicon = intern ("icon"); + staticpro (&Qicon); + Qminibuffer = intern ("minibuffer"); + staticpro (&Qminibuffer); + Qmodeline = intern ("modeline"); + staticpro (&Qmodeline); + Qname = intern ("name"); + staticpro (&Qname); + Qonly = intern ("only"); + staticpro (&Qonly); + Qunsplittable = intern ("unsplittable"); + staticpro (&Qunsplittable); + Qmenu_bar_lines = intern ("menu-bar-lines"); + staticpro (&Qmenu_bar_lines); + Qtool_bar_lines = intern ("tool-bar-lines"); + staticpro (&Qtool_bar_lines); + Qwidth = intern ("width"); + staticpro (&Qwidth); + Qx = intern ("x"); + staticpro (&Qx); + Qw32 = intern ("w32"); + staticpro (&Qw32); + Qpc = intern ("pc"); + staticpro (&Qpc); + Qmac = intern ("mac"); + staticpro (&Qmac); + Qvisible = intern ("visible"); + staticpro (&Qvisible); + Qbuffer_predicate = intern ("buffer-predicate"); + staticpro (&Qbuffer_predicate); + Qbuffer_list = intern ("buffer-list"); + staticpro (&Qbuffer_list); + Qtitle = intern ("title"); + staticpro (&Qtitle); + Qdisplay_type = intern ("display-type"); + staticpro (&Qdisplay_type); + Qbackground_mode = intern ("background-mode"); + staticpro (&Qbackground_mode); - staticpro (&Vframe_list); + DEFVAR_LISP ("default-frame-alist", &Vdefault_frame_alist, + "Alist of default values for frame creation.\n\ +These may be set in your init file, like this:\n\ + (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1))\n\ +These override values given in window system configuration data,\n\ + including X Windows' defaults database.\n\ +For values specific to the first Emacs frame, see `initial-frame-alist'.\n\ +For values specific to the separate minibuffer frame, see\n\ + `minibuffer-frame-alist'.\n\ +The `menu-bar-lines' element of the list controls whether new frames\n\ + have menu bars; `menu-bar-mode' works by altering this element."); + Vdefault_frame_alist = Qnil; + + Qinhibit_default_face_x_resources + = intern ("inhibit-default-face-x-resources"); + staticpro (&Qinhibit_default_face_x_resources); DEFVAR_LISP ("terminal-frame", &Vterminal_frame, "The initial frame-object, which represents Emacs's stdout."); @@ -2000,6 +2473,12 @@ syms_of_frame () "Non-nil if all of emacs is iconified and frame updates are not needed."); Vemacs_iconified = Qnil; + DEFVAR_LISP ("mouse-position-function", &Vmouse_position_function, + "If non-nil, function applied to the normal result of `mouse-position'.\n\ +This abnormal hook exists for the benefit of packages like XTerm-mouse\n\ +which need to do mouse handling at the Lisp level."); + Vmouse_position_function = Qnil; + DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame, "Minibufferless frames use this frame's minibuffer.\n\ \n\ @@ -2013,6 +2492,8 @@ this variable doesn't necessarily say anything meaningful about the\n\ current set of frames, or where the minibuffer is currently being\n\ displayed."); + staticpro (&Vframe_list); + defsubr (&Sactive_minibuffer_window); defsubr (&Sframep); defsubr (&Sframe_live_p); @@ -2048,6 +2529,7 @@ displayed."); defsubr (&Sredirect_frame_focus); defsubr (&Sframe_focus); defsubr (&Sframe_parameters); + defsubr (&Sframe_parameter); defsubr (&Smodify_frame_parameters); defsubr (&Sframe_char_height); defsubr (&Sframe_char_width); @@ -2059,6 +2541,7 @@ displayed."); defsubr (&Sset_frame_position); } +void keys_of_frame () { initial_define_lispy_key (global_map, "switch-frame", "handle-switch-frame"); @@ -2066,424 +2549,3 @@ keys_of_frame () initial_define_lispy_key (global_map, "iconify-frame", "ignore-event"); initial_define_lispy_key (global_map, "make-frame-visible", "ignore-event"); } - -#else /* not MULTI_FRAME */ - -/* If we're not using multi-frame stuff, we still need to provide some - support functions. */ - -/* Unless this function is defined, providing set-frame-height and - set-frame-width doesn't help compatibility any, since they both - want this as their first argument. */ -DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0, - /* Don't confuse make-docfile by having two doc strings for this function. - make-docfile does not pay attention to #if, for good reason! */ - 0) - () -{ - /* For your possible information, this code is unfolded into the - second WINDOW_FRAME in frame.h. */ - Lisp_Object tem; - XSETFASTINT (tem, 0); - return tem; -} - -DEFUN ("active-minibuffer-window", Factive_minibuffer_window, - Sactive_minibuffer_window, 0, 0, 0, - /* Don't confuse make-docfile by having two doc strings for this function. - make-docfile does not pay attention to #if, for good reason! */ - 0) - () -{ - return minibuf_level ? minibuf_window : Qnil; -} - -DEFUN ("window-frame", Fwindow_frame, Swindow_frame, 1, 1, 0, - /* Don't confuse make-docfile by having two doc strings for this function. - make-docfile does not pay attention to #if, for good reason! */ - 0) - (window) - Lisp_Object window; -{ - /* For your possible information, this code is unfolded into the - second WINDOW_FRAME in frame.h. */ - Lisp_Object tem; - XSETFASTINT (tem, 0); - return tem; -} - -DEFUN ("frame-first-window", Fframe_first_window, Sframe_first_window, 0, 1, 0, - 0) - (frame) - Lisp_Object frame; -{ - Lisp_Object w; - - w = FRAME_ROOT_WINDOW (selected_frame); - - while (NILP (XWINDOW (w)->buffer)) - { - if (! NILP (XWINDOW (w)->hchild)) - w = XWINDOW (w)->hchild; - else if (! NILP (XWINDOW (w)->vchild)) - w = XWINDOW (w)->vchild; - else - abort (); - } - return w; -} - -DEFUN ("framep", Fframep, Sframep, 1, 1, 0, - /* Don't confuse make-docfile by having two doc strings for this function. - make-docfile does not pay attention to #if, for good reason! */ - 0) - (object) - Lisp_Object object; -{ -#ifdef MSDOS - if (FRAME_X_P (object)) - return intern ("pc"); -#endif - return Qnil; -} - -DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0, - /* Don't confuse make-docfile by having two doc strings for this function. - make-docfile does not pay attention to #if, for good reason! */ - 0) - (frame, rows, pretend) - Lisp_Object frame, rows, pretend; -{ - CHECK_NUMBER (rows, 0); - - change_frame_size (0, XINT (rows), 0, !NILP (pretend), 0); - return Qnil; -} - -DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 3, 0, - /* Don't confuse make-docfile by having two doc strings for this function. - make-docfile does not pay attention to #if, for good reason! */ - 0) - (frame, cols, pretend) - Lisp_Object frame, cols, pretend; -{ - CHECK_NUMBER (cols, 0); - - change_frame_size (0, 0, XINT (cols), !NILP (pretend), 0); - return Qnil; -} - -DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0, - /* Don't confuse make-docfile by having two doc strings for this function. - make-docfile does not pay attention to #if, for good reason! */ - 0) - (frame, cols, rows) - Lisp_Object frame, cols, rows; -{ - CHECK_NUMBER (cols, 2); - CHECK_NUMBER (rows, 1); - - change_frame_size (0, XINT (rows), XINT (cols), 0, 0); - - return Qnil; -} - -DEFUN ("frame-height", Fframe_height, Sframe_height, 0, 1, 0, - /* Don't confuse make-docfile by having two doc strings for this function. - make-docfile does not pay attention to #if, for good reason! */ - 0) - (frame) - Lisp_Object frame; -{ - return make_number (FRAME_HEIGHT (selected_frame)); -} - -DEFUN ("frame-width", Fframe_width, Sframe_width, 0, 1, 0, - /* Don't confuse make-docfile by having two doc strings for this function. - make-docfile does not pay attention to #if, for good reason! */ - 0) - (frame) - Lisp_Object frame; -{ - return make_number (FRAME_WIDTH (selected_frame)); -} - -DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height, - 0, 1, 0, - /* Don't confuse make-docfile by having two doc strings for this function. - make-docfile does not pay attention to #if, for good reason! */ - 0) - (frame) - Lisp_Object frame; -{ - return make_number (1); -} - - -DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width, - 0, 1, 0, - /* Don't confuse make-docfile by having two doc strings for this function. - make-docfile does not pay attention to #if, for good reason! */ - 0) - (frame) - Lisp_Object frame; -{ - return make_number (1); -} - -DEFUN ("frame-pixel-height", Fframe_pixel_height, - Sframe_pixel_height, 0, 1, 0, - /* Don't confuse make-docfile by having two doc strings for this function. - make-docfile does not pay attention to #if, for good reason! */ - 0) - (frame) - Lisp_Object frame; -{ - return make_number (FRAME_HEIGHT (f)); -} - -DEFUN ("frame-pixel-width", Fframe_pixel_width, - Sframe_pixel_width, 0, 1, 0, - /* Don't confuse make-docfile by having two doc strings for this function. - make-docfile does not pay attention to #if, for good reason! */ - 0) - (frame) - Lisp_Object frame; -{ - return make_number (FRAME_WIDTH (f)); -} - -/* These are for backward compatibility with Emacs 18. */ - -DEFUN ("set-screen-height", Fset_screen_height, Sset_screen_height, 1, 2, 0, - /* Don't confuse make-docfile by having two doc strings for this function. - make-docfile does not pay attention to #if, for good reason! */ - 0) - (lines, pretend) - Lisp_Object lines, pretend; -{ - CHECK_NUMBER (lines, 0); - - change_frame_size (0, XINT (lines), 0, !NILP (pretend), 0); - return Qnil; -} - -DEFUN ("set-screen-width", Fset_screen_width, Sset_screen_width, 1, 2, 0, - /* Don't confuse make-docfile by having two doc strings for this function. - make-docfile does not pay attention to #if, for good reason! */ - 0) - (cols, pretend) - Lisp_Object cols, pretend; -{ - CHECK_NUMBER (cols, 0); - - change_frame_size (0, 0, XINT (cols), !NILP (pretend), 0); - return Qnil; -} - -DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0, - /* Don't confuse make-docfile by having two doc strings for this function. - make-docfile does not pay attention to #if, for good reason! */ - 0) - () -{ -#ifdef HAVE_MOUSE - if (mouse_position_hook) - { - FRAME_PTR f; - Lisp_Object lispy_dummy; - enum scroll_bar_part party_dummy; - Lisp_Object x, y; - unsigned long long_dummy; - - (*mouse_position_hook) (&f, 0, - &lispy_dummy, &party_dummy, - &x, &y, - &long_dummy); - return Fcons (Fselected_frame (), Fcons (x, y)); - } -#endif - return Fcons (Qnil, Fcons (Qnil, Qnil)); -} - -void -store_in_alist (alistptr, prop, val) - Lisp_Object *alistptr, val; - Lisp_Object prop; -{ - register Lisp_Object tem; - - tem = Fassq (prop, *alistptr); - if (EQ (tem, Qnil)) - *alistptr = Fcons (Fcons (prop, val), *alistptr); - else - Fsetcdr (tem, val); -} - -DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0, - /* Don't confuse make-docfile by having two doc strings for this function. - make-docfile does not pay attention to #if, for good reason! */ - 0) - (frame) - Lisp_Object frame; -{ - Lisp_Object alist; - FRAME_PTR f; - - if (EQ (frame, Qnil)) - f = selected_frame; - else - { - CHECK_FRAME (frame, 0); - f = XFRAME (frame); - } - - if (!FRAME_LIVE_P (f)) - return Qnil; - - alist = Qnil; -#ifdef MSDOS - if (FRAME_X_P (f)) - { - static char *colornames[16] = - { - "black", "blue", "green", "cyan", "red", "magenta", "brown", - "lightgray", "darkgray", "lightblue", "lightgreen", "lightcyan", - "lightred", "lightmagenta", "yellow", "white" - }; - store_in_alist (&alist, intern ("foreground-color"), - build_string (colornames[FRAME_FOREGROUND_PIXEL (f)])); - store_in_alist (&alist, intern ("background-color"), - build_string (colornames[FRAME_BACKGROUND_PIXEL (f)])); - } -#endif - store_in_alist (&alist, intern ("font"), build_string ("default")); - store_in_alist (&alist, Qname, build_string ("emacs")); - store_in_alist (&alist, Qheight, make_number (FRAME_HEIGHT (f))); - store_in_alist (&alist, Qwidth, make_number (FRAME_WIDTH (f))); - store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil)); - store_in_alist (&alist, Qminibuffer, FRAME_MINIBUF_WINDOW (f)); - store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil)); - store_in_alist (&alist, Qmenu_bar_lines, (FRAME_MENU_BAR_LINES (f))); - - return alist; -} - -DEFUN ("modify-frame-parameters", Fmodify_frame_parameters, - Smodify_frame_parameters, 2, 2, 0, - /* Don't confuse make-docfile by having two doc strings for this function. - make-docfile does not pay attention to #if, for good reason! */ - 0) - (frame, alist) - Lisp_Object frame, alist; -{ - Lisp_Object tail, elt, prop, val; - FRAME_PTR f; - - if (NILP (frame)) - f = selected_frame; - else - { - CHECK_LIVE_FRAME (frame, 0); - f = XFRAME (frame); - } - -#ifdef MSDOS - if (FRAME_X_P (frame)) - IT_set_frame_parameters (XFRAME (frame), alist); - else -#endif - for (tail = alist; !EQ (tail, Qnil); tail = Fcdr (tail)) - { - elt = Fcar (tail); - prop = Fcar (elt); - val = Fcdr (elt); - if (EQ (prop, Qmenu_bar_lines)) - set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f))); - } - - return Qnil; -} - -DEFUN ("frame-live-p", Fframe_live_p, Sframe_live_p, 1, 1, 0, - /* Don't confuse make-docfile by having two doc strings for this function. - make-docfile does not pay attention to #if, for good reason! */ - 0) - (frame) - Lisp_Object frame; -{ - return Qt; -} - -DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p, 1, 1, 0, - /* Don't confuse make-docfile by having two doc strings for this function. - make-docfile does not pay attention to #if, for good reason! */ - 0) - (frame) - Lisp_Object frame; -{ - return Qt; -} - -DEFUN ("frame-list", Fframe_list, Sframe_list, 0, 0, 0, - /* Don't confuse make-docfile by having two doc strings for this function. - make-docfile does not pay attention to #if, for good reason! */ - 0) - () -{ - return Fcons (Fselected_frame (), Qnil); -} - -syms_of_frame () -{ - syms_of_frame_1 (); - - DEFVAR_LISP ("terminal-frame", &Vterminal_frame, - /* Don't confuse make-docfile by having two doc strings for this variable. - make-docfile does not pay attention to #if, for good reason! */ - 0); - XSETFASTINT (Vterminal_frame, 0); - - defsubr (&Sselected_frame); - defsubr (&Sactive_minibuffer_window); - defsubr (&Swindow_frame); - defsubr (&Sframe_first_window); - defsubr (&Sframep); - defsubr (&Sframe_char_height); - defsubr (&Sframe_char_width); - defsubr (&Sframe_pixel_height); - defsubr (&Sframe_pixel_width); - defsubr (&Sset_frame_height); - defsubr (&Sset_frame_width); - defsubr (&Sset_frame_size); - defsubr (&Sset_screen_height); - defsubr (&Sset_screen_width); - defsubr (&Sframe_height); - Ffset (intern ("screen-height"), intern ("frame-height")); - defsubr (&Sframe_width); - Ffset (intern ("screen-width"), intern ("frame-width")); - defsubr (&Smouse_position); - Ffset (intern ("mouse-pixel-position"), intern ("mouse-position")); - defsubr (&Sframe_parameters); - defsubr (&Smodify_frame_parameters); - defsubr (&Sframe_live_p); - defsubr (&Sframe_visible_p); - defsubr (&Sframe_list); - -#ifdef MSDOS - /* A comment in dispnew.c says the_only_frame is not protected. */ - the_only_frame.face_alist = Qnil; - staticpro (&the_only_frame.face_alist); - the_only_frame.menu_bar_items = Qnil; - staticpro (&the_only_frame.menu_bar_items); - the_only_frame.menu_bar_vector = Qnil; - staticpro (&the_only_frame.menu_bar_vector); - the_only_frame.menu_bar_items = menu_bar_items (Qnil); -#endif -} - -keys_of_frame () -{ -} - -#endif /* not MULTI_FRAME */