#include <stdio.h>
#endif
#include <signal.h>
-#include "config.h"
+#include <config.h>
#include "lisp.h"
#include "xterm.h"
#include "frame.h"
#include "buffer.h"
#include "dispextern.h"
#include "keyboard.h"
+#include "blockinput.h"
#ifdef HAVE_X_WINDOWS
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
+
+#ifdef USE_X_TOOLKIT
+#include <X11/Shell.h>
+
+#include <X11/Xaw/Paned.h>
+#include <X11/Xaw/Label.h>
+
+#ifdef USG
+#undef USG /* ####KLUDGE for Solaris 2.2 and up */
+#include <X11/Xos.h>
+#define USG
+#else
+#include <X11/Xos.h>
+#endif
+
+#include "widget.h"
+
+#include "../lwlib/lwlib.h"
+
+/* The one and only application context associated with the connection
+ to the one and only X display that Emacs uses. */
+XtAppContext Xt_app_con;
+
+/* The one and only application shell. Emacs screens are popup shells of this
+ application. */
+Widget Xt_app_shell;
+
+extern void free_frame_menubar ();
+extern void free_frame_menubar ();
+#endif /* USE_X_TOOLKIT */
#define min(a,b) ((a) < (b) ? (a) : (b))
#define max(a,b) ((a) > (b) ? (a) : (b))
/* 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;
/* 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;
/* Color of chars displayed in cursor box. */
Lisp_Object Vx_cursor_fore_pixel;
extern Atom Xatom_wm_configure_denied; /* When our config request is denied */
extern Atom Xatom_wm_window_moved; /* When the WM moves us. */
+/* EditRes protocol */
+extern Atom Xatom_editres_name;
+
#else /* X10 */
/* Default size of an Emacs window. */
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 Qiconic_startup;
Lisp_Object Qinternal_border_width;
Lisp_Object Qleft;
Lisp_Object Qmouse_color;
Lisp_Object Qnone;
Lisp_Object Qparent_id;
Lisp_Object Qsuppress_icon;
-Lisp_Object Qsuppress_initial_map;
Lisp_Object Qtop;
Lisp_Object Qundefined_color;
Lisp_Object Qvertical_scroll_bars;
+Lisp_Object Qvisibility;
Lisp_Object Qwindow_id;
Lisp_Object Qx_frame_parameter;
-Lisp_Object Qvisibility;
+Lisp_Object Qx_resource_name;
/* 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. */
+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);
+#ifdef USE_X_TOOLKIT
+ if (f->display.nothing == 1)
+ return 0;
+ if ((f->display.x->edit_widget
+ && XtWindow (f->display.x->edit_widget) == wdesc)
+ || f->display.x->icon_desc == wdesc)
+ return f;
+#else /* not USE_X_TOOLKIT */
if (FRAME_X_WINDOW (f) == wdesc
|| f->display.x->icon_desc == wdesc)
return f;
+#endif /* not USE_X_TOOLKIT */
+ }
+ return 0;
+}
+
+#ifdef USE_X_TOOLKIT
+/* Like x_window_to_frame but also compares the window with the widget's
+ windows. */
+
+struct frame *
+x_any_window_to_frame (wdesc)
+ int wdesc;
+{
+ Lisp_Object tail, frame;
+ struct frame *f;
+ struct x_display *x;
+
+ for (tail = Vframe_list; XGCTYPE (tail) == Lisp_Cons;
+ tail = XCONS (tail)->cdr)
+ {
+ frame = XCONS (tail)->car;
+ if (XGCTYPE (frame) != Lisp_Frame)
+ continue;
+ f = XFRAME (frame);
+ if (f->display.nothing == 1)
+ return 0;
+ x = f->display.x;
+ /* This frame matches if the window is any of its widgets. */
+ if (wdesc == XtWindow (x->widget)
+ || wdesc == XtWindow (x->column_widget)
+ || wdesc == XtWindow (x->edit_widget))
+ return f;
+ /* Match if the window is this frame's menubar. */
+ if (x->menubar_widget
+ && wdesc == XtWindow (x->menubar_widget))
+ return f;
+ }
+ return 0;
+}
+
+/* Return the frame whose principal (outermost) window is WDESC.
+ If WDESC is some other (smaller) window, we return 0. */
+
+struct frame *
+x_top_window_to_frame (wdesc)
+ int wdesc;
+{
+ Lisp_Object tail, frame;
+ struct frame *f;
+ struct x_display *x;
+
+ for (tail = Vframe_list; XGCTYPE (tail) == Lisp_Cons;
+ tail = XCONS (tail)->cdr)
+ {
+ frame = XCONS (tail)->car;
+ if (XGCTYPE (frame) != Lisp_Frame)
+ continue;
+ f = XFRAME (frame);
+ if (f->display.nothing == 1)
+ return 0;
+ x = f->display.x;
+ /* This frame matches if the window is its topmost widget. */
+ if (wdesc == XtWindow (x->widget))
+ return f;
+ /* Match if the window is this frame's menubar. */
+ if (x->menubar_widget
+ && wdesc == XtWindow (x->menubar_widget))
+ return f;
}
return 0;
}
+#endif /* USE_X_TOOLKIT */
\f
/* Connect the frame-parameter names for X frames
/* 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, old_value;
+
+ 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
+ && 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 die if just one of these was set. */
+ if (EQ (left, Qunbound))
+ XSET (left, Lisp_Int, f->display.x->left_pos);
+ if (EQ (top, Qunbound))
+ XSET (top, Lisp_Int, f->display.x->top_pos);
+
+ /* Don't die if just one of these was set. */
+ if (EQ (width, Qunbound))
+ XSET (width, Lisp_Int, FRAME_WIDTH (f));
+ if (EQ (height, Qunbound))
+ XSET (height, Lisp_Int, FRAME_HEIGHT (f));
+
+ /* 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;
+ check_frame_size (f, &height, &width);
+
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);
}
}
sprintf (buf, "%d", FRAME_X_WINDOW (f));
store_in_alist (alistptr, Qwindow_id,
build_string (buf));
+ FRAME_SAMPLE_VISIBILITY (f);
store_in_alist (alistptr, Qvisibility,
(FRAME_VISIBLE_P (f) ? Qt
: FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
f->display.x->foreground_pixel);
UNBLOCK_INPUT;
#endif /* HAVE_X11 */
+ recompute_basic_faces (f);
if (FRAME_VISIBLE_P (f))
redraw_frame (f);
}
f->display.x->background_pixel);
XSetForeground (x_current_display, f->display.x->reverse_gc,
f->display.x->background_pixel);
+ XSetForeground (x_current_display, f->display.x->cursor_gc,
+ f->display.x->background_pixel);
XSetWindowBackground (x_current_display, FRAME_X_WINDOW (f),
f->display.x->background_pixel);
#endif /* not HAVE_X11 */
UNBLOCK_INPUT;
+ recompute_basic_faces (f);
+
if (FRAME_VISIBLE_P (f))
redraw_frame (f);
}
struct frame *f;
Lisp_Object arg, oldval;
{
- Cursor cursor, nontext_cursor, mode_cursor;
+ Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
int mask_color;
if (!EQ (Qnil, arg))
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))
}
else
mode_cursor = XCreateFontCursor (x_current_display, XC_xterm);
+ x_check_errors ("bad modeline pointer cursor: %s");
+
+ if (!EQ (Qnil, Vx_cross_pointer_shape))
+ {
+ CHECK_NUMBER (Vx_cross_pointer_shape, 0);
+ cross_cursor = XCreateFontCursor (x_current_display,
+ XINT (Vx_cross_pointer_shape));
+ }
+ else
+ cross_cursor = XCreateFontCursor (x_current_display, XC_crosshair);
/* Check and report errors with the above calls. */
x_check_errors ("can't set cursor shape: %s");
&fore_color, &back_color);
XRecolorCursor (x_current_display, mode_cursor,
&fore_color, &back_color);
+ XRecolorCursor (x_current_display, cross_cursor,
+ &fore_color, &back_color);
}
#else /* X10 */
cursor = XCreateCursor (16, 16, MouseCursor, MouseMask,
&& f->display.x->modeline_cursor != 0)
XFreeCursor (XDISPLAY f->display.x->modeline_cursor);
f->display.x->modeline_cursor = mode_cursor;
+ if (cross_cursor != f->display.x->cross_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 ();
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? */
/* If the window was unmapped (and its icon was mapped),
the new icon is not mapped, so map the window in its stead. */
if (FRAME_VISIBLE_P (f))
+#ifdef USE_X_TOOLKIT
+ XtPopup (f->display.x->widget, XtGrabNone);
+#endif
XMapWindow (XDISPLAY FRAME_X_WINDOW (f));
XFlushQueue ();
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
if (FRAME_X_WINDOW (f) != 0)
{
BLOCK_INPUT;
- x_set_window_size (f, f->width, f->height);
+ x_set_window_size (f, 0, f->width, f->height);
#if 0
x_set_resize_hint (f);
#endif
XSET (frame, Lisp_Frame, f);
if (NILP (value))
- Fmake_frame_invisible (frame);
- else if (EQ (value, Qt))
- Fmake_frame_visible (frame);
- else
+ Fmake_frame_invisible (frame, Qt);
+ else if (EQ (value, Qicon))
Ficonify_frame (frame);
+ else
+ Fmake_frame_visible (frame);
}
static 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
nlines = 0;
+#ifdef USE_X_TOOLKIT
+ FRAME_MENU_BAR_LINES (f) = 0;
+ if (nlines)
+ FRAME_EXTERNAL_MENU_BAR (f) = 1;
+ else
+ {
+ if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
+ free_frame_menubar (f);
+ FRAME_EXTERNAL_MENU_BAR (f) = 0;
+ f->display.x->menubar_widget = 0;
+ }
+#else /* not USE_X_TOOLKIT */
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);
+#endif /* not USE_X_TOOLKIT */
}
-/* Change the name of frame F to ARG. If ARG is nil, set F's name to
+/* Change the name of frame F to NAME. If NAME is nil, set F's name to
x_id_name.
If EXPLICIT is non-zero, that indicates that lisp code is setting the
- name; if ARG is a string, set F's name to ARG and set
- F->explicit_name; if ARG is Qnil, then clear F->explicit_name.
+ name; if NAME is a string, set F's name to NAME and set
+ F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
If EXPLICIT is zero, that indicates that Emacs redisplay code is
suggesting a new name, which lisp code should override; if
if (FRAME_X_WINDOW (f))
{
BLOCK_INPUT;
-
#ifdef HAVE_X11R4
{
XTextProperty text;
text.encoding = XA_STRING;
text.format = 8;
text.nitems = XSTRING (name)->size;
+#ifdef USE_X_TOOLKIT
+ XSetWMName (x_current_display, XtWindow (f->display.x->widget), &text);
+ XSetWMIconName (x_current_display, XtWindow (f->display.x->widget),
+ &text);
+#else /* not USE_X_TOOLKIT */
XSetWMName (x_current_display, FRAME_X_WINDOW (f), &text);
XSetWMIconName (x_current_display, FRAME_X_WINDOW (f), &text);
+#endif /* not USE_X_TOOLKIT */
}
-#else
+#else /* not HAVE_X11R4 */
XSetIconName (XDISPLAY FRAME_X_WINDOW (f),
XSTRING (name)->data);
XStoreName (XDISPLAY FRAME_X_WINDOW (f),
XSTRING (name)->data);
-#endif
-
+#endif /* not HAVE_X11R4 */
UNBLOCK_INPUT;
}
However, if the window hasn't been created yet, we shouldn't
call x_set_window_size. */
if (FRAME_X_WINDOW (f))
- x_set_window_size (f, FRAME_WIDTH (f), FRAME_HEIGHT (f));
+ x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
}
}
\f
-#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;
-{
- 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;
+/* Subroutines of creating an X frame. */
- x_face_table[++n_faces] = new_face;
- return 1;
-}
-#endif
+#ifdef HAVE_X11
-x_set_glyph (scr, glyph)
+/* Make sure that Vx_resource_name is set to a reasonable value. */
+static void
+validate_x_resource_name ()
{
+ if (! STRINGP (Vx_resource_name))
+ Vx_resource_name = make_string ("emacs", 5);
}
-#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;
register char *value;
char *name_key;
char *class_key;
+ Lisp_Object resname;
+
+ 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 ();
+ resname = Vx_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 (resname)->size
+ XSTRING (attribute)->size
+ 2);
class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
+ 2);
sprintf (name_key, "%s.%s",
- XSTRING (Vinvocation_name)->data,
+ XSTRING (resname)->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 (resname)->size
+ XSTRING (component)->size
+ XSTRING (attribute)->size
+ 3);
+ 3);
sprintf (name_key, "%s.%s.%s",
- XSTRING (Vinvocation_name)->data,
+ XSTRING (resname)->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,
}
#define Fx_get_resource(attribute, class, component, subclass) \
- Fx_get_default(attribute)
+ Fx_get_default (attribute)
#endif /* X10 */
/* Types we might convert a resource string into. */
enum resource_types
{
- number, boolean, string, symbol,
+ number, boolean, string, symbol
};
/* Return the value of parameter PARAM.
return tem;
case symbol:
- return intern (tem);
+ /* As a special case, we map the values `true' and `on'
+ to Qt, and `false' and `off' to Qnil. */
+ {
+ Lisp_Object lower;
+ lower = Fdowncase (tem);
+ if (!strcmp (XSTRING (lower)->data, "on")
+ || !strcmp (XSTRING (lower)->data, "true"))
+ return Qt;
+ else if (!strcmp (XSTRING (lower)->data, "off")
+ || !strcmp (XSTRING (lower)->data, "false"))
+ return Qnil;
+ else
+ return Fintern (tem, Qnil);
+ }
default:
abort ();
return tem;
}
\f
-DEFUN ("x-geometry", Fx_geometry, Sx_geometry, 1, 1, 0,
+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) ... ).")
(string)
#ifdef HAVE_X11
/* Calculate the desired size and position of this window,
- or set rubber-band prompting if none. */
+ and return the attributes saying which aspects were specified.
+
+ This function does not make the coordinates positive. */
#define DEFAULT_ROWS 40
#define DEFAULT_COLS 80
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);
CHECK_NUMBER (tem1, 0);
f->display.x->top_pos = XINT (tem0);
f->display.x->left_pos = XINT (tem1);
- x_calc_absolute_position (f);
+ if (f->display.x->top_pos < 0)
+ window_prompting |= YNegative;
+ if (f->display.x->left_pos < 0)
+ window_prompting |= YNegative;
window_prompting |= USPosition;
}
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;
+}
+
+#if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
+
+Status
+XSetWMProtocols (dpy, w, protocols, count)
+ Display *dpy;
+ Window w;
+ Atom *protocols;
+ int count;
+{
+ Atom prop;
+ prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
+ if (prop == None) return False;
+ XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
+ (unsigned char *) protocols, count);
+ return True;
+}
+#endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
+\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). */
+
+static void
+hack_wm_protocols (widget)
+ Widget widget;
+{
+ Display *dpy = XtDisplay (widget);
+ Window w = XtWindow (widget);
+ int need_delete = 1;
+ int need_focus = 1;
+
+ BLOCK_INPUT;
+ {
+ Atom type, *atoms = 0;
+ int format = 0;
+ unsigned long nitems = 0;
+ unsigned long bytes_after;
+
+ if (Success == XGetWindowProperty (dpy, w, Xatom_wm_protocols,
+ 0, 100, False, XA_ATOM,
+ &type, &format, &nitems, &bytes_after,
+ (unsigned char **) &atoms)
+ && format == 32 && type == XA_ATOM)
+ 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) 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 (count)
+ XChangeProperty (dpy, w, Xatom_wm_protocols, XA_ATOM, 32, PropModeAppend,
+ (unsigned char *) props, count);
+ }
+ UNBLOCK_INPUT;
+}
+#endif
+\f
+#ifdef USE_X_TOOLKIT
+
+/* Create and set up the X widget for frame F. */
+
+static void
+x_window (f, window_prompting, minibuffer_only)
+ struct frame *f;
+ long window_prompting;
+ int minibuffer_only;
+{
+ XClassHint class_hints;
+ XSetWindowAttributes attributes;
+ unsigned long attribute_mask;
+
+ Widget shell_widget;
+ Widget pane_widget;
+ Widget screen_widget;
+ char* name;
+ Arg al [25];
+ int ac;
+
+ BLOCK_INPUT;
+
+ if (STRINGP (f->name))
+ name = (char*) XSTRING (f->name)->data;
+ else
+ name = "emacs";
+
+ ac = 0;
+ XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
+ XtSetArg (al[ac], XtNinput, 1); ac++;
+ shell_widget = XtCreatePopupShell ("shell",
+ topLevelShellWidgetClass,
+ Xt_app_shell, al, ac);
+
+ f->display.x->widget = shell_widget;
+ /* maybe_set_screen_title_format (shell_widget); */
+
+
+ ac = 0;
+ XtSetArg (al[ac], XtNborderWidth, 0); ac++;
+ pane_widget = XtCreateWidget ("pane",
+ panedWidgetClass,
+ shell_widget, al, ac);
+
+ f->display.x->column_widget = pane_widget;
+
+ if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
+ initialize_frame_menubar (f);
+
+ /* mappedWhenManaged to false tells to the paned window to not map/unmap
+ the emacs screen when changing menubar. This reduces flickering. */
+
+ ac = 0;
+ XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
+ XtSetArg (al[ac], XtNshowGrip, 0); ac++;
+ XtSetArg (al[ac], XtNallowResize, 1); ac++;
+ XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
+ XtSetArg (al[ac], XtNemacsFrame, f); ac++;
+ screen_widget = XtCreateWidget (name,
+ emacsFrameClass,
+ pane_widget, al, ac);
+
+ f->display.x->edit_widget = screen_widget;
+
+ if (f->display.x->menubar_widget)
+ XtManageChild (f->display.x->menubar_widget);
+ XtManageChild (screen_widget);
+
+ /* Do some needed geometry management. */
+ {
+ int len;
+ char *tem, shell_position[32];
+ Arg al[2];
+ int ac = 0;
+ int menubar_size
+ = (f->display.x->menubar_widget
+ ? (f->display.x->menubar_widget->core.height
+ + f->display.x->menubar_widget->core.border_width)
+ : 0);
+
+ if (window_prompting & USPosition)
+ {
+ int left = f->display.x->left_pos;
+ int xneg = left < 0;
+ int top = f->display.x->top_pos;
+ int yneg = top < 0;
+ if (left < 0)
+ left = -left;
+ if (top < 0)
+ top = -top;
+ sprintf (shell_position, "=%dx%d%c%d%c%d", PIXEL_WIDTH (f),
+ PIXEL_HEIGHT (f) + menubar_size,
+ (xneg ? '-' : '+'), left,
+ (yneg ? '-' : '+'), top);
+ }
+ else
+ sprintf (shell_position, "=%dx%d", PIXEL_WIDTH (f),
+ PIXEL_HEIGHT (f) + menubar_size);
+ len = strlen (shell_position) + 1;
+ tem = (char *) xmalloc (len);
+ strncpy (tem, shell_position, len);
+ XtSetArg (al[ac], XtNgeometry, tem); ac++;
+ XtSetValues (shell_widget, al, ac);
+ }
+
+ x_calc_absolute_position (f);
+
+ XtManageChild (pane_widget);
+ XtRealizeWidget (shell_widget);
+
+ FRAME_X_WINDOW (f) = XtWindow (screen_widget);
+
+ validate_x_resource_name ();
+ class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
+ class_hints.res_class = EMACS_CLASS;
+ XSetClassHint (x_current_display, XtWindow (shell_widget), &class_hints);
+
+ 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);
+
+ hack_wm_protocols (shell_widget);
+
+ /* Do a stupid property change to force the server to generate a
+ propertyNotify event so that the event_stream server timestamp will
+ be initialized to something relevant to the time we created the window.
+ */
+ XChangeProperty (XtDisplay (screen_widget), XtWindow (screen_widget),
+ Xatom_wm_protocols, XA_ATOM, 32, PropModeAppend,
+ (unsigned char*) NULL, 0);
+
+ /* Make all the standard events reach the Emacs frame. */
+ attributes.event_mask = STANDARD_EVENT_SET;
+ attribute_mask = CWEventMask;
+ XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
+ attribute_mask, &attributes);
+
+ XtMapWidget (screen_widget);
+
+ /* 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
+ place where that assumption isn't correct; f->name is set, but
+ the X server hasn't been told. */
+ {
+ Lisp_Object name;
+ int explicit = f->explicit_name;
+
+ f->explicit_name = 0;
+ name = f->name;
+ f->name = Qnil;
+ x_set_name (f, name, explicit);
+ }
+
+ XDefineCursor (XDISPLAY FRAME_X_WINDOW (f),
+ f->display.x->text_cursor);
+
+ UNBLOCK_INPUT;
+
+ if (FRAME_X_WINDOW (f) == 0)
+ error ("Unable to create window");
}
-static void
+#else /* not USE_X_TOOLKIT */
+
+/* Create and set up the X window for frame F. */
+
x_window (f)
struct frame *f;
+
{
+ XClassHint class_hints;
XSetWindowAttributes attributes;
unsigned long attribute_mask;
- XClassHint class_hints;
attributes.background_pixel = f->display.x->background_pixel;
attributes.border_pixel = f->display.x->border_pixel;
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->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);
+
/* 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
place where that assumption isn't correct; f->name is set, but
the X server hasn't been told. */
{
- Lisp_Object name = f->name;
+ Lisp_Object name;
int explicit = f->explicit_name;
- f->name = Qnil;
f->explicit_name = 0;
+ name = f->name;
+ f->name = Qnil;
x_set_name (f, name, explicit);
}
XDefineCursor (XDISPLAY FRAME_X_WINDOW (f),
f->display.x->text_cursor);
+
UNBLOCK_INPUT;
if (FRAME_X_WINDOW (f) == 0)
- error ("Unable to create window.");
+ error ("Unable to create window");
}
+#endif /* not USE_X_TOOLKIT */
+
/* Handle the icon stuff for this window. Perhaps later we might
want an x_set_icon_position which can be called interactively as
well. */
x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
/* Start up iconic or window? */
- x_wm_set_window_state (f,
- (EQ (x_get_arg (parms, Qiconic_startup,
- 0, 0, boolean),
- Qt)
- ? IconicState
- : NormalState));
+ x_wm_set_window_state
+ (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
+ ? IconicState
+ : NormalState));
UNBLOCK_INPUT;
}
GC temp_gc;
XImage tileimage;
+ BLOCK_INPUT;
+
/* Create the GC's of this frame.
- Note that many default values are used. */
+ Note that many default values are used. */
/* Normal video */
gc_values.font = f->display.x->font->fid;
gc_values.foreground = f->display.x->foreground_pixel;
gc_values.background = f->display.x->background_pixel;
- gc_values.line_width = 0; /* Means 1 using fast algorithm. */
+ gc_values.line_width = 0; /* Means 1 using fast algorithm. */
f->display.x->normal_gc = XCreateGC (x_current_display,
FRAME_X_WINDOW (f),
GCLineWidth | GCFont
| GCLineWidth,
&gc_values);
- /* Cursor has cursor-color background, background-color foreground. */
+ /* Cursor has cursor-color background, background-color foreground. */
gc_values.foreground = f->display.x->background_pixel;
gc_values.background = f->display.x->cursor_pixel;
gc_values.fill_style = FillOpaqueStippled;
/* Create the gray border tile used when the pointer is not in
the frame. Since this depends on the frame's pixel values,
- this must be done on a per-frame basis. */
+ this must be done on a per-frame basis. */
f->display.x->border_tile
= (XCreatePixmapFromBitmapData
(x_current_display, ROOT_WINDOW,
f->display.x->foreground_pixel,
f->display.x->background_pixel,
DefaultDepth (x_current_display, XDefaultScreen (x_current_display))));
+
+ UNBLOCK_INPUT;
}
#endif /* HAVE_X11 */
int minibuffer_only = 0;
long window_prompting = 0;
int width, height;
+ int count = specpdl_ptr - specpdl;
- 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
{
f->name = name;
f->explicit_name = 1;
+ /* use the frame's title when getting resources for this frame. */
+ specbind (Qx_resource_name, name);
}
XSET (frame, Lisp_Frame, f);
/* 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_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);
+
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))
+ {
+ 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;
+ }
+
+#ifdef USE_X_TOOLKIT
+ x_window (f, window_prompting, minibuffer_only);
+#else
x_window (f);
+#endif
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->height = f->width = 0;
change_frame_size (f, height, width, 1, 0);
- x_default_parameter (f, parms, Qmenu_bar_lines, make_number (0),
- "menuBarLines", "MenuBarLines", number);
-
+/* With the toolkit, the geometry management is done in x_window. */
+#ifndef USE_X_TOOLKIT
BLOCK_INPUT;
- x_wm_set_size_hint (f, window_prompting);
+ x_wm_set_size_hint (f, window_prompting, 1);
UNBLOCK_INPUT;
+#endif /* USE_X_TOOLKIT */
tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
f->no_split = minibuffer_only || EQ (tem, Qt);
+ /* 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
+ or making it visible won't work. */
+ Vframe_list = Fcons (frame, Vframe_list);
+
/* Make the window appear on the frame and enable display,
unless the caller says not to. */
- if (!EQ (x_get_arg (parms, Qsuppress_initial_map, 0, 0, boolean), Qt))
- {
- tem = x_get_arg (parms, Qvisibility, 0, 0, boolean);
- if (EQ (tem, Qicon))
- x_iconify_frame (f);
- /* Note that the default is Qunbound,
- so by default we do make visible. */
- else if (!EQ (tem, Qnil))
- x_make_frame_visible (f);
- }
+ {
+ Lisp_Object visibility;
+
+ visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
+ if (EQ (visibility, Qunbound))
+ visibility = Qt;
+
+ if (EQ (visibility, Qicon))
+ x_iconify_frame (f);
+ else if (! NILP (visibility))
+ x_make_frame_visible (f);
+ else
+ /* Must have been Qnil. */
+ ;
+ }
- return frame;
+ return unbind_to (count, frame);
#else /* X10 */
struct frame *f;
Lisp_Object frame, tem;
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;
BLOCK_INPUT;
XGetWindowInfo (FRAME_X_WINDOW (f), &wininfo);
XQueryTree (FRAME_X_WINDOW (f), &parent, &nchildren, &children);
- free (children);
+ xfree (children);
UNBLOCK_INPUT;
height = PIXEL_TO_CHAR_HEIGHT (f, wininfo.height);
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);
+ }
- if (!EQ (x_get_arg (parms, Qsuppress_initial_map, 0, 0, boolean), Qt))
- x_make_window_visible (f);
SET_FRAME_GARBAGED (f);
+ Vframe_list = Fcons (frame, Vframe_list);
return frame;
#endif /* X10 */
}
+Lisp_Object
+x_get_focus_frame ()
+{
+ Lisp_Object xfocus;
+ if (! x_focus_frame)
+ return Qnil;
+
+ XSET (xfocus, Lisp_Frame, x_focus_frame);
+ return xfocus;
+}
+
DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
"Set the focus on FRAME.")
(frame)
+ (hscroll ? HSCROLL_HEIGHT : 0)),
width, height, f->display.x->font,
FONT_WIDTH (f->display.x->font),
- FONT_HEIGHT (f->display.x->font));
+ f->display.x->line_height);
XFreePixmap (frame.border);
XFreePixmap (frame.background);
*x -= wininfo.x;
*y -= wininfo.y;
XQueryTree (tempwindow, &tempwindow, &nchildren, &children);
- free (children);
+ xfree (children);
}
UNBLOCK_INPUT;
}
#endif /* not HAVE_X11 */
\f
-DEFUN ("x-defined-color", Fx_defined_color, Sx_defined_color, 1, 1, 0,
+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\
+Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
+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_x ();
+ 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;
+
+ /* Don't die if we get called with a terminal frame. */
+ if (! FRAME_X_P (f))
+ error ("non-X frame used in `x-list-fonts'");
+
+ 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;
+
+ /* Solaris 2.3 has a bug in XListFontsWithInfo. */
+#ifdef BROKEN_XLISTFONTSWITHINFO
+ names = XListFonts (x_current_display,
+ XSTRING (pattern)->data,
+ 2000, /* maxnames */
+ &num_fonts); /* count_return */
+#else
+ names = XListFontsWithInfo (x_current_display,
+ XSTRING (pattern)->data,
+ 2000, /* maxnames */
+ &num_fonts, /* count_return */
+ &info); /* info_return */
+#endif
+ UNBLOCK_INPUT;
+
+ list = Qnil;
+
+ if (names)
+ {
+ Lisp_Object *tail;
+ int i;
+
+ tail = &list;
+ for (i = 0; i < num_fonts; i++)
+ {
+ XFontStruct *thisinfo;
+
+#ifdef BROKEN_XLISTFONTSWITHINFO
+ BLOCK_INPUT;
+ thisinfo = XLoadQueryFont (x_current_display, names[i]);
+ UNBLOCK_INPUT;
+#else
+ thisinfo = &info[i];
+#endif
+ if (thisinfo && (! size_ref
+ || same_size_fonts (thisinfo, size_ref)))
+ {
+ *tail = Fcons (build_string (names[i]), Qnil);
+ tail = &XCONS (*tail)->cdr;
+ }
+ }
+
+ BLOCK_INPUT;
+#ifdef BROKEN_XLISTFONTSWITHINFO
+ XFreeFontNames (names);
+#else
+ XFreeFontInfo (names, info, num_fonts);
+#endif
+ UNBLOCK_INPUT;
+ }
+
+ 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)
Lisp_Object 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
x_char_height (f)
register struct frame *f;
{
- return FONT_HEIGHT (f->display.x->font);
+ return f->display.x->line_height;
}
\f
#if 0 /* These no longer seem like the right way to do things. */
int height;
int left = (left_char * FONT_WIDTH (f->display.x->font)
+ f->display.x->internal_border_width);
- int top = (top_char * FONT_HEIGHT (f->display.x->font)
+ int top = (top_char * f->display.x->line_height
+ f->display.x->internal_border_width);
if (chars < 0)
else
width = FONT_WIDTH (f->display.x->font) * chars;
if (lines < 0)
- height = FONT_HEIGHT (f->display.x->font) / 2;
+ height = f->display.x->line_height / 2;
else
- height = FONT_HEIGHT (f->display.x->font) * lines;
+ height = f->display.x->line_height * lines;
XDrawRectangle (x_current_display, FRAME_X_WINDOW (f),
gc, left, top, width, height);
{
register int ibw = f->display.x->internal_border_width;
register int font_w = FONT_WIDTH (f->display.x->font);
- register int font_h = FONT_HEIGHT (f->display.x->font);
+ register int font_h = f->display.x->line_height;
int y = top_y;
int x = line_len (y);
- XPoint *pixel_points = (XPoint *)
- alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
+ XPoint *pixel_points
+ = (XPoint *) alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
register XPoint *this_point = pixel_points;
/* Do the horizontal top line/lines */
}
}
-/* 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
XGCValues gc_values;
#endif
register int previous_y;
- register int line = (x_mouse_y + 1) * FONT_HEIGHT (f->display.x->font)
+ register int line = (x_mouse_y + 1) * f->display.x->line_height
+ f->display.x->internal_border_width;
register int left = f->display.x->internal_border_width
+ (w->left
&& x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
{
previous_y = x_mouse_y;
- line = (x_mouse_y + 1) * FONT_HEIGHT (f->display.x->font)
+ line = (x_mouse_y + 1) * f->display.x->line_height
+ f->display.x->internal_border_width;
XDrawLine (x_current_display, FRAME_X_WINDOW (f),
line_gc, left, line, right, line);
}
#endif
\f
-#if 0
-
-#ifdef HAVE_X11
-#define XMouseEvent XEvent
-#define WhichMouseButton xbutton.button
-#define MouseWindow xbutton.window
-#define MouseX xbutton.x
-#define MouseY xbutton.y
-#define MouseTime xbutton.time
-#define ButtonReleased ButtonRelease
-#define ButtonPressed ButtonPress
-#else
-#define XMouseEvent XButtonEvent
-#define WhichMouseButton detail
-#define MouseWindow window
-#define MouseX x
-#define MouseY y
-#define MouseTime time
-#endif /* X11 */
-
-DEFUN ("x-mouse-events", Fx_mouse_events, Sx_mouse_events, 0, 0, 0,
- "Return number of pending mouse events from X window system.")
- ()
-{
- return make_number (queue_event_count (&x_mouse_queue));
-}
-
-/* Encode the mouse button events in the form expected by the
- mouse code in Lisp. For X11, this means moving the masks around. */
-
-static int
-encode_mouse_button (mouse_event)
- XMouseEvent mouse_event;
-{
- register int event_code;
- register char key_mask;
-
- event_code = mouse_event.detail & 3;
- key_mask = (mouse_event.detail >> 8) & 0xf0;
- event_code |= key_mask >> 1;
- if (mouse_event.type == ButtonReleased) event_code |= 0x04;
- return event_code;
-}
-
-DEFUN ("x-get-mouse-event", Fx_get_mouse_event, Sx_get_mouse_event,
- 0, 1, 0,
- "Get next mouse event out of mouse event buffer.\n\
-Optional ARG non-nil means return nil immediately if no pending event;\n\
-otherwise, wait for an event. Returns a four-part list:\n\
- ((X-POS Y-POS) WINDOW FRAME-PART KEYSEQ TIMESTAMP).\n\
-Normally X-POS and Y-POS are the position of the click on the frame\n\
- (measured in characters and lines), and WINDOW is the window clicked in.\n\
-KEYSEQ is a string, the key sequence to be looked up in the mouse maps.\n\
-If FRAME-PART is non-nil, the event was on a scroll bar;\n\
-then Y-POS is really the total length of the scroll bar, while X-POS is\n\
-the relative position of the scroll bar's value within that total length,\n\
-and a third element OFFSET appears in that list: the height of the thumb-up\n\
-area at the top of the scroll bar.\n\
-FRAME-PART is one of the following symbols:\n\
- `vertical-scroll-bar', `vertical-thumbup', `vertical-thumbdown',\n\
- `horizontal-scroll-bar', `horizontal-thumbleft', `horizontal-thumbright'.\n\
-TIMESTAMP is the lower 23 bits of the X-server's timestamp for\n\
-the mouse event.")
- (arg)
- Lisp_Object arg;
-{
- XMouseEvent xrep;
- register int com_letter;
- register Lisp_Object tempx;
- register Lisp_Object tempy;
- Lisp_Object part, pos, timestamp;
- int prefix;
- struct frame *f;
-
- int tem;
-
- while (1)
- {
- BLOCK_INPUT;
- tem = dequeue_event (&xrep, &x_mouse_queue);
- UNBLOCK_INPUT;
-
- if (tem)
- {
- switch (xrep.type)
- {
- case ButtonPressed:
- case ButtonReleased:
-
- com_letter = encode_mouse_button (xrep);
- mouse_timestamp = xrep.MouseTime;
-
- if ((f = x_window_to_frame (xrep.MouseWindow)) != 0)
- {
- Lisp_Object frame;
-
- if (f->display.x->icon_desc == xrep.MouseWindow)
- {
- x_make_frame_visible (f);
- continue;
- }
-
- XSET (tempx, Lisp_Int,
- min (f->width-1, max (0, (xrep.MouseX - f->display.x->internal_border_width)/FONT_WIDTH (f->display.x->font))));
- XSET (tempy, Lisp_Int,
- min (f->height-1, max (0, (xrep.MouseY - f->display.x->internal_border_width)/FONT_HEIGHT (f->display.x->font))));
- XSET (timestamp, Lisp_Int, (xrep.MouseTime & 0x7fffff));
- XSET (frame, Lisp_Frame, f);
-
- pos = Fcons (tempx, Fcons (tempy, Qnil));
- Vmouse_window
- = Flocate_window_from_coordinates (frame, pos);
-
- Vmouse_event
- = Fcons (pos,
- Fcons (Vmouse_window,
- Fcons (Qnil,
- Fcons (Fchar_to_string (make_number (com_letter)),
- Fcons (timestamp, Qnil)))));
- return Vmouse_event;
- }
- else if ((f = x_window_to_scroll_bar (xrep.MouseWindow, &part, &prefix)) != 0)
- {
- int pos, len;
- Lisp_Object keyseq;
- char *partname;
-
- keyseq = concat2 (Fchar_to_string (make_number (prefix)),
- Fchar_to_string (make_number (com_letter)));
-
- pos = xrep.MouseY - (f->display.x->v_scroll_bar_width - 2);
- XSET (tempx, Lisp_Int, pos);
- len = ((FONT_HEIGHT (f->display.x->font) * f->height)
- + f->display.x->internal_border_width
- - (2 * (f->display.x->v_scroll_bar_width - 2)));
- XSET (tempy, Lisp_Int, len);
- XSET (timestamp, Lisp_Int, (xrep.MouseTime & 0x7fffff));
- Vmouse_window = f->selected_window;
- Vmouse_event
- = Fcons (Fcons (tempx, Fcons (tempy,
- Fcons (make_number (f->display.x->v_scroll_bar_width - 2),
- Qnil))),
- Fcons (Vmouse_window,
- Fcons (intern (part),
- Fcons (keyseq, Fcons (timestamp,
- Qnil)))));
- return Vmouse_event;
- }
- else
- continue;
-
-#ifdef HAVE_X11
- case MotionNotify:
-
- com_letter = x11_encode_mouse_button (xrep);
- if ((f = x_window_to_frame (xrep.MouseWindow)) != 0)
- {
- Lisp_Object frame;
-
- XSET (tempx, Lisp_Int,
- min (f->width-1,
- max (0, (xrep.MouseX - f->display.x->internal_border_width)
- / FONT_WIDTH (f->display.x->font))));
- XSET (tempy, Lisp_Int,
- min (f->height-1,
- max (0, (xrep.MouseY - f->display.x->internal_border_width)
- / FONT_HEIGHT (f->display.x->font))));
-
- XSET (frame, Lisp_Frame, f);
- XSET (timestamp, Lisp_Int, (xrep.MouseTime & 0x7fffff));
-
- pos = Fcons (tempx, Fcons (tempy, Qnil));
- Vmouse_window
- = Flocate_window_from_coordinates (frame, pos);
-
- Vmouse_event
- = Fcons (pos,
- Fcons (Vmouse_window,
- Fcons (Qnil,
- Fcons (Fchar_to_string (make_number (com_letter)),
- Fcons (timestamp, Qnil)))));
- return Vmouse_event;
- }
-
- break;
-#endif /* HAVE_X11 */
-
- default:
- if (f = x_window_to_frame (xrep.MouseWindow))
- Vmouse_window = f->selected_window;
- else if (f = x_window_to_scroll_bar (xrep.MouseWindow, &part, &prefix))
- Vmouse_window = f->selected_window;
- return Vmouse_event = Qnil;
- }
- }
-
- if (!NILP (arg))
- return Qnil;
-
- /* Wait till we get another mouse event. */
- wait_reading_process_input (0, 0, 2, 0);
- }
-}
-#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: ",
}
#endif /* X10 */
\f
+#if 0 /* I'm told these functions are superfluous
+ given the ability to bind function keys. */
+
#ifdef HAVE_X11
DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
"Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
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.")
+#endif /* HAVE_X11 */
+#endif /* 0 */
+\f
+#ifdef HAVE_X11
- (keycode, shift_mask, newstring)
- register Lisp_Object keycode;
- register Lisp_Object shift_mask;
- register Lisp_Object newstring;
+#ifndef HAVE_XSCREENNUMBEROFSCREEN
+int
+XScreenNumberOfScreen (scr)
+ register Screen *scr;
{
- 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);
+ register Display *dpy;
+ register Screen *dpyscr;
+ register int i;
- keysym = ((unsigned) (XINT (keycode))) & 255;
+ dpy = scr->display;
+ dpyscr = dpy->screens;
- 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;
+ for (i = 0; i < dpy->nscreens; i++, dpyscr++)
+ if (scr == dpyscr)
+ return 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;
+ return -1;
}
-#endif /* not HAVE_X11 */
-\f
-#ifdef HAVE_X11
+#endif /* not HAVE_XSCREENNUMBEROFSCREEN */
+
Visual *
select_visual (screen, depth)
Screen *screen;
#ifdef HAVE_X11R4
vinfo_template.visualid = XVisualIDFromVisual (v);
#else
- vinfo_template.visualid = x->visualid;
+ 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;
+#ifdef HAVE_XRMSETDATABASE
XrmSetDatabase (x_current_display, xrdb);
#else
x_current_display->db = xrdb;
"WM_CONFIGURE_DENIED", False);
Xatom_wm_window_moved = XInternAtom (x_current_display, "WM_MOVED",
False);
+ Xatom_editres_name = XInternAtom (x_current_display, "Editres", False);
UNBLOCK_INPUT;
#else /* not HAVE_X11 */
XFASTINT (Vwindow_system_version) = 10;
0, 0, 0, "Close the connection to the current X server.")
()
{
+ /* Note: If we're going to call check_x here, then the fatal error
+ can't happen. For the moment, this check is just for safety,
+ so a user won't try out the function and get a crash. If it's
+ 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. */
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;
}
+/* Wait for responses to all X commands issued so far for FRAME. */
+
+void
+x_sync (frame)
+ Lisp_Object frame;
+{
+ BLOCK_INPUT;
+ XSync (x_current_display, False);
+ UNBLOCK_INPUT;
+}
\f
syms_of_xfns ()
{
staticpro (&Qicon_top);
Qicon_type = intern ("icon-type");
staticpro (&Qicon_type);
- Qiconic_startup = intern ("iconic-startup");
- staticpro (&Qiconic_startup);
Qinternal_border_width = intern ("internal-border-width");
staticpro (&Qinternal_border_width);
Qleft = intern ("left");
staticpro (&Qparent_id);
Qsuppress_icon = intern ("suppress-icon");
staticpro (&Qsuppress_icon);
- Qsuppress_initial_map = intern ("suppress-initial-map");
- staticpro (&Qsuppress_initial_map);
Qtop = intern ("top");
staticpro (&Qtop);
Qundefined_color = intern ("undefined-color");
staticpro (&Qundefined_color);
Qvertical_scroll_bars = intern ("vertical-scroll-bars");
staticpro (&Qvertical_scroll_bars);
+ Qvisibility = intern ("visibility");
+ staticpro (&Qvisibility);
Qwindow_id = intern ("window-id");
staticpro (&Qwindow_id);
Qx_frame_parameter = intern ("x-frame-parameter");
staticpro (&Qx_frame_parameter);
+ Qx_resource_name = intern ("x-resource-name");
+ staticpro (&Qx_resource_name);
/* This is the end of symbol initialization. */
- Qvisibility = intern ("visibility");
- staticpro (&Qvisibility);
Fput (Qundefined_color, Qerror_conditions,
Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
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.");
+ DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
+ "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;
+
+#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;
+ Vx_cross_pointer_shape = Qnil;
+
DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
"A string indicating the foreground color of the cursor box.");
Vx_cursor_fore_pixel = Qnil;
defsubr (&Sx_uncontour_region);
#endif
defsubr (&Sx_display_color_p);
- defsubr (&Sx_defined_color);
+ 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_backing_store);
defsubr (&Sx_display_save_under);
#if 0
+ defsubr (&Sx_rebind_key);
+ defsubr (&Sx_rebind_keys);
defsubr (&Sx_track_pointer);
defsubr (&Sx_grab_pointer);
defsubr (&Sx_ungrab_pointer);
defsubr (&Sx_get_default);
defsubr (&Sx_store_cut_buffer);
defsubr (&Sx_get_cut_buffer);
- defsubr (&Sx_set_face);
#endif
- defsubr (&Sx_geometry);
+ defsubr (&Sx_parse_geometry);
defsubr (&Sx_create_frame);
defsubr (&Sfocus_frame);
defsubr (&Sunfocus_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);
-
- /* This was used in the old event interface which used a separate
- event queue.*/
-#if 0
- defsubr (&Sx_mouse_events);
- defsubr (&Sx_get_mouse_event);
-#endif
}
#endif /* HAVE_X_WINDOWS */
HCoop / bpt / emacs.git / blobdiff