#include <config.h>
#include <signal.h>
#include <stdio.h>
#include <math.h>
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#define XLIB_ILLEGAL_ACCESS
#include "lisp.h"
#include "xterm.h"
#include "frame.h"
#include "window.h"
#include "buffer.h"
#include "intervals.h"
#include "dispextern.h"
#include "keyboard.h"
#include "blockinput.h"
#include <epaths.h>
#include "charset.h"
#include "coding.h"
#include "fontset.h"
#include "systime.h"
#include "termhooks.h"
#include "atimer.h"
#ifdef HAVE_X_WINDOWS
#include <ctype.h>
#include <sys/types.h>
#include <sys/stat.h>
#ifndef VMS
#if 1
#include "bitmaps/gray.xbm"
#else
#include <X11/bitmaps/gray>
#endif
#else
#include "[.bitmaps]gray.xbm"
#endif
#ifdef USE_X_TOOLKIT
#include <X11/Shell.h>
#ifndef USE_MOTIF
#include <X11/Xaw/Paned.h>
#include <X11/Xaw/Label.h>
#endif
#ifdef USG
#undef USG
#include <X11/Xos.h>
#define USG
#else
#include <X11/Xos.h>
#endif
#include "widget.h"
#include "../lwlib/lwlib.h"
#ifdef USE_MOTIF
#include <Xm/Xm.h>
#include <Xm/DialogS.h>
#include <Xm/FileSB.h>
#endif
#if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
#define HACK_EDITRES
extern void _XEditResCheckMessages ();
#endif
extern LWLIB_ID widget_id_tick;
#ifdef USE_LUCID
extern XFontStruct *xlwmenu_default_font;
#endif
extern void free_frame_menubar ();
extern double atof ();
#ifdef USE_MOTIF
static Lisp_Object Vmotif_version_string;
#endif
#endif
#define min(a,b) ((a) < (b) ? (a) : (b))
#define max(a,b) ((a) > (b) ? (a) : (b))
#ifdef HAVE_X11R4
#define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
#else
#define MAXREQUEST(dpy) ((dpy)->max_request_size)
#endif
int gray_bitmap_width = gray_width;
int gray_bitmap_height = gray_height;
char *gray_bitmap_bits = gray_bits;
Lisp_Object Vx_resource_name;
Lisp_Object Vx_resource_class;
int display_hourglass_p;
Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
Lisp_Object Vx_hourglass_pointer_shape;
Lisp_Object Vx_sensitive_text_pointer_shape;
Lisp_Object Vx_window_horizontal_drag_shape;
Lisp_Object Vx_cursor_fore_pixel;
static int x_in_use;
Lisp_Object Vx_no_window_manager;
Lisp_Object Vx_bitmap_file_path;
Lisp_Object Vx_pixel_size_width_font_regexp;
Lisp_Object Qauto_raise;
Lisp_Object Qauto_lower;
Lisp_Object Qbar;
Lisp_Object Qborder_color;
Lisp_Object Qborder_width;
Lisp_Object Qbox;
Lisp_Object Qcursor_color;
Lisp_Object Qcursor_type;
Lisp_Object Qgeometry;
Lisp_Object Qicon_left;
Lisp_Object Qicon_top;
Lisp_Object Qicon_type;
Lisp_Object Qicon_name;
Lisp_Object Qinternal_border_width;
Lisp_Object Qleft;
Lisp_Object Qright;
Lisp_Object Qmouse_color;
Lisp_Object Qnone;
Lisp_Object Qouter_window_id;
Lisp_Object Qparent_id;
Lisp_Object Qscroll_bar_width;
Lisp_Object Qsuppress_icon;
extern 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 Qx_resource_name;
Lisp_Object Quser_position;
Lisp_Object Quser_size;
extern Lisp_Object Qdisplay;
Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
Lisp_Object Qscreen_gamma, Qline_spacing, Qcenter;
Lisp_Object Qcompound_text, Qcancel_timer;
Lisp_Object Qwait_for_wm;
extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
extern Lisp_Object Qtool_bar_lines;
extern Lisp_Object Vwindow_system_version;
Lisp_Object Qface_set_after_frame_default;
#if GLYPH_DEBUG
int image_cache_refcount, dpyinfo_refcount;
#endif
void
check_x ()
{
if (! x_in_use)
error ("X windows are not in use or not initialized");
}
int
have_menus_p ()
{
return x_in_use;
}
FRAME_PTR
check_x_frame (frame)
Lisp_Object frame;
{
FRAME_PTR f;
if (NILP (frame))
frame = selected_frame;
CHECK_LIVE_FRAME (frame, 0);
f = XFRAME (frame);
if (! FRAME_X_P (f))
error ("Non-X frame used");
return f;
}
static struct x_display_info *
check_x_display_info (frame)
Lisp_Object frame;
{
struct x_display_info *dpyinfo = NULL;
if (NILP (frame))
{
struct frame *sf = XFRAME (selected_frame);
if (FRAME_X_P (sf) && FRAME_LIVE_P (sf))
dpyinfo = FRAME_X_DISPLAY_INFO (sf);
else if (x_display_list != 0)
dpyinfo = x_display_list;
else
error ("X windows are not in use or not initialized");
}
else if (STRINGP (frame))
dpyinfo = x_display_info_for_name (frame);
else
{
FRAME_PTR f;
CHECK_LIVE_FRAME (frame, 0);
f = XFRAME (frame);
if (! FRAME_X_P (f))
error ("Non-X frame used");
dpyinfo = FRAME_X_DISPLAY_INFO (f);
}
return dpyinfo;
}
struct frame *
x_window_to_frame (dpyinfo, wdesc)
struct x_display_info *dpyinfo;
int wdesc;
{
Lisp_Object tail, frame;
struct frame *f;
for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
{
frame = XCAR (tail);
if (!GC_FRAMEP (frame))
continue;
f = XFRAME (frame);
if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
continue;
if (f->output_data.x->hourglass_window == wdesc)
return f;
#ifdef USE_X_TOOLKIT
if ((f->output_data.x->edit_widget
&& XtWindow (f->output_data.x->edit_widget) == wdesc)
|| (!f->output_data.x->edit_widget
&& FRAME_X_WINDOW (f) == wdesc)
|| f->output_data.x->icon_desc == wdesc)
return f;
#else
if (FRAME_X_WINDOW (f) == wdesc
|| f->output_data.x->icon_desc == wdesc)
return f;
#endif
}
return 0;
}
#ifdef USE_X_TOOLKIT
struct frame *
x_any_window_to_frame (dpyinfo, wdesc)
struct x_display_info *dpyinfo;
int wdesc;
{
Lisp_Object tail, frame;
struct frame *f, *found;
struct x_output *x;
found = NULL;
for (tail = Vframe_list; GC_CONSP (tail) && !found; tail = XCDR (tail))
{
frame = XCAR (tail);
if (!GC_FRAMEP (frame))
continue;
f = XFRAME (frame);
if (FRAME_X_P (f) && FRAME_X_DISPLAY_INFO (f) == dpyinfo)
{
x = f->output_data.x;
if (x->hourglass_window == wdesc)
found = f;
else if (x->widget)
{
if (wdesc == XtWindow (x->widget)
|| wdesc == XtWindow (x->column_widget)
|| wdesc == XtWindow (x->edit_widget))
found = f;
else if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
found = f;
}
else if (FRAME_X_WINDOW (f) == wdesc)
found = f;
}
}
return found;
}
struct frame *
x_non_menubar_window_to_frame (dpyinfo, wdesc)
struct x_display_info *dpyinfo;
int wdesc;
{
Lisp_Object tail, frame;
struct frame *f;
struct x_output *x;
for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
{
frame = XCAR (tail);
if (!GC_FRAMEP (frame))
continue;
f = XFRAME (frame);
if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
continue;
x = f->output_data.x;
if (x->hourglass_window == wdesc)
return f;
else if (x->widget)
{
if (wdesc == XtWindow (x->widget)
|| wdesc == XtWindow (x->column_widget)
|| wdesc == XtWindow (x->edit_widget))
return f;
}
else if (FRAME_X_WINDOW (f) == wdesc)
return f;
}
return 0;
}
struct frame *
x_menubar_window_to_frame (dpyinfo, wdesc)
struct x_display_info *dpyinfo;
int wdesc;
{
Lisp_Object tail, frame;
struct frame *f;
struct x_output *x;
for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
{
frame = XCAR (tail);
if (!GC_FRAMEP (frame))
continue;
f = XFRAME (frame);
if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
continue;
x = f->output_data.x;
if (x->menubar_widget
&& lw_window_is_in_menubar (wdesc, x->menubar_widget))
return f;
}
return 0;
}
struct frame *
x_top_window_to_frame (dpyinfo, wdesc)
struct x_display_info *dpyinfo;
int wdesc;
{
Lisp_Object tail, frame;
struct frame *f;
struct x_output *x;
for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
{
frame = XCAR (tail);
if (!GC_FRAMEP (frame))
continue;
f = XFRAME (frame);
if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
continue;
x = f->output_data.x;
if (x->widget)
{
if (wdesc == XtWindow (x->widget))
return f;
#if 0
if (x->menubar_widget
&& wdesc == XtWindow (x->menubar_widget))
return f;
#endif
}
else if (FRAME_X_WINDOW (f) == wdesc)
return f;
}
return 0;
}
#endif
int
x_bitmap_height (f, id)
FRAME_PTR f;
int id;
{
return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].height;
}
int
x_bitmap_width (f, id)
FRAME_PTR f;
int id;
{
return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].width;
}
int
x_bitmap_pixmap (f, id)
FRAME_PTR f;
int id;
{
return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
}
static int
x_allocate_bitmap_record (f)
FRAME_PTR f;
{
struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
int i;
if (dpyinfo->bitmaps == NULL)
{
dpyinfo->bitmaps_size = 10;
dpyinfo->bitmaps
= (struct x_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
dpyinfo->bitmaps_last = 1;
return 1;
}
if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
return ++dpyinfo->bitmaps_last;
for (i = 0; i < dpyinfo->bitmaps_size; ++i)
if (dpyinfo->bitmaps[i].refcount == 0)
return i + 1;
dpyinfo->bitmaps_size *= 2;
dpyinfo->bitmaps
= (struct x_bitmap_record *) xrealloc (dpyinfo->bitmaps,
dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
return ++dpyinfo->bitmaps_last;
}
void
x_reference_bitmap (f, id)
FRAME_PTR f;
int id;
{
++FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
}
int
x_create_bitmap_from_data (f, bits, width, height)
struct frame *f;
char *bits;
unsigned int width, height;
{
struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
Pixmap bitmap;
int id;
bitmap = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
bits, width, height);
if (! bitmap)
return -1;
id = x_allocate_bitmap_record (f);
dpyinfo->bitmaps[id - 1].pixmap = bitmap;
dpyinfo->bitmaps[id - 1].file = NULL;
dpyinfo->bitmaps[id - 1].refcount = 1;
dpyinfo->bitmaps[id - 1].depth = 1;
dpyinfo->bitmaps[id - 1].height = height;
dpyinfo->bitmaps[id - 1].width = width;
return id;
}
int
x_create_bitmap_from_file (f, file)
struct frame *f;
Lisp_Object file;
{
struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
unsigned int width, height;
Pixmap bitmap;
int xhot, yhot, result, id;
Lisp_Object found;
int fd;
char *filename;
for (id = 0; id < dpyinfo->bitmaps_last; ++id)
{
if (dpyinfo->bitmaps[id].refcount
&& dpyinfo->bitmaps[id].file
&& !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
{
++dpyinfo->bitmaps[id].refcount;
return id + 1;
}
}
fd = openp (Vx_bitmap_file_path, file, "", &found, 0);
if (fd < 0)
return -1;
emacs_close (fd);
filename = (char *) XSTRING (found)->data;
result = XReadBitmapFile (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
filename, &width, &height, &bitmap, &xhot, &yhot);
if (result != BitmapSuccess)
return -1;
id = x_allocate_bitmap_record (f);
dpyinfo->bitmaps[id - 1].pixmap = bitmap;
dpyinfo->bitmaps[id - 1].refcount = 1;
dpyinfo->bitmaps[id - 1].file
= (char *) xmalloc (STRING_BYTES (XSTRING (file)) + 1);
dpyinfo->bitmaps[id - 1].depth = 1;
dpyinfo->bitmaps[id - 1].height = height;
dpyinfo->bitmaps[id - 1].width = width;
strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
return id;
}
void
x_destroy_bitmap (f, id)
FRAME_PTR f;
int id;
{
struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
if (id > 0)
{
--dpyinfo->bitmaps[id - 1].refcount;
if (dpyinfo->bitmaps[id - 1].refcount == 0)
{
BLOCK_INPUT;
XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].pixmap);
if (dpyinfo->bitmaps[id - 1].file)
{
xfree (dpyinfo->bitmaps[id - 1].file);
dpyinfo->bitmaps[id - 1].file = NULL;
}
UNBLOCK_INPUT;
}
}
}
static void
x_destroy_all_bitmaps (dpyinfo)
struct x_display_info *dpyinfo;
{
int i;
for (i = 0; i < dpyinfo->bitmaps_last; i++)
if (dpyinfo->bitmaps[i].refcount > 0)
{
XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].pixmap);
if (dpyinfo->bitmaps[i].file)
xfree (dpyinfo->bitmaps[i].file);
}
dpyinfo->bitmaps_last = 0;
}
struct x_frame_parm_table
{
char *name;
void (*setter) P_ ((struct frame *, Lisp_Object, Lisp_Object));
};
static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
static void x_change_window_heights P_ ((Lisp_Object, int));
static void x_disable_image P_ ((struct frame *, struct image *));
void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
static void x_set_line_spacing P_ ((struct frame *, Lisp_Object, Lisp_Object));
static void x_set_wait_for_wm P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_font P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_border_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_internal_border_width P_ ((struct frame *, Lisp_Object,
Lisp_Object));
void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_autoraise P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_autolower P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_vertical_scroll_bars P_ ((struct frame *, Lisp_Object,
Lisp_Object));
void x_set_visibility P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_scroll_bar_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_unsplittable P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_scroll_bar_foreground P_ ((struct frame *, Lisp_Object,
Lisp_Object));
void x_set_scroll_bar_background P_ ((struct frame *, Lisp_Object,
Lisp_Object));
static Lisp_Object x_default_scroll_bar_color_parameter P_ ((struct frame *,
Lisp_Object,
Lisp_Object,
char *, char *,
int));
static void x_set_screen_gamma P_ ((struct frame *, Lisp_Object, Lisp_Object));
static void x_edge_detection P_ ((struct frame *, struct image *, Lisp_Object,
Lisp_Object));
static void init_color_table P_ ((void));
static void free_color_table P_ ((void));
static unsigned long *colors_in_color_table P_ ((int *n));
static unsigned long lookup_rgb_color P_ ((struct frame *f, int r, int g, int b));
static unsigned long lookup_pixel_color P_ ((struct frame *f, unsigned long p));
static struct x_frame_parm_table x_frame_parms[] =
{
"auto-raise", x_set_autoraise,
"auto-lower", x_set_autolower,
"background-color", x_set_background_color,
"border-color", x_set_border_color,
"border-width", x_set_border_width,
"cursor-color", x_set_cursor_color,
"cursor-type", x_set_cursor_type,
"font", x_set_font,
"foreground-color", x_set_foreground_color,
"icon-name", x_set_icon_name,
"icon-type", x_set_icon_type,
"internal-border-width", x_set_internal_border_width,
"menu-bar-lines", x_set_menu_bar_lines,
"mouse-color", x_set_mouse_color,
"name", x_explicitly_set_name,
"scroll-bar-width", x_set_scroll_bar_width,
"title", x_set_title,
"unsplittable", x_set_unsplittable,
"vertical-scroll-bars", x_set_vertical_scroll_bars,
"visibility", x_set_visibility,
"tool-bar-lines", x_set_tool_bar_lines,
"scroll-bar-foreground", x_set_scroll_bar_foreground,
"scroll-bar-background", x_set_scroll_bar_background,
"screen-gamma", x_set_screen_gamma,
"line-spacing", x_set_line_spacing,
"wait-for-wm", x_set_wait_for_wm
};
void
init_x_parm_symbols ()
{
int i;
for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
make_number (i));
}
void
x_set_frame_parameters (f, alist)
FRAME_PTR f;
Lisp_Object alist;
{
Lisp_Object tail;
int width, height;
Lisp_Object left, top;
Lisp_Object icon_left, icon_top;
Lisp_Object *parms;
Lisp_Object *values;
int i, p;
int left_no_change = 0, top_no_change = 0;
int icon_left_no_change = 0, icon_top_no_change = 0;
struct gcpro gcpro1, gcpro2;
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));
i = 0;
for (tail = alist; CONSP (tail); tail = Fcdr (tail))
{
Lisp_Object elt;
elt = Fcar (tail);
parms[i] = Fcar (elt);
values[i] = Fcdr (elt);
i++;
}
alist = tail = Qnil;
GCPRO2 (*parms, *values);
gcpro1.nvars = i;
gcpro2.nvars = i;
top = left = Qunbound;
icon_left = icon_top = Qunbound;
if (FRAME_NEW_WIDTH (f))
width = FRAME_NEW_WIDTH (f);
else
width = FRAME_WIDTH (f);
if (FRAME_NEW_HEIGHT (f))
height = FRAME_NEW_HEIGHT (f);
else
height = FRAME_HEIGHT (f);
for (p = 0; p < i; p++)
{
Lisp_Object prop, val;
prop = parms[p];
val = values[p];
if (EQ (prop, Qforeground_color) || EQ (prop, Qbackground_color))
{
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 (NATNUMP (param_index)
&& (XFASTINT (param_index)
< sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
(*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
}
}
for (i--; i >= 0; i--)
{
Lisp_Object prop, val;
prop = parms[i];
val = values[i];
if (EQ (prop, Qwidth) && NUMBERP (val))
width = XFASTINT (val);
else if (EQ (prop, Qheight) && NUMBERP (val))
height = XFASTINT (val);
else if (EQ (prop, Qtop))
top = val;
else if (EQ (prop, Qleft))
left = val;
else if (EQ (prop, Qicon_top))
icon_top = val;
else if (EQ (prop, Qicon_left))
icon_left = val;
else if (EQ (prop, Qforeground_color) || EQ (prop, Qbackground_color))
continue;
else
{
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 (NATNUMP (param_index)
&& (XFASTINT (param_index)
< sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
(*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
}
}
if (EQ (left, Qunbound))
{
left_no_change = 1;
if (f->output_data.x->left_pos < 0)
left = Fcons (Qplus, Fcons (make_number (f->output_data.x->left_pos), Qnil));
else
XSETINT (left, f->output_data.x->left_pos);
}
if (EQ (top, Qunbound))
{
top_no_change = 1;
if (f->output_data.x->top_pos < 0)
top = Fcons (Qplus, Fcons (make_number (f->output_data.x->top_pos), Qnil));
else
XSETINT (top, f->output_data.x->top_pos);
}
if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
{
icon_left_no_change = 1;
icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
if (NILP (icon_left))
XSETINT (icon_left, 0);
}
if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
{
icon_top_no_change = 1;
icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
if (NILP (icon_top))
XSETINT (icon_top, 0);
}
{
Lisp_Object frame;
check_frame_size (f, &height, &width);
XSETFRAME (frame, f);
if (width != FRAME_WIDTH (f)
|| height != FRAME_HEIGHT (f)
|| FRAME_NEW_HEIGHT (f) || FRAME_NEW_WIDTH (f))
Fset_frame_size (frame, make_number (width), make_number (height));
if ((!NILP (left) || !NILP (top))
&& ! (left_no_change && top_no_change)
&& ! (NUMBERP (left) && XINT (left) == f->output_data.x->left_pos
&& NUMBERP (top) && XINT (top) == f->output_data.x->top_pos))
{
int leftpos = 0;
int toppos = 0;
f->output_data.x->size_hint_flags &= ~ (XNegative | YNegative);
if (EQ (left, Qminus))
f->output_data.x->size_hint_flags |= XNegative;
else if (INTEGERP (left))
{
leftpos = XINT (left);
if (leftpos < 0)
f->output_data.x->size_hint_flags |= XNegative;
}
else if (CONSP (left) && EQ (XCAR (left), Qminus)
&& CONSP (XCDR (left))
&& INTEGERP (XCAR (XCDR (left))))
{
leftpos = - XINT (XCAR (XCDR (left)));
f->output_data.x->size_hint_flags |= XNegative;
}
else if (CONSP (left) && EQ (XCAR (left), Qplus)
&& CONSP (XCDR (left))
&& INTEGERP (XCAR (XCDR (left))))
{
leftpos = XINT (XCAR (XCDR (left)));
}
if (EQ (top, Qminus))
f->output_data.x->size_hint_flags |= YNegative;
else if (INTEGERP (top))
{
toppos = XINT (top);
if (toppos < 0)
f->output_data.x->size_hint_flags |= YNegative;
}
else if (CONSP (top) && EQ (XCAR (top), Qminus)
&& CONSP (XCDR (top))
&& INTEGERP (XCAR (XCDR (top))))
{
toppos = - XINT (XCAR (XCDR (top)));
f->output_data.x->size_hint_flags |= YNegative;
}
else if (CONSP (top) && EQ (XCAR (top), Qplus)
&& CONSP (XCDR (top))
&& INTEGERP (XCAR (XCDR (top))))
{
toppos = XINT (XCAR (XCDR (top)));
}
f->output_data.x->top_pos = toppos;
f->output_data.x->left_pos = leftpos;
f->output_data.x->win_gravity = NorthWestGravity;
x_set_offset (f, leftpos, toppos, -1);
}
if ((!NILP (icon_left) || !NILP (icon_top))
&& ! (icon_left_no_change && icon_top_no_change))
x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
}
UNGCPRO;
}
void
x_real_positions (f, xptr, yptr)
FRAME_PTR f;
int *xptr, *yptr;
{
int win_x, win_y;
Window child;
#ifdef USE_X_TOOLKIT
Window outer = (f->output_data.x->widget
? XtWindow (f->output_data.x->widget)
: FRAME_X_WINDOW (f));
#else
Window outer = f->output_data.x->window_desc;
#endif
Window tmp_root_window;
Window *tmp_children;
unsigned int tmp_nchildren;
while (1)
{
int count = x_catch_errors (FRAME_X_DISPLAY (f));
Window outer_window;
XQueryTree (FRAME_X_DISPLAY (f), outer, &tmp_root_window,
&f->output_data.x->parent_desc,
&tmp_children, &tmp_nchildren);
XFree ((char *) tmp_children);
win_x = win_y = 0;
if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
outer_window = f->output_data.x->parent_desc;
else
outer_window = outer;
XTranslateCoordinates (FRAME_X_DISPLAY (f),
outer_window,
FRAME_X_DISPLAY_INFO (f)->root_window,
0, 0, &win_x, &win_y,
&child);
if (! x_had_errors_p (FRAME_X_DISPLAY (f)))
{
x_uncatch_errors (FRAME_X_DISPLAY (f), count);
break;
}
x_uncatch_errors (FRAME_X_DISPLAY (f), count);
}
*xptr = win_x;
*yptr = win_y;
}
void
x_report_frame_params (f, alistptr)
struct frame *f;
Lisp_Object *alistptr;
{
char buf[16];
Lisp_Object tem;
XSETINT (tem, f->output_data.x->left_pos);
if (f->output_data.x->left_pos >= 0)
store_in_alist (alistptr, Qleft, tem);
else
store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
XSETINT (tem, f->output_data.x->top_pos);
if (f->output_data.x->top_pos >= 0)
store_in_alist (alistptr, Qtop, tem);
else
store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
store_in_alist (alistptr, Qborder_width,
make_number (f->output_data.x->border_width));
store_in_alist (alistptr, Qinternal_border_width,
make_number (f->output_data.x->internal_border_width));
sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
store_in_alist (alistptr, Qwindow_id,
build_string (buf));
#ifdef USE_X_TOOLKIT
if (f->output_data.x->widget)
#endif
sprintf (buf, "%ld", (long) FRAME_OUTER_WINDOW (f));
store_in_alist (alistptr, Qouter_window_id,
build_string (buf));
store_in_alist (alistptr, Qicon_name, f->icon_name);
FRAME_SAMPLE_VISIBILITY (f);
store_in_alist (alistptr, Qvisibility,
(FRAME_VISIBLE_P (f) ? Qt
: FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
store_in_alist (alistptr, Qdisplay,
XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
if (f->output_data.x->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
tem = Qnil;
else
XSETFASTINT (tem, f->output_data.x->parent_desc);
store_in_alist (alistptr, Qparent_id, tem);
}
void
gamma_correct (f, color)
struct frame *f;
XColor *color;
{
if (f->gamma)
{
color->red = pow (color->red / 65535.0, f->gamma) * 65535.0 + 0.5;
color->green = pow (color->green / 65535.0, f->gamma) * 65535.0 + 0.5;
color->blue = pow (color->blue / 65535.0, f->gamma) * 65535.0 + 0.5;
}
}
int
x_defined_color (f, color_name, color, alloc_p)
struct frame *f;
char *color_name;
XColor *color;
int alloc_p;
{
int success_p;
Display *dpy = FRAME_X_DISPLAY (f);
Colormap cmap = FRAME_X_COLORMAP (f);
BLOCK_INPUT;
success_p = XParseColor (dpy, cmap, color_name, color);
if (success_p && alloc_p)
success_p = x_alloc_nearest_color (f, cmap, color);
UNBLOCK_INPUT;
return success_p;
}
int
x_decode_color (f, color_name, mono_color)
FRAME_PTR f;
Lisp_Object color_name;
int mono_color;
{
XColor cdef;
CHECK_STRING (color_name, 0);
#if 0
if (strcmp (XSTRING (color_name)->data, "black") == 0)
return BLACK_PIX_DEFAULT (f);
else if (strcmp (XSTRING (color_name)->data, "white") == 0)
return WHITE_PIX_DEFAULT (f);
#endif
if (FRAME_X_DISPLAY_INFO (f)->n_planes == 1)
return mono_color;
if (x_defined_color (f, XSTRING (color_name)->data, &cdef, 1))
return cdef.pixel;
Fsignal (Qerror, Fcons (build_string ("Undefined color"),
Fcons (color_name, Qnil)));
return 0;
}
static void
x_set_line_spacing (f, new_value, old_value)
struct frame *f;
Lisp_Object new_value, old_value;
{
if (NILP (new_value))
f->extra_line_spacing = 0;
else if (NATNUMP (new_value))
f->extra_line_spacing = XFASTINT (new_value);
else
Fsignal (Qerror, Fcons (build_string ("Invalid line-spacing"),
Fcons (new_value, Qnil)));
if (FRAME_VISIBLE_P (f))
redraw_frame (f);
}
static void
x_set_wait_for_wm (f, new_value, old_value)
struct frame *f;
Lisp_Object new_value, old_value;
{
f->output_data.x->wait_for_wm = !NILP (new_value);
}
static void
x_set_screen_gamma (f, new_value, old_value)
struct frame *f;
Lisp_Object new_value, old_value;
{
if (NILP (new_value))
f->gamma = 0;
else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
else
Fsignal (Qerror, Fcons (build_string ("Invalid screen-gamma"),
Fcons (new_value, Qnil)));
clear_face_cache (0);
}
void
x_set_foreground_color (f, arg, oldval)
struct frame *f;
Lisp_Object arg, oldval;
{
struct x_output *x = f->output_data.x;
unsigned long fg, old_fg;
fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
old_fg = x->foreground_pixel;
x->foreground_pixel = fg;
if (FRAME_X_WINDOW (f) != 0)
{
Display *dpy = FRAME_X_DISPLAY (f);
BLOCK_INPUT;
XSetForeground (dpy, x->normal_gc, fg);
XSetBackground (dpy, x->reverse_gc, fg);
if (x->cursor_pixel == old_fg)
{
unload_color (f, x->cursor_pixel);
x->cursor_pixel = x_copy_color (f, fg);
XSetBackground (dpy, x->cursor_gc, x->cursor_pixel);
}
UNBLOCK_INPUT;
update_face_from_frame_parameter (f, Qforeground_color, arg);
if (FRAME_VISIBLE_P (f))
redraw_frame (f);
}
unload_color (f, old_fg);
}
void
x_set_background_color (f, arg, oldval)
struct frame *f;
Lisp_Object arg, oldval;
{
struct x_output *x = f->output_data.x;
unsigned long bg;
bg = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
unload_color (f, x->background_pixel);
x->background_pixel = bg;
if (FRAME_X_WINDOW (f) != 0)
{
Display *dpy = FRAME_X_DISPLAY (f);
BLOCK_INPUT;
XSetBackground (dpy, x->normal_gc, bg);
XSetForeground (dpy, x->reverse_gc, bg);
XSetWindowBackground (dpy, FRAME_X_WINDOW (f), bg);
XSetForeground (dpy, x->cursor_gc, bg);
#ifndef USE_TOOLKIT_SCROLL_BARS
{
Lisp_Object bar;
for (bar = FRAME_SCROLL_BARS (f);
!NILP (bar);
bar = XSCROLL_BAR (bar)->next)
{
Window window = SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar));
XSetWindowBackground (dpy, window, bg);
}
}
#endif
UNBLOCK_INPUT;
update_face_from_frame_parameter (f, Qbackground_color, arg);
if (FRAME_VISIBLE_P (f))
redraw_frame (f);
}
}
void
x_set_mouse_color (f, arg, oldval)
struct frame *f;
Lisp_Object arg, oldval;
{
struct x_output *x = f->output_data.x;
Display *dpy = FRAME_X_DISPLAY (f);
Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
Cursor hourglass_cursor, horizontal_drag_cursor;
int count;
unsigned long pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
unsigned long mask_color = x->background_pixel;
if (mask_color == pixel)
{
x_free_colors (f, &pixel, 1);
pixel = x_copy_color (f, x->foreground_pixel);
}
unload_color (f, x->mouse_pixel);
x->mouse_pixel = pixel;
BLOCK_INPUT;
count = x_catch_errors (dpy);
if (!NILP (Vx_pointer_shape))
{
CHECK_NUMBER (Vx_pointer_shape, 0);
cursor = XCreateFontCursor (dpy, XINT (Vx_pointer_shape));
}
else
cursor = XCreateFontCursor (dpy, XC_xterm);
x_check_errors (dpy, "bad text pointer cursor: %s");
if (!NILP (Vx_nontext_pointer_shape))
{
CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
nontext_cursor
= XCreateFontCursor (dpy, XINT (Vx_nontext_pointer_shape));
}
else
nontext_cursor = XCreateFontCursor (dpy, XC_left_ptr);
x_check_errors (dpy, "bad nontext pointer cursor: %s");
if (!NILP (Vx_hourglass_pointer_shape))
{
CHECK_NUMBER (Vx_hourglass_pointer_shape, 0);
hourglass_cursor
= XCreateFontCursor (dpy, XINT (Vx_hourglass_pointer_shape));
}
else
hourglass_cursor = XCreateFontCursor (dpy, XC_watch);
x_check_errors (dpy, "bad hourglass pointer cursor: %s");
x_check_errors (dpy, "bad nontext pointer cursor: %s");
if (!NILP (Vx_mode_pointer_shape))
{
CHECK_NUMBER (Vx_mode_pointer_shape, 0);
mode_cursor = XCreateFontCursor (dpy, XINT (Vx_mode_pointer_shape));
}
else
mode_cursor = XCreateFontCursor (dpy, XC_xterm);
x_check_errors (dpy, "bad modeline pointer cursor: %s");
if (!NILP (Vx_sensitive_text_pointer_shape))
{
CHECK_NUMBER (Vx_sensitive_text_pointer_shape, 0);
cross_cursor
= XCreateFontCursor (dpy, XINT (Vx_sensitive_text_pointer_shape));
}
else
cross_cursor = XCreateFontCursor (dpy, XC_crosshair);
if (!NILP (Vx_window_horizontal_drag_shape))
{
CHECK_NUMBER (Vx_window_horizontal_drag_shape, 0);
horizontal_drag_cursor
= XCreateFontCursor (dpy, XINT (Vx_window_horizontal_drag_shape));
}
else
horizontal_drag_cursor
= XCreateFontCursor (dpy, XC_sb_h_double_arrow);
x_check_errors (dpy, "can't set cursor shape: %s");
x_uncatch_errors (dpy, count);
{
XColor fore_color, back_color;
fore_color.pixel = x->mouse_pixel;
x_query_color (f, &fore_color);
back_color.pixel = mask_color;
x_query_color (f, &back_color);
XRecolorCursor (dpy, cursor, &fore_color, &back_color);
XRecolorCursor (dpy, nontext_cursor, &fore_color, &back_color);
XRecolorCursor (dpy, mode_cursor, &fore_color, &back_color);
XRecolorCursor (dpy, cross_cursor, &fore_color, &back_color);
XRecolorCursor (dpy, hourglass_cursor, &fore_color, &back_color);
XRecolorCursor (dpy, horizontal_drag_cursor, &fore_color, &back_color);
}
if (FRAME_X_WINDOW (f) != 0)
XDefineCursor (dpy, FRAME_X_WINDOW (f), cursor);
if (cursor != x->text_cursor
&& x->text_cursor != 0)
XFreeCursor (dpy, x->text_cursor);
x->text_cursor = cursor;
if (nontext_cursor != x->nontext_cursor
&& x->nontext_cursor != 0)
XFreeCursor (dpy, x->nontext_cursor);
x->nontext_cursor = nontext_cursor;
if (hourglass_cursor != x->hourglass_cursor
&& x->hourglass_cursor != 0)
XFreeCursor (dpy, x->hourglass_cursor);
x->hourglass_cursor = hourglass_cursor;
if (mode_cursor != x->modeline_cursor
&& x->modeline_cursor != 0)
XFreeCursor (dpy, f->output_data.x->modeline_cursor);
x->modeline_cursor = mode_cursor;
if (cross_cursor != x->cross_cursor
&& x->cross_cursor != 0)
XFreeCursor (dpy, x->cross_cursor);
x->cross_cursor = cross_cursor;
if (horizontal_drag_cursor != x->horizontal_drag_cursor
&& x->horizontal_drag_cursor != 0)
XFreeCursor (dpy, x->horizontal_drag_cursor);
x->horizontal_drag_cursor = horizontal_drag_cursor;
XFlush (dpy);
UNBLOCK_INPUT;
update_face_from_frame_parameter (f, Qmouse_color, arg);
}
void
x_set_cursor_color (f, arg, oldval)
struct frame *f;
Lisp_Object arg, oldval;
{
unsigned long fore_pixel, pixel;
int fore_pixel_allocated_p = 0, pixel_allocated_p = 0;
struct x_output *x = f->output_data.x;
if (!NILP (Vx_cursor_fore_pixel))
{
fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
WHITE_PIX_DEFAULT (f));
fore_pixel_allocated_p = 1;
}
else
fore_pixel = x->background_pixel;
pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
pixel_allocated_p = 1;
if (pixel == x->background_pixel)
{
if (pixel_allocated_p)
{
x_free_colors (f, &pixel, 1);
pixel_allocated_p = 0;
}
pixel = x->mouse_pixel;
if (pixel == fore_pixel)
{
if (fore_pixel_allocated_p)
{
x_free_colors (f, &fore_pixel, 1);
fore_pixel_allocated_p = 0;
}
fore_pixel = x->background_pixel;
}
}
unload_color (f, x->cursor_foreground_pixel);
if (!fore_pixel_allocated_p)
fore_pixel = x_copy_color (f, fore_pixel);
x->cursor_foreground_pixel = fore_pixel;
unload_color (f, x->cursor_pixel);
if (!pixel_allocated_p)
pixel = x_copy_color (f, pixel);
x->cursor_pixel = pixel;
if (FRAME_X_WINDOW (f) != 0)
{
BLOCK_INPUT;
XSetBackground (FRAME_X_DISPLAY (f), x->cursor_gc, x->cursor_pixel);
XSetForeground (FRAME_X_DISPLAY (f), x->cursor_gc, fore_pixel);
UNBLOCK_INPUT;
if (FRAME_VISIBLE_P (f))
{
x_update_cursor (f, 0);
x_update_cursor (f, 1);
}
}
update_face_from_frame_parameter (f, Qcursor_color, arg);
}
void
x_set_border_color (f, arg, oldval)
struct frame *f;
Lisp_Object arg, oldval;
{
int pix;
CHECK_STRING (arg, 0);
pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
x_set_border_pixel (f, pix);
update_face_from_frame_parameter (f, Qborder_color, arg);
}
void
x_set_border_pixel (f, pix)
struct frame *f;
int pix;
{
unload_color (f, f->output_data.x->border_pixel);
f->output_data.x->border_pixel = pix;
if (FRAME_X_WINDOW (f) != 0 && f->output_data.x->border_width > 0)
{
BLOCK_INPUT;
XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
(unsigned long)pix);
UNBLOCK_INPUT;
if (FRAME_VISIBLE_P (f))
redraw_frame (f);
}
}
enum text_cursor_kinds
x_specified_cursor_type (arg, width)
Lisp_Object arg;
int *width;
{
enum text_cursor_kinds type;
if (EQ (arg, Qbar))
{
type = BAR_CURSOR;
*width = 2;
}
else if (CONSP (arg)
&& EQ (XCAR (arg), Qbar)
&& INTEGERP (XCDR (arg))
&& XINT (XCDR (arg)) >= 0)
{
type = BAR_CURSOR;
*width = XINT (XCDR (arg));
}
else if (NILP (arg))
type = NO_CURSOR;
else
type = FILLED_BOX_CURSOR;
return type;
}
void
x_set_cursor_type (f, arg, oldval)
FRAME_PTR f;
Lisp_Object arg, oldval;
{
int width;
FRAME_DESIRED_CURSOR (f) = x_specified_cursor_type (arg, &width);
f->output_data.x->cursor_width = width;
update_mode_lines++;
}
void
x_set_icon_type (f, arg, oldval)
struct frame *f;
Lisp_Object arg, oldval;
{
int result;
if (STRINGP (arg))
{
if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
return;
}
else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
return;
BLOCK_INPUT;
if (NILP (arg))
result = x_text_icon (f,
(char *) XSTRING ((!NILP (f->icon_name)
? f->icon_name
: f->name))->data);
else
result = x_bitmap_icon (f, arg);
if (result)
{
UNBLOCK_INPUT;
error ("No icon window available");
}
XFlush (FRAME_X_DISPLAY (f));
UNBLOCK_INPUT;
}
Lisp_Object
x_icon_type (f)
FRAME_PTR f;
{
Lisp_Object tem;
tem = assq_no_quit (Qicon_type, f->param_alist);
if (CONSP (tem))
return XCDR (tem);
else
return Qnil;
}
void
x_set_icon_name (f, arg, oldval)
struct frame *f;
Lisp_Object arg, oldval;
{
int result;
if (STRINGP (arg))
{
if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
return;
}
else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
return;
f->icon_name = arg;
if (f->output_data.x->icon_bitmap != 0)
return;
BLOCK_INPUT;
result = x_text_icon (f,
(char *) XSTRING ((!NILP (f->icon_name)
? f->icon_name
: !NILP (f->title)
? f->title
: f->name))->data);
if (result)
{
UNBLOCK_INPUT;
error ("No icon window available");
}
XFlush (FRAME_X_DISPLAY (f));
UNBLOCK_INPUT;
}
void
x_set_font (f, arg, oldval)
struct frame *f;
Lisp_Object arg, oldval;
{
Lisp_Object result;
Lisp_Object fontset_name;
Lisp_Object frame;
int old_fontset = f->output_data.x->fontset;
CHECK_STRING (arg, 1);
fontset_name = Fquery_fontset (arg, Qnil);
BLOCK_INPUT;
result = (STRINGP (fontset_name)
? x_new_fontset (f, XSTRING (fontset_name)->data)
: x_new_font (f, XSTRING (arg)->data));
UNBLOCK_INPUT;
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))
{
if (STRINGP (fontset_name))
{
if (old_fontset == f->output_data.x->fontset)
return;
}
else if (!NILP (Fequal (result, oldval)))
return;
store_frame_param (f, Qfont, result);
recompute_basic_faces (f);
}
else
abort ();
do_pending_window_change (0);
if (FRAME_FACE_CACHE (f))
{
XSETFRAME (frame, f);
call1 (Qface_set_after_frame_default, frame);
}
}
void
x_set_border_width (f, arg, oldval)
struct frame *f;
Lisp_Object arg, oldval;
{
CHECK_NUMBER (arg, 0);
if (XINT (arg) == f->output_data.x->border_width)
return;
if (FRAME_X_WINDOW (f) != 0)
error ("Cannot change the border width of a window");
f->output_data.x->border_width = XINT (arg);
}
void
x_set_internal_border_width (f, arg, oldval)
struct frame *f;
Lisp_Object arg, oldval;
{
int old = f->output_data.x->internal_border_width;
CHECK_NUMBER (arg, 0);
f->output_data.x->internal_border_width = XINT (arg);
if (f->output_data.x->internal_border_width < 0)
f->output_data.x->internal_border_width = 0;
#ifdef USE_X_TOOLKIT
if (f->output_data.x->edit_widget)
widget_store_internal_border (f->output_data.x->edit_widget);
#endif
if (f->output_data.x->internal_border_width == old)
return;
if (FRAME_X_WINDOW (f) != 0)
{
x_set_window_size (f, 0, f->width, f->height);
SET_FRAME_GARBAGED (f);
do_pending_window_change (0);
}
else
SET_FRAME_GARBAGED (f);
}
void
x_set_visibility (f, value, oldval)
struct frame *f;
Lisp_Object value, oldval;
{
Lisp_Object frame;
XSETFRAME (frame, f);
if (NILP (value))
Fmake_frame_invisible (frame, Qt);
else if (EQ (value, Qicon))
Ficonify_frame (frame);
else
Fmake_frame_visible (frame);
}
static void
x_change_window_heights (window, n)
Lisp_Object window;
int n;
{
struct window *w = XWINDOW (window);
XSETFASTINT (w->top, XFASTINT (w->top) + n);
XSETFASTINT (w->height, XFASTINT (w->height) - n);
if (INTEGERP (w->orig_top))
XSETFASTINT (w->orig_top, XFASTINT (w->orig_top) + n);
if (INTEGERP (w->orig_height))
XSETFASTINT (w->orig_height, XFASTINT (w->orig_height) - n);
if (!NILP (w->vchild))
x_change_window_heights (w->vchild, n);
for (window = w->hchild; !NILP (window); window = w->next)
{
w = XWINDOW (window);
x_change_window_heights (window, n);
}
}
void
x_set_menu_bar_lines (f, value, oldval)
struct frame *f;
Lisp_Object value, oldval;
{
int nlines;
#ifndef USE_X_TOOLKIT
int olines = FRAME_MENU_BAR_LINES (f);
#endif
if (FRAME_MINIBUF_ONLY_P (f))
return;
if (INTEGERP (value))
nlines = XINT (value);
else
nlines = 0;
windows_or_buffers_changed++;
#ifdef USE_X_TOOLKIT
FRAME_MENU_BAR_LINES (f) = 0;
if (nlines)
{
FRAME_EXTERNAL_MENU_BAR (f) = 1;
if (FRAME_X_P (f) && f->output_data.x->menubar_widget == 0)
XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
}
else
{
if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
free_frame_menubar (f);
FRAME_EXTERNAL_MENU_BAR (f) = 0;
if (FRAME_X_P (f))
f->output_data.x->menubar_widget = 0;
}
#else
FRAME_MENU_BAR_LINES (f) = nlines;
x_change_window_heights (f->root_window, nlines - olines);
#endif
adjust_glyphs (f);
}
void
x_set_tool_bar_lines (f, value, oldval)
struct frame *f;
Lisp_Object value, oldval;
{
int delta, nlines, root_height;
Lisp_Object root_window;
if (FRAME_MINIBUF_ONLY_P (f))
return;
if (INTEGERP (value) && XINT (value) >= 0)
nlines = XFASTINT (value);
else
nlines = 0;
++windows_or_buffers_changed;
delta = nlines - FRAME_TOOL_BAR_LINES (f);
root_window = FRAME_ROOT_WINDOW (f);
root_height = XINT (XWINDOW (root_window)->height);
if (root_height - delta < 1)
{
delta = root_height - 1;
nlines = FRAME_TOOL_BAR_LINES (f) + delta;
}
FRAME_TOOL_BAR_LINES (f) = nlines;
x_change_window_heights (root_window, delta);
adjust_glyphs (f);
if (FRAME_X_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
{
updating_frame = f;
clear_frame ();
clear_current_matrices (f);
updating_frame = NULL;
}
if (delta < 0)
{
int height = FRAME_INTERNAL_BORDER_WIDTH (f);
int width = PIXEL_WIDTH (f);
int y = nlines * CANON_Y_UNIT (f);
BLOCK_INPUT;
x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
0, y, width, height, False);
UNBLOCK_INPUT;
if (WINDOWP (f->tool_bar_window))
clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
}
}
void
x_set_scroll_bar_foreground (f, value, oldval)
struct frame *f;
Lisp_Object value, oldval;
{
unsigned long pixel;
if (STRINGP (value))
pixel = x_decode_color (f, value, BLACK_PIX_DEFAULT (f));
else
pixel = -1;
if (f->output_data.x->scroll_bar_foreground_pixel != -1)
unload_color (f, f->output_data.x->scroll_bar_foreground_pixel);
f->output_data.x->scroll_bar_foreground_pixel = pixel;
if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
{
if (condemn_scroll_bars_hook)
(*condemn_scroll_bars_hook) (f);
if (judge_scroll_bars_hook)
(*judge_scroll_bars_hook) (f);
update_face_from_frame_parameter (f, Qscroll_bar_foreground, value);
redraw_frame (f);
}
}
void
x_set_scroll_bar_background (f, value, oldval)
struct frame *f;
Lisp_Object value, oldval;
{
unsigned long pixel;
if (STRINGP (value))
pixel = x_decode_color (f, value, WHITE_PIX_DEFAULT (f));
else
pixel = -1;
if (f->output_data.x->scroll_bar_background_pixel != -1)
unload_color (f, f->output_data.x->scroll_bar_background_pixel);
f->output_data.x->scroll_bar_background_pixel = pixel;
if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
{
if (condemn_scroll_bars_hook)
(*condemn_scroll_bars_hook) (f);
if (judge_scroll_bars_hook)
(*judge_scroll_bars_hook) (f);
update_face_from_frame_parameter (f, Qscroll_bar_background, value);
redraw_frame (f);
}
}
unsigned char *
x_encode_text (string, coding_system, selectionp, text_bytes, stringp)
Lisp_Object string, coding_system;
int *text_bytes, *stringp;
int selectionp;
{
unsigned char *str = XSTRING (string)->data;
int chars = XSTRING (string)->size;
int bytes = STRING_BYTES (XSTRING (string));
int charset_info;
int bufsize;
unsigned char *buf;
struct coding_system coding;
charset_info = find_charset_in_text (str, chars, bytes, NULL, Qnil);
if (charset_info == 0)
{
*text_bytes = bytes;
*stringp = 1;
return str;
}
setup_coding_system (coding_system, &coding);
if (selectionp
&& SYMBOLP (coding.pre_write_conversion)
&& !NILP (Ffboundp (coding.pre_write_conversion)))
{
string = run_pre_post_conversion_on_str (string, &coding, 1);
str = XSTRING (string)->data;
chars = XSTRING (string)->size;
bytes = STRING_BYTES (XSTRING (string));
}
coding.src_multibyte = 1;
coding.dst_multibyte = 0;
coding.mode |= CODING_MODE_LAST_BLOCK;
if (coding.type == coding_type_iso2022)
coding.flags |= CODING_FLAG_ISO_SAFE;
coding.composing = COMPOSITION_DISABLED;
bufsize = encoding_buffer_size (&coding, bytes);
buf = (unsigned char *) xmalloc (bufsize);
encode_coding (&coding, str, buf, bytes, bufsize);
*text_bytes = coding.produced;
*stringp = (charset_info == 1 || !EQ (coding_system, Qcompound_text));
return buf;
}
void
x_set_name (f, name, explicit)
struct frame *f;
Lisp_Object name;
int explicit;
{
if (explicit)
{
if (f->explicit_name && NILP (name))
update_mode_lines = 1;
f->explicit_name = ! NILP (name);
}
else if (f->explicit_name)
return;
if (NILP (name))
{
if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name,
XSTRING (f->name)->data))
return;
name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name);
}
else
CHECK_STRING (name, 0);
if (! NILP (Fstring_equal (name, f->name)))
return;
f->name = name;
if (! NILP (f->title))
name = f->title;
if (FRAME_X_WINDOW (f))
{
BLOCK_INPUT;
#ifdef HAVE_X11R4
{
XTextProperty text, icon;
int bytes, stringp;
Lisp_Object coding_system;
coding_system = Vlocale_coding_system;
if (NILP (coding_system))
coding_system = Qcompound_text;
text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp);
text.encoding = (stringp ? XA_STRING
: FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
text.format = 8;
text.nitems = bytes;
if (NILP (f->icon_name))
{
icon = text;
}
else
{
icon.value = x_encode_text (f->icon_name, coding_system, 0,
&bytes, &stringp);
icon.encoding = (stringp ? XA_STRING
: FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
icon.format = 8;
icon.nitems = bytes;
}
#ifdef USE_X_TOOLKIT
XSetWMName (FRAME_X_DISPLAY (f),
XtWindow (f->output_data.x->widget), &text);
XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
&icon);
#else
XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
#endif
if (!NILP (f->icon_name)
&& icon.value != XSTRING (f->icon_name)->data)
xfree (icon.value);
if (text.value != XSTRING (name)->data)
xfree (text.value);
}
#else
XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
XSTRING (name)->data);
XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
XSTRING (name)->data);
#endif
UNBLOCK_INPUT;
}
}
void
x_explicitly_set_name (f, arg, oldval)
FRAME_PTR f;
Lisp_Object arg, oldval;
{
x_set_name (f, arg, 1);
}
void
x_implicitly_set_name (f, arg, oldval)
FRAME_PTR f;
Lisp_Object arg, oldval;
{
x_set_name (f, arg, 0);
}
void
x_set_title (f, name, old_name)
struct frame *f;
Lisp_Object name, old_name;
{
if (EQ (name, f->title))
return;
update_mode_lines = 1;
f->title = name;
if (NILP (name))
name = f->name;
else
CHECK_STRING (name, 0);
if (FRAME_X_WINDOW (f))
{
BLOCK_INPUT;
#ifdef HAVE_X11R4
{
XTextProperty text, icon;
int bytes, stringp;
Lisp_Object coding_system;
coding_system = Vlocale_coding_system;
if (NILP (coding_system))
coding_system = Qcompound_text;
text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp);
text.encoding = (stringp ? XA_STRING
: FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
text.format = 8;
text.nitems = bytes;
if (NILP (f->icon_name))
{
icon = text;
}
else
{
icon.value = x_encode_text (f->icon_name, coding_system, 0,
&bytes, &stringp);
icon.encoding = (stringp ? XA_STRING
: FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
icon.format = 8;
icon.nitems = bytes;
}
#ifdef USE_X_TOOLKIT
XSetWMName (FRAME_X_DISPLAY (f),
XtWindow (f->output_data.x->widget), &text);
XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
&icon);
#else
XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
#endif
if (!NILP (f->icon_name)
&& icon.value != XSTRING (f->icon_name)->data)
xfree (icon.value);
if (text.value != XSTRING (name)->data)
xfree (text.value);
}
#else
XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
XSTRING (name)->data);
XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
XSTRING (name)->data);
#endif
UNBLOCK_INPUT;
}
}
void
x_set_autoraise (f, arg, oldval)
struct frame *f;
Lisp_Object arg, oldval;
{
f->auto_raise = !EQ (Qnil, arg);
}
void
x_set_autolower (f, arg, oldval)
struct frame *f;
Lisp_Object arg, oldval;
{
f->auto_lower = !EQ (Qnil, arg);
}
void
x_set_unsplittable (f, arg, oldval)
struct frame *f;
Lisp_Object arg, oldval;
{
f->no_split = !NILP (arg);
}
void
x_set_vertical_scroll_bars (f, arg, oldval)
struct frame *f;
Lisp_Object arg, oldval;
{
if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
|| (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
|| (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
|| (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
{
FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
= (NILP (arg)
? vertical_scroll_bar_none
: EQ (Qright, arg)
? vertical_scroll_bar_right
: vertical_scroll_bar_left);
if (FRAME_X_WINDOW (f))
x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
do_pending_window_change (0);
}
}
void
x_set_scroll_bar_width (f, arg, oldval)
struct frame *f;
Lisp_Object arg, oldval;
{
int wid = FONT_WIDTH (f->output_data.x->font);
if (NILP (arg))
{
#ifdef USE_TOOLKIT_SCROLL_BARS
int width = 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM;
FRAME_SCROLL_BAR_COLS (f) = (width + wid - 1) / wid;
FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = width;
#else
FRAME_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid;
FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
#endif
if (FRAME_X_WINDOW (f))
x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
do_pending_window_change (0);
}
else if (INTEGERP (arg) && XINT (arg) > 0
&& XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
{
if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
if (FRAME_X_WINDOW (f))
x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
}
change_frame_size (f, 0, FRAME_WIDTH (f), 0, 0, 0);
XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
}
static void
validate_x_resource_name ()
{
int len = 0;
int good_count = 0;
int bad_count = 0;
Lisp_Object new;
int i;
if (!STRINGP (Vx_resource_class))
Vx_resource_class = build_string (EMACS_CLASS);
if (STRINGP (Vx_resource_name))
{
unsigned char *p = XSTRING (Vx_resource_name)->data;
int i;
len = STRING_BYTES (XSTRING (Vx_resource_name));
for (i = 0; i < len; i++)
{
int c = p[i];
if (! ((c >= 'a' && c <= 'z')
|| (c >= 'A' && c <= 'Z')
|| (c >= '0' && c <= '9')
|| c == '-' || c == '_'))
bad_count++;
else
good_count++;
}
}
else
bad_count = 5, good_count = 0;
if (bad_count == 0)
return;
if (good_count == 0
|| (good_count == 1 && bad_count > 0))
{
Vx_resource_name = build_string ("emacs");
return;
}
Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
for (i = 0; i < len; i++)
{
int c = XSTRING (new)->data[i];
if (! ((c >= 'a' && c <= 'z')
|| (c >= 'A' && c <= 'Z')
|| (c >= '0' && c <= '9')
|| c == '-' || c == '_'))
XSTRING (new)->data[i] = '_';
}
}
extern char *x_get_string_resource ();
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, 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\
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;
check_x ();
CHECK_STRING (attribute, 0);
CHECK_STRING (class, 0);
if (!NILP (component))
CHECK_STRING (component, 1);
if (!NILP (subclass))
CHECK_STRING (subclass, 2);
if (NILP (component) != NILP (subclass))
error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
validate_x_resource_name ();
name_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name))
+ (STRINGP (component)
? STRING_BYTES (XSTRING (component)) : 0)
+ STRING_BYTES (XSTRING (attribute))
+ 3);
class_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class))
+ STRING_BYTES (XSTRING (class))
+ (STRINGP (subclass)
? STRING_BYTES (XSTRING (subclass)) : 0)
+ 3);
strcpy (name_key, XSTRING (Vx_resource_name)->data);
strcpy (class_key, XSTRING (Vx_resource_class)->data);
strcat (class_key, ".");
strcat (class_key, XSTRING (class)->data);
if (!NILP (component))
{
strcat (class_key, ".");
strcat (class_key, XSTRING (subclass)->data);
strcat (name_key, ".");
strcat (name_key, XSTRING (component)->data);
}
strcat (name_key, ".");
strcat (name_key, XSTRING (attribute)->data);
value = x_get_string_resource (check_x_display_info (Qnil)->xrdb,
name_key, class_key);
if (value != (char *) 0)
return build_string (value);
else
return Qnil;
}
Lisp_Object
display_x_get_resource (dpyinfo, attribute, class, component, subclass)
struct x_display_info *dpyinfo;
Lisp_Object attribute, class, component, subclass;
{
register char *value;
char *name_key;
char *class_key;
CHECK_STRING (attribute, 0);
CHECK_STRING (class, 0);
if (!NILP (component))
CHECK_STRING (component, 1);
if (!NILP (subclass))
CHECK_STRING (subclass, 2);
if (NILP (component) != NILP (subclass))
error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
validate_x_resource_name ();
name_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name))
+ (STRINGP (component)
? STRING_BYTES (XSTRING (component)) : 0)
+ STRING_BYTES (XSTRING (attribute))
+ 3);
class_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class))
+ STRING_BYTES (XSTRING (class))
+ (STRINGP (subclass)
? STRING_BYTES (XSTRING (subclass)) : 0)
+ 3);
strcpy (name_key, XSTRING (Vx_resource_name)->data);
strcpy (class_key, XSTRING (Vx_resource_class)->data);
strcat (class_key, ".");
strcat (class_key, XSTRING (class)->data);
if (!NILP (component))
{
strcat (class_key, ".");
strcat (class_key, XSTRING (subclass)->data);
strcat (name_key, ".");
strcat (name_key, XSTRING (component)->data);
}
strcat (name_key, ".");
strcat (name_key, XSTRING (attribute)->data);
value = x_get_string_resource (dpyinfo->xrdb, name_key, class_key);
if (value != (char *) 0)
return build_string (value);
else
return Qnil;
}
char *
x_get_resource_string (attribute, class)
char *attribute, *class;
{
char *name_key;
char *class_key;
struct frame *sf = SELECTED_FRAME ();
name_key = (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name))
+ 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 (FRAME_X_DISPLAY_INFO (sf)->xrdb,
name_key, class_key);
}
enum resource_types
{
RES_TYPE_NUMBER,
RES_TYPE_FLOAT,
RES_TYPE_BOOLEAN,
RES_TYPE_STRING,
RES_TYPE_SYMBOL
};
static Lisp_Object
x_get_arg (dpyinfo, alist, param, attribute, class, type)
struct x_display_info *dpyinfo;
Lisp_Object alist, param;
char *attribute;
char *class;
enum resource_types type;
{
register Lisp_Object tem;
tem = Fassq (param, alist);
if (EQ (tem, Qnil))
tem = Fassq (param, Vdefault_frame_alist);
if (EQ (tem, Qnil))
{
if (attribute)
{
tem = display_x_get_resource (dpyinfo,
build_string (attribute),
build_string (class),
Qnil, Qnil);
if (NILP (tem))
return Qunbound;
switch (type)
{
case RES_TYPE_NUMBER:
return make_number (atoi (XSTRING (tem)->data));
case RES_TYPE_FLOAT:
return make_float (atof (XSTRING (tem)->data));
case RES_TYPE_BOOLEAN:
tem = Fdowncase (tem);
if (!strcmp (XSTRING (tem)->data, "on")
|| !strcmp (XSTRING (tem)->data, "true"))
return Qt;
else
return Qnil;
case RES_TYPE_STRING:
return tem;
case RES_TYPE_SYMBOL:
{
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 ();
}
}
else
return Qunbound;
}
return Fcdr (tem);
}
static Lisp_Object
x_get_and_record_arg (f, alist, param, attribute, class, type)
struct frame *f;
Lisp_Object alist, param;
char *attribute;
char *class;
enum resource_types type;
{
Lisp_Object value;
value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
attribute, class, type);
if (! NILP (value))
store_frame_param (f, param, value);
return value;
}
static Lisp_Object
x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
struct frame *f;
Lisp_Object alist;
Lisp_Object prop;
Lisp_Object deflt;
char *xprop;
char *xclass;
enum resource_types type;
{
Lisp_Object tem;
tem = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, prop, xprop, xclass, type);
if (EQ (tem, Qunbound))
tem = deflt;
x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
return tem;
}
static Lisp_Object
x_default_scroll_bar_color_parameter (f, alist, prop, xprop, xclass,
foreground_p)
struct frame *f;
Lisp_Object alist;
Lisp_Object prop;
char *xprop;
char *xclass;
int foreground_p;
{
struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
Lisp_Object tem;
tem = x_get_arg (dpyinfo, alist, prop, xprop, xclass, RES_TYPE_STRING);
if (EQ (tem, Qunbound))
{
#ifdef USE_TOOLKIT_SCROLL_BARS
tem = display_x_get_resource (dpyinfo,
build_string (foreground_p
? "foreground"
: "background"),
build_string (""),
build_string ("verticalScrollBar"),
build_string (""));
if (!STRINGP (tem))
{
tem = Qnil;
}
#else
tem = Qnil;
#endif
}
x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
return tem;
}
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) ... ).\n\
The properties returned may include `top', `left', `height', and `width'.\n\
The value of `left' or `top' may be an integer,\n\
or a list (+ N) meaning N pixels relative to top/left corner,\n\
or a list (- N) meaning -N pixels relative to bottom/right corner.")
(string)
Lisp_Object string;
{
int geometry, x, y;
unsigned int width, height;
Lisp_Object result;
CHECK_STRING (string, 0);
geometry = XParseGeometry ((char *) XSTRING (string)->data,
&x, &y, &width, &height);
#if 0
if (!!(geometry & XValue) != !!(geometry & YValue))
error ("Must specify both x and y position, or neither");
#endif
result = Qnil;
if (geometry & XValue)
{
Lisp_Object element;
if (x >= 0 && (geometry & XNegative))
element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
else if (x < 0 && ! (geometry & XNegative))
element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
else
element = Fcons (Qleft, make_number (x));
result = Fcons (element, result);
}
if (geometry & YValue)
{
Lisp_Object element;
if (y >= 0 && (geometry & YNegative))
element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
else if (y < 0 && ! (geometry & YNegative))
element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
else
element = Fcons (Qtop, make_number (y));
result = Fcons (element, result);
}
if (geometry & WidthValue)
result = Fcons (Fcons (Qwidth, make_number (width)), result);
if (geometry & HeightValue)
result = Fcons (Fcons (Qheight, make_number (height)), result);
return result;
}
#define DEFAULT_ROWS 40
#define DEFAULT_COLS 80
static int
x_figure_window_size (f, parms)
struct frame *f;
Lisp_Object parms;
{
register Lisp_Object tem0, tem1, tem2;
long window_prompting = 0;
struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
SET_FRAME_WIDTH (f, DEFAULT_COLS);
f->height = DEFAULT_ROWS;
f->output_data.x->top_pos = 0;
f->output_data.x->left_pos = 0;
tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
{
if (!EQ (tem0, Qunbound))
{
CHECK_NUMBER (tem0, 0);
f->height = XINT (tem0);
}
if (!EQ (tem1, Qunbound))
{
CHECK_NUMBER (tem1, 0);
SET_FRAME_WIDTH (f, XINT (tem1));
}
if (!NILP (tem2) && !EQ (tem2, Qunbound))
window_prompting |= USSize;
else
window_prompting |= PSize;
}
f->output_data.x->vertical_scroll_bar_extra
= (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
? 0
: (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.x->font)));
f->output_data.x->flags_areas_extra
= FRAME_FLAGS_AREA_WIDTH (f);
f->output_data.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
f->output_data.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
{
if (EQ (tem0, Qminus))
{
f->output_data.x->top_pos = 0;
window_prompting |= YNegative;
}
else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
&& CONSP (XCDR (tem0))
&& INTEGERP (XCAR (XCDR (tem0))))
{
f->output_data.x->top_pos = - XINT (XCAR (XCDR (tem0)));
window_prompting |= YNegative;
}
else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
&& CONSP (XCDR (tem0))
&& INTEGERP (XCAR (XCDR (tem0))))
{
f->output_data.x->top_pos = XINT (XCAR (XCDR (tem0)));
}
else if (EQ (tem0, Qunbound))
f->output_data.x->top_pos = 0;
else
{
CHECK_NUMBER (tem0, 0);
f->output_data.x->top_pos = XINT (tem0);
if (f->output_data.x->top_pos < 0)
window_prompting |= YNegative;
}
if (EQ (tem1, Qminus))
{
f->output_data.x->left_pos = 0;
window_prompting |= XNegative;
}
else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
&& CONSP (XCDR (tem1))
&& INTEGERP (XCAR (XCDR (tem1))))
{
f->output_data.x->left_pos = - XINT (XCAR (XCDR (tem1)));
window_prompting |= XNegative;
}
else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
&& CONSP (XCDR (tem1))
&& INTEGERP (XCAR (XCDR (tem1))))
{
f->output_data.x->left_pos = XINT (XCAR (XCDR (tem1)));
}
else if (EQ (tem1, Qunbound))
f->output_data.x->left_pos = 0;
else
{
CHECK_NUMBER (tem1, 0);
f->output_data.x->left_pos = XINT (tem1);
if (f->output_data.x->left_pos < 0)
window_prompting |= XNegative;
}
if (!NILP (tem2) && ! EQ (tem2, Qunbound))
window_prompting |= USPosition;
else
window_prompting |= PPosition;
}
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
#ifdef USE_X_TOOLKIT
static void
hack_wm_protocols (f, widget)
FRAME_PTR f;
Widget widget;
{
Display *dpy = XtDisplay (widget);
Window w = XtWindow (widget);
int need_delete = 1;
int need_focus = 1;
int need_save = 1;
BLOCK_INPUT;
{
Atom type, *atoms = 0;
int format = 0;
unsigned long nitems = 0;
unsigned long bytes_after;
if ((XGetWindowProperty (dpy, w,
FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
(long)0, (long)100, False, XA_ATOM,
&type, &format, &nitems, &bytes_after,
(unsigned char **) &atoms)
== Success)
&& format == 32 && type == XA_ATOM)
while (nitems > 0)
{
nitems--;
if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window)
need_delete = 0;
else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus)
need_focus = 0;
else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
need_save = 0;
}
if (atoms) XFree ((char *) atoms);
}
{
Atom props [10];
int count = 0;
if (need_delete)
props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
if (need_focus)
props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus;
if (need_save)
props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
if (count)
XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
XA_ATOM, 32, PropModeAppend,
(unsigned char *) props, count);
}
UNBLOCK_INPUT;
}
#endif
#ifdef HAVE_X_I18N
static XFontSet xic_create_xfontset P_ ((struct frame *, char *));
static XIMStyle best_xim_style P_ ((XIMStyles *, XIMStyles *));
static XIMStyle supported_xim_styles[] =
{
XIMPreeditPosition | XIMStatusArea,
XIMPreeditPosition | XIMStatusNothing,
XIMPreeditPosition | XIMStatusNone,
XIMPreeditNothing | XIMStatusArea,
XIMPreeditNothing | XIMStatusNothing,
XIMPreeditNothing | XIMStatusNone,
XIMPreeditNone | XIMStatusArea,
XIMPreeditNone | XIMStatusNothing,
XIMPreeditNone | XIMStatusNone,
0,
};
static XFontSet
xic_create_xfontset (f, base_fontname)
struct frame *f;
char *base_fontname;
{
XFontSet xfs;
char **missing_list;
int missing_count;
char *def_string;
xfs = XCreateFontSet (FRAME_X_DISPLAY (f),
base_fontname, &missing_list,
&missing_count, &def_string);
if (missing_list)
XFreeStringList (missing_list);
return xfs;
}
static XIMStyle
best_xim_style (user, xim)
XIMStyles *user;
XIMStyles *xim;
{
int i, j;
for (i = 0; i < user->count_styles; ++i)
for (j = 0; j < xim->count_styles; ++j)
if (user->supported_styles[i] == xim->supported_styles[j])
return user->supported_styles[i];
return XIMPreeditNothing | XIMStatusNothing;
}
static XIMStyle xic_style;
void
create_frame_xic (f)
struct frame *f;
{
XIM xim;
XIC xic = NULL;
XFontSet xfs = NULL;
if (FRAME_XIC (f))
return;
xim = FRAME_X_XIM (f);
if (xim)
{
XRectangle s_area;
XPoint spot;
XVaNestedList preedit_attr;
XVaNestedList status_attr;
char *base_fontname;
int fontset;
s_area.x = 0; s_area.y = 0; s_area.width = 1; s_area.height = 1;
spot.x = 0; spot.y = 1;
fontset = FRAME_FONTSET (f);
if (fontset < 0)
base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
else
{
char *ascii_font = (char *) XSTRING (fontset_ascii (fontset))->data;
char *p = ascii_font;
int i;
for (i = 0; *p; p++)
if (*p == '-') i++;
if (i != 14)
base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
else
{
int len = strlen (ascii_font) + 1;
char *p1 = NULL;
for (i = 0, p = ascii_font; i < 8; p++)
{
if (*p == '-')
{
i++;
if (i == 3)
p1 = p + 1;
}
}
base_fontname = (char *) alloca (len);
bzero (base_fontname, len);
strcpy (base_fontname, "-*-*-");
bcopy (p1, base_fontname + 5, p - p1);
strcat (base_fontname, "*-*-*-*-*-*-*");
}
}
xfs = xic_create_xfontset (f, base_fontname);
if (xic_style == 0)
{
XIMStyles supported_list;
supported_list.count_styles = (sizeof supported_xim_styles
/ sizeof supported_xim_styles[0]);
supported_list.supported_styles = supported_xim_styles;
xic_style = best_xim_style (&supported_list,
FRAME_X_XIM_STYLES (f));
}
preedit_attr = XVaCreateNestedList (0,
XNFontSet, xfs,
XNForeground,
FRAME_FOREGROUND_PIXEL (f),
XNBackground,
FRAME_BACKGROUND_PIXEL (f),
(xic_style & XIMPreeditPosition
? XNSpotLocation
: NULL),
&spot,
NULL);
status_attr = XVaCreateNestedList (0,
XNArea,
&s_area,
XNFontSet,
xfs,
XNForeground,
FRAME_FOREGROUND_PIXEL (f),
XNBackground,
FRAME_BACKGROUND_PIXEL (f),
NULL);
xic = XCreateIC (xim,
XNInputStyle, xic_style,
XNClientWindow, FRAME_X_WINDOW(f),
XNFocusWindow, FRAME_X_WINDOW(f),
XNStatusAttributes, status_attr,
XNPreeditAttributes, preedit_attr,
NULL);
XFree (preedit_attr);
XFree (status_attr);
}
FRAME_XIC (f) = xic;
FRAME_XIC_STYLE (f) = xic_style;
FRAME_XIC_FONTSET (f) = xfs;
}
void
free_frame_xic (f)
struct frame *f;
{
if (FRAME_XIC (f) == NULL)
return;
XDestroyIC (FRAME_XIC (f));
if (FRAME_XIC_FONTSET (f))
XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
FRAME_XIC (f) = NULL;
FRAME_XIC_FONTSET (f) = NULL;
}
void
xic_set_preeditarea (w, x, y)
struct window *w;
int x, y;
{
struct frame *f = XFRAME (w->frame);
XVaNestedList attr;
XPoint spot;
spot.x = WINDOW_TO_FRAME_PIXEL_X (w, x);
spot.y = WINDOW_TO_FRAME_PIXEL_Y (w, y) + FONT_BASE (FRAME_FONT (f));
attr = XVaCreateNestedList (0, XNSpotLocation, &spot, NULL);
XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
XFree (attr);
}
void
xic_set_statusarea (f)
struct frame *f;
{
XIC xic = FRAME_XIC (f);
XVaNestedList attr;
XRectangle area;
XRectangle *needed;
area.x = area.y = area.width = area.height = 0;
attr = XVaCreateNestedList (0, XNAreaNeeded, &area, NULL);
XSetICValues (xic, XNStatusAttributes, attr, NULL);
XFree (attr);
attr = XVaCreateNestedList (0, XNAreaNeeded, &needed, NULL);
XGetICValues (xic, XNStatusAttributes, attr, NULL);
XFree (attr);
if (needed->width == 0)
{
attr = XVaCreateNestedList (0, XNArea, &needed, NULL);
XGetICValues (xic, XNStatusAttributes, attr, NULL);
XFree (attr);
}
area.width = needed->width;
area.height = needed->height;
area.x = PIXEL_WIDTH (f) - area.width - FRAME_INTERNAL_BORDER_WIDTH (f);
area.y = (PIXEL_HEIGHT (f) - area.height
- FRAME_MENUBAR_HEIGHT (f) - FRAME_INTERNAL_BORDER_WIDTH (f));
XFree (needed);
attr = XVaCreateNestedList (0, XNArea, &area, NULL);
XSetICValues(xic, XNStatusAttributes, attr, NULL);
XFree (attr);
}
void
xic_set_xfontset (f, base_fontname)
struct frame *f;
char *base_fontname;
{
XVaNestedList attr;
XFontSet xfs;
xfs = xic_create_xfontset (f, base_fontname);
attr = XVaCreateNestedList (0, XNFontSet, xfs, NULL);
if (FRAME_XIC_STYLE (f) & XIMPreeditPosition)
XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
if (FRAME_XIC_STYLE (f) & XIMStatusArea)
XSetICValues (FRAME_XIC (f), XNStatusAttributes, attr, NULL);
XFree (attr);
if (FRAME_XIC_FONTSET (f))
XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
FRAME_XIC_FONTSET (f) = xfs;
}
#endif
#ifdef USE_X_TOOLKIT
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 frame_widget;
Arg al [25];
int ac;
BLOCK_INPUT;
{
char *str = (char *) XSTRING (Vx_resource_name)->data;
f->namebuf = (char *) xmalloc (strlen (str) + 1);
strcpy (f->namebuf, str);
}
ac = 0;
XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
XtSetArg (al[ac], XtNinput, 1); ac++;
XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
XtSetArg (al[ac], XtNborderWidth, f->output_data.x->border_width); ac++;
XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
shell_widget = XtAppCreateShell (f->namebuf, EMACS_CLASS,
applicationShellWidgetClass,
FRAME_X_DISPLAY (f), al, ac);
f->output_data.x->widget = shell_widget;
pane_widget = lw_create_widget ("main", "pane", widget_id_tick++,
(widget_value *) NULL,
shell_widget, False,
(lw_callback) NULL,
(lw_callback) NULL,
(lw_callback) NULL,
(lw_callback) NULL);
ac = 0;
XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
XtSetValues (pane_widget, al, ac);
f->output_data.x->column_widget = pane_widget;
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++;
XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
frame_widget = XtCreateWidget (f->namebuf, emacsFrameClass, pane_widget,
al, ac);
f->output_data.x->edit_widget = frame_widget;
XtManageChild (frame_widget);
{
int len;
char *tem, shell_position[32];
Arg al[2];
int ac = 0;
int extra_borders = 0;
int menubar_size
= (f->output_data.x->menubar_widget
? (f->output_data.x->menubar_widget->core.height
+ f->output_data.x->menubar_widget->core.border_width)
: 0);
#if 0
if (FRAME_EXTERNAL_MENU_BAR (f))
{
Dimension ibw = 0;
XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
menubar_size += ibw;
}
#endif
f->output_data.x->menubar_height = menubar_size;
#ifndef USE_LUCID
XtVaGetValues (f->output_data.x->edit_widget, XtNinternalBorderWidth,
&extra_borders, NULL);
extra_borders *= 2;
#endif
{
int left = f->output_data.x->left_pos;
int xneg = window_prompting & XNegative;
int top = f->output_data.x->top_pos;
int yneg = window_prompting & YNegative;
if (xneg)
left = -left;
if (yneg)
top = -top;
if (window_prompting & USPosition)
sprintf (shell_position, "=%dx%d%c%d%c%d",
PIXEL_WIDTH (f) + extra_borders,
PIXEL_HEIGHT (f) + menubar_size + extra_borders,
(xneg ? '-' : '+'), left,
(yneg ? '-' : '+'), top);
else
sprintf (shell_position, "=%dx%d",
PIXEL_WIDTH (f) + extra_borders,
PIXEL_HEIGHT (f) + menubar_size + extra_borders);
}
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);
}
XtManageChild (pane_widget);
XtRealizeWidget (shell_widget);
FRAME_X_WINDOW (f) = XtWindow (frame_widget);
validate_x_resource_name ();
class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
class_hints.res_class = (char *) XSTRING (Vx_resource_class)->data;
XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
#ifdef HAVE_X_I18N
FRAME_XIC (f) = NULL;
#ifdef USE_XIM
create_frame_xic (f);
#endif
#endif
f->output_data.x->wm_hints.input = True;
f->output_data.x->wm_hints.flags |= InputHint;
XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
&f->output_data.x->wm_hints);
hack_wm_protocols (f, shell_widget);
#ifdef HACK_EDITRES
XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
#endif
XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
XA_ATOM, 32, PropModeAppend,
(unsigned char*) NULL, 0);
attributes.event_mask = STANDARD_EVENT_SET;
#ifdef HAVE_X_I18N
if (FRAME_XIC (f))
{
unsigned long fevent = NoEventMask;
XGetICValues(FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
attributes.event_mask |= fevent;
}
#endif
attribute_mask = CWEventMask;
XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
attribute_mask, &attributes);
XtMapWidget (frame_widget);
{
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 (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
f->output_data.x->text_cursor);
UNBLOCK_INPUT;
lw_set_main_areas (pane_widget, 0, frame_widget);
}
#else
void
x_window (f)
struct frame *f;
{
XClassHint class_hints;
XSetWindowAttributes attributes;
unsigned long attribute_mask;
attributes.background_pixel = f->output_data.x->background_pixel;
attributes.border_pixel = f->output_data.x->border_pixel;
attributes.bit_gravity = StaticGravity;
attributes.backing_store = NotUseful;
attributes.save_under = True;
attributes.event_mask = STANDARD_EVENT_SET;
attributes.colormap = FRAME_X_COLORMAP (f);
attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity | CWEventMask
| CWColormap);
BLOCK_INPUT;
FRAME_X_WINDOW (f)
= XCreateWindow (FRAME_X_DISPLAY (f),
f->output_data.x->parent_desc,
f->output_data.x->left_pos,
f->output_data.x->top_pos,
PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
f->output_data.x->border_width,
CopyFromParent,
InputOutput,
FRAME_X_VISUAL (f),
attribute_mask, &attributes);
#ifdef HAVE_X_I18N
#ifdef USE_XIM
create_frame_xic (f);
if (FRAME_XIC (f))
{
unsigned long fevent = NoEventMask;
XGetICValues(FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
attributes.event_mask |= fevent;
attribute_mask = CWEventMask;
XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
attribute_mask, &attributes);
}
#endif
#endif
validate_x_resource_name ();
class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
class_hints.res_class = (char *) XSTRING (Vx_resource_class)->data;
XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
f->output_data.x->menubar_height = 0;
f->output_data.x->wm_hints.input = True;
f->output_data.x->wm_hints.flags |= InputHint;
XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
&f->output_data.x->wm_hints);
f->output_data.x->wm_hints.icon_pixmap = None;
{
Atom protocols[2];
protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
}
{
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 (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
f->output_data.x->text_cursor);
UNBLOCK_INPUT;
if (FRAME_X_WINDOW (f) == 0)
error ("Unable to create window");
}
#endif
static void
x_icon (f, parms)
struct frame *f;
Lisp_Object parms;
{
Lisp_Object icon_x, icon_y;
struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
icon_x = x_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
icon_y = x_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
{
CHECK_NUMBER (icon_x, 0);
CHECK_NUMBER (icon_y, 0);
}
else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
error ("Both left and top icon corners of icon must be specified");
BLOCK_INPUT;
if (! EQ (icon_x, Qunbound))
x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
x_wm_set_window_state
(f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL),
Qicon)
? IconicState
: NormalState));
x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
? f->icon_name
: f->name))->data);
UNBLOCK_INPUT;
}
static char cursor_bits[] =
{
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
};
static void
x_make_gc (f)
struct frame *f;
{
XGCValues gc_values;
BLOCK_INPUT;
gc_values.font = f->output_data.x->font->fid;
gc_values.foreground = f->output_data.x->foreground_pixel;
gc_values.background = f->output_data.x->background_pixel;
gc_values.line_width = 0;
f->output_data.x->normal_gc
= XCreateGC (FRAME_X_DISPLAY (f),
FRAME_X_WINDOW (f),
GCLineWidth | GCFont | GCForeground | GCBackground,
&gc_values);
gc_values.foreground = f->output_data.x->background_pixel;
gc_values.background = f->output_data.x->foreground_pixel;
f->output_data.x->reverse_gc
= XCreateGC (FRAME_X_DISPLAY (f),
FRAME_X_WINDOW (f),
GCFont | GCForeground | GCBackground | GCLineWidth,
&gc_values);
gc_values.foreground = f->output_data.x->background_pixel;
gc_values.background = f->output_data.x->cursor_pixel;
gc_values.fill_style = FillOpaqueStippled;
gc_values.stipple
= XCreateBitmapFromData (FRAME_X_DISPLAY (f),
FRAME_X_DISPLAY_INFO (f)->root_window,
cursor_bits, 16, 16);
f->output_data.x->cursor_gc
= XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
(GCFont | GCForeground | GCBackground
| GCFillStyle | GCLineWidth),
&gc_values);
f->output_data.x->white_relief.gc = 0;
f->output_data.x->black_relief.gc = 0;
f->output_data.x->border_tile
= (XCreatePixmapFromBitmapData
(FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
gray_bits, gray_width, gray_height,
f->output_data.x->foreground_pixel,
f->output_data.x->background_pixel,
DefaultDepth (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f))));
UNBLOCK_INPUT;
}
void
x_free_gcs (f)
struct frame *f;
{
Display *dpy = FRAME_X_DISPLAY (f);
BLOCK_INPUT;
if (f->output_data.x->normal_gc)
{
XFreeGC (dpy, f->output_data.x->normal_gc);
f->output_data.x->normal_gc = 0;
}
if (f->output_data.x->reverse_gc)
{
XFreeGC (dpy, f->output_data.x->reverse_gc);
f->output_data.x->reverse_gc = 0;
}
if (f->output_data.x->cursor_gc)
{
XFreeGC (dpy, f->output_data.x->cursor_gc);
f->output_data.x->cursor_gc = 0;
}
if (f->output_data.x->border_tile)
{
XFreePixmap (dpy, f->output_data.x->border_tile);
f->output_data.x->border_tile = 0;
}
UNBLOCK_INPUT;
}
static Lisp_Object
unwind_create_frame (frame)
Lisp_Object frame;
{
struct frame *f = XFRAME (frame);
if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
{
#if GLYPH_DEBUG
struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
#endif
x_free_frame_resources (f);
xassert (dpyinfo->reference_count == dpyinfo_refcount);
xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
return Qt;
}
return Qnil;
}
DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1, 1, 0,
"Make a new X window, which is called a \"frame\" in Emacs terms.\n\
Returns an Emacs frame object.\n\
ALIST is an alist of frame parameters.\n\
If the parameters specify that the frame should not have a minibuffer,\n\
and do not specify a specific minibuffer window to use,\n\
then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
be shared by the new frame.\n\
\n\
This function is an internal primitive--use `make-frame' instead.")
(parms)
Lisp_Object parms;
{
struct frame *f;
Lisp_Object frame, tem;
Lisp_Object name;
int minibuffer_only = 0;
long window_prompting = 0;
int width, height;
int count = BINDING_STACK_SIZE ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Lisp_Object display;
struct x_display_info *dpyinfo = NULL;
Lisp_Object parent;
struct kboard *kb;
check_x ();
Vx_resource_name = Vinvocation_name;
display = x_get_arg (dpyinfo, parms, Qdisplay, 0, 0, RES_TYPE_STRING);
if (EQ (display, Qunbound))
display = Qnil;
dpyinfo = check_x_display_info (display);
#ifdef MULTI_KBOARD
kb = dpyinfo->kboard;
#else
kb = &the_only_kboard;
#endif
name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
if (!STRINGP (name)
&& ! EQ (name, Qunbound)
&& ! NILP (name))
error ("Invalid frame name--not a string or nil");
if (STRINGP (name))
Vx_resource_name = name;
parent = x_get_arg (dpyinfo, parms, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
if (EQ (parent, Qunbound))
parent = Qnil;
if (! NILP (parent))
CHECK_NUMBER (parent, 0);
frame = Qnil;
GCPRO4 (parms, parent, name, frame);
tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
RES_TYPE_SYMBOL);
if (EQ (tem, Qnone) || NILP (tem))
f = make_frame_without_minibuffer (Qnil, kb, display);
else if (EQ (tem, Qonly))
{
f = make_minibuffer_frame ();
minibuffer_only = 1;
}
else if (WINDOWP (tem))
f = make_frame_without_minibuffer (tem, kb, display);
else
f = make_frame (1);
XSETFRAME (frame, f);
FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
f->output_method = output_x_window;
f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
bzero (f->output_data.x, sizeof (struct x_output));
f->output_data.x->icon_bitmap = -1;
f->output_data.x->fontset = -1;
f->output_data.x->scroll_bar_foreground_pixel = -1;
f->output_data.x->scroll_bar_background_pixel = -1;
record_unwind_protect (unwind_create_frame, frame);
f->icon_name
= x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
RES_TYPE_STRING);
if (! STRINGP (f->icon_name))
f->icon_name = Qnil;
FRAME_X_DISPLAY_INFO (f) = dpyinfo;
#if GLYPH_DEBUG
image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
dpyinfo_refcount = dpyinfo->reference_count;
#endif
#ifdef MULTI_KBOARD
FRAME_KBOARD (f) = kb;
#endif
{
Lisp_Object black;
struct gcpro gcpro1;
f->output_data.x->foreground_pixel = -1;
f->output_data.x->background_pixel = -1;
f->output_data.x->cursor_pixel = -1;
f->output_data.x->cursor_foreground_pixel = -1;
f->output_data.x->border_pixel = -1;
f->output_data.x->mouse_pixel = -1;
black = build_string ("black");
GCPRO1 (black);
f->output_data.x->foreground_pixel
= x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
f->output_data.x->background_pixel
= x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
f->output_data.x->cursor_pixel
= x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
f->output_data.x->cursor_foreground_pixel
= x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
f->output_data.x->border_pixel
= x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
f->output_data.x->mouse_pixel
= x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
UNGCPRO;
}
if (!NILP (parent))
{
f->output_data.x->parent_desc = (Window) XFASTINT (parent);
f->output_data.x->explicit_parent = 1;
}
else
{
f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
f->output_data.x->explicit_parent = 0;
}
if (EQ (name, Qunbound) || NILP (name))
{
f->name = build_string (dpyinfo->x_id_name);
f->explicit_name = 0;
}
else
{
f->name = name;
f->explicit_name = 1;
specbind (Qx_resource_name, name);
}
{
Lisp_Object font;
font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
BLOCK_INPUT;
if (STRINGP (font))
{
tem = Fquery_fontset (font, Qnil);
if (STRINGP (tem))
font = x_new_fontset (f, XSTRING (tem)->data);
else
font = x_new_font (f, XSTRING (font)->data);
}
if (!STRINGP (font))
font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
if (!STRINGP (font))
font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
if (! STRINGP (font))
font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
if (! STRINGP (font))
font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
if (! STRINGP (font))
font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
UNBLOCK_INPUT;
if (! STRINGP (font))
font = build_string ("fixed");
x_default_parameter (f, parms, Qfont, font,
"font", "Font", RES_TYPE_STRING);
}
#ifdef USE_LUCID
xlwmenu_default_font = f->output_data.x->font;
#endif
x_default_parameter (f, parms, Qborder_width, make_number (2),
"borderWidth", "BorderWidth", RES_TYPE_NUMBER);
if (NILP (Fassq (Qinternal_border_width, parms)))
{
Lisp_Object value;
value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
"internalBorder", "internalBorder", RES_TYPE_NUMBER);
if (! EQ (value, Qunbound))
parms = Fcons (Fcons (Qinternal_border_width, value),
parms);
}
x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
"internalBorderWidth", "internalBorderWidth",
RES_TYPE_NUMBER);
x_default_parameter (f, parms, Qvertical_scroll_bars, Qleft,
"verticalScrollBars", "ScrollBars",
RES_TYPE_SYMBOL);
x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
"foreground", "Foreground", RES_TYPE_STRING);
x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
"background", "Background", RES_TYPE_STRING);
x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
"pointerColor", "Foreground", RES_TYPE_STRING);
x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
"cursorColor", "Foreground", RES_TYPE_STRING);
x_default_parameter (f, parms, Qborder_color, build_string ("black"),
"borderColor", "BorderColor", RES_TYPE_STRING);
x_default_parameter (f, parms, Qscreen_gamma, Qnil,
"screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
x_default_parameter (f, parms, Qline_spacing, Qnil,
"lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_foreground,
"scrollBarForeground",
"ScrollBarForeground", 1);
x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_background,
"scrollBarBackground",
"ScrollBarBackground", 0);
init_frame_faces (f);
x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
"menuBar", "MenuBar", RES_TYPE_NUMBER);
x_default_parameter (f, parms, Qtool_bar_lines, make_number (1),
"toolBar", "ToolBar", RES_TYPE_NUMBER);
x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
"bufferPredicate", "BufferPredicate",
RES_TYPE_SYMBOL);
x_default_parameter (f, parms, Qtitle, Qnil,
"title", "Title", RES_TYPE_STRING);
x_default_parameter (f, parms, Qwait_for_wm, Qt,
"waitForWM", "WaitForWM", RES_TYPE_BOOLEAN);
f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
if (FRAME_TOOL_BAR_LINES (f))
{
int margin, relief, bar_height;
relief = (tool_bar_button_relief > 0
? tool_bar_button_relief
: DEFAULT_TOOL_BAR_BUTTON_RELIEF);
if (INTEGERP (Vtool_bar_button_margin)
&& XINT (Vtool_bar_button_margin) > 0)
margin = XFASTINT (Vtool_bar_button_margin);
else if (CONSP (Vtool_bar_button_margin)
&& INTEGERP (XCDR (Vtool_bar_button_margin))
&& XINT (XCDR (Vtool_bar_button_margin)) > 0)
margin = XFASTINT (XCDR (Vtool_bar_button_margin));
else
margin = 0;
bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
f->height += (bar_height + CANON_Y_UNIT (f) - 1) / CANON_Y_UNIT (f);
}
window_prompting = x_figure_window_size (f, parms);
if (window_prompting & XNegative)
{
if (window_prompting & YNegative)
f->output_data.x->win_gravity = SouthEastGravity;
else
f->output_data.x->win_gravity = NorthEastGravity;
}
else
{
if (window_prompting & YNegative)
f->output_data.x->win_gravity = SouthWestGravity;
else
f->output_data.x->win_gravity = NorthWestGravity;
}
f->output_data.x->size_hint_flags = window_prompting;
tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
f->no_split = minibuffer_only || EQ (tem, Qt);
#ifdef USE_X_TOOLKIT
x_window (f, window_prompting, minibuffer_only);
#else
x_window (f);
#endif
x_icon (f, parms);
x_make_gc (f);
FRAME_X_DISPLAY_INFO (f)->reference_count++;
Vframe_list = Fcons (frame, Vframe_list);
x_default_parameter (f, parms, Qicon_type, Qnil,
"bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
x_default_parameter (f, parms, Qauto_raise, Qnil,
"autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
x_default_parameter (f, parms, Qauto_lower, Qnil,
"autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
x_default_parameter (f, parms, Qcursor_type, Qbox,
"cursorType", "CursorType", RES_TYPE_SYMBOL);
x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
"scrollBarWidth", "ScrollBarWidth",
RES_TYPE_NUMBER);
width = f->width;
height = f->height;
f->height = 0;
SET_FRAME_WIDTH (f, 0);
change_frame_size (f, height, width, 1, 0, 0);
call1 (Qface_set_after_frame_default, frame);
#ifdef USE_X_TOOLKIT
if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
{
initialize_frame_menubar (f);
lw_set_main_areas (f->output_data.x->column_widget,
f->output_data.x->menubar_widget,
f->output_data.x->edit_widget);
}
#endif
BLOCK_INPUT;
x_wm_set_size_hint (f, window_prompting, 0);
UNBLOCK_INPUT;
if (! f->output_data.x->explicit_parent)
{
Lisp_Object visibility;
visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
RES_TYPE_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
;
}
UNGCPRO;
Vwindow_list = Qnil;
return unbind_to (count, frame);
}
Lisp_Object
x_get_focus_frame (frame)
struct frame *frame;
{
struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
Lisp_Object xfocus;
if (! dpyinfo->x_focus_frame)
return Qnil;
XSETFRAME (xfocus, dpyinfo->x_focus_frame);
return xfocus;
}
DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
"Set the input focus to FRAME.\n\
FRAME nil means use the selected frame.")
(frame)
Lisp_Object frame;
{
struct frame *f = check_x_frame (frame);
Display *dpy = FRAME_X_DISPLAY (f);
int count;
BLOCK_INPUT;
count = x_catch_errors (dpy);
XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
RevertToParent, CurrentTime);
x_uncatch_errors (dpy, count);
UNBLOCK_INPUT;
return Qnil;
}
DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
"Internal function called by `color-defined-p', which see.")
(color, frame)
Lisp_Object color, frame;
{
XColor foo;
FRAME_PTR f = check_x_frame (frame);
CHECK_STRING (color, 1);
if (x_defined_color (f, XSTRING (color)->data, &foo, 0))
return Qt;
else
return Qnil;
}
DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
"Internal function called by `color-values', which see.")
(color, frame)
Lisp_Object color, frame;
{
XColor foo;
FRAME_PTR f = check_x_frame (frame);
CHECK_STRING (color, 1);
if (x_defined_color (f, XSTRING (color)->data, &foo, 0))
{
Lisp_Object rgb[3];
rgb[0] = make_number (foo.red);
rgb[1] = make_number (foo.green);
rgb[2] = make_number (foo.blue);
return Flist (3, rgb);
}
else
return Qnil;
}
DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
"Internal function called by `display-color-p', which see.")
(display)
Lisp_Object display;
{
struct x_display_info *dpyinfo = check_x_display_info (display);
if (dpyinfo->n_planes <= 2)
return Qnil;
switch (dpyinfo->visual->class)
{
case StaticColor:
case PseudoColor:
case TrueColor:
case DirectColor:
return Qt;
default:
return Qnil;
}
}
DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
0, 1, 0,
"Return t if the X display supports shades of gray.\n\
Note that color displays do support shades of gray.\n\
The optional argument DISPLAY specifies which display to ask about.\n\
DISPLAY should be either a frame or a display name (a string).\n\
If omitted or nil, that stands for the selected frame's display.")
(display)
Lisp_Object display;
{
struct x_display_info *dpyinfo = check_x_display_info (display);
if (dpyinfo->n_planes <= 1)
return Qnil;
switch (dpyinfo->visual->class)
{
case StaticColor:
case PseudoColor:
case TrueColor:
case DirectColor:
case StaticGray:
case GrayScale:
return Qt;
default:
return Qnil;
}
}
DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
0, 1, 0,
"Returns the width in pixels of the X display DISPLAY.\n\
The optional argument DISPLAY specifies which display to ask about.\n\
DISPLAY should be either a frame or a display name (a string).\n\
If omitted or nil, that stands for the selected frame's display.")
(display)
Lisp_Object display;
{
struct x_display_info *dpyinfo = check_x_display_info (display);
return make_number (dpyinfo->width);
}
DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
Sx_display_pixel_height, 0, 1, 0,
"Returns the height in pixels of the X display DISPLAY.\n\
The optional argument DISPLAY specifies which display to ask about.\n\
DISPLAY should be either a frame or a display name (a string).\n\
If omitted or nil, that stands for the selected frame's display.")
(display)
Lisp_Object display;
{
struct x_display_info *dpyinfo = check_x_display_info (display);
return make_number (dpyinfo->height);
}
DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
0, 1, 0,
"Returns the number of bitplanes of the X display DISPLAY.\n\
The optional argument DISPLAY specifies which display to ask about.\n\
DISPLAY should be either a frame or a display name (a string).\n\
If omitted or nil, that stands for the selected frame's display.")
(display)
Lisp_Object display;
{
struct x_display_info *dpyinfo = check_x_display_info (display);
return make_number (dpyinfo->n_planes);
}
DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
0, 1, 0,
"Returns the number of color cells of the X display DISPLAY.\n\
The optional argument DISPLAY specifies which display to ask about.\n\
DISPLAY should be either a frame or a display name (a string).\n\
If omitted or nil, that stands for the selected frame's display.")
(display)
Lisp_Object display;
{
struct x_display_info *dpyinfo = check_x_display_info (display);
return make_number (DisplayCells (dpyinfo->display,
XScreenNumberOfScreen (dpyinfo->screen)));
}
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 of display DISPLAY.\n\
The optional argument DISPLAY specifies which display to ask about.\n\
DISPLAY should be either a frame or a display name (a string).\n\
If omitted or nil, that stands for the selected frame's display.")
(display)
Lisp_Object display;
{
struct x_display_info *dpyinfo = check_x_display_info (display);
return make_number (MAXREQUEST (dpyinfo->display));
}
DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
"Returns the vendor ID string of the X server of display DISPLAY.\n\
The optional argument DISPLAY specifies which display to ask about.\n\
DISPLAY should be either a frame or a display name (a string).\n\
If omitted or nil, that stands for the selected frame's display.")
(display)
Lisp_Object display;
{
struct x_display_info *dpyinfo = check_x_display_info (display);
char *vendor = ServerVendor (dpyinfo->display);
if (! vendor) vendor = "";
return build_string (vendor);
}
DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
"Returns the version numbers of the X server of display DISPLAY.\n\
The value is a list of three integers: the major and minor\n\
version numbers of the X Protocol in use, and the vendor-specific release\n\
number. See also the function `x-server-vendor'.\n\n\
The optional argument DISPLAY specifies which display to ask about.\n\
DISPLAY should be either a frame or a display name (a string).\n\
If omitted or nil, that stands for the selected frame's display.")
(display)
Lisp_Object display;
{
struct x_display_info *dpyinfo = check_x_display_info (display);
Display *dpy = dpyinfo->display;
return Fcons (make_number (ProtocolVersion (dpy)),
Fcons (make_number (ProtocolRevision (dpy)),
Fcons (make_number (VendorRelease (dpy)), Qnil)));
}
DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
"Returns the number of screens on the X server of display DISPLAY.\n\
The optional argument DISPLAY specifies which display to ask about.\n\
DISPLAY should be either a frame or a display name (a string).\n\
If omitted or nil, that stands for the selected frame's display.")
(display)
Lisp_Object display;
{
struct x_display_info *dpyinfo = check_x_display_info (display);
return make_number (ScreenCount (dpyinfo->display));
}
DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
"Returns the height in millimeters of the X display DISPLAY.\n\
The optional argument DISPLAY specifies which display to ask about.\n\
DISPLAY should be either a frame or a display name (a string).\n\
If omitted or nil, that stands for the selected frame's display.")
(display)
Lisp_Object display;
{
struct x_display_info *dpyinfo = check_x_display_info (display);
return make_number (HeightMMOfScreen (dpyinfo->screen));
}
DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
"Returns the width in millimeters of the X display DISPLAY.\n\
The optional argument DISPLAY specifies which display to ask about.\n\
DISPLAY should be either a frame or a display name (a string).\n\
If omitted or nil, that stands for the selected frame's display.")
(display)
Lisp_Object display;
{
struct x_display_info *dpyinfo = check_x_display_info (display);
return make_number (WidthMMOfScreen (dpyinfo->screen));
}
DEFUN ("x-display-backing-store", Fx_display_backing_store,
Sx_display_backing_store, 0, 1, 0,
"Returns an indication of whether X display DISPLAY does backing store.\n\
The value may be `always', `when-mapped', or `not-useful'.\n\
The optional argument DISPLAY specifies which display to ask about.\n\
DISPLAY should be either a frame or a display name (a string).\n\
If omitted or nil, that stands for the selected frame's display.")
(display)
Lisp_Object display;
{
struct x_display_info *dpyinfo = check_x_display_info (display);
Lisp_Object result;
switch (DoesBackingStore (dpyinfo->screen))
{
case Always:
result = intern ("always");
break;
case WhenMapped:
result = intern ("when-mapped");
break;
case NotUseful:
result = intern ("not-useful");
break;
default:
error ("Strange value for BackingStore parameter of screen");
result = Qnil;
}
return result;
}
DEFUN ("x-display-visual-class", Fx_display_visual_class,
Sx_display_visual_class, 0, 1, 0,
"Returns the visual class of the X display DISPLAY.\n\
The value is one of the symbols `static-gray', `gray-scale',\n\
`static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
The optional argument DISPLAY specifies which display to ask about.\n\
DISPLAY should be either a frame or a display name (a string).\n\
If omitted or nil, that stands for the selected frame's display.")
(display)
Lisp_Object display;
{
struct x_display_info *dpyinfo = check_x_display_info (display);
Lisp_Object result;
switch (dpyinfo->visual->class)
{
case StaticGray:
result = intern ("static-gray");
break;
case GrayScale:
result = intern ("gray-scale");
break;
case StaticColor:
result = intern ("static-color");
break;
case PseudoColor:
result = intern ("pseudo-color");
break;
case TrueColor:
result = intern ("true-color");
break;
case DirectColor:
result = intern ("direct-color");
break;
default:
error ("Display has an unknown visual class");
result = Qnil;
}
return result;
}
DEFUN ("x-display-save-under", Fx_display_save_under,
Sx_display_save_under, 0, 1, 0,
"Returns t if the X display DISPLAY supports the save-under feature.\n\
The optional argument DISPLAY specifies which display to ask about.\n\
DISPLAY should be either a frame or a display name (a string).\n\
If omitted or nil, that stands for the selected frame's display.")
(display)
Lisp_Object display;
{
struct x_display_info *dpyinfo = check_x_display_info (display);
if (DoesSaveUnders (dpyinfo->screen) == True)
return Qt;
else
return Qnil;
}
int
x_pixel_width (f)
register struct frame *f;
{
return PIXEL_WIDTH (f);
}
int
x_pixel_height (f)
register struct frame *f;
{
return PIXEL_HEIGHT (f);
}
int
x_char_width (f)
register struct frame *f;
{
return FONT_WIDTH (f->output_data.x->font);
}
int
x_char_height (f)
register struct frame *f;
{
return f->output_data.x->line_height;
}
int
x_screen_planes (f)
register struct frame *f;
{
return FRAME_X_DISPLAY_INFO (f)->n_planes;
}
static struct visual_class
{
char *name;
int class;
}
visual_classes[] =
{
{"StaticGray", StaticGray},
{"GrayScale", GrayScale},
{"StaticColor", StaticColor},
{"PseudoColor", PseudoColor},
{"TrueColor", TrueColor},
{"DirectColor", DirectColor},
NULL
};
#ifndef HAVE_XSCREENNUMBEROFSCREEN
int
XScreenNumberOfScreen (scr)
register Screen *scr;
{
Display *dpy = scr->display;
int i;
for (i = 0; i < dpy->nscreens; ++i)
if (scr == dpy->screens + i)
break;
return i;
}
#endif
void
select_visual (dpyinfo)
struct x_display_info *dpyinfo;
{
Display *dpy = dpyinfo->display;
Screen *screen = dpyinfo->screen;
Lisp_Object value;
value = display_x_get_resource (dpyinfo,
build_string ("visualClass"),
build_string ("VisualClass"),
Qnil, Qnil);
if (STRINGP (value))
{
char *s = (char *) alloca (STRING_BYTES (XSTRING (value)) + 1);
char *dash;
int i, class = -1;
XVisualInfo vinfo;
strcpy (s, XSTRING (value)->data);
dash = index (s, '-');
if (dash)
{
dpyinfo->n_planes = atoi (dash + 1);
*dash = '\0';
}
else
dpyinfo->n_planes = 0;
for (i = 0; visual_classes[i].name; ++i)
if (xstricmp (s, visual_classes[i].name) == 0)
{
class = visual_classes[i].class;
break;
}
if (class == -1
|| !XMatchVisualInfo (dpy, XScreenNumberOfScreen (screen),
dpyinfo->n_planes, class, &vinfo))
fatal ("Invalid visual specification `%s'", XSTRING (value)->data);
dpyinfo->visual = vinfo.visual;
}
else
{
int n_visuals;
XVisualInfo *vinfo, vinfo_template;
dpyinfo->visual = DefaultVisualOfScreen (screen);
#ifdef HAVE_X11R4
vinfo_template.visualid = XVisualIDFromVisual (dpyinfo->visual);
#else
vinfo_template.visualid = dpyinfo->visual->visualid;
#endif
vinfo_template.screen = XScreenNumberOfScreen (screen);
vinfo = XGetVisualInfo (dpy, VisualIDMask | VisualScreenMask,
&vinfo_template, &n_visuals);
if (n_visuals != 1)
fatal ("Can't get proper X visual info");
dpyinfo->n_planes = vinfo->depth;
XFree ((char *) vinfo);
}
}
struct x_display_info *
x_display_info_for_name (name)
Lisp_Object name;
{
Lisp_Object names;
struct x_display_info *dpyinfo;
CHECK_STRING (name, 0);
if (! EQ (Vwindow_system, intern ("x")))
error ("Not using X Windows");
for (dpyinfo = x_display_list, names = x_display_name_list;
dpyinfo;
dpyinfo = dpyinfo->next, names = XCDR (names))
{
Lisp_Object tem;
tem = Fstring_equal (XCAR (XCAR (names)), name);
if (!NILP (tem))
return dpyinfo;
}
Vx_resource_name = Vinvocation_name;
validate_x_resource_name ();
dpyinfo = x_term_init (name, (char *)0,
(char *) XSTRING (Vx_resource_name)->data);
if (dpyinfo == 0)
error ("Cannot connect to X server %s", XSTRING (name)->data);
x_in_use = 1;
XSETFASTINT (Vwindow_system_version, 11);
return dpyinfo;
}
DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
1, 3, 0, "Open a connection to an X server.\n\
DISPLAY is the name of the display to connect to.\n\
Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
If the optional third arg MUST-SUCCEED is non-nil,\n\
terminate Emacs if we can't open the connection.")
(display, xrm_string, must_succeed)
Lisp_Object display, xrm_string, must_succeed;
{
unsigned char *xrm_option;
struct x_display_info *dpyinfo;
CHECK_STRING (display, 0);
if (! NILP (xrm_string))
CHECK_STRING (xrm_string, 1);
if (! EQ (Vwindow_system, intern ("x")))
error ("Not using X Windows");
if (! NILP (xrm_string))
xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
else
xrm_option = (unsigned char *) 0;
validate_x_resource_name ();
dpyinfo = x_term_init (display, xrm_option,
(char *) XSTRING (Vx_resource_name)->data);
if (dpyinfo == 0)
{
if (!NILP (must_succeed))
fatal ("Cannot connect to X server %s.\n\
Check the DISPLAY environment variable or use `-d'.\n\
Also use the `xhost' program to verify that it is set to permit\n\
connections from your machine.\n",
XSTRING (display)->data);
else
error ("Cannot connect to X server %s", XSTRING (display)->data);
}
x_in_use = 1;
XSETFASTINT (Vwindow_system_version, 11);
return Qnil;
}
DEFUN ("x-close-connection", Fx_close_connection,
Sx_close_connection, 1, 1, 0,
"Close the connection to DISPLAY's X server.\n\
For DISPLAY, specify either a frame or a display name (a string).\n\
If DISPLAY is nil, that stands for the selected frame's display.")
(display)
Lisp_Object display;
{
struct x_display_info *dpyinfo = check_x_display_info (display);
int i;
if (dpyinfo->reference_count > 0)
error ("Display still has frames on it");
BLOCK_INPUT;
for (i = 0; i < dpyinfo->n_fonts; i++)
if (dpyinfo->font_table[i].name)
{
if (dpyinfo->font_table[i].name != dpyinfo->font_table[i].full_name)
xfree (dpyinfo->font_table[i].full_name);
xfree (dpyinfo->font_table[i].name);
XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
}
x_destroy_all_bitmaps (dpyinfo);
XSetCloseDownMode (dpyinfo->display, DestroyAll);
#ifdef USE_X_TOOLKIT
XtCloseDisplay (dpyinfo->display);
#else
XCloseDisplay (dpyinfo->display);
#endif
x_delete_display (dpyinfo);
UNBLOCK_INPUT;
return Qnil;
}
DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
"Return the list of display names that Emacs has connections to.")
()
{
Lisp_Object tail, result;
result = Qnil;
for (tail = x_display_name_list; ! NILP (tail); tail = XCDR (tail))
result = Fcons (XCAR (XCAR (tail)), result);
return result;
}
DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
"If ON is non-nil, report X errors as soon as the erring request is made.\n\
If ON is nil, allow buffering of requests.\n\
Turning on synchronization prohibits the Xlib routines from buffering\n\
requests and seriously degrades performance, but makes debugging much\n\
easier.\n\
The optional second argument DISPLAY specifies which display to act on.\n\
DISPLAY should be either a frame or a display name (a string).\n\
If DISPLAY is omitted or nil, that stands for the selected frame's display.")
(on, display)
Lisp_Object display, on;
{
struct x_display_info *dpyinfo = check_x_display_info (display);
XSynchronize (dpyinfo->display, !EQ (on, Qnil));
return Qnil;
}
void
x_sync (f)
FRAME_PTR f;
{
BLOCK_INPUT;
XSync (FRAME_X_DISPLAY (f), False);
UNBLOCK_INPUT;
}
#define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
static struct image_type *image_types;
extern Lisp_Object Qimage;
Lisp_Object Qxbm;
extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
extern Lisp_Object QCdata;
Lisp_Object QCtype, QCascent, QCmargin, QCrelief;
Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask;
Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask;
Lisp_Object Qlaplace, Qemboss, Qedge_detection, Qheuristic;
Lisp_Object Vimage_cache_eviction_delay;
static void define_image_type P_ ((struct image_type *type));
static struct image_type *lookup_image_type P_ ((Lisp_Object symbol));
static void image_error P_ ((char *format, Lisp_Object, Lisp_Object));
static void x_laplace P_ ((struct frame *, struct image *));
static void x_emboss P_ ((struct frame *, struct image *));
static int x_build_heuristic_mask P_ ((struct frame *, struct image *,
Lisp_Object));
static void
define_image_type (type)
struct image_type *type;
{
struct image_type *p = (struct image_type *) xmalloc (sizeof *p);
bcopy (type, p, sizeof *p);
p->next = image_types;
image_types = p;
Vimage_types = Fcons (*p->type, Vimage_types);
}
static INLINE struct image_type *
lookup_image_type (symbol)
Lisp_Object symbol;
{
struct image_type *type;
for (type = image_types; type; type = type->next)
if (EQ (symbol, *type->type))
break;
return type;
}
int
valid_image_p (object)
Lisp_Object object;
{
int valid_p = 0;
if (CONSP (object) && EQ (XCAR (object), Qimage))
{
Lisp_Object tem;
for (tem = XCDR (object); CONSP (tem); tem = XCDR (tem))
if (EQ (XCAR (tem), QCtype))
{
tem = XCDR (tem);
if (CONSP (tem) && SYMBOLP (XCAR (tem)))
{
struct image_type *type;
type = lookup_image_type (XCAR (tem));
if (type)
valid_p = type->valid_p (object);
}
break;
}
}
return valid_p;
}
static void
image_error (format, arg1, arg2)
char *format;
Lisp_Object arg1, arg2;
{
add_to_log (format, arg1, arg2);
}
enum image_value_type
{
IMAGE_DONT_CHECK_VALUE_TYPE,
IMAGE_STRING_VALUE,
IMAGE_STRING_OR_NIL_VALUE,
IMAGE_SYMBOL_VALUE,
IMAGE_POSITIVE_INTEGER_VALUE,
IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR,
IMAGE_NON_NEGATIVE_INTEGER_VALUE,
IMAGE_ASCENT_VALUE,
IMAGE_INTEGER_VALUE,
IMAGE_FUNCTION_VALUE,
IMAGE_NUMBER_VALUE,
IMAGE_BOOL_VALUE
};
struct image_keyword
{
char *name;
enum image_value_type type;
int mandatory_p;
int count;
Lisp_Object value;
};
static int parse_image_spec P_ ((Lisp_Object, struct image_keyword *,
int, Lisp_Object));
static Lisp_Object image_spec_value P_ ((Lisp_Object, Lisp_Object, int *));
static int
parse_image_spec (spec, keywords, nkeywords, type)
Lisp_Object spec;
struct image_keyword *keywords;
int nkeywords;
Lisp_Object type;
{
int i;
Lisp_Object plist;
if (!CONSP (spec) || !EQ (XCAR (spec), Qimage))
return 0;
plist = XCDR (spec);
while (CONSP (plist))
{
Lisp_Object key, value;
key = XCAR (plist);
plist = XCDR (plist);
if (!SYMBOLP (key))
return 0;
if (!CONSP (plist))
return 0;
value = XCAR (plist);
plist = XCDR (plist);
for (i = 0; i < nkeywords; ++i)
if (strcmp (keywords[i].name, XSYMBOL (key)->name->data) == 0)
break;
if (i == nkeywords)
continue;
keywords[i].value = value;
++keywords[i].count;
if (keywords[i].count > 1)
return 0;
switch (keywords[i].type)
{
case IMAGE_STRING_VALUE:
if (!STRINGP (value))
return 0;
break;
case IMAGE_STRING_OR_NIL_VALUE:
if (!STRINGP (value) && !NILP (value))
return 0;
break;
case IMAGE_SYMBOL_VALUE:
if (!SYMBOLP (value))
return 0;
break;
case IMAGE_POSITIVE_INTEGER_VALUE:
if (!INTEGERP (value) || XINT (value) <= 0)
return 0;
break;
case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR:
if (INTEGERP (value) && XINT (value) >= 0)
break;
if (CONSP (value)
&& INTEGERP (XCAR (value)) && INTEGERP (XCDR (value))
&& XINT (XCAR (value)) >= 0 && XINT (XCDR (value)) >= 0)
break;
return 0;
case IMAGE_ASCENT_VALUE:
if (SYMBOLP (value) && EQ (value, Qcenter))
break;
else if (INTEGERP (value)
&& XINT (value) >= 0
&& XINT (value) <= 100)
break;
return 0;
case IMAGE_NON_NEGATIVE_INTEGER_VALUE:
if (!INTEGERP (value) || XINT (value) < 0)
return 0;
break;
case IMAGE_DONT_CHECK_VALUE_TYPE:
break;
case IMAGE_FUNCTION_VALUE:
value = indirect_function (value);
if (SUBRP (value)
|| COMPILEDP (value)
|| (CONSP (value) && EQ (XCAR (value), Qlambda)))
break;
return 0;
case IMAGE_NUMBER_VALUE:
if (!INTEGERP (value) && !FLOATP (value))
return 0;
break;
case IMAGE_INTEGER_VALUE:
if (!INTEGERP (value))
return 0;
break;
case IMAGE_BOOL_VALUE:
if (!NILP (value) && !EQ (value, Qt))
return 0;
break;
default:
abort ();
break;
}
if (EQ (key, QCtype) && !EQ (type, value))
return 0;
}
for (i = 0; i < nkeywords; ++i)
if (keywords[i].mandatory_p && keywords[i].count == 0)
return 0;
return NILP (plist);
}
static Lisp_Object
image_spec_value (spec, key, found)
Lisp_Object spec, key;
int *found;
{
Lisp_Object tail;
xassert (valid_image_p (spec));
for (tail = XCDR (spec);
CONSP (tail) && CONSP (XCDR (tail));
tail = XCDR (XCDR (tail)))
{
if (EQ (XCAR (tail), key))
{
if (found)
*found = 1;
return XCAR (XCDR (tail));
}
}
if (found)
*found = 0;
return Qnil;
}
DEFUN ("image-size", Fimage_size, Simage_size, 1, 3, 0,
"Return the size of image SPEC as pair (WIDTH . HEIGHT).\n\
PIXELS non-nil means return the size in pixels, otherwise return the\n\
size in canonical character units.\n\
FRAME is the frame on which the image will be displayed. FRAME nil\n\
or omitted means use the selected frame.")
(spec, pixels, frame)
Lisp_Object spec, pixels, frame;
{
Lisp_Object size;
size = Qnil;
if (valid_image_p (spec))
{
struct frame *f = check_x_frame (frame);
int id = lookup_image (f, spec);
struct image *img = IMAGE_FROM_ID (f, id);
int width = img->width + 2 * img->hmargin;
int height = img->height + 2 * img->vmargin;
if (NILP (pixels))
size = Fcons (make_float ((double) width / CANON_X_UNIT (f)),
make_float ((double) height / CANON_Y_UNIT (f)));
else
size = Fcons (make_number (width), make_number (height));
}
else
error ("Invalid image specification");
return size;
}
DEFUN ("image-mask-p", Fimage_mask_p, Simage_mask_p, 1, 2, 0,
"Return t if image SPEC has a mask bitmap.\n\
FRAME is the frame on which the image will be displayed. FRAME nil\n\
or omitted means use the selected frame.")
(spec, frame)
Lisp_Object spec, frame;
{
Lisp_Object mask;
mask = Qnil;
if (valid_image_p (spec))
{
struct frame *f = check_x_frame (frame);
int id = lookup_image (f, spec);
struct image *img = IMAGE_FROM_ID (f, id);
if (img->mask)
mask = Qt;
}
else
error ("Invalid image specification");
return mask;
}
static struct image *make_image P_ ((Lisp_Object spec, unsigned hash));
static void free_image P_ ((struct frame *f, struct image *img));
static struct image *
make_image (spec, hash)
Lisp_Object spec;
unsigned hash;
{
struct image *img = (struct image *) xmalloc (sizeof *img);
xassert (valid_image_p (spec));
bzero (img, sizeof *img);
img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
xassert (img->type != NULL);
img->spec = spec;
img->data.lisp_val = Qnil;
img->ascent = DEFAULT_IMAGE_ASCENT;
img->hash = hash;
return img;
}
static void
free_image (f, img)
struct frame *f;
struct image *img;
{
if (img)
{
struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
if (img->prev)
img->prev->next = img->next;
else
c->buckets[img->hash % IMAGE_CACHE_BUCKETS_SIZE] = img->next;
if (img->next)
img->next->prev = img->prev;
c->images[img->id] = NULL;
img->type->free (f, img);
xfree (img);
}
}
void
prepare_image_for_display (f, img)
struct frame *f;
struct image *img;
{
EMACS_TIME t;
EMACS_GET_TIME (t);
img->timestamp = EMACS_SECS (t);
if (img->pixmap == None && !img->load_failed_p)
img->load_failed_p = img->type->load (f, img) == 0;
}
int
image_ascent (img, face)
struct image *img;
struct face *face;
{
int height = img->height + img->vmargin;
int ascent;
if (img->ascent == CENTERED_IMAGE_ASCENT)
{
if (face->font)
ascent = (height + face->font->ascent - face->font->descent + 1) / 2;
else
ascent = height / 2;
}
else
ascent = height * img->ascent / 100.0;
return ascent;
}
static void x_clear_image_1 P_ ((struct frame *, struct image *, int,
int, int));
static void x_clear_image P_ ((struct frame *f, struct image *img));
static unsigned long x_alloc_image_color P_ ((struct frame *f,
struct image *img,
Lisp_Object color_name,
unsigned long dflt));
static void
x_clear_image_1 (f, img, pixmap_p, mask_p, colors_p)
struct frame *f;
struct image *img;
int pixmap_p, mask_p, colors_p;
{
if (pixmap_p && img->pixmap)
{
XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
img->pixmap = None;
}
if (mask_p && img->mask)
{
XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
img->mask = None;
}
if (colors_p && img->ncolors)
{
x_free_colors (f, img->colors, img->ncolors);
xfree (img->colors);
img->colors = NULL;
img->ncolors = 0;
}
}
static void
x_clear_image (f, img)
struct frame *f;
struct image *img;
{
BLOCK_INPUT;
x_clear_image_1 (f, img, 1, 1, 1);
UNBLOCK_INPUT;
}
static unsigned long
x_alloc_image_color (f, img, color_name, dflt)
struct frame *f;
struct image *img;
Lisp_Object color_name;
unsigned long dflt;
{
XColor color;
unsigned long result;
xassert (STRINGP (color_name));
if (x_defined_color (f, XSTRING (color_name)->data, &color, 1))
{
++img->ncolors;
img->colors =
(unsigned long *) xrealloc (img->colors,
img->ncolors * sizeof *img->colors);
img->colors[img->ncolors - 1] = color.pixel;
result = color.pixel;
}
else
result = dflt;
return result;
}
static void cache_image P_ ((struct frame *f, struct image *img));
static void postprocess_image P_ ((struct frame *, struct image *));
struct image_cache *
make_image_cache ()
{
struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
int size;
bzero (c, sizeof *c);
c->size = 50;
c->images = (struct image **) xmalloc (c->size * sizeof *c->images);
size = IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
c->buckets = (struct image **) xmalloc (size);
bzero (c->buckets, size);
return c;
}
void
free_image_cache (f)
struct frame *f;
{
struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
if (c)
{
int i;
xassert (c->refcount == 0);
for (i = 0; i < c->used; ++i)
free_image (f, c->images[i]);
xfree (c->images);
xfree (c->buckets);
xfree (c);
FRAME_X_IMAGE_CACHE (f) = NULL;
}
}
void
clear_image_cache (f, force_p)
struct frame *f;
int force_p;
{
struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
if (c && INTEGERP (Vimage_cache_eviction_delay))
{
EMACS_TIME t;
unsigned long old;
int i, nfreed;
EMACS_GET_TIME (t);
old = EMACS_SECS (t) - XFASTINT (Vimage_cache_eviction_delay);
BLOCK_INPUT;
for (i = nfreed = 0; i < c->used; ++i)
{
struct image *img = c->images[i];
if (img != NULL
&& (force_p || img->timestamp < old))
{
free_image (f, img);
++nfreed;
}
}
if (nfreed)
{
Lisp_Object tail, frame;
FOR_EACH_FRAME (tail, frame)
{
struct frame *f = XFRAME (frame);
if (FRAME_X_P (f)
&& FRAME_X_IMAGE_CACHE (f) == c)
clear_current_matrices (f);
}
++windows_or_buffers_changed;
}
UNBLOCK_INPUT;
}
}
DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache,
0, 1, 0,
"Clear the image cache of FRAME.\n\
FRAME nil or omitted means use the selected frame.\n\
FRAME t means clear the image caches of all frames.")
(frame)
Lisp_Object frame;
{
if (EQ (frame, Qt))
{
Lisp_Object tail;
FOR_EACH_FRAME (tail, frame)
if (FRAME_X_P (XFRAME (frame)))
clear_image_cache (XFRAME (frame), 1);
}
else
clear_image_cache (check_x_frame (frame), 1);
return Qnil;
}
static void
postprocess_image (f, img)
struct frame *f;
struct image *img;
{
if (img->pixmap)
{
Lisp_Object conversion, spec;
Lisp_Object mask;
spec = img->spec;
mask = image_spec_value (spec, QCheuristic_mask, NULL);
if (!NILP (mask))
x_build_heuristic_mask (f, img, mask);
else
{
int found_p;
mask = image_spec_value (spec, QCmask, &found_p);
if (EQ (mask, Qheuristic))
x_build_heuristic_mask (f, img, Qt);
else if (CONSP (mask)
&& EQ (XCAR (mask), Qheuristic))
{
if (CONSP (XCDR (mask)))
x_build_heuristic_mask (f, img, XCAR (XCDR (mask)));
else
x_build_heuristic_mask (f, img, XCDR (mask));
}
else if (NILP (mask) && found_p && img->mask)
{
XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
img->mask = None;
}
}
conversion = image_spec_value (spec, QCconversion, NULL);
if (EQ (conversion, Qdisabled))
x_disable_image (f, img);
else if (EQ (conversion, Qlaplace))
x_laplace (f, img);
else if (EQ (conversion, Qemboss))
x_emboss (f, img);
else if (CONSP (conversion)
&& EQ (XCAR (conversion), Qedge_detection))
{
Lisp_Object tem;
tem = XCDR (conversion);
if (CONSP (tem))
x_edge_detection (f, img,
Fplist_get (tem, QCmatrix),
Fplist_get (tem, QCcolor_adjustment));
}
}
}
int
lookup_image (f, spec)
struct frame *f;
Lisp_Object spec;
{
struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
struct image *img;
int i;
unsigned hash;
struct gcpro gcpro1;
EMACS_TIME now;
xassert (FRAME_WINDOW_P (f));
xassert (valid_image_p (spec));
GCPRO1 (spec);
hash = sxhash (spec, 0);
i = hash % IMAGE_CACHE_BUCKETS_SIZE;
for (img = c->buckets[i]; img; img = img->next)
if (img->hash == hash && !NILP (Fequal (img->spec, spec)))
break;
if (img == NULL)
{
extern Lisp_Object Qpostscript;
BLOCK_INPUT;
img = make_image (spec, hash);
cache_image (f, img);
img->load_failed_p = img->type->load (f, img) == 0;
if (img->load_failed_p)
{
Lisp_Object value;
value = image_spec_value (spec, QCwidth, NULL);
img->width = (INTEGERP (value)
? XFASTINT (value) : DEFAULT_IMAGE_WIDTH);
value = image_spec_value (spec, QCheight, NULL);
img->height = (INTEGERP (value)
? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT);
}
else
{
Lisp_Object ascent, margin, relief;
ascent = image_spec_value (spec, QCascent, NULL);
if (INTEGERP (ascent))
img->ascent = XFASTINT (ascent);
else if (EQ (ascent, Qcenter))
img->ascent = CENTERED_IMAGE_ASCENT;
margin = image_spec_value (spec, QCmargin, NULL);
if (INTEGERP (margin) && XINT (margin) >= 0)
img->vmargin = img->hmargin = XFASTINT (margin);
else if (CONSP (margin) && INTEGERP (XCAR (margin))
&& INTEGERP (XCDR (margin)))
{
if (XINT (XCAR (margin)) > 0)
img->hmargin = XFASTINT (XCAR (margin));
if (XINT (XCDR (margin)) > 0)
img->vmargin = XFASTINT (XCDR (margin));
}
relief = image_spec_value (spec, QCrelief, NULL);
if (INTEGERP (relief))
{
img->relief = XINT (relief);
img->hmargin += abs (img->relief);
img->vmargin += abs (img->relief);
}
if (!EQ (*img->type->type, Qpostscript))
postprocess_image (f, img);
}
UNBLOCK_INPUT;
xassert (!interrupt_input_blocked);
}
EMACS_GET_TIME (now);
img->timestamp = EMACS_SECS (now);
UNGCPRO;
return img->id;
}
static void
cache_image (f, img)
struct frame *f;
struct image *img;
{
struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
int i;
for (i = 0; i < c->used; ++i)
if (c->images[i] == NULL)
break;
if (i == c->used && c->used == c->size)
{
c->size *= 2;
c->images = (struct image **) xrealloc (c->images,
c->size * sizeof *c->images);
}
c->images[i] = img;
img->id = i;
if (i == c->used)
++c->used;
i = img->hash % IMAGE_CACHE_BUCKETS_SIZE;
img->next = c->buckets[i];
if (img->next)
img->next->prev = img;
img->prev = NULL;
c->buckets[i] = img;
}
void
forall_images_in_image_cache (f, fn)
struct frame *f;
void (*fn) P_ ((struct image *img));
{
if (FRAME_LIVE_P (f) && FRAME_X_P (f))
{
struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
if (c)
{
int i;
for (i = 0; i < c->used; ++i)
if (c->images[i])
fn (c->images[i]);
}
}
}
static int x_create_x_image_and_pixmap P_ ((struct frame *, int, int, int,
XImage **, Pixmap *));
static void x_destroy_x_image P_ ((XImage *));
static void x_put_x_image P_ ((struct frame *, XImage *, Pixmap, int, int));
static int
x_create_x_image_and_pixmap (f, width, height, depth, ximg, pixmap)
struct frame *f;
int width, height, depth;
XImage **ximg;
Pixmap *pixmap;
{
Display *display = FRAME_X_DISPLAY (f);
Screen *screen = FRAME_X_SCREEN (f);
Window window = FRAME_X_WINDOW (f);
xassert (interrupt_input_blocked);
if (depth <= 0)
depth = DefaultDepthOfScreen (screen);
*ximg = XCreateImage (display, DefaultVisualOfScreen (screen),
depth, ZPixmap, 0, NULL, width, height,
depth > 16 ? 32 : depth > 8 ? 16 : 8, 0);
if (*ximg == NULL)
{
image_error ("Unable to allocate X image", Qnil, Qnil);
return 0;
}
(*ximg)->data = (char *) xmalloc ((*ximg)->bytes_per_line * height);
*pixmap = XCreatePixmap (display, window, width, height, depth);
if (*pixmap == None)
{
x_destroy_x_image (*ximg);
*ximg = NULL;
image_error ("Unable to create X pixmap", Qnil, Qnil);
return 0;
}
return 1;
}
static void
x_destroy_x_image (ximg)
XImage *ximg;
{
xassert (interrupt_input_blocked);
if (ximg)
{
xfree (ximg->data);
ximg->data = NULL;
XDestroyImage (ximg);
}
}
static void
x_put_x_image (f, ximg, pixmap, width, height)
struct frame *f;
XImage *ximg;
Pixmap pixmap;
{
GC gc;
xassert (interrupt_input_blocked);
gc = XCreateGC (FRAME_X_DISPLAY (f), pixmap, 0, NULL);
XPutImage (FRAME_X_DISPLAY (f), pixmap, gc, ximg, 0, 0, 0, 0, width, height);
XFreeGC (FRAME_X_DISPLAY (f), gc);
}
static Lisp_Object x_find_image_file P_ ((Lisp_Object));
static char *slurp_file P_ ((char *, int *));
static Lisp_Object
x_find_image_file (file)
Lisp_Object file;
{
Lisp_Object file_found, search_path;
struct gcpro gcpro1, gcpro2;
int fd;
file_found = Qnil;
search_path = Fcons (Vdata_directory, Vx_bitmap_file_path);
GCPRO2 (file_found, search_path);
fd = openp (search_path, file, "", &file_found, 0);
if (fd == -1)
file_found = Qnil;
else
close (fd);
UNGCPRO;
return file_found;
}
static char *
slurp_file (file, size)
char *file;
int *size;
{
FILE *fp = NULL;
char *buf = NULL;
struct stat st;
if (stat (file, &st) == 0
&& (fp = fopen (file, "r")) != NULL
&& (buf = (char *) xmalloc (st.st_size),
fread (buf, 1, st.st_size, fp) == st.st_size))
{
*size = st.st_size;
fclose (fp);
}
else
{
if (fp)
fclose (fp);
if (buf)
{
xfree (buf);
buf = NULL;
}
}
return buf;
}
static int xbm_scan P_ ((char **, char *, char *, int *));
static int xbm_load P_ ((struct frame *f, struct image *img));
static int xbm_load_image P_ ((struct frame *f, struct image *img,
char *, char *));
static int xbm_image_p P_ ((Lisp_Object object));
static int xbm_read_bitmap_data P_ ((char *, char *, int *, int *,
unsigned char **));
static int xbm_file_p P_ ((Lisp_Object));
enum xbm_keyword_index
{
XBM_TYPE,
XBM_FILE,
XBM_WIDTH,
XBM_HEIGHT,
XBM_DATA,
XBM_FOREGROUND,
XBM_BACKGROUND,
XBM_ASCENT,
XBM_MARGIN,
XBM_RELIEF,
XBM_ALGORITHM,
XBM_HEURISTIC_MASK,
XBM_MASK,
XBM_LAST
};
static struct image_keyword xbm_format[XBM_LAST] =
{
{":type", IMAGE_SYMBOL_VALUE, 1},
{":file", IMAGE_STRING_VALUE, 0},
{":width", IMAGE_POSITIVE_INTEGER_VALUE, 0},
{":height", IMAGE_POSITIVE_INTEGER_VALUE, 0},
{":data", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
{":background", IMAGE_STRING_OR_NIL_VALUE, 0},
{":ascent", IMAGE_ASCENT_VALUE, 0},
{":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
{":relief", IMAGE_INTEGER_VALUE, 0},
{":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
};
static struct image_type xbm_type =
{
&Qxbm,
xbm_image_p,
xbm_load,
x_clear_image,
NULL
};
enum xbm_token
{
XBM_TK_IDENT = 256,
XBM_TK_NUMBER
};
static int
xbm_image_p (object)
Lisp_Object object;
{
struct image_keyword kw[XBM_LAST];
bcopy (xbm_format, kw, sizeof kw);
if (!parse_image_spec (object, kw, XBM_LAST, Qxbm))
return 0;
xassert (EQ (kw[XBM_TYPE].value, Qxbm));
if (kw[XBM_FILE].count)
{
if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_DATA].count)
return 0;
}
else if (kw[XBM_DATA].count && xbm_file_p (kw[XBM_DATA].value))
{
if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_FILE].count)
return 0;
}
else
{
Lisp_Object data;
int width, height;
if (!kw[XBM_WIDTH].count
|| !kw[XBM_HEIGHT].count
|| !kw[XBM_DATA].count)
return 0;
data = kw[XBM_DATA].value;
width = XFASTINT (kw[XBM_WIDTH].value);
height = XFASTINT (kw[XBM_HEIGHT].value);
if (VECTORP (data))
{
int i;
if (XVECTOR (data)->size < height)
return 0;
for (i = 0; i < height; ++i)
{
Lisp_Object elt = XVECTOR (data)->contents[i];
if (STRINGP (elt))
{
if (XSTRING (elt)->size
< (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR)
return 0;
}
else if (BOOL_VECTOR_P (elt))
{
if (XBOOL_VECTOR (elt)->size < width)
return 0;
}
else
return 0;
}
}
else if (STRINGP (data))
{
if (XSTRING (data)->size
< (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR * height)
return 0;
}
else if (BOOL_VECTOR_P (data))
{
if (XBOOL_VECTOR (data)->size < width * height)
return 0;
}
else
return 0;
}
return 1;
}
static int
xbm_scan (s, end, sval, ival)
char **s, *end;
char *sval;
int *ival;
{
int c;
loop:
while (*s < end && (c = *(*s)++, isspace (c)))
;
if (*s >= end)
c = 0;
else if (isdigit (c))
{
int value = 0, digit;
if (c == '0' && *s < end)
{
c = *(*s)++;
if (c == 'x' || c == 'X')
{
while (*s < end)
{
c = *(*s)++;
if (isdigit (c))
digit = c - '0';
else if (c >= 'a' && c <= 'f')
digit = c - 'a' + 10;
else if (c >= 'A' && c <= 'F')
digit = c - 'A' + 10;
else
break;
value = 16 * value + digit;
}
}
else if (isdigit (c))
{
value = c - '0';
while (*s < end
&& (c = *(*s)++, isdigit (c)))
value = 8 * value + c - '0';
}
}
else
{
value = c - '0';
while (*s < end
&& (c = *(*s)++, isdigit (c)))
value = 10 * value + c - '0';
}
if (*s < end)
*s = *s - 1;
*ival = value;
c = XBM_TK_NUMBER;
}
else if (isalpha (c) || c == '_')
{
*sval++ = c;
while (*s < end
&& (c = *(*s)++, (isalnum (c) || c == '_')))
*sval++ = c;
*sval = 0;
if (*s < end)
*s = *s - 1;
c = XBM_TK_IDENT;
}
else if (c == '/' && **s == '*')
{
++*s;
while (**s && (**s != '*' || *(*s + 1) != '/'))
++*s;
if (**s)
{
*s += 2;
goto loop;
}
}
return c;
}
static int
xbm_read_bitmap_data (contents, end, width, height, data)
char *contents, *end;
int *width, *height;
unsigned char **data;
{
char *s = contents;
char buffer[BUFSIZ];
int padding_p = 0;
int v10 = 0;
int bytes_per_line, i, nbytes;
unsigned char *p;
int value;
int LA1;
#define match() \
LA1 = xbm_scan (&s, end, buffer, &value)
#define expect(TOKEN) \
if (LA1 != (TOKEN)) \
goto failure; \
else \
match ()
#define expect_ident(IDENT) \
if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
match (); \
else \
goto failure
*width = *height = -1;
if (data)
*data = NULL;
LA1 = xbm_scan (&s, end, buffer, &value);
while (LA1 == '#')
{
match ();
expect_ident ("define");
expect (XBM_TK_IDENT);
if (LA1 == XBM_TK_NUMBER);
{
char *p = strrchr (buffer, '_');
p = p ? p + 1 : buffer;
if (strcmp (p, "width") == 0)
*width = value;
else if (strcmp (p, "height") == 0)
*height = value;
}
expect (XBM_TK_NUMBER);
}
if (*width < 0 || *height < 0)
goto failure;
else if (data == NULL)
goto success;
expect_ident ("static");
if (LA1 == XBM_TK_IDENT)
{
if (strcmp (buffer, "unsigned") == 0)
{
match ();
expect_ident ("char");
}
else if (strcmp (buffer, "short") == 0)
{
match ();
v10 = 1;
if (*width % 16 && *width % 16 < 9)
padding_p = 1;
}
else if (strcmp (buffer, "char") == 0)
match ();
else
goto failure;
}
else
goto failure;
expect (XBM_TK_IDENT);
expect ('[');
expect (']');
expect ('=');
expect ('{');
bytes_per_line = (*width + 7) / 8 + padding_p;
nbytes = bytes_per_line * *height;
p = *data = (char *) xmalloc (nbytes);
if (v10)
{
for (i = 0; i < nbytes; i += 2)
{
int val = value;
expect (XBM_TK_NUMBER);
*p++ = val;
if (!padding_p || ((i + 2) % bytes_per_line))
*p++ = value >> 8;
if (LA1 == ',' || LA1 == '}')
match ();
else
goto failure;
}
}
else
{
for (i = 0; i < nbytes; ++i)
{
int val = value;
expect (XBM_TK_NUMBER);
*p++ = val;
if (LA1 == ',' || LA1 == '}')
match ();
else
goto failure;
}
}
success:
return 1;
failure:
if (data && *data)
{
xfree (*data);
*data = NULL;
}
return 0;
#undef match
#undef expect
#undef expect_ident
}
static int
xbm_load_image (f, img, contents, end)
struct frame *f;
struct image *img;
char *contents, *end;
{
int rc;
unsigned char *data;
int success_p = 0;
rc = xbm_read_bitmap_data (contents, end, &img->width, &img->height, &data);
if (rc)
{
int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
unsigned long background = FRAME_BACKGROUND_PIXEL (f);
Lisp_Object value;
xassert (img->width > 0 && img->height > 0);
value = image_spec_value (img->spec, QCforeground, NULL);
if (!NILP (value))
foreground = x_alloc_image_color (f, img, value, foreground);
value = image_spec_value (img->spec, QCbackground, NULL);
if (!NILP (value))
background = x_alloc_image_color (f, img, value, background);
img->pixmap
= XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
FRAME_X_WINDOW (f),
data,
img->width, img->height,
foreground, background,
depth);
xfree (data);
if (img->pixmap == None)
{
x_clear_image (f, img);
image_error ("Unable to create X pixmap for `%s'", img->spec, Qnil);
}
else
success_p = 1;
}
else
image_error ("Error loading XBM image `%s'", img->spec, Qnil);
return success_p;
}
static int
xbm_file_p (data)
Lisp_Object data;
{
int w, h;
return (STRINGP (data)
&& xbm_read_bitmap_data (XSTRING (data)->data,
(XSTRING (data)->data
+ STRING_BYTES (XSTRING (data))),
&w, &h, NULL));
}
static int
xbm_load (f, img)
struct frame *f;
struct image *img;
{
int success_p = 0;
Lisp_Object file_name;
xassert (xbm_image_p (img->spec));
file_name = image_spec_value (img->spec, QCfile, NULL);
if (STRINGP (file_name))
{
Lisp_Object file;
char *contents;
int size;
struct gcpro gcpro1;
file = x_find_image_file (file_name);
GCPRO1 (file);
if (!STRINGP (file))
{
image_error ("Cannot find image file `%s'", file_name, Qnil);
UNGCPRO;
return 0;
}
contents = slurp_file (XSTRING (file)->data, &size);
if (contents == NULL)
{
image_error ("Error loading XBM image `%s'", img->spec, Qnil);
UNGCPRO;
return 0;
}
success_p = xbm_load_image (f, img, contents, contents + size);
UNGCPRO;
}
else
{
struct image_keyword fmt[XBM_LAST];
Lisp_Object data;
int depth;
unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
unsigned long background = FRAME_BACKGROUND_PIXEL (f);
char *bits;
int parsed_p;
int in_memory_file_p = 0;
data = image_spec_value (img->spec, QCdata, NULL);
in_memory_file_p = xbm_file_p (data);
bcopy (xbm_format, fmt, sizeof fmt);
parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm);
xassert (parsed_p);
if (!in_memory_file_p)
{
img->width = XFASTINT (fmt[XBM_WIDTH].value);
img->height = XFASTINT (fmt[XBM_HEIGHT].value);
xassert (img->width > 0 && img->height > 0);
}
if (fmt[XBM_FOREGROUND].count
&& STRINGP (fmt[XBM_FOREGROUND].value))
foreground = x_alloc_image_color (f, img, fmt[XBM_FOREGROUND].value,
foreground);
if (fmt[XBM_BACKGROUND].count
&& STRINGP (fmt[XBM_BACKGROUND].value))
background = x_alloc_image_color (f, img, fmt[XBM_BACKGROUND].value,
background);
if (in_memory_file_p)
success_p = xbm_load_image (f, img, XSTRING (data)->data,
(XSTRING (data)->data
+ STRING_BYTES (XSTRING (data))));
else
{
if (VECTORP (data))
{
int i;
char *p;
int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
p = bits = (char *) alloca (nbytes * img->height);
for (i = 0; i < img->height; ++i, p += nbytes)
{
Lisp_Object line = XVECTOR (data)->contents[i];
if (STRINGP (line))
bcopy (XSTRING (line)->data, p, nbytes);
else
bcopy (XBOOL_VECTOR (line)->data, p, nbytes);
}
}
else if (STRINGP (data))
bits = XSTRING (data)->data;
else
bits = XBOOL_VECTOR (data)->data;
depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
img->pixmap
= XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
FRAME_X_WINDOW (f),
bits,
img->width, img->height,
foreground, background,
depth);
if (img->pixmap)
success_p = 1;
else
{
image_error ("Unable to create pixmap for XBM image `%s'",
img->spec, Qnil);
x_clear_image (f, img);
}
}
}
return success_p;
}
#if HAVE_XPM
static int xpm_image_p P_ ((Lisp_Object object));
static int xpm_load P_ ((struct frame *f, struct image *img));
static int xpm_valid_color_symbols_p P_ ((Lisp_Object));
#include "X11/xpm.h"
Lisp_Object Qxpm;
enum xpm_keyword_index
{
XPM_TYPE,
XPM_FILE,
XPM_DATA,
XPM_ASCENT,
XPM_MARGIN,
XPM_RELIEF,
XPM_ALGORITHM,
XPM_HEURISTIC_MASK,
XPM_MASK,
XPM_COLOR_SYMBOLS,
XPM_LAST
};
static struct image_keyword xpm_format[XPM_LAST] =
{
{":type", IMAGE_SYMBOL_VALUE, 1},
{":file", IMAGE_STRING_VALUE, 0},
{":data", IMAGE_STRING_VALUE, 0},
{":ascent", IMAGE_ASCENT_VALUE, 0},
{":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
{":relief", IMAGE_INTEGER_VALUE, 0},
{":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
};
static struct image_type xpm_type =
{
&Qxpm,
xpm_image_p,
xpm_load,
x_clear_image,
NULL
};
#if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
#define ALLOC_XPM_COLORS
#endif
#ifdef ALLOC_XPM_COLORS
static void xpm_init_color_cache P_ ((struct frame *, XpmAttributes *));
static void xpm_free_color_cache P_ ((void));
static int xpm_lookup_color P_ ((struct frame *, char *, XColor *));
static int xpm_color_bucket P_ ((char *));
static struct xpm_cached_color *xpm_cache_color P_ ((struct frame *, char *,
XColor *, int));
struct xpm_cached_color
{
struct xpm_cached_color *next;
XColor color;
char name[1];
};
#define XPM_COLOR_CACHE_BUCKETS 1001
struct xpm_cached_color **xpm_color_cache;
static void
xpm_init_color_cache (f, attrs)
struct frame *f;
XpmAttributes *attrs;
{
size_t nbytes = XPM_COLOR_CACHE_BUCKETS * sizeof *xpm_color_cache;
xpm_color_cache = (struct xpm_cached_color **) xmalloc (nbytes);
memset (xpm_color_cache, 0, nbytes);
init_color_table ();
if (attrs->valuemask & XpmColorSymbols)
{
int i;
XColor color;
for (i = 0; i < attrs->numsymbols; ++i)
if (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
attrs->colorsymbols[i].value, &color))
{
color.pixel = lookup_rgb_color (f, color.red, color.green,
color.blue);
xpm_cache_color (f, attrs->colorsymbols[i].name, &color, -1);
}
}
}
static void
xpm_free_color_cache ()
{
struct xpm_cached_color *p, *next;
int i;
for (i = 0; i < XPM_COLOR_CACHE_BUCKETS; ++i)
for (p = xpm_color_cache[i]; p; p = next)
{
next = p->next;
xfree (p);
}
xfree (xpm_color_cache);
xpm_color_cache = NULL;
free_color_table ();
}
static int
xpm_color_bucket (color_name)
char *color_name;
{
unsigned h = 0;
char *s;
for (s = color_name; *s; ++s)
h = (h << 2) ^ *s;
return h %= XPM_COLOR_CACHE_BUCKETS;
}
static struct xpm_cached_color *
xpm_cache_color (f, color_name, color, bucket)
struct frame *f;
char *color_name;
XColor *color;
int bucket;
{
size_t nbytes;
struct xpm_cached_color *p;
if (bucket < 0)
bucket = xpm_color_bucket (color_name);
nbytes = sizeof *p + strlen (color_name);
p = (struct xpm_cached_color *) xmalloc (nbytes);
strcpy (p->name, color_name);
p->color = *color;
p->next = xpm_color_cache[bucket];
xpm_color_cache[bucket] = p;
return p;
}
static int
xpm_lookup_color (f, color_name, color)
struct frame *f;
char *color_name;
XColor *color;
{
struct xpm_cached_color *p;
int h = xpm_color_bucket (color_name);
for (p = xpm_color_cache[h]; p; p = p->next)
if (strcmp (p->name, color_name) == 0)
break;
if (p != NULL)
*color = p->color;
else if (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
color_name, color))
{
color->pixel = lookup_rgb_color (f, color->red, color->green,
color->blue);
p = xpm_cache_color (f, color_name, color, h);
}
return p != NULL;
}
static int
xpm_alloc_color (dpy, cmap, color_name, color, closure)
Display *dpy;
Colormap cmap;
char *color_name;
XColor *color;
void *closure;
{
return xpm_lookup_color ((struct frame *) closure, color_name, color);
}
static int
xpm_free_colors (dpy, cmap, pixels, npixels, closure)
Display *dpy;
Colormap cmap;
Pixel *pixels;
int npixels;
void *closure;
{
return 1;
}
#endif
static int
xpm_valid_color_symbols_p (color_symbols)
Lisp_Object color_symbols;
{
while (CONSP (color_symbols))
{
Lisp_Object sym = XCAR (color_symbols);
if (!CONSP (sym)
|| !STRINGP (XCAR (sym))
|| !STRINGP (XCDR (sym)))
break;
color_symbols = XCDR (color_symbols);
}
return NILP (color_symbols);
}
static int
xpm_image_p (object)
Lisp_Object object;
{
struct image_keyword fmt[XPM_LAST];
bcopy (xpm_format, fmt, sizeof fmt);
return (parse_image_spec (object, fmt, XPM_LAST, Qxpm)
&& fmt[XPM_FILE].count + fmt[XPM_DATA].count == 1
&& (fmt[XPM_COLOR_SYMBOLS].count == 0
|| xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value)));
}
static int
xpm_load (f, img)
struct frame *f;
struct image *img;
{
int rc;
XpmAttributes attrs;
Lisp_Object specified_file, color_symbols;
bzero (&attrs, sizeof attrs);
attrs.visual = FRAME_X_VISUAL (f);
attrs.colormap = FRAME_X_COLORMAP (f);
attrs.valuemask |= XpmVisual;
attrs.valuemask |= XpmColormap;
#ifdef ALLOC_XPM_COLORS
attrs.color_closure = f;
attrs.alloc_color = xpm_alloc_color;
attrs.free_colors = xpm_free_colors;
attrs.valuemask |= XpmAllocColor | XpmFreeColors | XpmColorClosure;
#else
attrs.valuemask |= XpmReturnAllocPixels;
#ifdef XpmAllocCloseColors
attrs.alloc_close_colors = 1;
attrs.valuemask |= XpmAllocCloseColors;
#else
attrs.closeness = 600;
attrs.valuemask |= XpmCloseness;
#endif
#endif
color_symbols = image_spec_value (img->spec, QCcolor_symbols, NULL);
if (CONSP (color_symbols))
{
Lisp_Object tail;
XpmColorSymbol *xpm_syms;
int i, size;
attrs.valuemask |= XpmColorSymbols;
attrs.numsymbols = 0;
for (tail = color_symbols; CONSP (tail); tail = XCDR (tail))
++attrs.numsymbols;
size = attrs.numsymbols * sizeof *xpm_syms;
xpm_syms = (XpmColorSymbol *) alloca (size);
bzero (xpm_syms, size);
attrs.colorsymbols = xpm_syms;
for (tail = color_symbols, i = 0;
CONSP (tail);
++i, tail = XCDR (tail))
{
Lisp_Object name = XCAR (XCAR (tail));
Lisp_Object color = XCDR (XCAR (tail));
xpm_syms[i].name = (char *) alloca (XSTRING (name)->size + 1);
strcpy (xpm_syms[i].name, XSTRING (name)->data);
xpm_syms[i].value = (char *) alloca (XSTRING (color)->size + 1);
strcpy (xpm_syms[i].value, XSTRING (color)->data);
}
}
#ifdef ALLOC_XPM_COLORS
xpm_init_color_cache (f, &attrs);
#endif
specified_file = image_spec_value (img->spec, QCfile, NULL);
if (STRINGP (specified_file))
{
Lisp_Object file = x_find_image_file (specified_file);
if (!STRINGP (file))
{
image_error ("Cannot find image file `%s'", specified_file, Qnil);
return 0;
}
rc = XpmReadFileToPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
XSTRING (file)->data, &img->pixmap, &img->mask,
&attrs);
}
else
{
Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL);
rc = XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
XSTRING (buffer)->data,
&img->pixmap, &img->mask,
&attrs);
}
if (rc == XpmSuccess)
{
#ifdef ALLOC_XPM_COLORS
img->colors = colors_in_color_table (&img->ncolors);
#else
int i;
img->ncolors = attrs.nalloc_pixels;
img->colors = (unsigned long *) xmalloc (img->ncolors
* sizeof *img->colors);
for (i = 0; i < attrs.nalloc_pixels; ++i)
{
img->colors[i] = attrs.alloc_pixels[i];
#ifdef DEBUG_X_COLORS
register_color (img->colors[i]);
#endif
}
#endif
img->width = attrs.width;
img->height = attrs.height;
xassert (img->width > 0 && img->height > 0);
XpmFreeAttributes (&attrs);
}
else
{
switch (rc)
{
case XpmOpenFailed:
image_error ("Error opening XPM file (%s)", img->spec, Qnil);
break;
case XpmFileInvalid:
image_error ("Invalid XPM file (%s)", img->spec, Qnil);
break;
case XpmNoMemory:
image_error ("Out of memory (%s)", img->spec, Qnil);
break;
case XpmColorFailed:
image_error ("Color allocation error (%s)", img->spec, Qnil);
break;
default:
image_error ("Unknown error (%s)", img->spec, Qnil);
break;
}
}
#ifdef ALLOC_XPM_COLORS
xpm_free_color_cache ();
#endif
return rc == XpmSuccess;
}
#endif
struct ct_color
{
int r, g, b;
unsigned long pixel;
struct ct_color *next;
};
#define CT_SIZE 101
#define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
struct ct_color **ct_table;
int ct_colors_allocated;
static void
init_color_table ()
{
int size = CT_SIZE * sizeof (*ct_table);
ct_table = (struct ct_color **) xmalloc (size);
bzero (ct_table, size);
ct_colors_allocated = 0;
}
static void
free_color_table ()
{
int i;
struct ct_color *p, *next;
for (i = 0; i < CT_SIZE; ++i)
for (p = ct_table[i]; p; p = next)
{
next = p->next;
xfree (p);
}
xfree (ct_table);
ct_table = NULL;
}
static unsigned long
lookup_rgb_color (f, r, g, b)
struct frame *f;
int r, g, b;
{
unsigned hash = CT_HASH_RGB (r, g, b);
int i = hash % CT_SIZE;
struct ct_color *p;
for (p = ct_table[i]; p; p = p->next)
if (p->r == r && p->g == g && p->b == b)
break;
if (p == NULL)
{
XColor color;
Colormap cmap;
int rc;
color.red = r;
color.green = g;
color.blue = b;
cmap = FRAME_X_COLORMAP (f);
rc = x_alloc_nearest_color (f, cmap, &color);
if (rc)
{
++ct_colors_allocated;
p = (struct ct_color *) xmalloc (sizeof *p);
p->r = r;
p->g = g;
p->b = b;
p->pixel = color.pixel;
p->next = ct_table[i];
ct_table[i] = p;
}
else
return FRAME_FOREGROUND_PIXEL (f);
}
return p->pixel;
}
static unsigned long
lookup_pixel_color (f, pixel)
struct frame *f;
unsigned long pixel;
{
int i = pixel % CT_SIZE;
struct ct_color *p;
for (p = ct_table[i]; p; p = p->next)
if (p->pixel == pixel)
break;
if (p == NULL)
{
XColor color;
Colormap cmap;
int rc;
cmap = FRAME_X_COLORMAP (f);
color.pixel = pixel;
x_query_color (f, &color);
rc = x_alloc_nearest_color (f, cmap, &color);
if (rc)
{
++ct_colors_allocated;
p = (struct ct_color *) xmalloc (sizeof *p);
p->r = color.red;
p->g = color.green;
p->b = color.blue;
p->pixel = pixel;
p->next = ct_table[i];
ct_table[i] = p;
}
else
return FRAME_FOREGROUND_PIXEL (f);
}
return p->pixel;
}
static unsigned long *
colors_in_color_table (n)
int *n;
{
int i, j;
struct ct_color *p;
unsigned long *colors;
if (ct_colors_allocated == 0)
{
*n = 0;
colors = NULL;
}
else
{
colors = (unsigned long *) xmalloc (ct_colors_allocated
* sizeof *colors);
*n = ct_colors_allocated;
for (i = j = 0; i < CT_SIZE; ++i)
for (p = ct_table[i]; p; p = p->next)
colors[j++] = p->pixel;
}
return colors;
}
static void x_laplace_write_row P_ ((struct frame *, long *,
int, XImage *, int));
static void x_laplace_read_row P_ ((struct frame *, Colormap,
XColor *, int, XImage *, int));
static XColor *x_to_xcolors P_ ((struct frame *, struct image *, int));
static void x_from_xcolors P_ ((struct frame *, struct image *, XColor *));
static void x_detect_edges P_ ((struct frame *, struct image *, int[9], int));
int cross_disabled_images;
static int emboss_matrix[9] = {
2, -1, 0,
-1, 0, 1,
0, 1, -2
};
static int laplace_matrix[9] = {
1, 0, 0,
0, 0, 0,
0, 0, -1
};
#define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
static XColor *
x_to_xcolors (f, img, rgb_p)
struct frame *f;
struct image *img;
int rgb_p;
{
int x, y;
XColor *colors, *p;
XImage *ximg;
colors = (XColor *) xmalloc (img->width * img->height * sizeof *colors);
ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
0, 0, img->width, img->height, ~0, ZPixmap);
p = colors;
for (y = 0; y < img->height; ++y)
{
XColor *row = p;
for (x = 0; x < img->width; ++x, ++p)
p->pixel = XGetPixel (ximg, x, y);
if (rgb_p)
x_query_colors (f, row, img->width);
}
XDestroyImage (ximg);
return colors;
}
static void
x_from_xcolors (f, img, colors)
struct frame *f;
struct image *img;
XColor *colors;
{
int x, y;
XImage *oimg;
Pixmap pixmap;
XColor *p;
init_color_table ();
x_create_x_image_and_pixmap (f, img->width, img->height, 0,
&oimg, &pixmap);
p = colors;
for (y = 0; y < img->height; ++y)
for (x = 0; x < img->width; ++x, ++p)
{
unsigned long pixel;
pixel = lookup_rgb_color (f, p->red, p->green, p->blue);
XPutPixel (oimg, x, y, pixel);
}
xfree (colors);
x_clear_image_1 (f, img, 1, 0, 1);
x_put_x_image (f, oimg, pixmap, img->width, img->height);
x_destroy_x_image (oimg);
img->pixmap = pixmap;
img->colors = colors_in_color_table (&img->ncolors);
free_color_table ();
}
static void
x_detect_edges (f, img, matrix, color_adjust)
struct frame *f;
struct image *img;
int matrix[9], color_adjust;
{
XColor *colors = x_to_xcolors (f, img, 1);
XColor *new, *p;
int x, y, i, sum;
for (i = sum = 0; i < 9; ++i)
sum += abs (matrix[i]);
#define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
new = (XColor *) xmalloc (img->width * img->height * sizeof *new);
for (y = 0; y < img->height; ++y)
{
p = COLOR (new, 0, y);
p->red = p->green = p->blue = 0xffff/2;
p = COLOR (new, img->width - 1, y);
p->red = p->green = p->blue = 0xffff/2;
}
for (x = 1; x < img->width - 1; ++x)
{
p = COLOR (new, x, 0);
p->red = p->green = p->blue = 0xffff/2;
p = COLOR (new, x, img->height - 1);
p->red = p->green = p->blue = 0xffff/2;
}
for (y = 1; y < img->height - 1; ++y)
{
p = COLOR (new, 1, y);
for (x = 1; x < img->width - 1; ++x, ++p)
{
int r, g, b, y1, x1;
r = g = b = i = 0;
for (y1 = y - 1; y1 < y + 2; ++y1)
for (x1 = x - 1; x1 < x + 2; ++x1, ++i)
if (matrix[i])
{
XColor *t = COLOR (colors, x1, y1);
r += matrix[i] * t->red;
g += matrix[i] * t->green;
b += matrix[i] * t->blue;
}
r = (r / sum + color_adjust) & 0xffff;
g = (g / sum + color_adjust) & 0xffff;
b = (b / sum + color_adjust) & 0xffff;
p->red = p->green = p->blue = COLOR_INTENSITY (r, g, b);
}
}
xfree (colors);
x_from_xcolors (f, img, new);
#undef COLOR
}
static void
x_emboss (f, img)
struct frame *f;
struct image *img;
{
x_detect_edges (f, img, emboss_matrix, 0xffff / 2);
}
static void
x_laplace (f, img)
struct frame *f;
struct image *img;
{
x_detect_edges (f, img, laplace_matrix, 45000);
}
static void
x_edge_detection (f, img, matrix, color_adjust)
struct frame *f;
struct image *img;
Lisp_Object matrix, color_adjust;
{
int i = 0;
int trans[9];
if (CONSP (matrix))
{
for (i = 0;
i < 9 && CONSP (matrix) && NUMBERP (XCAR (matrix));
++i, matrix = XCDR (matrix))
trans[i] = XFLOATINT (XCAR (matrix));
}
else if (VECTORP (matrix) && ASIZE (matrix) >= 9)
{
for (i = 0; i < 9 && NUMBERP (AREF (matrix, i)); ++i)
trans[i] = XFLOATINT (AREF (matrix, i));
}
if (NILP (color_adjust))
color_adjust = make_number (0xffff / 2);
if (i == 9 && NUMBERP (color_adjust))
x_detect_edges (f, img, trans, (int) XFLOATINT (color_adjust));
}
static void
x_disable_image (f, img)
struct frame *f;
struct image *img;
{
struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
if (dpyinfo->n_planes >= 2)
{
XColor *colors = x_to_xcolors (f, img, 1);
XColor *p, *end;
const int h = 15000;
const int l = 30000;
for (p = colors, end = colors + img->width * img->height;
p < end;
++p)
{
int i = COLOR_INTENSITY (p->red, p->green, p->blue);
int i2 = (0xffff - h - l) * i / 0xffff + l;
p->red = p->green = p->blue = i2;
}
x_from_xcolors (f, img, colors);
}
if (dpyinfo->n_planes < 2 || cross_disabled_images)
{
Display *dpy = FRAME_X_DISPLAY (f);
GC gc;
gc = XCreateGC (dpy, img->pixmap, 0, NULL);
XSetForeground (dpy, gc, BLACK_PIX_DEFAULT (f));
XDrawLine (dpy, img->pixmap, gc, 0, 0,
img->width - 1, img->height - 1);
XDrawLine (dpy, img->pixmap, gc, 0, img->height - 1,
img->width - 1, 0);
XFreeGC (dpy, gc);
if (img->mask)
{
gc = XCreateGC (dpy, img->mask, 0, NULL);
XSetForeground (dpy, gc, WHITE_PIX_DEFAULT (f));
XDrawLine (dpy, img->mask, gc, 0, 0,
img->width - 1, img->height - 1);
XDrawLine (dpy, img->mask, gc, 0, img->height - 1,
img->width - 1, 0);
XFreeGC (dpy, gc);
}
}
}
static int
x_build_heuristic_mask (f, img, how)
struct frame *f;
struct image *img;
Lisp_Object how;
{
Display *dpy = FRAME_X_DISPLAY (f);
XImage *ximg, *mask_img;
int x, y, rc, look_at_corners_p;
unsigned long bg = 0;
if (img->mask)
{
XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
img->mask = None;
}
rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1,
&mask_img, &img->mask);
if (!rc)
return 0;
ximg = XGetImage (dpy, img->pixmap, 0, 0, img->width, img->height,
~0, ZPixmap);
look_at_corners_p = 1;
if (CONSP (how))
{
int rgb[3], i;
for (i = 0; i < 3 && CONSP (how) && NATNUMP (XCAR (how)); ++i)
{
rgb[i] = XFASTINT (XCAR (how)) & 0xffff;
how = XCDR (how);
}
if (i == 3 && NILP (how))
{
char color_name[30];
sprintf (color_name, "#%04x%04x%04x", rgb[0], rgb[1], rgb[2]);
bg = x_alloc_image_color (f, img, build_string (color_name), 0);
look_at_corners_p = 0;
}
}
if (look_at_corners_p)
{
unsigned long corners[4];
int i, best_count;
corners[0] = XGetPixel (ximg, 0, 0);
corners[1] = XGetPixel (ximg, img->width - 1, 0);
corners[2] = XGetPixel (ximg, img->width - 1, img->height - 1);
corners[3] = XGetPixel (ximg, 0, img->height - 1);
for (i = best_count = 0; i < 4; ++i)
{
int j, n;
for (j = n = 0; j < 4; ++j)
if (corners[i] == corners[j])
++n;
if (n > best_count)
bg = corners[i], best_count = n;
}
}
for (y = 0; y < img->height; ++y)
for (x = 0; x < img->width; ++x)
XPutPixel (mask_img, x, y, XGetPixel (ximg, x, y) != bg);
x_put_x_image (f, mask_img, img->mask, img->width, img->height);
x_destroy_x_image (mask_img);
XDestroyImage (ximg);
return 1;
}
static int pbm_image_p P_ ((Lisp_Object object));
static int pbm_load P_ ((struct frame *f, struct image *img));
static int pbm_scan_number P_ ((unsigned char **, unsigned char *));
Lisp_Object Qpbm;
enum pbm_keyword_index
{
PBM_TYPE,
PBM_FILE,
PBM_DATA,
PBM_ASCENT,
PBM_MARGIN,
PBM_RELIEF,
PBM_ALGORITHM,
PBM_HEURISTIC_MASK,
PBM_MASK,
PBM_FOREGROUND,
PBM_BACKGROUND,
PBM_LAST
};
static struct image_keyword pbm_format[PBM_LAST] =
{
{":type", IMAGE_SYMBOL_VALUE, 1},
{":file", IMAGE_STRING_VALUE, 0},
{":data", IMAGE_STRING_VALUE, 0},
{":ascent", IMAGE_ASCENT_VALUE, 0},
{":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
{":relief", IMAGE_INTEGER_VALUE, 0},
{":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
{":background", IMAGE_STRING_OR_NIL_VALUE, 0}
};
static struct image_type pbm_type =
{
&Qpbm,
pbm_image_p,
pbm_load,
x_clear_image,
NULL
};
static int
pbm_image_p (object)
Lisp_Object object;
{
struct image_keyword fmt[PBM_LAST];
bcopy (pbm_format, fmt, sizeof fmt);
if (!parse_image_spec (object, fmt, PBM_LAST, Qpbm))
return 0;
return fmt[PBM_DATA].count + fmt[PBM_FILE].count == 1;
}
static int
pbm_scan_number (s, end)
unsigned char **s, *end;
{
int c = 0, val = -1;
while (*s < end)
{
while (*s < end && (c = *(*s)++, isspace (c)))
;
if (c == '#')
{
while (*s < end && (c = *(*s)++, c != '\n'))
;
}
else if (isdigit (c))
{
val = c - '0';
while (*s < end && (c = *(*s)++, isdigit (c)))
val = 10 * val + c - '0';
break;
}
else
break;
}
return val;
}
static int
pbm_load (f, img)
struct frame *f;
struct image *img;
{
int raw_p, x, y;
int width, height, max_color_idx = 0;
XImage *ximg;
Lisp_Object file, specified_file;
enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type;
struct gcpro gcpro1;
unsigned char *contents = NULL;
unsigned char *end, *p;
int size;
specified_file = image_spec_value (img->spec, QCfile, NULL);
file = Qnil;
GCPRO1 (file);
if (STRINGP (specified_file))
{
file = x_find_image_file (specified_file);
if (!STRINGP (file))
{
image_error ("Cannot find image file `%s'", specified_file, Qnil);
UNGCPRO;
return 0;
}
contents = slurp_file (XSTRING (file)->data, &size);
if (contents == NULL)
{
image_error ("Error reading `%s'", file, Qnil);
UNGCPRO;
return 0;
}
p = contents;
end = contents + size;
}
else
{
Lisp_Object data;
data = image_spec_value (img->spec, QCdata, NULL);
p = XSTRING (data)->data;
end = p + STRING_BYTES (XSTRING (data));
}
if (end - p < 2 || *p++ != 'P')
{
image_error ("Not a PBM image: `%s'", img->spec, Qnil);
error:
xfree (contents);
UNGCPRO;
return 0;
}
switch (*p++)
{
case '1':
raw_p = 0, type = PBM_MONO;
break;
case '2':
raw_p = 0, type = PBM_GRAY;
break;
case '3':
raw_p = 0, type = PBM_COLOR;
break;
case '4':
raw_p = 1, type = PBM_MONO;
break;
case '5':
raw_p = 1, type = PBM_GRAY;
break;
case '6':
raw_p = 1, type = PBM_COLOR;
break;
default:
image_error ("Not a PBM image: `%s'", img->spec, Qnil);
goto error;
}
width = pbm_scan_number (&p, end);
height = pbm_scan_number (&p, end);
if (type != PBM_MONO)
{
max_color_idx = pbm_scan_number (&p, end);
if (raw_p && max_color_idx > 255)
max_color_idx = 255;
}
if (width < 0
|| height < 0
|| (type != PBM_MONO && max_color_idx < 0))
goto error;
if (!x_create_x_image_and_pixmap (f, width, height, 0,
&ximg, &img->pixmap))
goto error;
init_color_table ();
if (type == PBM_MONO)
{
int c = 0, g;
struct image_keyword fmt[PBM_LAST];
unsigned long fg = FRAME_FOREGROUND_PIXEL (f);
unsigned long bg = FRAME_BACKGROUND_PIXEL (f);
bcopy (pbm_format, fmt, sizeof fmt);
parse_image_spec (img->spec, fmt, PBM_LAST, Qpbm);
if (fmt[PBM_FOREGROUND].count
&& STRINGP (fmt[PBM_FOREGROUND].value))
fg = x_alloc_image_color (f, img, fmt[PBM_FOREGROUND].value, fg);
if (fmt[PBM_BACKGROUND].count
&& STRINGP (fmt[PBM_BACKGROUND].value))
bg = x_alloc_image_color (f, img, fmt[PBM_BACKGROUND].value, bg);
for (y = 0; y < height; ++y)
for (x = 0; x < width; ++x)
{
if (raw_p)
{
if ((x & 7) == 0)
c = *p++;
g = c & 0x80;
c <<= 1;
}
else
g = pbm_scan_number (&p, end);
XPutPixel (ximg, x, y, g ? fg : bg);
}
}
else
{
for (y = 0; y < height; ++y)
for (x = 0; x < width; ++x)
{
int r, g, b;
if (type == PBM_GRAY)
r = g = b = raw_p ? *p++ : pbm_scan_number (&p, end);
else if (raw_p)
{
r = *p++;
g = *p++;
b = *p++;
}
else
{
r = pbm_scan_number (&p, end);
g = pbm_scan_number (&p, end);
b = pbm_scan_number (&p, end);
}
if (r < 0 || g < 0 || b < 0)
{
xfree (ximg->data);
ximg->data = NULL;
XDestroyImage (ximg);
image_error ("Invalid pixel value in image `%s'",
img->spec, Qnil);
goto error;
}
r = (double) r * 65535 / max_color_idx;
g = (double) g * 65535 / max_color_idx;
b = (double) b * 65535 / max_color_idx;
XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
}
}
img->colors = colors_in_color_table (&img->ncolors);
free_color_table ();
x_put_x_image (f, ximg, img->pixmap, width, height);
x_destroy_x_image (ximg);
img->width = width;
img->height = height;
UNGCPRO;
xfree (contents);
return 1;
}
#if HAVE_PNG
#include <png.h>
static int png_image_p P_ ((Lisp_Object object));
static int png_load P_ ((struct frame *f, struct image *img));
Lisp_Object Qpng;
enum png_keyword_index
{
PNG_TYPE,
PNG_DATA,
PNG_FILE,
PNG_ASCENT,
PNG_MARGIN,
PNG_RELIEF,
PNG_ALGORITHM,
PNG_HEURISTIC_MASK,
PNG_MASK,
PNG_LAST
};
static struct image_keyword png_format[PNG_LAST] =
{
{":type", IMAGE_SYMBOL_VALUE, 1},
{":data", IMAGE_STRING_VALUE, 0},
{":file", IMAGE_STRING_VALUE, 0},
{":ascent", IMAGE_ASCENT_VALUE, 0},
{":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
{":relief", IMAGE_INTEGER_VALUE, 0},
{":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
};
static struct image_type png_type =
{
&Qpng,
png_image_p,
png_load,
x_clear_image,
NULL
};
static int
png_image_p (object)
Lisp_Object object;
{
struct image_keyword fmt[PNG_LAST];
bcopy (png_format, fmt, sizeof fmt);
if (!parse_image_spec (object, fmt, PNG_LAST, Qpng))
return 0;
return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
}
static void
my_png_error (png_ptr, msg)
png_struct *png_ptr;
char *msg;
{
xassert (png_ptr != NULL);
image_error ("PNG error: %s", build_string (msg), Qnil);
longjmp (png_ptr->jmpbuf, 1);
}
static void
my_png_warning (png_ptr, msg)
png_struct *png_ptr;
char *msg;
{
xassert (png_ptr != NULL);
image_error ("PNG warning: %s", build_string (msg), Qnil);
}
struct png_memory_storage
{
unsigned char *bytes;
size_t len;
int index;
};
static void
png_read_from_memory (png_ptr, data, length)
png_structp png_ptr;
png_bytep data;
png_size_t length;
{
struct png_memory_storage *tbr
= (struct png_memory_storage *) png_get_io_ptr (png_ptr);
if (length > tbr->len - tbr->index)
png_error (png_ptr, "Read error");
bcopy (tbr->bytes + tbr->index, data, length);
tbr->index = tbr->index + length;
}
static int
png_load (f, img)
struct frame *f;
struct image *img;
{
Lisp_Object file, specified_file;
Lisp_Object specified_data;
int x, y, i;
XImage *ximg, *mask_img = NULL;
struct gcpro gcpro1;
png_struct *png_ptr = NULL;
png_info *info_ptr = NULL, *end_info = NULL;
FILE *volatile fp = NULL;
png_byte sig[8];
png_byte * volatile pixels = NULL;
png_byte ** volatile rows = NULL;
png_uint_32 width, height;
int bit_depth, color_type, interlace_type;
png_byte channels;
png_uint_32 row_bytes;
int transparent_p;
char *gamma_str;
double screen_gamma, image_gamma;
int intent;
struct png_memory_storage tbr;
specified_file = image_spec_value (img->spec, QCfile, NULL);
specified_data = image_spec_value (img->spec, QCdata, NULL);
file = Qnil;
GCPRO1 (file);
if (NILP (specified_data))
{
file = x_find_image_file (specified_file);
if (!STRINGP (file))
{
image_error ("Cannot find image file `%s'", specified_file, Qnil);
UNGCPRO;
return 0;
}
fp = fopen (XSTRING (file)->data, "rb");
if (!fp)
{
image_error ("Cannot open image file `%s'", file, Qnil);
UNGCPRO;
fclose (fp);
return 0;
}
if (fread (sig, 1, sizeof sig, fp) != sizeof sig
|| !png_check_sig (sig, sizeof sig))
{
image_error ("Not a PNG file: `%s'", file, Qnil);
UNGCPRO;
fclose (fp);
return 0;
}
}
else
{
tbr.bytes = XSTRING (specified_data)->data;
tbr.len = STRING_BYTES (XSTRING (specified_data));
tbr.index = 0;
if (tbr.len < sizeof sig
|| !png_check_sig (tbr.bytes, sizeof sig))
{
image_error ("Not a PNG image: `%s'", img->spec, Qnil);
UNGCPRO;
return 0;
}
tbr.bytes += sizeof (sig);
}
png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL,
my_png_error, my_png_warning);
if (!png_ptr)
{
if (fp) fclose (fp);
UNGCPRO;
return 0;
}
info_ptr = png_create_info_struct (png_ptr);
if (!info_ptr)
{
png_destroy_read_struct (&png_ptr, NULL, NULL);
if (fp) fclose (fp);
UNGCPRO;
return 0;
}
end_info = png_create_info_struct (png_ptr);
if (!end_info)
{
png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
if (fp) fclose (fp);
UNGCPRO;
return 0;
}
if (setjmp (png_ptr->jmpbuf))
{
error:
if (png_ptr)
png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
xfree (pixels);
xfree (rows);
if (fp) fclose (fp);
UNGCPRO;
return 0;
}
if (!NILP (specified_data))
png_set_read_fn (png_ptr, (void *) &tbr, png_read_from_memory);
else
png_init_io (png_ptr, fp);
png_set_sig_bytes (png_ptr, sizeof sig);
png_read_info (png_ptr, info_ptr);
png_get_IHDR (png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
&interlace_type, NULL, NULL);
if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
transparent_p = 1;
else
transparent_p = 0;
if (bit_depth == 16)
png_set_strip_16 (png_ptr);
png_set_expand (png_ptr);
if (color_type == PNG_COLOR_TYPE_GRAY
|| color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
png_set_gray_to_rgb (png_ptr);
gamma_str = getenv ("SCREEN_GAMMA");
screen_gamma = gamma_str ? atof (gamma_str) : 2.2;
#if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
if (png_get_sRGB (png_ptr, info_ptr, &intent))
png_set_sRGB (png_ptr, info_ptr, intent);
else
#endif
if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
png_set_gamma (png_ptr, screen_gamma, image_gamma);
else
png_set_gamma (png_ptr, screen_gamma, 0.5);
if (!transparent_p)
{
png_color_16 *image_background;
if (png_get_bKGD (png_ptr, info_ptr, &image_background))
png_set_background (png_ptr, image_background,
PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
else
{
XColor color;
Colormap cmap;
png_color_16 frame_background;
cmap = FRAME_X_COLORMAP (f);
color.pixel = FRAME_BACKGROUND_PIXEL (f);
x_query_color (f, &color);
bzero (&frame_background, sizeof frame_background);
frame_background.red = color.red;
frame_background.green = color.green;
frame_background.blue = color.blue;
png_set_background (png_ptr, &frame_background,
PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
}
}
png_read_update_info (png_ptr, info_ptr);
channels = png_get_channels (png_ptr, info_ptr);
xassert (channels == 3 || channels == 4);
row_bytes = png_get_rowbytes (png_ptr, info_ptr);
pixels = (png_byte *) xmalloc (row_bytes * height * sizeof *pixels);
rows = (png_byte **) xmalloc (height * sizeof *rows);
for (i = 0; i < height; ++i)
rows[i] = pixels + i * row_bytes;
png_read_image (png_ptr, rows);
png_read_end (png_ptr, info_ptr);
if (fp)
{
fclose (fp);
fp = NULL;
}
if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
&img->pixmap))
goto error;
if (channels == 4
&& !transparent_p
&& !x_create_x_image_and_pixmap (f, width, height, 1,
&mask_img, &img->mask))
{
x_destroy_x_image (ximg);
XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
img->pixmap = None;
goto error;
}
init_color_table ();
for (y = 0; y < height; ++y)
{
png_byte *p = rows[y];
for (x = 0; x < width; ++x)
{
unsigned r, g, b;
r = *p++ << 8;
g = *p++ << 8;
b = *p++ << 8;
XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
if (channels == 4)
{
if (mask_img)
XPutPixel (mask_img, x, y, *p > 0);
++p;
}
}
}
img->colors = colors_in_color_table (&img->ncolors);
free_color_table ();
png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
xfree (rows);
xfree (pixels);
img->width = width;
img->height = height;
x_put_x_image (f, ximg, img->pixmap, width, height);
x_destroy_x_image (ximg);
if (mask_img)
{
x_put_x_image (f, mask_img, img->mask, img->width, img->height);
x_destroy_x_image (mask_img);
}
UNGCPRO;
return 1;
}
#endif
#if HAVE_JPEG
#ifdef HAVE_STDLIB_H
#define HAVE_STDLIB_H_1
#undef HAVE_STDLIB_H
#endif
#include <jpeglib.h>
#include <jerror.h>
#include <setjmp.h>
#ifdef HAVE_STLIB_H_1
#define HAVE_STDLIB_H 1
#endif
static int jpeg_image_p P_ ((Lisp_Object object));
static int jpeg_load P_ ((struct frame *f, struct image *img));
Lisp_Object Qjpeg;
enum jpeg_keyword_index
{
JPEG_TYPE,
JPEG_DATA,
JPEG_FILE,
JPEG_ASCENT,
JPEG_MARGIN,
JPEG_RELIEF,
JPEG_ALGORITHM,
JPEG_HEURISTIC_MASK,
JPEG_MASK,
JPEG_LAST
};
static struct image_keyword jpeg_format[JPEG_LAST] =
{
{":type", IMAGE_SYMBOL_VALUE, 1},
{":data", IMAGE_STRING_VALUE, 0},
{":file", IMAGE_STRING_VALUE, 0},
{":ascent", IMAGE_ASCENT_VALUE, 0},
{":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
{":relief", IMAGE_INTEGER_VALUE, 0},
{":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
};
static struct image_type jpeg_type =
{
&Qjpeg,
jpeg_image_p,
jpeg_load,
x_clear_image,
NULL
};
static int
jpeg_image_p (object)
Lisp_Object object;
{
struct image_keyword fmt[JPEG_LAST];
bcopy (jpeg_format, fmt, sizeof fmt);
if (!parse_image_spec (object, fmt, JPEG_LAST, Qjpeg))
return 0;
return fmt[JPEG_FILE].count + fmt[JPEG_DATA].count == 1;
}
struct my_jpeg_error_mgr
{
struct jpeg_error_mgr pub;
jmp_buf setjmp_buffer;
};
static void
my_error_exit (cinfo)
j_common_ptr cinfo;
{
struct my_jpeg_error_mgr *mgr = (struct my_jpeg_error_mgr *) cinfo->err;
longjmp (mgr->setjmp_buffer, 1);
}
static void
our_init_source (cinfo)
j_decompress_ptr cinfo;
{
}
static boolean
our_fill_input_buffer (cinfo)
j_decompress_ptr cinfo;
{
struct jpeg_source_mgr *src = cinfo->src;
static JOCTET buffer[2];
buffer[0] = (JOCTET) 0xFF;
buffer[1] = (JOCTET) JPEG_EOI;
src->next_input_byte = buffer;
src->bytes_in_buffer = 2;
return TRUE;
}
static void
our_skip_input_data (cinfo, num_bytes)
j_decompress_ptr cinfo;
long num_bytes;
{
struct jpeg_source_mgr *src = (struct jpeg_source_mgr *) cinfo->src;
if (src)
{
if (num_bytes > src->bytes_in_buffer)
ERREXIT (cinfo, JERR_INPUT_EOF);
src->bytes_in_buffer -= num_bytes;
src->next_input_byte += num_bytes;
}
}
static void
our_term_source (cinfo)
j_decompress_ptr cinfo;
{
}
static void
jpeg_memory_src (cinfo, data, len)
j_decompress_ptr cinfo;
JOCTET *data;
unsigned int len;
{
struct jpeg_source_mgr *src;
if (cinfo->src == NULL)
{
cinfo->src = (struct jpeg_source_mgr *)
(*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,
sizeof (struct jpeg_source_mgr));
src = (struct jpeg_source_mgr *) cinfo->src;
src->next_input_byte = data;
}
src = (struct jpeg_source_mgr *) cinfo->src;
src->init_source = our_init_source;
src->fill_input_buffer = our_fill_input_buffer;
src->skip_input_data = our_skip_input_data;
src->resync_to_restart = jpeg_resync_to_restart;
src->term_source = our_term_source;
src->bytes_in_buffer = len;
src->next_input_byte = data;
}
static int
jpeg_load (f, img)
struct frame *f;
struct image *img;
{
struct jpeg_decompress_struct cinfo;
struct my_jpeg_error_mgr mgr;
Lisp_Object file, specified_file;
Lisp_Object specified_data;
FILE * volatile fp = NULL;
JSAMPARRAY buffer;
int row_stride, x, y;
XImage *ximg = NULL;
int rc;
unsigned long *colors;
int width, height;
struct gcpro gcpro1;
specified_file = image_spec_value (img->spec, QCfile, NULL);
specified_data = image_spec_value (img->spec, QCdata, NULL);
file = Qnil;
GCPRO1 (file);
if (NILP (specified_data))
{
file = x_find_image_file (specified_file);
if (!STRINGP (file))
{
image_error ("Cannot find image file `%s'", specified_file, Qnil);
UNGCPRO;
return 0;
}
fp = fopen (XSTRING (file)->data, "r");
if (fp == NULL)
{
image_error ("Cannot open `%s'", file, Qnil);
UNGCPRO;
return 0;
}
}
cinfo.err = jpeg_std_error (&mgr.pub);
mgr.pub.error_exit = my_error_exit;
if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
{
if (rc == 1)
{
char buffer[JMSG_LENGTH_MAX];
cinfo.err->format_message ((j_common_ptr) &cinfo, buffer);
image_error ("Error reading JPEG image `%s': %s", img->spec,
build_string (buffer));
}
if (fp)
fclose ((FILE *) fp);
jpeg_destroy_decompress (&cinfo);
x_destroy_x_image (ximg);
x_clear_image (f, img);
UNGCPRO;
return 0;
}
jpeg_create_decompress (&cinfo);
if (NILP (specified_data))
jpeg_stdio_src (&cinfo, (FILE *) fp);
else
jpeg_memory_src (&cinfo, XSTRING (specified_data)->data,
STRING_BYTES (XSTRING (specified_data)));
jpeg_read_header (&cinfo, TRUE);
cinfo.quantize_colors = TRUE;
jpeg_start_decompress (&cinfo);
width = img->width = cinfo.output_width;
height = img->height = cinfo.output_height;
if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
longjmp (mgr.setjmp_buffer, 2);
{
int i, ir, ig, ib;
if (cinfo.out_color_components > 2)
ir = 0, ig = 1, ib = 2;
else if (cinfo.out_color_components > 1)
ir = 0, ig = 1, ib = 0;
else
ir = 0, ig = 0, ib = 0;
init_color_table ();
colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
* sizeof *colors);
for (i = 0; i < cinfo.actual_number_of_colors; ++i)
{
int r = cinfo.colormap[ir][i] << 8;
int g = cinfo.colormap[ig][i] << 8;
int b = cinfo.colormap[ib][i] << 8;
colors[i] = lookup_rgb_color (f, r, g, b);
}
img->colors = colors_in_color_table (&img->ncolors);
free_color_table ();
}
row_stride = width * cinfo.output_components;
buffer = cinfo.mem->alloc_sarray ((j_common_ptr) &cinfo, JPOOL_IMAGE,
row_stride, 1);
for (y = 0; y < height; ++y)
{
jpeg_read_scanlines (&cinfo, buffer, 1);
for (x = 0; x < cinfo.output_width; ++x)
XPutPixel (ximg, x, y, colors[buffer[0][x]]);
}
jpeg_finish_decompress (&cinfo);
jpeg_destroy_decompress (&cinfo);
if (fp)
fclose ((FILE *) fp);
x_put_x_image (f, ximg, img->pixmap, width, height);
x_destroy_x_image (ximg);
UNGCPRO;
return 1;
}
#endif
#if HAVE_TIFF
#include <tiffio.h>
static int tiff_image_p P_ ((Lisp_Object object));
static int tiff_load P_ ((struct frame *f, struct image *img));
Lisp_Object Qtiff;
enum tiff_keyword_index
{
TIFF_TYPE,
TIFF_DATA,
TIFF_FILE,
TIFF_ASCENT,
TIFF_MARGIN,
TIFF_RELIEF,
TIFF_ALGORITHM,
TIFF_HEURISTIC_MASK,
TIFF_MASK,
TIFF_LAST
};
static struct image_keyword tiff_format[TIFF_LAST] =
{
{":type", IMAGE_SYMBOL_VALUE, 1},
{":data", IMAGE_STRING_VALUE, 0},
{":file", IMAGE_STRING_VALUE, 0},
{":ascent", IMAGE_ASCENT_VALUE, 0},
{":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
{":relief", IMAGE_INTEGER_VALUE, 0},
{":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
};
static struct image_type tiff_type =
{
&Qtiff,
tiff_image_p,
tiff_load,
x_clear_image,
NULL
};
static int
tiff_image_p (object)
Lisp_Object object;
{
struct image_keyword fmt[TIFF_LAST];
bcopy (tiff_format, fmt, sizeof fmt);
if (!parse_image_spec (object, fmt, TIFF_LAST, Qtiff))
return 0;
return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
}
typedef struct
{
unsigned char *bytes;
size_t len;
int index;
}
tiff_memory_source;
static size_t
tiff_read_from_memory (data, buf, size)
thandle_t data;
tdata_t buf;
tsize_t size;
{
tiff_memory_source *src = (tiff_memory_source *) data;
if (size > src->len - src->index)
return (size_t) -1;
bcopy (src->bytes + src->index, buf, size);
src->index += size;
return size;
}
static size_t
tiff_write_from_memory (data, buf, size)
thandle_t data;
tdata_t buf;
tsize_t size;
{
return (size_t) -1;
}
static toff_t
tiff_seek_in_memory (data, off, whence)
thandle_t data;
toff_t off;
int whence;
{
tiff_memory_source *src = (tiff_memory_source *) data;
int idx;
switch (whence)
{
case SEEK_SET:
idx = off;
break;
case SEEK_END:
idx = src->len + off;
break;
case SEEK_CUR:
idx = src->index + off;
break;
default:
return -1;
}
if (idx > src->len || idx < 0)
return -1;
src->index = idx;
return src->index;
}
static int
tiff_close_memory (data)
thandle_t data;
{
return 0;
}
static int
tiff_mmap_memory (data, pbase, psize)
thandle_t data;
tdata_t *pbase;
toff_t *psize;
{
return 0;
}
static void
tiff_unmap_memory (data, base, size)
thandle_t data;
tdata_t base;
toff_t size;
{
}
static toff_t
tiff_size_of_memory (data)
thandle_t data;
{
return ((tiff_memory_source *) data)->len;
}
static int
tiff_load (f, img)
struct frame *f;
struct image *img;
{
Lisp_Object file, specified_file;
Lisp_Object specified_data;
TIFF *tiff;
int width, height, x, y;
uint32 *buf;
int rc;
XImage *ximg;
struct gcpro gcpro1;
tiff_memory_source memsrc;
specified_file = image_spec_value (img->spec, QCfile, NULL);
specified_data = image_spec_value (img->spec, QCdata, NULL);
file = Qnil;
GCPRO1 (file);
if (NILP (specified_data))
{
file = x_find_image_file (specified_file);
if (!STRINGP (file))
{
image_error ("Cannot find image file `%s'", file, Qnil);
UNGCPRO;
return 0;
}
tiff = TIFFOpen (XSTRING (file)->data, "r");
if (tiff == NULL)
{
image_error ("Cannot open `%s'", file, Qnil);
UNGCPRO;
return 0;
}
}
else
{
memsrc.bytes = XSTRING (specified_data)->data;
memsrc.len = STRING_BYTES (XSTRING (specified_data));
memsrc.index = 0;
tiff = TIFFClientOpen ("memory_source", "r", &memsrc,
(TIFFReadWriteProc) tiff_read_from_memory,
(TIFFReadWriteProc) tiff_write_from_memory,
tiff_seek_in_memory,
tiff_close_memory,
tiff_size_of_memory,
tiff_mmap_memory,
tiff_unmap_memory);
if (!tiff)
{
image_error ("Cannot open memory source for `%s'", img->spec, Qnil);
UNGCPRO;
return 0;
}
}
TIFFGetField (tiff, TIFFTAG_IMAGEWIDTH, &width);
TIFFGetField (tiff, TIFFTAG_IMAGELENGTH, &height);
buf = (uint32 *) xmalloc (width * height * sizeof *buf);
rc = TIFFReadRGBAImage (tiff, width, height, buf, 0);
TIFFClose (tiff);
if (!rc)
{
image_error ("Error reading TIFF image `%s'", img->spec, Qnil);
xfree (buf);
UNGCPRO;
return 0;
}
if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
{
xfree (buf);
UNGCPRO;
return 0;
}
init_color_table ();
for (y = 0; y < height; ++y)
{
uint32 *row = buf + y * width;
for (x = 0; x < width; ++x)
{
uint32 abgr = row[x];
int r = TIFFGetR (abgr) << 8;
int g = TIFFGetG (abgr) << 8;
int b = TIFFGetB (abgr) << 8;
XPutPixel (ximg, x, height - 1 - y, lookup_rgb_color (f, r, g, b));
}
}
img->colors = colors_in_color_table (&img->ncolors);
free_color_table ();
x_put_x_image (f, ximg, img->pixmap, width, height);
x_destroy_x_image (ximg);
xfree (buf);
img->width = width;
img->height = height;
UNGCPRO;
return 1;
}
#endif
#if HAVE_GIF
#include <gif_lib.h>
static int gif_image_p P_ ((Lisp_Object object));
static int gif_load P_ ((struct frame *f, struct image *img));
Lisp_Object Qgif;
enum gif_keyword_index
{
GIF_TYPE,
GIF_DATA,
GIF_FILE,
GIF_ASCENT,
GIF_MARGIN,
GIF_RELIEF,
GIF_ALGORITHM,
GIF_HEURISTIC_MASK,
GIF_MASK,
GIF_IMAGE,
GIF_LAST
};
static struct image_keyword gif_format[GIF_LAST] =
{
{":type", IMAGE_SYMBOL_VALUE, 1},
{":data", IMAGE_STRING_VALUE, 0},
{":file", IMAGE_STRING_VALUE, 0},
{":ascent", IMAGE_ASCENT_VALUE, 0},
{":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
{":relief", IMAGE_INTEGER_VALUE, 0},
{":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0}
};
static struct image_type gif_type =
{
&Qgif,
gif_image_p,
gif_load,
x_clear_image,
NULL
};
static int
gif_image_p (object)
Lisp_Object object;
{
struct image_keyword fmt[GIF_LAST];
bcopy (gif_format, fmt, sizeof fmt);
if (!parse_image_spec (object, fmt, GIF_LAST, Qgif))
return 0;
return fmt[GIF_FILE].count + fmt[GIF_DATA].count == 1;
}
typedef struct
{
unsigned char *bytes;
size_t len;
int index;
}
gif_memory_source;
static gif_memory_source *current_gif_memory_src;
static int
gif_read_from_memory (file, buf, len)
GifFileType *file;
GifByteType *buf;
int len;
{
gif_memory_source *src = current_gif_memory_src;
if (len > src->len - src->index)
return -1;
bcopy (src->bytes + src->index, buf, len);
src->index += len;
return len;
}
static int
gif_load (f, img)
struct frame *f;
struct image *img;
{
Lisp_Object file, specified_file;
Lisp_Object specified_data;
int rc, width, height, x, y, i;
XImage *ximg;
ColorMapObject *gif_color_map;
unsigned long pixel_colors[256];
GifFileType *gif;
struct gcpro gcpro1;
Lisp_Object image;
int ino, image_left, image_top, image_width, image_height;
gif_memory_source memsrc;
unsigned char *raster;
specified_file = image_spec_value (img->spec, QCfile, NULL);
specified_data = image_spec_value (img->spec, QCdata, NULL);
file = Qnil;
GCPRO1 (file);
if (NILP (specified_data))
{
file = x_find_image_file (specified_file);
if (!STRINGP (file))
{
image_error ("Cannot find image file `%s'", specified_file, Qnil);
UNGCPRO;
return 0;
}
gif = DGifOpenFileName (XSTRING (file)->data);
if (gif == NULL)
{
image_error ("Cannot open `%s'", file, Qnil);
UNGCPRO;
return 0;
}
}
else
{
current_gif_memory_src = &memsrc;
memsrc.bytes = XSTRING (specified_data)->data;
memsrc.len = STRING_BYTES (XSTRING (specified_data));
memsrc.index = 0;
gif = DGifOpen(&memsrc, gif_read_from_memory);
if (!gif)
{
image_error ("Cannot open memory source `%s'", img->spec, Qnil);
UNGCPRO;
return 0;
}
}
rc = DGifSlurp (gif);
if (rc == GIF_ERROR)
{
image_error ("Error reading `%s'", img->spec, Qnil);
DGifCloseFile (gif);
UNGCPRO;
return 0;
}
image = image_spec_value (img->spec, QCindex, NULL);
ino = INTEGERP (image) ? XFASTINT (image) : 0;
if (ino >= gif->ImageCount)
{
image_error ("Invalid image number `%s' in image `%s'",
image, img->spec);
DGifCloseFile (gif);
UNGCPRO;
return 0;
}
width = img->width = max (gif->SWidth, gif->Image.Left + gif->Image.Width);
height = img->height = max (gif->SHeight, gif->Image.Top + gif->Image.Height);
if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
{
DGifCloseFile (gif);
UNGCPRO;
return 0;
}
gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap;
if (!gif_color_map)
gif_color_map = gif->SColorMap;
init_color_table ();
bzero (pixel_colors, sizeof pixel_colors);
for (i = 0; i < gif_color_map->ColorCount; ++i)
{
int r = gif_color_map->Colors[i].Red << 8;
int g = gif_color_map->Colors[i].Green << 8;
int b = gif_color_map->Colors[i].Blue << 8;
pixel_colors[i] = lookup_rgb_color (f, r, g, b);
}
img->colors = colors_in_color_table (&img->ncolors);
free_color_table ();
image_top = gif->SavedImages[ino].ImageDesc.Top;
image_left = gif->SavedImages[ino].ImageDesc.Left;
image_width = gif->SavedImages[ino].ImageDesc.Width;
image_height = gif->SavedImages[ino].ImageDesc.Height;
for (y = 0; y < image_top; ++y)
for (x = 0; x < width; ++x)
XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
for (y = image_top + image_height; y < height; ++y)
for (x = 0; x < width; ++x)
XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
for (y = image_top; y < image_top + image_height; ++y)
{
for (x = 0; x < image_left; ++x)
XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
for (x = image_left + image_width; x < width; ++x)
XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
}
raster = (unsigned char *) gif->SavedImages[ino].RasterBits;
if (gif->SavedImages[ino].ImageDesc.Interlace)
{
static int interlace_start[] = {0, 4, 2, 1};
static int interlace_increment[] = {8, 8, 4, 2};
int pass;
int row = interlace_start[0];
pass = 0;
for (y = 0; y < image_height; y++)
{
if (row >= image_height)
{
row = interlace_start[++pass];
while (row >= image_height)
row = interlace_start[++pass];
}
for (x = 0; x < image_width; x++)
{
int i = raster[(y * image_width) + x];
XPutPixel (ximg, x + image_left, row + image_top,
pixel_colors[i]);
}
row += interlace_increment[pass];
}
}
else
{
for (y = 0; y < image_height; ++y)
for (x = 0; x < image_width; ++x)
{
int i = raster[y * image_width + x];
XPutPixel (ximg, x + image_left, y + image_top, pixel_colors[i]);
}
}
DGifCloseFile (gif);
x_put_x_image (f, ximg, img->pixmap, width, height);
x_destroy_x_image (ximg);
UNGCPRO;
return 1;
}
#endif
static int gs_image_p P_ ((Lisp_Object object));
static int gs_load P_ ((struct frame *f, struct image *img));
static void gs_clear_image P_ ((struct frame *f, struct image *img));
Lisp_Object Qpostscript;
Lisp_Object QCloader, QCbounding_box, QCpt_width, QCpt_height;
enum gs_keyword_index
{
GS_TYPE,
GS_PT_WIDTH,
GS_PT_HEIGHT,
GS_FILE,
GS_LOADER,
GS_BOUNDING_BOX,
GS_ASCENT,
GS_MARGIN,
GS_RELIEF,
GS_ALGORITHM,
GS_HEURISTIC_MASK,
GS_MASK,
GS_LAST
};
static struct image_keyword gs_format[GS_LAST] =
{
{":type", IMAGE_SYMBOL_VALUE, 1},
{":pt-width", IMAGE_POSITIVE_INTEGER_VALUE, 1},
{":pt-height", IMAGE_POSITIVE_INTEGER_VALUE, 1},
{":file", IMAGE_STRING_VALUE, 1},
{":loader", IMAGE_FUNCTION_VALUE, 0},
{":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE, 1},
{":ascent", IMAGE_ASCENT_VALUE, 0},
{":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
{":relief", IMAGE_INTEGER_VALUE, 0},
{":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
};
static struct image_type gs_type =
{
&Qpostscript,
gs_image_p,
gs_load,
gs_clear_image,
NULL
};
static void
gs_clear_image (f, img)
struct frame *f;
struct image *img;
{
xfree (img->data.ptr_val);
x_clear_image (f, img);
}
static int
gs_image_p (object)
Lisp_Object object;
{
struct image_keyword fmt[GS_LAST];
Lisp_Object tem;
int i;
bcopy (gs_format, fmt, sizeof fmt);
if (!parse_image_spec (object, fmt, GS_LAST, Qpostscript))
return 0;
tem = fmt[GS_BOUNDING_BOX].value;
if (CONSP (tem))
{
for (i = 0; i < 4; ++i, tem = XCDR (tem))
if (!CONSP (tem) || !INTEGERP (XCAR (tem)))
return 0;
if (!NILP (tem))
return 0;
}
else if (VECTORP (tem))
{
if (XVECTOR (tem)->size != 4)
return 0;
for (i = 0; i < 4; ++i)
if (!INTEGERP (XVECTOR (tem)->contents[i]))
return 0;
}
else
return 0;
return 1;
}
static int
gs_load (f, img)
struct frame *f;
struct image *img;
{
char buffer[100];
Lisp_Object window_and_pixmap_id = Qnil, loader, pt_height, pt_width;
struct gcpro gcpro1, gcpro2;
Lisp_Object frame;
double in_width, in_height;
Lisp_Object pixel_colors = Qnil;
pt_width = image_spec_value (img->spec, QCpt_width, NULL);
in_width = XFASTINT (pt_width) / 72.0;
img->width = in_width * FRAME_X_DISPLAY_INFO (f)->resx;
pt_height = image_spec_value (img->spec, QCpt_height, NULL);
in_height = XFASTINT (pt_height) / 72.0;
img->height = in_height * FRAME_X_DISPLAY_INFO (f)->resy;
xassert (img->pixmap == None);
img->pixmap = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
img->width, img->height,
DefaultDepthOfScreen (FRAME_X_SCREEN (f)));
if (!img->pixmap)
{
image_error ("Unable to create pixmap for `%s'", img->spec, Qnil);
return 0;
}
GCPRO2 (window_and_pixmap_id, pixel_colors);
sprintf (buffer, "%lu %lu",
(unsigned long) FRAME_X_WINDOW (f),
(unsigned long) img->pixmap);
window_and_pixmap_id = build_string (buffer);
sprintf (buffer, "%lu %lu",
FRAME_FOREGROUND_PIXEL (f),
FRAME_BACKGROUND_PIXEL (f));
pixel_colors = build_string (buffer);
XSETFRAME (frame, f);
loader = image_spec_value (img->spec, QCloader, NULL);
if (NILP (loader))
loader = intern ("gs-load-image");
img->data.lisp_val = call6 (loader, frame, img->spec,
make_number (img->width),
make_number (img->height),
window_and_pixmap_id,
pixel_colors);
UNGCPRO;
return PROCESSP (img->data.lisp_val);
}
void
x_kill_gs_process (pixmap, f)
Pixmap pixmap;
struct frame *f;
{
struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
int class, i;
struct image *img;
for (i = 0; i < c->used; ++i)
if (c->images[i]->pixmap == pixmap)
break;
if (i == c->used)
return;
img = c->images[i];
xassert (PROCESSP (img->data.lisp_val));
Fkill_process (img->data.lisp_val, Qnil);
img->data.lisp_val = Qnil;
class = FRAME_X_VISUAL (f)->class;
if (class != StaticColor && class != StaticGray && class != TrueColor)
{
XImage *ximg;
BLOCK_INPUT;
ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
0, 0, img->width, img->height, ~0, ZPixmap);
if (ximg)
{
int x, y;
init_color_table ();
for (y = 0; y < img->height; ++y)
for (x = 0; x < img->width; ++x)
{
unsigned long pixel = XGetPixel (ximg, x, y);
lookup_pixel_color (f, pixel);
}
img->colors = colors_in_color_table (&img->ncolors);
free_color_table ();
XDestroyImage (ximg);
#if 0
if (img->ncolors)
x_free_colors (f, img->colors, img->ncolors);
#endif
}
else
image_error ("Cannot get X image of `%s'; colors will not be freed",
img->spec, Qnil);
UNBLOCK_INPUT;
}
BLOCK_INPUT;
postprocess_image (f, img);
UNBLOCK_INPUT;
}
DEFUN ("x-change-window-property", Fx_change_window_property,
Sx_change_window_property, 2, 3, 0,
"Change window property PROP to VALUE on the X window of FRAME.\n\
PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
selected frame. Value is VALUE.")
(prop, value, frame)
Lisp_Object frame, prop, value;
{
struct frame *f = check_x_frame (frame);
Atom prop_atom;
CHECK_STRING (prop, 1);
CHECK_STRING (value, 2);
BLOCK_INPUT;
prop_atom = XInternAtom (FRAME_X_DISPLAY (f), XSTRING (prop)->data, False);
XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
prop_atom, XA_STRING, 8, PropModeReplace,
XSTRING (value)->data, XSTRING (value)->size);
XFlush (FRAME_X_DISPLAY (f));
UNBLOCK_INPUT;
return value;
}
DEFUN ("x-delete-window-property", Fx_delete_window_property,
Sx_delete_window_property, 1, 2, 0,
"Remove window property PROP from X window of FRAME.\n\
FRAME nil or omitted means use the selected frame. Value is PROP.")
(prop, frame)
Lisp_Object prop, frame;
{
struct frame *f = check_x_frame (frame);
Atom prop_atom;
CHECK_STRING (prop, 1);
BLOCK_INPUT;
prop_atom = XInternAtom (FRAME_X_DISPLAY (f), XSTRING (prop)->data, False);
XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), prop_atom);
XFlush (FRAME_X_DISPLAY (f));
UNBLOCK_INPUT;
return prop;
}
DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
1, 2, 0,
"Value is the value of window property PROP on FRAME.\n\
If FRAME is nil or omitted, use the selected frame. Value is nil\n\
if FRAME hasn't a property with name PROP or if PROP has no string\n\
value.")
(prop, frame)
Lisp_Object prop, frame;
{
struct frame *f = check_x_frame (frame);
Atom prop_atom;
int rc;
Lisp_Object prop_value = Qnil;
char *tmp_data = NULL;
Atom actual_type;
int actual_format;
unsigned long actual_size, bytes_remaining;
CHECK_STRING (prop, 1);
BLOCK_INPUT;
prop_atom = XInternAtom (FRAME_X_DISPLAY (f), XSTRING (prop)->data, False);
rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
prop_atom, 0, 0, False, XA_STRING,
&actual_type, &actual_format, &actual_size,
&bytes_remaining, (unsigned char **) &tmp_data);
if (rc == Success)
{
int size = bytes_remaining;
XFree (tmp_data);
tmp_data = NULL;
rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
prop_atom, 0, bytes_remaining,
False, XA_STRING,
&actual_type, &actual_format,
&actual_size, &bytes_remaining,
(unsigned char **) &tmp_data);
if (rc == Success && tmp_data)
prop_value = make_string (tmp_data, size);
XFree (tmp_data);
}
UNBLOCK_INPUT;
return prop_value;
}
static struct atimer *hourglass_atimer;
static int hourglass_shown_p;
static Lisp_Object Vhourglass_delay;
#define DEFAULT_HOURGLASS_DELAY 1
static void show_hourglass P_ ((struct atimer *));
static void hide_hourglass P_ ((void));
void
start_hourglass ()
{
EMACS_TIME delay;
int secs, usecs = 0;
cancel_hourglass ();
if (INTEGERP (Vhourglass_delay)
&& XINT (Vhourglass_delay) > 0)
secs = XFASTINT (Vhourglass_delay);
else if (FLOATP (Vhourglass_delay)
&& XFLOAT_DATA (Vhourglass_delay) > 0)
{
Lisp_Object tem;
tem = Ftruncate (Vhourglass_delay, Qnil);
secs = XFASTINT (tem);
usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
}
else
secs = DEFAULT_HOURGLASS_DELAY;
EMACS_SET_SECS_USECS (delay, secs, usecs);
hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
show_hourglass, NULL);
}
void
cancel_hourglass ()
{
if (hourglass_atimer)
{
cancel_atimer (hourglass_atimer);
hourglass_atimer = NULL;
}
if (hourglass_shown_p)
hide_hourglass ();
}
static void
show_hourglass (timer)
struct atimer *timer;
{
hourglass_atimer = NULL;
if (!hourglass_shown_p)
{
Lisp_Object rest, frame;
BLOCK_INPUT;
FOR_EACH_FRAME (rest, frame)
{
struct frame *f = XFRAME (frame);
if (FRAME_LIVE_P (f) && FRAME_X_P (f) && FRAME_X_DISPLAY (f))
{
Display *dpy = FRAME_X_DISPLAY (f);
#ifdef USE_X_TOOLKIT
if (f->output_data.x->widget)
#else
if (FRAME_OUTER_WINDOW (f))
#endif
{
f->output_data.x->hourglass_p = 1;
if (!f->output_data.x->hourglass_window)
{
unsigned long mask = CWCursor;
XSetWindowAttributes attrs;
attrs.cursor = f->output_data.x->hourglass_cursor;
f->output_data.x->hourglass_window
= XCreateWindow (dpy, FRAME_OUTER_WINDOW (f),
0, 0, 32000, 32000, 0, 0,
InputOnly,
CopyFromParent,
mask, &attrs);
}
XMapRaised (dpy, f->output_data.x->hourglass_window);
XFlush (dpy);
}
}
}
hourglass_shown_p = 1;
UNBLOCK_INPUT;
}
}
static void
hide_hourglass ()
{
if (hourglass_shown_p)
{
Lisp_Object rest, frame;
BLOCK_INPUT;
FOR_EACH_FRAME (rest, frame)
{
struct frame *f = XFRAME (frame);
if (FRAME_X_P (f)
&& f->output_data.x->hourglass_window)
{
XUnmapWindow (FRAME_X_DISPLAY (f),
f->output_data.x->hourglass_window);
XSync (FRAME_X_DISPLAY (f), False);
f->output_data.x->hourglass_p = 0;
}
}
hourglass_shown_p = 0;
UNBLOCK_INPUT;
}
}
static Lisp_Object x_create_tip_frame P_ ((struct x_display_info *,
Lisp_Object, Lisp_Object));
static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
Lisp_Object, int, int, int *, int *));
Lisp_Object tip_frame;
Lisp_Object tip_timer;
Window tip_window;
Lisp_Object last_show_tip_args;
Lisp_Object Vx_max_tooltip_size;
static Lisp_Object
unwind_create_tip_frame (frame)
Lisp_Object frame;
{
Lisp_Object deleted;
deleted = unwind_create_frame (frame);
if (EQ (deleted, Qt))
{
tip_window = None;
tip_frame = Qnil;
}
return deleted;
}
static Lisp_Object
x_create_tip_frame (dpyinfo, parms, text)
struct x_display_info *dpyinfo;
Lisp_Object parms, text;
{
struct frame *f;
Lisp_Object frame, tem;
Lisp_Object name;
long window_prompting = 0;
int width, height;
int count = BINDING_STACK_SIZE ();
struct gcpro gcpro1, gcpro2, gcpro3;
struct kboard *kb;
int face_change_count_before = face_change_count;
Lisp_Object buffer;
struct buffer *old_buffer;
check_x ();
Vx_resource_name = Vinvocation_name;
#ifdef MULTI_KBOARD
kb = dpyinfo->kboard;
#else
kb = &the_only_kboard;
#endif
name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
if (!STRINGP (name)
&& !EQ (name, Qunbound)
&& !NILP (name))
error ("Invalid frame name--not a string or nil");
Vx_resource_name = name;
frame = Qnil;
GCPRO3 (parms, name, frame);
f = make_frame (1);
XSETFRAME (frame, f);
buffer = Fget_buffer_create (build_string (" *tip*"));
Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer);
old_buffer = current_buffer;
set_buffer_internal_1 (XBUFFER (buffer));
current_buffer->truncate_lines = Qnil;
Ferase_buffer ();
Finsert (1, &text);
set_buffer_internal_1 (old_buffer);
FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
record_unwind_protect (unwind_create_tip_frame, frame);
f->output_method = output_x_window;
f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
bzero (f->output_data.x, sizeof (struct x_output));
f->output_data.x->icon_bitmap = -1;
f->output_data.x->fontset = -1;
f->output_data.x->scroll_bar_foreground_pixel = -1;
f->output_data.x->scroll_bar_background_pixel = -1;
f->icon_name = Qnil;
FRAME_X_DISPLAY_INFO (f) = dpyinfo;
#if GLYPH_DEBUG
image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
dpyinfo_refcount = dpyinfo->reference_count;
#endif
#ifdef MULTI_KBOARD
FRAME_KBOARD (f) = kb;
#endif
f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
f->output_data.x->explicit_parent = 0;
{
Lisp_Object black;
struct gcpro gcpro1;
black = build_string ("black");
GCPRO1 (black);
f->output_data.x->foreground_pixel
= x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
f->output_data.x->background_pixel
= x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
f->output_data.x->cursor_pixel
= x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
f->output_data.x->cursor_foreground_pixel
= x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
f->output_data.x->border_pixel
= x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
f->output_data.x->mouse_pixel
= x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
UNGCPRO;
}
if (EQ (name, Qunbound) || NILP (name))
{
f->name = build_string (dpyinfo->x_id_name);
f->explicit_name = 0;
}
else
{
f->name = name;
f->explicit_name = 1;
specbind (Qx_resource_name, name);
}
{
Lisp_Object font;
font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
BLOCK_INPUT;
if (STRINGP (font))
{
tem = Fquery_fontset (font, Qnil);
if (STRINGP (tem))
font = x_new_fontset (f, XSTRING (tem)->data);
else
font = x_new_font (f, XSTRING (font)->data);
}
if (!STRINGP (font))
font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
if (!STRINGP (font))
font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
if (! STRINGP (font))
font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
if (! STRINGP (font))
font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
if (! STRINGP (font))
font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
UNBLOCK_INPUT;
if (! STRINGP (font))
font = build_string ("fixed");
x_default_parameter (f, parms, Qfont, font,
"font", "Font", RES_TYPE_STRING);
}
x_default_parameter (f, parms, Qborder_width, make_number (2),
"borderWidth", "BorderWidth", RES_TYPE_NUMBER);
if (NILP (Fassq (Qinternal_border_width, parms)))
{
Lisp_Object value;
value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
"internalBorder", "internalBorder", RES_TYPE_NUMBER);
if (! EQ (value, Qunbound))
parms = Fcons (Fcons (Qinternal_border_width, value),
parms);
}
x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
"internalBorderWidth", "internalBorderWidth",
RES_TYPE_NUMBER);
x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
"foreground", "Foreground", RES_TYPE_STRING);
x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
"background", "Background", RES_TYPE_STRING);
x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
"pointerColor", "Foreground", RES_TYPE_STRING);
x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
"cursorColor", "Foreground", RES_TYPE_STRING);
x_default_parameter (f, parms, Qborder_color, build_string ("black"),
"borderColor", "BorderColor", RES_TYPE_STRING);
init_frame_faces (f);
f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
window_prompting = x_figure_window_size (f, parms);
if (window_prompting & XNegative)
{
if (window_prompting & YNegative)
f->output_data.x->win_gravity = SouthEastGravity;
else
f->output_data.x->win_gravity = NorthEastGravity;
}
else
{
if (window_prompting & YNegative)
f->output_data.x->win_gravity = SouthWestGravity;
else
f->output_data.x->win_gravity = NorthWestGravity;
}
f->output_data.x->size_hint_flags = window_prompting;
{
XSetWindowAttributes attrs;
unsigned long mask;
BLOCK_INPUT;
mask = CWBackPixel | CWOverrideRedirect | CWEventMask;
if (DoesSaveUnders (dpyinfo->screen))
mask |= CWSaveUnder;
attrs.override_redirect = True;
attrs.save_under = True;
attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f);
attrs.event_mask = StructureNotifyMask;
tip_window
= FRAME_X_WINDOW (f)
= XCreateWindow (FRAME_X_DISPLAY (f),
FRAME_X_DISPLAY_INFO (f)->root_window,
0, 0, 1, 1,
1,
CopyFromParent, InputOutput, CopyFromParent,
mask, &attrs);
UNBLOCK_INPUT;
}
x_make_gc (f);
x_default_parameter (f, parms, Qauto_raise, Qnil,
"autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
x_default_parameter (f, parms, Qauto_lower, Qnil,
"autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
x_default_parameter (f, parms, Qcursor_type, Qbox,
"cursorType", "CursorType", RES_TYPE_SYMBOL);
width = f->width;
height = f->height;
f->height = 0;
SET_FRAME_WIDTH (f, 0);
change_frame_size (f, height, width, 1, 0, 0);
{
Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
tip_frame = frame;
call1 (Qface_set_after_frame_default, frame);
if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
Qnil));
}
f->no_split = 1;
UNGCPRO;
Vframe_list = Fcons (frame, Vframe_list);
FRAME_X_DISPLAY_INFO (f)->reference_count++;
face_change_count = face_change_count_before;
return unbind_to (count, frame);
}
static void
compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
struct frame *f;
Lisp_Object parms, dx, dy;
int width, height;
int *root_x, *root_y;
{
Lisp_Object left, top;
int win_x, win_y;
Window root, child;
unsigned pmask;
left = Fcdr (Fassq (Qleft, parms));
top = Fcdr (Fassq (Qtop, parms));
if (!INTEGERP (left) && !INTEGERP (top))
{
BLOCK_INPUT;
XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
&root, &child, root_x, root_y, &win_x, &win_y, &pmask);
UNBLOCK_INPUT;
}
if (INTEGERP (top))
*root_y = XINT (top);
else if (*root_y + XINT (dy) - height < 0)
*root_y -= XINT (dy);
else
{
*root_y -= height;
*root_y += XINT (dy);
}
if (INTEGERP (left))
*root_x = XINT (left);
else if (*root_x + XINT (dx) + width > FRAME_X_DISPLAY_INFO (f)->width)
*root_x -= width + XINT (dx);
else
*root_x += XINT (dx);
}
DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
"Show STRING in a \"tooltip\" window on frame FRAME.\n\
A tooltip window is a small X window displaying a string.\n\
\n\
FRAME nil or omitted means use the selected frame.\n\
\n\
PARMS is an optional list of frame parameters which can be\n\
used to change the tooltip's appearance.\n\
\n\
Automatically hide the tooltip after TIMEOUT seconds.\n\
TIMEOUT nil means use the default timeout of 5 seconds.\n\
\n\
If the list of frame parameters PARAMS contains a `left' parameters,\n\
the tooltip is displayed at that x-position. Otherwise it is\n\
displayed at the mouse position, with offset DX added (default is 5 if\n\
DX isn't specified). Likewise for the y-position; if a `top' frame\n\
parameter is specified, it determines the y-position of the tooltip\n\
window, otherwise it is displayed at the mouse position, with offset\n\
DY added (default is -10).\n\
\n\
A tooltip's maximum size is specified by `x-max-tooltip-size'.\n\
Text larger than the specified size is clipped.")
(string, frame, parms, timeout, dx, dy)
Lisp_Object string, frame, parms, timeout, dx, dy;
{
struct frame *f;
struct window *w;
Lisp_Object buffer, top, left, max_width, max_height;
int root_x, root_y;
struct buffer *old_buffer;
struct text_pos pos;
int i, width, height;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
int old_windows_or_buffers_changed = windows_or_buffers_changed;
int count = BINDING_STACK_SIZE ();
specbind (Qinhibit_redisplay, Qt);
GCPRO4 (string, parms, frame, timeout);
CHECK_STRING (string, 0);
f = check_x_frame (frame);
if (NILP (timeout))
timeout = make_number (5);
else
CHECK_NATNUM (timeout, 2);
if (NILP (dx))
dx = make_number (5);
else
CHECK_NUMBER (dx, 5);
if (NILP (dy))
dy = make_number (-10);
else
CHECK_NUMBER (dy, 6);
if (NILP (last_show_tip_args))
last_show_tip_args = Fmake_vector (make_number (3), Qnil);
if (!NILP (tip_frame))
{
Lisp_Object last_string = AREF (last_show_tip_args, 0);
Lisp_Object last_frame = AREF (last_show_tip_args, 1);
Lisp_Object last_parms = AREF (last_show_tip_args, 2);
if (EQ (frame, last_frame)
&& !NILP (Fequal (last_string, string))
&& !NILP (Fequal (last_parms, parms)))
{
struct frame *f = XFRAME (tip_frame);
if (!NILP (tip_timer))
{
Lisp_Object timer = tip_timer;
tip_timer = Qnil;
call1 (Qcancel_timer, timer);
}
BLOCK_INPUT;
compute_tip_xy (f, parms, dx, dy, PIXEL_WIDTH (f),
PIXEL_HEIGHT (f), &root_x, &root_y);
XMoveWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
root_x, root_y);
UNBLOCK_INPUT;
goto start_timer;
}
}
Fx_hide_tip ();
ASET (last_show_tip_args, 0, string);
ASET (last_show_tip_args, 1, frame);
ASET (last_show_tip_args, 2, parms);
if (NILP (Fassq (Qname, parms)))
parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
if (NILP (Fassq (Qinternal_border_width, parms)))
parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
if (NILP (Fassq (Qborder_width, parms)))
parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
if (NILP (Fassq (Qborder_color, parms)))
parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
if (NILP (Fassq (Qbackground_color, parms)))
parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
parms);
frame = x_create_tip_frame (FRAME_X_DISPLAY_INFO (f), parms, string);
f = XFRAME (frame);
w = XWINDOW (FRAME_ROOT_WINDOW (f));
w->left = w->top = make_number (0);
if (CONSP (Vx_max_tooltip_size)
&& INTEGERP (XCAR (Vx_max_tooltip_size))
&& XINT (XCAR (Vx_max_tooltip_size)) > 0
&& INTEGERP (XCDR (Vx_max_tooltip_size))
&& XINT (XCDR (Vx_max_tooltip_size)) > 0)
{
w->width = XCAR (Vx_max_tooltip_size);
w->height = XCDR (Vx_max_tooltip_size);
}
else
{
w->width = make_number (80);
w->height = make_number (40);
}
f->window_width = XINT (w->width);
adjust_glyphs (f);
w->pseudo_window_p = 1;
old_buffer = current_buffer;
set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
current_buffer->truncate_lines = Qnil;
clear_glyph_matrix (w->desired_matrix);
clear_glyph_matrix (w->current_matrix);
SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
try_window (FRAME_ROOT_WINDOW (f), pos);
width = height = 0;
for (i = 0; i < w->desired_matrix->nrows; ++i)
{
struct glyph_row *row = &w->desired_matrix->rows[i];
struct glyph *last;
int row_width;
if (!row->enabled_p || !row->displays_text_p)
break;
row->full_width_p = 1;
if (row->used[TEXT_AREA])
{
last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
row_width = row->pixel_width - last->pixel_width;
}
else
row_width = row->pixel_width;
height += row->height;
width = max (width, row_width);
}
height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
BLOCK_INPUT;
XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
root_x, root_y, width, height);
XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
UNBLOCK_INPUT;
w->must_be_updated_p = 1;
update_single_window (w, 1);
set_buffer_internal_1 (old_buffer);
windows_or_buffers_changed = old_windows_or_buffers_changed;
start_timer:
tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
intern ("x-hide-tip"));
UNGCPRO;
return unbind_to (count, Qnil);
}
DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
"Hide the current tooltip window, if there is any.\n\
Value is t is tooltip was open, nil otherwise.")
()
{
int count;
Lisp_Object deleted, frame, timer;
struct gcpro gcpro1, gcpro2;
if (NILP (tip_timer) && NILP (tip_frame))
return Qnil;
frame = tip_frame;
timer = tip_timer;
GCPRO2 (frame, timer);
tip_frame = tip_timer = deleted = Qnil;
count = BINDING_STACK_SIZE ();
specbind (Qinhibit_redisplay, Qt);
specbind (Qinhibit_quit, Qt);
if (!NILP (timer))
call1 (Qcancel_timer, timer);
if (FRAMEP (frame))
{
Fdelete_frame (frame, Qnil);
deleted = Qt;
#ifdef USE_LUCID
{
struct frame *f = SELECTED_FRAME ();
Widget w = f->output_data.x->menubar_widget;
extern void xlwmenu_redisplay P_ ((Widget));
if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f)->screen)
&& w != NULL)
{
BLOCK_INPUT;
xlwmenu_redisplay (w);
UNBLOCK_INPUT;
}
}
#endif
}
UNGCPRO;
return unbind_to (count, deleted);
}
#ifdef USE_MOTIF
static void
file_dialog_cb (widget, client_data, call_data)
Widget widget;
XtPointer call_data, client_data;
{
int *result = (int *) client_data;
XmAnyCallbackStruct *cb = (XmAnyCallbackStruct *) call_data;
*result = cb->reason;
}
static void
file_dialog_unmap_cb (widget, client_data, call_data)
Widget widget;
XtPointer call_data, client_data;
{
int *result = (int *) client_data;
*result = XmCR_CANCEL;
}
DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
"Read file name, prompting with PROMPT in directory DIR.\n\
Use a file selection dialog.\n\
Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
specified. Don't let the user enter a file name in the file\n\
selection dialog's entry field, if MUSTMATCH is non-nil.")
(prompt, dir, default_filename, mustmatch)
Lisp_Object prompt, dir, default_filename, mustmatch;
{
int result;
struct frame *f = SELECTED_FRAME ();
Lisp_Object file = Qnil;
Widget dialog, text, list, help;
Arg al[10];
int ac = 0;
extern XtAppContext Xt_app_con;
char *title;
XmString dir_xmstring, pattern_xmstring;
int popup_activated_flag;
int count = specpdl_ptr - specpdl;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
GCPRO5 (prompt, dir, default_filename, mustmatch, file);
CHECK_STRING (prompt, 0);
CHECK_STRING (dir, 1);
specbind (Qinhibit_redisplay, Qt);
BLOCK_INPUT;
dir = Fexpand_file_name (dir, Qnil);
dir_xmstring = XmStringCreateLocalized (XSTRING (dir)->data);
pattern_xmstring = XmStringCreateLocalized ("*");
XtSetArg (al[ac], XmNtitle, XSTRING (prompt)->data); ++ac;
XtSetArg (al[ac], XmNdirectory, dir_xmstring); ++ac;
XtSetArg (al[ac], XmNpattern, pattern_xmstring); ++ac;
XtSetArg (al[ac], XmNresizePolicy, XmRESIZE_GROW); ++ac;
XtSetArg (al[ac], XmNdialogStyle, XmDIALOG_APPLICATION_MODAL); ++ac;
dialog = XmCreateFileSelectionDialog (f->output_data.x->widget,
"fsb", al, ac);
XmStringFree (dir_xmstring);
XmStringFree (pattern_xmstring);
XtAddCallback (dialog, XmNokCallback, file_dialog_cb,
(XtPointer) &result);
XtAddCallback (dialog, XmNcancelCallback, file_dialog_cb,
(XtPointer) &result);
XtAddCallback (dialog, XmNunmapCallback, file_dialog_unmap_cb,
(XtPointer) &result);
help = XmFileSelectionBoxGetChild (dialog, XmDIALOG_HELP_BUTTON);
XtSetSensitive (help, False);
XtVaSetValues (XmFileSelectionBoxGetChild (dialog, XmDIALOG_OK_BUTTON),
XmNshowAsDefault, True, NULL);
text = XmFileSelectionBoxGetChild (dialog, XmDIALOG_TEXT);
if (!NILP (mustmatch))
{
Widget label;
label = XmFileSelectionBoxGetChild (dialog, XmDIALOG_SELECTION_LABEL);
XtSetSensitive (text, False);
XtSetSensitive (label, False);
}
XtManageChild (dialog);
list = XmFileSelectionBoxGetChild (dialog, XmDIALOG_LIST);
if (STRINGP (default_filename))
{
XmString default_xmstring;
int item_pos;
default_xmstring
= XmStringCreateLocalized (XSTRING (default_filename)->data);
if (!XmListItemExists (list, default_xmstring))
{
XmListAddItem (list, default_xmstring, 0);
item_pos = 0;
}
else
item_pos = XmListItemPos (list, default_xmstring);
XmStringFree (default_xmstring);
XmListSelectPos (list, item_pos, True);
XmListSetPos (list, item_pos);
}
UNBLOCK_INPUT;
result = 0;
while (result == 0)
{
BLOCK_INPUT;
XtAppProcessEvent (Xt_app_con, XtIMAll);
UNBLOCK_INPUT;
}
BLOCK_INPUT;
if (result == XmCR_OK)
{
XmString text;
String data;
XtVaGetValues (dialog, XmNtextString, &text, NULL);
XmStringGetLtoR (text, XmFONTLIST_DEFAULT_TAG, &data);
XmStringFree (text);
file = build_string (data);
XtFree (data);
}
else
file = Qnil;
XtUnmanageChild (dialog);
XtDestroyWidget (dialog);
UNBLOCK_INPUT;
UNGCPRO;
if (NILP (file))
Fsignal (Qquit, Qnil);
return unbind_to (count, file);
}
#endif
#ifdef HAVE_XKBGETKEYBOARD
#include <X11/XKBlib.h>
#include <X11/keysym.h>
#endif
DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p,
Sx_backspace_delete_keys_p, 0, 1, 0,
"Check if both Backspace and Delete keys are on the keyboard of FRAME.\n\
FRAME nil means use the selected frame.\n\
Value is t if we know that both keys are present, and are mapped to the\n\
usual X keysyms.")
(frame)
Lisp_Object frame;
{
#ifdef HAVE_XKBGETKEYBOARD
XkbDescPtr kb;
struct frame *f = check_x_frame (frame);
Display *dpy = FRAME_X_DISPLAY (f);
Lisp_Object have_keys;
int major, minor, op, event, error;
BLOCK_INPUT;
major = XkbMajorVersion;
minor = XkbMinorVersion;
if (!XkbLibraryVersion (&major, &minor))
{
UNBLOCK_INPUT;
return Qnil;
}
major = XkbMajorVersion;
minor = XkbMinorVersion;
if (!XkbQueryExtension (dpy, &op, &event, &error, &major, &minor))
{
UNBLOCK_INPUT;
return Qnil;
}
have_keys = Qnil;
kb = XkbGetMap (dpy, XkbAllMapComponentsMask, XkbUseCoreKbd);
if (kb)
{
int delete_keycode = 0, backspace_keycode = 0, i;
if (XkbGetNames (dpy, XkbAllNamesMask, kb) == Success)
{
for (i = kb->min_key_code;
(i < kb->max_key_code
&& (delete_keycode == 0 || backspace_keycode == 0));
++i)
{
if (bcmp ("DELE", kb->names->keys[i].name, 4) == 0)
delete_keycode = i;
else if (bcmp ("BKSP", kb->names->keys[i].name, 4) == 0)
backspace_keycode = i;
}
XkbFreeNames (kb, 0, True);
}
XkbFreeClientMap (kb, 0, True);
if (delete_keycode
&& backspace_keycode
&& XKeysymToKeycode (dpy, XK_Delete) == delete_keycode
&& XKeysymToKeycode (dpy, XK_BackSpace) == backspace_keycode)
have_keys = Qt;
}
UNBLOCK_INPUT;
return have_keys;
#else
return Qnil;
#endif
}
void
syms_of_xfns ()
{
x_in_use = 0;
Qauto_raise = intern ("auto-raise");
staticpro (&Qauto_raise);
Qauto_lower = intern ("auto-lower");
staticpro (&Qauto_lower);
Qbar = intern ("bar");
staticpro (&Qbar);
Qborder_color = intern ("border-color");
staticpro (&Qborder_color);
Qborder_width = intern ("border-width");
staticpro (&Qborder_width);
Qbox = intern ("box");
staticpro (&Qbox);
Qcursor_color = intern ("cursor-color");
staticpro (&Qcursor_color);
Qcursor_type = intern ("cursor-type");
staticpro (&Qcursor_type);
Qgeometry = intern ("geometry");
staticpro (&Qgeometry);
Qicon_left = intern ("icon-left");
staticpro (&Qicon_left);
Qicon_top = intern ("icon-top");
staticpro (&Qicon_top);
Qicon_type = intern ("icon-type");
staticpro (&Qicon_type);
Qicon_name = intern ("icon-name");
staticpro (&Qicon_name);
Qinternal_border_width = intern ("internal-border-width");
staticpro (&Qinternal_border_width);
Qleft = intern ("left");
staticpro (&Qleft);
Qright = intern ("right");
staticpro (&Qright);
Qmouse_color = intern ("mouse-color");
staticpro (&Qmouse_color);
Qnone = intern ("none");
staticpro (&Qnone);
Qparent_id = intern ("parent-id");
staticpro (&Qparent_id);
Qscroll_bar_width = intern ("scroll-bar-width");
staticpro (&Qscroll_bar_width);
Qsuppress_icon = intern ("suppress-icon");
staticpro (&Qsuppress_icon);
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);
Qouter_window_id = intern ("outer-window-id");
staticpro (&Qouter_window_id);
Qx_frame_parameter = intern ("x-frame-parameter");
staticpro (&Qx_frame_parameter);
Qx_resource_name = intern ("x-resource-name");
staticpro (&Qx_resource_name);
Quser_position = intern ("user-position");
staticpro (&Quser_position);
Quser_size = intern ("user-size");
staticpro (&Quser_size);
Qscroll_bar_foreground = intern ("scroll-bar-foreground");
staticpro (&Qscroll_bar_foreground);
Qscroll_bar_background = intern ("scroll-bar-background");
staticpro (&Qscroll_bar_background);
Qscreen_gamma = intern ("screen-gamma");
staticpro (&Qscreen_gamma);
Qline_spacing = intern ("line-spacing");
staticpro (&Qline_spacing);
Qcenter = intern ("center");
staticpro (&Qcenter);
Qcompound_text = intern ("compound-text");
staticpro (&Qcompound_text);
Qcancel_timer = intern ("cancel-timer");
staticpro (&Qcancel_timer);
Qwait_for_wm = intern ("wait-for-wm");
staticpro (&Qwait_for_wm);
Vtext_property_default_nonsticky
= Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
Qlaplace = intern ("laplace");
staticpro (&Qlaplace);
Qemboss = intern ("emboss");
staticpro (&Qemboss);
Qedge_detection = intern ("edge-detection");
staticpro (&Qedge_detection);
Qheuristic = intern ("heuristic");
staticpro (&Qheuristic);
QCmatrix = intern (":matrix");
staticpro (&QCmatrix);
QCcolor_adjustment = intern (":color-adjustment");
staticpro (&QCcolor_adjustment);
QCmask = intern (":mask");
staticpro (&QCmask);
Qface_set_after_frame_default = intern ("face-set-after-frame-default");
staticpro (&Qface_set_after_frame_default);
Fput (Qundefined_color, Qerror_conditions,
Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
Fput (Qundefined_color, Qerror_message,
build_string ("Undefined color"));
init_x_parm_symbols ();
DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images,
"Non-nil means always draw a cross over disabled images.\n\
Disabled images are those having an `:conversion disabled' property.\n\
A cross is always drawn on black & white displays.");
cross_disabled_images = 0;
DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
"List of directories to search for bitmap files for X.");
Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
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.\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.\n\
\n\
It may be useful to bind this variable locally around a call\n\
to `x-get-resource'. See also the variable `x-resource-class'.");
Vx_resource_name = Qnil;
DEFVAR_LISP ("x-resource-class", &Vx_resource_class,
"The class Emacs uses to look up X resources.\n\
`x-get-resource' uses this as the first component of the instance class\n\
when requesting resource values.\n\
Emacs initially sets `x-resource-class' to \"Emacs\".\n\
\n\
Setting this variable permanently is not a reasonable thing to do,\n\
but binding this variable locally around a call to `x-get-resource'\n\
is a reasonable practice. See also the variable `x-resource-name'.");
Vx_resource_class = build_string (EMACS_CLASS);
#if 0
DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
"The shape of the pointer when not over text.\n\
This variable takes effect when you create a new frame\n\
or when you set the mouse color.");
#endif
Vx_nontext_pointer_shape = Qnil;
DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
"The shape of the pointer when Emacs is busy.\n\
This variable takes effect when you create a new frame\n\
or when you set the mouse color.");
Vx_hourglass_pointer_shape = Qnil;
DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
"Non-zero means Emacs displays an hourglass pointer on window systems.");
display_hourglass_p = 1;
DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
"*Seconds to wait before displaying an hourglass pointer.\n\
Value must be an integer or float.");
Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
#if 0
DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
"The shape of the pointer when over the mode line.\n\
This variable takes effect when you create a new frame\n\
or when you set the mouse color.");
#endif
Vx_mode_pointer_shape = Qnil;
DEFVAR_LISP ("x-sensitive-text-pointer-shape",
&Vx_sensitive_text_pointer_shape,
"The shape of the pointer when over mouse-sensitive text.\n\
This variable takes effect when you create a new frame\n\
or when you set the mouse color.");
Vx_sensitive_text_pointer_shape = Qnil;
DEFVAR_LISP ("x-window-horizontal-drag-cursor",
&Vx_window_horizontal_drag_shape,
"Pointer shape to use for indicating a window can be dragged horizontally.\n\
This variable takes effect when you create a new frame\n\
or when you set the mouse color.");
Vx_window_horizontal_drag_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;
DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
"Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).\n\
Text larger than this is clipped.");
Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
"Non-nil if no X window manager is in use.\n\
Emacs doesn't try to figure this out; this is always nil\n\
unless you set it to something else.");
Vx_no_window_manager = Qnil;
DEFVAR_LISP ("x-pixel-size-width-font-regexp",
&Vx_pixel_size_width_font_regexp,
"Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
\n\
Since Emacs gets width of a font matching with this regexp from\n\
PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
such a font. This is especially effective for such large fonts as\n\
Chinese, Japanese, and Korean.");
Vx_pixel_size_width_font_regexp = Qnil;
DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay,
"Time after which cached images are removed from the cache.\n\
When an image has not been displayed this many seconds, remove it\n\
from the image cache. Value must be an integer or nil with nil\n\
meaning don't clear the cache.");
Vimage_cache_eviction_delay = make_number (30 * 60);
#ifdef USE_X_TOOLKIT
Fprovide (intern ("x-toolkit"));
#ifdef USE_MOTIF
Fprovide (intern ("motif"));
DEFVAR_LISP ("motif-version-string", &Vmotif_version_string,
"Version info for LessTif/Motif.");
Vmotif_version_string = build_string (XmVERSION_STRING);
#endif
#endif
defsubr (&Sx_get_resource);
defsubr (&Sx_change_window_property);
defsubr (&Sx_delete_window_property);
defsubr (&Sx_window_property);
defsubr (&Sxw_display_color_p);
defsubr (&Sx_display_grayscale_p);
defsubr (&Sxw_color_defined_p);
defsubr (&Sxw_color_values);
defsubr (&Sx_server_max_request_size);
defsubr (&Sx_server_vendor);
defsubr (&Sx_server_version);
defsubr (&Sx_display_pixel_width);
defsubr (&Sx_display_pixel_height);
defsubr (&Sx_display_mm_width);
defsubr (&Sx_display_mm_height);
defsubr (&Sx_display_screens);
defsubr (&Sx_display_planes);
defsubr (&Sx_display_color_cells);
defsubr (&Sx_display_visual_class);
defsubr (&Sx_display_backing_store);
defsubr (&Sx_display_save_under);
defsubr (&Sx_parse_geometry);
defsubr (&Sx_create_frame);
defsubr (&Sx_open_connection);
defsubr (&Sx_close_connection);
defsubr (&Sx_display_list);
defsubr (&Sx_synchronize);
defsubr (&Sx_focus_frame);
defsubr (&Sx_backspace_delete_keys_p);
get_font_info_func = x_get_font_info;
#if 0
list_fonts_func = x_list_fonts;
#endif
load_font_func = x_load_font;
find_ccl_program_func = x_find_ccl_program;
query_font_func = x_query_font;
set_frame_fontset_func = x_set_font;
check_window_system_func = check_x;
Qxbm = intern ("xbm");
staticpro (&Qxbm);
QCtype = intern (":type");
staticpro (&QCtype);
QCconversion = intern (":conversion");
staticpro (&QCconversion);
QCheuristic_mask = intern (":heuristic-mask");
staticpro (&QCheuristic_mask);
QCcolor_symbols = intern (":color-symbols");
staticpro (&QCcolor_symbols);
QCascent = intern (":ascent");
staticpro (&QCascent);
QCmargin = intern (":margin");
staticpro (&QCmargin);
QCrelief = intern (":relief");
staticpro (&QCrelief);
Qpostscript = intern ("postscript");
staticpro (&Qpostscript);
QCloader = intern (":loader");
staticpro (&QCloader);
QCbounding_box = intern (":bounding-box");
staticpro (&QCbounding_box);
QCpt_width = intern (":pt-width");
staticpro (&QCpt_width);
QCpt_height = intern (":pt-height");
staticpro (&QCpt_height);
QCindex = intern (":index");
staticpro (&QCindex);
Qpbm = intern ("pbm");
staticpro (&Qpbm);
#if HAVE_XPM
Qxpm = intern ("xpm");
staticpro (&Qxpm);
#endif
#if HAVE_JPEG
Qjpeg = intern ("jpeg");
staticpro (&Qjpeg);
#endif
#if HAVE_TIFF
Qtiff = intern ("tiff");
staticpro (&Qtiff);
#endif
#if HAVE_GIF
Qgif = intern ("gif");
staticpro (&Qgif);
#endif
#if HAVE_PNG
Qpng = intern ("png");
staticpro (&Qpng);
#endif
defsubr (&Sclear_image_cache);
defsubr (&Simage_size);
defsubr (&Simage_mask_p);
hourglass_atimer = NULL;
hourglass_shown_p = 0;
defsubr (&Sx_show_tip);
defsubr (&Sx_hide_tip);
tip_timer = Qnil;
staticpro (&tip_timer);
tip_frame = Qnil;
staticpro (&tip_frame);
last_show_tip_args = Qnil;
staticpro (&last_show_tip_args);
#ifdef USE_MOTIF
defsubr (&Sx_file_dialog);
#endif
}
void
init_xfns ()
{
image_types = NULL;
Vimage_types = Qnil;
define_image_type (&xbm_type);
define_image_type (&gs_type);
define_image_type (&pbm_type);
#if HAVE_XPM
define_image_type (&xpm_type);
#endif
#if HAVE_JPEG
define_image_type (&jpeg_type);
#endif
#if HAVE_TIFF
define_image_type (&tiff_type);
#endif
#if HAVE_GIF
define_image_type (&gif_type);
#endif
#if HAVE_PNG
define_image_type (&png_type);
#endif
}
#endif