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_IMAGE_INSTANTIATOR_FORMAT (xface);
94 DEFINE_IMAGE_INSTANTIATOR_FORMAT (cursor_font);
95 Lisp_Object Qcursor_font;
97 DEFINE_IMAGE_INSTANTIATOR_FORMAT (font);
99 DEFINE_IMAGE_INSTANTIATOR_FORMAT (autodetect);
101 static void cursor_font_instantiate (Lisp_Object image_instance,
102 Lisp_Object instantiator,
103 Lisp_Object pointer_fg,
104 Lisp_Object pointer_bg,
111 /************************************************************************/
112 /* image instance methods */
113 /************************************************************************/
115 /************************************************************************/
116 /* convert from a series of RGB triples to an XImage formated for the */
118 /************************************************************************/
120 convert_EImage_to_XImage (Lisp_Object device, int width, int height,
121 unsigned char *pic, unsigned long **pixtbl,
128 int depth, bitmap_pad, byte_cnt, i, j;
130 unsigned char *data, *ip, *dp;
131 quant_table *qtable = 0;
137 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
138 cmap = DEVICE_X_COLORMAP (XDEVICE(device));
139 vis = DEVICE_X_VISUAL (XDEVICE(device));
140 depth = DEVICE_X_DEPTH(XDEVICE(device));
142 if (vis->class == PseudoColor)
144 /* Quantize the image and get a histogram while we're at it.
145 Do this first to save memory */
146 qtable = build_EImage_quantable(pic, width, height, 256);
147 if (qtable == NULL) return NULL;
150 bitmap_pad = ((depth > 16) ? 32 :
153 byte_cnt = bitmap_pad >> 3;
155 outimg = XCreateImage (dpy, vis,
156 depth, ZPixmap, 0, 0, width, height,
158 if (!outimg) return NULL;
160 data = (unsigned char *) xmalloc (outimg->bytes_per_line * height);
163 XDestroyImage (outimg);
166 outimg->data = (char *) data;
168 if (vis->class == PseudoColor)
170 unsigned long pixarray[256];
172 /* use our quantize table to allocate the colors */
174 *pixtbl = xnew_array (unsigned long, pixcount);
177 /* ### should implement a sort by popularity to assure proper allocation */
179 for (i = 0; i < qtable->num_active_colors; i++)
184 color.red = qtable->rm[i] ? qtable->rm[i] << 8 : 0;
185 color.green = qtable->gm[i] ? qtable->gm[i] << 8 : 0;
186 color.blue = qtable->bm[i] ? qtable->bm[i] << 8 : 0;
187 color.flags = DoRed | DoGreen | DoBlue;
188 res = allocate_nearest_color (dpy, cmap, vis, &color);
189 if (res > 0 && res < 3)
191 DO_REALLOC(*pixtbl, pixcount, n+1, unsigned long);
192 (*pixtbl)[n] = color.pixel;
195 pixarray[i] = color.pixel;
199 for (i = 0; i < height; i++)
201 dp = data + (i * outimg->bytes_per_line);
202 for (j = 0; j < width; j++)
207 conv.val = pixarray[QUANT_GET_COLOR(qtable,rd,gr,bl)];
209 if (outimg->byte_order == MSBFirst)
210 for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q];
212 for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q];
214 if (outimg->byte_order == MSBFirst)
215 for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q];
217 for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q];
223 unsigned long rshift,gshift,bshift,rbits,gbits,bbits,junk;
224 junk = vis->red_mask;
226 while ((junk & 0x1) == 0)
237 junk = vis->green_mask;
239 while ((junk & 0x1) == 0)
250 junk = vis->blue_mask;
252 while ((junk & 0x1) == 0)
264 for (i = 0; i < height; i++)
266 dp = data + (i * outimg->bytes_per_line);
267 for (j = 0; j < width; j++)
270 rd = *ip++ << (rbits - 8);
272 rd = *ip++ >> (8 - rbits);
274 gr = *ip++ << (gbits - 8);
276 gr = *ip++ >> (8 - gbits);
278 bl = *ip++ << (bbits - 8);
280 bl = *ip++ >> (8 - bbits);
282 conv.val = (rd << rshift) | (gr << gshift) | (bl << bshift);
284 if (outimg->byte_order == MSBFirst)
285 for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q];
287 for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q];
289 if (outimg->byte_order == MSBFirst)
290 for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q];
292 for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q];
303 x_print_image_instance (struct Lisp_Image_Instance *p,
304 Lisp_Object printcharfun,
309 switch (IMAGE_INSTANCE_TYPE (p))
311 case IMAGE_MONO_PIXMAP:
312 case IMAGE_COLOR_PIXMAP:
314 sprintf (buf, " (0x%lx", (unsigned long) IMAGE_INSTANCE_X_PIXMAP (p));
315 write_c_string (buf, printcharfun);
316 if (IMAGE_INSTANCE_X_MASK (p))
318 sprintf (buf, "/0x%lx", (unsigned long) IMAGE_INSTANCE_X_MASK (p));
319 write_c_string (buf, printcharfun);
321 write_c_string (")", printcharfun);
329 x_finalize_image_instance (struct Lisp_Image_Instance *p)
334 if (DEVICE_LIVE_P (XDEVICE (p->device)))
336 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (p->device));
338 if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET
340 IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
342 if (IMAGE_INSTANCE_SUBWINDOW_ID (p))
343 XDestroyWindow (dpy, IMAGE_INSTANCE_X_SUBWINDOW_ID (p));
344 IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0;
348 if (IMAGE_INSTANCE_X_PIXMAP (p))
349 XFreePixmap (dpy, IMAGE_INSTANCE_X_PIXMAP (p));
350 if (IMAGE_INSTANCE_X_MASK (p) &&
351 IMAGE_INSTANCE_X_MASK (p) != IMAGE_INSTANCE_X_PIXMAP (p))
352 XFreePixmap (dpy, IMAGE_INSTANCE_X_MASK (p));
353 IMAGE_INSTANCE_X_PIXMAP (p) = 0;
354 IMAGE_INSTANCE_X_MASK (p) = 0;
356 if (IMAGE_INSTANCE_X_CURSOR (p))
358 XFreeCursor (dpy, IMAGE_INSTANCE_X_CURSOR (p));
359 IMAGE_INSTANCE_X_CURSOR (p) = 0;
362 if (IMAGE_INSTANCE_X_NPIXELS (p) != 0)
365 IMAGE_INSTANCE_X_COLORMAP (p),
366 IMAGE_INSTANCE_X_PIXELS (p),
367 IMAGE_INSTANCE_X_NPIXELS (p), 0);
368 IMAGE_INSTANCE_X_NPIXELS (p) = 0;
372 if (IMAGE_INSTANCE_X_PIXELS (p))
374 xfree (IMAGE_INSTANCE_X_PIXELS (p));
375 IMAGE_INSTANCE_X_PIXELS (p) = 0;
383 x_image_instance_equal (struct Lisp_Image_Instance *p1,
384 struct Lisp_Image_Instance *p2, int depth)
386 switch (IMAGE_INSTANCE_TYPE (p1))
388 case IMAGE_MONO_PIXMAP:
389 case IMAGE_COLOR_PIXMAP:
391 if (IMAGE_INSTANCE_X_COLORMAP (p1) != IMAGE_INSTANCE_X_COLORMAP (p2) ||
392 IMAGE_INSTANCE_X_NPIXELS (p1) != IMAGE_INSTANCE_X_NPIXELS (p2))
403 x_image_instance_hash (struct Lisp_Image_Instance *p, int depth)
405 switch (IMAGE_INSTANCE_TYPE (p))
407 case IMAGE_MONO_PIXMAP:
408 case IMAGE_COLOR_PIXMAP:
410 return IMAGE_INSTANCE_X_NPIXELS (p);
416 /* Set all the slots in an image instance structure to reasonable
417 default values. This is used somewhere within an instantiate
418 method. It is assumed that the device slot within the image
419 instance is already set -- this is the case when instantiate
420 methods are called. */
423 x_initialize_pixmap_image_instance (struct Lisp_Image_Instance *ii,
424 enum image_instance_type type)
426 ii->data = xnew_and_zero (struct x_image_instance_data);
427 IMAGE_INSTANCE_TYPE (ii) = type;
428 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = Qnil;
429 IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (ii) = Qnil;
430 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) = Qnil;
431 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) = Qnil;
432 IMAGE_INSTANCE_PIXMAP_FG (ii) = Qnil;
433 IMAGE_INSTANCE_PIXMAP_BG (ii) = Qnil;
437 /************************************************************************/
438 /* pixmap file functions */
439 /************************************************************************/
441 /* Where bitmaps are; initialized from resource database */
442 Lisp_Object Vx_bitmap_file_path;
445 #define BITMAPDIR "/usr/include/X11/bitmaps"
448 #define USE_XBMLANGPATH
450 /* Given a pixmap filename, look through all of the "standard" places
451 where the file might be located. Return a full pathname if found;
452 otherwise, return Qnil. */
455 x_locate_pixmap_file (Lisp_Object name)
457 /* This function can GC if IN_REDISPLAY is false */
460 /* Check non-absolute pathnames with a directory component relative to
461 the search path; that's the way Xt does it. */
462 /* #### Unix-specific */
463 if (XSTRING_BYTE (name, 0) == '/' ||
464 (XSTRING_BYTE (name, 0) == '.' &&
465 (XSTRING_BYTE (name, 1) == '/' ||
466 (XSTRING_BYTE (name, 1) == '.' &&
467 (XSTRING_BYTE (name, 2) == '/')))))
469 if (!NILP (Ffile_readable_p (name)))
475 if (NILP (Vdefault_x_device))
476 /* This may occur during initialization. */
479 /* We only check the bitmapFilePath resource on the original X device. */
480 display = DEVICE_X_DISPLAY (XDEVICE (Vdefault_x_device));
482 #ifdef USE_XBMLANGPATH
484 char *path = egetenv ("XBMLANGPATH");
485 SubstitutionRec subs[1];
487 subs[0].substitution = (char *) XSTRING_DATA (name);
488 /* #### Motif uses a big hairy default if $XBMLANGPATH isn't set.
489 We don't. If you want it used, set it. */
491 (path = XtResolvePathname (display, "bitmaps", 0, 0, path,
492 subs, XtNumber (subs), 0)))
494 name = build_string (path);
501 if (NILP (Vx_bitmap_file_path))
505 if (XrmGetResource (XtDatabase (display),
506 "bitmapFilePath", "BitmapFilePath", &type, &value)
507 && !strcmp (type, "String"))
508 Vx_bitmap_file_path = decode_env_path (0, (char *) value.addr);
509 Vx_bitmap_file_path = nconc2 (Vx_bitmap_file_path,
510 (decode_path (BITMAPDIR)));
515 if (locate_file (Vx_bitmap_file_path, name, "", &found, R_OK) < 0)
517 Lisp_Object temp = list1 (Vdata_directory);
521 locate_file (temp, name, "", &found, R_OK);
530 locate_pixmap_file (Lisp_Object name)
532 return x_locate_pixmap_file (name);
537 write_lisp_string_to_temp_file (Lisp_Object string, char *filename_out)
539 Lisp_Object instream, outstream;
540 Lstream *istr, *ostr;
541 char tempbuf[1024]; /* some random amount */
544 static Extbyte_dynarr *conversion_out_dynarr;
545 Bytecount bstart, bend;
546 struct gcpro gcpro1, gcpro2;
548 Lisp_Object conv_out_stream;
553 /* This function can GC */
554 if (!conversion_out_dynarr)
555 conversion_out_dynarr = Dynarr_new (Extbyte);
557 Dynarr_reset (conversion_out_dynarr);
559 /* Create the temporary file ... */
560 sprintf (filename_out, "/tmp/emacs%d.XXXXXX", (int) getpid ());
561 mktemp (filename_out);
562 tmpfil = fopen (filename_out, "w");
567 int old_errno = errno;
569 unlink (filename_out);
572 report_file_error ("Creating temp file",
573 list1 (build_string (filename_out)));
576 CHECK_STRING (string);
577 get_string_range_byte (string, Qnil, Qnil, &bstart, &bend,
578 GB_HISTORICAL_STRING_BEHAVIOR);
579 instream = make_lisp_string_input_stream (string, bstart, bend);
580 istr = XLSTREAM (instream);
581 /* setup the out stream */
582 outstream = make_dynarr_output_stream((unsigned_char_dynarr *)conversion_out_dynarr);
583 ostr = XLSTREAM (outstream);
585 /* setup the conversion stream */
586 conv_out_stream = make_encoding_output_stream (ostr, Fget_coding_system(Qbinary));
587 costr = XLSTREAM (conv_out_stream);
588 GCPRO3 (instream, outstream, conv_out_stream);
590 GCPRO2 (instream, outstream);
593 /* Get the data while doing the conversion */
596 int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
599 /* It does seem the flushes are necessary... */
601 Lstream_write (costr, tempbuf, size_in_bytes);
602 Lstream_flush (costr);
604 Lstream_write (ostr, tempbuf, size_in_bytes);
606 Lstream_flush (ostr);
607 if (fwrite ((unsigned char *)Dynarr_atp(conversion_out_dynarr, 0),
608 Dynarr_length(conversion_out_dynarr), 1, tmpfil) != 1)
613 /* reset the dynarr */
614 Lstream_rewind(ostr);
617 if (fclose (tmpfil) != 0)
619 Lstream_close (istr);
621 Lstream_close (costr);
623 Lstream_close (ostr);
626 Lstream_delete (istr);
627 Lstream_delete (ostr);
629 Lstream_delete (costr);
633 report_file_error ("Writing temp file",
634 list1 (build_string (filename_out)));
639 /************************************************************************/
640 /* cursor functions */
641 /************************************************************************/
643 /* Check that this server supports cursors of size WIDTH * HEIGHT. If
644 not, signal an error. INSTANTIATOR is only used in the error
648 check_pointer_sizes (Screen *xs, unsigned int width, unsigned int height,
649 Lisp_Object instantiator)
651 unsigned int best_width, best_height;
652 if (! XQueryBestCursor (DisplayOfScreen (xs), RootWindowOfScreen (xs),
653 width, height, &best_width, &best_height))
654 /* this means that an X error of some sort occurred (we trap
655 these so they're not fatal). */
656 signal_simple_error ("XQueryBestCursor() failed?", instantiator);
658 if (width > best_width || height > best_height)
659 error_with_frob (instantiator,
660 "pointer too large (%dx%d): "
661 "server requires %dx%d or smaller",
662 width, height, best_width, best_height);
667 generate_cursor_fg_bg (Lisp_Object device, Lisp_Object *foreground,
668 Lisp_Object *background, XColor *xfg, XColor *xbg)
670 if (!NILP (*foreground) && !COLOR_INSTANCEP (*foreground))
672 Fmake_color_instance (*foreground, device,
673 encode_error_behavior_flag (ERROR_ME));
674 if (COLOR_INSTANCEP (*foreground))
675 *xfg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (*foreground));
679 xfg->red = xfg->green = xfg->blue = 0;
682 if (!NILP (*background) && !COLOR_INSTANCEP (*background))
684 Fmake_color_instance (*background, device,
685 encode_error_behavior_flag (ERROR_ME));
686 if (COLOR_INSTANCEP (*background))
687 *xbg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (*background));
691 xbg->red = xbg->green = xbg->blue = ~0;
696 maybe_recolor_cursor (Lisp_Object image_instance, Lisp_Object foreground,
697 Lisp_Object background)
699 Lisp_Object device = XIMAGE_INSTANCE_DEVICE (image_instance);
702 generate_cursor_fg_bg (device, &foreground, &background, &xfg, &xbg);
703 if (!NILP (foreground) || !NILP (background))
705 XRecolorCursor (DEVICE_X_DISPLAY (XDEVICE (device)),
706 XIMAGE_INSTANCE_X_CURSOR (image_instance),
708 XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
709 XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
714 /************************************************************************/
715 /* color pixmap functions */
716 /************************************************************************/
718 /* Initialize an image instance from an XImage.
720 DEST_MASK specifies the mask of allowed image types.
722 PIXELS and NPIXELS specify an array of pixels that are used in
723 the image. These need to be kept around for the duration of the
724 image. When the image instance is freed, XFreeColors() will
725 automatically be called on all the pixels specified here; thus,
726 you should have allocated the pixels yourself using XAllocColor()
727 or the like. The array passed in is used directly without
728 being copied, so it should be heap data created with xmalloc().
729 It will be freed using xfree() when the image instance is
732 If this fails, signal an error. INSTANTIATOR is only used
733 in the error message.
735 #### This should be able to handle conversion into `pointer'.
736 Use the same code as for `xpm'. */
739 init_image_instance_from_x_image (struct Lisp_Image_Instance *ii,
743 unsigned long *pixels,
745 Lisp_Object instantiator)
747 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
753 if (!DEVICE_X_P (XDEVICE (device)))
754 signal_simple_error ("Not an X device", device);
756 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
757 d = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
759 if (!(dest_mask & IMAGE_COLOR_PIXMAP_MASK))
760 incompatible_image_types (instantiator, dest_mask,
761 IMAGE_COLOR_PIXMAP_MASK);
763 pixmap = XCreatePixmap (dpy, d, ximage->width,
764 ximage->height, ximage->depth);
766 signal_simple_error ("Unable to create pixmap", instantiator);
768 gc = XCreateGC (dpy, pixmap, 0, NULL);
771 XFreePixmap (dpy, pixmap);
772 signal_simple_error ("Unable to create GC", instantiator);
775 XPutImage (dpy, pixmap, gc, ximage, 0, 0, 0, 0,
776 ximage->width, ximage->height);
780 x_initialize_pixmap_image_instance (ii, IMAGE_COLOR_PIXMAP);
782 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
783 find_keyword_in_vector (instantiator, Q_file);
785 IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
786 IMAGE_INSTANCE_X_MASK (ii) = 0;
787 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = ximage->width;
788 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = ximage->height;
789 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = ximage->depth;
790 IMAGE_INSTANCE_X_COLORMAP (ii) = cmap;
791 IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
792 IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
796 x_init_image_instance_from_eimage (struct Lisp_Image_Instance *ii,
797 int width, int height,
798 unsigned char *eimage,
800 Lisp_Object instantiator,
803 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
804 Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device));
805 unsigned long *pixtbl = NULL;
809 ximage = convert_EImage_to_XImage (device, width, height, eimage,
813 if (pixtbl) xfree (pixtbl);
814 signal_image_error("EImage to XImage conversion failed", instantiator);
817 /* Now create the pixmap and set up the image instance */
818 init_image_instance_from_x_image (ii, ximage, dest_mask,
819 cmap, pixtbl, npixels,
826 xfree (ximage->data);
829 XDestroyImage (ximage);
833 int read_bitmap_data_from_file (CONST char *filename, unsigned int *width,
834 unsigned int *height, unsigned char **datap,
835 int *x_hot, int *y_hot)
837 return XmuReadBitmapDataFromFile (filename, width, height,
838 datap, x_hot, y_hot);
841 /* Given inline data for a mono pixmap, create and return the
842 corresponding X object. */
845 pixmap_from_xbm_inline (Lisp_Object device, int width, int height,
846 /* Note that data is in ext-format! */
849 return XCreatePixmapFromBitmapData (DEVICE_X_DISPLAY (XDEVICE(device)),
850 XtWindow (DEVICE_XT_APP_SHELL (XDEVICE (device))),
851 (char *) bits, width, height,
855 /* Given inline data for a mono pixmap, initialize the given
856 image instance accordingly. */
859 init_image_instance_from_xbm_inline (struct Lisp_Image_Instance *ii,
860 int width, int height,
861 /* Note that data is in ext-format! */
863 Lisp_Object instantiator,
864 Lisp_Object pointer_fg,
865 Lisp_Object pointer_bg,
868 Lisp_Object mask_filename)
870 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
871 Lisp_Object foreground = find_keyword_in_vector (instantiator, Q_foreground);
872 Lisp_Object background = find_keyword_in_vector (instantiator, Q_background);
876 enum image_instance_type type;
878 if (!DEVICE_X_P (XDEVICE (device)))
879 signal_simple_error ("Not an X device", device);
881 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
882 draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
883 scr = DefaultScreenOfDisplay (dpy);
885 if ((dest_mask & IMAGE_MONO_PIXMAP_MASK) &&
886 (dest_mask & IMAGE_COLOR_PIXMAP_MASK))
888 if (!NILP (foreground) || !NILP (background))
889 type = IMAGE_COLOR_PIXMAP;
891 type = IMAGE_MONO_PIXMAP;
893 else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
894 type = IMAGE_MONO_PIXMAP;
895 else if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
896 type = IMAGE_COLOR_PIXMAP;
897 else if (dest_mask & IMAGE_POINTER_MASK)
898 type = IMAGE_POINTER;
900 incompatible_image_types (instantiator, dest_mask,
901 IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
902 | IMAGE_POINTER_MASK);
904 x_initialize_pixmap_image_instance (ii, type);
905 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = width;
906 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = height;
907 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
908 find_keyword_in_vector (instantiator, Q_file);
912 case IMAGE_MONO_PIXMAP:
914 IMAGE_INSTANCE_X_PIXMAP (ii) =
915 pixmap_from_xbm_inline (device, width, height, (Extbyte *) bits);
919 case IMAGE_COLOR_PIXMAP:
921 Dimension d = DEVICE_X_DEPTH (XDEVICE(device));
922 unsigned long fg = BlackPixelOfScreen (scr);
923 unsigned long bg = WhitePixelOfScreen (scr);
925 if (!NILP (foreground) && !COLOR_INSTANCEP (foreground))
927 Fmake_color_instance (foreground, device,
928 encode_error_behavior_flag (ERROR_ME));
930 if (COLOR_INSTANCEP (foreground))
931 fg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground)).pixel;
933 if (!NILP (background) && !COLOR_INSTANCEP (background))
935 Fmake_color_instance (background, device,
936 encode_error_behavior_flag (ERROR_ME));
938 if (COLOR_INSTANCEP (background))
939 bg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background)).pixel;
941 /* We used to duplicate the pixels using XAllocColor(), to protect
942 against their getting freed. Just as easy to just store the
943 color instances here and GC-protect them, so this doesn't
945 IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
946 IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
947 IMAGE_INSTANCE_X_PIXMAP (ii) =
948 XCreatePixmapFromBitmapData (dpy, draw,
949 (char *) bits, width, height,
951 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = d;
957 XColor fg_color, bg_color;
960 check_pointer_sizes (scr, width, height, instantiator);
963 XCreatePixmapFromBitmapData (dpy, draw,
964 (char *) bits, width, height,
967 if (NILP (foreground))
968 foreground = pointer_fg;
969 if (NILP (background))
970 background = pointer_bg;
971 generate_cursor_fg_bg (device, &foreground, &background,
972 &fg_color, &bg_color);
974 IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
975 IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
976 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) =
977 find_keyword_in_vector (instantiator, Q_hotspot_x);
978 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) =
979 find_keyword_in_vector (instantiator, Q_hotspot_y);
980 IMAGE_INSTANCE_X_CURSOR (ii) =
982 (dpy, source, mask, &fg_color, &bg_color,
983 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ?
984 XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) : 0,
985 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) ?
986 XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) : 0);
996 xbm_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator,
997 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
998 int dest_mask, int width, int height,
999 /* Note that data is in ext-format! */
1002 Lisp_Object mask_data = find_keyword_in_vector (instantiator, Q_mask_data);
1003 Lisp_Object mask_file = find_keyword_in_vector (instantiator, Q_mask_file);
1004 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1006 CONST char *gcc_may_you_rot_in_hell;
1008 if (!NILP (mask_data))
1010 GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (mask_data))),
1011 gcc_may_you_rot_in_hell);
1013 pixmap_from_xbm_inline (IMAGE_INSTANCE_DEVICE (ii),
1014 XINT (XCAR (mask_data)),
1015 XINT (XCAR (XCDR (mask_data))),
1016 (CONST unsigned char *)
1017 gcc_may_you_rot_in_hell);
1020 init_image_instance_from_xbm_inline (ii, width, height, bits,
1021 instantiator, pointer_fg, pointer_bg,
1022 dest_mask, mask, mask_file);
1025 /* Instantiate method for XBM's. */
1028 x_xbm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1029 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1030 int dest_mask, Lisp_Object domain)
1032 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1033 CONST char *gcc_go_home;
1035 assert (!NILP (data));
1037 GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (data))),
1040 xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1041 pointer_bg, dest_mask, XINT (XCAR (data)),
1042 XINT (XCAR (XCDR (data))), gcc_go_home);
1048 /**********************************************************************
1050 **********************************************************************/
1051 /* xpm 3.2g and better has XpmCreatePixmapFromBuffer()...
1052 There was no version number in xpm.h before 3.3, but this should do.
1054 #if (XpmVersion >= 3) || defined(XpmExactColors)
1055 # define XPM_DOES_BUFFERS
1058 #ifndef XPM_DOES_BUFFERS
1059 Your version of XPM is too old. You cannot compile with it.
1060 Upgrade to version 3.2g or better or compile with --with-xpm=no.
1061 #endif /* !XPM_DOES_BUFFERS */
1063 static XpmColorSymbol *
1064 extract_xpm_color_names (XpmAttributes *xpmattrs, Lisp_Object device,
1066 Lisp_Object color_symbol_alist)
1068 /* This function can GC */
1069 Display *dpy = DEVICE_X_DISPLAY (XDEVICE(device));
1070 Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1073 Lisp_Object results = Qnil;
1075 XpmColorSymbol *symbols;
1076 struct gcpro gcpro1, gcpro2;
1078 GCPRO2 (results, device);
1080 /* We built up results to be (("name" . #<color>) ...) so that if an
1081 error happens we don't lose any malloc()ed data, or more importantly,
1082 leave any pixels allocated in the server. */
1084 LIST_LOOP (rest, color_symbol_alist)
1086 Lisp_Object cons = XCAR (rest);
1087 Lisp_Object name = XCAR (cons);
1088 Lisp_Object value = XCDR (cons);
1091 if (STRINGP (value))
1093 Fmake_color_instance
1094 (value, device, encode_error_behavior_flag (ERROR_ME_NOT));
1097 assert (COLOR_SPECIFIERP (value));
1098 value = Fspecifier_instance (value, domain, Qnil, Qnil);
1102 results = noseeum_cons (noseeum_cons (name, value), results);
1105 UNGCPRO; /* no more evaluation */
1107 if (i == 0) return 0;
1109 symbols = xnew_array (XpmColorSymbol, i);
1110 xpmattrs->valuemask |= XpmColorSymbols;
1111 xpmattrs->colorsymbols = symbols;
1112 xpmattrs->numsymbols = i;
1116 Lisp_Object cons = XCAR (results);
1117 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (XCDR (cons)));
1118 /* Duplicate the pixel value so that we still have a lock on it if
1119 the pixel we were passed is later freed. */
1120 if (! XAllocColor (dpy, cmap, &color))
1121 abort (); /* it must be allocable since we're just duplicating it */
1123 symbols [i].name = (char *) XSTRING_DATA (XCAR (cons));
1124 symbols [i].pixel = color.pixel;
1125 symbols [i].value = 0;
1126 free_cons (XCONS (cons));
1128 results = XCDR (results);
1129 free_cons (XCONS (cons));
1135 xpm_free (XpmAttributes *xpmattrs)
1137 /* Could conceivably lose if XpmXXX returned an error without first
1138 initializing this structure, if we didn't know that initializing it
1139 to all zeros was ok (and also that it's ok to call XpmFreeAttributes()
1140 multiple times, since it zeros slots as it frees them...) */
1141 XpmFreeAttributes (xpmattrs);
1145 x_xpm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1146 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1147 int dest_mask, Lisp_Object domain)
1149 /* This function can GC */
1150 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1151 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1152 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1160 XpmAttributes xpmattrs;
1162 XpmColorSymbol *color_symbols;
1163 Lisp_Object color_symbol_alist = find_keyword_in_vector (instantiator,
1165 enum image_instance_type type;
1169 if (!DEVICE_X_P (XDEVICE (device)))
1170 signal_simple_error ("Not an X device", device);
1172 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1173 xs = DefaultScreenOfDisplay (dpy);
1175 if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
1176 type = IMAGE_COLOR_PIXMAP;
1177 else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
1178 type = IMAGE_MONO_PIXMAP;
1179 else if (dest_mask & IMAGE_POINTER_MASK)
1180 type = IMAGE_POINTER;
1182 incompatible_image_types (instantiator, dest_mask,
1183 IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
1184 | IMAGE_POINTER_MASK);
1185 force_mono = (type != IMAGE_COLOR_PIXMAP);
1188 /* Although I haven't found it documented yet, it appears that pointers are
1189 always colored via the default window colormap... Sigh. */
1190 if (type == IMAGE_POINTER)
1192 cmap = DefaultColormap(dpy, DefaultScreen(dpy));
1193 depth = DefaultDepthOfScreen (xs);
1194 visual = DefaultVisualOfScreen (xs);
1198 cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1199 depth = DEVICE_X_DEPTH (XDEVICE(device));
1200 visual = DEVICE_X_VISUAL (XDEVICE(device));
1203 cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1204 depth = DEVICE_X_DEPTH (XDEVICE(device));
1205 visual = DEVICE_X_VISUAL (XDEVICE(device));
1208 x_initialize_pixmap_image_instance (ii, type);
1210 assert (!NILP (data));
1214 xzero (xpmattrs); /* want XpmInitAttributes() */
1215 xpmattrs.valuemask = XpmReturnPixels;
1218 /* Without this, we get a 1-bit version of the color image, which
1219 isn't quite right. With this, we get the mono image, which might
1220 be very different looking. */
1221 xpmattrs.valuemask |= XpmColorKey;
1222 xpmattrs.color_key = XPM_MONO;
1224 xpmattrs.valuemask |= XpmDepth;
1228 xpmattrs.closeness = 65535;
1229 xpmattrs.valuemask |= XpmCloseness;
1230 xpmattrs.depth = depth;
1231 xpmattrs.valuemask |= XpmDepth;
1232 xpmattrs.visual = visual;
1233 xpmattrs.valuemask |= XpmVisual;
1234 xpmattrs.colormap = cmap;
1235 xpmattrs.valuemask |= XpmColormap;
1238 color_symbols = extract_xpm_color_names (&xpmattrs, device, domain,
1239 color_symbol_alist);
1241 result = XpmCreatePixmapFromBuffer (dpy,
1242 XtWindow(DEVICE_XT_APP_SHELL (XDEVICE(device))),
1243 (char *) XSTRING_DATA (data),
1244 &pixmap, &mask, &xpmattrs);
1248 xfree (color_symbols);
1249 xpmattrs.colorsymbols = 0; /* in case XpmFreeAttr is too smart... */
1250 xpmattrs.numsymbols = 0;
1257 case XpmFileInvalid:
1259 xpm_free (&xpmattrs);
1260 signal_image_error ("invalid XPM data", data);
1262 case XpmColorFailed:
1265 xpm_free (&xpmattrs);
1268 /* second time; blow out. */
1269 signal_double_file_error ("Reading pixmap data",
1270 "color allocation failed",
1275 if (! (dest_mask & IMAGE_MONO_PIXMAP_MASK))
1277 /* second time; blow out. */
1278 signal_double_file_error ("Reading pixmap data",
1279 "color allocation failed",
1283 IMAGE_INSTANCE_TYPE (ii) = IMAGE_MONO_PIXMAP;
1289 xpm_free (&xpmattrs);
1290 signal_double_file_error ("Parsing pixmap data",
1291 "out of memory", data);
1295 xpm_free (&xpmattrs);
1296 signal_double_file_error_2 ("Parsing pixmap data",
1297 "unknown error code",
1298 make_int (result), data);
1303 h = xpmattrs.height;
1306 int npixels = xpmattrs.npixels;
1311 pixels = xnew_array (Pixel, npixels);
1312 memcpy (pixels, xpmattrs.pixels, npixels * sizeof (Pixel));
1317 IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
1318 IMAGE_INSTANCE_X_MASK (ii) = mask;
1319 IMAGE_INSTANCE_X_COLORMAP (ii) = cmap;
1320 IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
1321 IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
1322 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = w;
1323 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = h;
1324 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
1325 find_keyword_in_vector (instantiator, Q_file);
1330 case IMAGE_MONO_PIXMAP:
1333 case IMAGE_COLOR_PIXMAP:
1335 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = depth;
1341 int npixels = xpmattrs.npixels;
1342 Pixel *pixels = xpmattrs.pixels;
1345 int xhot = 0, yhot = 0;
1347 if (xpmattrs.valuemask & XpmHotspot)
1349 xhot = xpmattrs.x_hotspot;
1350 XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii), xpmattrs.x_hotspot);
1352 if (xpmattrs.valuemask & XpmHotspot)
1354 yhot = xpmattrs.y_hotspot;
1355 XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii), xpmattrs.y_hotspot);
1357 check_pointer_sizes (xs, w, h, instantiator);
1359 /* If the loaded pixmap has colors allocated (meaning it came from an
1360 XPM file), then use those as the default colors for the cursor we
1361 create. Otherwise, default to pointer_fg and pointer_bg.
1365 /* With an XBM file, it's obvious which bit is foreground
1366 and which is background, or rather, it's implicit: in
1367 an XBM file, a 1 bit is foreground, and a 0 bit is
1370 XCreatePixmapCursor() assumes this property of the
1371 pixmap it is called with as well; the `foreground'
1372 color argument is used for the 1 bits.
1374 With an XPM file, it's tricker, since the elements of
1375 the pixmap don't represent FG and BG, but are actual
1376 pixel values. So we need to figure out which of those
1377 pixels is the foreground color and which is the
1378 background. We do it by comparing RGB and assuming
1379 that the darker color is the foreground. This works
1380 with the result of xbmtopbm|ppmtoxpm, at least.
1382 It might be nice if there was some way to tag the
1383 colors in the XPM file with whether they are the
1384 foreground - perhaps with logical color names somehow?
1386 Once we have decided which color is the foreground, we
1387 need to ensure that that color corresponds to a `1' bit
1388 in the Pixmap. The XPM library wrote into the (1-bit)
1389 pixmap with XPutPixel, which will ignore all but the
1390 least significant bit.
1392 This means that a 1 bit in the image corresponds to
1393 `fg' only if `fg.pixel' is odd.
1395 (This also means that the image will be all the same
1396 color if both `fg' and `bg' are odd or even, but we can
1397 safely assume that that won't happen if the XPM file is
1400 The desired result is that the image use `1' to
1401 represent the foreground color, and `0' to represent
1402 the background color. So, we may need to invert the
1403 image to accomplish this; we invert if fg is
1404 odd. (Remember that WhitePixel and BlackPixel are not
1405 necessarily 1 and 0 respectively, though I think it
1406 might be safe to assume that one of them is always 1
1407 and the other is always 0. We also pretty much need to
1408 assume that one is even and the other is odd.)
1411 fg.pixel = pixels[0]; /* pick a pixel at random. */
1412 bg.pixel = fg.pixel;
1413 for (i = 1; i < npixels; i++) /* Look for an "other" pixel value.*/
1415 bg.pixel = pixels[i];
1416 if (fg.pixel != bg.pixel)
1420 /* If (fg.pixel == bg.pixel) then probably something has
1421 gone wrong, but I don't think signalling an error would
1424 XQueryColor (dpy, cmap, &fg);
1425 XQueryColor (dpy, cmap, &bg);
1427 /* If the foreground is lighter than the background, swap them.
1428 (This occurs semi-randomly, depending on the ordering of the
1429 color list in the XPM file.)
1432 unsigned short fg_total = ((fg.red / 3) + (fg.green / 3)
1434 unsigned short bg_total = ((bg.red / 3) + (bg.green / 3)
1436 if (fg_total > bg_total)
1445 /* If the fg pixel corresponds to a `0' in the bitmap, invert it.
1446 (This occurs (only?) on servers with Black=0, White=1.)
1448 if ((fg.pixel & 1) == 0)
1452 gcv.function = GXxor;
1454 gc = XCreateGC (dpy, pixmap, (GCFunction | GCForeground),
1456 XFillRectangle (dpy, pixmap, gc, 0, 0, w, h);
1462 generate_cursor_fg_bg (device, &pointer_fg, &pointer_bg,
1464 IMAGE_INSTANCE_PIXMAP_FG (ii) = pointer_fg;
1465 IMAGE_INSTANCE_PIXMAP_BG (ii) = pointer_bg;
1468 IMAGE_INSTANCE_X_CURSOR (ii) =
1470 (dpy, pixmap, mask, &fg, &bg, xhot, yhot);
1479 xpm_free (&xpmattrs); /* after we've read pixels and hotspot */
1482 #endif /* HAVE_XPM */
1487 /**********************************************************************
1489 **********************************************************************/
1492 xface_validate (Lisp_Object instantiator)
1494 file_or_data_must_be_present (instantiator);
1498 xface_normalize (Lisp_Object inst, Lisp_Object console_type)
1500 /* This function can call lisp */
1501 Lisp_Object file = Qnil, mask_file = Qnil;
1502 struct gcpro gcpro1, gcpro2, gcpro3;
1503 Lisp_Object alist = Qnil;
1505 GCPRO3 (file, mask_file, alist);
1507 /* Now, convert any file data into inline data for both the regular
1508 data and the mask data. At the end of this, `data' will contain
1509 the inline data (if any) or Qnil, and `file' will contain
1510 the name this data was derived from (if known) or Qnil.
1511 Likewise for `mask_file' and `mask_data'.
1513 Note that if we cannot generate any regular inline data, we
1516 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
1518 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
1519 Q_mask_data, console_type);
1521 if (CONSP (file)) /* failure locating filename */
1522 signal_double_file_error ("Opening bitmap file",
1523 "no such file or directory",
1526 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
1527 RETURN_UNGCPRO (inst);
1529 alist = tagged_vector_to_alist (inst);
1532 Lisp_Object data = make_string_from_file (file);
1533 alist = remassq_no_quit (Q_file, alist);
1534 /* there can't be a :data at this point. */
1535 alist = Fcons (Fcons (Q_file, file),
1536 Fcons (Fcons (Q_data, data), alist));
1539 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
1542 Lisp_Object result = alist_to_tagged_vector (Qxface, alist);
1544 RETURN_UNGCPRO (result);
1549 xface_possible_dest_types (void)
1552 IMAGE_MONO_PIXMAP_MASK |
1553 IMAGE_COLOR_PIXMAP_MASK |
1558 /* This is about to get redefined! */
1561 /* We have to define SYSV32 so that compface.h includes string.h
1562 instead of strings.h. */
1567 #include <compface.h>
1571 /* JMP_BUF cannot be used here because if it doesn't get defined
1572 to jmp_buf we end up with a conflicting type error with the
1573 definition in compface.h */
1574 extern jmp_buf comp_env;
1578 xface_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1579 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1580 int dest_mask, Lisp_Object domain)
1582 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1584 char *p, *bits, *bp;
1585 CONST char * volatile emsg = 0;
1586 CONST char * volatile dstring;
1588 assert (!NILP (data));
1590 GET_C_STRING_BINARY_DATA_ALLOCA (data, dstring);
1592 if ((p = strchr (dstring, ':')))
1597 /* Must use setjmp not SETJMP because we used jmp_buf above not JMP_BUF */
1598 if (!(stattis = setjmp (comp_env)))
1600 UnCompAll ((char *) dstring);
1607 emsg = "uncompface: internal error";
1610 emsg = "uncompface: insufficient or invalid data";
1613 emsg = "uncompface: excess data ignored";
1618 signal_simple_error_2 (emsg, data, Qimage);
1620 bp = bits = (char *) alloca (PIXELS / 8);
1622 /* the compface library exports char F[], which uses a single byte per
1623 pixel to represent a 48x48 bitmap. Yuck. */
1624 for (i = 0, p = F; i < (PIXELS / 8); ++i)
1627 /* reverse the bit order of each byte... */
1628 for (b = n = 0; b < 8; ++b)
1635 xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1636 pointer_bg, dest_mask, 48, 48, bits);
1639 #endif /* HAVE_XFACE */
1642 /**********************************************************************
1644 **********************************************************************/
1647 autodetect_validate (Lisp_Object instantiator)
1649 data_must_be_present (instantiator);
1653 autodetect_normalize (Lisp_Object instantiator,
1654 Lisp_Object console_type)
1656 Lisp_Object file = find_keyword_in_vector (instantiator, Q_data);
1657 Lisp_Object filename = Qnil;
1658 Lisp_Object data = Qnil;
1659 struct gcpro gcpro1, gcpro2, gcpro3;
1660 Lisp_Object alist = Qnil;
1662 GCPRO3 (filename, data, alist);
1664 if (NILP (file)) /* no conversion necessary */
1665 RETURN_UNGCPRO (instantiator);
1667 alist = tagged_vector_to_alist (instantiator);
1669 filename = locate_pixmap_file (file);
1670 if (!NILP (filename))
1673 /* #### Apparently some versions of XpmReadFileToData, which is
1674 called by pixmap_to_lisp_data, don't return an error value
1675 if the given file is not a valid XPM file. Instead, they
1676 just seg fault. It is definitely caused by passing a
1677 bitmap. To try and avoid this we check for bitmaps first. */
1679 data = bitmap_to_lisp_data (filename, &xhot, &yhot, 1);
1683 alist = remassq_no_quit (Q_data, alist);
1684 alist = Fcons (Fcons (Q_file, filename),
1685 Fcons (Fcons (Q_data, data), alist));
1687 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
1690 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
1693 alist = xbm_mask_file_munging (alist, filename, Qnil, console_type);
1696 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
1698 RETURN_UNGCPRO (result);
1703 data = pixmap_to_lisp_data (filename, 1);
1707 alist = remassq_no_quit (Q_data, alist);
1708 alist = Fcons (Fcons (Q_file, filename),
1709 Fcons (Fcons (Q_data, data), alist));
1710 alist = Fcons (Fcons (Q_color_symbols,
1711 evaluate_xpm_color_symbols ()),
1714 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
1716 RETURN_UNGCPRO (result);
1722 /* If we couldn't convert it, just put it back as it is.
1723 We might try to further frob it later as a cursor-font
1724 specification. (We can't do that now because we don't know
1725 what dest-types it's going to be instantiated into.) */
1727 Lisp_Object result = alist_to_tagged_vector (Qautodetect, alist);
1729 RETURN_UNGCPRO (result);
1734 autodetect_possible_dest_types (void)
1737 IMAGE_MONO_PIXMAP_MASK |
1738 IMAGE_COLOR_PIXMAP_MASK |
1739 IMAGE_POINTER_MASK |
1744 autodetect_instantiate (Lisp_Object image_instance,
1745 Lisp_Object instantiator,
1746 Lisp_Object pointer_fg,
1747 Lisp_Object pointer_bg,
1748 int dest_mask, Lisp_Object domain)
1750 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1751 struct gcpro gcpro1, gcpro2, gcpro3;
1752 Lisp_Object alist = Qnil;
1753 Lisp_Object result = Qnil;
1754 int is_cursor_font = 0;
1756 GCPRO3 (data, alist, result);
1758 alist = tagged_vector_to_alist (instantiator);
1759 if (dest_mask & IMAGE_POINTER_MASK)
1761 CONST char *name_ext;
1762 GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext);
1763 if (XmuCursorNameToIndex (name_ext) != -1)
1765 result = alist_to_tagged_vector (Qcursor_font, alist);
1770 if (!is_cursor_font)
1771 result = alist_to_tagged_vector (Qstring, alist);
1775 cursor_font_instantiate (image_instance, result, pointer_fg,
1776 pointer_bg, dest_mask, domain);
1778 string_instantiate (image_instance, result, pointer_fg,
1779 pointer_bg, dest_mask, domain);
1785 /**********************************************************************
1787 **********************************************************************/
1790 font_validate (Lisp_Object instantiator)
1792 data_must_be_present (instantiator);
1795 /* XmuCvtStringToCursor is bogus in the following ways:
1797 - When it can't convert the given string to a real cursor, it will
1798 sometimes return a "success" value, after triggering a BadPixmap
1799 error. It then gives you a cursor that will itself generate BadCursor
1800 errors. So we install this error handler to catch/notice the X error
1801 and take that as meaning "couldn't convert."
1803 - When you tell it to find a cursor file that doesn't exist, it prints
1804 an error message on stderr. You can't make it not do that.
1806 - Also, using Xmu means we can't properly hack Lisp_Image_Instance
1807 objects, or XPM files, or $XBMLANGPATH.
1810 /* Duplicate the behavior of XmuCvtStringToCursor() to bypass its bogusness. */
1812 static int XLoadFont_got_error;
1815 XLoadFont_error_handler (Display *dpy, XErrorEvent *xerror)
1817 XLoadFont_got_error = 1;
1822 safe_XLoadFont (Display *dpy, char *name)
1825 int (*old_handler) (Display *, XErrorEvent *);
1826 XLoadFont_got_error = 0;
1828 old_handler = XSetErrorHandler (XLoadFont_error_handler);
1829 font = XLoadFont (dpy, name);
1831 XSetErrorHandler (old_handler);
1832 if (XLoadFont_got_error) return 0;
1837 font_possible_dest_types (void)
1839 return IMAGE_POINTER_MASK;
1843 font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1844 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1845 int dest_mask, Lisp_Object domain)
1847 /* This function can GC */
1848 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1849 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1850 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1854 char source_name[MAXPATHLEN], mask_name[MAXPATHLEN], dummy;
1855 int source_char, mask_char;
1857 Lisp_Object foreground, background;
1859 if (!DEVICE_X_P (XDEVICE (device)))
1860 signal_simple_error ("Not an X device", device);
1862 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1864 if (!STRINGP (data) ||
1865 strncmp ("FONT ", (char *) XSTRING_DATA (data), 5))
1866 signal_simple_error ("Invalid font-glyph instantiator",
1869 if (!(dest_mask & IMAGE_POINTER_MASK))
1870 incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
1872 foreground = find_keyword_in_vector (instantiator, Q_foreground);
1873 if (NILP (foreground))
1874 foreground = pointer_fg;
1875 background = find_keyword_in_vector (instantiator, Q_background);
1876 if (NILP (background))
1877 background = pointer_bg;
1879 generate_cursor_fg_bg (device, &foreground, &background, &fg, &bg);
1881 count = sscanf ((char *) XSTRING_DATA (data),
1882 "FONT %s %d %s %d %c",
1883 source_name, &source_char,
1884 mask_name, &mask_char, &dummy);
1885 /* Allow "%s %d %d" as well... */
1886 if (count == 3 && (1 == sscanf (mask_name, "%d %c", &mask_char, &dummy)))
1887 count = 4, mask_name[0] = 0;
1889 if (count != 2 && count != 4)
1890 signal_simple_error ("invalid cursor specification", data);
1891 source = safe_XLoadFont (dpy, source_name);
1893 signal_simple_error_2 ("couldn't load font",
1894 build_string (source_name),
1898 else if (!mask_name[0])
1902 mask = safe_XLoadFont (dpy, mask_name);
1905 Fsignal (Qerror, list3 (build_string ("couldn't load font"),
1906 build_string (mask_name), data));
1911 /* #### call XQueryTextExtents() and check_pointer_sizes() here. */
1913 x_initialize_pixmap_image_instance (ii, IMAGE_POINTER);
1914 IMAGE_INSTANCE_X_CURSOR (ii) =
1915 XCreateGlyphCursor (dpy, source, mask, source_char, mask_char,
1917 XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
1918 XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
1919 XUnloadFont (dpy, source);
1920 if (mask && mask != source) XUnloadFont (dpy, mask);
1924 /**********************************************************************
1926 **********************************************************************/
1929 cursor_font_validate (Lisp_Object instantiator)
1931 data_must_be_present (instantiator);
1935 cursor_font_possible_dest_types (void)
1937 return IMAGE_POINTER_MASK;
1941 cursor_font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1942 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1943 int dest_mask, Lisp_Object domain)
1945 /* This function can GC */
1946 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1947 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1948 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1951 CONST char *name_ext;
1952 Lisp_Object foreground, background;
1954 if (!DEVICE_X_P (XDEVICE (device)))
1955 signal_simple_error ("Not an X device", device);
1957 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1959 if (!(dest_mask & IMAGE_POINTER_MASK))
1960 incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
1962 GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext);
1963 if ((i = XmuCursorNameToIndex (name_ext)) == -1)
1964 signal_simple_error ("Unrecognized cursor-font name", data);
1966 x_initialize_pixmap_image_instance (ii, IMAGE_POINTER);
1967 IMAGE_INSTANCE_X_CURSOR (ii) = XCreateFontCursor (dpy, i);
1968 foreground = find_keyword_in_vector (instantiator, Q_foreground);
1969 if (NILP (foreground))
1970 foreground = pointer_fg;
1971 background = find_keyword_in_vector (instantiator, Q_background);
1972 if (NILP (background))
1973 background = pointer_bg;
1974 maybe_recolor_cursor (image_instance, foreground, background);
1978 x_colorize_image_instance (Lisp_Object image_instance,
1979 Lisp_Object foreground, Lisp_Object background)
1981 struct Lisp_Image_Instance *p;
1983 p = XIMAGE_INSTANCE (image_instance);
1985 switch (IMAGE_INSTANCE_TYPE (p))
1987 case IMAGE_MONO_PIXMAP:
1988 IMAGE_INSTANCE_TYPE (p) = IMAGE_COLOR_PIXMAP;
1989 /* Make sure there aren't two pointers to the same mask, causing
1990 it to get freed twice. */
1991 IMAGE_INSTANCE_X_MASK (p) = 0;
1999 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
2000 Drawable draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (IMAGE_INSTANCE_DEVICE (p))));
2001 Dimension d = DEVICE_X_DEPTH (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
2002 Pixmap new = XCreatePixmap (dpy, draw,
2003 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
2004 IMAGE_INSTANCE_PIXMAP_HEIGHT (p), d);
2008 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground));
2009 gcv.foreground = color.pixel;
2010 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background));
2011 gcv.background = color.pixel;
2012 gc = XCreateGC (dpy, new, GCBackground|GCForeground, &gcv);
2013 XCopyPlane (dpy, IMAGE_INSTANCE_X_PIXMAP (p), new, gc, 0, 0,
2014 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
2015 IMAGE_INSTANCE_PIXMAP_HEIGHT (p),
2018 IMAGE_INSTANCE_X_PIXMAP (p) = new;
2019 IMAGE_INSTANCE_PIXMAP_DEPTH (p) = d;
2020 IMAGE_INSTANCE_PIXMAP_FG (p) = foreground;
2021 IMAGE_INSTANCE_PIXMAP_BG (p) = background;
2027 /************************************************************************/
2028 /* subwindow and widget support */
2029 /************************************************************************/
2031 /* unmap the image if it is a widget. This is used by redisplay via
2032 redisplay_unmap_subwindows */
2034 x_unmap_subwindow (struct Lisp_Image_Instance *p)
2036 XUnmapWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (p)),
2037 IMAGE_INSTANCE_X_SUBWINDOW_ID (p));
2040 /* map the subwindow. This is used by redisplay via
2041 redisplay_output_subwindow */
2043 x_map_subwindow (struct Lisp_Image_Instance *p, int x, int y)
2045 XMapWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (p)),
2046 IMAGE_INSTANCE_X_SUBWINDOW_ID (p));
2047 XMoveWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (p)),
2048 IMAGE_INSTANCE_X_SUBWINDOW_ID (p), x, y);
2051 /* instantiate and x type subwindow */
2053 x_subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2054 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2055 int dest_mask, Lisp_Object domain)
2057 /* This function can GC */
2058 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2059 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
2060 Lisp_Object frame = FW_FRAME (domain);
2061 struct frame* f = XFRAME (frame);
2065 XSetWindowAttributes xswa;
2067 unsigned int w = IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii),
2068 h = IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii);
2070 if (!DEVICE_X_P (XDEVICE (device)))
2071 signal_simple_error ("Not an X device", device);
2073 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2074 xs = DefaultScreenOfDisplay (dpy);
2076 if (dest_mask & IMAGE_SUBWINDOW_MASK)
2077 IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW;
2079 incompatible_image_types (instantiator, dest_mask,
2080 IMAGE_SUBWINDOW_MASK);
2082 pw = XtWindow (FRAME_X_TEXT_WIDGET (f));
2084 ii->data = xnew_and_zero (struct x_subwindow_data);
2086 IMAGE_INSTANCE_X_SUBWINDOW_PARENT (ii) = pw;
2087 IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (ii) = xs;
2089 xswa.backing_store = Always;
2090 valueMask |= CWBackingStore;
2091 xswa.colormap = DefaultColormapOfScreen (xs);
2092 valueMask |= CWColormap;
2094 win = XCreateWindow (dpy, pw, 0, 0, w, h, 0, CopyFromParent,
2095 InputOutput, CopyFromParent, valueMask,
2098 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)win;
2102 /* #### Should this function exist? If there's any doubt I'm not implementing it --andyp */
2103 DEFUN ("change-subwindow-property", Fchange_subwindow_property, 3, 3, 0, /*
2104 For the given SUBWINDOW, set PROPERTY to DATA, which is a string.
2105 Subwindows are not currently implemented.
2107 (subwindow, property, data))
2110 struct Lisp_Subwindow *sw;
2113 CHECK_SUBWINDOW (subwindow);
2114 CHECK_STRING (property);
2115 CHECK_STRING (data);
2117 sw = XSUBWINDOW (subwindow);
2118 dpy = DisplayOfScreen (LISP_DEVICE_TO_X_SCREEN
2119 (FRAME_DEVICE (XFRAME (sw->frame))));
2121 property_atom = XInternAtom (dpy, (char *) XSTRING_DATA (property), False);
2122 XChangeProperty (dpy, sw->subwindow, property_atom, XA_STRING, 8,
2124 XSTRING_DATA (data),
2125 XSTRING_LENGTH (data));
2132 x_resize_subwindow (struct Lisp_Image_Instance* ii, int w, int h)
2134 XResizeWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (ii)),
2135 IMAGE_INSTANCE_X_SUBWINDOW_ID (ii),
2140 /************************************************************************/
2141 /* initialization */
2142 /************************************************************************/
2145 syms_of_glyphs_x (void)
2148 DEFSUBR (Fchange_subwindow_property);
2153 console_type_create_glyphs_x (void)
2157 CONSOLE_HAS_METHOD (x, print_image_instance);
2158 CONSOLE_HAS_METHOD (x, finalize_image_instance);
2159 CONSOLE_HAS_METHOD (x, image_instance_equal);
2160 CONSOLE_HAS_METHOD (x, image_instance_hash);
2161 CONSOLE_HAS_METHOD (x, colorize_image_instance);
2162 CONSOLE_HAS_METHOD (x, init_image_instance_from_eimage);
2163 CONSOLE_HAS_METHOD (x, locate_pixmap_file);
2164 CONSOLE_HAS_METHOD (x, unmap_subwindow);
2165 CONSOLE_HAS_METHOD (x, map_subwindow);
2166 CONSOLE_HAS_METHOD (x, resize_subwindow);
2170 image_instantiator_format_create_glyphs_x (void)
2173 INITIALIZE_DEVICE_IIFORMAT (x, xpm);
2174 IIFORMAT_HAS_DEVMETHOD (x, xpm, instantiate);
2176 INITIALIZE_DEVICE_IIFORMAT (x, xbm);
2177 IIFORMAT_HAS_DEVMETHOD (x, xbm, instantiate);
2179 INITIALIZE_DEVICE_IIFORMAT (x, subwindow);
2180 IIFORMAT_HAS_DEVMETHOD (x, subwindow, instantiate);
2182 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (cursor_font, "cursor-font");
2184 IIFORMAT_HAS_METHOD (cursor_font, validate);
2185 IIFORMAT_HAS_METHOD (cursor_font, possible_dest_types);
2186 IIFORMAT_HAS_METHOD (cursor_font, instantiate);
2188 IIFORMAT_VALID_KEYWORD (cursor_font, Q_data, check_valid_string);
2189 IIFORMAT_VALID_KEYWORD (cursor_font, Q_foreground, check_valid_string);
2190 IIFORMAT_VALID_KEYWORD (cursor_font, Q_background, check_valid_string);
2192 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (font, "font");
2194 IIFORMAT_HAS_METHOD (font, validate);
2195 IIFORMAT_HAS_METHOD (font, possible_dest_types);
2196 IIFORMAT_HAS_METHOD (font, instantiate);
2198 IIFORMAT_VALID_KEYWORD (font, Q_data, check_valid_string);
2199 IIFORMAT_VALID_KEYWORD (font, Q_foreground, check_valid_string);
2200 IIFORMAT_VALID_KEYWORD (font, Q_background, check_valid_string);
2203 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xface, "xface");
2205 IIFORMAT_HAS_METHOD (xface, validate);
2206 IIFORMAT_HAS_METHOD (xface, normalize);
2207 IIFORMAT_HAS_METHOD (xface, possible_dest_types);
2208 IIFORMAT_HAS_METHOD (xface, instantiate);
2210 IIFORMAT_VALID_KEYWORD (xface, Q_data, check_valid_string);
2211 IIFORMAT_VALID_KEYWORD (xface, Q_file, check_valid_string);
2212 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_x, check_valid_int);
2213 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_y, check_valid_int);
2214 IIFORMAT_VALID_KEYWORD (xface, Q_foreground, check_valid_string);
2215 IIFORMAT_VALID_KEYWORD (xface, Q_background, check_valid_string);
2218 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (autodetect,
2221 IIFORMAT_HAS_METHOD (autodetect, validate);
2222 IIFORMAT_HAS_METHOD (autodetect, normalize);
2223 IIFORMAT_HAS_METHOD (autodetect, possible_dest_types);
2224 IIFORMAT_HAS_METHOD (autodetect, instantiate);
2226 IIFORMAT_VALID_KEYWORD (autodetect, Q_data, check_valid_string);
2230 vars_of_glyphs_x (void)
2236 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path /*
2237 A list of the directories in which X bitmap files may be found.
2238 If nil, this is initialized from the "*bitmapFilePath" resource.
2239 This is used by the `make-image-instance' function (however, note that if
2240 the environment variable XBMLANGPATH is set, it is consulted first).
2242 Vx_bitmap_file_path = Qnil;
2246 complex_vars_of_glyphs_x (void)
2248 #define BUILD_GLYPH_INST(variable, name) \
2249 Fadd_spec_to_specifier \
2250 (GLYPH_IMAGE (XGLYPH (variable)), \
2251 vector3 (Qxbm, Q_data, \
2252 list3 (make_int (name##_width), \
2253 make_int (name##_height), \
2254 make_ext_string (name##_bits, \
2255 sizeof (name##_bits), \
2259 BUILD_GLYPH_INST (Vtruncation_glyph, truncator);
2260 BUILD_GLYPH_INST (Vcontinuation_glyph, continuer);
2261 BUILD_GLYPH_INST (Vxemacs_logo, xemacs);
2262 BUILD_GLYPH_INST (Vhscroll_glyph, hscroll);
2264 #undef BUILD_GLYPH_INST