/* Functions for the X window system.
- Copyright (C) 1989, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 01, 02, 03
+ Copyright (C) 1989, 92, 93, 94, 95, 96, 97, 98, 99, 2000,01,02,03,04
Free Software Foundation.
This file is part of GNU Emacs.
#include "systime.h"
#include "termhooks.h"
#include "atimer.h"
+#include "termchar.h"
#ifdef HAVE_X_WINDOWS
#endif /* USE_X_TOOLKIT */
+#ifdef USE_GTK
+
+/* GTK+ version info */
+
+static Lisp_Object Vgtk_version_string;
+
+#endif /* USE_GTK */
+
#ifdef HAVE_X11R4
#define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
#else
Lisp_Object Vx_no_window_manager;
-/* Search path for bitmap files. */
-
-Lisp_Object Vx_bitmap_file_path;
-
/* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
Lisp_Object Vx_pixel_size_width_font_regexp;
Lisp_Object Qnone;
Lisp_Object Qsuppress_icon;
Lisp_Object Qundefined_color;
-Lisp_Object Qcenter;
Lisp_Object Qcompound_text, Qcancel_timer;
/* In dispnew.c */
#ifdef USE_GTK
if (f->output_data.x->edit_widget)
{
- GtkWidget *gwdesc = xg_win_to_widget (wdesc);
+ GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
struct x_output *x = f->output_data.x;
if (gwdesc != 0 && gwdesc == x->edit_widget)
return f;
else if (x->widget)
{
#ifdef USE_GTK
- GtkWidget *gwdesc = xg_win_to_widget (wdesc);
+ GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
if (gwdesc != 0
&& (gwdesc == x->widget
|| gwdesc == x->edit_widget
else if (x->widget)
{
#ifdef USE_GTK
- GtkWidget *gwdesc = xg_win_to_widget (wdesc);
+ GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
if (gwdesc != 0
&& (gwdesc == x->widget
|| gwdesc == x->edit_widget
#ifdef USE_GTK
if (x->menubar_widget)
{
- GtkWidget *gwdesc = xg_win_to_widget (wdesc);
+ GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
int found = 0;
BLOCK_INPUT;
{
/* This frame matches if the window is its topmost widget. */
#ifdef USE_GTK
- GtkWidget *gwdesc = xg_win_to_widget (wdesc);
+ GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
if (gwdesc == x->widget)
return f;
#else
\f
-/* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
- id, which is just an int that this section returns. Bitmaps are
- reference counted so they can be shared among frames.
-
- Bitmap indices are guaranteed to be > 0, so a negative number can
- be used to indicate no bitmap.
-
- If you use x_create_bitmap_from_data, then you must keep track of
- the bitmaps yourself. That is, creating a bitmap from the same
- data more than once will not be caught. */
-
-
-/* Functions to access the contents of a bitmap, given an id. */
-
-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;
-}
-
-int
-x_bitmap_mask (f, id)
- FRAME_PTR f;
- int id;
-{
- return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].mask;
-}
-
-
-/* Allocate a new bitmap record. Returns index of new record. */
-
-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;
-}
-
-/* Add one reference to the reference count of the bitmap with id ID. */
-
-void
-x_reference_bitmap (f, id)
- FRAME_PTR f;
- int id;
-{
- ++FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
-}
-
-/* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
-
-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;
-}
-
-/* Create bitmap from file FILE for frame F. */
-
-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;
-
- /* Look for an existing bitmap with the same name. */
- for (id = 0; id < dpyinfo->bitmaps_last; ++id)
- {
- if (dpyinfo->bitmaps[id].refcount
- && dpyinfo->bitmaps[id].file
- && !strcmp (dpyinfo->bitmaps[id].file, (char *) SDATA (file)))
- {
- ++dpyinfo->bitmaps[id].refcount;
- return id + 1;
- }
- }
-
- /* Search bitmap-file-path for the file, if appropriate. */
- fd = openp (Vx_bitmap_file_path, file, Qnil, &found, Qnil);
- if (fd < 0)
- return -1;
- emacs_close (fd);
-
- filename = (char *) SDATA (found);
-
- 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 (SBYTES (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, SDATA (file));
-
- return id;
-}
-
-/* Remove reference to bitmap with id number 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);
- XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].mask);
- if (dpyinfo->bitmaps[id - 1].file)
- {
- xfree (dpyinfo->bitmaps[id - 1].file);
- dpyinfo->bitmaps[id - 1].file = NULL;
- }
- UNBLOCK_INPUT;
- }
- }
-}
-
-/* Free all the bitmaps for the display specified by DPYINFO. */
-
-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);
- XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].mask);
- if (dpyinfo->bitmaps[i].file)
- xfree (dpyinfo->bitmaps[i].file);
- }
- dpyinfo->bitmaps_last = 0;
-}
-\f
-
-
-
-/* Useful functions defined in the section
- `Image type independent image structures' below. */
-
-static unsigned long four_corners_best P_ ((XImage *ximg, unsigned long width,
- unsigned long height));
-
-static int x_create_x_image_and_pixmap P_ ((struct frame *f, int width, int height,
- int depth, XImage **ximg,
- Pixmap *pixmap));
-
-static void x_destroy_x_image P_ ((XImage *ximg));
-
-
-/* Create a mask of a bitmap. Note is this not a perfect mask.
- It's nicer with some borders in this context */
-
-int
-x_create_bitmap_mask(f, id)
- struct frame *f;
- int id;
-{
- Pixmap pixmap, mask;
- XImage *ximg, *mask_img;
- unsigned long width, height;
- int result;
- unsigned long bg;
- unsigned long x, y, xp, xm, yp, ym;
- GC gc;
-
- int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
- struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
-
- if (!(id > 0))
- return -1;
-
- pixmap = x_bitmap_pixmap(f, id);
- width = x_bitmap_width(f, id);
- height = x_bitmap_height(f, id);
-
- BLOCK_INPUT;
- ximg = XGetImage (FRAME_X_DISPLAY (f), pixmap, 0, 0, width, height,
- ~0, ZPixmap);
-
- if (!ximg)
- {
- UNBLOCK_INPUT;
- return -1;
- }
-
- result = x_create_x_image_and_pixmap (f, width, height, 1, &mask_img, &mask);
-
- UNBLOCK_INPUT;
- if (!result)
- {
- XDestroyImage(ximg);
- return -1;
- }
-
- bg = four_corners_best (ximg, width, height);
-
- for (y = 0; y < ximg->height; ++y)
- {
- for (x = 0; x < ximg->width; ++x)
- {
- xp = x != ximg->width - 1 ? x + 1 : 0;
- xm = x != 0 ? x - 1 : ximg->width - 1;
- yp = y != ximg->height - 1 ? y + 1 : 0;
- ym = y != 0 ? y - 1 : ximg->height - 1;
- if (XGetPixel (ximg, x, y) == bg
- && XGetPixel (ximg, x, yp) == bg
- && XGetPixel (ximg, x, ym) == bg
- && XGetPixel (ximg, xp, y) == bg
- && XGetPixel (ximg, xp, yp) == bg
- && XGetPixel (ximg, xp, ym) == bg
- && XGetPixel (ximg, xm, y) == bg
- && XGetPixel (ximg, xm, yp) == bg
- && XGetPixel (ximg, xm, ym) == bg)
- XPutPixel (mask_img, x, y, 0);
- else
- XPutPixel (mask_img, x, y, 1);
- }
- }
-
- xassert (interrupt_input_blocked);
- gc = XCreateGC (FRAME_X_DISPLAY (f), mask, 0, NULL);
- XPutImage (FRAME_X_DISPLAY (f), mask, gc, mask_img, 0, 0, 0, 0,
- width, height);
- XFreeGC (FRAME_X_DISPLAY (f), gc);
-
- dpyinfo->bitmaps[id - 1].mask = mask;
-
- XDestroyImage (ximg);
- x_destroy_x_image(mask_img);
-
- return 0;
-}
-
static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
-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_wait_for_wm P_ ((struct frame *, Lisp_Object, Lisp_Object));
Lisp_Object,
char *, char *,
int));
-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));
-
-
-
\f
/* Store the screen positions of frame F into XPTR and YPTR.
#ifdef USE_GTK
-/* Wrapper for gtk_window_icon_from_file() */
+/* Set icon from FILE for frame F. By using GTK functions the icon
+ may be any format that GdkPixbuf knows about, i.e. not just bitmaps. */
int
-xg_set_icon(f, file)
- struct frame *f;
+xg_set_icon (f, file)
+ FRAME_PTR f;
Lisp_Object file;
{
- struct gcpro gcpro1, gcpro2, gcpro3;
- int fd;
- int result = 1;
- Lisp_Object found, search_path;
- char *filename;
+ struct gcpro gcpro1;
+ int result = 0;
+ Lisp_Object found;
- search_path = Fcons (Vdata_directory, Vx_bitmap_file_path);
+ GCPRO1 (found);
- GCPRO3 (found, search_path, file);
- fd = openp (search_path, file, Qnil, &found, Qnil);
- if (fd > 0)
- {
- filename = (char *) SDATA (found);
- BLOCK_INPUT;
- result =
- gtk_window_set_icon_from_file (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
- filename,
- NULL);
- UNBLOCK_INPUT;
- }
- emacs_close (fd);
- UNGCPRO;
- return result;
+ found = x_find_image_file (file);
+
+ if (! NILP (found))
+ {
+ GdkPixbuf *pixbuf;
+ GError *err = NULL;
+ char *filename;
+
+ filename = SDATA (found);
+ BLOCK_INPUT;
+
+ pixbuf = gdk_pixbuf_new_from_file (filename, &err);
+
+ if (pixbuf)
+ {
+ gtk_window_set_icon (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
+ pixbuf);
+ g_object_unref (pixbuf);
+
+ result = 1;
+ }
+ else
+ g_error_free (err);
+
+ UNBLOCK_INPUT;
+ }
+
+ UNGCPRO;
+ return result;
}
#endif /* USE_GTK */
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);
Lisp_Object value, oldval;
{
int nlines;
-#ifndef USE_X_TOOLKIT
+#if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
int olines = FRAME_MENU_BAR_LINES (f);
#endif
if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
{
/* Remove all scroll bars because they have wrong colors. */
- if (condemn_scroll_bars_hook)
- (*condemn_scroll_bars_hook) (f);
- if (judge_scroll_bars_hook)
- (*judge_scroll_bars_hook) (f);
+ if (FRAME_DISPLAY (f)->condemn_scroll_bars_hook)
+ (*FRAME_DISPLAY (f)->condemn_scroll_bars_hook) (f);
+ if (FRAME_DISPLAY (f)->judge_scroll_bars_hook)
+ (*FRAME_DISPLAY (f)->judge_scroll_bars_hook) (f);
update_face_from_frame_parameter (f, Qscroll_bar_foreground, value);
redraw_frame (f);
if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
{
/* Remove all scroll bars because they have wrong colors. */
- if (condemn_scroll_bars_hook)
- (*condemn_scroll_bars_hook) (f);
- if (judge_scroll_bars_hook)
- (*judge_scroll_bars_hook) (f);
+ if (FRAME_DISPLAY (f)->condemn_scroll_bars_hook)
+ (*FRAME_DISPLAY (f)->condemn_scroll_bars_hook) (f);
+ if (FRAME_DISPLAY (f)->judge_scroll_bars_hook)
+ (*FRAME_DISPLAY (f)->judge_scroll_bars_hook) (f);
update_face_from_frame_parameter (f, Qscroll_bar_background, value);
redraw_frame (f);
managers which don't support that encoding. So, if NAME
contains only ASCII and 8859-1 characters, encode it by
iso-latin-1, and use "STRING" in text.encoding hoping that
- such window manager at least analize this format correctly,
+ such window managers at least analyze this format correctly,
i.e. treat 8-bit bytes as 8859-1 characters.
We may also be able to use "UTF8_STRING" in text.encoding
- in the feature which can encode all Unicode characters.
+ in the future which can encode all Unicode characters.
But, for the moment, there's no way to know that the
current window manager supports it or not. */
coding_system = Qcompound_text;
xic = XCreateIC (xim,
XNInputStyle, xic_style,
- XNClientWindow, FRAME_X_WINDOW(f),
- XNFocusWindow, FRAME_X_WINDOW(f),
+ XNClientWindow, FRAME_X_WINDOW (f),
+ XNFocusWindow, FRAME_X_WINDOW (f),
XNStatusAttributes, status_attr,
XNPreeditAttributes, preedit_attr,
NULL);
XVaNestedList attr;
XPoint spot;
- spot.x = WINDOW_TO_FRAME_PIXEL_X (w, x);
+ spot.x = WINDOW_TO_FRAME_PIXEL_X (w, x) + WINDOW_LEFT_FRINGE_WIDTH (w);
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 (needed);
attr = XVaCreateNestedList (0, XNArea, &area, NULL);
- XSetICValues(xic, XNStatusAttributes, attr, NULL);
+ XSetICValues (xic, XNStatusAttributes, attr, NULL);
XFree (attr);
}
{
int len;
char *tem, shell_position[32];
- Arg al[2];
+ Arg al[10];
int ac = 0;
int extra_borders = 0;
int menubar_size
(xneg ? '-' : '+'), left,
(yneg ? '-' : '+'), top);
else
- sprintf (shell_position, "=%dx%d",
- FRAME_PIXEL_WIDTH (f) + extra_borders,
- FRAME_PIXEL_HEIGHT (f) + menubar_size + extra_borders);
+ {
+ sprintf (shell_position, "=%dx%d",
+ FRAME_PIXEL_WIDTH (f) + extra_borders,
+ FRAME_PIXEL_HEIGHT (f) + menubar_size + extra_borders);
+
+ /* Setting x and y when the position is not specified in
+ the geometry string will set program position in the WM hints.
+ If Emacs had just one program position, we could set it in
+ fallback resources, but since each make-frame call can specify
+ different program positions, this is easier. */
+ XtSetArg (al[ac], XtNx, left); ac++;
+ XtSetArg (al[ac], XtNy, top); ac++;
+ }
}
len = strlen (shell_position) + 1;
{
/* XIM server might require some X events. */
unsigned long fevent = NoEventMask;
- XGetICValues(FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
+ XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
attributes.event_mask |= fevent;
}
#endif /* HAVE_X_I18N */
#ifdef HAVE_X_I18N
FRAME_XIC (f) = NULL;
-if (use_xim)
+ if (use_xim)
{
BLOCK_INPUT;
create_frame_xic (f);
{
/* XIM server might require some X events. */
unsigned long fevent = NoEventMask;
- XGetICValues(FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
+ XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
if (fevent != NoEventMask)
{
{
/* XIM server might require some X events. */
unsigned long fevent = NoEventMask;
- XGetICValues(FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
+ XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
attributes.event_mask |= fevent;
attribute_mask = CWEventMask;
XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
Lisp_Object parent;
struct kboard *kb;
- check_x ();
-
/* Use this general default value to start with
until we know if this frame has a specified name. */
Vx_resource_name = Vinvocation_name;
/* Note that X Windows does support scroll bars. */
FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
+ f->display = dpyinfo->frame_display;
+ f->display->reference_count++;
+
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));
specbind (Qx_resource_name, name);
}
+ Fmodify_frame_parameters (frame, Fcons (Fcons (Qwindow_system, Qx), Qnil));
+
/* Extract the window parameters from the supplied values
that are needed to determine window geometry. */
{
;
}
+ /* Set the WM leader property. GTK does this itself, so this is not
+ needed when using GTK. */
+ if (dpyinfo->client_leader_window != 0)
+ {
+ BLOCK_INPUT;
+ XChangeProperty (FRAME_X_DISPLAY (f),
+ FRAME_OUTER_WINDOW (f),
+ dpyinfo->Xatom_wm_client_leader,
+ XA_WINDOW, 32, PropModeReplace,
+ (char *) &dpyinfo->client_leader_window, 1);
+ UNBLOCK_INPUT;
+ }
+
UNGCPRO;
/* Make sure windows on this frame appear in calls to next-window
{
struct x_display_info *dpyinfo = check_x_display_info (display);
- return make_number (DisplayCells (dpyinfo->display,
- XScreenNumberOfScreen (dpyinfo->screen)));
+ int nr_planes = DisplayPlanes (dpyinfo->display,
+ XScreenNumberOfScreen (dpyinfo->screen));
+
+ /* Truncate nr_planes to 24 to avoid integer overflow.
+ Some displays says 32, but only 24 bits are actually significant.
+ There are only very few and rare video cards that have more than
+ 24 significant bits. Also 24 bits is more than 16 million colors,
+ it "should be enough for everyone". */
+ if (nr_planes > 24) nr_planes = 24;
+
+ return make_number (1 << nr_planes);
}
DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
CHECK_STRING (name);
- if (! EQ (Vwindow_system, intern ("x")))
- error ("Not using X Windows");
+#if 0
+ if (! EQ (Vinitial_window_system, intern ("x")))
+ error ("Not using X Windows"); /* That doesn't stop us anymore. */
+#endif
for (dpyinfo = x_display_list, names = x_display_name_list;
dpyinfo;
if (! NILP (xrm_string))
CHECK_STRING (xrm_string);
- if (! EQ (Vwindow_system, intern ("x")))
- error ("Not using X Windows");
+#if 0
+ if (! EQ (Vinitial_window_system, intern ("x")))
+ error ("Not using X Windows"); /* That doesn't stop us anymore. */
+#endif
if (! NILP (xrm_string))
xrm_option = (unsigned char *) SDATA (xrm_string);
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);
}
\f
/***********************************************************************
- Image types
+ Window properties
***********************************************************************/
-/* Value is the number of elements of vector VECTOR. */
+DEFUN ("x-change-window-property", Fx_change_window_property,
+ Sx_change_window_property, 2, 6, 0,
+ doc: /* Change window property PROP to VALUE on the X window of FRAME.
+PROP must be a string.
+VALUE may be a string or a list of conses, numbers and/or strings.
+If an element in the list is a string, it is converted to
+an Atom and the value of the Atom is used. If an element is a cons,
+it is converted to a 32 bit number where the car is the 16 top bits and the
+cdr is the lower 16 bits.
+FRAME nil or omitted means use the selected frame.
+If TYPE is given and non-nil, it is the name of the type of VALUE.
+If TYPE is not given or nil, the type is STRING.
+FORMAT gives the size in bits of each element if VALUE is a list.
+It must be one of 8, 16 or 32.
+If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
+If OUTER_P is non-nil, the property is changed for the outer X window of
+FRAME. Default is to change on the edit X window.
+
+Value is VALUE. */)
+ (prop, value, frame, type, format, outer_p)
+ Lisp_Object prop, value, frame, type, format, outer_p;
+{
+ struct frame *f = check_x_frame (frame);
+ Atom prop_atom;
+ Atom target_type = XA_STRING;
+ int element_format = 8;
+ unsigned char *data;
+ int nelements;
+ Window w;
-#define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
+ CHECK_STRING (prop);
-/* List of supported image types. Use define_image_type to add new
- types. Use lookup_image_type to find a type for a given symbol. */
+ if (! NILP (format))
+ {
+ CHECK_NUMBER (format);
+ element_format = XFASTINT (format);
-static struct image_type *image_types;
+ if (element_format != 8 && element_format != 16
+ && element_format != 32)
+ error ("FORMAT must be one of 8, 16 or 32");
+ }
-/* The symbol `image' which is the car of the lists used to represent
- images in Lisp. */
+ if (CONSP (value))
+ {
+ nelements = x_check_property_data (value);
+ if (nelements == -1)
+ error ("Bad data in VALUE, must be number, string or cons");
-extern Lisp_Object Qimage;
+ if (element_format == 8)
+ data = (unsigned char *) xmalloc (nelements);
+ else if (element_format == 16)
+ data = (unsigned char *) xmalloc (nelements*2);
+ else
+ data = (unsigned char *) xmalloc (nelements*4);
-/* The symbol `xbm' which is used as the type symbol for XBM images. */
+ x_fill_property_data (FRAME_X_DISPLAY (f), value, data, element_format);
+ }
+ else
+ {
+ CHECK_STRING (value);
+ data = SDATA (value);
+ nelements = SCHARS (value);
+ }
-Lisp_Object Qxbm;
+ BLOCK_INPUT;
+ prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
+ if (! NILP (type))
+ {
+ CHECK_STRING (type);
+ target_type = XInternAtom (FRAME_X_DISPLAY (f), SDATA (type), False);
+ }
-/* Keywords. */
+ if (! NILP (outer_p)) w = FRAME_OUTER_WINDOW (f);
+ else w = FRAME_X_WINDOW (f);
+
+ XChangeProperty (FRAME_X_DISPLAY (f), w,
+ prop_atom, target_type, element_format, PropModeReplace,
+ data, nelements);
-extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
-extern Lisp_Object QCdata, QCtype;
-Lisp_Object QCascent, QCmargin, QCrelief;
-Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask;
-Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask;
+ if (CONSP (value)) xfree (data);
-/* Other symbols. */
+ /* Make sure the property is set when we return. */
+ XFlush (FRAME_X_DISPLAY (f));
+ UNBLOCK_INPUT;
-Lisp_Object Qlaplace, Qemboss, Qedge_detection, Qheuristic;
+ return value;
+}
-/* Time in seconds after which images should be removed from the cache
- if not displayed. */
-Lisp_Object Vimage_cache_eviction_delay;
+DEFUN ("x-delete-window-property", Fx_delete_window_property,
+ Sx_delete_window_property, 1, 2, 0,
+ doc: /* Remove window property PROP from X window of FRAME.
+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;
-/* Function prototypes. */
+ CHECK_STRING (prop);
+ BLOCK_INPUT;
+ prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
+ XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), prop_atom);
-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));
+ /* Make sure the property is removed when we return. */
+ XFlush (FRAME_X_DISPLAY (f));
+ UNBLOCK_INPUT;
+ return prop;
+}
-/* Define a new image type from TYPE. This adds a copy of TYPE to
- image_types and adds the symbol *TYPE->type to Vimage_types. */
-static void
-define_image_type (type)
- struct image_type *type;
+DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
+ 1, 6, 0,
+ doc: /* Value is the value of window property PROP on FRAME.
+If FRAME is nil or omitted, use the selected frame.
+If TYPE is nil or omitted, get the property as a string. Otherwise TYPE
+is the name of the Atom that denotes the type expected.
+If SOURCE is non-nil, get the property on that window instead of from
+FRAME. The number 0 denotes the root window.
+If DELETE_P is non-nil, delete the property after retreiving it.
+If VECTOR_RET_P is non-nil, don't return a string but a vector of values.
+
+Value is nil if FRAME hasn't a property with name PROP or if PROP has
+no value of TYPE. */)
+ (prop, frame, type, source, delete_p, vector_ret_p)
+ Lisp_Object prop, frame, type, source, delete_p, vector_ret_p;
{
- /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
- The initialized data segment is read-only. */
- 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);
-}
+ struct frame *f = check_x_frame (frame);
+ Atom prop_atom;
+ int rc;
+ Lisp_Object prop_value = Qnil;
+ char *tmp_data = NULL;
+ Atom actual_type;
+ Atom target_type = XA_STRING;
+ int actual_format;
+ unsigned long actual_size, bytes_remaining;
+ Window target_window = FRAME_X_WINDOW (f);
+ struct gcpro gcpro1;
+ GCPRO1 (prop_value);
+ CHECK_STRING (prop);
-/* Look up image type SYMBOL, and return a pointer to its image_type
- structure. Value is null if SYMBOL is not a known image type. */
+ if (! NILP (source))
+ {
+ if (NUMBERP (source))
+ {
+ if (FLOATP (source))
+ target_window = (Window) XFLOAT (source);
+ else
+ target_window = XFASTINT (source);
-static INLINE struct image_type *
-lookup_image_type (symbol)
- Lisp_Object symbol;
-{
- struct image_type *type;
+ if (target_window == 0)
+ target_window = FRAME_X_DISPLAY_INFO (f)->root_window;
+ }
+ else if (CONSP (source))
+ target_window = cons_to_long (source);
+ }
- for (type = image_types; type; type = type->next)
- if (EQ (symbol, *type->type))
- break;
-
- return type;
-}
-
-
-/* Value is non-zero if OBJECT is a valid Lisp image specification. A
- valid image specification is a list whose car is the symbol
- `image', and whose rest is a property list. The property list must
- contain a value for key `:type'. That value must be the name of a
- supported image type. The rest of the property list depends on the
- image 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;
-}
-
-
-/* Log error message with format string FORMAT and argument ARG.
- Signaling an error, e.g. when an image cannot be loaded, is not a
- good idea because this would interrupt redisplay, and the error
- message display would lead to another redisplay. This function
- therefore simply displays a message. */
-
-static void
-image_error (format, arg1, arg2)
- char *format;
- Lisp_Object arg1, arg2;
-{
- add_to_log (format, arg1, arg2);
-}
-
-
-\f
-/***********************************************************************
- Image specifications
- ***********************************************************************/
-
-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
-};
-
-/* Structure used when parsing image specifications. */
-
-struct image_keyword
-{
- /* Name of keyword. */
- char *name;
-
- /* The type of value allowed. */
- enum image_value_type type;
-
- /* Non-zero means key must be present. */
- int mandatory_p;
-
- /* Used to recognize duplicate keywords in a property list. */
- int count;
-
- /* The value that was found. */
- 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 *));
-
-
-/* Parse image spec SPEC according to KEYWORDS. A valid image spec
- has the format (image KEYWORD VALUE ...). One of the keyword/
- value pairs must be `:type TYPE'. KEYWORDS is a vector of
- image_keywords structures of size NKEYWORDS describing other
- allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
-
-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;
-
- /* First element of a pair must be a symbol. */
- key = XCAR (plist);
- plist = XCDR (plist);
- if (!SYMBOLP (key))
- return 0;
-
- /* There must follow a value. */
- if (!CONSP (plist))
- return 0;
- value = XCAR (plist);
- plist = XCDR (plist);
-
- /* Find key in KEYWORDS. Error if not found. */
- for (i = 0; i < nkeywords; ++i)
- if (strcmp (keywords[i].name, SDATA (SYMBOL_NAME (key))) == 0)
- break;
-
- if (i == nkeywords)
- continue;
-
- /* Record that we recognized the keyword. If a keywords
- was found more than once, it's an error. */
- keywords[i].value = value;
- ++keywords[i].count;
-
- if (keywords[i].count > 1)
- return 0;
-
- /* Check type of value against allowed type. */
- 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;
- }
-
- /* Check that all mandatory fields are present. */
- for (i = 0; i < nkeywords; ++i)
- if (keywords[i].mandatory_p && keywords[i].count == 0)
- return 0;
-
- return NILP (plist);
-}
-
-
-/* Return the value of KEY in image specification SPEC. Value is nil
- if KEY is not present in SPEC. if FOUND is not null, set *FOUND
- to 1 if KEY was found in SPEC, set it to 0 otherwise. */
-
-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,
- doc: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
-PIXELS non-nil means return the size in pixels, otherwise return the
-size in canonical character units.
-FRAME is the frame on which the image will be displayed. FRAME nil
-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 / FRAME_COLUMN_WIDTH (f)),
- make_float ((double) height / FRAME_LINE_HEIGHT (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,
- doc: /* Return t if image SPEC has a mask bitmap.
-FRAME is the frame on which the image will be displayed. FRAME nil
-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;
-}
-
-
-\f
-/***********************************************************************
- Image type independent image structures
- ***********************************************************************/
-
-static struct image *make_image P_ ((Lisp_Object spec, unsigned hash));
-static void free_image P_ ((struct frame *f, struct image *img));
-
-
-/* Allocate and return a new image structure for image specification
- SPEC. SPEC has a hash value of HASH. */
-
-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;
-}
-
-
-/* Free image IMG which was used on frame F, including its resources. */
-
-static void
-free_image (f, img)
- struct frame *f;
- struct image *img;
-{
- if (img)
- {
- struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
-
- /* Remove IMG from the hash table of its cache. */
- 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;
-
- /* Free resources, then free IMG. */
- img->type->free (f, img);
- xfree (img);
- }
-}
-
-
-/* Prepare image IMG for display on frame F. Must be called before
- drawing an image. */
-
-void
-prepare_image_for_display (f, img)
- struct frame *f;
- struct image *img;
-{
- EMACS_TIME t;
-
- /* We're about to display IMG, so set its timestamp to `now'. */
- EMACS_GET_TIME (t);
- img->timestamp = EMACS_SECS (t);
-
- /* If IMG doesn't have a pixmap yet, load it now, using the image
- type dependent loader function. */
- if (img->pixmap == None && !img->load_failed_p)
- img->load_failed_p = img->type->load (f, img) == 0;
-}
-
-
-/* Value is the number of pixels for the ascent of image IMG when
- drawn in face FACE. */
-
-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)
- /* This expression is arranged so that if the image can't be
- exactly centered, it will be moved slightly up. This is
- because a typical font is `top-heavy' (due to the presence
- uppercase letters), so the image placement should err towards
- being top-heavy too. It also just generally looks better. */
- ascent = (height + face->font->ascent - face->font->descent + 1) / 2;
- else
- ascent = height / 2;
- }
- else
- ascent = height * img->ascent / 100.0;
-
- return ascent;
-}
-
-\f
-/* Image background colors. */
-
-static unsigned long
-four_corners_best (ximg, width, height)
- XImage *ximg;
- unsigned long width, height;
-{
- unsigned long corners[4], best;
- int i, best_count;
-
- /* Get the colors at the corners of ximg. */
- corners[0] = XGetPixel (ximg, 0, 0);
- corners[1] = XGetPixel (ximg, width - 1, 0);
- corners[2] = XGetPixel (ximg, width - 1, height - 1);
- corners[3] = XGetPixel (ximg, 0, height - 1);
-
- /* Choose the most frequently found color as background. */
- 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)
- best = corners[i], best_count = n;
- }
-
- return best;
-}
-
-/* Return the `background' field of IMG. If IMG doesn't have one yet,
- it is guessed heuristically. If non-zero, XIMG is an existing XImage
- object to use for the heuristic. */
-
-unsigned long
-image_background (img, f, ximg)
- struct image *img;
- struct frame *f;
- XImage *ximg;
-{
- if (! img->background_valid)
- /* IMG doesn't have a background yet, try to guess a reasonable value. */
- {
- int free_ximg = !ximg;
-
- if (! ximg)
- ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
- 0, 0, img->width, img->height, ~0, ZPixmap);
-
- img->background = four_corners_best (ximg, img->width, img->height);
-
- if (free_ximg)
- XDestroyImage (ximg);
-
- img->background_valid = 1;
- }
-
- return img->background;
-}
-
-/* Return the `background_transparent' field of IMG. If IMG doesn't
- have one yet, it is guessed heuristically. If non-zero, MASK is an
- existing XImage object to use for the heuristic. */
-
-int
-image_background_transparent (img, f, mask)
- struct image *img;
- struct frame *f;
- XImage *mask;
-{
- if (! img->background_transparent_valid)
- /* IMG doesn't have a background yet, try to guess a reasonable value. */
- {
- if (img->mask)
- {
- int free_mask = !mask;
-
- if (! mask)
- mask = XGetImage (FRAME_X_DISPLAY (f), img->mask,
- 0, 0, img->width, img->height, ~0, ZPixmap);
-
- img->background_transparent
- = !four_corners_best (mask, img->width, img->height);
-
- if (free_mask)
- XDestroyImage (mask);
- }
- else
- img->background_transparent = 0;
-
- img->background_transparent_valid = 1;
- }
-
- return img->background_transparent;
-}
-
-\f
-/***********************************************************************
- Helper functions for X image types
- ***********************************************************************/
-
-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));
-
-
-/* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
- free the pixmap if any. MASK_P non-zero means clear the mask
- pixmap if any. COLORS_P non-zero means free colors allocated for
- the image, if any. */
-
-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;
- img->background_valid = 0;
- }
-
- if (mask_p && img->mask)
- {
- XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
- img->mask = None;
- img->background_transparent_valid = 0;
- }
-
- if (colors_p && img->ncolors)
- {
- x_free_colors (f, img->colors, img->ncolors);
- xfree (img->colors);
- img->colors = NULL;
- img->ncolors = 0;
- }
-}
-
-/* Free X resources of image IMG which is used on frame F. */
-
-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;
-}
-
-
-/* Allocate color COLOR_NAME for image IMG on frame F. If color
- cannot be allocated, use DFLT. Add a newly allocated color to
- IMG->colors, so that it can be freed again. Value is the pixel
- color. */
-
-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, SDATA (color_name), &color, 1))
- {
- /* This isn't called frequently so we get away with simply
- reallocating the color vector to the needed size, here. */
- ++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;
-}
-
-
-\f
-/***********************************************************************
- Image Cache
- ***********************************************************************/
-
-static void cache_image P_ ((struct frame *f, struct image *img));
-static void postprocess_image P_ ((struct frame *, struct image *));
-
-
-/* Return a new, initialized image cache that is allocated from the
- heap. Call free_image_cache to free an image cache. */
-
-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;
-}
-
-
-/* Free image cache of frame F. Be aware that X frames share images
- caches. */
-
-void
-free_image_cache (f)
- struct frame *f;
-{
- struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
- if (c)
- {
- int i;
-
- /* Cache should not be referenced by any frame when freed. */
- 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;
- }
-}
-
-
-/* Clear image cache of frame F. FORCE_P non-zero means free all
- images. FORCE_P zero means clear only images that haven't been
- displayed for some time. Should be called from time to time to
- reduce the number of loaded images. If image-eviction-seconds is
- non-nil, this frees images in the cache which weren't displayed for
- at least that many seconds. */
-
-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 so that we won't be interrupted by a SIGIO
- while being in an inconsistent state. */
- 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;
- }
- }
-
- /* We may be clearing the image cache because, for example,
- Emacs was iconified for a longer period of time. In that
- case, current matrices may still contain references to
- images freed above. So, clear these matrices. */
- 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,
- doc: /* Clear the image cache of FRAME.
-FRAME nil or omitted means use the selected frame.
-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;
-}
-
-
-/* Compute masks and transform image IMG on frame F, as specified
- by the image's specification, */
-
-static void
-postprocess_image (f, img)
- struct frame *f;
- struct image *img;
-{
- /* Manipulation of the image's mask. */
- if (img->pixmap)
- {
- Lisp_Object conversion, spec;
- Lisp_Object mask;
-
- spec = img->spec;
-
- /* `:heuristic-mask t'
- `:mask heuristic'
- means build a mask heuristically.
- `:heuristic-mask (R G B)'
- `:mask (heuristic (R G B))'
- means build a mask from color (R G B) in the
- image.
- `:mask nil'
- means remove a mask, if any. */
-
- 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;
- }
- }
-
-
- /* Should we apply an image transformation algorithm? */
- 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));
- }
- }
-}
-
-
-/* Return the id of image with Lisp specification SPEC on frame F.
- SPEC must be a valid Lisp image specification (see valid_image_p). */
-
-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;
-
- /* F must be a window-system frame, and SPEC must be a valid image
- specification. */
- xassert (FRAME_WINDOW_P (f));
- xassert (valid_image_p (spec));
-
- GCPRO1 (spec);
-
- /* Look up SPEC in the hash table of the image cache. */
- 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 not found, create a new image and cache it. */
- 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 we can't load the image, and we don't have a width and
- height, use some arbitrary width and height so that we can
- draw a rectangle for it. */
- 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
- {
- /* Handle image type independent image attributes
- `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF',
- `:background COLOR'. */
- Lisp_Object ascent, margin, relief, bg;
-
- 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 (! img->background_valid)
- {
- bg = image_spec_value (img->spec, QCbackground, NULL);
- if (!NILP (bg))
- {
- img->background
- = x_alloc_image_color (f, img, bg,
- FRAME_BACKGROUND_PIXEL (f));
- img->background_valid = 1;
- }
- }
-
- /* Do image transformations and compute masks, unless we
- don't have the image yet. */
- if (!EQ (*img->type->type, Qpostscript))
- postprocess_image (f, img);
- }
-
- UNBLOCK_INPUT;
- xassert (!interrupt_input_blocked);
- }
-
- /* We're using IMG, so set its timestamp to `now'. */
- EMACS_GET_TIME (now);
- img->timestamp = EMACS_SECS (now);
-
- UNGCPRO;
-
- /* Value is the image id. */
- return img->id;
-}
-
-
-/* Cache image IMG in the image cache of frame F. */
-
-static void
-cache_image (f, img)
- struct frame *f;
- struct image *img;
-{
- struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
- int i;
-
- /* Find a free slot in c->images. */
- for (i = 0; i < c->used; ++i)
- if (c->images[i] == NULL)
- break;
-
- /* If no free slot found, maybe enlarge c->images. */
- if (i == c->used && c->used == c->size)
- {
- c->size *= 2;
- c->images = (struct image **) xrealloc (c->images,
- c->size * sizeof *c->images);
- }
-
- /* Add IMG to c->images, and assign IMG an id. */
- c->images[i] = img;
- img->id = i;
- if (i == c->used)
- ++c->used;
-
- /* Add IMG to the cache's hash table. */
- 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;
-}
-
-
-/* Call FN on every image in the image cache of frame F. Used to mark
- Lisp Objects in the image cache. */
-
-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]);
- }
- }
-}
-
-
-\f
-/***********************************************************************
- X support code
- ***********************************************************************/
-
-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));
-
-
-/* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
- frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
- Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
- via xmalloc. Print error messages via image_error if an error
- occurs. Value is non-zero if successful. */
-
-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;
- }
-
- /* Allocate image raster. */
- (*ximg)->data = (char *) xmalloc ((*ximg)->bytes_per_line * height);
-
- /* Allocate a pixmap of the same size. */
- *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;
-}
-
-
-/* Destroy XImage XIMG. Free XIMG->data. */
-
-static void
-x_destroy_x_image (ximg)
- XImage *ximg;
-{
- xassert (interrupt_input_blocked);
- if (ximg)
- {
- xfree (ximg->data);
- ximg->data = NULL;
- XDestroyImage (ximg);
- }
-}
-
-
-/* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
- are width and height of both the image and pixmap. */
-
-static void
-x_put_x_image (f, ximg, pixmap, width, height)
- struct frame *f;
- XImage *ximg;
- Pixmap pixmap;
- int width, height;
-{
- 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);
-}
-
-
-\f
-/***********************************************************************
- File Handling
- ***********************************************************************/
-
-static Lisp_Object x_find_image_file P_ ((Lisp_Object));
-static char *slurp_file P_ ((char *, int *));
-
-
-/* Find image file FILE. Look in data-directory, then
- x-bitmap-file-path. Value is the full name of the file found, or
- nil if not found. */
-
-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);
-
- /* Try to find FILE in data-directory, then x-bitmap-file-path. */
- fd = openp (search_path, file, Qnil, &file_found, Qnil);
-
- if (fd == -1)
- file_found = Qnil;
- else
- close (fd);
-
- UNGCPRO;
- return file_found;
-}
-
-
-/* Read FILE into memory. Value is a pointer to a buffer allocated
- with xmalloc holding FILE's contents. Value is null if an error
- occurred. *SIZE is set to the size of the file. */
-
-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;
-}
-
-
-\f
-/***********************************************************************
- XBM images
- ***********************************************************************/
-
-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));
-
-
-/* Indices of image specification fields in xbm_format, below. */
-
-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
-};
-
-/* Vector of image_keyword structures describing the format
- of valid XBM image specifications. */
-
-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}
-};
-
-/* Structure describing the image type XBM. */
-
-static struct image_type xbm_type =
-{
- &Qxbm,
- xbm_image_p,
- xbm_load,
- x_clear_image,
- NULL
-};
-
-/* Tokens returned from xbm_scan. */
-
-enum xbm_token
-{
- XBM_TK_IDENT = 256,
- XBM_TK_NUMBER
-};
-
-
-/* Return non-zero if OBJECT is a valid XBM-type image specification.
- A valid specification is a list starting with the symbol `image'
- The rest of the list is a property list which must contain an
- entry `:type xbm..
-
- If the specification specifies a file to load, it must contain
- an entry `:file FILENAME' where FILENAME is a string.
-
- If the specification is for a bitmap loaded from memory it must
- contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
- WIDTH and HEIGHT are integers > 0. DATA may be:
-
- 1. a string large enough to hold the bitmap data, i.e. it must
- have a size >= (WIDTH + 7) / 8 * HEIGHT
-
- 2. a bool-vector of size >= WIDTH * HEIGHT
-
- 3. a vector of strings or bool-vectors, one for each line of the
- bitmap.
-
- 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
- may not be specified in this case because they are defined in the
- XBM file.
-
- Both the file and data forms may contain the additional entries
- `:background COLOR' and `:foreground COLOR'. If not present,
- foreground and background of the frame on which the image is
- displayed is used. */
-
-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))
- {
- /* In-memory XBM file. */
- if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_FILE].count)
- return 0;
- }
- else
- {
- Lisp_Object data;
- int width, height;
-
- /* Entries for `:width', `:height' and `:data' must be present. */
- 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);
-
- /* Check type of data, and width and height against contents of
- data. */
- if (VECTORP (data))
- {
- int i;
-
- /* Number of elements of the vector must be >= height. */
- if (XVECTOR (data)->size < height)
- return 0;
-
- /* Each string or bool-vector in data must be large enough
- for one line of the image. */
- for (i = 0; i < height; ++i)
- {
- Lisp_Object elt = XVECTOR (data)->contents[i];
-
- if (STRINGP (elt))
- {
- if (SCHARS (elt)
- < (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 (SCHARS (data)
- < (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;
-}
-
-
-/* Scan a bitmap file. FP is the stream to read from. Value is
- either an enumerator from enum xbm_token, or a character for a
- single-character token, or 0 at end of file. If scanning an
- identifier, store the lexeme of the identifier in SVAL. If
- scanning a number, store its value in *IVAL. */
-
-static int
-xbm_scan (s, end, sval, ival)
- char **s, *end;
- char *sval;
- int *ival;
-{
- int c;
-
- loop:
-
- /* Skip white space. */
- 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 == '*')
- {
- /* C-style comment. */
- ++*s;
- while (**s && (**s != '*' || *(*s + 1) != '/'))
- ++*s;
- if (**s)
- {
- *s += 2;
- goto loop;
- }
- }
-
- return c;
-}
-
-
-/* Replacement for XReadBitmapFileData which isn't available under old
- X versions. CONTENTS is a pointer to a buffer to parse; END is the
- buffer's end. Set *WIDTH and *HEIGHT to the width and height of
- the image. Return in *DATA the bitmap data allocated with xmalloc.
- Value is non-zero if successful. DATA null means just test if
- CONTENTS looks like an in-memory XBM file. */
-
-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);
-
- /* Parse defines for width, height and hot-spots. */
- 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;
-
- /* Parse bits. Must start with `static'. */
- 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
-}
-
-
-/* Load XBM image IMG which will be displayed on frame F from buffer
- CONTENTS. END is the end of the buffer. Value is non-zero if
- successful. */
-
-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);
-
- /* Get foreground and background colors, maybe allocate colors. */
- 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->background = background;
- img->background_valid = 1;
- }
-
- 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;
-}
-
-
-/* Value is non-zero if DATA looks like an in-memory XBM file. */
-
-static int
-xbm_file_p (data)
- Lisp_Object data;
-{
- int w, h;
- return (STRINGP (data)
- && xbm_read_bitmap_data (SDATA (data),
- (SDATA (data)
- + SBYTES (data)),
- &w, &h, NULL));
-}
-
-
-/* Fill image IMG which is used on frame F with pixmap data. Value is
- non-zero if successful. */
-
-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));
-
- /* If IMG->spec specifies a file name, create a non-file spec from it. */
- 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 (SDATA (file), &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;
-
- /* See if data looks like an in-memory XBM file. */
- data = image_spec_value (img->spec, QCdata, NULL);
- in_memory_file_p = xbm_file_p (data);
-
- /* Parse the image specification. */
- bcopy (xbm_format, fmt, sizeof fmt);
- parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm);
- xassert (parsed_p);
-
- /* Get specified width, and height. */
- 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);
- }
-
- /* Get foreground and background colors, maybe allocate colors. */
- 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, SDATA (data),
- (SDATA (data)
- + SBYTES (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 (SDATA (line), p, nbytes);
- else
- bcopy (XBOOL_VECTOR (line)->data, p, nbytes);
- }
- }
- else if (STRINGP (data))
- bits = SDATA (data);
- else
- bits = XBOOL_VECTOR (data)->data;
-
- /* Create the pixmap. */
- 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;
-}
-
-
-\f
-/***********************************************************************
- XPM images
- ***********************************************************************/
-
-#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"
-
-/* The symbol `xpm' identifying XPM-format images. */
-
-Lisp_Object Qxpm;
-
-/* Indices of image specification fields in xpm_format, below. */
-
-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_BACKGROUND,
- XPM_LAST
-};
-
-/* Vector of image_keyword structures describing the format
- of valid XPM image specifications. */
-
-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},
- {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
-};
-
-/* Structure describing the image type XBM. */
-
-static struct image_type xpm_type =
-{
- &Qxpm,
- xpm_image_p,
- xpm_load,
- x_clear_image,
- NULL
-};
-
-
-/* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
- functions for allocating image colors. Our own functions handle
- color allocation failures more gracefully than the ones on the XPM
- lib. */
-
-#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));
-
-/* An entry in a hash table used to cache color definitions of named
- colors. This cache is necessary to speed up XPM image loading in
- case we do color allocations ourselves. Without it, we would need
- a call to XParseColor per pixel in the image. */
-
-struct xpm_cached_color
-{
- /* Next in collision chain. */
- struct xpm_cached_color *next;
-
- /* Color definition (RGB and pixel color). */
- XColor color;
-
- /* Color name. */
- char name[1];
-};
-
-/* The hash table used for the color cache, and its bucket vector
- size. */
-
-#define XPM_COLOR_CACHE_BUCKETS 1001
-struct xpm_cached_color **xpm_color_cache;
-
-/* Initialize the 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);
- }
- }
-}
-
-
-/* Free the color cache. */
-
-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 ();
-}
-
-
-/* Return the bucket index for color named COLOR_NAME in the color
- cache. */
-
-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;
-}
-
-
-/* On frame F, cache values COLOR for color with name COLOR_NAME.
- BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
- entry added. */
-
-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;
-}
-
-
-/* Look up color COLOR_NAME for frame F in the color cache. If found,
- return the cached definition in *COLOR. Otherwise, make a new
- entry in the cache and allocate the color. Value is zero if color
- allocation failed. */
-
-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);
- }
- /* You get `opaque' at least from ImageMagick converting pbm to xpm
- with transparency, and it's useful. */
- else if (strcmp ("opaque", color_name) == 0)
- {
- bzero (color, sizeof (XColor)); /* Is this necessary/correct? */
- color->pixel = FRAME_FOREGROUND_PIXEL (f);
- p = xpm_cache_color (f, color_name, color, h);
- }
-
- return p != NULL;
-}
-
-
-/* Callback for allocating color COLOR_NAME. Called from the XPM lib.
- CLOSURE is a pointer to the frame on which we allocate the
- color. Return in *COLOR the allocated color. Value is non-zero
- if successful. */
-
-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);
-}
-
-
-/* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
- is a pointer to the frame on which we allocate the color. Value is
- non-zero if successful. */
-
-static int
-xpm_free_colors (dpy, cmap, pixels, npixels, closure)
- Display *dpy;
- Colormap cmap;
- Pixel *pixels;
- int npixels;
- void *closure;
-{
- return 1;
-}
-
-#endif /* ALLOC_XPM_COLORS */
-
-
-/* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
- for XPM images. Such a list must consist of conses whose car and
- cdr are strings. */
-
-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);
-}
-
-
-/* Value is non-zero if OBJECT is a valid XPM image specification. */
-
-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)
- /* Either `:file' or `:data' must be present. */
- && fmt[XPM_FILE].count + fmt[XPM_DATA].count == 1
- /* Either no `:color-symbols' or it's a list of conses
- whose car and cdr are strings. */
- && (fmt[XPM_COLOR_SYMBOLS].count == 0
- || xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value)));
-}
-
-
-/* Load image IMG which will be displayed on frame F. Value is
- non-zero if successful. */
-
-static int
-xpm_load (f, img)
- struct frame *f;
- struct image *img;
-{
- int rc;
- XpmAttributes attrs;
- Lisp_Object specified_file, color_symbols;
-
- /* Configure the XPM lib. Use the visual of frame F. Allocate
- close colors. Return colors allocated. */
- 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
- /* Allocate colors with our own functions which handle
- failing color allocation more gracefully. */
- attrs.color_closure = f;
- attrs.alloc_color = xpm_alloc_color;
- attrs.free_colors = xpm_free_colors;
- attrs.valuemask |= XpmAllocColor | XpmFreeColors | XpmColorClosure;
-#else /* not ALLOC_XPM_COLORS */
- /* Let the XPM lib allocate colors. */
- attrs.valuemask |= XpmReturnAllocPixels;
-#ifdef XpmAllocCloseColors
- attrs.alloc_close_colors = 1;
- attrs.valuemask |= XpmAllocCloseColors;
-#else /* not XpmAllocCloseColors */
- attrs.closeness = 600;
- attrs.valuemask |= XpmCloseness;
-#endif /* not XpmAllocCloseColors */
-#endif /* ALLOC_XPM_COLORS */
-
- /* If image specification contains symbolic color definitions, add
- these to `attrs'. */
- 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;
-
- /* Count number of symbols. */
- attrs.numsymbols = 0;
- for (tail = color_symbols; CONSP (tail); tail = XCDR (tail))
- ++attrs.numsymbols;
-
- /* Allocate an XpmColorSymbol array. */
- size = attrs.numsymbols * sizeof *xpm_syms;
- xpm_syms = (XpmColorSymbol *) alloca (size);
- bzero (xpm_syms, size);
- attrs.colorsymbols = xpm_syms;
-
- /* Fill the color symbol array. */
- 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 (SCHARS (name) + 1);
- strcpy (xpm_syms[i].name, SDATA (name));
- xpm_syms[i].value = (char *) alloca (SCHARS (color) + 1);
- strcpy (xpm_syms[i].value, SDATA (color));
- }
- }
-
- /* Create a pixmap for the image, either from a file, or from a
- string buffer containing data in the same format as an XPM file. */
-#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),
- SDATA (file), &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),
- SDATA (buffer),
- &img->pixmap, &img->mask,
- &attrs);
- }
-
- if (rc == XpmSuccess)
- {
-#ifdef ALLOC_XPM_COLORS
- img->colors = colors_in_color_table (&img->ncolors);
-#else /* not ALLOC_XPM_COLORS */
- 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 /* not ALLOC_XPM_COLORS */
-
- img->width = attrs.width;
- img->height = attrs.height;
- xassert (img->width > 0 && img->height > 0);
-
- /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
- 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 /* HAVE_XPM != 0 */
-
-\f
-/***********************************************************************
- Color table
- ***********************************************************************/
-
-/* An entry in the color table mapping an RGB color to a pixel color. */
-
-struct ct_color
-{
- int r, g, b;
- unsigned long pixel;
-
- /* Next in color table collision list. */
- struct ct_color *next;
-};
-
-/* The bucket vector size to use. Must be prime. */
-
-#define CT_SIZE 101
-
-/* Value is a hash of the RGB color given by R, G, and B. */
-
-#define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
-
-/* The color hash table. */
-
-struct ct_color **ct_table;
-
-/* Number of entries in the color table. */
-
-int ct_colors_allocated;
-
-/* Initialize the color table. */
-
-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;
-}
-
-
-/* Free memory associated with the color table. */
-
-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;
-}
-
-
-/* Value is a pixel color for RGB color R, G, B on frame F. If an
- entry for that color already is in the color table, return the
- pixel color of that entry. Otherwise, allocate a new color for R,
- G, B, and make an entry in the color table. */
-
-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;
-}
-
-
-/* Look up pixel color PIXEL which is used on frame F in the color
- table. If not already present, allocate it. Value is 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;
-}
-
-
-/* Value is a vector of all pixel colors contained in the color table,
- allocated via xmalloc. Set *N to the number of colors. */
-
-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;
-}
-
-
-\f
-/***********************************************************************
- Algorithms
- ***********************************************************************/
-
-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));
-
-/* Non-zero means draw a cross on images having `:conversion
- disabled'. */
-
-int cross_disabled_images;
-
-/* Edge detection matrices for different edge-detection
- strategies. */
-
-static int emboss_matrix[9] = {
- /* x - 1 x x + 1 */
- 2, -1, 0, /* y - 1 */
- -1, 0, 1, /* y */
- 0, 1, -2 /* y + 1 */
-};
-
-static int laplace_matrix[9] = {
- /* x - 1 x x + 1 */
- 1, 0, 0, /* y - 1 */
- 0, 0, 0, /* y */
- 0, 0, -1 /* y + 1 */
-};
-
-/* Value is the intensity of the color whose red/green/blue values
- are R, G, and B. */
-
-#define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
-
-
-/* On frame F, return an array of XColor structures describing image
- IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
- non-zero means also fill the red/green/blue members of the XColor
- structures. Value is a pointer to the array of XColors structures,
- allocated with xmalloc; it must be freed by the caller. */
-
-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);
-
- /* Get the X image IMG->pixmap. */
- ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
- 0, 0, img->width, img->height, ~0, ZPixmap);
-
- /* Fill the `pixel' members of the XColor array. I wished there
- were an easy and portable way to circumvent XGetPixel. */
- 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;
-}
-
-
-/* Create IMG->pixmap from an array COLORS of XColor structures, whose
- RGB members are set. F is the frame on which this all happens.
- COLORS will be freed; an existing IMG->pixmap will be freed, too. */
-
-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 ();
-}
-
-
-/* On frame F, perform edge-detection on image IMG.
-
- MATRIX is a nine-element array specifying the transformation
- matrix. See emboss_matrix for an example.
-
- COLOR_ADJUST is a color adjustment added to each pixel of the
- outgoing image. */
-
-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
-}
-
-
-/* Perform the pre-defined `emboss' edge-detection on image IMG
- on frame F. */
-
-static void
-x_emboss (f, img)
- struct frame *f;
- struct image *img;
-{
- x_detect_edges (f, img, emboss_matrix, 0xffff / 2);
-}
-
-
-/* Perform the pre-defined `laplace' edge-detection on image IMG
- on frame F. */
-
-static void
-x_laplace (f, img)
- struct frame *f;
- struct image *img;
-{
- x_detect_edges (f, img, laplace_matrix, 45000);
-}
-
-
-/* Perform edge-detection on image IMG on frame F, with specified
- transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
-
- MATRIX must be either
-
- - a list of at least 9 numbers in row-major form
- - a vector of at least 9 numbers
-
- COLOR_ADJUST nil means use a default; otherwise it must be a
- number. */
-
-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));
-}
-
-
-/* Transform image IMG on frame F so that it looks disabled. */
-
-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)
- {
- /* Color (or grayscale). Convert to gray, and equalize. Just
- drawing such images with a stipple can look very odd, so
- we're using this method instead. */
- 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);
- }
-
- /* Draw a cross over the disabled image, if we must or if we
- should. */
- 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);
- }
- }
-}
-
-
-/* Build a mask for image IMG which is used on frame F. FILE is the
- name of an image file, for error messages. HOW determines how to
- determine the background color of IMG. If it is a list '(R G B)',
- with R, G, and B being integers >= 0, take that as the color of the
- background. Otherwise, determine the background color of IMG
- heuristically. Value is non-zero if successful. */
-
-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, use_img_background;
- unsigned long bg = 0;
-
- if (img->mask)
- {
- XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
- img->mask = None;
- img->background_transparent_valid = 0;
- }
-
- /* Create an image and pixmap serving as mask. */
- rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1,
- &mask_img, &img->mask);
- if (!rc)
- return 0;
-
- /* Get the X image of IMG->pixmap. */
- ximg = XGetImage (dpy, img->pixmap, 0, 0, img->width, img->height,
- ~0, ZPixmap);
-
- /* Determine the background color of ximg. If HOW is `(R G B)'
- take that as color. Otherwise, use the image's background color. */
- use_img_background = 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);
- use_img_background = 0;
- }
- }
-
- if (use_img_background)
- bg = four_corners_best (ximg, img->width, img->height);
-
- /* Set all bits in mask_img to 1 whose color in ximg is different
- from the background color bg. */
- for (y = 0; y < img->height; ++y)
- for (x = 0; x < img->width; ++x)
- XPutPixel (mask_img, x, y, XGetPixel (ximg, x, y) != bg);
-
- /* Fill in the background_transparent field while we have the mask handy. */
- image_background_transparent (img, f, mask_img);
-
- /* Put mask_img into img->mask. */
- x_put_x_image (f, mask_img, img->mask, img->width, img->height);
- x_destroy_x_image (mask_img);
- XDestroyImage (ximg);
-
- return 1;
-}
-
-
-\f
-/***********************************************************************
- PBM (mono, gray, color)
- ***********************************************************************/
-
-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 *));
-
-/* The symbol `pbm' identifying images of this type. */
-
-Lisp_Object Qpbm;
-
-/* Indices of image specification fields in gs_format, below. */
-
-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
-};
-
-/* Vector of image_keyword structures describing the format
- of valid user-defined image specifications. */
-
-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}
-};
-
-/* Structure describing the image type `pbm'. */
-
-static struct image_type pbm_type =
-{
- &Qpbm,
- pbm_image_p,
- pbm_load,
- x_clear_image,
- NULL
-};
-
-
-/* Return non-zero if OBJECT is a valid PBM image specification. */
-
-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;
-
- /* Must specify either :data or :file. */
- return fmt[PBM_DATA].count + fmt[PBM_FILE].count == 1;
-}
-
-
-/* Scan a decimal number from *S and return it. Advance *S while
- reading the number. END is the end of the string. Value is -1 at
- end of input. */
-
-static int
-pbm_scan_number (s, end)
- unsigned char **s, *end;
-{
- int c = 0, val = -1;
-
- while (*s < end)
- {
- /* Skip white-space. */
- while (*s < end && (c = *(*s)++, isspace (c)))
- ;
-
- if (c == '#')
- {
- /* Skip comment to end of line. */
- while (*s < end && (c = *(*s)++, c != '\n'))
- ;
- }
- else if (isdigit (c))
- {
- /* Read decimal number. */
- val = c - '0';
- while (*s < end && (c = *(*s)++, isdigit (c)))
- val = 10 * val + c - '0';
- break;
- }
- else
- break;
- }
-
- return val;
-}
-
-
-/* Load PBM image IMG for use on frame F. */
-
-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 (SDATA (file), &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 = SDATA (data);
- end = p + SBYTES (data);
- }
-
- /* Check magic number. */
- 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;
- }
-
- /* Read width, height, maximum color-component. Characters
- starting with `#' up to the end of a line are ignored. */
- 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;
-
- /* Initialize the color hash table. */
- 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);
-
- /* Parse the image specification. */
- bcopy (pbm_format, fmt, sizeof fmt);
- parse_image_spec (img->spec, fmt, PBM_LAST, Qpbm);
-
- /* Get foreground and background colors, maybe allocate colors. */
- 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);
- img->background = bg;
- img->background_valid = 1;
- }
-
- 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;
- }
-
- /* RGB values are now in the range 0..max_color_idx.
- Scale this to the range 0..0xffff supported by X. */
- 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));
- }
- }
-
- /* Store in IMG->colors the colors allocated for the image, and
- free the color table. */
- img->colors = colors_in_color_table (&img->ncolors);
- free_color_table ();
-
- /* Maybe fill in the background field while we have ximg handy. */
- if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
- IMAGE_BACKGROUND (img, f, ximg);
-
- /* Put the image into a pixmap. */
- 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;
-}
-
-
-\f
-/***********************************************************************
- PNG
- ***********************************************************************/
-
-#if HAVE_PNG
-
-#include <libpng/png.h>
-
-/* Function prototypes. */
-
-static int png_image_p P_ ((Lisp_Object object));
-static int png_load P_ ((struct frame *f, struct image *img));
-
-/* The symbol `png' identifying images of this type. */
-
-Lisp_Object Qpng;
-
-/* Indices of image specification fields in png_format, below. */
-
-enum png_keyword_index
-{
- PNG_TYPE,
- PNG_DATA,
- PNG_FILE,
- PNG_ASCENT,
- PNG_MARGIN,
- PNG_RELIEF,
- PNG_ALGORITHM,
- PNG_HEURISTIC_MASK,
- PNG_MASK,
- PNG_BACKGROUND,
- PNG_LAST
-};
-
-/* Vector of image_keyword structures describing the format
- of valid user-defined image specifications. */
-
-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},
- {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
-};
-
-/* Structure describing the image type `png'. */
-
-static struct image_type png_type =
-{
- &Qpng,
- png_image_p,
- png_load,
- x_clear_image,
- NULL
-};
-
-
-/* Return non-zero if OBJECT is a valid PNG image specification. */
-
-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;
-
- /* Must specify either the :data or :file keyword. */
- return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
-}
-
-
-/* Error and warning handlers installed when the PNG library
- is initialized. */
-
-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);
-}
-
-/* Memory source for PNG decoding. */
-
-struct png_memory_storage
-{
- unsigned char *bytes; /* The data */
- size_t len; /* How big is it? */
- int index; /* Where are we? */
-};
-
-
-/* Function set as reader function when reading PNG image from memory.
- PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
- bytes from the input to DATA. */
-
-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;
-}
-
-/* Load PNG image IMG for use on frame F. Value is non-zero if
- successful. */
-
-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;
- double screen_gamma;
- struct png_memory_storage tbr; /* Data to be read */
-
- /* Find out what file to load. */
- 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;
- }
-
- /* Open the image file. */
- fp = fopen (SDATA (file), "rb");
- if (!fp)
- {
- image_error ("Cannot open image file `%s'", file, Qnil);
- UNGCPRO;
- fclose (fp);
- return 0;
- }
-
- /* Check PNG signature. */
- 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
- {
- /* Read from memory. */
- tbr.bytes = SDATA (specified_data);
- tbr.len = SBYTES (specified_data);
- tbr.index = 0;
-
- /* Check PNG signature. */
- 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;
- }
-
- /* Need to skip past the signature. */
- tbr.bytes += sizeof (sig);
- }
-
- /* Initialize read and info structs for PNG lib. */
- 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;
- }
-
- /* Set error jump-back. We come back here when the PNG library
- detects an error. */
- 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;
- }
-
- /* Read image info. */
- 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 image contains simply transparency data, we prefer to
- construct a clipping mask. */
- if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
- transparent_p = 1;
- else
- transparent_p = 0;
-
- /* This function is easier to write if we only have to handle
- one data format: RGB or RGBA with 8 bits per channel. Let's
- transform other formats into that format. */
-
- /* Strip more than 8 bits per channel. */
- if (bit_depth == 16)
- png_set_strip_16 (png_ptr);
-
- /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
- if available. */
- png_set_expand (png_ptr);
-
- /* Convert grayscale images to RGB. */
- if (color_type == PNG_COLOR_TYPE_GRAY
- || color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
- png_set_gray_to_rgb (png_ptr);
-
- screen_gamma = (f->gamma ? 1 / f->gamma / 0.45455 : 2.2);
-
-#if 0 /* Avoid double gamma correction for PNG images. */
- { /* Tell the PNG lib to handle gamma correction for us. */
- int intent;
- double image_gamma;
-#if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
- if (png_get_sRGB (png_ptr, info_ptr, &intent))
- /* The libpng documentation says this is right in this case. */
- png_set_gamma (png_ptr, screen_gamma, 0.45455);
- else
-#endif
- if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
- /* Image contains gamma information. */
- png_set_gamma (png_ptr, screen_gamma, image_gamma);
- else
- /* Use the standard default for the image gamma. */
- png_set_gamma (png_ptr, screen_gamma, 0.45455);
- }
-#endif /* if 0 */
-
- /* Handle alpha channel by combining the image with a background
- color. Do this only if a real alpha channel is supplied. For
- simple transparency, we prefer a clipping mask. */
- if (!transparent_p)
- {
- png_color_16 *image_bg;
- Lisp_Object specified_bg
- = image_spec_value (img->spec, QCbackground, NULL);
-
- if (STRINGP (specified_bg))
- /* The user specified `:background', use that. */
- {
- XColor color;
- if (x_defined_color (f, SDATA (specified_bg), &color, 0))
- {
- png_color_16 user_bg;
-
- bzero (&user_bg, sizeof user_bg);
- user_bg.red = color.red;
- user_bg.green = color.green;
- user_bg.blue = color.blue;
-
- png_set_background (png_ptr, &user_bg,
- PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
- }
- }
- else if (png_get_bKGD (png_ptr, info_ptr, &image_bg))
- /* Image contains a background color with which to
- combine the image. */
- png_set_background (png_ptr, image_bg,
- PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
- else
- {
- /* Image does not contain a background color with which
- to combine the image data via an alpha channel. Use
- the frame's background instead. */
- 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);
- }
- }
-
- /* Update info structure. */
- png_read_update_info (png_ptr, info_ptr);
-
- /* Get number of channels. Valid values are 1 for grayscale images
- and images with a palette, 2 for grayscale images with transparency
- information (alpha channel), 3 for RGB images, and 4 for RGB
- images with alpha channel, i.e. RGBA. If conversions above were
- sufficient we should only have 3 or 4 channels here. */
- channels = png_get_channels (png_ptr, info_ptr);
- xassert (channels == 3 || channels == 4);
-
- /* Number of bytes needed for one row of the image. */
- row_bytes = png_get_rowbytes (png_ptr, info_ptr);
-
- /* Allocate memory for the image. */
- 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;
-
- /* Read the entire image. */
- png_read_image (png_ptr, rows);
- png_read_end (png_ptr, info_ptr);
- if (fp)
- {
- fclose (fp);
- fp = NULL;
- }
-
- /* Create the X image and pixmap. */
- if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
- &img->pixmap))
- goto error;
-
- /* Create an image and pixmap serving as mask if the PNG image
- contains an alpha channel. */
- 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;
- }
-
- /* Fill the X image and mask from PNG data. */
- 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));
-
- /* An alpha channel, aka mask channel, associates variable
- transparency with an image. Where other image formats
- support binary transparency---fully transparent or fully
- opaque---PNG allows up to 254 levels of partial transparency.
- The PNG library implements partial transparency by combining
- the image with a specified background color.
-
- I'm not sure how to handle this here nicely: because the
- background on which the image is displayed may change, for
- real alpha channel support, it would be necessary to create
- a new image for each possible background.
-
- What I'm doing now is that a mask is created if we have
- boolean transparency information. Otherwise I'm using
- the frame's background color to combine the image with. */
-
- if (channels == 4)
- {
- if (mask_img)
- XPutPixel (mask_img, x, y, *p > 0);
- ++p;
- }
- }
- }
-
- if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
- /* Set IMG's background color from the PNG image, unless the user
- overrode it. */
- {
- png_color_16 *bg;
- if (png_get_bKGD (png_ptr, info_ptr, &bg))
- {
- img->background = lookup_rgb_color (f, bg->red, bg->green, bg->blue);
- img->background_valid = 1;
- }
- }
-
- /* Remember colors allocated for this image. */
- img->colors = colors_in_color_table (&img->ncolors);
- free_color_table ();
-
- /* Clean up. */
- png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
- xfree (rows);
- xfree (pixels);
-
- img->width = width;
- img->height = height;
-
- /* Maybe fill in the background field while we have ximg handy. */
- IMAGE_BACKGROUND (img, f, ximg);
-
- /* Put the image into the pixmap, then free the X image and its buffer. */
- x_put_x_image (f, ximg, img->pixmap, width, height);
- x_destroy_x_image (ximg);
-
- /* Same for the mask. */
- if (mask_img)
- {
- /* Fill in the background_transparent field while we have the mask
- handy. */
- image_background_transparent (img, f, 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 /* HAVE_PNG != 0 */
-
-
-\f
-/***********************************************************************
- JPEG
- ***********************************************************************/
-
-#if HAVE_JPEG
-
-/* Work around a warning about HAVE_STDLIB_H being redefined in
- jconfig.h. */
-#ifdef HAVE_STDLIB_H
-#define HAVE_STDLIB_H_1
-#undef HAVE_STDLIB_H
-#endif /* HAVE_STLIB_H */
-
-#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));
-
-/* The symbol `jpeg' identifying images of this type. */
-
-Lisp_Object Qjpeg;
-
-/* Indices of image specification fields in gs_format, below. */
-
-enum jpeg_keyword_index
-{
- JPEG_TYPE,
- JPEG_DATA,
- JPEG_FILE,
- JPEG_ASCENT,
- JPEG_MARGIN,
- JPEG_RELIEF,
- JPEG_ALGORITHM,
- JPEG_HEURISTIC_MASK,
- JPEG_MASK,
- JPEG_BACKGROUND,
- JPEG_LAST
-};
-
-/* Vector of image_keyword structures describing the format
- of valid user-defined image specifications. */
-
-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},
- {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
-};
-
-/* Structure describing the image type `jpeg'. */
-
-static struct image_type jpeg_type =
-{
- &Qjpeg,
- jpeg_image_p,
- jpeg_load,
- x_clear_image,
- NULL
-};
-
-
-/* Return non-zero if OBJECT is a valid JPEG image specification. */
-
-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;
-
- /* Must specify either the :data or :file keyword. */
- 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);
-}
-
-
-/* Init source method for JPEG data source manager. Called by
- jpeg_read_header() before any data is actually read. See
- libjpeg.doc from the JPEG lib distribution. */
-
-static void
-our_init_source (cinfo)
- j_decompress_ptr cinfo;
-{
-}
-
-
-/* Fill input buffer method for JPEG data source manager. Called
- whenever more data is needed. We read the whole image in one step,
- so this only adds a fake end of input marker at the end. */
-
-static boolean
-our_fill_input_buffer (cinfo)
- j_decompress_ptr cinfo;
-{
- /* Insert a fake EOI marker. */
- 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;
-}
-
-
-/* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
- is the JPEG data source manager. */
-
-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;
- }
-}
-
-
-/* Method to terminate data source. Called by
- jpeg_finish_decompress() after all data has been processed. */
-
-static void
-our_term_source (cinfo)
- j_decompress_ptr cinfo;
-{
-}
-
-
-/* Set up the JPEG lib for reading an image from DATA which contains
- LEN bytes. CINFO is the decompression info structure created for
- reading the image. */
-
-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)
- {
- /* First time for this JPEG object? */
- 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; /* Use default method. */
- src->term_source = our_term_source;
- src->bytes_in_buffer = len;
- src->next_input_byte = data;
-}
-
-
-/* Load image IMG for use on frame F. Patterned after example.c
- from the JPEG lib. */
-
-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;
-
- /* Open the JPEG file. */
- 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 (SDATA (file), "r");
- if (fp == NULL)
- {
- image_error ("Cannot open `%s'", file, Qnil);
- UNGCPRO;
- return 0;
- }
- }
-
- /* Customize libjpeg's error handling to call my_error_exit when an
- error is detected. This function will perform a longjmp. */
- cinfo.err = jpeg_std_error (&mgr.pub);
- mgr.pub.error_exit = my_error_exit;
-
- if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
- {
- if (rc == 1)
- {
- /* Called from my_error_exit. Display a JPEG error. */
- 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));
- }
-
- /* Close the input file and destroy the JPEG object. */
- if (fp)
- fclose ((FILE *) fp);
- jpeg_destroy_decompress (&cinfo);
-
- /* If we already have an XImage, free that. */
- x_destroy_x_image (ximg);
-
- /* Free pixmap and colors. */
- x_clear_image (f, img);
-
- UNGCPRO;
- return 0;
- }
-
- /* Create the JPEG decompression object. Let it read from fp.
- Read the JPEG image header. */
- jpeg_create_decompress (&cinfo);
-
- if (NILP (specified_data))
- jpeg_stdio_src (&cinfo, (FILE *) fp);
- else
- jpeg_memory_src (&cinfo, SDATA (specified_data),
- SBYTES (specified_data));
-
- jpeg_read_header (&cinfo, TRUE);
-
- /* Customize decompression so that color quantization will be used.
- Start decompression. */
- cinfo.quantize_colors = TRUE;
- jpeg_start_decompress (&cinfo);
- width = img->width = cinfo.output_width;
- height = img->height = cinfo.output_height;
-
- /* Create X image and pixmap. */
- if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
- longjmp (mgr.setjmp_buffer, 2);
-
- /* Allocate colors. When color quantization is used,
- cinfo.actual_number_of_colors has been set with the number of
- colors generated, and cinfo.colormap is a two-dimensional array
- of color indices in the range 0..cinfo.actual_number_of_colors.
- No more than 255 colors will be generated. */
- {
- 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;
-
- /* Use the color table mechanism because it handles colors that
- cannot be allocated nicely. Such colors will be replaced with
- a default color, and we don't have to care about which colors
- can be freed safely, and which can't. */
- init_color_table ();
- colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
- * sizeof *colors);
-
- for (i = 0; i < cinfo.actual_number_of_colors; ++i)
- {
- /* Multiply RGB values with 255 because X expects RGB values
- in the range 0..0xffff. */
- 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);
- }
-
- /* Remember those colors actually allocated. */
- img->colors = colors_in_color_table (&img->ncolors);
- free_color_table ();
- }
-
- /* Read pixels. */
- 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]]);
- }
-
- /* Clean up. */
- jpeg_finish_decompress (&cinfo);
- jpeg_destroy_decompress (&cinfo);
- if (fp)
- fclose ((FILE *) fp);
-
- /* Maybe fill in the background field while we have ximg handy. */
- if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
- IMAGE_BACKGROUND (img, f, ximg);
-
- /* Put the image into the pixmap. */
- x_put_x_image (f, ximg, img->pixmap, width, height);
- x_destroy_x_image (ximg);
- UNGCPRO;
- return 1;
-}
-
-#endif /* HAVE_JPEG */
-
-
-\f
-/***********************************************************************
- TIFF
- ***********************************************************************/
-
-#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));
-
-/* The symbol `tiff' identifying images of this type. */
-
-Lisp_Object Qtiff;
-
-/* Indices of image specification fields in tiff_format, below. */
-
-enum tiff_keyword_index
-{
- TIFF_TYPE,
- TIFF_DATA,
- TIFF_FILE,
- TIFF_ASCENT,
- TIFF_MARGIN,
- TIFF_RELIEF,
- TIFF_ALGORITHM,
- TIFF_HEURISTIC_MASK,
- TIFF_MASK,
- TIFF_BACKGROUND,
- TIFF_LAST
-};
-
-/* Vector of image_keyword structures describing the format
- of valid user-defined image specifications. */
-
-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},
- {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
-};
-
-/* Structure describing the image type `tiff'. */
-
-static struct image_type tiff_type =
-{
- &Qtiff,
- tiff_image_p,
- tiff_load,
- x_clear_image,
- NULL
-};
-
-
-/* Return non-zero if OBJECT is a valid TIFF image specification. */
-
-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;
-
- /* Must specify either the :data or :file keyword. */
- return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
-}
-
-
-/* Reading from a memory buffer for TIFF images Based on the PNG
- memory source, but we have to provide a lot of extra functions.
- Blah.
-
- We really only need to implement read and seek, but I am not
- convinced that the TIFF library is smart enough not to destroy
- itself if we only hand it the function pointers we need to
- override. */
-
-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: /* Go from beginning of source. */
- idx = off;
- break;
-
- case SEEK_END: /* Go from end of source. */
- idx = src->len + off;
- break;
-
- case SEEK_CUR: /* Go from current position. */
- idx = src->index + off;
- break;
-
- default: /* Invalid `whence'. */
- 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;
-{
- /* NOOP */
- return 0;
-}
-
-
-static int
-tiff_mmap_memory (data, pbase, psize)
- thandle_t data;
- tdata_t *pbase;
- toff_t *psize;
-{
- /* It is already _IN_ memory. */
- return 0;
-}
-
-
-static void
-tiff_unmap_memory (data, base, size)
- thandle_t data;
- tdata_t base;
- toff_t size;
-{
- /* We don't need to do this. */
-}
-
-
-static toff_t
-tiff_size_of_memory (data)
- thandle_t data;
-{
- return ((tiff_memory_source *) data)->len;
-}
-
-
-static void
-tiff_error_handler (title, format, ap)
- const char *title, *format;
- va_list ap;
-{
- char buf[512];
- int len;
-
- len = sprintf (buf, "TIFF error: %s ", title);
- vsprintf (buf + len, format, ap);
- add_to_log (buf, Qnil, Qnil);
-}
-
-
-static void
-tiff_warning_handler (title, format, ap)
- const char *title, *format;
- va_list ap;
-{
- char buf[512];
- int len;
-
- len = sprintf (buf, "TIFF warning: %s ", title);
- vsprintf (buf + len, format, ap);
- add_to_log (buf, Qnil, Qnil);
-}
-
-
-/* Load TIFF image IMG for use on frame F. Value is non-zero if
- successful. */
-
-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);
-
- TIFFSetErrorHandler (tiff_error_handler);
- TIFFSetWarningHandler (tiff_warning_handler);
-
- if (NILP (specified_data))
- {
- /* Read from a file */
- file = x_find_image_file (specified_file);
- if (!STRINGP (file))
- {
- image_error ("Cannot find image file `%s'", file, Qnil);
- UNGCPRO;
- return 0;
- }
-
- /* Try to open the image file. */
- tiff = TIFFOpen (SDATA (file), "r");
- if (tiff == NULL)
- {
- image_error ("Cannot open `%s'", file, Qnil);
- UNGCPRO;
- return 0;
- }
- }
- else
- {
- /* Memory source! */
- memsrc.bytes = SDATA (specified_data);
- memsrc.len = SBYTES (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;
- }
- }
-
- /* Get width and height of the image, and allocate a raster buffer
- of width x height 32-bit values. */
- 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;
- }
-
- /* Create the X image and pixmap. */
- if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
- {
- xfree (buf);
- UNGCPRO;
- return 0;
- }
-
- /* Initialize the color table. */
- init_color_table ();
-
- /* Process the pixel raster. Origin is in the lower-left corner. */
- 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));
- }
- }
-
- /* Remember the colors allocated for the image. Free the color table. */
- img->colors = colors_in_color_table (&img->ncolors);
- free_color_table ();
-
- img->width = width;
- img->height = height;
-
- /* Maybe fill in the background field while we have ximg handy. */
- if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
- IMAGE_BACKGROUND (img, f, ximg);
-
- /* Put the image into the pixmap, then free the X image and its buffer. */
- x_put_x_image (f, ximg, img->pixmap, width, height);
- x_destroy_x_image (ximg);
- xfree (buf);
-
- UNGCPRO;
- return 1;
-}
-
-#endif /* HAVE_TIFF != 0 */
-
-
-\f
-/***********************************************************************
- GIF
- ***********************************************************************/
-
-#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));
-
-/* The symbol `gif' identifying images of this type. */
-
-Lisp_Object Qgif;
-
-/* Indices of image specification fields in gif_format, below. */
-
-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_BACKGROUND,
- GIF_LAST
-};
-
-/* Vector of image_keyword structures describing the format
- of valid user-defined image specifications. */
-
-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},
- {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
-};
-
-/* Structure describing the image type `gif'. */
-
-static struct image_type gif_type =
-{
- &Qgif,
- gif_image_p,
- gif_load,
- x_clear_image,
- NULL
-};
-
-
-/* Return non-zero if OBJECT is a valid GIF image specification. */
-
-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;
-
- /* Must specify either the :data or :file keyword. */
- return fmt[GIF_FILE].count + fmt[GIF_DATA].count == 1;
-}
-
-
-/* Reading a GIF image from memory
- Based on the PNG memory stuff to a certain extent. */
-
-typedef struct
-{
- unsigned char *bytes;
- size_t len;
- int index;
-}
-gif_memory_source;
-
-
-/* Make the current memory source available to gif_read_from_memory.
- It's done this way because not all versions of libungif support
- a UserData field in the GifFileType structure. */
-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;
-}
-
-
-/* Load GIF image IMG for use on frame F. Value is non-zero if
- successful. */
-
-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;
- }
-
- /* Open the GIF file. */
- gif = DGifOpenFileName (SDATA (file));
- if (gif == NULL)
- {
- image_error ("Cannot open `%s'", file, Qnil);
- UNGCPRO;
- return 0;
- }
- }
- else
- {
- /* Read from memory! */
- current_gif_memory_src = &memsrc;
- memsrc.bytes = SDATA (specified_data);
- memsrc.len = SBYTES (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;
- }
- }
-
- /* Read entire contents. */
- 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);
-
- /* Create the X image and pixmap. */
- if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
- {
- DGifCloseFile (gif);
- UNGCPRO;
- return 0;
- }
-
- /* Allocate colors. */
- 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 ();
-
- /* Clear the part of the screen image that are not covered by
- the image from the GIF file. Full animated GIF support
- requires more than can be done here (see the gif89 spec,
- disposal methods). Let's simply assume that the part
- not covered by a sub-image is in the frame's background color. */
- 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));
- }
-
- /* Read the GIF image into the X image. We use a local variable
- `raster' here because RasterBits below is a char *, and invites
- problems with bytes >= 0x80. */
- 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);
-
- /* Maybe fill in the background field while we have ximg handy. */
- if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
- IMAGE_BACKGROUND (img, f, ximg);
-
- /* Put the image into the pixmap, then free the X image and its buffer. */
- x_put_x_image (f, ximg, img->pixmap, width, height);
- x_destroy_x_image (ximg);
-
- UNGCPRO;
- return 1;
-}
-
-#endif /* HAVE_GIF != 0 */
-
-
-\f
-/***********************************************************************
- Ghostscript
- ***********************************************************************/
-
-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));
-
-/* The symbol `postscript' identifying images of this type. */
-
-Lisp_Object Qpostscript;
-
-/* Keyword symbols. */
-
-Lisp_Object QCloader, QCbounding_box, QCpt_width, QCpt_height;
-
-/* Indices of image specification fields in gs_format, below. */
-
-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_BACKGROUND,
- GS_LAST
-};
-
-/* Vector of image_keyword structures describing the format
- of valid user-defined image specifications. */
-
-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},
- {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
-};
-
-/* Structure describing the image type `ghostscript'. */
-
-static struct image_type gs_type =
-{
- &Qpostscript,
- gs_image_p,
- gs_load,
- gs_clear_image,
- NULL
-};
-
-
-/* Free X resources of Ghostscript image IMG which is used on frame F. */
-
-static void
-gs_clear_image (f, img)
- struct frame *f;
- struct image *img;
-{
- /* IMG->data.ptr_val may contain a recorded colormap. */
- xfree (img->data.ptr_val);
- x_clear_image (f, img);
-}
-
-
-/* Return non-zero if OBJECT is a valid Ghostscript image
- specification. */
-
-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;
-
- /* Bounding box must be a list or vector containing 4 integers. */
- 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;
-}
-
-
-/* Load Ghostscript image IMG for use on frame F. Value is non-zero
- if successful. */
-
-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;
-
- /* Compute pixel size of pixmap needed from the given size in the
- image specification. Sizes in the specification are in pt. 1 pt
- = 1/72 in, xdpi and ydpi are stored in the frame's X display
- info. */
- 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;
-
- /* Create the pixmap. */
- 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;
- }
-
- /* Call the loader to fill the pixmap. It returns a process object
- if successful. We do not record_unwind_protect here because
- other places in redisplay like calling window scroll functions
- don't either. Let the Lisp loader use `unwind-protect' instead. */
- 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);
-}
-
-
-/* Kill the Ghostscript process that was started to fill PIXMAP on
- frame F. Called from XTread_socket when receiving an event
- telling Emacs that Ghostscript has finished drawing. */
-
-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;
-
- /* Find the image containing PIXMAP. */
- for (i = 0; i < c->used; ++i)
- if (c->images[i]->pixmap == pixmap)
- break;
-
- /* Should someone in between have cleared the image cache, for
- instance, give up. */
- if (i == c->used)
- return;
-
- /* Kill the GS process. We should have found PIXMAP in the image
- cache and its image should contain a process object. */
- img = c->images[i];
- xassert (PROCESSP (img->data.lisp_val));
- Fkill_process (img->data.lisp_val, Qnil);
- img->data.lisp_val = Qnil;
-
- /* On displays with a mutable colormap, figure out the colors
- allocated for the image by looking at the pixels of an XImage for
- img->pixmap. */
- class = FRAME_X_VISUAL (f)->class;
- if (class != StaticColor && class != StaticGray && class != TrueColor)
+ BLOCK_INPUT;
+ if (STRINGP (type))
{
- XImage *ximg;
-
- BLOCK_INPUT;
-
- /* Try to get an XImage for img->pixmep. */
- ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
- 0, 0, img->width, img->height, ~0, ZPixmap);
- if (ximg)
- {
- int x, y;
-
- /* Initialize the color table. */
- init_color_table ();
-
- /* For each pixel of the image, look its color up in the
- color table. After having done so, the color table will
- contain an entry for each color used by the image. */
- 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);
- }
-
- /* Record colors in the image. Free color table and XImage. */
- img->colors = colors_in_color_table (&img->ncolors);
- free_color_table ();
- XDestroyImage (ximg);
-
-#if 0 /* This doesn't seem to be the case. If we free the colors
- here, we get a BadAccess later in x_clear_image when
- freeing the colors. */
- /* We have allocated colors once, but Ghostscript has also
- allocated colors on behalf of us. So, to get the
- reference counts right, free them once. */
- if (img->ncolors)
- x_free_colors (f, img->colors, img->ncolors);
-#endif
- }
+ if (strcmp ("AnyPropertyType", SDATA (type)) == 0)
+ target_type = AnyPropertyType;
else
- image_error ("Cannot get X image of `%s'; colors will not be freed",
- img->spec, Qnil);
-
- UNBLOCK_INPUT;
+ target_type = XInternAtom (FRAME_X_DISPLAY (f), SDATA (type), False);
}
- /* Now that we have the pixmap, compute mask and transform the
- image if requested. */
- BLOCK_INPUT;
- postprocess_image (f, img);
- UNBLOCK_INPUT;
-}
-
-
-\f
-/***********************************************************************
- Window properties
- ***********************************************************************/
-
-DEFUN ("x-change-window-property", Fx_change_window_property,
- Sx_change_window_property, 2, 3, 0,
- doc: /* Change window property PROP to VALUE on the X window of FRAME.
-PROP and VALUE must be strings. FRAME nil or omitted means use the
-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);
- CHECK_STRING (value);
-
- BLOCK_INPUT;
- prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
- XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- prop_atom, XA_STRING, 8, PropModeReplace,
- SDATA (value), SCHARS (value));
-
- /* Make sure the property is set when we return. */
- 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,
- doc: /* Remove window property PROP from X window of FRAME.
-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);
- BLOCK_INPUT;
- prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
- XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), prop_atom);
-
- /* Make sure the property is removed when we return. */
- XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
-
- return prop;
-}
-
-
-DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
- 1, 2, 0,
- doc: /* Value is the value of window property PROP on FRAME.
-If FRAME is nil or omitted, use the selected frame. Value is nil
-if FRAME hasn't a property with name PROP or if PROP has no string
-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);
- BLOCK_INPUT;
prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
- rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- prop_atom, 0, 0, False, XA_STRING,
+ rc = XGetWindowProperty (FRAME_X_DISPLAY (f), target_window,
+ prop_atom, 0, 0, False, target_type,
&actual_type, &actual_format, &actual_size,
&bytes_remaining, (unsigned char **) &tmp_data);
if (rc == Success)
XFree (tmp_data);
tmp_data = NULL;
- rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ rc = XGetWindowProperty (FRAME_X_DISPLAY (f), target_window,
prop_atom, 0, bytes_remaining,
- False, XA_STRING,
+ ! NILP (delete_p), target_type,
&actual_type, &actual_format,
&actual_size, &bytes_remaining,
(unsigned char **) &tmp_data);
if (rc == Success && tmp_data)
- prop_value = make_string (tmp_data, size);
+ {
+ if (NILP (vector_ret_p))
+ prop_value = make_string (tmp_data, size);
+ else
+ prop_value = x_property_data_to_lisp (f,
+ (unsigned char *) tmp_data,
+ actual_type,
+ actual_format,
+ actual_size);
+ }
- XFree (tmp_data);
+ if (tmp_data) XFree (tmp_data);
}
UNBLOCK_INPUT;
+ UNGCPRO;
return prop_value;
}
FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
record_unwind_protect (unwind_create_tip_frame, frame);
+ f->display = dpyinfo->frame_display;
+ f->display->reference_count++;
+
/* By setting the output method, we're essentially saying that
the frame is live, as per FRAME_LIVE_P. If we get a signal
from this point on, x_destroy_window might screw up reference
Qnil));
}
+ Fmodify_frame_parameters (frame, Fcons (Fcons (Qwindow_system, Qx), Qnil));
+
f->no_split = 1;
UNGCPRO;
int count = specpdl_ptr - specpdl;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
char *cdef_file;
- char *cprompt;
GCPRO5 (prompt, dir, default_filename, mustmatch, file);
CHECK_STRING (prompt);
staticpro (&Qsuppress_icon);
Qundefined_color = intern ("undefined-color");
staticpro (&Qundefined_color);
- Qcenter = intern ("center");
- staticpro (&Qcenter);
Qcompound_text = intern ("compound-text");
staticpro (&Qcompound_text);
Qcancel_timer = intern ("cancel-timer");
= 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);
-
Fput (Qundefined_color, Qerror_conditions,
Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
Fput (Qundefined_color, Qerror_message,
build_string ("Undefined color"));
- DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images,
- doc: /* Non-nil means always draw a cross over disabled images.
-Disabled images are those having an `:conversion disabled' property.
-A cross is always drawn on black & white displays. */);
- cross_disabled_images = 0;
-
- DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
- doc: /* List of directories to search for window system bitmap files. */);
- Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
-
DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
doc: /* The shape of the pointer when over text.
Changing the value does not affect existing frames
Chinese, Japanese, and Korean. */);
Vx_pixel_size_width_font_regexp = Qnil;
- DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay,
- doc: /* Time after which cached images are removed from the cache.
-When an image has not been displayed this many seconds, remove it
-from the image cache. Value must be an integer or nil with nil
-meaning don't clear the cache. */);
- Vimage_cache_eviction_delay = make_number (30 * 60);
-
#ifdef USE_X_TOOLKIT
Fprovide (intern ("x-toolkit"), Qnil);
#ifdef USE_MOTIF
#endif /* USE_MOTIF */
#endif /* USE_X_TOOLKIT */
+#ifdef USE_GTK
+ Fprovide (intern ("gtk"), Qnil);
+
+ DEFVAR_LISP ("gtk-version-string", &Vgtk_version_string,
+ doc: /* Version info for GTK+. */);
+ {
+ char gtk_version[40];
+ g_snprintf (gtk_version, sizeof (gtk_version), "%u.%u.%u",
+ GTK_MAJOR_VERSION, GTK_MINOR_VERSION, GTK_MICRO_VERSION);
+ Vgtk_version_string = build_string (gtk_version);
+ }
+#endif /* USE_GTK */
+
/* X window properties. */
defsubr (&Sx_change_window_property);
defsubr (&Sx_delete_window_property);
set_frame_fontset_func = x_set_font;
check_window_system_func = check_x;
- /* Images. */
- Qxbm = intern ("xbm");
- staticpro (&Qxbm);
- 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;
#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 /* HAVE_X_WINDOWS */
+
+/* arch-tag: 55040d02-5485-4d58-8b22-95a7a05f3288
+ (do not change this comment) */
HCoop / bpt / emacs.git / blobdiff