This is frame.c in view mode; [Download] [Up]
/* Generic frame functions.
Copyright (C) 1989, 1992, 1993, 1994 Free Software Foundation.
Copyright (C) 1995 Ben Wing.
Copyright (C) 1995 Sun Microsystems.
This file is part of XEmacs.
XEmacs is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 2, or (at your option) any
later version.
XEmacs is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
for more details.
You should have received a copy of the GNU General Public License
along with XEmacs; see the file COPYING. If not, write to the Free
Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
/* Synched up with: FSF 19.28. */
/* This file has been Mule-ized except for the frame-title stuff. */
#include <config.h>
#include "lisp.h"
#include "buffer.h" /* for Vbuffer_alist */
#include "device.h"
#include "extents.h"
#include "faces.h"
#include "frame.h"
#include "glyphs.h"
#include "redisplay.h"
#include "scrollbar.h"
#include "window.h"
#include <errno.h>
#include "sysdep.h"
Lisp_Object Vdefault_minibuffer_frame;
Lisp_Object Vcreate_frame_hook, Qcreate_frame_hook;
Lisp_Object Vdelete_frame_hook, Qdelete_frame_hook;
Lisp_Object Vmouse_enter_frame_hook, Qmouse_enter_frame_hook;
Lisp_Object Vmouse_leave_frame_hook, Qmouse_leave_frame_hook;
Lisp_Object Vmap_frame_hook, Qmap_frame_hook;
Lisp_Object Vunmap_frame_hook, Qunmap_frame_hook;
Lisp_Object Vmouse_motion_handler;
Lisp_Object Vsynchronize_minibuffers;
Lisp_Object Qframep, Qframe_live_p;
Lisp_Object Qframe_x_p, Qframe_tty_p;
Lisp_Object Qdelete_frame;
Lisp_Object Vframe_title_format;
Lisp_Object Vframe_icon_title_format;
Lisp_Object Qselect_frame_hook, Qdeselect_frame_hook;
Lisp_Object Vdefault_frame_name;
Lisp_Object Vdefault_frame_alist;
/* If this is non-nil, it is the frame that make-frame is currently
creating. We can't set the current frame to this in case the
debugger goes off because it would try and display to it. However,
there are some places which need to reference it which have no
other way of getting it if it isn't the selected frame. */
Lisp_Object Vframe_being_created;
static Lisp_Object mark_frame (Lisp_Object, void (*) (Lisp_Object));
static void print_frame (Lisp_Object, Lisp_Object, int);
DEFINE_LRECORD_IMPLEMENTATION ("frame", frame,
mark_frame, print_frame, 0, 0, 0,
struct frame);
static Lisp_Object
mark_frame (Lisp_Object obj, void (*markobj) (Lisp_Object))
{
struct frame *f = XFRAME (obj);
((markobj) (f->device));
((markobj) (f->name));
((markobj) (f->root_window));
((markobj) (f->selected_window));
((markobj) (f->minibuffer_window));
((markobj) (f->buffer_alist));
((markobj) (f->pointer));
((markobj) (f->scrollbar_pointer));
((markobj) (f->menubar_data));
((markobj) (f->toolbar_data[0]));
((markobj) (f->toolbar_data[1]));
((markobj) (f->toolbar_data[2]));
((markobj) (f->toolbar_data[3]));
((markobj) (f->scrollbar_width));
((markobj) (f->scrollbar_height));
((markobj) (f->toolbar_size[0]));
((markobj) (f->toolbar_size[1]));
((markobj) (f->toolbar_size[2]));
((markobj) (f->toolbar_size[3]));
((markobj) (f->left_margin_width));
((markobj) (f->right_margin_width));
if (!NILP (f->device)) /* device is nil for a dead frame */
{
MAYBE_FRAMEMETH (f, mark_frame, (f, markobj));
}
return Qnil;
}
static void
print_frame (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
{
struct frame *frm = XFRAME (obj);
char buf[200];
if (print_readably)
error ("printing unreadable object #<frame %s 0x%x>",
string_data (XSTRING (frm->name)), frm->header.uid);
sprintf (buf, "#<%s-frame ", !FRAME_LIVE_P (frm) ? "dead" :
DEVICE_TYPE_NAME (XDEVICE (FRAME_DEVICE (frm))));
write_c_string (buf, printcharfun);
print_internal (frm->name, printcharfun, 1);
sprintf (buf, " 0x%x>", frm->header.uid);
write_c_string (buf, printcharfun);
}
static struct frame *
allocate_frame (Lisp_Object device, int mini_p)
{
/* This function can GC */
Lisp_Object frame = Qnil;
Lisp_Object root_window;
Lisp_Object mini_window;
struct frame *f = alloc_lcrecord (sizeof (struct frame), lrecord_frame);
zero_lcrecord (f);
XSETFRAME (frame, f);
f->device = device;
f->name = Qnil;
f->root_window = Qnil;
f->selected_window = Qnil;
f->minibuffer_window = Qnil;
f->buffer_alist = Fcopy_sequence (Vbuffer_alist);
f->pointer = Qnil;
f->scrollbar_pointer = Qnil;
f->menubar_data = Qnil;
f->toolbar_data[0] = Qnil;
f->toolbar_data[1] = Qnil;
f->toolbar_data[2] = Qnil;
f->toolbar_data[3] = Qnil;
f->scrollbar_width = Qnil;
f->scrollbar_height = Qnil;
f->toolbar_size[0] = Qnil;
f->toolbar_size[1] = Qnil;
f->toolbar_size[2] = Qnil;
f->toolbar_size[3] = Qnil;
f->left_margin_width = Qnil;
f->right_margin_width = Qnil;
f->has_minibuffer = mini_p;
root_window = allocate_window ();
if (mini_p)
{
mini_window = allocate_window ();
XWINDOW (root_window)->next = mini_window;
XWINDOW (mini_window)->prev = root_window;
XWINDOW (mini_window)->mini_p = Qt;
XWINDOW (mini_window)->frame = frame;
f->minibuffer_window = mini_window;
}
else
{
mini_window = Qnil;
XWINDOW (root_window)->next = root_window;
XWINDOW (root_window)->prev = root_window;
f->minibuffer_window = Qnil;
}
XWINDOW (root_window)->frame = frame;
/* 10 is arbitrary,
just so that there is "something there."
Correct size will be set up later with change_frame_size. */
f->width = 10;
f->height = 10;
XWINDOW (root_window)->pixel_width = 10;
XWINDOW (root_window)->pixel_height = ((mini_p) ? 9 : 10);
/* The size of the minibuffer window is now set in x_create_frame
in xfns.c. */
f->root_window = root_window;
f->selected_window = root_window;
/* Choose a buffer for the frame's root window. */
XWINDOW (root_window)->buffer = Qt;
{
Lisp_Object buf;
buf = Fcurrent_buffer ();
/* If buf is a 'hidden' buffer (i.e. one whose name starts with
a space), try to find another one. */
if (string_char (XSTRING (Fbuffer_name (buf)), 0) == ' ')
buf = Fother_buffer (buf, Qnil, Qnil);
Fset_window_buffer (root_window, buf);
}
if (mini_p)
{
XWINDOW (mini_window)->buffer = Qt;
Fset_window_buffer (mini_window, Vminibuffer_zero);
}
update_frame_window_mirror (f);
return f;
}
#if 0 /* Unused */
/* 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). */
static struct frame *
allocate_frame_without_minibuffer (Lisp_Object device, Lisp_Object mini_window)
{
/* This function can GC */
struct frame *f;
/* Choose the minibuffer window to use. */
if (NILP (mini_window))
{
over:
if (!FRAMEP (Vdefault_minibuffer_frame))
{
error ("`default-minibuffer-frame' must be set when creating minibufferless frames");
goto over;
}
if (!FRAME_LIVE_P (XFRAME (Vdefault_minibuffer_frame)))
{
error ("`default-minibuffer-frame' must be a live frame");
goto over;
}
mini_window = XFRAME (Vdefault_minibuffer_frame)->minibuffer_window;
}
else
{
CHECK_LIVE_WINDOW (mini_window, 0);
}
/* Make a frame containing just a root window. */
f = allocate_frame (device, 0);
/* Install the chosen minibuffer window, with proper buffer. */
f->minibuffer_window = mini_window;
Fset_window_buffer (mini_window, Vminibuffer_zero);
return f;
}
#endif
#if 0 /* Unused */
/* Make a frame containing only a minibuffer window. */
static struct frame *
make_minibuffer_frame (Lisp_Object device)
{
/* This function can GC */
/* First make a frame containing just a root window, no minibuffer. */
struct frame *f = allocate_frame (device, 0);
Lisp_Object mini_window;
Lisp_Object frame;
XSETFRAME (frame, f);
f->no_split = 1;
f->has_minibuffer = 1;
/* Now label the root window as also being the minibuffer.
Avoid infinite looping on the window chain by marking next pointer
as nil. */
mini_window = f->minibuffer_window = f->root_window;
XWINDOW (mini_window)->mini_p = Qt;
XWINDOW (mini_window)->next = Qnil;
XWINDOW (mini_window)->prev = mini_window;
XWINDOW (mini_window)->frame = frame;
/* Put the proper buffer in that window. */
Fset_window_buffer (mini_window, Vminibuffer_zero);
return f;
}
#endif
DEFUN ("make-frame", Fmake_frame, Smake_frame, 0, 2, "",
"Create a new frame, displaying the current buffer.\n\
\n\
Optional argument PARAMETERS is an alist of parameters for the new\n\
frame. Specifically, PARAMETERS is a list of pairs, each having one\n\
of the following forms:\n\
\n\
(name . STRING) - The frame should be named STRING.\n\
(height . NUMBER) - The frame should be NUMBER text lines high.\n\
(width . NUMBER) - The frame should be NUMBER columns wide.\n\
\n\
The documentation for the variable `default-x-frame-alist' describes\n\
additional frame parameters that Emacs recognizes for X window frames.")
(parameters, device)
Lisp_Object parameters, device;
{
/*
(minibuffer . t) - the frame should have a minibuffer
(minibuffer . nil) - the frame should have no minibuffer
(minibuffer . only) - the frame should contain only a minibuffer
(minibuffer . WINDOW) - the frame should use WINDOW as its minibuffer window.
*/
struct frame *f;
struct device *d;
Lisp_Object frame = Qnil, name;
struct gcpro gcpro1;
d = get_device (device);
XSETDEVICE (device, d);
GCPRO1 (frame);
f = allocate_frame (device, 1);
XSETFRAME (Vframe_being_created, f);
if (!NILP (f->minibuffer_window))
reset_face_cache_elements (XWINDOW (f->minibuffer_window));
reset_face_cache_elements (XWINDOW (f->root_window));
XSETFRAME (frame, f);
name = Fassq (Qname, parameters);
if (!NILP (name))
{
name = Fcdr (name);
CHECK_STRING (name, 0);
f->name = name;
}
else if (STRINGP (Vdefault_frame_name))
f->name = Vdefault_frame_name;
else
f->name = build_string ("emacs");
if (DEVICE_SPECIFIC_FRAME_PARAMS (d))
/* Put the device-specific params after the more general ones so
that they override them. */
parameters = nconc2 (Fcopy_sequence (*DEVICE_SPECIFIC_FRAME_PARAMS (d)),
parameters);
parameters = nconc2 (Fcopy_sequence (Vdefault_frame_alist), parameters);
FRAMEMETH (f, init_frame, (f, parameters));
/* This *must* go before the init_*() methods. Those functions
call Lisp code, and if any of them causes a warning to be displayed
and the *Warnings* buffer to be created, it won't get added to
the frame-specific version of the buffer-alist unless the frame
is accessible from the device. */
DEVICE_FRAME_LIST (d) = nconc2 (DEVICE_FRAME_LIST (d), Fcons (frame, Qnil));
RESET_CHANGED_SET_FLAGS;
/* Now make sure that the initial cached values are set correctly.
Do this after the init_frame method is called because that may
do things (e.g. create widgets) that are necessary for the
specifier value-changed methods to work OK. */
recompute_all_cached_specifiers_in_frame (f);
if (!DEVICE_IS_STREAM (d))
{
init_frame_faces (f);
/* Finish up resourcing the scrollbars. */
init_frame_scrollbars (f);
/* Create the initial toolbars. We have to do this after the frame
methods are called because it may potentially call some things itself
which depend on the normal frame methods having initialized
things. */
init_frame_toolbars (f);
reset_face_cache_elements (XWINDOW (FRAME_SELECTED_WINDOW (f)));
reset_glyph_cache_elements (XWINDOW (FRAME_SELECTED_WINDOW (f)));
change_frame_size (f, f->height, f->width, 0, 0);
}
MAYBE_FRAMEMETH (f, finish_init_frame, (f, parameters));
/* If this is the first frame on the device, make it the selected one. */
if (NILP (DEVICE_SELECTED_FRAME (d)))
DEVICE_SELECTED_FRAME (d) = frame;
/* If at startup or if the current device is a stream device
(usually also at startup), make this device the selected one
so that messages show up on it. */
if (NILP (Fselected_device ()) ||
DEVICE_IS_STREAM (XDEVICE (Fselected_device ())))
Fselect_device (device);
run_hook_with_args (Qcreate_frame_hook, 1, frame);
Vframe_being_created = Qnil;
UNGCPRO;
return frame;
}
/* this function should be used in most cases when a Lisp function is passed
a FRAME argument. Use this unless you don't accept nil == current frame
(in which case, do a CHECK_LIVE_FRAME() and then an XFRAME()) or you
allow dead frames. Note that very few functions should accept dead
frames. It could be argued that functions should just do nothing when
given a dead frame, but the presence of a dead frame usually indicates
an oversight in the Lisp code that could potentially lead to strange
results and so it is better to catch the error early.
If you only accept X frames, use get_x_frame(), which does what this
function does but also makes sure the frame is an X frame. */
struct frame *
get_frame (Lisp_Object frame)
{
if (NILP (frame))
return selected_frame ();
else
{
CHECK_LIVE_FRAME (frame, 0);
return (XFRAME (frame));
}
}
/*
* window size changes are held up during critical regions. Afterwards,
* we want to deal with any delayed changes.
*/
void
hold_frame_size_changes (void)
{
in_display = 1;
}
void
unhold_frame_size_changes (struct frame *f)
{
in_display = 0;
if (f->size_change_pending)
change_frame_size (f, f->new_height, f->new_width, 1, 0);
}
DEFUN ("framep", Fframep, Sframep, 1, 1, 0,
"Return non-nil if OBJECT is a frame.")
(object)
Lisp_Object object;
{
if (!FRAMEP (object))
return Qnil;
return Qt;
}
DEFUN ("frame-type", Fframe_type, Sframe_type, 1, 1, 0,
"Return the type of the specified frame (e.g. `x' or `tty').\n\
This is equivalent to the type of the frame's device.\n\
Value is `tty' for a tty frame (a character-only terminal),\n\
`x' for a frame that is an X window,\n\
`stream' for a stream frame (which acts like a stdio stream), and\n\
`dead' for a deleted frame.")
(frame)
Lisp_Object frame;
{
struct frame *f;
CHECK_FRAME (frame, 0);
f = XFRAME (frame);
return (DEVICE_TYPE (XDEVICE (FRAME_DEVICE (f))));
}
DEFUN ("frame-live-p", Fframe_live_p, Sframe_live_p, 1, 1, 0,
"Return non-nil if OBJECT is a frame which has not been deleted.")
(object)
Lisp_Object object;
{
if (FRAMEP (object) && FRAME_LIVE_P (XFRAME (object)))
return Qt;
return Qnil;
}
/* Called from Fselect_window() */
void
select_frame_1 (Lisp_Object frame)
{
struct frame *f = XFRAME (frame);
Lisp_Object old_selected_frame = Fselected_frame (Qnil);
if (EQ (frame, old_selected_frame))
return;
/* now select the frame's device */
DEVICE_SELECTED_FRAME (XDEVICE (FRAME_DEVICE (f))) = frame;
select_device_1 (FRAME_DEVICE (f));
choose_minibuf_frame ();
update_frame_window_mirror (f);
}
DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 1, 0,
"Select the frame FRAME.\n\
Subsequent editing commands apply to its selected window.\n\
The selection of FRAME lasts until the next time the user does\n\
something to select a different frame, or until the next time this\n\
function is called.\n\
\n\
Note that this does not actually cause the window-system focus to\n\
be set to this frame, or the select-frame-hook or deselect-frame-hook\n\
to be run, until the next time that XEmacs is waiting for an event.")
(frame)
Lisp_Object frame;
{
CHECK_LIVE_FRAME (frame, 0);
/* select the frame's selected window. This will call
selected_frame_1(). */
Fselect_window (FRAME_SELECTED_WINDOW (XFRAME (frame)));
/* Nothing should be depending on the return value of this function.
But, of course, there is stuff out there which is. */
return frame;
}
/* use this to retrieve the currently selected frame. You should use
this in preference to Fselected_frame (Qnil) unless you are prepared
to handle the possibility of there being no selected frame (this
happens at some points during startup). */
struct frame *
selected_frame (void)
{
Lisp_Object device = Fselected_device ();
Lisp_Object frame = XDEVICE (device)->selected_frame;
if (NILP (frame))
signal_simple_error ("No frames exist on device", device);
return XFRAME (frame);
}
/* use this instead of XFRAME (DEVICE_SELECTED_FRAME (d)) to catch
the possibility of there being no frames on the device (just created).
There is no point doing this inside of redisplay because errors
cause an abort(), indicating a flaw in the logic, and error_check_frame()
will catch this just as well. */
struct frame *
device_selected_frame (struct device *d)
{
Lisp_Object frame = d->selected_frame;
if (NILP (frame))
{
Lisp_Object device;
XSETDEVICE (device, d);
signal_simple_error ("No frames exist on device", device);
}
return XFRAME (frame);
}
DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 1, 0,
"Return the frame that is now selected on device DEVICE.\n\
If DEVICE is not specified, the selected device will be used.\n\
If no frames exist on the device, nil is returned.")
(device)
Lisp_Object device;
{
if (NILP (device) && NILP (Fselected_device ()))
return Qnil; /* happens early in temacs */
return get_device (device)->selected_frame;
}
DEFUN ("frame-root-window", Fframe_root_window, Sframe_root_window, 0, 1, 0,
"Return the root-window of FRAME.\n\
If omitted, FRAME defaults to the currently selected frame.")
(frame)
Lisp_Object frame;
{
return (FRAME_ROOT_WINDOW (get_frame (frame)));
}
DEFUN ("frame-selected-window", Fframe_selected_window,
Sframe_selected_window, 0, 1, 0,
"Return the selected window of frame object FRAME.\n\
If omitted, FRAME defaults to the currently selected frame.")
(frame)
Lisp_Object frame;
{
return (FRAME_SELECTED_WINDOW (get_frame (frame)));
}
DEFUN ("set-frame-selected-window", Fset_frame_selected_window,
Sset_frame_selected_window, 2, 2, 0,
"Set the selected window of frame object FRAME to WINDOW.\n\
If FRAME is nil, the selected frame is used.\n\
If FRAME is the selected frame, this makes WINDOW the selected window.")
(frame, window)
Lisp_Object frame, window;
{
XSETFRAME (frame, get_frame (frame));
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 ())
return Fselect_window (window);
return XFRAME (frame)->selected_window = window;
}
#define LOW_HIGH_WINDOW_LOOP_FOR_BODY \
do \
{ \
Lisp_Object retval; \
\
w = XWINDOW (win); \
if (!NILP (w->vchild)) \
{ \
retval = low_high_window_loop (w->vchild, lowest, count, 1); \
if (*count == 0) \
return retval; \
} \
else if (!NILP (w->hchild)) \
{ \
retval = low_high_window_loop (w->hchild, lowest, count, 0); \
if (*count == 0) \
return retval; \
} \
else \
{ \
if (*count < 0) \
*count += 1; \
else \
*count -= 1; \
\
if (*count == 0) \
return win; \
} \
} while (0)
static Lisp_Object
low_high_window_loop (Lisp_Object window, int lowest, int *count,
int vertical)
{
struct window *w;
assert (!NILP (window));
if (vertical)
{
Lisp_Object win = window;
if (lowest)
{
while (!NILP (XWINDOW (win)->next))
win = XWINDOW (win)->next;
}
w = XWINDOW (win);
if (!NILP (w->vchild))
{
return low_high_window_loop (w->vchild, lowest,count, 1);
}
else if (!NILP (w->hchild))
{
return low_high_window_loop (w->hchild, lowest, count, 0);
}
else
{
if (*count < 0)
*count += 1;
else
*count -= 1;
if (*count == 0)
return win;
}
}
else
{
Lisp_Object win;
if (*count > 0)
{
for (win = window; !NILP (win); win = XWINDOW (win)->next)
{
LOW_HIGH_WINDOW_LOOP_FOR_BODY;
}
}
else
{
Lisp_Object start = window;
while (!NILP (XWINDOW (start)->next))
start = XWINDOW (start)->next;
for (win = start; !NILP (win); win = XWINDOW (win)->prev)
{
LOW_HIGH_WINDOW_LOOP_FOR_BODY;
}
}
}
return Qnil;
}
#undef LOW_HIGH_WINDOW_LOOP_FOR_BODY
static Lisp_Object
low_high_window_internal (struct frame *f, Lisp_Object position, int lowest)
{
int count;
struct window *w = XWINDOW (f->root_window);
/* Our internal function uses different values of position. For it 0
is a 'found state', the left position starts at 1 and the right
position starts at -1. We need to adjust the users position values
to match. */
if (NILP (position))
count = 1;
else
{
/* We already verified the type in the calling routines. */
count = XINT (position);
if (count >= 0)
count++;
}
if (!NILP (w->vchild))
return low_high_window_loop (w->vchild, lowest, &count, 1);
else if (!NILP (w->hchild))
return low_high_window_loop (w->hchild, lowest, &count, 0);
else if (count == 1 || count == -1)
return f->root_window;
else
return Qnil;
}
/* DO NOT change the fact that the return value is nil if POSITION would
be a window off the frame edge. Doing so will lead to an infinite
loop in the Fwindow_{highest,lowest}-p functions. */
DEFUN ("frame-lowest-window", Fframe_lowest_window, Sframe_lowest_window,
0, 2, 0,
"Return the lowest window on FRAME which is at POSITION.\n\
If omitted, FRAME defaults to the currently selected frame.\n\
If omitted, POSITION defaults to 0 which is the leftmost lowest window.\n\
If POSITION is negative, it is considered to start from the right.\n\
The rightmost lowest window has a position of -1.\n\
If there is no window at the given POSITION, return nil.")
(frame, position)
Lisp_Object frame, position;
{
struct frame *f = get_frame (frame);
if (!NILP (position))
CHECK_INT (position, 0);
return low_high_window_internal (f, position, 1);
}
DEFUN ("frame-highest-window", Fframe_highest_window, Sframe_highest_window,
0, 2, 0,
"Return the highest window on FRAME which is at POSITION.\n\
If omitted, FRAME defaults to the currently selected frame.\n\
If omitted, POSITION defaults to 0 which is the leftmost highest window.\n\
If POSITION is negative, it is considered to start from the right.\n\
The rightmost highest window has a position of -1.\n\
If there is no window at the given POSITION, return nil.")
(frame, position)
Lisp_Object frame, position;
{
struct frame *f = get_frame (frame);
if (!NILP (position))
CHECK_INT (position, 0);
return low_high_window_internal (f, position, 0);
}
DEFUN ("frame-device", Fframe_device, Sframe_device,
0, 1, 0,
"Return the device that FRAME is on.\n\
If omitted, FRAME defaults to the currently selected frame.")
(frame)
Lisp_Object frame;
{
return (FRAME_DEVICE (get_frame (frame)));
}
/* Return the next frame in the frame list after FRAME.
If MINIBUF is nil, exclude minibuffer-only frames.
If MINIBUF is a window, include only its own frame
and any frame now using that window as the minibuffer.
If MINIBUF is `visible', include all visible frames.
If MINIBUF is 0, include all visible and iconified frames.
Otherwise, include all frames. */
Lisp_Object
next_frame (Lisp_Object frame, Lisp_Object minibuf)
{
Lisp_Object tail;
int passed = 0;
Lisp_Object frame_list;
/* If this frame is dead, it won't be in frame_list, and we'll loop
forever. Forestall that. */
CHECK_LIVE_FRAME (frame, 0);
/* There must always be at least one frame in frame_list. */
frame_list = DEVICE_FRAME_LIST (XDEVICE (FRAME_DEVICE (XFRAME (frame))));
assert (!NILP (frame_list));
while (1)
for (tail = frame_list; CONSP (tail); tail = XCDR (tail))
{
Lisp_Object f;
struct frame *fr;
f = XCAR (tail);
fr = XFRAME (f);
if (passed)
{
/* Decide whether this frame is eligible to be returned. */
/* If we've looped all the way around without finding any
eligible frames, return the original frame. */
if (EQ (f, frame))
return f;
/* Let minibuf decide if this frame is acceptable. */
if (NILP (minibuf))
{
if (! FRAME_MINIBUF_ONLY_P (fr))
return f;
}
else if (EQ (minibuf, Qvisible))
{
#if 0 /* FSFmacs */
FRAME_SAMPLE_VISIBILITY (fr);
#endif
if (FRAME_VISIBLE_P (fr))
return f;
}
else if (EQ (minibuf, Qzero))
{
#if 0 /* FSFmacs */
FRAME_SAMPLE_VISIBILITY (fr);
#endif
if (FRAME_VISIBLE_P (fr)
|| FRAME_ICONIFIED_P (fr))
return f;
}
else if (WINDOWP (minibuf))
{
if (EQ (FRAME_MINIBUF_WINDOW (fr), minibuf)
/* Check that F either is, or has forwarded its focus to,
MINIBUF's frame. */
&& (EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
#if 0 /* FSFmacs */
|| EQ (WINDOW_FRAME (XWINDOW (minibuf)),
FRAME_FOCUS_FRAME (fr))
#endif
))
return f;
}
else
return f;
}
if (EQ (frame, f))
passed++;
}
}
/* Return the previous frame in the frame list before FRAME.
If MINIBUF is nil, exclude minibuffer-only frames.
If MINIBUF is a window, include only its own frame
and any frame now using that window as the minibuffer.
If MINIBUF is `visible', include all visible frames.
If MINIBUF is 0, include all visible and iconified frames.
Otherwise, include all frames. */
Lisp_Object
prev_frame (Lisp_Object frame, Lisp_Object minibuf)
{
Lisp_Object tail;
Lisp_Object prev;
Lisp_Object frame_list;
/* If this frame is dead, it won't be in frame_list, and we'll loop
forever. Forestall that. */
CHECK_LIVE_FRAME (frame, 0);
/* There must always be at least one frame in frame_list. */
frame_list = DEVICE_FRAME_LIST (XDEVICE (FRAME_DEVICE (XFRAME (frame))));
assert (!NILP (frame_list));
prev = Qnil;
for (tail = frame_list; CONSP (tail); tail = XCDR (tail))
{
Lisp_Object f;
struct frame *fr;
f = XCAR (tail);
fr = XFRAME (f);
if (EQ (frame, f) && !NILP (prev))
return prev;
/* Decide whether this frame is eligible to be returned,
according to minibuf. */
if (NILP (minibuf))
{
if (! FRAME_MINIBUF_ONLY_P (fr))
prev = f;
}
else if (WINDOWP (minibuf))
{
if (EQ (FRAME_MINIBUF_WINDOW (fr), minibuf)
/* Check that F either is, or has forwarded its focus to,
MINIBUF's frame. */
&& (EQ (WINDOW_FRAME (XWINDOW (minibuf)), f)
#if 0 /* FSFmacs */
|| EQ (WINDOW_FRAME (XWINDOW (minibuf)),
FRAME_FOCUS_FRAME (fr))
#endif
))
prev = f;
}
else if (EQ (minibuf, Qvisible))
{
#if 0 /* FSFmacs */
FRAME_SAMPLE_VISIBILITY (fr);
#endif
if (FRAME_VISIBLE_P (fr))
prev = f;
}
else if (EQ (minibuf, Qzero))
{
#if 0 /* FSFmacs */
FRAME_SAMPLE_VISIBILITY (fr);
#endif
if (FRAME_VISIBLE_P (fr)
|| FRAME_ICONIFIED_P (fr))
prev = f;
}
else
prev = f;
}
/* We've scanned the entire list. */
if (NILP (prev))
/* We went through the whole frame list without finding a single
acceptable frame. Return the original frame. */
return frame;
else
/* There were no acceptable frames in the list before FRAME; otherwise,
we would have returned directly from the loop. Since PREV is the last
acceptable frame in the list, return it. */
return prev;
}
DEFUN ("next-frame", Fnext_frame, Snext_frame,
0, 2, 0,
"Return the next frame in the frame list after FRAME.\n\
By default, skip minibuffer-only frames.\n\
If omitted, FRAME defaults to the selected frame.\n\
If optional argument MINIBUF is nil, exclude minibuffer-only frames.\n\
If MINIBUF is a window, include only its own frame\n\
and any frame now using that window as the minibuffer.\n\
If MINIBUF is `visible', include all visible frames.\n\
If MINIBUF is 0, include all visible and iconified frames.\n\
Otherwise, include all frames.")
(frame, minibuf)
Lisp_Object frame, minibuf;
{
XSETFRAME (frame, get_frame (frame));
return (next_frame (frame, minibuf));
}
DEFUN ("previous-frame", Fprevious_frame, Sprevious_frame,
0, 2, 0,
"Return the previous frame in the frame list before FRAME.\n\
By default, skip minibuffer-only frames.\n\
If omitted, FRAME defaults to the selected frame.\n\
If optional argument MINIBUF is nil, exclude minibuffer-only frames.\n\
If MINIBUF is a window, include only its own frame\n\
and any frame now using that window as the minibuffer.\n\
If MINIBUF is `visible', include all visible frames.\n\
If MINIBUF is 0, include all visible and iconified frames.\n\
Otherwise, include all frames.")
(frame, minibuf)
Lisp_Object frame, minibuf;
{
XSETFRAME (frame, get_frame (frame));
return (prev_frame (frame, minibuf));
}
extern void free_window_mirror (struct window_mirror *mir);
extern void free_line_insertion_deletion_costs (struct frame *f);
/* In FSF, delete-frame will not normally allow you to delete
the last visible frame. You have to specify the FORCE argument
to get this behavior. In XEmacs, this restriction was removed
because it was too annoying. */
/* Return 1 if it is ok to delete frame F;
0 if all frames aside from F are invisible.
(Exception: if F is the terminal frame, and we are using X, return 1.) */
int
other_visible_frames (struct frame *f)
{
Lisp_Object frame_list;
frame_list = DEVICE_FRAME_LIST (XDEVICE (FRAME_DEVICE (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 ())
{
Lisp_Object frames;
int count = 0;
for (frames = frame_list;
CONSP (frames);
frames = XCDR (frames))
{
Lisp_Object this;
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. */
if (FRAME_VISIBLE_P (XFRAME (this))
|| FRAME_ICONIFIED_P (XFRAME (this))
#ifdef HAVE_WINDOW_SYSTEM
/* Allow deleting the initial terminal frame when at least
one window system frame exists! */
|| (FRAME_IS_WIN (XFRAME (this)) && !FRAME_IS_WIN (f))
#endif /* HAVE_WINDOW_SYSTEM */
)
count++;
}
return count > 1;
}
return 1;
}
void
delete_frame_internal (Lisp_Object frame, int ok_to_delete_last)
{
/* This function can GC */
struct frame *f;
struct device *d;
if (NILP (frame))
{
f = selected_frame ();
XSETFRAME (frame, f);
}
else
{
CHECK_FRAME (frame, 0);
f = XFRAME (frame);
}
/* OK to delete an already deleted frame. */
if (! FRAME_LIVE_P (f))
return;
d = XDEVICE (f->device);
#if 0
/* Does this frame have a minibuffer, and is it the surrogate
minibuffer for any other frame? */
if (FRAME_HAS_MINIBUF_P (f))
{
Lisp_Object frames;
for (frames = Vframe_list;
CONSP (frames);
frames = XCDR (frames))
{
Lisp_Object this = XCAR (frames);
if (! EQ (this, frame)
&& EQ (frame,
(WINDOW_FRAME
(XWINDOW
(FRAME_MINIBUF_WINDOW
(XFRAME (this)))))))
signal_simple_error
("Attempt to delete a surrogate minibuffer frame",
frame);
}
}
#endif
/* If we were focussed on this frame, then we're not any more.
Assume that we lost the focus; that way, the call to
Fselect_frame() below won't end up making us explicitly
focus on another frame, which is generally undesirable in
a point-to-type world. If our mouse ends up sitting over
another frame, we will receive a FocusIn event and end up
making that frame the selected frame.
#### This may not be an ideal solution in a click-to-type
world (in that case, we might want to explicitly choose
another frame to have the focus, rather than relying on
the WM, which might focus on a frame in a different app
or focus on nothing at all). But there's no easy way
to detect which focus model we're running on, and the
alternative is more heinous. */
if (EQ (frame, DEVICE_FRAME_WITH_FOCUS (d)))
DEVICE_FRAME_WITH_FOCUS (d) = Qnil;
if (EQ (frame, DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d)))
DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = Qnil;
/* Don't allow deleted frame to remain selected.
Note that in the former scheme of things, this would
have caused us to regain the focus. This no longer
applies (see above); I think the new behavior is more
logical. If someone disagrees, it can always be
changed (or a new user variable can be introduced,
ugh.) */
if (EQ (frame, DEVICE_SELECTED_FRAME (d)))
{
Lisp_Object next;
next = next_frame (frame, Qvisible);
if (EQ (next, frame))
{
Lisp_Object invisible_next = next_frame (frame, Qt);
if (EQ (frame, invisible_next))
{
if (!ok_to_delete_last)
signal_simple_error
("Attempt to delete the only frame", frame);
}
else
next = invisible_next;
}
if (d == XDEVICE (Fselected_device ()))
Fselect_frame (next);
else
DEVICE_SELECTED_FRAME (d) = next;
}
/* Don't allow minibuf_window to remain on a deleted frame. */
if (EQ (f->minibuffer_window, minibuf_window))
{
struct frame *sel_frame = selected_frame ();
Fset_window_buffer (sel_frame->minibuffer_window,
XWINDOW (minibuf_window)->buffer);
minibuf_window = sel_frame->minibuffer_window;
}
/* Before here, we haven't made any dangerous changed (just checked for
error conditions). Now run the delete-frame-hook. Remember that
user code there could do any number of dangerous things, including
signalling an error.
*/
run_hook_with_args (Qdelete_frame_hook, 1, frame);
/* After this point, no errors must be allowed to occur. */
/* This must be done before the window and window_mirror structures
are freed. The scrollbar information is attached to them. */
MAYBE_FRAMEMETH (f, delete_frame, (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));
f->root_window = Qnil;
/* Remove the frame now from the list. This way, any events generated
on this frame by the maneuvers below will disperse themselves.
*/
{
struct device *d = XDEVICE (FRAME_DEVICE (f));
/* This used to be Fdelq(), but that will cause a seg fault if the
QUIT checker happens to get invoked, because the frame list is
in an inconsistent state */
d->frame_list = delq_no_quit (frame, d->frame_list);
RESET_CHANGED_SET_FLAGS;
}
f->dead = 1;
f->visible = 0;
free_window_mirror (f->root_mirror);
/* free_line_insertion_deletion_costs (f); */
f->device = Qnil; /* nobody should be accessing the device any more. */
#if 0
/* If we've deleted the last_nonminibuf_frame, then try to find
another one. */
if (f == last_nonminibuf_frame)
{
Lisp_Object frames;
last_nonminibuf_frame = 0;
for (frames = Vframe_list;
CONSP (frames);
frames = XCDR (frames))
{
f = XFRAME (XCAR (frames));
if (!FRAME_MINIBUF_ONLY_P (f))
{
last_nonminibuf_frame = f;
break;
}
}
}
/* If we've deleted Vdefault_minibuffer_frame, try to find another
one. Prefer minibuffer-only frames, but also notice frames
with other windows. */
if (EQ (frame, Vdefault_minibuffer_frame))
{
Lisp_Object frames;
/* The last frame we saw with a minibuffer, minibuffer-only or not. */
Lisp_Object frame_with_minibuf = Qnil;
for (frames = Vframe_list;
CONSP (frames);
frames = XCDR (frames))
{
Lisp_Object this = XCAR (frames);
f = XFRAME (this);
if (FRAME_HAS_MINIBUF_P (f))
{
frame_with_minibuf = this;
if (FRAME_MINIBUF_ONLY_P (f))
break;
}
}
/* We know that there must be some frame with a minibuffer out
there. If this were not true, all of the frames present
would have to be minibufferless, which implies that at some
point their minibuffer frames must have been deleted, but
that is prohibited at the top; you can't delete surrogate
minibuffer frames. */
assert (!NILP (frame_with_minibuf));
Vdefault_minibuffer_frame = frame_with_minibuf;
}
#endif
return;
}
DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame,
0, 2, "",
"Delete FRAME, permanently eliminating it from use.\n\
If omitted, FRAME defaults to the selected frame.\n\
A frame may not be deleted if its minibuffer is used by other frames.")
(frame, ignored)
Lisp_Object frame, ignored;
{
/* This function can GC */
delete_frame_internal (frame, 0);
return Qnil;
}
/* Return mouse position in character cell units. */
DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 1, 0,
"Return a list (WINDOW X . Y) giving the current mouse window and position.\n\
The position is given in character cells, where (0, 0) is the\n\
upper-left corner of the window.\n\
\n\
DEVICE specifies the device on which to read the mouse position, and\n\
defaults to the selected device. If the device is a mouseless terminal\n\
or Emacs hasn't been programmed to read its mouse position, it returns\n\
the device's selected window for WINDOW and nil for X and Y.")
(device)
Lisp_Object device;
{
Lisp_Object val = Fmouse_pixel_position (device);
int x, y, obj_x, obj_y;
struct window *w;
struct frame *f;
Bufpos bufpos, closest;
Lisp_Object class;
if (NILP (XCAR (val)) || NILP (XCAR (XCDR (val))))
return val;
w = XWINDOW (XCAR (val));
x = XINT (XCAR (XCDR (val)));
y = XINT (XCDR (XCDR (val)));
f = XFRAME (w->frame);
if (x >= 0 && y >= 0 &&
pixel_to_glyph_translation (f, x, y, &x, &y, &obj_x, &obj_y, &w,
&bufpos, &closest, &class) != OVER_NOTHING)
{
XCAR (XCDR (val)) = make_number (x);
XCDR (XCDR (val)) = make_number (y);
}
else
{
XCAR (XCDR (val)) = Qnil;
XCDR (XCDR (val)) = Qnil;
}
return val;
}
DEFUN ("mouse-pixel-position", Fmouse_pixel_position,
Smouse_pixel_position, 0, 1, 0,
"Return a list (WINDOW X . Y) giving the current mouse window and position.\n\
The position is given in pixel units, where (0, 0) is the\n\
upper-left corner.\n\
\n\
DEVICE specifies the device on which to read the mouse position, and\n\
defaults to the selected device. If the device is a mouseless terminal\n\
or Emacs hasn't been programmed to read its mouse position, it returns\n\
the device's selected window for FRAME and nil for X and Y.")
(device)
Lisp_Object device;
{
struct device *d = get_device (device);
struct frame *f = device_selected_frame (d);
struct window *w = XWINDOW (FRAME_SELECTED_WINDOW (f));
Lisp_Object window;
Lisp_Object x, y;
int intx, inty;
x = y = Qnil;
XSETWINDOW (window, w);
switch (DEVMETH_OR_GIVEN (d, get_mouse_position, (d, &w, &intx, &inty), -1))
{
case 1:
XSETINT (x, intx);
XSETINT (y, inty);
XSETWINDOW (window, w);
break;
case 0:
window = Qnil;
break;
case -1:
break;
default:
abort (); /* hook is incorrectly written */
}
return Fcons (window, Fcons (x, 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 WINDOW.")
(window, x, y)
Lisp_Object window, x, y;
{
struct window *w;
int pix_x, pix_y;
CHECK_WINDOW (window, 0);
CHECK_INT (x, 2);
CHECK_INT (y, 1);
/* Warping the mouse will cause EnterNotify and Focus events under X. */
w = XWINDOW (window);
glyph_to_pixel_translation (w, XINT (x), XINT (y), &pix_x, &pix_y);
MAYBE_FRAMEMETH (XFRAME (w->frame), set_mouse_position, (w, pix_x, pix_y));
return Qnil;
}
DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position,
Sset_mouse_pixel_position, 3, 3, 0,
"Move the mouse pointer to pixel position (X,Y) in WINDOW.")
(window, x, y)
Lisp_Object window, x, y;
{
struct window *w;
CHECK_WINDOW (window, 0);
CHECK_INT (x, 2);
CHECK_INT (y, 1);
/* Warping the mouse will cause EnterNotify and Focus events under X. */
w = XWINDOW (window);
FRAMEMETH (XFRAME (w->frame), set_mouse_position, (w, XINT (x), XINT (y)));
return Qnil;
}
#if 0
/* ??? Can this be replaced with a Lisp function? */
DEFUN ("frame-configuration", Fframe_configuration, Sframe_configuration,
0, 0, 0,
"Return object describing current frame configuration.\n\
The frame configuration is the current mouse position and selected frame.\n\
This object can be given to `restore-frame-configuration'\n\
to restore this frame configuration.")
()
{
int x, y;
Lisp_Object c, frame;
struct frame *f;
c = make_vector (3, Qnil);
vector_data (XVECTOR (c))[0] = frame = Fselected_frame (Qnil);
read_mouse_position (frame, &x, &y);
vector_data (XVECTOR (c))[1] = make_number (x);
vector_data (XVECTOR (c))[2] = make_number (y);
return c;
}
DEFUN ("restore-frame-configuration", Frestore_frame_configuration,
Srestore_frame_configuration,
1, 1, 0,
"Restores frame configuration CONFIGURATION.")
(config)
Lisp_Object config;
{
Lisp_Object x_pos, y_pos, frame;
CHECK_VECTOR (config, 0);
if (XVECTOR (config)->size != 3)
{
signal_simple_error
("Wrong size vector passed to restore-frame-configuration",
config);
}
frame = vector_data (XVECTOR (config))[0];
/* select-frame will error on dead frame */
CHECK_FRAME (frame, 0);
Fselect_frame (frame);
return frame;
}
#endif
DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible,
0, 1, 0,
"Make the frame FRAME visible (assuming it is an X-window).\n\
If omitted, FRAME defaults to the currently selected frame.\n\
Also raises the frame so that nothing obscures it.")
(frame)
Lisp_Object frame;
{
struct frame *f = get_frame (frame);
MAYBE_FRAMEMETH (f, make_frame_visible, (f));
return frame;
}
DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible,
0, 2, 0,
"Unconditionally removes frame from the display (assuming it is an X-window).\n\
If omitted, FRAME defaults to the currently selected frame.\n\
If what you want to do is iconify the frame (if the window manager uses\n\
icons) then you should call `iconify-frame' instead.")
(frame, ignored)
Lisp_Object frame, ignored;
{
struct frame *f, *sel_frame;
struct device *d;
f = get_frame (frame);
d = XDEVICE (FRAME_DEVICE (f));
sel_frame = XFRAME (DEVICE_SELECTED_FRAME (d));
#if 0 /* FSFmacs */
if (NILP (force) && !other_visible_frames (f))
error ("Attempt to make invisible the sole visible or iconified frame");
#endif
/* Don't allow minibuf_window to remain on a deleted frame. */
if (EQ (f->minibuffer_window, minibuf_window))
{
Fset_window_buffer (sel_frame->minibuffer_window,
XWINDOW (minibuf_window)->buffer);
minibuf_window = sel_frame->minibuffer_window;
}
MAYBE_FRAMEMETH (f, make_frame_invisible, (f));
return Qnil;
}
DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame,
0, 1, "",
"Make the frame FRAME into an icon, if the window manager supports icons.\n\
If omitted, FRAME defaults to the currently selected frame.")
(frame)
Lisp_Object frame;
{
struct frame *f, *sel_frame;
struct device *d;
f = get_frame (frame);
d = XDEVICE (FRAME_DEVICE (f));
sel_frame = XFRAME (DEVICE_SELECTED_FRAME (d));
/* Don't allow minibuf_window to remain on a deleted frame. */
if (EQ (f->minibuffer_window, minibuf_window))
{
Fset_window_buffer (sel_frame->minibuffer_window,
XWINDOW (minibuf_window)->buffer);
minibuf_window = sel_frame->minibuffer_window;
}
MAYBE_FRAMEMETH (f, iconify_frame, (f));
return Qnil;
}
DEFUN ("deiconify-frame", Fdeiconify_frame, Sdeiconify_frame,
0, 1, 0,
"Open (de-iconify) the iconified frame FRAME.\n\
Under X, this is currently the same as `make-frame-visible'.\n\
If omitted, FRAME defaults to the currently selected frame.\n\
Also raises the frame so that nothing obscures it.")
(frame)
Lisp_Object frame;
{
return Fmake_frame_visible (frame);
}
/* FSF returns 'icon for iconized frames. What a crock! */
DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p,
1, 1, 0,
"Return t if FRAME is now \"visible\" (actually in use for display).\n\
A frame that is not visible is not updated, and, if it works through a\n\
window system, may not show at all.")
(frame)
Lisp_Object frame;
{
CHECK_LIVE_FRAME (frame, 0);
return (XFRAME (frame)->visible ? Qt : Qnil);
}
DEFUN ("frame-totally-visible-p", Fframe_totally_visible_p,
Sframe_totally_visible_p, 0, 1, 0,
"Return T if frame is not obscured by any other X windows, NIL otherwise.\n\
Always returns t for tty frames.")
(frame)
Lisp_Object frame;
{
struct frame *f = get_frame (frame);
/* #### does it make sense that tty frames are always "totally visible"?
I think this should be changed so that tty frames are totally visible
if and only if they're visible, i.e. they're the currently active
frame. */
return (FRAMEMETH_OR_GIVEN (f, frame_totally_visible_p, (f), 1) ? Qt : Qnil);
}
DEFUN ("frame-iconified-p", Fframe_iconified_p, Sframe_iconified_p,
1, 1, 0,
"Return t if FRAME is iconified.\n\
Not all window managers use icons; some merely unmap the window, so this\n\
function is not the inverse of `frame-visible-p'. It is possible for a\n\
frame to not be visible and not be iconified either. However, if the\n\
frame is iconified, it will not be visible.")
(frame)
Lisp_Object frame;
{
struct frame *f = get_frame (frame);
if (f->visible)
return Qnil;
f->iconified = FRAMEMETH_OR_GIVEN (f, frame_iconified_p, (f), 0);
return (f->iconified ? Qt : Qnil);
}
DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list,
0, 1, 0,
"Return a list of all frames now \"visible\" (being updated).\n\
If DEVICE is specified only frames on that device will be returned.")
(device)
Lisp_Object device;
{
Lisp_Object tail, frame, dev;
struct frame *f;
Lisp_Object value;
value = Qnil;
DEVICE_LOOP (dev)
{
assert (DEVICEP (XCAR (dev)));
if (NILP (device) || EQ (device, XCAR (dev)))
{
for (tail = DEVICE_FRAME_LIST (XDEVICE (XCAR (dev)));
!NILP (tail);
tail = XCDR (tail))
{
frame = XCAR (tail);
if (!FRAMEP (frame))
continue;
f = XFRAME (frame);
if (f->visible)
value = Fcons (frame, value);
}
}
}
return value;
}
DEFUN ("raise-frame", Fraise_frame, Sraise_frame, 0, 1, "",
"Bring FRAME to the front, so it occludes any frames it overlaps.\n\
If omitted, FRAME defaults to the currently selected frame.\n\
If FRAME is invisible, make it visible.\n\
If Emacs is displaying on an ordinary terminal or some other device which\n\
doesn't support multiple overlapping frames, this function does nothing.")
(frame)
Lisp_Object frame;
{
struct frame *f = get_frame (frame);
/* Do like the documentation says. */
Fmake_frame_visible (frame);
MAYBE_FRAMEMETH (f, raise_frame, (f));
return Qnil;
}
DEFUN ("lower-frame", Flower_frame, Slower_frame, 0, 1, "",
"Send FRAME to the back, so it is occluded by any frames that overlap it.\n\
If omitted, FRAME defaults to the currently selected frame.\n\
If Emacs is displaying on an ordinary terminal or some other device which\n\
doesn't support multiple overlapping frames, this function does nothing.")
(frame)
Lisp_Object frame;
{
struct frame *f = get_frame (frame);
MAYBE_FRAMEMETH (f, lower_frame, (f));
return Qnil;
}
void
store_in_alist (Lisp_Object *alistptr, CONST char *propname, Lisp_Object val)
{
Lisp_Object tem;
Lisp_Object prop;
prop = intern (propname);
tem = assq_no_quit (prop, *alistptr);
if (EQ (tem, Qnil))
*alistptr = Fcons (Fcons (prop, val), *alistptr);
else
Fsetcdr (tem, val);
}
#if 0
/* #### this function is not used and should be deleted.
However, there may be some potentially useful code in
the surrogate-minibuffer shit below. */
void
store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
{
Lisp_Object tem;
tem = assq_no_quit (prop, f->param_alist);
if (EQ (tem, Qnil))
f->param_alist = Fcons (Fcons (prop, val), f->param_alist);
else
Fsetcdr (tem, val);
#if 0
if (EQ (prop, Qminibuffer)
&& WINDOWP (val))
{
if (! MINI_WINDOW_P (XWINDOW (val)))
signal_simple_error
("Surrogate minibuffer windows must be minibuffer windows.",
val);
if (FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
{
Lisp_Object frame;
XSETFRAME (frame, f);
signal_simple_error
("Can't change the surrogate minibuffer of a frame with its own minibuffer.", frame);
}
/* Install the chosen minibuffer window, with proper buffer. */
f->minibuffer_window = val;
}
#endif
}
#endif
DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0,
"Return the parameters-alist of frame FRAME.\n\
It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.\n\
The meaningful PARMs depend on the kind of frame.\n\
If FRAME is omitted, return information on the currently selected frame.\n\
\n\
See the variables `default-frame-alist', `default-x-frame-alist', and\n\
`default-tty-frame-alist' for a description of the parameters meaningful\n\
for particular types of frames.")
(frame)
Lisp_Object frame;
{
Lisp_Object alist = Qnil;
struct frame *f = get_frame (frame);
store_in_alist (&alist, "name", f->name);
store_in_alist (&alist, "height", make_number (FRAME_HEIGHT (f)));
store_in_alist (&alist, "width", make_number (FRAME_WIDTH (f)));
store_in_alist (&alist, "minibuffer", (FRAME_HAS_MINIBUF_P (f)
#if 0
? Qnone
: (FRAME_MINIBUF_ONLY_P (f) ? Qonly
: FRAME_MINIBUF_WINDOW (f))
#else
? FRAME_MINIBUF_WINDOW (f) : Qnil
#endif
));
store_in_alist (&alist, "unsplittable", (FRAME_NO_SPLIT_P (f)
? Qt : Qnil));
/* #### serious overhaulage needs to be applied to the following. */
store_in_alist (&alist, "pointer", f->pointer);
store_in_alist (&alist, "scrollbar-pointer", f->scrollbar_pointer);
MAYBE_FRAMEMETH (f, get_frame_params, (f, &alist));
return alist;
}
/* #### Using this to modify the internal border width has no effect
because the change isn't propagated to the windows. Are there
other parameters which this claims to handle, but doesn't? */
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\n\
ignored.\n\
\n\
See the variables `default-frame-alist', `default-x-frame-alist', and\n\
`default-tty-frame-alist' for a description of the parameters recognized\n\
for particular types of frames.")
(frame, alist)
Lisp_Object frame, alist;
{
struct frame *f = get_frame (frame);
MAYBE_FRAMEMETH (f, set_frame_params, (f, alist));
return Qnil;
}
/* #### These could be written in Lisp
* #### (defun frame-height (f) (cdr (assq 'height (frame-parameters s))))
* But they shouldn't be; frame-parameters should be replaced with
* a frame plist or something.
*/
DEFUN ("frame-height", Fframe_height, Sframe_height, 0, 1, 0,
"Return number of lines available for display on FRAME.")
(frame)
Lisp_Object frame;
{
return (make_number (FRAME_HEIGHT (get_frame (frame))));
}
DEFUN ("frame-width", Fframe_width, Sframe_width, 0, 1, 0,
"Return number of columns available for display on FRAME.")
(frame)
Lisp_Object frame;
{
return (make_number (FRAME_WIDTH (get_frame (frame))));
}
DEFUN ("frame-pixel-height", Fframe_pixel_height, Sframe_pixel_height, 0, 1, 0,
"Return the height in pixels of FRAME.")
(frame)
Lisp_Object frame;
{
struct frame *f = get_frame (frame);
return (make_number (f->pixheight));
}
DEFUN ("frame-pixel-width", Fframe_pixel_width, Sframe_pixel_width, 0, 1, 0,
"Return the width in pixels of FRAME.")
(frame)
Lisp_Object frame;
{
struct frame *f = get_frame (frame);
return (make_number (f->pixwidth));
}
DEFUN ("frame-name", Fframe_name, Sframe_name, 0, 1, 0,
"Return the name of FRAME (defaulting to the selected frame).\n\
This is not the same as the `title' of the frame.")
(frame)
Lisp_Object frame;
{
return (get_frame (frame)->name);
}
static void
internal_set_frame_size (struct frame *f, int cols, int rows, int pretend)
{
if (pretend || !HAS_FRAMEMETH_P (f, set_frame_size))
change_frame_size (f, rows, cols, pretend, 0);
else
FRAMEMETH (f, set_frame_size, (f, cols, rows));
}
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;
{
struct frame *f = get_frame (frame);
XSETFRAME (frame, f);
CHECK_INT (rows, 1);
internal_set_frame_size (f, FRAME_WIDTH (f), XINT (rows),
!NILP (pretend));
return frame;
}
DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 3, 0,
"Specify that the frame FRAME has COLS columns.\n\
Optional third arg non-nil means that redisplay should use COLS columns\n\
but that the idea of the actual width of the frame should not be changed.")
(frame, cols, pretend)
Lisp_Object frame, cols, pretend;
{
struct frame *f = get_frame (frame);
XSETFRAME (frame, f);
CHECK_INT (cols, 1);
internal_set_frame_size (f, XINT (cols), FRAME_HEIGHT (f),
!NILP (pretend));
return frame;
}
DEFUN ("set-frame-size", Fset_frame_size,
Sset_frame_size, 3, 4, 0,
"Sets size of FRAME to COLS by ROWS.\n\
Optional fourth arg non-nil means that redisplay should use COLS by ROWS\n\
but that the idea of the actual size of the frame should not be changed.")
(frame, cols, rows, pretend)
Lisp_Object frame, cols, rows, pretend;
{
struct frame *f = get_frame (frame);
XSETFRAME (frame, f);
CHECK_INT (cols, 1);
CHECK_INT (rows, 2);
internal_set_frame_size (f, XINT (cols), XINT (rows), !NILP (pretend));
return frame;
}
DEFUN ("set-frame-position", Fset_frame_position,
Sset_frame_position, 3, 3, 0,
"Sets position of FRAME in pixels to XOFFSET by YOFFSET.\n\
This is actually the position of the upper left corner of the frame.\n\
Negative values for XOFFSET or YOFFSET are interpreted relative to\n\
the rightmost or bottommost possible position (that stays within the screen).")
(frame, xoffset, yoffset)
Lisp_Object frame, xoffset, yoffset;
{
struct frame *f = get_frame (frame);
CHECK_INT (xoffset, 1);
CHECK_INT (yoffset, 2);
MAYBE_FRAMEMETH (f, set_frame_position, (f, XINT (xoffset), XINT (yoffset)));
return Qt;
}
struct frame *
choose_minibuf_frame (void)
{
struct frame *sel_frame;
struct device *d;
if (FRAMEP (Vdefault_minibuffer_frame))
return XFRAME (Vdefault_minibuffer_frame);
d = XDEVICE (Fselected_device ());
if (NILP (DEVICE_SELECTED_FRAME (d)))
return 0;
else
sel_frame = XFRAME (DEVICE_SELECTED_FRAME (d));
/* For lowest-level minibuf, put it on currently selected frame
if frame has a minibuffer. */
if (sel_frame != 0
&& !EQ (minibuf_window, FRAME_MINIBUF_WINDOW (sel_frame)))
{
/* I don't think that any frames may validly have a null minibuffer
window anymore. */
if (NILP (sel_frame->minibuffer_window))
abort ();
/* #### This completely screws up point in the minibuffer. Why
is this here. */
#if 0
if (!NILP (minibuf_window)) /* happens at startup */
Fset_window_buffer (sel_frame->minibuffer_window,
XWINDOW (minibuf_window)->buffer);
#endif
minibuf_window = sel_frame->minibuffer_window;
}
return sel_frame;
}
/* Change the frame height and/or width. Values may be given as zero to
indicate no change is to take place. */
static void
change_frame_size_1 (struct frame *f, int newheight, int newwidth, int pretend)
{
Lisp_Object frame;
struct device *d = XDEVICE (f->device);
int new_pixheight, new_pixwidth;
int font_height, font_width;
struct font_metric_info fm;
if (in_display)
abort ();
XSETFRAME (frame, f);
DEVMETH (d, font_metric_info, (d, FACE_FONT (Vdefault_face, frame),
&fm));
font_height = fm.ascent + fm.descent;
font_width = fm.width;
/* This size-change overrides any pending one for this frame. */
FRAME_NEW_HEIGHT (f) = 0;
FRAME_NEW_WIDTH (f) = 0;
new_pixheight = newheight * font_height;
new_pixwidth = (newwidth - 1) * font_width;
if (!FRAME_IS_TTY (f)) /* #### need abstraction */
{
new_pixheight += XINT (f->scrollbar_height);
new_pixwidth += XINT (f->scrollbar_width);
}
if (!FRAME_TOP_TOOLBAR_VISIBLE (f))
new_pixheight += FRAME_TOP_TOOLBAR_HEIGHT (f);
if (!FRAME_BOTTOM_TOOLBAR_VISIBLE (f))
new_pixheight += FRAME_BOTTOM_TOOLBAR_HEIGHT (f);
if (!FRAME_LEFT_TOOLBAR_VISIBLE (f))
new_pixwidth += FRAME_LEFT_TOOLBAR_WIDTH (f);
if (!FRAME_RIGHT_TOOLBAR_VISIBLE (f))
new_pixwidth += FRAME_RIGHT_TOOLBAR_WIDTH (f);
/* Adjust the width for the end glyph which may be a different width
than the default character width. */
{
int adjustment, trunc_width, cont_width;
trunc_width = glyph_width (Vtruncation_glyph, DEFAULT_INDEX, 1,
FRAME_SELECTED_WINDOW (f));
cont_width = glyph_width (Vcontinuation_glyph, DEFAULT_INDEX, 1,
FRAME_SELECTED_WINDOW (f));
adjustment = max (trunc_width, cont_width);
adjustment = max (adjustment, font_width);
new_pixwidth += adjustment;
}
/* If we don't have valid values, exit. */
if (!new_pixheight && !new_pixwidth)
return;
/* #### This doesn't take into account a separate minibuffer because
we haven't implemented it yet. */
if (new_pixheight)
{
XWINDOW (FRAME_ROOT_WINDOW (f))->pixel_top = FRAME_TOP_BORDER_END (f);
set_window_pixheight (FRAME_ROOT_WINDOW (f),
new_pixheight - font_height, 0);
XWINDOW (FRAME_MINIBUF_WINDOW (f))->pixel_top =
new_pixheight - font_height + FRAME_TOP_BORDER_END (f);
set_window_pixheight (FRAME_MINIBUF_WINDOW (f), font_height, 0);
FRAME_HEIGHT (f) = newheight;
if (FRAME_IS_TTY (f))
f->pixheight = newheight;
}
if (new_pixwidth)
{
XWINDOW (FRAME_ROOT_WINDOW (f))->pixel_left = FRAME_LEFT_BORDER_END (f);
set_window_pixwidth (FRAME_ROOT_WINDOW (f), new_pixwidth, 0);
XWINDOW (FRAME_MINIBUF_WINDOW (f))->pixel_left =
FRAME_LEFT_BORDER_END (f);
set_window_pixwidth (FRAME_MINIBUF_WINDOW (f), new_pixwidth, 0);
FRAME_WIDTH (f) = newwidth;
if (FRAME_IS_TTY (f))
f->pixwidth = newwidth;
}
MARK_FRAME_TOOLBARS_CHANGED (f);
MARK_FRAME_CHANGED (f);
}
void
change_frame_size (struct frame *f, int newheight, int newwidth, int pretend,
int delay)
{
/* sometimes we get passed a size that's too small (esp. when a
client widget gets resized, since we have no control over this).
So deal. */
check_frame_size (f, &newheight, &newwidth);
if (delay || in_display || gc_in_progress)
{
MARK_FRAME_SIZE_CHANGED (f);
f->new_width = newwidth;
f->new_height = newheight;
return;
}
f->size_change_pending = 0;
change_frame_size_1 (f, newheight, newwidth, pretend);
}
#define CONVERT_MODE_STRING_BUFFER \
do { \
int i; \
Emchar *s = Dynarr_atp (mode_string_buffer, 0); \
int len = Dynarr_length (mode_string_buffer); \
\
if (frame_title_string) \
xfree (frame_title_string); \
frame_title_string = (char *) xmalloc ((len + 1) * sizeof (char)); \
\
for (i = 0; i < len; i++) \
{ \
/* #### perhaps should use DASSERT? */ \
assert (s[i] < 0x100); \
frame_title_string[i] = (char) s[i]; \
} \
frame_title_string[len] = '\0'; \
} while (0)
void
update_frame_title (struct frame *f)
{
struct window *w = XWINDOW (FRAME_SELECTED_WINDOW (f));
Lisp_Object title_format;
Lisp_Object icon_format;
Lisp_Object old_cur_buf = Fcurrent_buffer ();
char *frame_title_string = 0;
/* tty's don't display titles */
if (FRAME_IS_TTY (f))
return;
/* We don't change the title for the minibuffer */
else if (MINI_WINDOW_P (w))
return;
/* And we don't want dead buffers to blow up on us. */
else if (!BUFFER_LIVE_P (XBUFFER (w->buffer)))
return;
/* #### Ugh. See about getting rid of setting the current buffer.
It is really so very gross. */
Fset_buffer (w->buffer);
title_format = Vframe_title_format;
icon_format = Vframe_icon_title_format;
if (HAS_FRAMEMETH_P (f, set_title_from_char))
{
Dynarr_reset (mode_string_buffer);
generate_modeline_string (w, 0, 0, -1, title_format, 0, -1,
DEFAULT_INDEX, CURRENT_DISP);
CONVERT_MODE_STRING_BUFFER;
FRAMEMETH (f, set_title_from_char, (f, frame_title_string));
}
if (HAS_FRAMEMETH_P (f, set_icon_name_from_char))
{
if (!EQ (icon_format, title_format) ||
!HAS_FRAMEMETH_P (f, set_title_from_char))
{
Dynarr_reset (mode_string_buffer);
generate_modeline_string (w, 0, 0, -1, icon_format, 0, -1,
DEFAULT_INDEX, CURRENT_DISP);
CONVERT_MODE_STRING_BUFFER;
}
FRAMEMETH (f, set_icon_name_from_char, (f, frame_title_string));
}
Fset_buffer (old_cur_buf);
if (frame_title_string)
xfree (frame_title_string);
}
void
syms_of_frame (void)
{
defsymbol (&Qdelete_frame_hook, "delete-frame-hook");
/* defvarred in frame.el */
defsymbol (&Qselect_frame_hook, "select-frame-hook");
defsymbol (&Qdeselect_frame_hook, "deselect-frame-hook");
defsymbol (&Qcreate_frame_hook, "create-frame-hook");
defsymbol (&Qmouse_enter_frame_hook, "mouse-enter-frame-hook");
defsymbol (&Qmouse_leave_frame_hook, "mouse-leave-frame-hook");
defsymbol (&Qmap_frame_hook, "map-frame-hook");
defsymbol (&Qunmap_frame_hook, "unmap-frame-hook");
defsymbol (&Qframep, "framep");
defsymbol (&Qframe_live_p, "frame-live-p");
defsymbol (&Qframe_x_p, "frame-x-p");
defsymbol (&Qframe_tty_p, "frame-tty-p");
defsymbol (&Qdelete_frame, "delete-frame");
defsubr (&Smake_frame);
defsubr (&Sframep);
defsubr (&Sframe_type);
defsubr (&Sframe_live_p);
defsubr (&Sselect_frame);
defsubr (&Sselected_frame);
defsubr (&Sframe_root_window);
defsubr (&Sframe_selected_window);
defsubr (&Sset_frame_selected_window);
defsubr (&Sframe_lowest_window);
defsubr (&Sframe_highest_window);
defsubr (&Sframe_device);
defsubr (&Snext_frame);
defsubr (&Sprevious_frame);
defsubr (&Sdelete_frame);
defsubr (&Smouse_position);
defsubr (&Smouse_pixel_position);
defsubr (&Sset_mouse_position);
defsubr (&Sset_mouse_pixel_position);
#if 0
defsubr (&Sframe_configuration);
defsubr (&Srestore_frame_configuration);
#endif
defsubr (&Smake_frame_visible);
defsubr (&Smake_frame_invisible);
defsubr (&Siconify_frame);
defsubr (&Sdeiconify_frame);
defsubr (&Sframe_visible_p);
defsubr (&Sframe_totally_visible_p);
defsubr (&Sframe_iconified_p);
defsubr (&Svisible_frame_list);
defsubr (&Sraise_frame);
defsubr (&Slower_frame);
defsubr (&Sframe_parameters);
defsubr (&Smodify_frame_parameters);
defsubr (&Sframe_height);
defsubr (&Sframe_width);
defsubr (&Sframe_pixel_height);
defsubr (&Sframe_pixel_width);
defsubr (&Sframe_name);
defsubr (&Sset_frame_height);
defsubr (&Sset_frame_width);
defsubr (&Sset_frame_size);
defsubr (&Sset_frame_position);
}
void
vars_of_frame (void)
{
Vframe_being_created = Qnil;
staticpro (&Vframe_being_created);
DEFVAR_LISP ("default-minibuffer-frame", &Vdefault_minibuffer_frame,
"A frame-object holding the default minibuffer for minibufferless frames.\n\
When you create a minibufferless frame, by default it will use the\n\
minibuffer of this frame. It is up to you to create a suitable frame\n\
and store it in this variable.");
Vdefault_minibuffer_frame = Qnil;
DEFVAR_LISP ("delete-frame-hook", &Vdelete_frame_hook,
"Function or functions to call when a frame is deleted.\n\
One argument, the to-be-deleted frame.");
Vdelete_frame_hook = Qnil;
DEFVAR_LISP ("create-frame-hook", &Vcreate_frame_hook,
"Function or functions to call when a frame is created.\n\
One argument, the newly-created frame.");
Vcreate_frame_hook = Qnil;
DEFVAR_LISP ("mouse-enter-frame-hook", &Vmouse_enter_frame_hook,
"Function or functions to call when mouse enters a frame.\n\
One argument, the frame.\n\
Be careful not to make assumptions about the window manger's focus model.\n\
In most cases, the `deselect-frame-hook' is more appropriate.");
Vmouse_enter_frame_hook = Qnil;
DEFVAR_LISP ("mouse-leave-frame-hook", &Vmouse_leave_frame_hook,
"Function or functions to call when mouse leaves frame.\n\
One argument, the frame.\n\
Be careful not to make assumptions about the window manger's focus model.\n\
In most cases, the `select-frame-hook' is more appropriate.");
Vmouse_leave_frame_hook = Qnil;
DEFVAR_LISP ("map-frame-hook", &Vmap_frame_hook,
"Function or functions to call when frame is mapped.\n\
One argument, the frame.");
Vmap_frame_hook = Qnil;
DEFVAR_LISP ("unmap-frame-hook", &Vunmap_frame_hook,
"Function or functions to call when frame is unmapped.\n\
One argument, the frame.");
Vunmap_frame_hook = Qnil;
DEFVAR_LISP ("mouse-motion-handler", &Vmouse_motion_handler,
"Handler for motion events. One arg, the event.\n\
For most applications, you should use `mode-motion-hook' instead of this.");
Vmouse_motion_handler = Qnil;
DEFVAR_LISP ("synchronize-minibuffers",&Vsynchronize_minibuffers,
"Set to t if all minibuffer windows are to be synchronized.\n\
This will cause echo area messages to appear in the minibuffers of all\n\
visible frames.");
Vsynchronize_minibuffers = Qnil;
DEFVAR_LISP ("frame-title-format", &Vframe_title_format,
"Controls the title of the X window corresponding to the selected frame.\n\
This is the same format as `modeline-format' with the exception that\n\
%- is ignored.");
Vframe_title_format = Fpurecopy (build_string ("%S: %b"));
DEFVAR_LISP ("frame-icon-title-format", &Vframe_icon_title_format,
"Controls the title of the icon corresponding to the selected frame.\n\
See also the variable `frame-title-format'");
Vframe_icon_title_format = Fpurecopy (build_string ("%b"));
DEFVAR_LISP ("default-frame-name", &Vdefault_frame_name,
"The default name to assign to newly-created frames.\n\
This can be overridden by arguments to `make-frame'.\n\
This must be a string.");
Vdefault_frame_name = Fpurecopy (build_string ("emacs"));
DEFVAR_LISP ("default-frame-alist", &Vdefault_frame_alist,
"Alist of default values for frame creation, other than the first one.\n\
These may be set in your init file, like this:\n\
\n\
(setq default-frame-alist '((width . 80) (height . 55)))\n\
\n\
Since the first X frame is created before loading your .emacs file,\n\
you must use the X resource database for that.\n\
\n\
See also the variables `default-x-frame-alist' and\n\
`default-tty-frame-alist', which are like `default-frame-alist'\n\
except that they apply only to X or tty frames, respectively\n\
(whereas `default-frame-alist' applies to all types of frames).");
Vdefault_frame_alist = Qnil;
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.