1 /* X-specific Lisp objects.
2 Copyright (C) 1993, 1994 Free Software Foundation, Inc.
3 Copyright (C) 1995 Board of Trustees, University of Illinois.
4 Copyright (C) 1995 Tinker Systems
5 Copyright (C) 1995, 1996 Ben Wing
6 Copyright (C) 1995 Sun Microsystems
8 This file is part of XEmacs.
10 XEmacs is free software; you can redistribute it and/or modify it
11 under the terms of the GNU General Public License as published by the
12 Free Software Foundation; either version 2, or (at your option) any
15 XEmacs is distributed in the hope that it will be useful, but WITHOUT
16 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
17 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
20 You should have received a copy of the GNU General Public License
21 along with XEmacs; see the file COPYING. If not, write to
22 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 Boston, MA 02111-1307, USA. */
25 /* Synched up with: Not in FSF. */
27 /* Original author: Jamie Zawinski for 19.8
28 font-truename stuff added by Jamie Zawinski for 19.10
29 subwindow support added by Chuck Thompson
30 additional XPM support added by Chuck Thompson
31 initial X-Face support added by Stig
32 rewritten/restructured by Ben Wing for 19.12/19.13
33 GIF/JPEG support added by Ben Wing for 19.14
34 PNG support added by Bill Perry for 19.14
35 Improved GIF/JPEG support added by Bill Perry for 19.14
36 Cleanup/simplification of error handling by Ben Wing for 19.14
37 Pointer/icon overhaul, more restructuring by Ben Wing for 19.14
38 GIF support changed to external GIFlib 3.1 by Jareth Hein for 21.0
39 Many changes for color work and optimizations by Jareth Hein for 21.0
40 Switch of GIF/JPEG/PNG to new EImage intermediate code by Jareth Hein for 21.0
41 TIFF code by Jareth Hein for 21.0
42 GIF/JPEG/PNG/TIFF code moved to new glyph-eimage.c for 21.0
45 Convert images.el to C and stick it in here?
51 #include "console-x.h"
53 #include "objects-x.h"
69 #include "file-coding.h"
73 # define FOUR_BYTE_TYPE unsigned int
75 # define FOUR_BYTE_TYPE unsigned long
77 # define FOUR_BYTE_TYPE unsigned short
79 #error What kind of strange-ass system are we running on?
82 #define LISP_DEVICE_TO_X_SCREEN(dev) XDefaultScreenOfDisplay (DEVICE_X_DISPLAY (XDEVICE (dev)))
85 DEFINE_DEVICE_IIFORMAT (x, xpm);
87 DEFINE_DEVICE_IIFORMAT (x, xbm);
88 DEFINE_DEVICE_IIFORMAT (x, subwindow);
90 DEFINE_DEVICE_IIFORMAT (x, xface);
93 DEFINE_IMAGE_INSTANTIATOR_FORMAT (cursor_font);
94 Lisp_Object Qcursor_font;
96 DEFINE_IMAGE_INSTANTIATOR_FORMAT (font);
98 DEFINE_IMAGE_INSTANTIATOR_FORMAT (autodetect);
100 static void cursor_font_instantiate (Lisp_Object image_instance,
101 Lisp_Object instantiator,
102 Lisp_Object pointer_fg,
103 Lisp_Object pointer_bg,
110 /************************************************************************/
111 /* image instance methods */
112 /************************************************************************/
114 /************************************************************************/
115 /* convert from a series of RGB triples to an XImage formated for the */
117 /************************************************************************/
119 convert_EImage_to_XImage (Lisp_Object device, int width, int height,
120 unsigned char *pic, unsigned long **pixtbl,
127 int depth, bitmap_pad, bits_per_pixel, byte_cnt, i, j;
129 unsigned char *data, *ip, *dp;
130 quant_table *qtable = 0;
136 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
137 cmap = DEVICE_X_COLORMAP (XDEVICE(device));
138 vis = DEVICE_X_VISUAL (XDEVICE(device));
139 depth = DEVICE_X_DEPTH(XDEVICE(device));
141 if (vis->class == PseudoColor)
143 /* Quantize the image and get a histogram while we're at it.
144 Do this first to save memory */
145 qtable = build_EImage_quantable(pic, width, height, 256);
146 if (qtable == NULL) return NULL;
149 bitmap_pad = ((depth > 16) ? 32 :
153 outimg = XCreateImage (dpy, vis,
154 depth, ZPixmap, 0, 0, width, height,
156 if (!outimg) return NULL;
158 bits_per_pixel = outimg->bits_per_pixel;
159 byte_cnt = bits_per_pixel >> 3;
161 data = (unsigned char *) xmalloc (outimg->bytes_per_line * height);
164 XDestroyImage (outimg);
167 outimg->data = (char *) data;
169 if (vis->class == PseudoColor)
171 unsigned long pixarray[256];
173 /* use our quantize table to allocate the colors */
175 *pixtbl = xnew_array (unsigned long, pixcount);
178 /* ### should implement a sort by popularity to assure proper allocation */
180 for (i = 0; i < qtable->num_active_colors; i++)
185 color.red = qtable->rm[i] ? qtable->rm[i] << 8 : 0;
186 color.green = qtable->gm[i] ? qtable->gm[i] << 8 : 0;
187 color.blue = qtable->bm[i] ? qtable->bm[i] << 8 : 0;
188 color.flags = DoRed | DoGreen | DoBlue;
189 res = allocate_nearest_color (dpy, cmap, vis, &color);
190 if (res > 0 && res < 3)
192 DO_REALLOC(*pixtbl, pixcount, n+1, unsigned long);
193 (*pixtbl)[n] = color.pixel;
196 pixarray[i] = color.pixel;
200 for (i = 0; i < height; i++)
202 dp = data + (i * outimg->bytes_per_line);
203 for (j = 0; j < width; j++)
208 conv.val = pixarray[QUANT_GET_COLOR(qtable,rd,gr,bl)];
210 if (outimg->byte_order == MSBFirst)
211 for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q];
213 for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q];
215 if (outimg->byte_order == MSBFirst)
216 for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q];
218 for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q];
224 unsigned long rshift,gshift,bshift,rbits,gbits,bbits,junk;
225 junk = vis->red_mask;
227 while ((junk & 0x1) == 0)
238 junk = vis->green_mask;
240 while ((junk & 0x1) == 0)
251 junk = vis->blue_mask;
253 while ((junk & 0x1) == 0)
265 for (i = 0; i < height; i++)
267 dp = data + (i * outimg->bytes_per_line);
268 for (j = 0; j < width; j++)
271 rd = *ip++ << (rbits - 8);
273 rd = *ip++ >> (8 - rbits);
275 gr = *ip++ << (gbits - 8);
277 gr = *ip++ >> (8 - gbits);
279 bl = *ip++ << (bbits - 8);
281 bl = *ip++ >> (8 - bbits);
283 conv.val = (rd << rshift) | (gr << gshift) | (bl << bshift);
285 if (outimg->byte_order == MSBFirst)
286 for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q];
288 for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q];
290 if (outimg->byte_order == MSBFirst)
291 for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q];
293 for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q];
304 x_print_image_instance (struct Lisp_Image_Instance *p,
305 Lisp_Object printcharfun,
310 switch (IMAGE_INSTANCE_TYPE (p))
312 case IMAGE_MONO_PIXMAP:
313 case IMAGE_COLOR_PIXMAP:
315 sprintf (buf, " (0x%lx", (unsigned long) IMAGE_INSTANCE_X_PIXMAP (p));
316 write_c_string (buf, printcharfun);
317 if (IMAGE_INSTANCE_X_MASK (p))
319 sprintf (buf, "/0x%lx", (unsigned long) IMAGE_INSTANCE_X_MASK (p));
320 write_c_string (buf, printcharfun);
322 write_c_string (")", printcharfun);
330 x_finalize_image_instance (struct Lisp_Image_Instance *p)
335 if (DEVICE_LIVE_P (XDEVICE (p->device)))
337 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (p->device));
339 if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET
341 IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
343 if (IMAGE_INSTANCE_SUBWINDOW_ID (p))
344 XDestroyWindow (dpy, IMAGE_INSTANCE_X_SUBWINDOW_ID (p));
345 IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0;
349 if (IMAGE_INSTANCE_X_PIXMAP (p))
350 XFreePixmap (dpy, IMAGE_INSTANCE_X_PIXMAP (p));
351 if (IMAGE_INSTANCE_X_MASK (p) &&
352 IMAGE_INSTANCE_X_MASK (p) != IMAGE_INSTANCE_X_PIXMAP (p))
353 XFreePixmap (dpy, IMAGE_INSTANCE_X_MASK (p));
354 IMAGE_INSTANCE_X_PIXMAP (p) = 0;
355 IMAGE_INSTANCE_X_MASK (p) = 0;
357 if (IMAGE_INSTANCE_X_CURSOR (p))
359 XFreeCursor (dpy, IMAGE_INSTANCE_X_CURSOR (p));
360 IMAGE_INSTANCE_X_CURSOR (p) = 0;
363 if (IMAGE_INSTANCE_X_NPIXELS (p) != 0)
366 IMAGE_INSTANCE_X_COLORMAP (p),
367 IMAGE_INSTANCE_X_PIXELS (p),
368 IMAGE_INSTANCE_X_NPIXELS (p), 0);
369 IMAGE_INSTANCE_X_NPIXELS (p) = 0;
373 if (IMAGE_INSTANCE_X_PIXELS (p))
375 xfree (IMAGE_INSTANCE_X_PIXELS (p));
376 IMAGE_INSTANCE_X_PIXELS (p) = 0;
384 x_image_instance_equal (struct Lisp_Image_Instance *p1,
385 struct Lisp_Image_Instance *p2, int depth)
387 switch (IMAGE_INSTANCE_TYPE (p1))
389 case IMAGE_MONO_PIXMAP:
390 case IMAGE_COLOR_PIXMAP:
392 if (IMAGE_INSTANCE_X_COLORMAP (p1) != IMAGE_INSTANCE_X_COLORMAP (p2) ||
393 IMAGE_INSTANCE_X_NPIXELS (p1) != IMAGE_INSTANCE_X_NPIXELS (p2))
404 x_image_instance_hash (struct Lisp_Image_Instance *p, int depth)
406 switch (IMAGE_INSTANCE_TYPE (p))
408 case IMAGE_MONO_PIXMAP:
409 case IMAGE_COLOR_PIXMAP:
411 return IMAGE_INSTANCE_X_NPIXELS (p);
417 /* Set all the slots in an image instance structure to reasonable
418 default values. This is used somewhere within an instantiate
419 method. It is assumed that the device slot within the image
420 instance is already set -- this is the case when instantiate
421 methods are called. */
424 x_initialize_pixmap_image_instance (struct Lisp_Image_Instance *ii,
425 enum image_instance_type type)
427 ii->data = xnew_and_zero (struct x_image_instance_data);
428 IMAGE_INSTANCE_TYPE (ii) = type;
429 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = Qnil;
430 IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (ii) = Qnil;
431 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) = Qnil;
432 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) = Qnil;
433 IMAGE_INSTANCE_PIXMAP_FG (ii) = Qnil;
434 IMAGE_INSTANCE_PIXMAP_BG (ii) = Qnil;
438 /************************************************************************/
439 /* pixmap file functions */
440 /************************************************************************/
442 /* Where bitmaps are; initialized from resource database */
443 Lisp_Object Vx_bitmap_file_path;
446 #define BITMAPDIR "/usr/include/X11/bitmaps"
449 #define USE_XBMLANGPATH
451 /* Given a pixmap filename, look through all of the "standard" places
452 where the file might be located. Return a full pathname if found;
453 otherwise, return Qnil. */
456 x_locate_pixmap_file (Lisp_Object name)
458 /* This function can GC if IN_REDISPLAY is false */
461 /* Check non-absolute pathnames with a directory component relative to
462 the search path; that's the way Xt does it. */
463 /* #### Unix-specific */
464 if (XSTRING_BYTE (name, 0) == '/' ||
465 (XSTRING_BYTE (name, 0) == '.' &&
466 (XSTRING_BYTE (name, 1) == '/' ||
467 (XSTRING_BYTE (name, 1) == '.' &&
468 (XSTRING_BYTE (name, 2) == '/')))))
470 if (!NILP (Ffile_readable_p (name)))
476 if (NILP (Vdefault_x_device))
477 /* This may occur during initialization. */
480 /* We only check the bitmapFilePath resource on the original X device. */
481 display = DEVICE_X_DISPLAY (XDEVICE (Vdefault_x_device));
483 #ifdef USE_XBMLANGPATH
485 char *path = egetenv ("XBMLANGPATH");
486 SubstitutionRec subs[1];
488 subs[0].substitution = (char *) XSTRING_DATA (name);
489 /* #### Motif uses a big hairy default if $XBMLANGPATH isn't set.
490 We don't. If you want it used, set it. */
492 (path = XtResolvePathname (display, "bitmaps", 0, 0, path,
493 subs, XtNumber (subs), 0)))
495 name = build_string (path);
502 if (NILP (Vx_bitmap_file_path))
506 if (XrmGetResource (XtDatabase (display),
507 "bitmapFilePath", "BitmapFilePath", &type, &value)
508 && !strcmp (type, "String"))
509 Vx_bitmap_file_path = decode_env_path (0, (char *) value.addr);
510 Vx_bitmap_file_path = nconc2 (Vx_bitmap_file_path,
511 (decode_path (BITMAPDIR)));
516 if (locate_file (Vx_bitmap_file_path, name, Qnil, &found, R_OK) < 0)
518 Lisp_Object temp = list1 (Vdata_directory);
522 locate_file (temp, name, Qnil, &found, R_OK);
531 locate_pixmap_file (Lisp_Object name)
533 return x_locate_pixmap_file (name);
538 write_lisp_string_to_temp_file (Lisp_Object string, char *filename_out)
540 Lisp_Object instream, outstream;
541 Lstream *istr, *ostr;
542 char tempbuf[1024]; /* some random amount */
545 static Extbyte_dynarr *conversion_out_dynarr;
546 Bytecount bstart, bend;
547 struct gcpro gcpro1, gcpro2;
549 Lisp_Object conv_out_stream;
554 /* This function can GC */
555 if (!conversion_out_dynarr)
556 conversion_out_dynarr = Dynarr_new (Extbyte);
558 Dynarr_reset (conversion_out_dynarr);
560 /* Create the temporary file ... */
561 sprintf (filename_out, "/tmp/emacs%d.XXXXXX", (int) getpid ());
562 mktemp (filename_out);
563 tmpfil = fopen (filename_out, "w");
568 int old_errno = errno;
570 unlink (filename_out);
573 report_file_error ("Creating temp file",
574 list1 (build_string (filename_out)));
577 CHECK_STRING (string);
578 get_string_range_byte (string, Qnil, Qnil, &bstart, &bend,
579 GB_HISTORICAL_STRING_BEHAVIOR);
580 instream = make_lisp_string_input_stream (string, bstart, bend);
581 istr = XLSTREAM (instream);
582 /* setup the out stream */
583 outstream = make_dynarr_output_stream((unsigned_char_dynarr *)conversion_out_dynarr);
584 ostr = XLSTREAM (outstream);
586 /* setup the conversion stream */
587 conv_out_stream = make_encoding_output_stream (ostr, Fget_coding_system(Qbinary));
588 costr = XLSTREAM (conv_out_stream);
589 GCPRO3 (instream, outstream, conv_out_stream);
591 GCPRO2 (instream, outstream);
594 /* Get the data while doing the conversion */
597 int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
600 /* It does seem the flushes are necessary... */
602 Lstream_write (costr, tempbuf, size_in_bytes);
603 Lstream_flush (costr);
605 Lstream_write (ostr, tempbuf, size_in_bytes);
607 Lstream_flush (ostr);
608 if (fwrite ((unsigned char *)Dynarr_atp(conversion_out_dynarr, 0),
609 Dynarr_length(conversion_out_dynarr), 1, tmpfil) != 1)
614 /* reset the dynarr */
615 Lstream_rewind(ostr);
618 if (fclose (tmpfil) != 0)
620 Lstream_close (istr);
622 Lstream_close (costr);
624 Lstream_close (ostr);
627 Lstream_delete (istr);
628 Lstream_delete (ostr);
630 Lstream_delete (costr);
634 report_file_error ("Writing temp file",
635 list1 (build_string (filename_out)));
640 /************************************************************************/
641 /* cursor functions */
642 /************************************************************************/
644 /* Check that this server supports cursors of size WIDTH * HEIGHT. If
645 not, signal an error. INSTANTIATOR is only used in the error
649 check_pointer_sizes (Screen *xs, unsigned int width, unsigned int height,
650 Lisp_Object instantiator)
652 unsigned int best_width, best_height;
653 if (! XQueryBestCursor (DisplayOfScreen (xs), RootWindowOfScreen (xs),
654 width, height, &best_width, &best_height))
655 /* this means that an X error of some sort occurred (we trap
656 these so they're not fatal). */
657 signal_simple_error ("XQueryBestCursor() failed?", instantiator);
659 if (width > best_width || height > best_height)
660 error_with_frob (instantiator,
661 "pointer too large (%dx%d): "
662 "server requires %dx%d or smaller",
663 width, height, best_width, best_height);
668 generate_cursor_fg_bg (Lisp_Object device, Lisp_Object *foreground,
669 Lisp_Object *background, XColor *xfg, XColor *xbg)
671 if (!NILP (*foreground) && !COLOR_INSTANCEP (*foreground))
673 Fmake_color_instance (*foreground, device,
674 encode_error_behavior_flag (ERROR_ME));
675 if (COLOR_INSTANCEP (*foreground))
676 *xfg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (*foreground));
680 xfg->red = xfg->green = xfg->blue = 0;
683 if (!NILP (*background) && !COLOR_INSTANCEP (*background))
685 Fmake_color_instance (*background, device,
686 encode_error_behavior_flag (ERROR_ME));
687 if (COLOR_INSTANCEP (*background))
688 *xbg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (*background));
692 xbg->red = xbg->green = xbg->blue = ~0;
697 maybe_recolor_cursor (Lisp_Object image_instance, Lisp_Object foreground,
698 Lisp_Object background)
700 Lisp_Object device = XIMAGE_INSTANCE_DEVICE (image_instance);
703 generate_cursor_fg_bg (device, &foreground, &background, &xfg, &xbg);
704 if (!NILP (foreground) || !NILP (background))
706 XRecolorCursor (DEVICE_X_DISPLAY (XDEVICE (device)),
707 XIMAGE_INSTANCE_X_CURSOR (image_instance),
709 XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
710 XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
715 /************************************************************************/
716 /* color pixmap functions */
717 /************************************************************************/
719 /* Initialize an image instance from an XImage.
721 DEST_MASK specifies the mask of allowed image types.
723 PIXELS and NPIXELS specify an array of pixels that are used in
724 the image. These need to be kept around for the duration of the
725 image. When the image instance is freed, XFreeColors() will
726 automatically be called on all the pixels specified here; thus,
727 you should have allocated the pixels yourself using XAllocColor()
728 or the like. The array passed in is used directly without
729 being copied, so it should be heap data created with xmalloc().
730 It will be freed using xfree() when the image instance is
733 If this fails, signal an error. INSTANTIATOR is only used
734 in the error message.
736 #### This should be able to handle conversion into `pointer'.
737 Use the same code as for `xpm'. */
740 init_image_instance_from_x_image (struct Lisp_Image_Instance *ii,
744 unsigned long *pixels,
746 Lisp_Object instantiator)
748 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
754 if (!DEVICE_X_P (XDEVICE (device)))
755 signal_simple_error ("Not an X device", device);
757 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
758 d = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
760 if (!(dest_mask & IMAGE_COLOR_PIXMAP_MASK))
761 incompatible_image_types (instantiator, dest_mask,
762 IMAGE_COLOR_PIXMAP_MASK);
764 pixmap = XCreatePixmap (dpy, d, ximage->width,
765 ximage->height, ximage->depth);
767 signal_simple_error ("Unable to create pixmap", instantiator);
769 gc = XCreateGC (dpy, pixmap, 0, NULL);
772 XFreePixmap (dpy, pixmap);
773 signal_simple_error ("Unable to create GC", instantiator);
776 XPutImage (dpy, pixmap, gc, ximage, 0, 0, 0, 0,
777 ximage->width, ximage->height);
781 x_initialize_pixmap_image_instance (ii, IMAGE_COLOR_PIXMAP);
783 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
784 find_keyword_in_vector (instantiator, Q_file);
786 IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
787 IMAGE_INSTANCE_X_MASK (ii) = 0;
788 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = ximage->width;
789 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = ximage->height;
790 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = ximage->depth;
791 IMAGE_INSTANCE_X_COLORMAP (ii) = cmap;
792 IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
793 IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
797 x_init_image_instance_from_eimage (struct Lisp_Image_Instance *ii,
798 int width, int height,
799 unsigned char *eimage,
801 Lisp_Object instantiator,
804 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
805 Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device));
806 unsigned long *pixtbl = NULL;
810 ximage = convert_EImage_to_XImage (device, width, height, eimage,
814 if (pixtbl) xfree (pixtbl);
815 signal_image_error("EImage to XImage conversion failed", instantiator);
818 /* Now create the pixmap and set up the image instance */
819 init_image_instance_from_x_image (ii, ximage, dest_mask,
820 cmap, pixtbl, npixels,
827 xfree (ximage->data);
830 XDestroyImage (ximage);
834 int read_bitmap_data_from_file (CONST char *filename, unsigned int *width,
835 unsigned int *height, unsigned char **datap,
836 int *x_hot, int *y_hot)
838 return XmuReadBitmapDataFromFile (filename, width, height,
839 datap, x_hot, y_hot);
842 /* Given inline data for a mono pixmap, create and return the
843 corresponding X object. */
846 pixmap_from_xbm_inline (Lisp_Object device, int width, int height,
847 /* Note that data is in ext-format! */
850 return XCreatePixmapFromBitmapData (DEVICE_X_DISPLAY (XDEVICE(device)),
851 XtWindow (DEVICE_XT_APP_SHELL (XDEVICE (device))),
852 (char *) bits, width, height,
856 /* Given inline data for a mono pixmap, initialize the given
857 image instance accordingly. */
860 init_image_instance_from_xbm_inline (struct Lisp_Image_Instance *ii,
861 int width, int height,
862 /* Note that data is in ext-format! */
864 Lisp_Object instantiator,
865 Lisp_Object pointer_fg,
866 Lisp_Object pointer_bg,
869 Lisp_Object mask_filename)
871 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
872 Lisp_Object foreground = find_keyword_in_vector (instantiator, Q_foreground);
873 Lisp_Object background = find_keyword_in_vector (instantiator, Q_background);
877 enum image_instance_type type;
879 if (!DEVICE_X_P (XDEVICE (device)))
880 signal_simple_error ("Not an X device", device);
882 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
883 draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
884 scr = DefaultScreenOfDisplay (dpy);
886 if ((dest_mask & IMAGE_MONO_PIXMAP_MASK) &&
887 (dest_mask & IMAGE_COLOR_PIXMAP_MASK))
889 if (!NILP (foreground) || !NILP (background))
890 type = IMAGE_COLOR_PIXMAP;
892 type = IMAGE_MONO_PIXMAP;
894 else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
895 type = IMAGE_MONO_PIXMAP;
896 else if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
897 type = IMAGE_COLOR_PIXMAP;
898 else if (dest_mask & IMAGE_POINTER_MASK)
899 type = IMAGE_POINTER;
901 incompatible_image_types (instantiator, dest_mask,
902 IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
903 | IMAGE_POINTER_MASK);
905 x_initialize_pixmap_image_instance (ii, type);
906 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = width;
907 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = height;
908 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
909 find_keyword_in_vector (instantiator, Q_file);
913 case IMAGE_MONO_PIXMAP:
915 IMAGE_INSTANCE_X_PIXMAP (ii) =
916 pixmap_from_xbm_inline (device, width, height, (Extbyte *) bits);
920 case IMAGE_COLOR_PIXMAP:
922 Dimension d = DEVICE_X_DEPTH (XDEVICE(device));
923 unsigned long fg = BlackPixelOfScreen (scr);
924 unsigned long bg = WhitePixelOfScreen (scr);
926 if (!NILP (foreground) && !COLOR_INSTANCEP (foreground))
928 Fmake_color_instance (foreground, device,
929 encode_error_behavior_flag (ERROR_ME));
931 if (COLOR_INSTANCEP (foreground))
932 fg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground)).pixel;
934 if (!NILP (background) && !COLOR_INSTANCEP (background))
936 Fmake_color_instance (background, device,
937 encode_error_behavior_flag (ERROR_ME));
939 if (COLOR_INSTANCEP (background))
940 bg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background)).pixel;
942 /* We used to duplicate the pixels using XAllocColor(), to protect
943 against their getting freed. Just as easy to just store the
944 color instances here and GC-protect them, so this doesn't
946 IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
947 IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
948 IMAGE_INSTANCE_X_PIXMAP (ii) =
949 XCreatePixmapFromBitmapData (dpy, draw,
950 (char *) bits, width, height,
952 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = d;
958 XColor fg_color, bg_color;
961 check_pointer_sizes (scr, width, height, instantiator);
964 XCreatePixmapFromBitmapData (dpy, draw,
965 (char *) bits, width, height,
968 if (NILP (foreground))
969 foreground = pointer_fg;
970 if (NILP (background))
971 background = pointer_bg;
972 generate_cursor_fg_bg (device, &foreground, &background,
973 &fg_color, &bg_color);
975 IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
976 IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
977 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) =
978 find_keyword_in_vector (instantiator, Q_hotspot_x);
979 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) =
980 find_keyword_in_vector (instantiator, Q_hotspot_y);
981 IMAGE_INSTANCE_X_CURSOR (ii) =
983 (dpy, source, mask, &fg_color, &bg_color,
984 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ?
985 XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) : 0,
986 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) ?
987 XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) : 0);
997 xbm_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator,
998 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
999 int dest_mask, int width, int height,
1000 /* Note that data is in ext-format! */
1003 Lisp_Object mask_data = find_keyword_in_vector (instantiator, Q_mask_data);
1004 Lisp_Object mask_file = find_keyword_in_vector (instantiator, Q_mask_file);
1005 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1007 CONST char *gcc_may_you_rot_in_hell;
1009 if (!NILP (mask_data))
1011 GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (mask_data))),
1012 gcc_may_you_rot_in_hell);
1014 pixmap_from_xbm_inline (IMAGE_INSTANCE_DEVICE (ii),
1015 XINT (XCAR (mask_data)),
1016 XINT (XCAR (XCDR (mask_data))),
1017 (CONST unsigned char *)
1018 gcc_may_you_rot_in_hell);
1021 init_image_instance_from_xbm_inline (ii, width, height, bits,
1022 instantiator, pointer_fg, pointer_bg,
1023 dest_mask, mask, mask_file);
1026 /* Instantiate method for XBM's. */
1029 x_xbm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1030 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1031 int dest_mask, Lisp_Object domain)
1033 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1034 CONST char *gcc_go_home;
1036 assert (!NILP (data));
1038 GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (data))),
1041 xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1042 pointer_bg, dest_mask, XINT (XCAR (data)),
1043 XINT (XCAR (XCDR (data))), gcc_go_home);
1049 /**********************************************************************
1051 **********************************************************************/
1052 /* xpm 3.2g and better has XpmCreatePixmapFromBuffer()...
1053 There was no version number in xpm.h before 3.3, but this should do.
1055 #if (XpmVersion >= 3) || defined(XpmExactColors)
1056 # define XPM_DOES_BUFFERS
1059 #ifndef XPM_DOES_BUFFERS
1060 Your version of XPM is too old. You cannot compile with it.
1061 Upgrade to version 3.2g or better or compile with --with-xpm=no.
1062 #endif /* !XPM_DOES_BUFFERS */
1064 static XpmColorSymbol *
1065 extract_xpm_color_names (XpmAttributes *xpmattrs, Lisp_Object device,
1067 Lisp_Object color_symbol_alist)
1069 /* This function can GC */
1070 Display *dpy = DEVICE_X_DISPLAY (XDEVICE(device));
1071 Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1074 Lisp_Object results = Qnil;
1076 XpmColorSymbol *symbols;
1077 struct gcpro gcpro1, gcpro2;
1079 GCPRO2 (results, device);
1081 /* We built up results to be (("name" . #<color>) ...) so that if an
1082 error happens we don't lose any malloc()ed data, or more importantly,
1083 leave any pixels allocated in the server. */
1085 LIST_LOOP (rest, color_symbol_alist)
1087 Lisp_Object cons = XCAR (rest);
1088 Lisp_Object name = XCAR (cons);
1089 Lisp_Object value = XCDR (cons);
1092 if (STRINGP (value))
1094 Fmake_color_instance
1095 (value, device, encode_error_behavior_flag (ERROR_ME_NOT));
1098 assert (COLOR_SPECIFIERP (value));
1099 value = Fspecifier_instance (value, domain, Qnil, Qnil);
1103 results = noseeum_cons (noseeum_cons (name, value), results);
1106 UNGCPRO; /* no more evaluation */
1108 if (i == 0) return 0;
1110 symbols = xnew_array (XpmColorSymbol, i);
1111 xpmattrs->valuemask |= XpmColorSymbols;
1112 xpmattrs->colorsymbols = symbols;
1113 xpmattrs->numsymbols = i;
1117 Lisp_Object cons = XCAR (results);
1118 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (XCDR (cons)));
1119 /* Duplicate the pixel value so that we still have a lock on it if
1120 the pixel we were passed is later freed. */
1121 if (! XAllocColor (dpy, cmap, &color))
1122 abort (); /* it must be allocable since we're just duplicating it */
1124 symbols [i].name = (char *) XSTRING_DATA (XCAR (cons));
1125 symbols [i].pixel = color.pixel;
1126 symbols [i].value = 0;
1127 free_cons (XCONS (cons));
1129 results = XCDR (results);
1130 free_cons (XCONS (cons));
1136 xpm_free (XpmAttributes *xpmattrs)
1138 /* Could conceivably lose if XpmXXX returned an error without first
1139 initializing this structure, if we didn't know that initializing it
1140 to all zeros was ok (and also that it's ok to call XpmFreeAttributes()
1141 multiple times, since it zeros slots as it frees them...) */
1142 XpmFreeAttributes (xpmattrs);
1146 x_xpm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1147 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1148 int dest_mask, Lisp_Object domain)
1150 /* This function can GC */
1151 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1152 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1153 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1161 XpmAttributes xpmattrs;
1163 XpmColorSymbol *color_symbols;
1164 Lisp_Object color_symbol_alist = find_keyword_in_vector (instantiator,
1166 enum image_instance_type type;
1170 if (!DEVICE_X_P (XDEVICE (device)))
1171 signal_simple_error ("Not an X device", device);
1173 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1174 xs = DefaultScreenOfDisplay (dpy);
1176 if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
1177 type = IMAGE_COLOR_PIXMAP;
1178 else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
1179 type = IMAGE_MONO_PIXMAP;
1180 else if (dest_mask & IMAGE_POINTER_MASK)
1181 type = IMAGE_POINTER;
1183 incompatible_image_types (instantiator, dest_mask,
1184 IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
1185 | IMAGE_POINTER_MASK);
1186 force_mono = (type != IMAGE_COLOR_PIXMAP);
1189 /* Although I haven't found it documented yet, it appears that pointers are
1190 always colored via the default window colormap... Sigh. */
1191 if (type == IMAGE_POINTER)
1193 cmap = DefaultColormap(dpy, DefaultScreen(dpy));
1194 depth = DefaultDepthOfScreen (xs);
1195 visual = DefaultVisualOfScreen (xs);
1199 cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1200 depth = DEVICE_X_DEPTH (XDEVICE(device));
1201 visual = DEVICE_X_VISUAL (XDEVICE(device));
1204 cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1205 depth = DEVICE_X_DEPTH (XDEVICE(device));
1206 visual = DEVICE_X_VISUAL (XDEVICE(device));
1209 x_initialize_pixmap_image_instance (ii, type);
1211 assert (!NILP (data));
1215 xzero (xpmattrs); /* want XpmInitAttributes() */
1216 xpmattrs.valuemask = XpmReturnPixels;
1219 /* Without this, we get a 1-bit version of the color image, which
1220 isn't quite right. With this, we get the mono image, which might
1221 be very different looking. */
1222 xpmattrs.valuemask |= XpmColorKey;
1223 xpmattrs.color_key = XPM_MONO;
1225 xpmattrs.valuemask |= XpmDepth;
1229 xpmattrs.closeness = 65535;
1230 xpmattrs.valuemask |= XpmCloseness;
1231 xpmattrs.depth = depth;
1232 xpmattrs.valuemask |= XpmDepth;
1233 xpmattrs.visual = visual;
1234 xpmattrs.valuemask |= XpmVisual;
1235 xpmattrs.colormap = cmap;
1236 xpmattrs.valuemask |= XpmColormap;
1239 color_symbols = extract_xpm_color_names (&xpmattrs, device, domain,
1240 color_symbol_alist);
1242 result = XpmCreatePixmapFromBuffer (dpy,
1243 XtWindow(DEVICE_XT_APP_SHELL (XDEVICE(device))),
1244 (char *) XSTRING_DATA (data),
1245 &pixmap, &mask, &xpmattrs);
1249 xfree (color_symbols);
1250 xpmattrs.colorsymbols = 0; /* in case XpmFreeAttr is too smart... */
1251 xpmattrs.numsymbols = 0;
1258 case XpmFileInvalid:
1260 xpm_free (&xpmattrs);
1261 signal_image_error ("invalid XPM data", data);
1263 case XpmColorFailed:
1266 xpm_free (&xpmattrs);
1269 /* second time; blow out. */
1270 signal_double_file_error ("Reading pixmap data",
1271 "color allocation failed",
1276 if (! (dest_mask & IMAGE_MONO_PIXMAP_MASK))
1278 /* second time; blow out. */
1279 signal_double_file_error ("Reading pixmap data",
1280 "color allocation failed",
1284 IMAGE_INSTANCE_TYPE (ii) = IMAGE_MONO_PIXMAP;
1290 xpm_free (&xpmattrs);
1291 signal_double_file_error ("Parsing pixmap data",
1292 "out of memory", data);
1296 xpm_free (&xpmattrs);
1297 signal_double_file_error_2 ("Parsing pixmap data",
1298 "unknown error code",
1299 make_int (result), data);
1304 h = xpmattrs.height;
1307 int npixels = xpmattrs.npixels;
1312 pixels = xnew_array (Pixel, npixels);
1313 memcpy (pixels, xpmattrs.pixels, npixels * sizeof (Pixel));
1318 IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
1319 IMAGE_INSTANCE_X_MASK (ii) = mask;
1320 IMAGE_INSTANCE_X_COLORMAP (ii) = cmap;
1321 IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
1322 IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
1323 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = w;
1324 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = h;
1325 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
1326 find_keyword_in_vector (instantiator, Q_file);
1331 case IMAGE_MONO_PIXMAP:
1334 case IMAGE_COLOR_PIXMAP:
1336 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = depth;
1342 int npixels = xpmattrs.npixels;
1343 Pixel *pixels = xpmattrs.pixels;
1346 int xhot = 0, yhot = 0;
1348 if (xpmattrs.valuemask & XpmHotspot)
1350 xhot = xpmattrs.x_hotspot;
1351 XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii), xpmattrs.x_hotspot);
1353 if (xpmattrs.valuemask & XpmHotspot)
1355 yhot = xpmattrs.y_hotspot;
1356 XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii), xpmattrs.y_hotspot);
1358 check_pointer_sizes (xs, w, h, instantiator);
1360 /* If the loaded pixmap has colors allocated (meaning it came from an
1361 XPM file), then use those as the default colors for the cursor we
1362 create. Otherwise, default to pointer_fg and pointer_bg.
1366 /* With an XBM file, it's obvious which bit is foreground
1367 and which is background, or rather, it's implicit: in
1368 an XBM file, a 1 bit is foreground, and a 0 bit is
1371 XCreatePixmapCursor() assumes this property of the
1372 pixmap it is called with as well; the `foreground'
1373 color argument is used for the 1 bits.
1375 With an XPM file, it's tricker, since the elements of
1376 the pixmap don't represent FG and BG, but are actual
1377 pixel values. So we need to figure out which of those
1378 pixels is the foreground color and which is the
1379 background. We do it by comparing RGB and assuming
1380 that the darker color is the foreground. This works
1381 with the result of xbmtopbm|ppmtoxpm, at least.
1383 It might be nice if there was some way to tag the
1384 colors in the XPM file with whether they are the
1385 foreground - perhaps with logical color names somehow?
1387 Once we have decided which color is the foreground, we
1388 need to ensure that that color corresponds to a `1' bit
1389 in the Pixmap. The XPM library wrote into the (1-bit)
1390 pixmap with XPutPixel, which will ignore all but the
1391 least significant bit.
1393 This means that a 1 bit in the image corresponds to
1394 `fg' only if `fg.pixel' is odd.
1396 (This also means that the image will be all the same
1397 color if both `fg' and `bg' are odd or even, but we can
1398 safely assume that that won't happen if the XPM file is
1401 The desired result is that the image use `1' to
1402 represent the foreground color, and `0' to represent
1403 the background color. So, we may need to invert the
1404 image to accomplish this; we invert if fg is
1405 odd. (Remember that WhitePixel and BlackPixel are not
1406 necessarily 1 and 0 respectively, though I think it
1407 might be safe to assume that one of them is always 1
1408 and the other is always 0. We also pretty much need to
1409 assume that one is even and the other is odd.)
1412 fg.pixel = pixels[0]; /* pick a pixel at random. */
1413 bg.pixel = fg.pixel;
1414 for (i = 1; i < npixels; i++) /* Look for an "other" pixel value.*/
1416 bg.pixel = pixels[i];
1417 if (fg.pixel != bg.pixel)
1421 /* If (fg.pixel == bg.pixel) then probably something has
1422 gone wrong, but I don't think signalling an error would
1425 XQueryColor (dpy, cmap, &fg);
1426 XQueryColor (dpy, cmap, &bg);
1428 /* If the foreground is lighter than the background, swap them.
1429 (This occurs semi-randomly, depending on the ordering of the
1430 color list in the XPM file.)
1433 unsigned short fg_total = ((fg.red / 3) + (fg.green / 3)
1435 unsigned short bg_total = ((bg.red / 3) + (bg.green / 3)
1437 if (fg_total > bg_total)
1446 /* If the fg pixel corresponds to a `0' in the bitmap, invert it.
1447 (This occurs (only?) on servers with Black=0, White=1.)
1449 if ((fg.pixel & 1) == 0)
1453 gcv.function = GXxor;
1455 gc = XCreateGC (dpy, pixmap, (GCFunction | GCForeground),
1457 XFillRectangle (dpy, pixmap, gc, 0, 0, w, h);
1463 generate_cursor_fg_bg (device, &pointer_fg, &pointer_bg,
1465 IMAGE_INSTANCE_PIXMAP_FG (ii) = pointer_fg;
1466 IMAGE_INSTANCE_PIXMAP_BG (ii) = pointer_bg;
1469 IMAGE_INSTANCE_X_CURSOR (ii) =
1471 (dpy, pixmap, mask, &fg, &bg, xhot, yhot);
1480 xpm_free (&xpmattrs); /* after we've read pixels and hotspot */
1483 #endif /* HAVE_XPM */
1488 /**********************************************************************
1490 **********************************************************************/
1492 /* This is about to get redefined! */
1495 /* We have to define SYSV32 so that compface.h includes string.h
1496 instead of strings.h. */
1501 #include <compface.h>
1505 /* JMP_BUF cannot be used here because if it doesn't get defined
1506 to jmp_buf we end up with a conflicting type error with the
1507 definition in compface.h */
1508 extern jmp_buf comp_env;
1512 x_xface_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1513 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1514 int dest_mask, Lisp_Object domain)
1516 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1518 char *p, *bits, *bp;
1519 CONST char * volatile emsg = 0;
1520 CONST char * volatile dstring;
1522 assert (!NILP (data));
1524 GET_C_STRING_BINARY_DATA_ALLOCA (data, dstring);
1526 if ((p = strchr (dstring, ':')))
1531 /* Must use setjmp not SETJMP because we used jmp_buf above not JMP_BUF */
1532 if (!(stattis = setjmp (comp_env)))
1534 UnCompAll ((char *) dstring);
1541 emsg = "uncompface: internal error";
1544 emsg = "uncompface: insufficient or invalid data";
1547 emsg = "uncompface: excess data ignored";
1552 signal_simple_error_2 (emsg, data, Qimage);
1554 bp = bits = (char *) alloca (PIXELS / 8);
1556 /* the compface library exports char F[], which uses a single byte per
1557 pixel to represent a 48x48 bitmap. Yuck. */
1558 for (i = 0, p = F; i < (PIXELS / 8); ++i)
1561 /* reverse the bit order of each byte... */
1562 for (b = n = 0; b < 8; ++b)
1569 xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1570 pointer_bg, dest_mask, 48, 48, bits);
1573 #endif /* HAVE_XFACE */
1576 /**********************************************************************
1578 **********************************************************************/
1581 autodetect_validate (Lisp_Object instantiator)
1583 data_must_be_present (instantiator);
1587 autodetect_normalize (Lisp_Object instantiator,
1588 Lisp_Object console_type)
1590 Lisp_Object file = find_keyword_in_vector (instantiator, Q_data);
1591 Lisp_Object filename = Qnil;
1592 Lisp_Object data = Qnil;
1593 struct gcpro gcpro1, gcpro2, gcpro3;
1594 Lisp_Object alist = Qnil;
1596 GCPRO3 (filename, data, alist);
1598 if (NILP (file)) /* no conversion necessary */
1599 RETURN_UNGCPRO (instantiator);
1601 alist = tagged_vector_to_alist (instantiator);
1603 filename = locate_pixmap_file (file);
1604 if (!NILP (filename))
1607 /* #### Apparently some versions of XpmReadFileToData, which is
1608 called by pixmap_to_lisp_data, don't return an error value
1609 if the given file is not a valid XPM file. Instead, they
1610 just seg fault. It is definitely caused by passing a
1611 bitmap. To try and avoid this we check for bitmaps first. */
1613 data = bitmap_to_lisp_data (filename, &xhot, &yhot, 1);
1617 alist = remassq_no_quit (Q_data, alist);
1618 alist = Fcons (Fcons (Q_file, filename),
1619 Fcons (Fcons (Q_data, data), alist));
1621 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
1624 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
1627 alist = xbm_mask_file_munging (alist, filename, Qnil, console_type);
1630 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
1632 RETURN_UNGCPRO (result);
1637 data = pixmap_to_lisp_data (filename, 1);
1641 alist = remassq_no_quit (Q_data, alist);
1642 alist = Fcons (Fcons (Q_file, filename),
1643 Fcons (Fcons (Q_data, data), alist));
1644 alist = Fcons (Fcons (Q_color_symbols,
1645 evaluate_xpm_color_symbols ()),
1648 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
1650 RETURN_UNGCPRO (result);
1656 /* If we couldn't convert it, just put it back as it is.
1657 We might try to further frob it later as a cursor-font
1658 specification. (We can't do that now because we don't know
1659 what dest-types it's going to be instantiated into.) */
1661 Lisp_Object result = alist_to_tagged_vector (Qautodetect, alist);
1663 RETURN_UNGCPRO (result);
1668 autodetect_possible_dest_types (void)
1671 IMAGE_MONO_PIXMAP_MASK |
1672 IMAGE_COLOR_PIXMAP_MASK |
1673 IMAGE_POINTER_MASK |
1678 autodetect_instantiate (Lisp_Object image_instance,
1679 Lisp_Object instantiator,
1680 Lisp_Object pointer_fg,
1681 Lisp_Object pointer_bg,
1682 int dest_mask, Lisp_Object domain)
1684 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1685 struct gcpro gcpro1, gcpro2, gcpro3;
1686 Lisp_Object alist = Qnil;
1687 Lisp_Object result = Qnil;
1688 int is_cursor_font = 0;
1690 GCPRO3 (data, alist, result);
1692 alist = tagged_vector_to_alist (instantiator);
1693 if (dest_mask & IMAGE_POINTER_MASK)
1695 CONST char *name_ext;
1696 GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext);
1697 if (XmuCursorNameToIndex (name_ext) != -1)
1699 result = alist_to_tagged_vector (Qcursor_font, alist);
1704 if (!is_cursor_font)
1705 result = alist_to_tagged_vector (Qstring, alist);
1709 cursor_font_instantiate (image_instance, result, pointer_fg,
1710 pointer_bg, dest_mask, domain);
1712 string_instantiate (image_instance, result, pointer_fg,
1713 pointer_bg, dest_mask, domain);
1719 /**********************************************************************
1721 **********************************************************************/
1724 font_validate (Lisp_Object instantiator)
1726 data_must_be_present (instantiator);
1729 /* XmuCvtStringToCursor is bogus in the following ways:
1731 - When it can't convert the given string to a real cursor, it will
1732 sometimes return a "success" value, after triggering a BadPixmap
1733 error. It then gives you a cursor that will itself generate BadCursor
1734 errors. So we install this error handler to catch/notice the X error
1735 and take that as meaning "couldn't convert."
1737 - When you tell it to find a cursor file that doesn't exist, it prints
1738 an error message on stderr. You can't make it not do that.
1740 - Also, using Xmu means we can't properly hack Lisp_Image_Instance
1741 objects, or XPM files, or $XBMLANGPATH.
1744 /* Duplicate the behavior of XmuCvtStringToCursor() to bypass its bogusness. */
1746 static int XLoadFont_got_error;
1749 XLoadFont_error_handler (Display *dpy, XErrorEvent *xerror)
1751 XLoadFont_got_error = 1;
1756 safe_XLoadFont (Display *dpy, char *name)
1759 int (*old_handler) (Display *, XErrorEvent *);
1760 XLoadFont_got_error = 0;
1762 old_handler = XSetErrorHandler (XLoadFont_error_handler);
1763 font = XLoadFont (dpy, name);
1765 XSetErrorHandler (old_handler);
1766 if (XLoadFont_got_error) return 0;
1771 font_possible_dest_types (void)
1773 return IMAGE_POINTER_MASK;
1777 font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1778 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1779 int dest_mask, Lisp_Object domain)
1781 /* This function can GC */
1782 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1783 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1784 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1788 char source_name[MAXPATHLEN], mask_name[MAXPATHLEN], dummy;
1789 int source_char, mask_char;
1791 Lisp_Object foreground, background;
1793 if (!DEVICE_X_P (XDEVICE (device)))
1794 signal_simple_error ("Not an X device", device);
1796 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1798 if (!STRINGP (data) ||
1799 strncmp ("FONT ", (char *) XSTRING_DATA (data), 5))
1800 signal_simple_error ("Invalid font-glyph instantiator",
1803 if (!(dest_mask & IMAGE_POINTER_MASK))
1804 incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
1806 foreground = find_keyword_in_vector (instantiator, Q_foreground);
1807 if (NILP (foreground))
1808 foreground = pointer_fg;
1809 background = find_keyword_in_vector (instantiator, Q_background);
1810 if (NILP (background))
1811 background = pointer_bg;
1813 generate_cursor_fg_bg (device, &foreground, &background, &fg, &bg);
1815 count = sscanf ((char *) XSTRING_DATA (data),
1816 "FONT %s %d %s %d %c",
1817 source_name, &source_char,
1818 mask_name, &mask_char, &dummy);
1819 /* Allow "%s %d %d" as well... */
1820 if (count == 3 && (1 == sscanf (mask_name, "%d %c", &mask_char, &dummy)))
1821 count = 4, mask_name[0] = 0;
1823 if (count != 2 && count != 4)
1824 signal_simple_error ("invalid cursor specification", data);
1825 source = safe_XLoadFont (dpy, source_name);
1827 signal_simple_error_2 ("couldn't load font",
1828 build_string (source_name),
1832 else if (!mask_name[0])
1836 mask = safe_XLoadFont (dpy, mask_name);
1839 Fsignal (Qerror, list3 (build_string ("couldn't load font"),
1840 build_string (mask_name), data));
1845 /* #### call XQueryTextExtents() and check_pointer_sizes() here. */
1847 x_initialize_pixmap_image_instance (ii, IMAGE_POINTER);
1848 IMAGE_INSTANCE_X_CURSOR (ii) =
1849 XCreateGlyphCursor (dpy, source, mask, source_char, mask_char,
1851 XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
1852 XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
1853 XUnloadFont (dpy, source);
1854 if (mask && mask != source) XUnloadFont (dpy, mask);
1858 /**********************************************************************
1860 **********************************************************************/
1863 cursor_font_validate (Lisp_Object instantiator)
1865 data_must_be_present (instantiator);
1869 cursor_font_possible_dest_types (void)
1871 return IMAGE_POINTER_MASK;
1875 cursor_font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1876 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1877 int dest_mask, Lisp_Object domain)
1879 /* This function can GC */
1880 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1881 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1882 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1885 CONST char *name_ext;
1886 Lisp_Object foreground, background;
1888 if (!DEVICE_X_P (XDEVICE (device)))
1889 signal_simple_error ("Not an X device", device);
1891 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1893 if (!(dest_mask & IMAGE_POINTER_MASK))
1894 incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
1896 GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext);
1897 if ((i = XmuCursorNameToIndex (name_ext)) == -1)
1898 signal_simple_error ("Unrecognized cursor-font name", data);
1900 x_initialize_pixmap_image_instance (ii, IMAGE_POINTER);
1901 IMAGE_INSTANCE_X_CURSOR (ii) = XCreateFontCursor (dpy, i);
1902 foreground = find_keyword_in_vector (instantiator, Q_foreground);
1903 if (NILP (foreground))
1904 foreground = pointer_fg;
1905 background = find_keyword_in_vector (instantiator, Q_background);
1906 if (NILP (background))
1907 background = pointer_bg;
1908 maybe_recolor_cursor (image_instance, foreground, background);
1912 x_colorize_image_instance (Lisp_Object image_instance,
1913 Lisp_Object foreground, Lisp_Object background)
1915 struct Lisp_Image_Instance *p;
1917 p = XIMAGE_INSTANCE (image_instance);
1919 switch (IMAGE_INSTANCE_TYPE (p))
1921 case IMAGE_MONO_PIXMAP:
1922 IMAGE_INSTANCE_TYPE (p) = IMAGE_COLOR_PIXMAP;
1923 /* Make sure there aren't two pointers to the same mask, causing
1924 it to get freed twice. */
1925 IMAGE_INSTANCE_X_MASK (p) = 0;
1933 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
1934 Drawable draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (IMAGE_INSTANCE_DEVICE (p))));
1935 Dimension d = DEVICE_X_DEPTH (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
1936 Pixmap new = XCreatePixmap (dpy, draw,
1937 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
1938 IMAGE_INSTANCE_PIXMAP_HEIGHT (p), d);
1942 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground));
1943 gcv.foreground = color.pixel;
1944 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background));
1945 gcv.background = color.pixel;
1946 gc = XCreateGC (dpy, new, GCBackground|GCForeground, &gcv);
1947 XCopyPlane (dpy, IMAGE_INSTANCE_X_PIXMAP (p), new, gc, 0, 0,
1948 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
1949 IMAGE_INSTANCE_PIXMAP_HEIGHT (p),
1952 IMAGE_INSTANCE_X_PIXMAP (p) = new;
1953 IMAGE_INSTANCE_PIXMAP_DEPTH (p) = d;
1954 IMAGE_INSTANCE_PIXMAP_FG (p) = foreground;
1955 IMAGE_INSTANCE_PIXMAP_BG (p) = background;
1961 /************************************************************************/
1962 /* subwindow and widget support */
1963 /************************************************************************/
1965 /* unmap the image if it is a widget. This is used by redisplay via
1966 redisplay_unmap_subwindows */
1968 x_unmap_subwindow (struct Lisp_Image_Instance *p)
1970 XUnmapWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (p)),
1971 IMAGE_INSTANCE_X_SUBWINDOW_ID (p));
1974 /* map the subwindow. This is used by redisplay via
1975 redisplay_output_subwindow */
1977 x_map_subwindow (struct Lisp_Image_Instance *p, int x, int y)
1979 XMapWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (p)),
1980 IMAGE_INSTANCE_X_SUBWINDOW_ID (p));
1981 XMoveWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (p)),
1982 IMAGE_INSTANCE_X_SUBWINDOW_ID (p), x, y);
1985 /* instantiate and x type subwindow */
1987 x_subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1988 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1989 int dest_mask, Lisp_Object domain)
1991 /* This function can GC */
1992 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1993 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1994 Lisp_Object frame = FW_FRAME (domain);
1995 struct frame* f = XFRAME (frame);
1999 XSetWindowAttributes xswa;
2001 unsigned int w = IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii),
2002 h = IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii);
2004 if (!DEVICE_X_P (XDEVICE (device)))
2005 signal_simple_error ("Not an X device", device);
2007 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2008 xs = DefaultScreenOfDisplay (dpy);
2010 if (dest_mask & IMAGE_SUBWINDOW_MASK)
2011 IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW;
2013 incompatible_image_types (instantiator, dest_mask,
2014 IMAGE_SUBWINDOW_MASK);
2016 pw = XtWindow (FRAME_X_TEXT_WIDGET (f));
2018 ii->data = xnew_and_zero (struct x_subwindow_data);
2020 IMAGE_INSTANCE_X_SUBWINDOW_PARENT (ii) = pw;
2021 IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (ii) = xs;
2023 xswa.backing_store = Always;
2024 valueMask |= CWBackingStore;
2025 xswa.colormap = DefaultColormapOfScreen (xs);
2026 valueMask |= CWColormap;
2028 win = XCreateWindow (dpy, pw, 0, 0, w, h, 0, CopyFromParent,
2029 InputOutput, CopyFromParent, valueMask,
2032 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)win;
2036 /* #### Should this function exist? If there's any doubt I'm not implementing it --andyp */
2037 DEFUN ("change-subwindow-property", Fchange_subwindow_property, 3, 3, 0, /*
2038 For the given SUBWINDOW, set PROPERTY to DATA, which is a string.
2039 Subwindows are not currently implemented.
2041 (subwindow, property, data))
2044 struct Lisp_Subwindow *sw;
2047 CHECK_SUBWINDOW (subwindow);
2048 CHECK_STRING (property);
2049 CHECK_STRING (data);
2051 sw = XSUBWINDOW (subwindow);
2052 dpy = DisplayOfScreen (LISP_DEVICE_TO_X_SCREEN
2053 (FRAME_DEVICE (XFRAME (sw->frame))));
2055 property_atom = XInternAtom (dpy, (char *) XSTRING_DATA (property), False);
2056 XChangeProperty (dpy, sw->subwindow, property_atom, XA_STRING, 8,
2058 XSTRING_DATA (data),
2059 XSTRING_LENGTH (data));
2066 x_resize_subwindow (struct Lisp_Image_Instance* ii, int w, int h)
2068 XResizeWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (ii)),
2069 IMAGE_INSTANCE_X_SUBWINDOW_ID (ii),
2074 /************************************************************************/
2075 /* initialization */
2076 /************************************************************************/
2079 syms_of_glyphs_x (void)
2082 DEFSUBR (Fchange_subwindow_property);
2087 console_type_create_glyphs_x (void)
2091 CONSOLE_HAS_METHOD (x, print_image_instance);
2092 CONSOLE_HAS_METHOD (x, finalize_image_instance);
2093 CONSOLE_HAS_METHOD (x, image_instance_equal);
2094 CONSOLE_HAS_METHOD (x, image_instance_hash);
2095 CONSOLE_HAS_METHOD (x, colorize_image_instance);
2096 CONSOLE_HAS_METHOD (x, init_image_instance_from_eimage);
2097 CONSOLE_HAS_METHOD (x, locate_pixmap_file);
2098 CONSOLE_HAS_METHOD (x, unmap_subwindow);
2099 CONSOLE_HAS_METHOD (x, map_subwindow);
2100 CONSOLE_HAS_METHOD (x, resize_subwindow);
2104 image_instantiator_format_create_glyphs_x (void)
2107 INITIALIZE_DEVICE_IIFORMAT (x, xpm);
2108 IIFORMAT_HAS_DEVMETHOD (x, xpm, instantiate);
2110 INITIALIZE_DEVICE_IIFORMAT (x, xbm);
2111 IIFORMAT_HAS_DEVMETHOD (x, xbm, instantiate);
2113 INITIALIZE_DEVICE_IIFORMAT (x, subwindow);
2114 IIFORMAT_HAS_DEVMETHOD (x, subwindow, instantiate);
2116 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (cursor_font, "cursor-font");
2118 IIFORMAT_HAS_METHOD (cursor_font, validate);
2119 IIFORMAT_HAS_METHOD (cursor_font, possible_dest_types);
2120 IIFORMAT_HAS_METHOD (cursor_font, instantiate);
2122 IIFORMAT_VALID_KEYWORD (cursor_font, Q_data, check_valid_string);
2123 IIFORMAT_VALID_KEYWORD (cursor_font, Q_foreground, check_valid_string);
2124 IIFORMAT_VALID_KEYWORD (cursor_font, Q_background, check_valid_string);
2126 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (font, "font");
2128 IIFORMAT_HAS_METHOD (font, validate);
2129 IIFORMAT_HAS_METHOD (font, possible_dest_types);
2130 IIFORMAT_HAS_METHOD (font, instantiate);
2132 IIFORMAT_VALID_KEYWORD (font, Q_data, check_valid_string);
2133 IIFORMAT_VALID_KEYWORD (font, Q_foreground, check_valid_string);
2134 IIFORMAT_VALID_KEYWORD (font, Q_background, check_valid_string);
2137 INITIALIZE_DEVICE_IIFORMAT (x, xface);
2138 IIFORMAT_HAS_DEVMETHOD (x, xface, instantiate);
2141 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (autodetect,
2144 IIFORMAT_HAS_METHOD (autodetect, validate);
2145 IIFORMAT_HAS_METHOD (autodetect, normalize);
2146 IIFORMAT_HAS_METHOD (autodetect, possible_dest_types);
2147 IIFORMAT_HAS_METHOD (autodetect, instantiate);
2149 IIFORMAT_VALID_KEYWORD (autodetect, Q_data, check_valid_string);
2153 vars_of_glyphs_x (void)
2155 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path /*
2156 A list of the directories in which X bitmap files may be found.
2157 If nil, this is initialized from the "*bitmapFilePath" resource.
2158 This is used by the `make-image-instance' function (however, note that if
2159 the environment variable XBMLANGPATH is set, it is consulted first).
2161 Vx_bitmap_file_path = Qnil;
2165 complex_vars_of_glyphs_x (void)
2167 #define BUILD_GLYPH_INST(variable, name) \
2168 Fadd_spec_to_specifier \
2169 (GLYPH_IMAGE (XGLYPH (variable)), \
2170 vector3 (Qxbm, Q_data, \
2171 list3 (make_int (name##_width), \
2172 make_int (name##_height), \
2173 make_ext_string (name##_bits, \
2174 sizeof (name##_bits), \
2178 BUILD_GLYPH_INST (Vtruncation_glyph, truncator);
2179 BUILD_GLYPH_INST (Vcontinuation_glyph, continuer);
2180 BUILD_GLYPH_INST (Vxemacs_logo, xemacs);
2181 BUILD_GLYPH_INST (Vhscroll_glyph, hscroll);
2183 #undef BUILD_GLYPH_INST