extern void abort ();
#ifndef VMS
+#if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
+#include "bitmaps/gray.xbm"
+#else
#include <X11/bitmaps/gray>
+#endif
#else
#include "[.bitmaps]gray.xbm"
#endif
/* The class of this X application. */
#define EMACS_CLASS "Emacs"
+#ifdef HAVE_X11R4
+#define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
+#else
+#define MAXREQUEST(dpy) ((dpy)->max_request_size)
+#endif
+
+/* The name we're using in resource queries. */
+Lisp_Object Vx_resource_name;
+
/* Title name and application name for X stuff. */
extern char *x_id_name;
Lisp_Object Qfont;
Lisp_Object Qforeground_color;
Lisp_Object Qgeometry;
-Lisp_Object Qicon;
+/* Lisp_Object Qicon; */
Lisp_Object Qicon_left;
Lisp_Object Qicon_top;
Lisp_Object Qicon_type;
/* The below are defined in frame.c. */
extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
-extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qicon;
+extern Lisp_Object Qunsplittable, Qmenu_bar_lines;
extern Lisp_Object Vwindow_system_version;
-/* Mouse map for clicks in windows. */
-extern Lisp_Object Vglobal_mouse_map;
-
-/* Points to table of defined typefaces. */
-struct face *x_face_table[MAX_FACES_AND_GLYPHS];
\f
+/* Error if we are not connected to X. */
+static void
+check_x ()
+{
+ if (x_current_display == 0)
+ error ("X windows are not in use or not initialized");
+}
+
/* Return the Emacs frame-object corresponding to an X window.
It could be the frame's main window or an icon window. */
+/* This function can be called during GC, so use XGCTYPE. */
+
struct frame *
x_window_to_frame (wdesc)
int wdesc;
Lisp_Object tail, frame;
struct frame *f;
- for (tail = Vframe_list; CONSP (tail); tail = XCONS (tail)->cdr)
+ for (tail = Vframe_list; XGCTYPE (tail) == Lisp_Cons;
+ tail = XCONS (tail)->cdr)
{
frame = XCONS (tail)->car;
- if (XTYPE (frame) != Lisp_Frame)
+ if (XGCTYPE (frame) != Lisp_Frame)
continue;
f = XFRAME (frame);
if (FRAME_X_WINDOW (f) == wdesc
/* Same here. */
Lisp_Object left, top;
+
+ /* Record in these vectors all the parms specified. */
+ Lisp_Object *parms;
+ Lisp_Object *values;
+ int i;
- XSET (width, Lisp_Int, FRAME_WIDTH (f));
- XSET (height, Lisp_Int, FRAME_HEIGHT (f));
+ i = 0;
+ for (tail = alist; CONSP (tail); tail = Fcdr (tail))
+ i++;
+
+ parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
+ values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
- XSET (top, Lisp_Int, f->display.x->top_pos);
- XSET (left, Lisp_Int, f->display.x->left_pos);
+ /* Extract parm names and values into those vectors. */
+ i = 0;
for (tail = alist; CONSP (tail); tail = Fcdr (tail))
{
Lisp_Object elt, prop, val;
elt = Fcar (tail);
- prop = Fcar (elt);
- val = Fcdr (elt);
+ parms[i] = Fcar (elt);
+ values[i] = Fcdr (elt);
+ i++;
+ }
+
+ width = height = top = left = Qunbound;
+
+ /* Now process them in reverse of specified order. */
+ for (i--; i >= 0; i--)
+ {
+ Lisp_Object prop, val;
+
+ prop = parms[i];
+ val = values[i];
if (EQ (prop, Qwidth))
width = val;
left = val;
else
{
- register Lisp_Object tem;
- tem = Fget (prop, Qx_frame_parameter);
- if (XTYPE (tem) == Lisp_Int
- && XINT (tem) >= 0
- && XINT (tem) < sizeof (x_frame_parms)/sizeof (x_frame_parms[0]))
- (*x_frame_parms[XINT (tem)].setter)(f, val,
- get_frame_param (f, prop));
+ register Lisp_Object param_index = Fget (prop, Qx_frame_parameter);
+ register Lisp_Object old_value = get_frame_param (f, prop);
+
store_frame_param (f, prop, val);
+ if (XTYPE (param_index) == Lisp_Int
+ && XINT (param_index) >= 0
+ && (XINT (param_index)
+ < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
+ (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
}
}
- /* Don't call these unless they've changed; the window may not actually
- exist yet. */
+ /* Don't set these parameters these unless they've been explicitly
+ specified. The window might be mapped or resized while we're in
+ this function, and we don't want to override that unless the lisp
+ code has asked for it.
+
+ Don't set these parameters unless they actually differ from the
+ window's current parameters; the window may not actually exist
+ yet. */
{
Lisp_Object frame;
XSET (frame, Lisp_Frame, f);
- if (XINT (width) != FRAME_WIDTH (f)
- || XINT (height) != FRAME_HEIGHT (f))
+ if ((NUMBERP (width) && XINT (width) != FRAME_WIDTH (f))
+ || (NUMBERP (height) && XINT (height) != FRAME_HEIGHT (f)))
Fset_frame_size (frame, width, height);
- if (XINT (left) != f->display.x->left_pos
- || XINT (top) != f->display.x->top_pos)
+ 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);
}
}
f->display.x->foreground_pixel);
UNBLOCK_INPUT;
#endif /* HAVE_X11 */
+ recompute_basic_faces (f);
if (FRAME_VISIBLE_P (f))
redraw_frame (f);
}
#endif /* not HAVE_X11 */
UNBLOCK_INPUT;
+ recompute_basic_faces (f);
+
if (FRAME_VISIBLE_P (f))
redraw_frame (f);
}
BLOCK_INPUT;
#ifdef HAVE_X11
- /* It's not okay to crash if the user selects a screwey cursor. */
+ /* It's not okay to crash if the user selects a screwy cursor. */
x_catch_errors ();
if (!EQ (Qnil, Vx_pointer_shape))
if (f->display.x->cursor_pixel == fore_pixel)
fore_pixel = f->display.x->background_pixel;
}
+ f->display.x->cursor_foreground_pixel = fore_pixel;
if (FRAME_X_WINDOW (f) != 0)
{
{
if (EQ (arg, Qbar))
FRAME_DESIRED_CURSOR (f) = bar_cursor;
- else if (EQ (arg, Qbox))
- FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
+ else
+#if 0
+ if (EQ (arg, Qbox))
+#endif
+ FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
+ /* Error messages commented out because people have trouble fixing
+ .Xdefaults with Emacs, when it has something bad in it. */
+#if 0
else
error
("the `cursor-type' frame parameter should be either `bar' or `box'");
+#endif
/* Make sure the cursor gets redrawn. This is overkill, but how
often do people change cursor types? */
UNBLOCK_INPUT;
}
+extern Lisp_Object x_new_font ();
+
void
x_set_font (f, arg, oldval)
struct frame *f;
Lisp_Object arg, oldval;
{
- unsigned char *name;
- int result;
+ Lisp_Object result;
CHECK_STRING (arg, 1);
- name = XSTRING (arg)->data;
BLOCK_INPUT;
- result = x_new_font (f, name);
+ result = x_new_font (f, XSTRING (arg)->data);
UNBLOCK_INPUT;
- if (result)
- error ("Font \"%s\" is not defined", name);
+ if (EQ (result, Qnil))
+ error ("Font \"%s\" is not defined", XSTRING (arg)->data);
+ else if (EQ (result, Qt))
+ error ("the characters of the given font have varying widths");
+ else if (STRINGP (result))
+ {
+ recompute_basic_faces (f);
+ store_frame_param (f, Qfont, result);
+ }
+ else
+ abort ();
}
void
Lisp_Object window;
int n;
{
- for (; !NILP (window); window = XWINDOW (window)->next)
- {
- struct window *w = XWINDOW (window);
+ struct window *w = XWINDOW (window);
- w->top += n;
+ XFASTINT (w->top) += n;
+ XFASTINT (w->height) -= n;
- if (!NILP (w->vchild))
- x_set_menu_bar_lines_1 (w->vchild);
+ /* Handle just the top child in a vertical split. */
+ if (!NILP (w->vchild))
+ x_set_menu_bar_lines_1 (w->vchild, n);
- if (!NILP (w->hchild))
- x_set_menu_bar_lines_1 (w->hchild);
+ /* Adjust all children in a horizontal split. */
+ for (window = w->hchild; !NILP (window); window = w->next)
+ {
+ w = XWINDOW (window);
+ x_set_menu_bar_lines_1 (window, n);
}
}
int nlines;
int olines = FRAME_MENU_BAR_LINES (f);
+ /* Right now, menu bars don't work properly in minibuf-only frames;
+ most of the commands try to apply themselves to the minibuffer
+ frame itslef, and get an error because you can't switch buffers
+ in or split the minibuffer window. */
+ if (FRAME_MINIBUF_ONLY_P (f))
+ return;
+
if (XTYPE (value) == Lisp_Int)
nlines = XINT (value);
else
FRAME_MENU_BAR_LINES (f) = nlines;
x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
- x_set_window_size (f, FRAME_WIDTH (f),
- FRAME_HEIGHT (f) + nlines - olines);
}
/* Change the name of frame F to ARG. If ARG is nil, set F's name to
}
}
\f
+/* Subroutines of creating an X frame. */
+
#ifdef HAVE_X11
-int n_faces;
-#if 0
-/* I believe this function is obsolete with respect to the new face display
- changes. */
-x_set_face (scr, font, background, foreground, stipple)
- struct frame *scr;
- XFontStruct *font;
- unsigned long background, foreground;
- Pixmap stipple;
+/* Make sure that Vx_resource_name is set to a reasonable value. */
+static void
+validate_x_resource_name ()
{
- XGCValues gc_values;
- GC temp_gc;
- unsigned long gc_mask;
- struct face *new_face;
- unsigned int width = 16;
- unsigned int height = 16;
-
- if (n_faces == MAX_FACES_AND_GLYPHS)
- return 1;
-
- /* Create the Graphics Context. */
- gc_values.font = font->fid;
- gc_values.foreground = foreground;
- gc_values.background = background;
- gc_values.line_width = 0;
- gc_mask = GCLineWidth | GCFont | GCForeground | GCBackground;
- if (stipple)
- {
- gc_values.stipple
- = XCreateBitmapFromData (x_current_display, ROOT_WINDOW,
- (char *) stipple, width, height);
- gc_mask |= GCStipple;
- }
-
- temp_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (scr),
- gc_mask, &gc_values);
- if (!temp_gc)
- return 1;
- new_face = (struct face *) xmalloc (sizeof (struct face));
- if (!new_face)
- {
- XFreeGC (x_current_display, temp_gc);
- return 1;
- }
-
- new_face->font = font;
- new_face->foreground = foreground;
- new_face->background = background;
- new_face->face_gc = temp_gc;
- if (stipple)
- new_face->stipple = gc_values.stipple;
-
- x_face_table[++n_faces] = new_face;
- return 1;
+ if (! STRINGP (Vx_resource_name))
+ Vx_resource_name = make_string ("emacs", 5);
}
-#endif
-x_set_glyph (scr, glyph)
-{
-}
-#if 0
-DEFUN ("x-set-face-font", Fx_set_face_font, Sx_set_face_font, 4, 2, 0,
- "Specify face table entry FACE-CODE to be the font named by FONT,\n\
- in colors FOREGROUND and BACKGROUND.")
- (face_code, font_name, foreground, background)
- Lisp_Object face_code;
- Lisp_Object font_name;
- Lisp_Object foreground;
- Lisp_Object background;
-{
- register struct face *fp; /* Current face info. */
- register int fn; /* Face number. */
- register FONT_TYPE *f; /* Font data structure. */
- unsigned char *newname;
- int fg, bg;
- GC temp_gc;
- XGCValues gc_values;
-
- /* Need to do something about this. */
- Drawable drawable = FRAME_X_WINDOW (selected_frame);
-
- CHECK_NUMBER (face_code, 1);
- CHECK_STRING (font_name, 2);
-
- if (EQ (foreground, Qnil) || EQ (background, Qnil))
- {
- fg = selected_frame->display.x->foreground_pixel;
- bg = selected_frame->display.x->background_pixel;
- }
- else
- {
- CHECK_NUMBER (foreground, 0);
- CHECK_NUMBER (background, 1);
-
- fg = x_decode_color (XINT (foreground), BLACK_PIX_DEFAULT);
- bg = x_decode_color (XINT (background), WHITE_PIX_DEFAULT);
- }
-
- fn = XINT (face_code);
- if ((fn < 1) || (fn > 255))
- error ("Invalid face code, %d", fn);
-
- newname = XSTRING (font_name)->data;
- BLOCK_INPUT;
- f = (*newname == 0 ? 0 : XGetFont (newname));
- UNBLOCK_INPUT;
- if (f == 0)
- error ("Font \"%s\" is not defined", newname);
-
- fp = x_face_table[fn];
- if (fp == 0)
- {
- x_face_table[fn] = fp = (struct face *) xmalloc (sizeof (struct face));
- bzero (fp, sizeof (struct face));
- fp->face_type = x_pixmap;
- }
- else if (FACE_IS_FONT (fn))
- {
- BLOCK_INPUT;
- XFreeGC (FACE_FONT (fn));
- UNBLOCK_INPUT;
- }
- else if (FACE_IS_IMAGE (fn)) /* This should not happen... */
- {
- BLOCK_INPUT;
- XFreePixmap (x_current_display, FACE_IMAGE (fn));
- fp->face_type = x_font;
- UNBLOCK_INPUT;
- }
- else
- abort ();
-
- fp->face_GLYPH.font_desc.font = f;
- gc_values.font = f->fid;
- gc_values.foreground = fg;
- gc_values.background = bg;
- fp->face_GLYPH.font_desc.face_gc = XCreateGC (x_current_display,
- drawable, GCFont | GCForeground
- | GCBackground, &gc_values);
- fp->face_GLYPH.font_desc.font_width = FONT_WIDTH (f);
- fp->face_GLYPH.font_desc.font_height = FONT_HEIGHT (f);
-
- return face_code;
-}
-#endif
-#else /* X10 */
-DEFUN ("x-set-face", Fx_set_face, Sx_set_face, 4, 4, 0,
- "Specify face table entry FACE-CODE to be the font named by FONT,\n\
- in colors FOREGROUND and BACKGROUND.")
- (face_code, font_name, foreground, background)
- Lisp_Object face_code;
- Lisp_Object font_name;
- Lisp_Object foreground;
- Lisp_Object background;
-{
- register struct face *fp; /* Current face info. */
- register int fn; /* Face number. */
- register FONT_TYPE *f; /* Font data structure. */
- unsigned char *newname;
-
- CHECK_NUMBER (face_code, 1);
- CHECK_STRING (font_name, 2);
-
- fn = XINT (face_code);
- if ((fn < 1) || (fn > 255))
- error ("Invalid face code, %d", fn);
-
- /* Ask the server to find the specified font. */
- newname = XSTRING (font_name)->data;
- BLOCK_INPUT;
- f = (*newname == 0 ? 0 : XGetFont (newname));
- UNBLOCK_INPUT;
- if (f == 0)
- error ("Font \"%s\" is not defined", newname);
-
- /* Get the face structure for face_code in the face table.
- Make sure it exists. */
- fp = x_face_table[fn];
- if (fp == 0)
- {
- x_face_table[fn] = fp = (struct face *) xmalloc (sizeof (struct face));
- bzero (fp, sizeof (struct face));
- }
-
- /* If this face code already exists, get rid of the old font. */
- if (fp->font != 0 && fp->font != f)
- {
- BLOCK_INPUT;
- XLoseFont (fp->font);
- UNBLOCK_INPUT;
- }
-
- /* Store the specified information in FP. */
- fp->fg = x_decode_color (foreground, BLACK_PIX_DEFAULT);
- fp->bg = x_decode_color (background, WHITE_PIX_DEFAULT);
- fp->font = f;
-
- return face_code;
-}
-#endif /* X10 */
-
-#if 0
-/* This is excluded because there is no painless way
- to get or to remember the name of the font. */
-
-DEFUN ("x-get-face", Fx_get_face, Sx_get_face, 1, 1, 0,
- "Get data defining face code FACE. FACE is an integer.\n\
-The value is a list (FONT FG-COLOR BG-COLOR).")
- (face)
- Lisp_Object face;
-{
- register struct face *fp; /* Current face info. */
- register int fn; /* Face number. */
-
- CHECK_NUMBER (face, 1);
- fn = XINT (face);
- if ((fn < 1) || (fn > 255))
- error ("Invalid face code, %d", fn);
-
- /* Make sure the face table exists and this face code is defined. */
- if (x_face_table == 0 || x_face_table[fn] == 0)
- return Qnil;
-
- fp = x_face_table[fn];
-
- return Fcons (build_string (fp->name),
- Fcons (make_number (fp->fg),
- Fcons (make_number (fp->bg), Qnil)));
-}
-#endif /* 0 */
-\f
-/* Subroutines of creating an X frame. */
-
-#ifdef HAVE_X11
extern char *x_get_string_resource ();
extern XrmDatabase x_load_resources ();
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 `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
-class, where INSTANCE is the name under which Emacs was invoked.\n\
+This uses `NAME.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 `INSTANCE.COMPONENT.ATTRIBUTE'\n\
+If you specify them, the key is `NAME.COMPONENT.ATTRIBUTE'\n\
and the class is `Emacs.CLASS.SUBCLASS'.")
(attribute, class, component, subclass)
Lisp_Object attribute, class, component, subclass;
char *name_key;
char *class_key;
+ check_x ();
+
CHECK_STRING (attribute, 0);
CHECK_STRING (class, 0);
if (NILP (component) != NILP (subclass))
error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
+ validate_x_resource_name ();
+
if (NILP (component))
{
/* Allocate space for the components, the dots which separate them,
and the final '\0'. */
- name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
+ name_key = (char *) alloca (XSTRING (Vx_resource_name)->size
+ XSTRING (attribute)->size
+ 2);
class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
+ 2);
sprintf (name_key, "%s.%s",
- XSTRING (Vinvocation_name)->data,
+ XSTRING (Vx_resource_name)->data,
XSTRING (attribute)->data);
sprintf (class_key, "%s.%s",
EMACS_CLASS,
}
else
{
- name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
+ name_key = (char *) alloca (XSTRING (Vx_resource_name)->size
+ XSTRING (component)->size
+ XSTRING (attribute)->size
+ 3);
+ 3);
sprintf (name_key, "%s.%s.%s",
- XSTRING (Vinvocation_name)->data,
+ XSTRING (Vx_resource_name)->data,
XSTRING (component)->data,
XSTRING (attribute)->data);
- sprintf (class_key, "%s.%s",
+ sprintf (class_key, "%s.%s.%s",
EMACS_CLASS,
XSTRING (class)->data,
XSTRING (subclass)->data);
return Qnil;
}
+/* Used when C code wants a resource value. */
+
+char *
+x_get_resource_string (attribute, class)
+ char *attribute, *class;
+{
+ register char *value;
+ char *name_key;
+ char *class_key;
+
+ /* Allocate space for the components, the dots which separate them,
+ and the final '\0'. */
+ name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
+ + strlen (attribute) + 2);
+ class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
+ + strlen (class) + 2);
+
+ sprintf (name_key, "%s.%s",
+ XSTRING (Vinvocation_name)->data,
+ attribute);
+ sprintf (class_key, "%s.%s", EMACS_CLASS, class);
+
+ 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,
window manager prompting. */
f->width = DEFAULT_COLS;
f->height = DEFAULT_ROWS;
- f->display.x->top_pos = 1;
- f->display.x->left_pos = 1;
+ /* Window managers expect that if program-specified
+ positions are not (0,0), they're intentional, not defaults. */
+ f->display.x->top_pos = 0;
+ f->display.x->left_pos = 0;
tem0 = x_get_arg (parms, Qheight, 0, 0, number);
tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
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)
- : 0);
+ f->display.x->vertical_scroll_bar_extra
+ = (FRAME_HAS_VERTICAL_SCROLL_BARS (f)
+ ? VERTICAL_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);
else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
error ("Must specify *both* top and left corners");
+#if 0 /* PPosition and PSize mean "specified explicitly,
+ by the program rather than by the user". So it is wrong to
+ set them if nothing was specified. */
switch (window_prompting)
{
case USSize | USPosition:
put there. */
abort ();
}
+#endif
+ return window_prompting;
}
static void
screen_visual, /* set in Fx_open_connection */
attribute_mask, &attributes);
- class_hints.res_name = (char *) XSTRING (f->name)->data;
+ validate_x_resource_name ();
+ class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
class_hints.res_class = EMACS_CLASS;
XSetClassHint (x_current_display, FRAME_X_WINDOW (f), &class_hints);
f->display.x->background_pixel,
DefaultDepth (x_current_display, XDefaultScreen (x_current_display))));
- init_frame_faces (f);
-
UNBLOCK_INPUT;
}
#endif /* HAVE_X11 */
long window_prompting = 0;
int width, height;
- if (x_current_display == 0)
- error ("X windows are not in use or not initialized");
+ check_x ();
name = x_get_arg (parms, Qname, "title", "Title", string);
if (XTYPE (name) != Lisp_String
/* Extract the window parameters from the supplied values
that are needed to determine window geometry. */
- x_default_parameter (f, parms, Qfont, build_string ("9x15"),
- "font", "Font", string);
+ {
+ Lisp_Object font;
+
+ font = x_get_arg (parms, Qfont, "font", "Font", string);
+ BLOCK_INPUT;
+ /* First, try whatever font the caller has specified. */
+ if (STRINGP (font))
+ 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");
+ if (! STRINGP (font))
+ font = x_new_font (f, "-*-*-medium-r-normal-*-*-120-*-*-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");
+ UNBLOCK_INPUT;
+ if (! STRINGP (font))
+ font = build_string ("fixed");
+
+ x_default_parameter (f, parms, Qfont, font,
+ "font", "Font", string);
+ }
x_default_parameter (f, parms, Qborder_width, make_number (2),
"borderwidth", "BorderWidth", number);
- /* This defaults to 2 in order to match xterm. */
+ /* This defaults to 2 in order to match xterm. We recognize either
+ internalBorderWidth or internalBorder (which is what xterm calls
+ it). */
+ if (NILP (Fassq (Qinternal_border_width, parms)))
+ {
+ Lisp_Object value;
+
+ value = x_get_arg (parms, Qinternal_border_width,
+ "internalBorder", "BorderWidth", number);
+ if (! EQ (value, Qunbound))
+ parms = Fcons (Fcons (Qinternal_border_width, value),
+ parms);
+ }
x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
"internalBorderWidth", "BorderWidth", number);
x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
x_window (f);
x_icon (f, parms);
x_make_gc (f);
+ init_frame_faces (f);
/* We need to do this after creating the X window, so that the
icon-creation functions can say whose icon they're describing. */
x_default_parameter (f, parms, Qicon_type, Qnil,
- "iconType", "IconType", symbol);
+ "bitmapIcon", "BitmapIcon", symbol);
x_default_parameter (f, parms, Qauto_raise, Qnil,
"autoRaise", "AutoRaiseLower", boolean);
f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
bzero (f->display.x, sizeof (struct x_display));
- /* Some temprorary default values for height and width. */
+ /* Some temporary default values for height and width. */
width = 80;
height = 40;
f->display.x->left_pos = -1;
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\
+the same size as FACE on FRAME.\n\
+\n\
+PATTERN is a string, perhaps with wildcard characters;\n\
+ the * character matches any substring, and\n\
+ the ? character matches any single character.\n\
+ PATTERN is case-insensitive.\n\
+FACE is a face name - a symbol.\n\
+\n\
+The return value is a list of strings, suitable as arguments to\n\
+set-face-font.\n\
+\n\
+The list does not include fonts Emacs can't use (i.e. proportional\n\
+fonts), even if they match PATTERN and FACE.")
+ (pattern, face, frame)
+ Lisp_Object pattern, face, frame;
+{
+ int num_fonts;
+ char **names;
+ XFontStruct *info;
+ XFontStruct *size_ref;
+ Lisp_Object list;
+
+ CHECK_STRING (pattern, 0);
+ if (!NILP (face))
+ CHECK_SYMBOL (face, 1);
+ if (!NILP (frame))
+ CHECK_LIVE_FRAME (frame, 2);
+
+ if (NILP (face))
+ size_ref = 0;
+ else
+ {
+ FRAME_PTR f = NILP (frame) ? selected_frame : XFRAME (frame);
+ int face_id = face_name_id_number (f, face);
+
+ if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
+ || FRAME_PARAM_FACES (f) [face_id] == 0)
+ size_ref = f->display.x->font;
+ else
+ {
+ size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
+ if (size_ref == (XFontStruct *) (~0))
+ size_ref = f->display.x->font;
+ }
+ }
+
+ BLOCK_INPUT;
+ names = XListFontsWithInfo (x_current_display,
+ XSTRING (pattern)->data,
+ 2000, /* maxnames */
+ &num_fonts, /* count_return */
+ &info); /* info_return */
+ UNBLOCK_INPUT;
+
+ list = Qnil;
+
+ if (names)
+ {
+ Lisp_Object *tail;
+ int i;
+
+ tail = &list;
+ for (i = 0; i < num_fonts; i++)
+ if (! size_ref
+ || same_size_fonts (&info[i], size_ref))
+ {
+ *tail = Fcons (build_string (names[i]), Qnil);
+ tail = &XCONS (*tail)->cdr;
+ }
+
+ XFreeFontInfo (names, info, num_fonts);
+ }
+
+ return list;
+}
+
\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.")
{
Color foo;
+ check_x ();
CHECK_STRING (color, 0);
if (defined_color (XSTRING (color)->data, &foo))
"Return t if the X screen currently in use supports color.")
()
{
+ check_x ();
+
if (x_screen_planes <= 2)
return Qnil;
Lisp_Object frame;
{
Display *dpy = x_current_display;
+ check_x ();
return make_number (DisplayWidth (dpy, DefaultScreen (dpy)));
}
Lisp_Object frame;
{
Display *dpy = x_current_display;
+ check_x ();
return make_number (DisplayHeight (dpy, DefaultScreen (dpy)));
}
Lisp_Object frame;
{
Display *dpy = x_current_display;
+ check_x ();
return make_number (DisplayPlanes (dpy, DefaultScreen (dpy)));
}
Lisp_Object frame;
{
Display *dpy = x_current_display;
+ check_x ();
return make_number (DisplayCells (dpy, DefaultScreen (dpy)));
}
+DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
+ Sx_server_max_request_size,
+ 0, 1, 0,
+ "Returns the maximum request size of the X server FRAME is using.")
+ (frame)
+ Lisp_Object frame;
+{
+ Display *dpy = x_current_display;
+ check_x ();
+ return make_number (MAXREQUEST (dpy));
+}
+
DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
"Returns the vendor ID string of the X server FRAME is on.")
(frame)
{
Display *dpy = x_current_display;
char *vendor;
+ check_x ();
vendor = ServerVendor (dpy);
if (! vendor) vendor = "";
return build_string (vendor);
Lisp_Object frame;
{
Display *dpy = x_current_display;
+
+ check_x ();
return Fcons (make_number (ProtocolVersion (dpy)),
Fcons (make_number (ProtocolRevision (dpy)),
Fcons (make_number (VendorRelease (dpy)), Qnil)));
(frame)
Lisp_Object frame;
{
+ check_x ();
return make_number (ScreenCount (x_current_display));
}
(frame)
Lisp_Object frame;
{
+ check_x ();
return make_number (HeightMMOfScreen (x_screen));
}
(frame)
Lisp_Object frame;
{
+ check_x ();
return make_number (WidthMMOfScreen (x_screen));
}
(frame)
Lisp_Object frame;
{
+ check_x ();
+
switch (DoesBackingStore (x_screen))
{
case Always:
(screen)
Lisp_Object screen;
{
+ check_x ();
+
switch (screen_visual->class)
{
case StaticGray: return (intern ("static-gray"));
(frame)
Lisp_Object frame;
{
+ check_x ();
+
if (DoesSaveUnders (x_screen) == True)
return Qt;
else
}
}
-/* Erase the top horzontal lines of the contour, and then extend
+/* Erase the top horizontal lines of the contour, and then extend
the contour upwards. */
static void
register KeySym keysym;
KeySym modifier_list[16];
+ check_x ();
CHECK_STRING (x_keysym, 1);
CHECK_STRING (newstring, 3);
mod = Fcar (rest);
CHECK_STRING (mod, 3);
modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
+#ifndef HAVE_X11R5
+ if (modifier_list[i] == NoSymbol
+ || !(IsModifierKey (modifier_list[i])
+ || ((unsigned)(modifier_list[i]) == XK_Mode_switch)
+ || ((unsigned)(modifier_list[i]) == XK_Num_Lock)))
+#else
if (modifier_list[i] == NoSymbol
|| !IsModifierKey (modifier_list[i]))
+#endif
error ("Element is not a modifier keysym");
i++;
}
int strsize;
register unsigned i;
+ check_x ();
CHECK_NUMBER (keycode, 1);
CHECK_CONS (strings, 2);
rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
}
return Qnil;
}
-#else
-DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
- "Rebind KEYCODE, with shift bits SHIFT-MASK, to new string NEWSTRING.\n\
-KEYCODE and SHIFT-MASK should be numbers representing the X keyboard code\n\
-and shift mask respectively. NEWSTRING is an arbitrary string of keystrokes.\n\
-If SHIFT-MASK is nil, then KEYCODE's key will be bound to NEWSTRING for\n\
-all shift combinations.\n\
-Shift Lock 1 Shift 2\n\
-Meta 4 Control 8\n\
-\n\
-For values of KEYCODE, see /usr/lib/Xkeymap.txt (remember that the codes\n\
-in that file are in octal!)\n\
-\n\
-NOTE: due to an X bug, this function will not take effect unless one has\n\
-a `~/.Xkeymap' file. (See the documentation for the `keycomp' program.)\n\
-This problem will be fixed in X version 11.")
-
- (keycode, shift_mask, newstring)
- register Lisp_Object keycode;
- register Lisp_Object shift_mask;
- register Lisp_Object newstring;
-{
- char *rawstring;
- int keysym, rawshift;
- int i, strsize;
-
- CHECK_NUMBER (keycode, 1);
- if (!NILP (shift_mask))
- CHECK_NUMBER (shift_mask, 2);
- CHECK_STRING (newstring, 3);
- strsize = XSTRING (newstring)->size;
- rawstring = (char *) xmalloc (strsize);
- bcopy (XSTRING (newstring)->data, rawstring, strsize);
-
- keysym = ((unsigned) (XINT (keycode))) & 255;
-
- if (NILP (shift_mask))
- {
- for (i = 0; i <= 15; i++)
- XRebindCode (keysym, i<<11, rawstring, strsize);
- }
- else
- {
- rawshift = (((unsigned) (XINT (shift_mask))) & 15) << 11;
- XRebindCode (keysym, rawshift, rawstring, strsize);
- }
- return Qnil;
-}
-
-DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
- "Rebind KEYCODE to list of strings STRINGS.\n\
-STRINGS should be a list of 16 elements, one for each shift combination.\n\
-nil as element means don't change.\n\
-See the documentation of `x-rebind-key' for more information.")
- (keycode, strings)
- register Lisp_Object keycode;
- register Lisp_Object strings;
-{
- register Lisp_Object item;
- register char *rawstring;
- KeySym rawkey, modifier[1];
- int strsize;
- register unsigned i;
-
- CHECK_NUMBER (keycode, 1);
- CHECK_CONS (strings, 2);
- rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
- for (i = 0; i <= 15; strings = Fcdr (strings), i++)
- {
- item = Fcar (strings);
- if (!NILP (item))
- {
- CHECK_STRING (item, 2);
- strsize = XSTRING (item)->size;
- rawstring = (char *) xmalloc (strsize);
- bcopy (XSTRING (item)->data, rawstring, strsize);
- XRebindCode (rawkey, i << 11, rawstring, strsize);
- }
- }
- return Qnil;
-}
-#endif /* not HAVE_X11 */
+#endif /* HAVE_X11 */
\f
#ifdef HAVE_X11
Visual *
vinfo_template.visualid = v->visualid;
#endif
- vinfo = XGetVisualInfo (x_current_display, VisualIDMask, &vinfo_template,
+ vinfo_template.screen = XScreenNumberOfScreen (screen);
+
+ vinfo = XGetVisualInfo (x_current_display,
+ VisualIDMask | VisualScreenMask, &vinfo_template,
&n_visuals);
if (n_visuals != 1)
fatal ("Can't get proper X visual info");
DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
1, 2, 0, "Open a connection to an X server.\n\
-DISPLAY is the name of the display to connect to. Optional second\n\
-arg XRM_STRING is a string of resources in xrdb format.")
+DISPLAY is the name of the display to connect to.\n\
+Optional second arg XRM_STRING is a string of resources in xrdb format.")
(display, xrm_string)
Lisp_Object display, xrm_string;
{
CHECK_STRING (display, 0);
if (x_current_display != 0)
error ("X server connection is already initialized");
+ 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. */
#ifdef HAVE_X11
XFASTINT (Vwindow_system_version) = 11;
- if (!EQ (xrm_string, Qnil))
- {
- CHECK_STRING (xrm_string, 1);
- xrm_option = (unsigned char *) XSTRING (xrm_string);
- }
+ if (! NILP (xrm_string))
+ xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
else
xrm_option = (unsigned char *) 0;
- xrdb = x_load_resources (x_current_display, xrm_option, EMACS_CLASS);
-#ifdef HAVE_X11R5
+
+ validate_x_resource_name ();
+
+ BLOCK_INPUT;
+ xrdb = x_load_resources (x_current_display, xrm_option,
+ (char *) XSTRING (Vx_resource_name)->data,
+ EMACS_CLASS);
+ UNBLOCK_INPUT;
+#if defined (HAVE_X11R5)
XrmSetDatabase (x_current_display, xrdb);
#else
x_current_display->db = xrdb;
BLOCK_INPUT;
XSetCloseDownMode (x_current_display, DestroyAll);
XCloseDisplay (x_current_display);
+ x_current_display = 0;
}
else
fatal ("No current X display connection to close\n");
(on)
Lisp_Object on;
{
+ check_x ();
+
XSynchronize (x_current_display, !EQ (on, Qnil));
return Qnil;
staticpro (&Qforeground_color);
Qgeometry = intern ("geometry");
staticpro (&Qgeometry);
- Qicon = intern ("icon");
- staticpro (&Qicon);
Qicon_left = intern ("icon-left");
staticpro (&Qicon_left);
Qicon_top = intern ("icon-top");
init_x_parm_symbols ();
DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset,
- "The buffer offset of the character under the pointer.");
+ "The buffer offset of the character under the pointer.");
mouse_buffer_offset = 0;
DEFVAR_INT ("x-pointer-shape", &Vx_pointer_shape,
- "The shape of the pointer when over text.");
+ "The shape of the pointer when over text.\n\
+Changing the value does not affect existing frames\n\
+unless you set the mouse color.");
Vx_pointer_shape = Qnil;
+ DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
+ "The name Emacs uses to look up X resources; for internal use only.\n\
+`x-get-resource' uses this as the first component of the instance name\n\
+when requesting resource values.\n\
+Emacs initially sets `x-resource-name' to the name under which Emacs\n\
+was invoked, or to the value specified with the `-name' or `-rn'\n\
+switches, if present.");
+ Vx_resource_name = Qnil;
+ staticpro (&Vx_resource_name);
+
+#if 0
DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
"The shape of the pointer when not over text.");
+#endif
Vx_nontext_pointer_shape = Qnil;
+#if 0
DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
"The shape of the pointer when over the mode line.");
+#endif
Vx_mode_pointer_shape = Qnil;
DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
defsubr (&Sx_uncontour_region);
#endif
defsubr (&Sx_display_color_p);
+ defsubr (&Sx_list_fonts);
defsubr (&Sx_color_defined_p);
+ defsubr (&Sx_server_max_request_size);
defsubr (&Sx_server_vendor);
defsubr (&Sx_server_version);
defsubr (&Sx_display_pixel_width);
defsubr (&Sx_display_visual_class);
defsubr (&Sx_display_backing_store);
defsubr (&Sx_display_save_under);
+ defsubr (&Sx_rebind_key);
+ defsubr (&Sx_rebind_keys);
#if 0
defsubr (&Sx_track_pointer);
defsubr (&Sx_grab_pointer);
defsubr (&Sx_get_default);
defsubr (&Sx_store_cut_buffer);
defsubr (&Sx_get_cut_buffer);
- defsubr (&Sx_set_face);
#endif
defsubr (&Sx_parse_geometry);
defsubr (&Sx_create_frame);
#if 0
defsubr (&Sx_horizontal_line);
#endif
- defsubr (&Sx_rebind_key);
- defsubr (&Sx_rebind_keys);
defsubr (&Sx_open_connection);
defsubr (&Sx_close_current_connection);
defsubr (&Sx_synchronize);