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, 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 :
152 byte_cnt = bitmap_pad >> 3;
154 outimg = XCreateImage (dpy, vis,
155 depth, ZPixmap, 0, 0, width, height,
157 if (!outimg) return NULL;
159 data = (unsigned char *) xmalloc (outimg->bytes_per_line * height);
162 XDestroyImage (outimg);
165 outimg->data = (char *) data;
167 if (vis->class == PseudoColor)
169 unsigned long pixarray[256];
171 /* use our quantize table to allocate the colors */
173 *pixtbl = xnew_array (unsigned long, pixcount);
176 /* ### should implement a sort by popularity to assure proper allocation */
178 for (i = 0; i < qtable->num_active_colors; i++)
183 color.red = qtable->rm[i] ? qtable->rm[i] << 8 : 0;
184 color.green = qtable->gm[i] ? qtable->gm[i] << 8 : 0;
185 color.blue = qtable->bm[i] ? qtable->bm[i] << 8 : 0;
186 color.flags = DoRed | DoGreen | DoBlue;
187 res = allocate_nearest_color (dpy, cmap, vis, &color);
188 if (res > 0 && res < 3)
190 DO_REALLOC(*pixtbl, pixcount, n+1, unsigned long);
191 (*pixtbl)[n] = color.pixel;
194 pixarray[i] = color.pixel;
198 for (i = 0; i < height; i++)
200 dp = data + (i * outimg->bytes_per_line);
201 for (j = 0; j < width; j++)
206 conv.val = pixarray[QUANT_GET_COLOR(qtable,rd,gr,bl)];
208 if (outimg->byte_order == MSBFirst)
209 for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q];
211 for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q];
213 if (outimg->byte_order == MSBFirst)
214 for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q];
216 for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q];
222 unsigned long rshift,gshift,bshift,rbits,gbits,bbits,junk;
223 junk = vis->red_mask;
225 while ((junk & 0x1) == 0)
236 junk = vis->green_mask;
238 while ((junk & 0x1) == 0)
249 junk = vis->blue_mask;
251 while ((junk & 0x1) == 0)
263 for (i = 0; i < height; i++)
265 dp = data + (i * outimg->bytes_per_line);
266 for (j = 0; j < width; j++)
269 rd = *ip++ << (rbits - 8);
271 rd = *ip++ >> (8 - rbits);
273 gr = *ip++ << (gbits - 8);
275 gr = *ip++ >> (8 - gbits);
277 bl = *ip++ << (bbits - 8);
279 bl = *ip++ >> (8 - bbits);
281 conv.val = (rd << rshift) | (gr << gshift) | (bl << bshift);
283 if (outimg->byte_order == MSBFirst)
284 for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q];
286 for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q];
288 if (outimg->byte_order == MSBFirst)
289 for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q];
291 for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q];
302 x_print_image_instance (struct Lisp_Image_Instance *p,
303 Lisp_Object printcharfun,
308 switch (IMAGE_INSTANCE_TYPE (p))
310 case IMAGE_MONO_PIXMAP:
311 case IMAGE_COLOR_PIXMAP:
313 sprintf (buf, " (0x%lx", (unsigned long) IMAGE_INSTANCE_X_PIXMAP (p));
314 write_c_string (buf, printcharfun);
315 if (IMAGE_INSTANCE_X_MASK (p))
317 sprintf (buf, "/0x%lx", (unsigned long) IMAGE_INSTANCE_X_MASK (p));
318 write_c_string (buf, printcharfun);
320 write_c_string (")", printcharfun);
328 x_finalize_image_instance (struct Lisp_Image_Instance *p)
333 if (DEVICE_LIVE_P (XDEVICE (p->device)))
335 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (p->device));
337 if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET
339 IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
341 if (IMAGE_INSTANCE_SUBWINDOW_ID (p))
342 XDestroyWindow (dpy, IMAGE_INSTANCE_X_SUBWINDOW_ID (p));
343 IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0;
347 if (IMAGE_INSTANCE_X_PIXMAP (p))
348 XFreePixmap (dpy, IMAGE_INSTANCE_X_PIXMAP (p));
349 if (IMAGE_INSTANCE_X_MASK (p) &&
350 IMAGE_INSTANCE_X_MASK (p) != IMAGE_INSTANCE_X_PIXMAP (p))
351 XFreePixmap (dpy, IMAGE_INSTANCE_X_MASK (p));
352 IMAGE_INSTANCE_X_PIXMAP (p) = 0;
353 IMAGE_INSTANCE_X_MASK (p) = 0;
355 if (IMAGE_INSTANCE_X_CURSOR (p))
357 XFreeCursor (dpy, IMAGE_INSTANCE_X_CURSOR (p));
358 IMAGE_INSTANCE_X_CURSOR (p) = 0;
361 if (IMAGE_INSTANCE_X_NPIXELS (p) != 0)
364 IMAGE_INSTANCE_X_COLORMAP (p),
365 IMAGE_INSTANCE_X_PIXELS (p),
366 IMAGE_INSTANCE_X_NPIXELS (p), 0);
367 IMAGE_INSTANCE_X_NPIXELS (p) = 0;
371 if (IMAGE_INSTANCE_X_PIXELS (p))
373 xfree (IMAGE_INSTANCE_X_PIXELS (p));
374 IMAGE_INSTANCE_X_PIXELS (p) = 0;
382 x_image_instance_equal (struct Lisp_Image_Instance *p1,
383 struct Lisp_Image_Instance *p2, int depth)
385 switch (IMAGE_INSTANCE_TYPE (p1))
387 case IMAGE_MONO_PIXMAP:
388 case IMAGE_COLOR_PIXMAP:
390 if (IMAGE_INSTANCE_X_COLORMAP (p1) != IMAGE_INSTANCE_X_COLORMAP (p2) ||
391 IMAGE_INSTANCE_X_NPIXELS (p1) != IMAGE_INSTANCE_X_NPIXELS (p2))
402 x_image_instance_hash (struct Lisp_Image_Instance *p, int depth)
404 switch (IMAGE_INSTANCE_TYPE (p))
406 case IMAGE_MONO_PIXMAP:
407 case IMAGE_COLOR_PIXMAP:
409 return IMAGE_INSTANCE_X_NPIXELS (p);
415 /* Set all the slots in an image instance structure to reasonable
416 default values. This is used somewhere within an instantiate
417 method. It is assumed that the device slot within the image
418 instance is already set -- this is the case when instantiate
419 methods are called. */
422 x_initialize_pixmap_image_instance (struct Lisp_Image_Instance *ii,
423 enum image_instance_type type)
425 ii->data = xnew_and_zero (struct x_image_instance_data);
426 IMAGE_INSTANCE_TYPE (ii) = type;
427 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = Qnil;
428 IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (ii) = Qnil;
429 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) = Qnil;
430 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) = Qnil;
431 IMAGE_INSTANCE_PIXMAP_FG (ii) = Qnil;
432 IMAGE_INSTANCE_PIXMAP_BG (ii) = Qnil;
436 /************************************************************************/
437 /* pixmap file functions */
438 /************************************************************************/
440 /* Where bitmaps are; initialized from resource database */
441 Lisp_Object Vx_bitmap_file_path;
444 #define BITMAPDIR "/usr/include/X11/bitmaps"
447 #define USE_XBMLANGPATH
449 /* Given a pixmap filename, look through all of the "standard" places
450 where the file might be located. Return a full pathname if found;
451 otherwise, return Qnil. */
454 x_locate_pixmap_file (Lisp_Object name)
456 /* This function can GC if IN_REDISPLAY is false */
459 /* Check non-absolute pathnames with a directory component relative to
460 the search path; that's the way Xt does it. */
461 /* #### Unix-specific */
462 if (XSTRING_BYTE (name, 0) == '/' ||
463 (XSTRING_BYTE (name, 0) == '.' &&
464 (XSTRING_BYTE (name, 1) == '/' ||
465 (XSTRING_BYTE (name, 1) == '.' &&
466 (XSTRING_BYTE (name, 2) == '/')))))
468 if (!NILP (Ffile_readable_p (name)))
474 if (NILP (Vdefault_x_device))
475 /* This may occur during initialization. */
478 /* We only check the bitmapFilePath resource on the original X device. */
479 display = DEVICE_X_DISPLAY (XDEVICE (Vdefault_x_device));
481 #ifdef USE_XBMLANGPATH
483 char *path = egetenv ("XBMLANGPATH");
484 SubstitutionRec subs[1];
486 subs[0].substitution = (char *) XSTRING_DATA (name);
487 /* #### Motif uses a big hairy default if $XBMLANGPATH isn't set.
488 We don't. If you want it used, set it. */
490 (path = XtResolvePathname (display, "bitmaps", 0, 0, path,
491 subs, XtNumber (subs), 0)))
493 name = build_string (path);
500 if (NILP (Vx_bitmap_file_path))
504 if (XrmGetResource (XtDatabase (display),
505 "bitmapFilePath", "BitmapFilePath", &type, &value)
506 && !strcmp (type, "String"))
507 Vx_bitmap_file_path = decode_env_path (0, (char *) value.addr);
508 Vx_bitmap_file_path = nconc2 (Vx_bitmap_file_path,
509 (decode_path (BITMAPDIR)));
514 if (locate_file (Vx_bitmap_file_path, name, "", &found, R_OK) < 0)
516 Lisp_Object temp = list1 (Vdata_directory);
520 locate_file (temp, name, "", &found, R_OK);
529 locate_pixmap_file (Lisp_Object name)
531 return x_locate_pixmap_file (name);
536 write_lisp_string_to_temp_file (Lisp_Object string, char *filename_out)
538 Lisp_Object instream, outstream;
539 Lstream *istr, *ostr;
540 char tempbuf[1024]; /* some random amount */
543 static Extbyte_dynarr *conversion_out_dynarr;
544 Bytecount bstart, bend;
545 struct gcpro gcpro1, gcpro2;
547 Lisp_Object conv_out_stream;
552 /* This function can GC */
553 if (!conversion_out_dynarr)
554 conversion_out_dynarr = Dynarr_new (Extbyte);
556 Dynarr_reset (conversion_out_dynarr);
558 /* Create the temporary file ... */
559 sprintf (filename_out, "/tmp/emacs%d.XXXXXX", (int) getpid ());
560 mktemp (filename_out);
561 tmpfil = fopen (filename_out, "w");
566 int old_errno = errno;
568 unlink (filename_out);
571 report_file_error ("Creating temp file",
572 list1 (build_string (filename_out)));
575 CHECK_STRING (string);
576 get_string_range_byte (string, Qnil, Qnil, &bstart, &bend,
577 GB_HISTORICAL_STRING_BEHAVIOR);
578 instream = make_lisp_string_input_stream (string, bstart, bend);
579 istr = XLSTREAM (instream);
580 /* setup the out stream */
581 outstream = make_dynarr_output_stream((unsigned_char_dynarr *)conversion_out_dynarr);
582 ostr = XLSTREAM (outstream);
584 /* setup the conversion stream */
585 conv_out_stream = make_encoding_output_stream (ostr, Fget_coding_system(Qbinary));
586 costr = XLSTREAM (conv_out_stream);
587 GCPRO3 (instream, outstream, conv_out_stream);
589 GCPRO2 (instream, outstream);
592 /* Get the data while doing the conversion */
595 int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
598 /* It does seem the flushes are necessary... */
600 Lstream_write (costr, tempbuf, size_in_bytes);
601 Lstream_flush (costr);
603 Lstream_write (ostr, tempbuf, size_in_bytes);
605 Lstream_flush (ostr);
606 if (fwrite ((unsigned char *)Dynarr_atp(conversion_out_dynarr, 0),
607 Dynarr_length(conversion_out_dynarr), 1, tmpfil) != 1)
612 /* reset the dynarr */
613 Lstream_rewind(ostr);
616 if (fclose (tmpfil) != 0)
618 Lstream_close (istr);
620 Lstream_close (costr);
622 Lstream_close (ostr);
625 Lstream_delete (istr);
626 Lstream_delete (ostr);
628 Lstream_delete (costr);
632 report_file_error ("Writing temp file",
633 list1 (build_string (filename_out)));
638 /************************************************************************/
639 /* cursor functions */
640 /************************************************************************/
642 /* Check that this server supports cursors of size WIDTH * HEIGHT. If
643 not, signal an error. INSTANTIATOR is only used in the error
647 check_pointer_sizes (Screen *xs, unsigned int width, unsigned int height,
648 Lisp_Object instantiator)
650 unsigned int best_width, best_height;
651 if (! XQueryBestCursor (DisplayOfScreen (xs), RootWindowOfScreen (xs),
652 width, height, &best_width, &best_height))
653 /* this means that an X error of some sort occurred (we trap
654 these so they're not fatal). */
655 signal_simple_error ("XQueryBestCursor() failed?", instantiator);
657 if (width > best_width || height > best_height)
658 error_with_frob (instantiator,
659 "pointer too large (%dx%d): "
660 "server requires %dx%d or smaller",
661 width, height, best_width, best_height);
666 generate_cursor_fg_bg (Lisp_Object device, Lisp_Object *foreground,
667 Lisp_Object *background, XColor *xfg, XColor *xbg)
669 if (!NILP (*foreground) && !COLOR_INSTANCEP (*foreground))
671 Fmake_color_instance (*foreground, device,
672 encode_error_behavior_flag (ERROR_ME));
673 if (COLOR_INSTANCEP (*foreground))
674 *xfg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (*foreground));
678 xfg->red = xfg->green = xfg->blue = 0;
681 if (!NILP (*background) && !COLOR_INSTANCEP (*background))
683 Fmake_color_instance (*background, device,
684 encode_error_behavior_flag (ERROR_ME));
685 if (COLOR_INSTANCEP (*background))
686 *xbg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (*background));
690 xbg->red = xbg->green = xbg->blue = ~0;
695 maybe_recolor_cursor (Lisp_Object image_instance, Lisp_Object foreground,
696 Lisp_Object background)
698 Lisp_Object device = XIMAGE_INSTANCE_DEVICE (image_instance);
701 generate_cursor_fg_bg (device, &foreground, &background, &xfg, &xbg);
702 if (!NILP (foreground) || !NILP (background))
704 XRecolorCursor (DEVICE_X_DISPLAY (XDEVICE (device)),
705 XIMAGE_INSTANCE_X_CURSOR (image_instance),
707 XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
708 XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
713 /************************************************************************/
714 /* color pixmap functions */
715 /************************************************************************/
717 /* Initialize an image instance from an XImage.
719 DEST_MASK specifies the mask of allowed image types.
721 PIXELS and NPIXELS specify an array of pixels that are used in
722 the image. These need to be kept around for the duration of the
723 image. When the image instance is freed, XFreeColors() will
724 automatically be called on all the pixels specified here; thus,
725 you should have allocated the pixels yourself using XAllocColor()
726 or the like. The array passed in is used directly without
727 being copied, so it should be heap data created with xmalloc().
728 It will be freed using xfree() when the image instance is
731 If this fails, signal an error. INSTANTIATOR is only used
732 in the error message.
734 #### This should be able to handle conversion into `pointer'.
735 Use the same code as for `xpm'. */
738 init_image_instance_from_x_image (struct Lisp_Image_Instance *ii,
742 unsigned long *pixels,
744 Lisp_Object instantiator)
746 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
752 if (!DEVICE_X_P (XDEVICE (device)))
753 signal_simple_error ("Not an X device", device);
755 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
756 d = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
758 if (!(dest_mask & IMAGE_COLOR_PIXMAP_MASK))
759 incompatible_image_types (instantiator, dest_mask,
760 IMAGE_COLOR_PIXMAP_MASK);
762 pixmap = XCreatePixmap (dpy, d, ximage->width,
763 ximage->height, ximage->depth);
765 signal_simple_error ("Unable to create pixmap", instantiator);
767 gc = XCreateGC (dpy, pixmap, 0, NULL);
770 XFreePixmap (dpy, pixmap);
771 signal_simple_error ("Unable to create GC", instantiator);
774 XPutImage (dpy, pixmap, gc, ximage, 0, 0, 0, 0,
775 ximage->width, ximage->height);
779 x_initialize_pixmap_image_instance (ii, IMAGE_COLOR_PIXMAP);
781 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
782 find_keyword_in_vector (instantiator, Q_file);
784 IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
785 IMAGE_INSTANCE_X_MASK (ii) = 0;
786 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = ximage->width;
787 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = ximage->height;
788 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = ximage->depth;
789 IMAGE_INSTANCE_X_COLORMAP (ii) = cmap;
790 IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
791 IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
795 x_init_image_instance_from_eimage (struct Lisp_Image_Instance *ii,
796 int width, int height,
797 unsigned char *eimage,
799 Lisp_Object instantiator,
802 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
803 Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device));
804 unsigned long *pixtbl = NULL;
808 ximage = convert_EImage_to_XImage (device, width, height, eimage,
812 if (pixtbl) xfree (pixtbl);
813 signal_image_error("EImage to XImage conversion failed", instantiator);
816 /* Now create the pixmap and set up the image instance */
817 init_image_instance_from_x_image (ii, ximage, dest_mask,
818 cmap, pixtbl, npixels,
825 xfree (ximage->data);
828 XDestroyImage (ximage);
832 int read_bitmap_data_from_file (CONST char *filename, unsigned int *width,
833 unsigned int *height, unsigned char **datap,
834 int *x_hot, int *y_hot)
836 return XmuReadBitmapDataFromFile (filename, width, height,
837 datap, x_hot, y_hot);
840 /* Given inline data for a mono pixmap, create and return the
841 corresponding X object. */
844 pixmap_from_xbm_inline (Lisp_Object device, int width, int height,
845 /* Note that data is in ext-format! */
848 return XCreatePixmapFromBitmapData (DEVICE_X_DISPLAY (XDEVICE(device)),
849 XtWindow (DEVICE_XT_APP_SHELL (XDEVICE (device))),
850 (char *) bits, width, height,
854 /* Given inline data for a mono pixmap, initialize the given
855 image instance accordingly. */
858 init_image_instance_from_xbm_inline (struct Lisp_Image_Instance *ii,
859 int width, int height,
860 /* Note that data is in ext-format! */
862 Lisp_Object instantiator,
863 Lisp_Object pointer_fg,
864 Lisp_Object pointer_bg,
867 Lisp_Object mask_filename)
869 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
870 Lisp_Object foreground = find_keyword_in_vector (instantiator, Q_foreground);
871 Lisp_Object background = find_keyword_in_vector (instantiator, Q_background);
875 enum image_instance_type type;
877 if (!DEVICE_X_P (XDEVICE (device)))
878 signal_simple_error ("Not an X device", device);
880 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
881 draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
882 scr = DefaultScreenOfDisplay (dpy);
884 if ((dest_mask & IMAGE_MONO_PIXMAP_MASK) &&
885 (dest_mask & IMAGE_COLOR_PIXMAP_MASK))
887 if (!NILP (foreground) || !NILP (background))
888 type = IMAGE_COLOR_PIXMAP;
890 type = IMAGE_MONO_PIXMAP;
892 else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
893 type = IMAGE_MONO_PIXMAP;
894 else if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
895 type = IMAGE_COLOR_PIXMAP;
896 else if (dest_mask & IMAGE_POINTER_MASK)
897 type = IMAGE_POINTER;
899 incompatible_image_types (instantiator, dest_mask,
900 IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
901 | IMAGE_POINTER_MASK);
903 x_initialize_pixmap_image_instance (ii, type);
904 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = width;
905 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = height;
906 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
907 find_keyword_in_vector (instantiator, Q_file);
911 case IMAGE_MONO_PIXMAP:
913 IMAGE_INSTANCE_X_PIXMAP (ii) =
914 pixmap_from_xbm_inline (device, width, height, (Extbyte *) bits);
918 case IMAGE_COLOR_PIXMAP:
920 Dimension d = DEVICE_X_DEPTH (XDEVICE(device));
921 unsigned long fg = BlackPixelOfScreen (scr);
922 unsigned long bg = WhitePixelOfScreen (scr);
924 if (!NILP (foreground) && !COLOR_INSTANCEP (foreground))
926 Fmake_color_instance (foreground, device,
927 encode_error_behavior_flag (ERROR_ME));
929 if (COLOR_INSTANCEP (foreground))
930 fg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground)).pixel;
932 if (!NILP (background) && !COLOR_INSTANCEP (background))
934 Fmake_color_instance (background, device,
935 encode_error_behavior_flag (ERROR_ME));
937 if (COLOR_INSTANCEP (background))
938 bg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background)).pixel;
940 /* We used to duplicate the pixels using XAllocColor(), to protect
941 against their getting freed. Just as easy to just store the
942 color instances here and GC-protect them, so this doesn't
944 IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
945 IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
946 IMAGE_INSTANCE_X_PIXMAP (ii) =
947 XCreatePixmapFromBitmapData (dpy, draw,
948 (char *) bits, width, height,
950 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = d;
956 XColor fg_color, bg_color;
959 check_pointer_sizes (scr, width, height, instantiator);
962 XCreatePixmapFromBitmapData (dpy, draw,
963 (char *) bits, width, height,
966 if (NILP (foreground))
967 foreground = pointer_fg;
968 if (NILP (background))
969 background = pointer_bg;
970 generate_cursor_fg_bg (device, &foreground, &background,
971 &fg_color, &bg_color);
973 IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
974 IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
975 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) =
976 find_keyword_in_vector (instantiator, Q_hotspot_x);
977 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) =
978 find_keyword_in_vector (instantiator, Q_hotspot_y);
979 IMAGE_INSTANCE_X_CURSOR (ii) =
981 (dpy, source, mask, &fg_color, &bg_color,
982 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ?
983 XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) : 0,
984 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) ?
985 XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) : 0);
995 xbm_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator,
996 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
997 int dest_mask, int width, int height,
998 /* Note that data is in ext-format! */
1001 Lisp_Object mask_data = find_keyword_in_vector (instantiator, Q_mask_data);
1002 Lisp_Object mask_file = find_keyword_in_vector (instantiator, Q_mask_file);
1003 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1005 CONST char *gcc_may_you_rot_in_hell;
1007 if (!NILP (mask_data))
1009 GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (mask_data))),
1010 gcc_may_you_rot_in_hell);
1012 pixmap_from_xbm_inline (IMAGE_INSTANCE_DEVICE (ii),
1013 XINT (XCAR (mask_data)),
1014 XINT (XCAR (XCDR (mask_data))),
1015 (CONST unsigned char *)
1016 gcc_may_you_rot_in_hell);
1019 init_image_instance_from_xbm_inline (ii, width, height, bits,
1020 instantiator, pointer_fg, pointer_bg,
1021 dest_mask, mask, mask_file);
1024 /* Instantiate method for XBM's. */
1027 x_xbm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1028 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1029 int dest_mask, Lisp_Object domain)
1031 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1032 CONST char *gcc_go_home;
1034 assert (!NILP (data));
1036 GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (data))),
1039 xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1040 pointer_bg, dest_mask, XINT (XCAR (data)),
1041 XINT (XCAR (XCDR (data))), gcc_go_home);
1047 /**********************************************************************
1049 **********************************************************************/
1050 /* xpm 3.2g and better has XpmCreatePixmapFromBuffer()...
1051 There was no version number in xpm.h before 3.3, but this should do.
1053 #if (XpmVersion >= 3) || defined(XpmExactColors)
1054 # define XPM_DOES_BUFFERS
1057 #ifndef XPM_DOES_BUFFERS
1058 Your version of XPM is too old. You cannot compile with it.
1059 Upgrade to version 3.2g or better or compile with --with-xpm=no.
1060 #endif /* !XPM_DOES_BUFFERS */
1062 static XpmColorSymbol *
1063 extract_xpm_color_names (XpmAttributes *xpmattrs, Lisp_Object device,
1065 Lisp_Object color_symbol_alist)
1067 /* This function can GC */
1068 Display *dpy = DEVICE_X_DISPLAY (XDEVICE(device));
1069 Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1072 Lisp_Object results = Qnil;
1074 XpmColorSymbol *symbols;
1075 struct gcpro gcpro1, gcpro2;
1077 GCPRO2 (results, device);
1079 /* We built up results to be (("name" . #<color>) ...) so that if an
1080 error happens we don't lose any malloc()ed data, or more importantly,
1081 leave any pixels allocated in the server. */
1083 LIST_LOOP (rest, color_symbol_alist)
1085 Lisp_Object cons = XCAR (rest);
1086 Lisp_Object name = XCAR (cons);
1087 Lisp_Object value = XCDR (cons);
1090 if (STRINGP (value))
1092 Fmake_color_instance
1093 (value, device, encode_error_behavior_flag (ERROR_ME_NOT));
1096 assert (COLOR_SPECIFIERP (value));
1097 value = Fspecifier_instance (value, domain, Qnil, Qnil);
1101 results = noseeum_cons (noseeum_cons (name, value), results);
1104 UNGCPRO; /* no more evaluation */
1106 if (i == 0) return 0;
1108 symbols = xnew_array (XpmColorSymbol, i);
1109 xpmattrs->valuemask |= XpmColorSymbols;
1110 xpmattrs->colorsymbols = symbols;
1111 xpmattrs->numsymbols = i;
1115 Lisp_Object cons = XCAR (results);
1116 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (XCDR (cons)));
1117 /* Duplicate the pixel value so that we still have a lock on it if
1118 the pixel we were passed is later freed. */
1119 if (! XAllocColor (dpy, cmap, &color))
1120 abort (); /* it must be allocable since we're just duplicating it */
1122 symbols [i].name = (char *) XSTRING_DATA (XCAR (cons));
1123 symbols [i].pixel = color.pixel;
1124 symbols [i].value = 0;
1125 free_cons (XCONS (cons));
1127 results = XCDR (results);
1128 free_cons (XCONS (cons));
1134 xpm_free (XpmAttributes *xpmattrs)
1136 /* Could conceivably lose if XpmXXX returned an error without first
1137 initializing this structure, if we didn't know that initializing it
1138 to all zeros was ok (and also that it's ok to call XpmFreeAttributes()
1139 multiple times, since it zeros slots as it frees them...) */
1140 XpmFreeAttributes (xpmattrs);
1144 x_xpm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1145 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1146 int dest_mask, Lisp_Object domain)
1148 /* This function can GC */
1149 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1150 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1151 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1159 XpmAttributes xpmattrs;
1161 XpmColorSymbol *color_symbols;
1162 Lisp_Object color_symbol_alist = find_keyword_in_vector (instantiator,
1164 enum image_instance_type type;
1168 if (!DEVICE_X_P (XDEVICE (device)))
1169 signal_simple_error ("Not an X device", device);
1171 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1172 xs = DefaultScreenOfDisplay (dpy);
1174 if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
1175 type = IMAGE_COLOR_PIXMAP;
1176 else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
1177 type = IMAGE_MONO_PIXMAP;
1178 else if (dest_mask & IMAGE_POINTER_MASK)
1179 type = IMAGE_POINTER;
1181 incompatible_image_types (instantiator, dest_mask,
1182 IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
1183 | IMAGE_POINTER_MASK);
1184 force_mono = (type != IMAGE_COLOR_PIXMAP);
1187 /* Although I haven't found it documented yet, it appears that pointers are
1188 always colored via the default window colormap... Sigh. */
1189 if (type == IMAGE_POINTER)
1191 cmap = DefaultColormap(dpy, DefaultScreen(dpy));
1192 depth = DefaultDepthOfScreen (xs);
1193 visual = DefaultVisualOfScreen (xs);
1197 cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1198 depth = DEVICE_X_DEPTH (XDEVICE(device));
1199 visual = DEVICE_X_VISUAL (XDEVICE(device));
1202 cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1203 depth = DEVICE_X_DEPTH (XDEVICE(device));
1204 visual = DEVICE_X_VISUAL (XDEVICE(device));
1207 x_initialize_pixmap_image_instance (ii, type);
1209 assert (!NILP (data));
1213 xzero (xpmattrs); /* want XpmInitAttributes() */
1214 xpmattrs.valuemask = XpmReturnPixels;
1217 /* Without this, we get a 1-bit version of the color image, which
1218 isn't quite right. With this, we get the mono image, which might
1219 be very different looking. */
1220 xpmattrs.valuemask |= XpmColorKey;
1221 xpmattrs.color_key = XPM_MONO;
1223 xpmattrs.valuemask |= XpmDepth;
1227 xpmattrs.closeness = 65535;
1228 xpmattrs.valuemask |= XpmCloseness;
1229 xpmattrs.depth = depth;
1230 xpmattrs.valuemask |= XpmDepth;
1231 xpmattrs.visual = visual;
1232 xpmattrs.valuemask |= XpmVisual;
1233 xpmattrs.colormap = cmap;
1234 xpmattrs.valuemask |= XpmColormap;
1237 color_symbols = extract_xpm_color_names (&xpmattrs, device, domain,
1238 color_symbol_alist);
1240 result = XpmCreatePixmapFromBuffer (dpy,
1241 XtWindow(DEVICE_XT_APP_SHELL (XDEVICE(device))),
1242 (char *) XSTRING_DATA (data),
1243 &pixmap, &mask, &xpmattrs);
1247 xfree (color_symbols);
1248 xpmattrs.colorsymbols = 0; /* in case XpmFreeAttr is too smart... */
1249 xpmattrs.numsymbols = 0;
1256 case XpmFileInvalid:
1258 xpm_free (&xpmattrs);
1259 signal_image_error ("invalid XPM data", data);
1261 case XpmColorFailed:
1264 xpm_free (&xpmattrs);
1267 /* second time; blow out. */
1268 signal_double_file_error ("Reading pixmap data",
1269 "color allocation failed",
1274 if (! (dest_mask & IMAGE_MONO_PIXMAP_MASK))
1276 /* second time; blow out. */
1277 signal_double_file_error ("Reading pixmap data",
1278 "color allocation failed",
1282 IMAGE_INSTANCE_TYPE (ii) = IMAGE_MONO_PIXMAP;
1288 xpm_free (&xpmattrs);
1289 signal_double_file_error ("Parsing pixmap data",
1290 "out of memory", data);
1294 xpm_free (&xpmattrs);
1295 signal_double_file_error_2 ("Parsing pixmap data",
1296 "unknown error code",
1297 make_int (result), data);
1302 h = xpmattrs.height;
1305 int npixels = xpmattrs.npixels;
1310 pixels = xnew_array (Pixel, npixels);
1311 memcpy (pixels, xpmattrs.pixels, npixels * sizeof (Pixel));
1316 IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
1317 IMAGE_INSTANCE_X_MASK (ii) = mask;
1318 IMAGE_INSTANCE_X_COLORMAP (ii) = cmap;
1319 IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
1320 IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
1321 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = w;
1322 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = h;
1323 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
1324 find_keyword_in_vector (instantiator, Q_file);
1329 case IMAGE_MONO_PIXMAP:
1332 case IMAGE_COLOR_PIXMAP:
1334 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = depth;
1340 int npixels = xpmattrs.npixels;
1341 Pixel *pixels = xpmattrs.pixels;
1344 int xhot = 0, yhot = 0;
1346 if (xpmattrs.valuemask & XpmHotspot)
1348 xhot = xpmattrs.x_hotspot;
1349 XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii), xpmattrs.x_hotspot);
1351 if (xpmattrs.valuemask & XpmHotspot)
1353 yhot = xpmattrs.y_hotspot;
1354 XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii), xpmattrs.y_hotspot);
1356 check_pointer_sizes (xs, w, h, instantiator);
1358 /* If the loaded pixmap has colors allocated (meaning it came from an
1359 XPM file), then use those as the default colors for the cursor we
1360 create. Otherwise, default to pointer_fg and pointer_bg.
1364 /* With an XBM file, it's obvious which bit is foreground
1365 and which is background, or rather, it's implicit: in
1366 an XBM file, a 1 bit is foreground, and a 0 bit is
1369 XCreatePixmapCursor() assumes this property of the
1370 pixmap it is called with as well; the `foreground'
1371 color argument is used for the 1 bits.
1373 With an XPM file, it's tricker, since the elements of
1374 the pixmap don't represent FG and BG, but are actual
1375 pixel values. So we need to figure out which of those
1376 pixels is the foreground color and which is the
1377 background. We do it by comparing RGB and assuming
1378 that the darker color is the foreground. This works
1379 with the result of xbmtopbm|ppmtoxpm, at least.
1381 It might be nice if there was some way to tag the
1382 colors in the XPM file with whether they are the
1383 foreground - perhaps with logical color names somehow?
1385 Once we have decided which color is the foreground, we
1386 need to ensure that that color corresponds to a `1' bit
1387 in the Pixmap. The XPM library wrote into the (1-bit)
1388 pixmap with XPutPixel, which will ignore all but the
1389 least significant bit.
1391 This means that a 1 bit in the image corresponds to
1392 `fg' only if `fg.pixel' is odd.
1394 (This also means that the image will be all the same
1395 color if both `fg' and `bg' are odd or even, but we can
1396 safely assume that that won't happen if the XPM file is
1399 The desired result is that the image use `1' to
1400 represent the foreground color, and `0' to represent
1401 the background color. So, we may need to invert the
1402 image to accomplish this; we invert if fg is
1403 odd. (Remember that WhitePixel and BlackPixel are not
1404 necessarily 1 and 0 respectively, though I think it
1405 might be safe to assume that one of them is always 1
1406 and the other is always 0. We also pretty much need to
1407 assume that one is even and the other is odd.)
1410 fg.pixel = pixels[0]; /* pick a pixel at random. */
1411 bg.pixel = fg.pixel;
1412 for (i = 1; i < npixels; i++) /* Look for an "other" pixel value.*/
1414 bg.pixel = pixels[i];
1415 if (fg.pixel != bg.pixel)
1419 /* If (fg.pixel == bg.pixel) then probably something has
1420 gone wrong, but I don't think signalling an error would
1423 XQueryColor (dpy, cmap, &fg);
1424 XQueryColor (dpy, cmap, &bg);
1426 /* If the foreground is lighter than the background, swap them.
1427 (This occurs semi-randomly, depending on the ordering of the
1428 color list in the XPM file.)
1431 unsigned short fg_total = ((fg.red / 3) + (fg.green / 3)
1433 unsigned short bg_total = ((bg.red / 3) + (bg.green / 3)
1435 if (fg_total > bg_total)
1444 /* If the fg pixel corresponds to a `0' in the bitmap, invert it.
1445 (This occurs (only?) on servers with Black=0, White=1.)
1447 if ((fg.pixel & 1) == 0)
1451 gcv.function = GXxor;
1453 gc = XCreateGC (dpy, pixmap, (GCFunction | GCForeground),
1455 XFillRectangle (dpy, pixmap, gc, 0, 0, w, h);
1461 generate_cursor_fg_bg (device, &pointer_fg, &pointer_bg,
1463 IMAGE_INSTANCE_PIXMAP_FG (ii) = pointer_fg;
1464 IMAGE_INSTANCE_PIXMAP_BG (ii) = pointer_bg;
1467 IMAGE_INSTANCE_X_CURSOR (ii) =
1469 (dpy, pixmap, mask, &fg, &bg, xhot, yhot);
1478 xpm_free (&xpmattrs); /* after we've read pixels and hotspot */
1481 #endif /* HAVE_XPM */
1486 /**********************************************************************
1488 **********************************************************************/
1490 /* This is about to get redefined! */
1493 /* We have to define SYSV32 so that compface.h includes string.h
1494 instead of strings.h. */
1499 #include <compface.h>
1503 /* JMP_BUF cannot be used here because if it doesn't get defined
1504 to jmp_buf we end up with a conflicting type error with the
1505 definition in compface.h */
1506 extern jmp_buf comp_env;
1510 x_xface_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1511 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1512 int dest_mask, Lisp_Object domain)
1514 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1516 char *p, *bits, *bp;
1517 CONST char * volatile emsg = 0;
1518 CONST char * volatile dstring;
1520 assert (!NILP (data));
1522 GET_C_STRING_BINARY_DATA_ALLOCA (data, dstring);
1524 if ((p = strchr (dstring, ':')))
1529 /* Must use setjmp not SETJMP because we used jmp_buf above not JMP_BUF */
1530 if (!(stattis = setjmp (comp_env)))
1532 UnCompAll ((char *) dstring);
1539 emsg = "uncompface: internal error";
1542 emsg = "uncompface: insufficient or invalid data";
1545 emsg = "uncompface: excess data ignored";
1550 signal_simple_error_2 (emsg, data, Qimage);
1552 bp = bits = (char *) alloca (PIXELS / 8);
1554 /* the compface library exports char F[], which uses a single byte per
1555 pixel to represent a 48x48 bitmap. Yuck. */
1556 for (i = 0, p = F; i < (PIXELS / 8); ++i)
1559 /* reverse the bit order of each byte... */
1560 for (b = n = 0; b < 8; ++b)
1567 xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1568 pointer_bg, dest_mask, 48, 48, bits);
1571 #endif /* HAVE_XFACE */
1574 /**********************************************************************
1576 **********************************************************************/
1579 autodetect_validate (Lisp_Object instantiator)
1581 data_must_be_present (instantiator);
1585 autodetect_normalize (Lisp_Object instantiator,
1586 Lisp_Object console_type)
1588 Lisp_Object file = find_keyword_in_vector (instantiator, Q_data);
1589 Lisp_Object filename = Qnil;
1590 Lisp_Object data = Qnil;
1591 struct gcpro gcpro1, gcpro2, gcpro3;
1592 Lisp_Object alist = Qnil;
1594 GCPRO3 (filename, data, alist);
1596 if (NILP (file)) /* no conversion necessary */
1597 RETURN_UNGCPRO (instantiator);
1599 alist = tagged_vector_to_alist (instantiator);
1601 filename = locate_pixmap_file (file);
1602 if (!NILP (filename))
1605 /* #### Apparently some versions of XpmReadFileToData, which is
1606 called by pixmap_to_lisp_data, don't return an error value
1607 if the given file is not a valid XPM file. Instead, they
1608 just seg fault. It is definitely caused by passing a
1609 bitmap. To try and avoid this we check for bitmaps first. */
1611 data = bitmap_to_lisp_data (filename, &xhot, &yhot, 1);
1615 alist = remassq_no_quit (Q_data, alist);
1616 alist = Fcons (Fcons (Q_file, filename),
1617 Fcons (Fcons (Q_data, data), alist));
1619 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
1622 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
1625 alist = xbm_mask_file_munging (alist, filename, Qnil, console_type);
1628 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
1630 RETURN_UNGCPRO (result);
1635 data = pixmap_to_lisp_data (filename, 1);
1639 alist = remassq_no_quit (Q_data, alist);
1640 alist = Fcons (Fcons (Q_file, filename),
1641 Fcons (Fcons (Q_data, data), alist));
1642 alist = Fcons (Fcons (Q_color_symbols,
1643 evaluate_xpm_color_symbols ()),
1646 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
1648 RETURN_UNGCPRO (result);
1654 /* If we couldn't convert it, just put it back as it is.
1655 We might try to further frob it later as a cursor-font
1656 specification. (We can't do that now because we don't know
1657 what dest-types it's going to be instantiated into.) */
1659 Lisp_Object result = alist_to_tagged_vector (Qautodetect, alist);
1661 RETURN_UNGCPRO (result);
1666 autodetect_possible_dest_types (void)
1669 IMAGE_MONO_PIXMAP_MASK |
1670 IMAGE_COLOR_PIXMAP_MASK |
1671 IMAGE_POINTER_MASK |
1676 autodetect_instantiate (Lisp_Object image_instance,
1677 Lisp_Object instantiator,
1678 Lisp_Object pointer_fg,
1679 Lisp_Object pointer_bg,
1680 int dest_mask, Lisp_Object domain)
1682 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1683 struct gcpro gcpro1, gcpro2, gcpro3;
1684 Lisp_Object alist = Qnil;
1685 Lisp_Object result = Qnil;
1686 int is_cursor_font = 0;
1688 GCPRO3 (data, alist, result);
1690 alist = tagged_vector_to_alist (instantiator);
1691 if (dest_mask & IMAGE_POINTER_MASK)
1693 CONST char *name_ext;
1694 GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext);
1695 if (XmuCursorNameToIndex (name_ext) != -1)
1697 result = alist_to_tagged_vector (Qcursor_font, alist);
1702 if (!is_cursor_font)
1703 result = alist_to_tagged_vector (Qstring, alist);
1707 cursor_font_instantiate (image_instance, result, pointer_fg,
1708 pointer_bg, dest_mask, domain);
1710 string_instantiate (image_instance, result, pointer_fg,
1711 pointer_bg, dest_mask, domain);
1717 /**********************************************************************
1719 **********************************************************************/
1722 font_validate (Lisp_Object instantiator)
1724 data_must_be_present (instantiator);
1727 /* XmuCvtStringToCursor is bogus in the following ways:
1729 - When it can't convert the given string to a real cursor, it will
1730 sometimes return a "success" value, after triggering a BadPixmap
1731 error. It then gives you a cursor that will itself generate BadCursor
1732 errors. So we install this error handler to catch/notice the X error
1733 and take that as meaning "couldn't convert."
1735 - When you tell it to find a cursor file that doesn't exist, it prints
1736 an error message on stderr. You can't make it not do that.
1738 - Also, using Xmu means we can't properly hack Lisp_Image_Instance
1739 objects, or XPM files, or $XBMLANGPATH.
1742 /* Duplicate the behavior of XmuCvtStringToCursor() to bypass its bogusness. */
1744 static int XLoadFont_got_error;
1747 XLoadFont_error_handler (Display *dpy, XErrorEvent *xerror)
1749 XLoadFont_got_error = 1;
1754 safe_XLoadFont (Display *dpy, char *name)
1757 int (*old_handler) (Display *, XErrorEvent *);
1758 XLoadFont_got_error = 0;
1760 old_handler = XSetErrorHandler (XLoadFont_error_handler);
1761 font = XLoadFont (dpy, name);
1763 XSetErrorHandler (old_handler);
1764 if (XLoadFont_got_error) return 0;
1769 font_possible_dest_types (void)
1771 return IMAGE_POINTER_MASK;
1775 font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1776 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1777 int dest_mask, Lisp_Object domain)
1779 /* This function can GC */
1780 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1781 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1782 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1786 char source_name[MAXPATHLEN], mask_name[MAXPATHLEN], dummy;
1787 int source_char, mask_char;
1789 Lisp_Object foreground, background;
1791 if (!DEVICE_X_P (XDEVICE (device)))
1792 signal_simple_error ("Not an X device", device);
1794 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1796 if (!STRINGP (data) ||
1797 strncmp ("FONT ", (char *) XSTRING_DATA (data), 5))
1798 signal_simple_error ("Invalid font-glyph instantiator",
1801 if (!(dest_mask & IMAGE_POINTER_MASK))
1802 incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
1804 foreground = find_keyword_in_vector (instantiator, Q_foreground);
1805 if (NILP (foreground))
1806 foreground = pointer_fg;
1807 background = find_keyword_in_vector (instantiator, Q_background);
1808 if (NILP (background))
1809 background = pointer_bg;
1811 generate_cursor_fg_bg (device, &foreground, &background, &fg, &bg);
1813 count = sscanf ((char *) XSTRING_DATA (data),
1814 "FONT %s %d %s %d %c",
1815 source_name, &source_char,
1816 mask_name, &mask_char, &dummy);
1817 /* Allow "%s %d %d" as well... */
1818 if (count == 3 && (1 == sscanf (mask_name, "%d %c", &mask_char, &dummy)))
1819 count = 4, mask_name[0] = 0;
1821 if (count != 2 && count != 4)
1822 signal_simple_error ("invalid cursor specification", data);
1823 source = safe_XLoadFont (dpy, source_name);
1825 signal_simple_error_2 ("couldn't load font",
1826 build_string (source_name),
1830 else if (!mask_name[0])
1834 mask = safe_XLoadFont (dpy, mask_name);
1837 Fsignal (Qerror, list3 (build_string ("couldn't load font"),
1838 build_string (mask_name), data));
1843 /* #### call XQueryTextExtents() and check_pointer_sizes() here. */
1845 x_initialize_pixmap_image_instance (ii, IMAGE_POINTER);
1846 IMAGE_INSTANCE_X_CURSOR (ii) =
1847 XCreateGlyphCursor (dpy, source, mask, source_char, mask_char,
1849 XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
1850 XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
1851 XUnloadFont (dpy, source);
1852 if (mask && mask != source) XUnloadFont (dpy, mask);
1856 /**********************************************************************
1858 **********************************************************************/
1861 cursor_font_validate (Lisp_Object instantiator)
1863 data_must_be_present (instantiator);
1867 cursor_font_possible_dest_types (void)
1869 return IMAGE_POINTER_MASK;
1873 cursor_font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1874 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1875 int dest_mask, Lisp_Object domain)
1877 /* This function can GC */
1878 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1879 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1880 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1883 CONST char *name_ext;
1884 Lisp_Object foreground, background;
1886 if (!DEVICE_X_P (XDEVICE (device)))
1887 signal_simple_error ("Not an X device", device);
1889 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1891 if (!(dest_mask & IMAGE_POINTER_MASK))
1892 incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
1894 GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext);
1895 if ((i = XmuCursorNameToIndex (name_ext)) == -1)
1896 signal_simple_error ("Unrecognized cursor-font name", data);
1898 x_initialize_pixmap_image_instance (ii, IMAGE_POINTER);
1899 IMAGE_INSTANCE_X_CURSOR (ii) = XCreateFontCursor (dpy, i);
1900 foreground = find_keyword_in_vector (instantiator, Q_foreground);
1901 if (NILP (foreground))
1902 foreground = pointer_fg;
1903 background = find_keyword_in_vector (instantiator, Q_background);
1904 if (NILP (background))
1905 background = pointer_bg;
1906 maybe_recolor_cursor (image_instance, foreground, background);
1910 x_colorize_image_instance (Lisp_Object image_instance,
1911 Lisp_Object foreground, Lisp_Object background)
1913 struct Lisp_Image_Instance *p;
1915 p = XIMAGE_INSTANCE (image_instance);
1917 switch (IMAGE_INSTANCE_TYPE (p))
1919 case IMAGE_MONO_PIXMAP:
1920 IMAGE_INSTANCE_TYPE (p) = IMAGE_COLOR_PIXMAP;
1921 /* Make sure there aren't two pointers to the same mask, causing
1922 it to get freed twice. */
1923 IMAGE_INSTANCE_X_MASK (p) = 0;
1931 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
1932 Drawable draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (IMAGE_INSTANCE_DEVICE (p))));
1933 Dimension d = DEVICE_X_DEPTH (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
1934 Pixmap new = XCreatePixmap (dpy, draw,
1935 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
1936 IMAGE_INSTANCE_PIXMAP_HEIGHT (p), d);
1940 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground));
1941 gcv.foreground = color.pixel;
1942 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background));
1943 gcv.background = color.pixel;
1944 gc = XCreateGC (dpy, new, GCBackground|GCForeground, &gcv);
1945 XCopyPlane (dpy, IMAGE_INSTANCE_X_PIXMAP (p), new, gc, 0, 0,
1946 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
1947 IMAGE_INSTANCE_PIXMAP_HEIGHT (p),
1950 IMAGE_INSTANCE_X_PIXMAP (p) = new;
1951 IMAGE_INSTANCE_PIXMAP_DEPTH (p) = d;
1952 IMAGE_INSTANCE_PIXMAP_FG (p) = foreground;
1953 IMAGE_INSTANCE_PIXMAP_BG (p) = background;
1959 /************************************************************************/
1960 /* subwindow and widget support */
1961 /************************************************************************/
1963 /* unmap the image if it is a widget. This is used by redisplay via
1964 redisplay_unmap_subwindows */
1966 x_unmap_subwindow (struct Lisp_Image_Instance *p)
1968 XUnmapWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (p)),
1969 IMAGE_INSTANCE_X_SUBWINDOW_ID (p));
1972 /* map the subwindow. This is used by redisplay via
1973 redisplay_output_subwindow */
1975 x_map_subwindow (struct Lisp_Image_Instance *p, int x, int y)
1977 XMapWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (p)),
1978 IMAGE_INSTANCE_X_SUBWINDOW_ID (p));
1979 XMoveWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (p)),
1980 IMAGE_INSTANCE_X_SUBWINDOW_ID (p), x, y);
1983 /* instantiate and x type subwindow */
1985 x_subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1986 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1987 int dest_mask, Lisp_Object domain)
1989 /* This function can GC */
1990 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1991 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1992 Lisp_Object frame = FW_FRAME (domain);
1993 struct frame* f = XFRAME (frame);
1997 XSetWindowAttributes xswa;
1999 unsigned int w = IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii),
2000 h = IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii);
2002 if (!DEVICE_X_P (XDEVICE (device)))
2003 signal_simple_error ("Not an X device", device);
2005 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2006 xs = DefaultScreenOfDisplay (dpy);
2008 if (dest_mask & IMAGE_SUBWINDOW_MASK)
2009 IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW;
2011 incompatible_image_types (instantiator, dest_mask,
2012 IMAGE_SUBWINDOW_MASK);
2014 pw = XtWindow (FRAME_X_TEXT_WIDGET (f));
2016 ii->data = xnew_and_zero (struct x_subwindow_data);
2018 IMAGE_INSTANCE_X_SUBWINDOW_PARENT (ii) = pw;
2019 IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (ii) = xs;
2021 xswa.backing_store = Always;
2022 valueMask |= CWBackingStore;
2023 xswa.colormap = DefaultColormapOfScreen (xs);
2024 valueMask |= CWColormap;
2026 win = XCreateWindow (dpy, pw, 0, 0, w, h, 0, CopyFromParent,
2027 InputOutput, CopyFromParent, valueMask,
2030 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)win;
2034 /* #### Should this function exist? If there's any doubt I'm not implementing it --andyp */
2035 DEFUN ("change-subwindow-property", Fchange_subwindow_property, 3, 3, 0, /*
2036 For the given SUBWINDOW, set PROPERTY to DATA, which is a string.
2037 Subwindows are not currently implemented.
2039 (subwindow, property, data))
2042 struct Lisp_Subwindow *sw;
2045 CHECK_SUBWINDOW (subwindow);
2046 CHECK_STRING (property);
2047 CHECK_STRING (data);
2049 sw = XSUBWINDOW (subwindow);
2050 dpy = DisplayOfScreen (LISP_DEVICE_TO_X_SCREEN
2051 (FRAME_DEVICE (XFRAME (sw->frame))));
2053 property_atom = XInternAtom (dpy, (char *) XSTRING_DATA (property), False);
2054 XChangeProperty (dpy, sw->subwindow, property_atom, XA_STRING, 8,
2056 XSTRING_DATA (data),
2057 XSTRING_LENGTH (data));
2064 x_resize_subwindow (struct Lisp_Image_Instance* ii, int w, int h)
2066 XResizeWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (ii)),
2067 IMAGE_INSTANCE_X_SUBWINDOW_ID (ii),
2072 /************************************************************************/
2073 /* initialization */
2074 /************************************************************************/
2077 syms_of_glyphs_x (void)
2080 DEFSUBR (Fchange_subwindow_property);
2085 console_type_create_glyphs_x (void)
2089 CONSOLE_HAS_METHOD (x, print_image_instance);
2090 CONSOLE_HAS_METHOD (x, finalize_image_instance);
2091 CONSOLE_HAS_METHOD (x, image_instance_equal);
2092 CONSOLE_HAS_METHOD (x, image_instance_hash);
2093 CONSOLE_HAS_METHOD (x, colorize_image_instance);
2094 CONSOLE_HAS_METHOD (x, init_image_instance_from_eimage);
2095 CONSOLE_HAS_METHOD (x, locate_pixmap_file);
2096 CONSOLE_HAS_METHOD (x, unmap_subwindow);
2097 CONSOLE_HAS_METHOD (x, map_subwindow);
2098 CONSOLE_HAS_METHOD (x, resize_subwindow);
2102 image_instantiator_format_create_glyphs_x (void)
2105 INITIALIZE_DEVICE_IIFORMAT (x, xpm);
2106 IIFORMAT_HAS_DEVMETHOD (x, xpm, instantiate);
2108 INITIALIZE_DEVICE_IIFORMAT (x, xbm);
2109 IIFORMAT_HAS_DEVMETHOD (x, xbm, instantiate);
2111 INITIALIZE_DEVICE_IIFORMAT (x, subwindow);
2112 IIFORMAT_HAS_DEVMETHOD (x, subwindow, instantiate);
2114 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (cursor_font, "cursor-font");
2116 IIFORMAT_HAS_METHOD (cursor_font, validate);
2117 IIFORMAT_HAS_METHOD (cursor_font, possible_dest_types);
2118 IIFORMAT_HAS_METHOD (cursor_font, instantiate);
2120 IIFORMAT_VALID_KEYWORD (cursor_font, Q_data, check_valid_string);
2121 IIFORMAT_VALID_KEYWORD (cursor_font, Q_foreground, check_valid_string);
2122 IIFORMAT_VALID_KEYWORD (cursor_font, Q_background, check_valid_string);
2124 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (font, "font");
2126 IIFORMAT_HAS_METHOD (font, validate);
2127 IIFORMAT_HAS_METHOD (font, possible_dest_types);
2128 IIFORMAT_HAS_METHOD (font, instantiate);
2130 IIFORMAT_VALID_KEYWORD (font, Q_data, check_valid_string);
2131 IIFORMAT_VALID_KEYWORD (font, Q_foreground, check_valid_string);
2132 IIFORMAT_VALID_KEYWORD (font, Q_background, check_valid_string);
2135 INITIALIZE_DEVICE_IIFORMAT (x, xface);
2136 IIFORMAT_HAS_DEVMETHOD (x, xface, instantiate);
2139 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (autodetect,
2142 IIFORMAT_HAS_METHOD (autodetect, validate);
2143 IIFORMAT_HAS_METHOD (autodetect, normalize);
2144 IIFORMAT_HAS_METHOD (autodetect, possible_dest_types);
2145 IIFORMAT_HAS_METHOD (autodetect, instantiate);
2147 IIFORMAT_VALID_KEYWORD (autodetect, Q_data, check_valid_string);
2151 vars_of_glyphs_x (void)
2153 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path /*
2154 A list of the directories in which X bitmap files may be found.
2155 If nil, this is initialized from the "*bitmapFilePath" resource.
2156 This is used by the `make-image-instance' function (however, note that if
2157 the environment variable XBMLANGPATH is set, it is consulted first).
2159 Vx_bitmap_file_path = Qnil;
2163 complex_vars_of_glyphs_x (void)
2165 #define BUILD_GLYPH_INST(variable, name) \
2166 Fadd_spec_to_specifier \
2167 (GLYPH_IMAGE (XGLYPH (variable)), \
2168 vector3 (Qxbm, Q_data, \
2169 list3 (make_int (name##_width), \
2170 make_int (name##_height), \
2171 make_ext_string (name##_bits, \
2172 sizeof (name##_bits), \
2176 BUILD_GLYPH_INST (Vtruncation_glyph, truncator);
2177 BUILD_GLYPH_INST (Vcontinuation_glyph, continuer);
2178 BUILD_GLYPH_INST (Vxemacs_logo, xemacs);
2179 BUILD_GLYPH_INST (Vhscroll_glyph, hscroll);
2181 #undef BUILD_GLYPH_INST