/* Functions for the X window system.
- Copyright (C) 1989, 1992, 1993 Free Software Foundation.
+ Copyright (C) 1989, 1992, 1993, 1994 Free Software Foundation.
This file is part of GNU Emacs.
/* Rewritten for X11 by Joseph Arceneaux */
+#include <signal.h>
+#include <config.h>
+
#if 0
#include <stdio.h>
#endif
-#include <signal.h>
-#include <config.h>
+
+/* This makes the fields of a Display accessible, in Xlib header files. */
+#define XLIB_ILLEGAL_ACCESS
+
#include "lisp.h"
#include "xterm.h"
#include "frame.h"
#define min(a,b) ((a) < (b) ? (a) : (b))
#define max(a,b) ((a) > (b) ? (a) : (b))
-#ifdef HAVE_X11
/* X Resource data base */
static XrmDatabase xrdb;
/* The background and shape of the mouse pointer, and shape when not
over text or in the modeline. */
Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
-Lisp_Object Vx_cross_pointer_shape;
+/* The shape when over mouse-sensitive text. */
+Lisp_Object Vx_sensitive_text_pointer_shape;
/* Color of chars displayed in cursor box. */
Lisp_Object Vx_cursor_fore_pixel;
Lisp_Object Vmouse_depressed;
+/* For now, we have just one x_display structure since we only support
+ one X display. */
+static struct x_screen the_x_screen;
+
extern unsigned int x_mouse_x, x_mouse_y, x_mouse_grabbed;
/* Atom for indicating window state to the window manager. */
/* EditRes protocol */
extern Atom Xatom_editres_name;
-#else /* X10 */
-
-/* Default size of an Emacs window. */
-static char *default_window = "=80x24+0+0";
-
-#define MAXICID 80
-char iconidentity[MAXICID];
-#define ICONTAG "emacs@"
-char minibuffer_iconidentity[MAXICID];
-#define MINIBUFFER_ICONTAG "minibuffer@"
-
-#endif /* X10 */
-
/* The last 23 bits of the timestamp of the last mouse button event. */
Time mouse_timestamp;
Lisp_Object Qfont;
Lisp_Object Qforeground_color;
Lisp_Object Qgeometry;
-/* Lisp_Object Qicon; */
Lisp_Object Qicon_left;
Lisp_Object Qicon_top;
Lisp_Object Qicon_type;
Lisp_Object Qmouse_color;
Lisp_Object Qnone;
Lisp_Object Qparent_id;
+Lisp_Object Qscroll_bar_width;
Lisp_Object Qsuppress_icon;
Lisp_Object Qtop;
Lisp_Object Qundefined_color;
error ("X windows are not in use or not initialized");
}
+/* Nonzero if using X for display. */
+
+int
+using_x_p ()
+{
+ return x_current_display != 0;
+}
+
/* Return the Emacs frame-object corresponding to an X window.
It could be the frame's main window or an icon window. */
void x_set_vertical_scroll_bars ();
void x_set_visibility ();
void x_set_menu_bar_lines ();
+void x_set_scroll_bar_width ();
static struct x_frame_parm_table x_frame_parms[] =
{
"vertical-scroll-bars", x_set_vertical_scroll_bars,
"visibility", x_set_visibility,
"menu-bar-lines", x_set_menu_bar_lines,
+ "scroll-bar-width", x_set_scroll_bar_width,
};
/* Attach the `x-frame-parameter' properties to
Lisp_Object *parms;
Lisp_Object *values;
int i;
+ int left_no_change = 0, top_no_change = 0;
i = 0;
for (tail = alist; CONSP (tail); tail = Fcdr (tail))
param_index = Fget (prop, Qx_frame_parameter);
old_value = get_frame_param (f, prop);
store_frame_param (f, prop, val);
- if (XTYPE (param_index) == Lisp_Int
+ if (INTEGERP (param_index)
&& XINT (param_index) >= 0
&& (XINT (param_index)
< sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
/* Don't die if just one of these was set. */
if (EQ (left, Qunbound))
- XSET (left, Lisp_Int, f->display.x->left_pos);
+ {
+ left_no_change = 1;
+ if (f->display.x->left_pos < 0)
+ left = Fcons (Qplus, Fcons (make_number (f->display.x->left_pos), Qnil));
+ else
+ XSET (left, Lisp_Int, f->display.x->left_pos);
+ }
if (EQ (top, Qunbound))
- XSET (top, Lisp_Int, f->display.x->top_pos);
+ {
+ top_no_change = 1;
+ if (f->display.x->top_pos < 0)
+ top = Fcons (Qplus, Fcons (make_number (f->display.x->top_pos), Qnil));
+ else
+ XSET (top, Lisp_Int, f->display.x->top_pos);
+ }
/* Don't die if just one of these was set. */
if (EQ (width, Qunbound))
if ((NUMBERP (width) && XINT (width) != FRAME_WIDTH (f))
|| (NUMBERP (height) && XINT (height) != FRAME_HEIGHT (f)))
Fset_frame_size (frame, width, height);
- if ((NUMBERP (left) && XINT (left) != f->display.x->left_pos)
- || (NUMBERP (top) && XINT (top) != f->display.x->top_pos))
- Fset_frame_position (frame, left, top);
+
+ if ((!NILP (left) || !NILP (top))
+ && ! (left_no_change && top_no_change)
+ && ! (NUMBERP (left) && XINT (left) == f->display.x->left_pos
+ && NUMBERP (top) && XINT (top) == f->display.x->top_pos))
+ {
+ int leftpos = 0;
+ int toppos = 0;
+
+ /* Record the signs. */
+ f->display.x->size_hint_flags &= ~ (XNegative | YNegative);
+ if (EQ (left, Qminus))
+ f->display.x->size_hint_flags |= XNegative;
+ else if (INTEGERP (left))
+ {
+ leftpos = XINT (left);
+ if (leftpos < 0)
+ f->display.x->size_hint_flags |= XNegative;
+ }
+ else if (CONSP (left) && EQ (XCONS (left)->car, Qminus)
+ && CONSP (XCONS (left)->cdr)
+ && INTEGERP (XCONS (XCONS (left)->cdr)->car))
+ {
+ leftpos = - XINT (XCONS (XCONS (left)->cdr)->car);
+ f->display.x->size_hint_flags |= XNegative;
+ }
+ else if (CONSP (left) && EQ (XCONS (left)->car, Qplus)
+ && CONSP (XCONS (left)->cdr)
+ && INTEGERP (XCONS (XCONS (left)->cdr)->car))
+ {
+ leftpos = XINT (XCONS (XCONS (left)->cdr)->car);
+ }
+
+ if (EQ (top, Qminus))
+ f->display.x->size_hint_flags |= YNegative;
+ else if (INTEGERP (top))
+ {
+ toppos = XINT (top);
+ if (toppos < 0)
+ f->display.x->size_hint_flags |= YNegative;
+ }
+ else if (CONSP (top) && EQ (XCONS (top)->car, Qminus)
+ && CONSP (XCONS (top)->cdr)
+ && INTEGERP (XCONS (XCONS (top)->cdr)->car))
+ {
+ toppos = - XINT (XCONS (XCONS (top)->cdr)->car);
+ f->display.x->size_hint_flags |= YNegative;
+ }
+ else if (CONSP (top) && EQ (XCONS (top)->car, Qplus)
+ && CONSP (XCONS (top)->cdr)
+ && INTEGERP (XCONS (XCONS (top)->cdr)->car))
+ {
+ toppos = XINT (XCONS (XCONS (top)->cdr)->car);
+ }
+
+
+ /* Store the numeric value of the position. */
+ f->display.x->top_pos = toppos;
+ f->display.x->left_pos = leftpos;
+
+ f->display.x->win_gravity = NorthWestGravity;
+
+ /* Actually set that position, and convert to absolute. */
+ x_set_offset (f, leftpos, toppos, 0);
+ }
}
}
+/* Store the positions of frame F into XPTR and YPTR.
+ These are the positions of the containing window manager window,
+ not Emacs's own window. */
+
+void
+x_real_positions (f, xptr, yptr)
+ FRAME_PTR f;
+ int *xptr, *yptr;
+{
+ int win_x = 0, win_y = 0;
+ Window child;
+
+ /* This is pretty gross, but seems to be the easiest way out of
+ the problem that arises when restarting window-managers. */
+
+#ifdef USE_X_TOOLKIT
+ Window outer = XtWindow (f->display.x->widget);
+#else
+ Window outer = f->display.x->window_desc;
+#endif
+ Window tmp_root_window;
+ Window *tmp_children;
+ int tmp_nchildren;
+
+ XQueryTree (x_current_display, outer, &tmp_root_window,
+ &f->display.x->parent_desc,
+ &tmp_children, &tmp_nchildren);
+ xfree (tmp_children);
+
+ /* Find the position of the outside upper-left corner of
+ the inner window, with respect to the outer window. */
+ if (f->display.x->parent_desc != ROOT_WINDOW)
+ {
+ BLOCK_INPUT;
+ XTranslateCoordinates (x_current_display,
+
+ /* From-window, to-window. */
+#ifdef USE_X_TOOLKIT
+ XtWindow (f->display.x->widget),
+#else
+ f->display.x->window_desc,
+#endif
+ f->display.x->parent_desc,
+
+ /* From-position, to-position. */
+ 0, 0, &win_x, &win_y,
+
+ /* Child of win. */
+ &child);
+ UNBLOCK_INPUT;
+
+ win_x += f->display.x->border_width;
+ win_y += f->display.x->border_width;
+ }
+ *xptr = f->display.x->left_pos - win_x;
+ *yptr = f->display.x->top_pos - win_y;
+}
+
/* Insert a description of internally-recorded parameters of frame X
into the parameter alist *ALISTPTR that is to be given to the user.
Only parameters that are specific to the X window system
: FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
}
\f
-/* Decide if color named COLOR is valid for the display
- associated with the selected frame. */
+/* Decide if color named COLOR is valid for the display associated with
+ the selected frame; if so, return the rgb values in COLOR_DEF.
+ If ALLOC is nonzero, allocate a new colormap cell. */
+
int
-defined_color (color, color_def)
+defined_color (color, color_def, alloc)
char *color;
Color *color_def;
+ int alloc;
{
register int foo;
Colormap screen_colormap;
BLOCK_INPUT;
-#ifdef HAVE_X11
screen_colormap
= DefaultColormap (x_current_display, XDefaultScreen (x_current_display));
- foo = XParseColor (x_current_display, screen_colormap,
- color, color_def)
- && XAllocColor (x_current_display, screen_colormap, color_def);
-#else
- foo = XParseColor (color, color_def) && XGetHardwareColor (color_def);
-#endif /* not HAVE_X11 */
+ foo = XParseColor (x_current_display, screen_colormap, color, color_def);
+ if (foo && alloc)
+ foo = XAllocColor (x_current_display, screen_colormap, color_def);
UNBLOCK_INPUT;
if (foo)
else if (strcmp (XSTRING (arg)->data, "white") == 0)
return WHITE_PIX_DEFAULT;
-#ifdef HAVE_X11
if (x_screen_planes == 1)
return def;
-#else
- if (DISPLAY_CELLS == 1)
- return def;
-#endif
- if (defined_color (XSTRING (arg)->data, &cdef))
+ if (defined_color (XSTRING (arg)->data, &cdef, 1))
return cdef.pixel;
else
Fsignal (Qundefined_color, Fcons (arg, Qnil));
f->display.x->foreground_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
if (FRAME_X_WINDOW (f) != 0)
{
-#ifdef HAVE_X11
BLOCK_INPUT;
XSetForeground (x_current_display, f->display.x->normal_gc,
f->display.x->foreground_pixel);
XSetBackground (x_current_display, f->display.x->reverse_gc,
f->display.x->foreground_pixel);
UNBLOCK_INPUT;
-#endif /* HAVE_X11 */
recompute_basic_faces (f);
if (FRAME_VISIBLE_P (f))
redraw_frame (f);
if (FRAME_X_WINDOW (f) != 0)
{
BLOCK_INPUT;
-#ifdef HAVE_X11
/* The main frame area. */
XSetBackground (x_current_display, f->display.x->normal_gc,
f->display.x->background_pixel);
f->display.x->background_pixel);
XSetWindowBackground (x_current_display, FRAME_X_WINDOW (f),
f->display.x->background_pixel);
-
-#else
- temp = XMakeTile (f->display.x->background_pixel);
- XChangeBackground (FRAME_X_WINDOW (f), temp);
- XFreePixmap (temp);
-#endif /* not HAVE_X11 */
+ {
+ Lisp_Object bar;
+ for (bar = FRAME_SCROLL_BARS (f); !NILP (bar);
+ bar = XSCROLL_BAR (bar)->next)
+ XSetWindowBackground (x_current_display,
+ SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar)),
+ f->display.x->background_pixel);
+ }
UNBLOCK_INPUT;
recompute_basic_faces (f);
f->display.x->mouse_pixel = f->display.x->foreground_pixel;
BLOCK_INPUT;
-#ifdef HAVE_X11
/* It's not okay to crash if the user selects a screwy cursor. */
x_catch_errors ();
mode_cursor = XCreateFontCursor (x_current_display, XC_xterm);
x_check_errors ("bad modeline pointer cursor: %s");
- if (!EQ (Qnil, Vx_cross_pointer_shape))
+ if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
{
- CHECK_NUMBER (Vx_cross_pointer_shape, 0);
- cross_cursor = XCreateFontCursor (x_current_display,
- XINT (Vx_cross_pointer_shape));
+ CHECK_NUMBER (Vx_sensitive_text_pointer_shape, 0);
+ cross_cursor
+ = XCreateFontCursor (x_current_display,
+ XINT (Vx_sensitive_text_pointer_shape));
}
else
cross_cursor = XCreateFontCursor (x_current_display, XC_crosshair);
XRecolorCursor (x_current_display, cross_cursor,
&fore_color, &back_color);
}
-#else /* X10 */
- cursor = XCreateCursor (16, 16, MouseCursor, MouseMask,
- 0, 0,
- f->display.x->mouse_pixel,
- f->display.x->background_pixel,
- GXcopy);
-#endif /* X10 */
if (FRAME_X_WINDOW (f) != 0)
{
if (cursor != f->display.x->text_cursor && f->display.x->text_cursor != 0)
XFreeCursor (XDISPLAY f->display.x->text_cursor);
f->display.x->text_cursor = cursor;
-#ifdef HAVE_X11
+
if (nontext_cursor != f->display.x->nontext_cursor
&& f->display.x->nontext_cursor != 0)
XFreeCursor (XDISPLAY f->display.x->nontext_cursor);
&& f->display.x->cross_cursor != 0)
XFreeCursor (XDISPLAY f->display.x->cross_cursor);
f->display.x->cross_cursor = cross_cursor;
-#endif /* HAVE_X11 */
XFlushQueue ();
UNBLOCK_INPUT;
/* Make sure that the cursor color differs from the background color. */
if (f->display.x->cursor_pixel == f->display.x->background_pixel)
{
- f->display.x->cursor_pixel == f->display.x->mouse_pixel;
+ f->display.x->cursor_pixel = f->display.x->mouse_pixel;
if (f->display.x->cursor_pixel == fore_pixel)
fore_pixel = f->display.x->background_pixel;
}
if (FRAME_X_WINDOW (f) != 0)
{
-#ifdef HAVE_X11
BLOCK_INPUT;
XSetBackground (x_current_display, f->display.x->cursor_gc,
f->display.x->cursor_pixel);
XSetForeground (x_current_display, f->display.x->cursor_gc,
fore_pixel);
UNBLOCK_INPUT;
-#endif /* HAVE_X11 */
if (FRAME_VISIBLE_P (f))
{
CHECK_STRING (arg, 0);
str = XSTRING (arg)->data;
-#ifndef HAVE_X11
- if (!strcmp (str, "grey") || !strcmp (str, "Grey")
- || !strcmp (str, "gray") || !strcmp (str, "Gray"))
- pix = -1;
- else
-#endif /* X10 */
-
pix = x_decode_color (arg, BLACK_PIX_DEFAULT);
x_set_border_pixel (f, pix);
int mask;
BLOCK_INPUT;
-#ifdef HAVE_X11
XSetWindowBorder (x_current_display, FRAME_X_WINDOW (f),
pix);
-#else
- if (pix < 0)
- temp = XMakePixmap ((Bitmap) XStoreBitmap (gray_width, gray_height,
- gray_bits),
- BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
- else
- temp = XMakeTile (pix);
- XChangeBorder (FRAME_X_WINDOW (f), temp);
- XFreePixmap (XDISPLAY temp);
-#endif /* not HAVE_X11 */
UNBLOCK_INPUT;
if (FRAME_VISIBLE_P (f))
if (FRAME_MINIBUF_ONLY_P (f))
return;
- if (XTYPE (value) == Lisp_Int)
+ if (INTEGERP (value))
nlines = XINT (value);
else
nlines = 0;
/* If NAME is nil, set the name to the x_id_name. */
if (NILP (name))
- name = build_string (x_id_name);
+ {
+ /* Check for no change needed in this very common case
+ before we do any consing. */
+ if (!strcmp (x_id_name, XSTRING (f->name)->data))
+ return;
+ name = build_string (x_id_name);
+ }
else
CHECK_STRING (name, 0);
x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
}
}
+
+void
+x_set_scroll_bar_width (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
+{
+ if (NILP (arg))
+ {
+ FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
+ FRAME_SCROLL_BAR_COLS (f) = 2;
+ }
+ else if (INTEGERP (arg) && XINT (arg) > 0
+ && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
+ {
+ int wid = FONT_WIDTH (f->display.x->font);
+ FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
+ FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
+ if (FRAME_X_WINDOW (f))
+ x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
+ }
+}
\f
/* Subroutines of creating an X frame. */
-#ifdef HAVE_X11
-
/* Make sure that Vx_resource_name is set to a reasonable value. */
static void
validate_x_resource_name ()
{
- if (! STRINGP (Vx_resource_name))
+ if (STRINGP (Vx_resource_name))
+ {
+ int len = XSTRING (Vx_resource_name)->size;
+ unsigned char *p = XSTRING (Vx_resource_name)->data;
+ int i;
+
+ /* Allow only letters, digits, - and _,
+ because those are all that X allows. */
+ for (i = 0; i < len; i++)
+ {
+ int c = p[i];
+ if (! ((c >= 'a' && c <= 'z')
+ || (c >= 'A' && c <= 'Z')
+ || (c >= '0' && c <= '9')
+ || c == '-' || c == '_'))
+ goto fail;
+ }
+ }
+ else
+ fail:
Vx_resource_name = make_string ("emacs", 5);
}
DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
"Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
-This uses `NAME.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
+This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
class, where INSTANCE is the name under which Emacs was invoked, or\n\
the name specified by the `-name' or `-rn' command-line arguments.\n\
\n\
The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
class, respectively. You must specify both of them or neither.\n\
-If you specify them, the key is `NAME.COMPONENT.ATTRIBUTE'\n\
+If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
and the class is `Emacs.CLASS.SUBCLASS'.")
(attribute, class, component, subclass)
Lisp_Object attribute, class, component, subclass;
return x_get_string_resource (xrdb, name_key, class_key);
}
-#else /* X10 */
-
-DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1, 0,
- "Get X default ATTRIBUTE from the system, or nil if no default.\n\
-Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
-The defaults are specified in the file `~/.Xdefaults'.")
- (arg)
- Lisp_Object arg;
-{
- register unsigned char *value;
-
- CHECK_STRING (arg, 1);
-
- value = (unsigned char *) XGetDefault (XDISPLAY
- XSTRING (Vinvocation_name)->data,
- XSTRING (arg)->data);
- if (value == 0)
- /* Try reversing last two args, in case this is the buggy version of X. */
- value = (unsigned char *) XGetDefault (XDISPLAY
- XSTRING (arg)->data,
- XSTRING (Vinvocation_name)->data);
- if (value != 0)
- return build_string (value);
- else
- return (Qnil);
-}
-
-#define Fx_get_resource(attribute, class, component, subclass) \
- Fx_get_default (attribute)
-
-#endif /* X10 */
-
/* Types we might convert a resource string into. */
enum resource_types
{
\f
DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
"Parse an X-style geometry string STRING.\n\
-Returns an alist of the form ((top . TOP), (left . LEFT) ... ).")
+Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
+The properties returned may include `top', `left', `height', and `width'.\n\
+The value of `left' or `top' may be an integer,\n\
+or a list (+ N) meaning N pixels relative to top/left corner,\n\
+or a list (- N) meaning -N pixels relative to bottom/right corner.")
(string)
Lisp_Object string;
{
int geometry, x, y;
unsigned int width, height;
- Lisp_Object values[4];
+ Lisp_Object result;
CHECK_STRING (string, 0);
geometry = XParseGeometry ((char *) XSTRING (string)->data,
&x, &y, &width, &height);
- switch (geometry & 0xf) /* Mask out {X,Y}Negative */
+#if 0
+ if (!!(geometry & XValue) != !!(geometry & YValue))
+ error ("Must specify both x and y position, or neither");
+#endif
+
+ result = Qnil;
+ if (geometry & XValue)
{
- case (XValue | YValue):
- /* What's one pixel among friends?
- Perhaps fix this some day by returning symbol `extreme-top'... */
- if (x == 0 && (geometry & XNegative))
- x = -1;
- if (y == 0 && (geometry & YNegative))
- y = -1;
- values[0] = Fcons (Qleft, make_number (x));
- values[1] = Fcons (Qtop, make_number (y));
- return Flist (2, values);
- break;
-
- case (WidthValue | HeightValue):
- values[0] = Fcons (Qwidth, make_number (width));
- values[1] = Fcons (Qheight, make_number (height));
- return Flist (2, values);
- break;
-
- case (XValue | YValue | WidthValue | HeightValue):
- if (x == 0 && (geometry & XNegative))
- x = -1;
- if (y == 0 && (geometry & YNegative))
- y = -1;
- values[0] = Fcons (Qwidth, make_number (width));
- values[1] = Fcons (Qheight, make_number (height));
- values[2] = Fcons (Qleft, make_number (x));
- values[3] = Fcons (Qtop, make_number (y));
- return Flist (4, values);
- break;
-
- case 0:
- return Qnil;
-
- default:
- error ("Must specify x and y value, and/or width and height");
+ Lisp_Object element;
+
+ if (x >= 0 && (geometry & XNegative))
+ element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
+ else if (x < 0 && ! (geometry & XNegative))
+ element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
+ else
+ element = Fcons (Qleft, make_number (x));
+ result = Fcons (element, result);
}
+
+ if (geometry & YValue)
+ {
+ Lisp_Object element;
+
+ if (y >= 0 && (geometry & YNegative))
+ element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
+ else if (y < 0 && ! (geometry & YNegative))
+ element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
+ else
+ element = Fcons (Qtop, make_number (y));
+ result = Fcons (element, result);
+ }
+
+ if (geometry & WidthValue)
+ result = Fcons (Fcons (Qwidth, make_number (width)), result);
+ if (geometry & HeightValue)
+ result = Fcons (Fcons (Qheight, make_number (height)), result);
+
+ return result;
}
-#ifdef HAVE_X11
/* Calculate the desired size and position of this window,
- and return the attributes saying which aspects were specified.
+ and return the flags saying which aspects were specified.
This function does not make the coordinates positive. */
tem0 = x_get_arg (parms, Qheight, 0, 0, number);
tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
tem2 = x_get_arg (parms, Quser_size, 0, 0, number);
- if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound))
+ if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
{
- CHECK_NUMBER (tem0, 0);
- CHECK_NUMBER (tem1, 0);
- f->height = XINT (tem0);
- f->width = XINT (tem1);
- if (!NILP (tem2))
+ if (!EQ (tem0, Qunbound))
+ {
+ CHECK_NUMBER (tem0, 0);
+ f->height = XINT (tem0);
+ }
+ if (!EQ (tem1, Qunbound))
+ {
+ CHECK_NUMBER (tem1, 0);
+ f->width = XINT (tem1);
+ }
+ if (!NILP (tem2) && !EQ (tem2, Qunbound))
window_prompting |= USSize;
else
window_prompting |= PSize;
}
- else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
- error ("Must specify *both* height and width");
f->display.x->vertical_scroll_bar_extra
= (FRAME_HAS_VERTICAL_SCROLL_BARS (f)
- ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f)
+ ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
: 0);
f->display.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
f->display.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
tem0 = x_get_arg (parms, Qtop, 0, 0, number);
tem1 = x_get_arg (parms, Qleft, 0, 0, number);
tem2 = x_get_arg (parms, Quser_position, 0, 0, number);
- if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound))
+ if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
{
- CHECK_NUMBER (tem0, 0);
- CHECK_NUMBER (tem1, 0);
- f->display.x->top_pos = XINT (tem0);
- f->display.x->left_pos = XINT (tem1);
- if (f->display.x->top_pos < 0)
- window_prompting |= YNegative;
- if (f->display.x->left_pos < 0)
- window_prompting |= XNegative;
+ if (EQ (tem0, Qminus))
+ {
+ f->display.x->top_pos = 0;
+ window_prompting |= YNegative;
+ }
+ else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qminus)
+ && CONSP (XCONS (tem0)->cdr)
+ && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
+ {
+ f->display.x->top_pos = - XINT (XCONS (XCONS (tem0)->cdr)->car);
+ window_prompting |= YNegative;
+ }
+ else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qplus)
+ && CONSP (XCONS (tem0)->cdr)
+ && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
+ {
+ f->display.x->top_pos = XINT (XCONS (XCONS (tem0)->cdr)->car);
+ }
+ else if (EQ (tem0, Qunbound))
+ f->display.x->top_pos = 0;
+ else
+ {
+ CHECK_NUMBER (tem0, 0);
+ f->display.x->top_pos = XINT (tem0);
+ if (f->display.x->top_pos < 0)
+ window_prompting |= YNegative;
+ }
+
+ if (EQ (tem1, Qminus))
+ {
+ f->display.x->left_pos = 0;
+ window_prompting |= XNegative;
+ }
+ else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qminus)
+ && CONSP (XCONS (tem1)->cdr)
+ && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
+ {
+ f->display.x->left_pos = - XINT (XCONS (XCONS (tem1)->cdr)->car);
+ window_prompting |= XNegative;
+ }
+ else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qplus)
+ && CONSP (XCONS (tem1)->cdr)
+ && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
+ {
+ f->display.x->left_pos = XINT (XCONS (XCONS (tem1)->cdr)->car);
+ }
+ else if (EQ (tem1, Qunbound))
+ f->display.x->left_pos = 0;
+ else
+ {
+ CHECK_NUMBER (tem1, 0);
+ f->display.x->left_pos = XINT (tem1);
+ if (f->display.x->left_pos < 0)
+ window_prompting |= XNegative;
+ }
+
if (!NILP (tem2))
window_prompting |= USPosition;
else
window_prompting |= PPosition;
}
- else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
- error ("Must specify *both* top and left corners");
+
return window_prompting;
}
\f
#ifdef USE_X_TOOLKIT
-/* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS
- and WM_DELETE_WINDOW, then add them. (They may already be present
- because of the toolkit (Motif adds them, for example, but Xt doesn't). */
+/* WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
+ already be present because of the toolkit (Motif adds some of them,
+ for example, but Xt doesn't). */
static void
hack_wm_protocols (widget)
Window w = XtWindow (widget);
int need_delete = 1;
int need_focus = 1;
+ int need_save = 1;
BLOCK_INPUT;
{
while (nitems > 0)
{
nitems--;
- if (atoms [nitems] == Xatom_wm_delete_window) need_delete = 0;
- else if (atoms [nitems] == Xatom_wm_take_focus) need_focus = 0;
+ if (atoms[nitems] == Xatom_wm_delete_window) need_delete = 0;
+ else if (atoms[nitems] == Xatom_wm_take_focus) need_focus = 0;
+ else if (atoms[nitems] == Xatom_wm_save_yourself) need_save = 0;
}
if (atoms) XFree ((char *) atoms);
}
{
Atom props [10];
int count = 0;
- if (need_delete) props [count++] = Xatom_wm_delete_window;
- if (need_focus) props [count++] = Xatom_wm_take_focus;
+ if (need_delete) props[count++] = Xatom_wm_delete_window;
+ if (need_focus) props[count++] = Xatom_wm_take_focus;
+ if (need_save) props[count++] = Xatom_wm_save_yourself;
if (count)
XChangeProperty (dpy, w, Xatom_wm_protocols, XA_ATOM, 32, PropModeAppend,
(unsigned char *) props, count);
BLOCK_INPUT;
if (STRINGP (f->name))
- name = (char*) XSTRING (f->name)->data;
+ name = (char*) XSTRING (f->name)->data;
else
name = "emacs";
+ f->display.x->menubar_widget->core.border_width)
: 0);
+ if (FRAME_EXTERNAL_MENU_BAR (f))
+ {
+ Dimension ibw;
+ XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
+ menubar_size += ibw;
+ }
+
if (window_prompting & USPosition)
{
int left = f->display.x->left_pos;
- int xneg = left < 0;
+ int xneg = window_prompting & XNegative;
int top = f->display.x->top_pos;
- int yneg = top < 0;
- if (left < 0)
+ int yneg = window_prompting & YNegative;
+ if (xneg)
left = -left;
- if (top < 0)
+ if (yneg)
top = -top;
sprintf (shell_position, "=%dx%d%c%d%c%d", PIXEL_WIDTH (f),
PIXEL_HEIGHT (f) + menubar_size,
f->display.x->wm_hints.input = True;
f->display.x->wm_hints.flags |= InputHint;
XSetWMHints (x_current_display, FRAME_X_WINDOW (f), &f->display.x->wm_hints);
- XSetWMProtocols (x_current_display, FRAME_X_WINDOW (f),
- &Xatom_wm_delete_window, 1);
+ /* Request "save yourself" and "delete window" commands from wm. */
+ {
+ Atom protocols[2];
+ protocols[0] = Xatom_wm_delete_window;
+ protocols[1] = Xatom_wm_save_yourself;
+ XSetWMProtocols (x_current_display, FRAME_X_WINDOW (f), protocols, 2);
+ }
/* x_set_name normally ignores requests to set the name if the
requested name is the same as the current name. This is the one
UNBLOCK_INPUT;
}
-#endif /* HAVE_X11 */
DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1, 1, 0,
(parms)
Lisp_Object parms;
{
-#ifdef HAVE_X11
struct frame *f;
Lisp_Object frame, tem;
Lisp_Object name;
long window_prompting = 0;
int width, height;
int count = specpdl_ptr - specpdl;
+ struct gcpro gcpro1;
check_x ();
name = x_get_arg (parms, Qname, "title", "Title", string);
- if (XTYPE (name) != Lisp_String
+ if (!STRINGP (name)
&& ! EQ (name, Qunbound)
&& ! NILP (name))
error ("x-create-frame: name parameter must be a string");
f = make_minibuffer_frame ();
minibuffer_only = 1;
}
- else if (XTYPE (tem) == Lisp_Window)
+ else if (WINDOWP (tem))
f = make_frame_without_minibuffer (tem);
else
f = make_frame (1);
}
XSET (frame, Lisp_Frame, f);
+ GCPRO1 (frame);
+
f->output_method = output_x_window;
f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
bzero (f->display.x, sizeof (struct x_display));
font = x_new_font (f, XSTRING (font)->data);
/* Try out a font which we hope has bold and italic variations. */
if (!STRINGP (font))
- font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
+ font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
if (! STRINGP (font))
- font = x_new_font (f, "-*-*-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
+ font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
if (! STRINGP (font))
/* This was formerly the first thing tried, but it finds too many fonts
and takes too long. */
font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
/* If those didn't work, look for something which will at least work. */
if (! STRINGP (font))
- font = x_new_font (f, "-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1");
+ font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
UNBLOCK_INPUT;
if (! STRINGP (font))
font = build_string ("fixed");
x_default_parameter (f, parms, Qborder_color, build_string ("black"),
"borderColor", "BorderColor", string);
- x_default_parameter (f, parms, Qmenu_bar_lines, make_number (0),
- "menuBarLines", "MenuBarLines", number);
+ x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
+ "menuBar", "MenuBar", number);
+ x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
+ "scrollBarWidth", "ScrollBarWidth", number);
f->display.x->parent_desc = ROOT_WINDOW;
window_prompting = x_figure_window_size (f, parms);
- switch (((f->display.x->left_pos < 0) << 1) + (f->display.x->top_pos < 0))
+ if (window_prompting & XNegative)
+ {
+ if (window_prompting & YNegative)
+ f->display.x->win_gravity = SouthEastGravity;
+ else
+ f->display.x->win_gravity = NorthEastGravity;
+ }
+ else
{
- case 0:
- f->display.x->win_gravity = NorthWestGravity;
- break;
- case 1:
- f->display.x->win_gravity = SouthWestGravity;
- break;
- case 2:
- f->display.x->win_gravity = NorthEastGravity;
- break;
- case 3:
- f->display.x->win_gravity = SouthEastGravity;
- break;
+ if (window_prompting & YNegative)
+ f->display.x->win_gravity = SouthWestGravity;
+ else
+ f->display.x->win_gravity = NorthWestGravity;
}
+ f->display.x->size_hint_flags = window_prompting;
+
#ifdef USE_X_TOOLKIT
x_window (f, window_prompting, minibuffer_only);
#else
tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
f->no_split = minibuffer_only || EQ (tem, Qt);
+ FRAME_X_SCREEN (f) = &the_x_screen;
+ FRAME_X_SCREEN (f)->reference_count++;
+ the_x_screen.x_display_value = x_current_display;
+
+ UNGCPRO;
+
/* It is now ok to make the frame official
even if we get an error below.
And the frame needs to be on Vframe_list
}
return unbind_to (count, frame);
-#else /* X10 */
- struct frame *f;
- Lisp_Object frame, tem;
- Lisp_Object name;
- int pixelwidth, pixelheight;
- Cursor cursor;
- int height, width;
- Window parent;
- Pixmap temp;
- int minibuffer_only = 0;
- Lisp_Object vscroll, hscroll;
-
- if (x_current_display == 0)
- error ("X windows are not in use or not initialized");
-
- name = Fassq (Qname, parms);
-
- tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
- if (EQ (tem, Qnone))
- f = make_frame_without_minibuffer (Qnil);
- else if (EQ (tem, Qonly))
- {
- f = make_minibuffer_frame ();
- minibuffer_only = 1;
- }
- else if (EQ (tem, Qnil) || EQ (tem, Qunbound))
- f = make_frame (1);
- else
- f = make_frame_without_minibuffer (tem);
-
- parent = ROOT_WINDOW;
-
- XSET (frame, Lisp_Frame, f);
- f->output_method = output_x_window;
- f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
- bzero (f->display.x, sizeof (struct x_display));
-
- /* Some temporary default values for height and width. */
- width = 80;
- height = 40;
- f->display.x->left_pos = -1;
- f->display.x->top_pos = -1;
-
- /* Give the frame a default name (which may be overridden with PARMS). */
-
- strncpy (iconidentity, ICONTAG, MAXICID);
- if (gethostname (&iconidentity[sizeof (ICONTAG) - 1],
- (MAXICID - 1) - sizeof (ICONTAG)))
- iconidentity[sizeof (ICONTAG) - 2] = '\0';
- f->name = build_string (iconidentity);
-
- /* Extract some window parameters from the supplied values.
- These are the parameters that affect window geometry. */
-
- tem = x_get_arg (parms, Qfont, "BodyFont", 0, string);
- if (EQ (tem, Qunbound))
- tem = build_string ("9x15");
- x_set_font (f, tem, Qnil);
- x_default_parameter (f, parms, Qborder_color,
- build_string ("black"), "Border", 0, string);
- x_default_parameter (f, parms, Qbackground_color,
- build_string ("white"), "Background", 0, string);
- x_default_parameter (f, parms, Qforeground_color,
- build_string ("black"), "Foreground", 0, string);
- x_default_parameter (f, parms, Qmouse_color,
- build_string ("black"), "Mouse", 0, string);
- x_default_parameter (f, parms, Qcursor_color,
- build_string ("black"), "Cursor", 0, string);
- x_default_parameter (f, parms, Qborder_width,
- make_number (2), "BorderWidth", 0, number);
- x_default_parameter (f, parms, Qinternal_border_width,
- make_number (4), "InternalBorderWidth", 0, number);
- x_default_parameter (f, parms, Qauto_raise,
- Qnil, "AutoRaise", 0, boolean);
-
- hscroll = EQ (x_get_arg (parms, Qhorizontal_scroll_bar, 0, 0, boolean), Qt);
- vscroll = EQ (x_get_arg (parms, Qvertical_scroll_bar, 0, 0, boolean), Qt);
-
- if (f->display.x->internal_border_width < 0)
- f->display.x->internal_border_width = 0;
-
- tem = x_get_arg (parms, Qwindow_id, 0, 0, number);
- if (!EQ (tem, Qunbound))
- {
- WINDOWINFO_TYPE wininfo;
- int nchildren;
- Window *children, root;
-
- CHECK_NUMBER (tem, 0);
- FRAME_X_WINDOW (f) = (Window) XINT (tem);
-
- BLOCK_INPUT;
- XGetWindowInfo (FRAME_X_WINDOW (f), &wininfo);
- XQueryTree (FRAME_X_WINDOW (f), &parent, &nchildren, &children);
- xfree (children);
- UNBLOCK_INPUT;
-
- height = PIXEL_TO_CHAR_HEIGHT (f, wininfo.height);
- width = PIXEL_TO_CHAR_WIDTH (f, wininfo.width);
- f->display.x->left_pos = wininfo.x;
- f->display.x->top_pos = wininfo.y;
- FRAME_SET_VISIBILITY (f, wininfo.mapped != 0);
- f->display.x->border_width = wininfo.bdrwidth;
- f->display.x->parent_desc = parent;
- }
- else
- {
- tem = x_get_arg (parms, Qparent_id, 0, 0, number);
- if (!EQ (tem, Qunbound))
- {
- CHECK_NUMBER (tem, 0);
- parent = (Window) XINT (tem);
- }
- f->display.x->parent_desc = parent;
- tem = x_get_arg (parms, Qheight, 0, 0, number);
- if (EQ (tem, Qunbound))
- {
- tem = x_get_arg (parms, Qwidth, 0, 0, number);
- if (EQ (tem, Qunbound))
- {
- tem = x_get_arg (parms, Qtop, 0, 0, number);
- if (EQ (tem, Qunbound))
- tem = x_get_arg (parms, Qleft, 0, 0, number);
- }
- }
- /* Now TEM is Qunbound if no edge or size was specified.
- In that case, we must do rubber-banding. */
- if (EQ (tem, Qunbound))
- {
- tem = x_get_arg (parms, Qgeometry, 0, 0, number);
- x_rubber_band (f,
- &f->display.x->left_pos, &f->display.x->top_pos,
- &width, &height,
- (XTYPE (tem) == Lisp_String
- ? (char *) XSTRING (tem)->data : ""),
- XSTRING (f->name)->data,
- !NILP (hscroll), !NILP (vscroll));
- }
- else
- {
- /* Here if at least one edge or size was specified.
- Demand that they all were specified, and use them. */
- tem = x_get_arg (parms, Qheight, 0, 0, number);
- if (EQ (tem, Qunbound))
- error ("Height not specified");
- CHECK_NUMBER (tem, 0);
- height = XINT (tem);
-
- tem = x_get_arg (parms, Qwidth, 0, 0, number);
- if (EQ (tem, Qunbound))
- error ("Width not specified");
- CHECK_NUMBER (tem, 0);
- width = XINT (tem);
-
- tem = x_get_arg (parms, Qtop, 0, 0, number);
- if (EQ (tem, Qunbound))
- error ("Top position not specified");
- CHECK_NUMBER (tem, 0);
- f->display.x->left_pos = XINT (tem);
-
- tem = x_get_arg (parms, Qleft, 0, 0, number);
- if (EQ (tem, Qunbound))
- error ("Left position not specified");
- CHECK_NUMBER (tem, 0);
- f->display.x->top_pos = XINT (tem);
- }
-
- pixelwidth = CHAR_TO_PIXEL_WIDTH (f, width);
- pixelheight = CHAR_TO_PIXEL_HEIGHT (f, height);
-
- BLOCK_INPUT;
- FRAME_X_WINDOW (f)
- = XCreateWindow (parent,
- f->display.x->left_pos, /* Absolute horizontal offset */
- f->display.x->top_pos, /* Absolute Vertical offset */
- pixelwidth, pixelheight,
- f->display.x->border_width,
- BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
- UNBLOCK_INPUT;
- if (FRAME_X_WINDOW (f) == 0)
- error ("Unable to create window.");
- }
-
- /* Install the now determined height and width
- in the windows and in phys_lines and desired_lines. */
- change_frame_size (f, height, width, 1, 0);
- XSelectInput (FRAME_X_WINDOW (f), KeyPressed | ExposeWindow
- | ButtonPressed | ButtonReleased | ExposeRegion | ExposeCopy
- | EnterWindow | LeaveWindow | UnmapWindow );
- x_set_resize_hint (f);
-
- /* Tell the server the window's default name. */
- XStoreName (XDISPLAY FRAME_X_WINDOW (f), XSTRING (f->name)->data);
-
- /* Now override the defaults with all the rest of the specified
- parms. */
- tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
- f->no_split = minibuffer_only || EQ (tem, Qt);
-
- /* Do not create an icon window if the caller says not to */
- if (!EQ (x_get_arg (parms, Qsuppress_icon, 0, 0, boolean), Qt)
- || f->display.x->parent_desc != ROOT_WINDOW)
- {
- x_text_icon (f, iconidentity);
- x_default_parameter (f, parms, Qicon_type, Qnil,
- "BitmapIcon", 0, symbol);
- }
-
- /* Tell the X server the previously set values of the
- background, border and mouse colors; also create the mouse cursor. */
- BLOCK_INPUT;
- temp = XMakeTile (f->display.x->background_pixel);
- XChangeBackground (FRAME_X_WINDOW (f), temp);
- XFreePixmap (temp);
- UNBLOCK_INPUT;
- x_set_border_pixel (f, f->display.x->border_pixel);
-
- x_set_mouse_color (f, Qnil, Qnil);
-
- /* Now override the defaults with all the rest of the specified parms. */
-
- Fmodify_frame_parameters (frame, parms);
-
- /* Make the window appear on the frame and enable display. */
- {
- Lisp_Object visibility;
-
- visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
- if (EQ (visibility, Qunbound))
- visibility = Qt;
-
- if (! EQ (visibility, Qicon)
- && ! NILP (visibility))
- x_make_window_visible (f);
- }
-
- SET_FRAME_GARBAGED (f);
-
- Vframe_list = Fcons (frame, Vframe_list);
- return frame;
-#endif /* X10 */
}
Lisp_Object
return Qnil;
}
\f
-#ifndef HAVE_X11
-/* Computes an X-window size and position either from geometry GEO
- or with the mouse.
-
- F is a frame. It specifies an X window which is used to
- determine which display to compute for. Its font, borders
- and colors control how the rectangle will be displayed.
-
- X and Y are where to store the positions chosen.
- WIDTH and HEIGHT are where to store the sizes chosen.
-
- GEO is the geometry that may specify some of the info.
- STR is a prompt to display.
- HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
-
-int
-x_rubber_band (f, x, y, width, height, geo, str, hscroll, vscroll)
- struct frame *f;
- int *x, *y, *width, *height;
- char *geo;
- char *str;
- int hscroll, vscroll;
-{
- OpaqueFrame frame;
- Window tempwindow;
- WindowInfo wininfo;
- int border_color;
- int background_color;
- Lisp_Object tem;
- int mask;
-
- BLOCK_INPUT;
-
- background_color = f->display.x->background_pixel;
- border_color = f->display.x->border_pixel;
-
- frame.bdrwidth = f->display.x->border_width;
- frame.border = XMakeTile (border_color);
- frame.background = XMakeTile (background_color);
- tempwindow = XCreateTerm (str, "emacs", geo, default_window, &frame, 10, 5,
- (2 * f->display.x->internal_border_width
- + (vscroll ? VSCROLL_WIDTH : 0)),
- (2 * f->display.x->internal_border_width
- + (hscroll ? HSCROLL_HEIGHT : 0)),
- width, height, f->display.x->font,
- FONT_WIDTH (f->display.x->font),
- f->display.x->line_height);
- XFreePixmap (frame.border);
- XFreePixmap (frame.background);
-
- if (tempwindow != 0)
- {
- XQueryWindow (tempwindow, &wininfo);
- XDestroyWindow (tempwindow);
- *x = wininfo.x;
- *y = wininfo.y;
- }
-
- /* Coordinates we got are relative to the root window.
- Convert them to coordinates relative to desired parent window
- by scanning from there up to the root. */
- tempwindow = f->display.x->parent_desc;
- while (tempwindow != ROOT_WINDOW)
- {
- int nchildren;
- Window *children;
- XQueryWindow (tempwindow, &wininfo);
- *x -= wininfo.x;
- *y -= wininfo.y;
- XQueryTree (tempwindow, &tempwindow, &nchildren, &children);
- xfree (children);
- }
-
- UNBLOCK_INPUT;
- return tempwindow != 0;
-}
-#endif /* not HAVE_X11 */
-\f
DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 3, 0,
"Return a list of the names of available fonts matching PATTERN.\n\
If optional arguments FACE and FRAME are specified, return only fonts\n\
XFontStruct *info;
XFontStruct *size_ref;
Lisp_Object list;
+ FRAME_PTR f;
check_x ();
CHECK_STRING (pattern, 0);
if (!NILP (frame))
CHECK_LIVE_FRAME (frame, 2);
+ f = NILP (frame) ? selected_frame : XFRAME (frame);
+
+ /* Determine the width standard for comparison with the fonts we find. */
+
if (NILP (face))
size_ref = 0;
else
{
- FRAME_PTR f = NILP (frame) ? selected_frame : XFRAME (frame);
int face_id;
/* Don't die if we get called with a terminal frame. */
}
}
+ /* See if we cached the result for this particular query. */
+ list = Fassoc (pattern, FRAME_X_SCREEN (f)->font_list_cache);
+
+ /* We have info in the cache for this PATTERN. */
+ if (!NILP (list))
+ {
+ Lisp_Object tem, newlist;
+
+ /* We have info about this pattern. */
+ list = XCONS (list)->cdr;
+
+ if (size_ref == 0)
+ return list;
+
+ BLOCK_INPUT;
+
+ /* Filter the cached info and return just the fonts that match FACE. */
+ newlist = Qnil;
+ for (tem = list; CONSP (tem); tem = XCONS (tem)->cdr)
+ {
+ XFontStruct *thisinfo;
+
+ thisinfo = XLoadQueryFont (x_current_display,
+ XSTRING (XCONS (tem)->car)->data);
+
+ if (thisinfo && same_size_fonts (thisinfo, size_ref))
+ newlist = Fcons (XCONS (tem)->car, newlist);
+
+ XFreeFont (x_current_display, thisinfo);
+ }
+
+ UNBLOCK_INPUT;
+
+ return newlist;
+ }
+
BLOCK_INPUT;
/* Solaris 2.3 has a bug in XListFontsWithInfo. */
if (names)
{
- Lisp_Object *tail;
int i;
+ Lisp_Object full_list;
+
+ /* Make a list of all the fonts we got back.
+ Store that in the font cache for the display. */
+ full_list = Qnil;
+ for (i = 0; i < num_fonts; i++)
+ full_list = Fcons (build_string (names[i]), full_list);
+ FRAME_X_SCREEN (f)->font_list_cache
+ = Fcons (Fcons (pattern, full_list),
+ FRAME_X_SCREEN (f)->font_list_cache);
- tail = &list;
+ /* Make a list of the fonts that have the right width. */
+ list = Qnil;
for (i = 0; i < num_fonts; i++)
{
XFontStruct *thisinfo;
#endif
if (thisinfo && (! size_ref
|| same_size_fonts (thisinfo, size_ref)))
- {
- *tail = Fcons (build_string (names[i]), Qnil);
- tail = &XCONS (*tail)->cdr;
- }
+ list = Fcons (build_string (names[i]), list);
}
+ list = Fnreverse (list);
BLOCK_INPUT;
#ifdef BROKEN_XLISTFONTSWITHINFO
\f
DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 1, 0,
- "Return t if the current X display supports the color named COLOR.")
+ "Return non-nil if the X display supports the color named COLOR.")
(color)
Lisp_Object color;
{
check_x ();
CHECK_STRING (color, 0);
- if (defined_color (XSTRING (color)->data, &foo))
+ if (defined_color (XSTRING (color)->data, &foo, 0))
return Qt;
else
return Qnil;
}
+DEFUN ("x-color-values", Fx_color_values, Sx_color_values, 1, 1, 0,
+ "Return a description of the color named COLOR.\n\
+The value is a list of integer RGB values--(RED GREEN BLUE).\n\
+These values appear to range from 0 to 65280; white is (65280 65280 65280).")
+ (color)
+ Lisp_Object color;
+{
+ Color foo;
+
+ check_x ();
+ CHECK_STRING (color, 0);
+
+ if (defined_color (XSTRING (color)->data, &foo, 0))
+ {
+ Lisp_Object rgb[3];
+
+ rgb[0] = make_number (foo.red);
+ rgb[1] = make_number (foo.green);
+ rgb[2] = make_number (foo.blue);
+ return Flist (3, rgb);
+ }
+ else
+ return Qnil;
+}
+
DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 0, 0,
"Return t if the X screen currently in use supports color.")
()
}
}
+DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
+ 0, 0, 0,
+ "Return t if the X screen currently in use supports grayscale.")
+ ()
+{
+ check_x ();
+
+ return (x_screen_planes > 1
+ && (screen_visual->class == StaticGray
+ || screen_visual->class == GrayScale));
+}
+
DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
0, 1, 0,
"Returns the width in pixels of the display FRAME is on.")
while (1)
{
obj = read_char (-1, 0, 0, Qnil, 0);
- if (XTYPE (obj) != Lisp_Cons)
+ if (!CONSP (obj))
break;
if (mouse_below_point)
do
{
obj = read_char (-1, 0, 0, Qnil, 0);
- if ((XTYPE (obj) != Lisp_Cons)
+ if (!CONSP (obj)
|| (! EQ (Fcar (Fcdr (Fcdr (obj))),
- Qvertical_scroll_bar))
+ Qvertical_scroll_bar))
|| x_mouse_grabbed)
{
BLOCK_INPUT;
obj = read_char (-1, 0, 0, Qnil, 0);
BLOCK_INPUT;
}
- while (XTYPE (obj) == Lisp_Cons /* Mouse event */
+ while (CONSP (obj) /* Mouse event */
&& EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
&& EQ (Vmouse_depressed, Qnil) /* Only motion events */
&& EQ (Vmouse_window, selected_window) /* In this window */
}
#endif
\f
-#ifndef HAVE_X11
-DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer,
- 1, 1, "sStore text in cut buffer: ",
- "Store contents of STRING into the cut buffer of the X window system.")
- (string)
- register Lisp_Object string;
-{
- int mask;
-
- CHECK_STRING (string, 1);
- if (! FRAME_X_P (selected_frame))
- error ("Selected frame does not understand X protocol.");
-
- BLOCK_INPUT;
- XStoreBytes ((char *) XSTRING (string)->data, XSTRING (string)->size);
- UNBLOCK_INPUT;
-
- return Qnil;
-}
-
-DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0,
- "Return contents of cut buffer of the X window system, as a string.")
- ()
-{
- int len;
- register Lisp_Object string;
- int mask;
- register char *d;
-
- BLOCK_INPUT;
- d = XFetchBytes (&len);
- string = make_string (d, len);
- XFree (d);
- UNBLOCK_INPUT;
- return string;
-}
-#endif /* X10 */
-\f
#if 0 /* I'm told these functions are superfluous
given the ability to bind function keys. */
#endif /* HAVE_X11 */
#endif /* 0 */
\f
-#ifdef HAVE_X11
-
#ifndef HAVE_XSCREENNUMBEROFSCREEN
int
XScreenNumberOfScreen (scr)
XFree ((char *) vinfo);
return v;
}
-#endif /* HAVE_X11 */
DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
1, 2, 0, "Open a connection to an X server.\n\
if (! NILP (xrm_string))
CHECK_STRING (xrm_string, 1);
- /* This is what opens the connection and sets x_current_display.
- This also initializes many symbols, such as those used for input. */
- x_term_init (XSTRING (display)->data);
-
-#ifdef HAVE_X11
- XFASTINT (Vwindow_system_version) = 11;
-
if (! NILP (xrm_string))
xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
else
validate_x_resource_name ();
+ /* This is what opens the connection and sets x_current_display.
+ This also initializes many symbols, such as those used for input. */
+ x_term_init (XSTRING (display)->data, xrm_option,
+ XSTRING (Vx_resource_name)->data);
+
+ XFASTINT (Vwindow_system_version) = 11;
+
BLOCK_INPUT;
xrdb = x_load_resources (x_current_display, xrm_option,
(char *) XSTRING (Vx_resource_name)->data,
x_current_display->db = xrdb;
#endif
+ the_x_screen.name = display;
+
x_screen = DefaultScreenOfDisplay (x_current_display);
screen_visual = select_visual (x_screen, &n_planes);
False);
Xatom_editres_name = XInternAtom (x_current_display, "Editres", False);
UNBLOCK_INPUT;
-#else /* not HAVE_X11 */
- XFASTINT (Vwindow_system_version) = 10;
-#endif /* not HAVE_X11 */
return Qnil;
}
really intended only to be called when killing emacs, then there's
no reason for it to have a lisp interface at all. */
check_x();
-#ifdef HAVE_X11
+
/* This is ONLY used when killing emacs; For switching displays
we'll have to take care of setting CloseDownMode elsewhere. */
}
else
fatal ("No current X display connection to close\n");
-#endif
+
return Qnil;
}
/* This is zero if not using X windows. */
x_current_display = 0;
+ the_x_screen.font_list_cache = Qnil;
+ the_x_screen.name = Qnil;
+ staticpro (&the_x_screen.font_list_cache);
+ staticpro (&the_x_screen.name);
+
/* The section below is built by the lisp expression at the top of the file,
just above where these variables are declared. */
/*&&& init symbols here &&&*/
staticpro (&Qnone);
Qparent_id = intern ("parent-id");
staticpro (&Qparent_id);
+ Qscroll_bar_width = intern ("scroll-bar-width");
+ staticpro (&Qscroll_bar_width);
Qsuppress_icon = intern ("suppress-icon");
staticpro (&Qsuppress_icon);
Qtop = intern ("top");
switches, if present.");
Vx_resource_name = Qnil;
-#if 0
+#if 0 /* This doesn't really do anything. */
DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
- "The shape of the pointer when not over text.");
+ "The shape of the pointer when not over text.\n\
+This variable takes effect when you create a new frame\n\
+or when you set the mouse color.");
#endif
Vx_nontext_pointer_shape = Qnil;
-#if 0
+#if 0 /* This doesn't really do anything. */
DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
- "The shape of the pointer when over the mode line.");
+ "The shape of the pointer when over the mode line.\n\
+This variable takes effect when you create a new frame\n\
+or when you set the mouse color.");
#endif
Vx_mode_pointer_shape = Qnil;
- Vx_cross_pointer_shape = Qnil;
+ DEFVAR_INT ("x-sensitive-text-pointer-shape",
+ &Vx_sensitive_text_pointer_shape,
+ "The shape of the pointer when over mouse-sensitive text.\n\
+This variable takes effect when you create a new frame\n\
+or when you set the mouse color.");
+ Vx_sensitive_text_pointer_shape = Qnil;
DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
"A string indicating the foreground color of the cursor box.");
Vmouse_depressed = Qnil;
DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
- "t if no X window manager is in use.");
+ "Non-nil if no X window manager is in use.");
+
+#ifdef USE_X_TOOLKIT
+ Fprovide (intern ("x-toolkit"));
+#endif
-#ifdef HAVE_X11
defsubr (&Sx_get_resource);
#if 0
defsubr (&Sx_draw_rectangle);
defsubr (&Sx_contour_region);
defsubr (&Sx_uncontour_region);
#endif
- defsubr (&Sx_display_color_p);
defsubr (&Sx_list_fonts);
+ defsubr (&Sx_display_color_p);
+ defsubr (&Sx_display_grayscale_p);
defsubr (&Sx_color_defined_p);
+ defsubr (&Sx_color_values);
defsubr (&Sx_server_max_request_size);
defsubr (&Sx_server_vendor);
defsubr (&Sx_server_version);
defsubr (&Sx_track_pointer);
defsubr (&Sx_grab_pointer);
defsubr (&Sx_ungrab_pointer);
-#endif
-#else
- defsubr (&Sx_get_default);
- defsubr (&Sx_store_cut_buffer);
- defsubr (&Sx_get_cut_buffer);
#endif
defsubr (&Sx_parse_geometry);
defsubr (&Sx_create_frame);
HCoop / bpt / emacs.git / blobdiff