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
7 Copyright (C) 1999 Andy Piper
9 This file is part of XEmacs.
11 XEmacs is free software; you can redistribute it and/or modify it
12 under the terms of the GNU General Public License as published by the
13 Free Software Foundation; either version 2, or (at your option) any
16 XEmacs is distributed in the hope that it will be useful, but WITHOUT
17 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
18 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
21 You should have received a copy of the GNU General Public License
22 along with XEmacs; see the file COPYING. If not, write to
23 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 Boston, MA 02111-1307, USA. */
26 /* Synched up with: Not in FSF. */
28 /* Original author: Jamie Zawinski for 19.8
29 font-truename stuff added by Jamie Zawinski for 19.10
30 subwindow support added by Chuck Thompson
31 additional XPM support added by Chuck Thompson
32 initial X-Face support added by Stig
33 rewritten/restructured by Ben Wing for 19.12/19.13
34 GIF/JPEG support added by Ben Wing for 19.14
35 PNG support added by Bill Perry for 19.14
36 Improved GIF/JPEG support added by Bill Perry for 19.14
37 Cleanup/simplification of error handling by Ben Wing for 19.14
38 Pointer/icon overhaul, more restructuring by Ben Wing for 19.14
39 GIF support changed to external GIFlib 3.1 by Jareth Hein for 21.0
40 Many changes for color work and optimizations by Jareth Hein for 21.0
41 Switch of GIF/JPEG/PNG to new EImage intermediate code by Jareth Hein for 21.0
42 TIFF code by Jareth Hein for 21.0
43 GIF/JPEG/PNG/TIFF code moved to new glyph-eimage.c by Andy Piper for 21.0
44 Subwindow and Widget support by Andy Piper for 21.2
47 Support the GrayScale, StaticColor and StaticGray visual classes.
48 Convert images.el to C and stick it in here?
54 #include "console-x.h"
56 #include "objects-x.h"
77 #include "file-coding.h"
80 #ifdef LWLIB_WIDGETS_MOTIF
83 #include <X11/IntrinsicP.h>
86 # define FOUR_BYTE_TYPE unsigned int
88 # define FOUR_BYTE_TYPE unsigned long
90 # define FOUR_BYTE_TYPE unsigned short
92 #error What kind of strange-ass system are we running on?
95 #define LISP_DEVICE_TO_X_SCREEN(dev) XDefaultScreenOfDisplay (DEVICE_X_DISPLAY (XDEVICE (dev)))
97 DECLARE_IMAGE_INSTANTIATOR_FORMAT (nothing);
98 DECLARE_IMAGE_INSTANTIATOR_FORMAT (string);
99 DECLARE_IMAGE_INSTANTIATOR_FORMAT (formatted_string);
100 DECLARE_IMAGE_INSTANTIATOR_FORMAT (inherit);
101 DECLARE_IMAGE_INSTANTIATOR_FORMAT (layout);
103 DECLARE_IMAGE_INSTANTIATOR_FORMAT (jpeg);
106 DECLARE_IMAGE_INSTANTIATOR_FORMAT (tiff);
109 DECLARE_IMAGE_INSTANTIATOR_FORMAT (png);
112 DECLARE_IMAGE_INSTANTIATOR_FORMAT (gif);
115 DEFINE_DEVICE_IIFORMAT (x, xpm);
117 DEFINE_DEVICE_IIFORMAT (x, xbm);
118 DEFINE_DEVICE_IIFORMAT (x, subwindow);
120 DEFINE_DEVICE_IIFORMAT (x, xface);
123 DEFINE_IMAGE_INSTANTIATOR_FORMAT (cursor_font);
124 Lisp_Object Qcursor_font;
126 DEFINE_IMAGE_INSTANTIATOR_FORMAT (font);
128 DEFINE_IMAGE_INSTANTIATOR_FORMAT (autodetect);
131 DEFINE_DEVICE_IIFORMAT (x, widget);
132 DEFINE_DEVICE_IIFORMAT (x, button);
133 DEFINE_DEVICE_IIFORMAT (x, progress_gauge);
134 DEFINE_DEVICE_IIFORMAT (x, edit_field);
135 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
136 DEFINE_DEVICE_IIFORMAT (x, combo_box);
138 DEFINE_DEVICE_IIFORMAT (x, tab_control);
139 DEFINE_DEVICE_IIFORMAT (x, label);
142 static void cursor_font_instantiate (Lisp_Object image_instance,
143 Lisp_Object instantiator,
144 Lisp_Object pointer_fg,
145 Lisp_Object pointer_bg,
151 update_widget_face (struct Lisp_Image_Instance* ii, Lisp_Object domain);
157 /************************************************************************/
158 /* image instance methods */
159 /************************************************************************/
161 /************************************************************************/
162 /* convert from a series of RGB triples to an XImage formated for the */
164 /************************************************************************/
166 convert_EImage_to_XImage (Lisp_Object device, int width, int height,
167 unsigned char *pic, unsigned long **pixtbl,
174 int depth, bitmap_pad, bits_per_pixel, byte_cnt, i, j;
176 unsigned char *data, *ip, *dp;
177 quant_table *qtable = 0;
183 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
184 cmap = DEVICE_X_COLORMAP (XDEVICE(device));
185 vis = DEVICE_X_VISUAL (XDEVICE(device));
186 depth = DEVICE_X_DEPTH(XDEVICE(device));
188 if (vis->class == GrayScale || vis->class == StaticColor ||
189 vis->class == StaticGray)
191 /* #### Implement me!!! */
195 if (vis->class == PseudoColor)
197 /* Quantize the image and get a histogram while we're at it.
198 Do this first to save memory */
199 qtable = build_EImage_quantable(pic, width, height, 256);
200 if (qtable == NULL) return NULL;
203 bitmap_pad = ((depth > 16) ? 32 :
207 outimg = XCreateImage (dpy, vis,
208 depth, ZPixmap, 0, 0, width, height,
210 if (!outimg) return NULL;
212 bits_per_pixel = outimg->bits_per_pixel;
213 byte_cnt = bits_per_pixel >> 3;
215 data = (unsigned char *) xmalloc (outimg->bytes_per_line * height);
218 XDestroyImage (outimg);
221 outimg->data = (char *) data;
223 if (vis->class == PseudoColor)
225 unsigned long pixarray[256];
227 /* use our quantize table to allocate the colors */
229 *pixtbl = xnew_array (unsigned long, pixcount);
232 /* ### should implement a sort by popularity to assure proper allocation */
234 for (i = 0; i < qtable->num_active_colors; i++)
239 color.red = qtable->rm[i] ? qtable->rm[i] << 8 : 0;
240 color.green = qtable->gm[i] ? qtable->gm[i] << 8 : 0;
241 color.blue = qtable->bm[i] ? qtable->bm[i] << 8 : 0;
242 color.flags = DoRed | DoGreen | DoBlue;
243 res = allocate_nearest_color (dpy, cmap, vis, &color);
244 if (res > 0 && res < 3)
246 DO_REALLOC(*pixtbl, pixcount, n+1, unsigned long);
247 (*pixtbl)[n] = color.pixel;
250 pixarray[i] = color.pixel;
254 for (i = 0; i < height; i++)
256 dp = data + (i * outimg->bytes_per_line);
257 for (j = 0; j < width; j++)
262 conv.val = pixarray[QUANT_GET_COLOR(qtable,rd,gr,bl)];
264 if (outimg->byte_order == MSBFirst)
265 for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q];
267 for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q];
269 if (outimg->byte_order == MSBFirst)
270 for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q];
272 for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q];
278 unsigned long rshift,gshift,bshift,rbits,gbits,bbits,junk;
279 junk = vis->red_mask;
281 while ((junk & 0x1) == 0)
292 junk = vis->green_mask;
294 while ((junk & 0x1) == 0)
305 junk = vis->blue_mask;
307 while ((junk & 0x1) == 0)
319 for (i = 0; i < height; i++)
321 dp = data + (i * outimg->bytes_per_line);
322 for (j = 0; j < width; j++)
325 rd = *ip++ << (rbits - 8);
327 rd = *ip++ >> (8 - rbits);
329 gr = *ip++ << (gbits - 8);
331 gr = *ip++ >> (8 - gbits);
333 bl = *ip++ << (bbits - 8);
335 bl = *ip++ >> (8 - bbits);
337 conv.val = (rd << rshift) | (gr << gshift) | (bl << bshift);
339 if (outimg->byte_order == MSBFirst)
340 for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q];
342 for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q];
344 if (outimg->byte_order == MSBFirst)
345 for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q];
347 for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q];
358 x_print_image_instance (struct Lisp_Image_Instance *p,
359 Lisp_Object printcharfun,
364 switch (IMAGE_INSTANCE_TYPE (p))
366 case IMAGE_MONO_PIXMAP:
367 case IMAGE_COLOR_PIXMAP:
369 sprintf (buf, " (0x%lx", (unsigned long) IMAGE_INSTANCE_X_PIXMAP (p));
370 write_c_string (buf, printcharfun);
371 if (IMAGE_INSTANCE_X_MASK (p))
373 sprintf (buf, "/0x%lx", (unsigned long) IMAGE_INSTANCE_X_MASK (p));
374 write_c_string (buf, printcharfun);
376 write_c_string (")", printcharfun);
384 extern int debug_widget_instances;
388 x_finalize_image_instance (struct Lisp_Image_Instance *p)
393 if (DEVICE_LIVE_P (XDEVICE (p->device)))
395 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (p->device));
397 if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET)
399 if (IMAGE_INSTANCE_SUBWINDOW_ID (p))
402 debug_widget_instances--;
403 stderr_out ("widget destroyed, %d left\n", debug_widget_instances);
405 lw_destroy_widget (IMAGE_INSTANCE_X_WIDGET_ID (p));
406 lw_destroy_widget (IMAGE_INSTANCE_X_CLIPWIDGET (p));
407 IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0;
410 else if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
412 if (IMAGE_INSTANCE_SUBWINDOW_ID (p))
413 XDestroyWindow (dpy, IMAGE_INSTANCE_X_SUBWINDOW_ID (p));
414 IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0;
419 if (IMAGE_INSTANCE_PIXMAP_TIMEOUT (p))
420 disable_glyph_animated_timeout (IMAGE_INSTANCE_PIXMAP_TIMEOUT (p));
422 if (IMAGE_INSTANCE_X_MASK (p) &&
423 IMAGE_INSTANCE_X_MASK (p) != IMAGE_INSTANCE_X_PIXMAP (p))
424 XFreePixmap (dpy, IMAGE_INSTANCE_X_MASK (p));
425 IMAGE_INSTANCE_PIXMAP_MASK (p) = 0;
427 if (IMAGE_INSTANCE_X_PIXMAP_SLICES (p))
429 for (i = 0; i < IMAGE_INSTANCE_PIXMAP_MAXSLICE (p); i++)
430 if (IMAGE_INSTANCE_X_PIXMAP_SLICE (p,i))
432 XFreePixmap (dpy, IMAGE_INSTANCE_X_PIXMAP_SLICE (p,i));
433 IMAGE_INSTANCE_X_PIXMAP_SLICE (p, i) = 0;
435 xfree (IMAGE_INSTANCE_X_PIXMAP_SLICES (p));
436 IMAGE_INSTANCE_X_PIXMAP_SLICES (p) = 0;
439 if (IMAGE_INSTANCE_X_CURSOR (p))
441 XFreeCursor (dpy, IMAGE_INSTANCE_X_CURSOR (p));
442 IMAGE_INSTANCE_X_CURSOR (p) = 0;
445 if (IMAGE_INSTANCE_X_NPIXELS (p) != 0)
448 IMAGE_INSTANCE_X_COLORMAP (p),
449 IMAGE_INSTANCE_X_PIXELS (p),
450 IMAGE_INSTANCE_X_NPIXELS (p), 0);
451 IMAGE_INSTANCE_X_NPIXELS (p) = 0;
455 /* You can sometimes have pixels without a live device. I forget
456 why, but that's why we free them here if we have a pixmap type
457 image instance. It probably means that we might also get a memory
458 leak with widgets. */
459 if (IMAGE_INSTANCE_TYPE (p) != IMAGE_WIDGET
460 && IMAGE_INSTANCE_TYPE (p) != IMAGE_SUBWINDOW
461 && IMAGE_INSTANCE_X_PIXELS (p))
463 xfree (IMAGE_INSTANCE_X_PIXELS (p));
464 IMAGE_INSTANCE_X_PIXELS (p) = 0;
472 x_image_instance_equal (struct Lisp_Image_Instance *p1,
473 struct Lisp_Image_Instance *p2, int depth)
475 switch (IMAGE_INSTANCE_TYPE (p1))
477 case IMAGE_MONO_PIXMAP:
478 case IMAGE_COLOR_PIXMAP:
480 if (IMAGE_INSTANCE_X_COLORMAP (p1) != IMAGE_INSTANCE_X_COLORMAP (p2) ||
481 IMAGE_INSTANCE_X_NPIXELS (p1) != IMAGE_INSTANCE_X_NPIXELS (p2))
492 x_image_instance_hash (struct Lisp_Image_Instance *p, int depth)
494 switch (IMAGE_INSTANCE_TYPE (p))
496 case IMAGE_MONO_PIXMAP:
497 case IMAGE_COLOR_PIXMAP:
499 return IMAGE_INSTANCE_X_NPIXELS (p);
505 /* Set all the slots in an image instance structure to reasonable
506 default values. This is used somewhere within an instantiate
507 method. It is assumed that the device slot within the image
508 instance is already set -- this is the case when instantiate
509 methods are called. */
512 x_initialize_pixmap_image_instance (struct Lisp_Image_Instance *ii,
514 enum image_instance_type type)
516 ii->data = xnew_and_zero (struct x_image_instance_data);
517 IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) = slices;
518 IMAGE_INSTANCE_X_PIXMAP_SLICES (ii) =
519 xnew_array_and_zero (Pixmap, slices);
520 IMAGE_INSTANCE_TYPE (ii) = type;
521 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = Qnil;
522 IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (ii) = Qnil;
523 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) = Qnil;
524 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) = Qnil;
525 IMAGE_INSTANCE_PIXMAP_FG (ii) = Qnil;
526 IMAGE_INSTANCE_PIXMAP_BG (ii) = Qnil;
530 /************************************************************************/
531 /* pixmap file functions */
532 /************************************************************************/
534 /* Where bitmaps are; initialized from resource database */
535 Lisp_Object Vx_bitmap_file_path;
538 #define BITMAPDIR "/usr/include/X11/bitmaps"
541 #define USE_XBMLANGPATH
543 /* Given a pixmap filename, look through all of the "standard" places
544 where the file might be located. Return a full pathname if found;
545 otherwise, return Qnil. */
548 x_locate_pixmap_file (Lisp_Object name)
550 /* This function can GC if IN_REDISPLAY is false */
553 /* Check non-absolute pathnames with a directory component relative to
554 the search path; that's the way Xt does it. */
555 /* #### Unix-specific */
556 if (XSTRING_BYTE (name, 0) == '/' ||
557 (XSTRING_BYTE (name, 0) == '.' &&
558 (XSTRING_BYTE (name, 1) == '/' ||
559 (XSTRING_BYTE (name, 1) == '.' &&
560 (XSTRING_BYTE (name, 2) == '/')))))
562 if (!NILP (Ffile_readable_p (name)))
568 if (NILP (Vdefault_x_device))
569 /* This may occur during initialization. */
572 /* We only check the bitmapFilePath resource on the original X device. */
573 display = DEVICE_X_DISPLAY (XDEVICE (Vdefault_x_device));
575 #ifdef USE_XBMLANGPATH
577 char *path = egetenv ("XBMLANGPATH");
578 SubstitutionRec subs[1];
580 subs[0].substitution = (char *) XSTRING_DATA (name);
581 /* #### Motif uses a big hairy default if $XBMLANGPATH isn't set.
582 We don't. If you want it used, set it. */
584 (path = XtResolvePathname (display, "bitmaps", 0, 0, path,
585 subs, XtNumber (subs), 0)))
587 name = build_string (path);
594 if (NILP (Vx_bitmap_file_path))
598 if (XrmGetResource (XtDatabase (display),
599 "bitmapFilePath", "BitmapFilePath", &type, &value)
600 && !strcmp (type, "String"))
601 Vx_bitmap_file_path = decode_env_path (0, (char *) value.addr);
602 Vx_bitmap_file_path = nconc2 (Vx_bitmap_file_path,
603 (decode_path (BITMAPDIR)));
608 if (locate_file (Vx_bitmap_file_path, name, Qnil, &found, R_OK) < 0)
610 Lisp_Object temp = list1 (Vdata_directory);
614 locate_file (temp, name, Qnil, &found, R_OK);
623 locate_pixmap_file (Lisp_Object name)
625 return x_locate_pixmap_file (name);
630 write_lisp_string_to_temp_file (Lisp_Object string, char *filename_out)
632 Lisp_Object instream, outstream;
633 Lstream *istr, *ostr;
634 char tempbuf[1024]; /* some random amount */
637 static Extbyte_dynarr *conversion_out_dynarr;
638 Bytecount bstart, bend;
639 struct gcpro gcpro1, gcpro2;
641 Lisp_Object conv_out_stream;
646 /* This function can GC */
647 if (!conversion_out_dynarr)
648 conversion_out_dynarr = Dynarr_new (Extbyte);
650 Dynarr_reset (conversion_out_dynarr);
652 /* Create the temporary file ... */
653 sprintf (filename_out, "/tmp/emacs%d.XXXXXX", (int) getpid ());
654 mktemp (filename_out);
655 tmpfil = fopen (filename_out, "w");
660 int old_errno = errno;
662 unlink (filename_out);
665 report_file_error ("Creating temp file",
666 list1 (build_string (filename_out)));
669 CHECK_STRING (string);
670 get_string_range_byte (string, Qnil, Qnil, &bstart, &bend,
671 GB_HISTORICAL_STRING_BEHAVIOR);
672 instream = make_lisp_string_input_stream (string, bstart, bend);
673 istr = XLSTREAM (instream);
674 /* setup the out stream */
675 outstream = make_dynarr_output_stream((unsigned_char_dynarr *)conversion_out_dynarr);
676 ostr = XLSTREAM (outstream);
678 /* setup the conversion stream */
679 conv_out_stream = make_encoding_output_stream (ostr, Fget_coding_system(Qbinary));
680 costr = XLSTREAM (conv_out_stream);
681 GCPRO3 (instream, outstream, conv_out_stream);
683 GCPRO2 (instream, outstream);
686 /* Get the data while doing the conversion */
689 ssize_t size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
692 /* It does seem the flushes are necessary... */
694 Lstream_write (costr, tempbuf, size_in_bytes);
695 Lstream_flush (costr);
697 Lstream_write (ostr, tempbuf, size_in_bytes);
699 Lstream_flush (ostr);
700 if (fwrite ((unsigned char *)Dynarr_atp(conversion_out_dynarr, 0),
701 Dynarr_length(conversion_out_dynarr), 1, tmpfil) != 1)
706 /* reset the dynarr */
707 Lstream_rewind(ostr);
710 if (fclose (tmpfil) != 0)
712 Lstream_close (istr);
714 Lstream_close (costr);
716 Lstream_close (ostr);
719 Lstream_delete (istr);
720 Lstream_delete (ostr);
722 Lstream_delete (costr);
726 report_file_error ("Writing temp file",
727 list1 (build_string (filename_out)));
732 /************************************************************************/
733 /* cursor functions */
734 /************************************************************************/
736 /* Check that this server supports cursors of size WIDTH * HEIGHT. If
737 not, signal an error. INSTANTIATOR is only used in the error
741 check_pointer_sizes (Screen *xs, unsigned int width, unsigned int height,
742 Lisp_Object instantiator)
744 unsigned int best_width, best_height;
745 if (! XQueryBestCursor (DisplayOfScreen (xs), RootWindowOfScreen (xs),
746 width, height, &best_width, &best_height))
747 /* this means that an X error of some sort occurred (we trap
748 these so they're not fatal). */
749 signal_simple_error ("XQueryBestCursor() failed?", instantiator);
751 if (width > best_width || height > best_height)
752 error_with_frob (instantiator,
753 "pointer too large (%dx%d): "
754 "server requires %dx%d or smaller",
755 width, height, best_width, best_height);
760 generate_cursor_fg_bg (Lisp_Object device, Lisp_Object *foreground,
761 Lisp_Object *background, XColor *xfg, XColor *xbg)
763 if (!NILP (*foreground) && !COLOR_INSTANCEP (*foreground))
765 Fmake_color_instance (*foreground, device,
766 encode_error_behavior_flag (ERROR_ME));
767 if (COLOR_INSTANCEP (*foreground))
768 *xfg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (*foreground));
772 xfg->red = xfg->green = xfg->blue = 0;
775 if (!NILP (*background) && !COLOR_INSTANCEP (*background))
777 Fmake_color_instance (*background, device,
778 encode_error_behavior_flag (ERROR_ME));
779 if (COLOR_INSTANCEP (*background))
780 *xbg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (*background));
784 xbg->red = xbg->green = xbg->blue = ~0;
789 maybe_recolor_cursor (Lisp_Object image_instance, Lisp_Object foreground,
790 Lisp_Object background)
792 Lisp_Object device = XIMAGE_INSTANCE_DEVICE (image_instance);
795 generate_cursor_fg_bg (device, &foreground, &background, &xfg, &xbg);
796 if (!NILP (foreground) || !NILP (background))
798 XRecolorCursor (DEVICE_X_DISPLAY (XDEVICE (device)),
799 XIMAGE_INSTANCE_X_CURSOR (image_instance),
801 XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
802 XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
807 /************************************************************************/
808 /* color pixmap functions */
809 /************************************************************************/
811 /* Initialize an image instance from an XImage.
813 DEST_MASK specifies the mask of allowed image types.
815 PIXELS and NPIXELS specify an array of pixels that are used in
816 the image. These need to be kept around for the duration of the
817 image. When the image instance is freed, XFreeColors() will
818 automatically be called on all the pixels specified here; thus,
819 you should have allocated the pixels yourself using XAllocColor()
820 or the like. The array passed in is used directly without
821 being copied, so it should be heap data created with xmalloc().
822 It will be freed using xfree() when the image instance is
825 If this fails, signal an error. INSTANTIATOR is only used
826 in the error message.
828 #### This should be able to handle conversion into `pointer'.
829 Use the same code as for `xpm'. */
832 init_image_instance_from_x_image (struct Lisp_Image_Instance *ii,
836 unsigned long *pixels,
839 Lisp_Object instantiator)
841 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
847 if (!DEVICE_X_P (XDEVICE (device)))
848 signal_simple_error ("Not an X device", device);
850 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
851 d = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
853 if (!(dest_mask & IMAGE_COLOR_PIXMAP_MASK))
854 incompatible_image_types (instantiator, dest_mask,
855 IMAGE_COLOR_PIXMAP_MASK);
857 pixmap = XCreatePixmap (dpy, d, ximage->width,
858 ximage->height, ximage->depth);
860 signal_simple_error ("Unable to create pixmap", instantiator);
862 gc = XCreateGC (dpy, pixmap, 0, NULL);
865 XFreePixmap (dpy, pixmap);
866 signal_simple_error ("Unable to create GC", instantiator);
869 XPutImage (dpy, pixmap, gc, ximage, 0, 0, 0, 0,
870 ximage->width, ximage->height);
874 x_initialize_pixmap_image_instance (ii, slices, IMAGE_COLOR_PIXMAP);
876 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
877 find_keyword_in_vector (instantiator, Q_file);
879 /* Fixup a set of pixmaps. */
880 IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
882 IMAGE_INSTANCE_PIXMAP_MASK (ii) = 0;
883 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = ximage->width;
884 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = ximage->height;
885 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = ximage->depth;
886 IMAGE_INSTANCE_X_COLORMAP (ii) = cmap;
887 IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
888 IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
892 image_instance_add_x_image (struct Lisp_Image_Instance *ii,
895 Lisp_Object instantiator)
897 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
903 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
904 d = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
906 pixmap = XCreatePixmap (dpy, d, ximage->width,
907 ximage->height, ximage->depth);
909 signal_simple_error ("Unable to create pixmap", instantiator);
911 gc = XCreateGC (dpy, pixmap, 0, NULL);
914 XFreePixmap (dpy, pixmap);
915 signal_simple_error ("Unable to create GC", instantiator);
918 XPutImage (dpy, pixmap, gc, ximage, 0, 0, 0, 0,
919 ximage->width, ximage->height);
923 IMAGE_INSTANCE_X_PIXMAP_SLICE (ii, slice) = pixmap;
927 x_init_image_instance_from_eimage (struct Lisp_Image_Instance *ii,
928 int width, int height,
930 unsigned char *eimage,
932 Lisp_Object instantiator,
935 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
936 Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device));
937 unsigned long *pixtbl = NULL;
942 for (slice = 0; slice < slices; slice++)
944 ximage = convert_EImage_to_XImage (device, width, height,
945 eimage + (width * height * 3 * slice),
949 if (pixtbl) xfree (pixtbl);
950 signal_image_error("EImage to XImage conversion failed", instantiator);
953 /* Now create the pixmap and set up the image instance */
955 init_image_instance_from_x_image (ii, ximage, dest_mask,
956 cmap, pixtbl, npixels, slices,
959 image_instance_add_x_image (ii, ximage, slice, instantiator);
965 xfree (ximage->data);
968 XDestroyImage (ximage);
974 int read_bitmap_data_from_file (CONST char *filename, unsigned int *width,
975 unsigned int *height, unsigned char **datap,
976 int *x_hot, int *y_hot)
978 return XmuReadBitmapDataFromFile (filename, width, height,
979 datap, x_hot, y_hot);
982 /* Given inline data for a mono pixmap, create and return the
983 corresponding X object. */
986 pixmap_from_xbm_inline (Lisp_Object device, int width, int height,
987 /* Note that data is in ext-format! */
990 return XCreatePixmapFromBitmapData (DEVICE_X_DISPLAY (XDEVICE(device)),
991 XtWindow (DEVICE_XT_APP_SHELL (XDEVICE (device))),
992 (char *) bits, width, height,
996 /* Given inline data for a mono pixmap, initialize the given
997 image instance accordingly. */
1000 init_image_instance_from_xbm_inline (struct Lisp_Image_Instance *ii,
1001 int width, int height,
1002 /* Note that data is in ext-format! */
1004 Lisp_Object instantiator,
1005 Lisp_Object pointer_fg,
1006 Lisp_Object pointer_bg,
1009 Lisp_Object mask_filename)
1011 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1012 Lisp_Object foreground = find_keyword_in_vector (instantiator, Q_foreground);
1013 Lisp_Object background = find_keyword_in_vector (instantiator, Q_background);
1017 enum image_instance_type type;
1019 if (!DEVICE_X_P (XDEVICE (device)))
1020 signal_simple_error ("Not an X device", device);
1022 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1023 draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
1024 scr = DefaultScreenOfDisplay (dpy);
1026 if ((dest_mask & IMAGE_MONO_PIXMAP_MASK) &&
1027 (dest_mask & IMAGE_COLOR_PIXMAP_MASK))
1029 if (!NILP (foreground) || !NILP (background))
1030 type = IMAGE_COLOR_PIXMAP;
1032 type = IMAGE_MONO_PIXMAP;
1034 else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
1035 type = IMAGE_MONO_PIXMAP;
1036 else if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
1037 type = IMAGE_COLOR_PIXMAP;
1038 else if (dest_mask & IMAGE_POINTER_MASK)
1039 type = IMAGE_POINTER;
1041 incompatible_image_types (instantiator, dest_mask,
1042 IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
1043 | IMAGE_POINTER_MASK);
1045 x_initialize_pixmap_image_instance (ii, 1, type);
1046 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = width;
1047 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = height;
1048 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
1049 find_keyword_in_vector (instantiator, Q_file);
1053 case IMAGE_MONO_PIXMAP:
1055 IMAGE_INSTANCE_X_PIXMAP (ii) =
1056 pixmap_from_xbm_inline (device, width, height, (Extbyte *) bits);
1060 case IMAGE_COLOR_PIXMAP:
1062 Dimension d = DEVICE_X_DEPTH (XDEVICE(device));
1063 unsigned long fg = BlackPixelOfScreen (scr);
1064 unsigned long bg = WhitePixelOfScreen (scr);
1066 if (!NILP (foreground) && !COLOR_INSTANCEP (foreground))
1068 Fmake_color_instance (foreground, device,
1069 encode_error_behavior_flag (ERROR_ME));
1071 if (COLOR_INSTANCEP (foreground))
1072 fg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground)).pixel;
1074 if (!NILP (background) && !COLOR_INSTANCEP (background))
1076 Fmake_color_instance (background, device,
1077 encode_error_behavior_flag (ERROR_ME));
1079 if (COLOR_INSTANCEP (background))
1080 bg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background)).pixel;
1082 /* We used to duplicate the pixels using XAllocColor(), to protect
1083 against their getting freed. Just as easy to just store the
1084 color instances here and GC-protect them, so this doesn't
1086 IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
1087 IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
1088 IMAGE_INSTANCE_X_PIXMAP (ii) =
1089 XCreatePixmapFromBitmapData (dpy, draw,
1090 (char *) bits, width, height,
1092 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = d;
1098 XColor fg_color, bg_color;
1101 check_pointer_sizes (scr, width, height, instantiator);
1104 XCreatePixmapFromBitmapData (dpy, draw,
1105 (char *) bits, width, height,
1108 if (NILP (foreground))
1109 foreground = pointer_fg;
1110 if (NILP (background))
1111 background = pointer_bg;
1112 generate_cursor_fg_bg (device, &foreground, &background,
1113 &fg_color, &bg_color);
1115 IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
1116 IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
1117 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) =
1118 find_keyword_in_vector (instantiator, Q_hotspot_x);
1119 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) =
1120 find_keyword_in_vector (instantiator, Q_hotspot_y);
1121 IMAGE_INSTANCE_X_CURSOR (ii) =
1123 (dpy, source, mask, &fg_color, &bg_color,
1124 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ?
1125 XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) : 0,
1126 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) ?
1127 XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) : 0);
1137 xbm_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator,
1138 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1139 int dest_mask, int width, int height,
1140 /* Note that data is in ext-format! */
1143 Lisp_Object mask_data = find_keyword_in_vector (instantiator, Q_mask_data);
1144 Lisp_Object mask_file = find_keyword_in_vector (instantiator, Q_mask_file);
1145 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1147 CONST char *gcc_may_you_rot_in_hell;
1149 if (!NILP (mask_data))
1151 GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (mask_data))),
1152 gcc_may_you_rot_in_hell);
1154 pixmap_from_xbm_inline (IMAGE_INSTANCE_DEVICE (ii),
1155 XINT (XCAR (mask_data)),
1156 XINT (XCAR (XCDR (mask_data))),
1157 (CONST unsigned char *)
1158 gcc_may_you_rot_in_hell);
1161 init_image_instance_from_xbm_inline (ii, width, height, bits,
1162 instantiator, pointer_fg, pointer_bg,
1163 dest_mask, mask, mask_file);
1166 /* Instantiate method for XBM's. */
1169 x_xbm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1170 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1171 int dest_mask, Lisp_Object domain)
1173 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1174 CONST char *gcc_go_home;
1176 assert (!NILP (data));
1178 GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (data))),
1181 xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1182 pointer_bg, dest_mask, XINT (XCAR (data)),
1183 XINT (XCAR (XCDR (data))), gcc_go_home);
1189 /**********************************************************************
1191 **********************************************************************/
1192 /* xpm 3.2g and better has XpmCreatePixmapFromBuffer()...
1193 There was no version number in xpm.h before 3.3, but this should do.
1195 #if (XpmVersion >= 3) || defined(XpmExactColors)
1196 # define XPM_DOES_BUFFERS
1199 #ifndef XPM_DOES_BUFFERS
1200 Your version of XPM is too old. You cannot compile with it.
1201 Upgrade to version 3.2g or better or compile with --with-xpm=no.
1202 #endif /* !XPM_DOES_BUFFERS */
1204 static XpmColorSymbol *
1205 extract_xpm_color_names (XpmAttributes *xpmattrs, Lisp_Object device,
1207 Lisp_Object color_symbol_alist)
1209 /* This function can GC */
1210 Display *dpy = DEVICE_X_DISPLAY (XDEVICE(device));
1211 Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1214 Lisp_Object results = Qnil;
1216 XpmColorSymbol *symbols;
1217 struct gcpro gcpro1, gcpro2;
1219 GCPRO2 (results, device);
1221 /* We built up results to be (("name" . #<color>) ...) so that if an
1222 error happens we don't lose any malloc()ed data, or more importantly,
1223 leave any pixels allocated in the server. */
1225 LIST_LOOP (rest, color_symbol_alist)
1227 Lisp_Object cons = XCAR (rest);
1228 Lisp_Object name = XCAR (cons);
1229 Lisp_Object value = XCDR (cons);
1232 if (STRINGP (value))
1234 Fmake_color_instance
1235 (value, device, encode_error_behavior_flag (ERROR_ME_NOT));
1238 assert (COLOR_SPECIFIERP (value));
1239 value = Fspecifier_instance (value, domain, Qnil, Qnil);
1243 results = noseeum_cons (noseeum_cons (name, value), results);
1246 UNGCPRO; /* no more evaluation */
1248 if (i == 0) return 0;
1250 symbols = xnew_array (XpmColorSymbol, i);
1251 xpmattrs->valuemask |= XpmColorSymbols;
1252 xpmattrs->colorsymbols = symbols;
1253 xpmattrs->numsymbols = i;
1257 Lisp_Object cons = XCAR (results);
1258 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (XCDR (cons)));
1259 /* Duplicate the pixel value so that we still have a lock on it if
1260 the pixel we were passed is later freed. */
1261 if (! XAllocColor (dpy, cmap, &color))
1262 abort (); /* it must be allocable since we're just duplicating it */
1264 symbols [i].name = (char *) XSTRING_DATA (XCAR (cons));
1265 symbols [i].pixel = color.pixel;
1266 symbols [i].value = 0;
1267 free_cons (XCONS (cons));
1269 results = XCDR (results);
1270 free_cons (XCONS (cons));
1276 xpm_free (XpmAttributes *xpmattrs)
1278 /* Could conceivably lose if XpmXXX returned an error without first
1279 initializing this structure, if we didn't know that initializing it
1280 to all zeros was ok (and also that it's ok to call XpmFreeAttributes()
1281 multiple times, since it zeros slots as it frees them...) */
1282 XpmFreeAttributes (xpmattrs);
1286 x_xpm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1287 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1288 int dest_mask, Lisp_Object domain)
1290 /* This function can GC */
1291 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1292 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1293 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1301 XpmAttributes xpmattrs;
1303 XpmColorSymbol *color_symbols;
1304 Lisp_Object color_symbol_alist = find_keyword_in_vector (instantiator,
1306 enum image_instance_type type;
1310 if (!DEVICE_X_P (XDEVICE (device)))
1311 signal_simple_error ("Not an X device", device);
1313 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1314 xs = DefaultScreenOfDisplay (dpy);
1316 if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
1317 type = IMAGE_COLOR_PIXMAP;
1318 else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
1319 type = IMAGE_MONO_PIXMAP;
1320 else if (dest_mask & IMAGE_POINTER_MASK)
1321 type = IMAGE_POINTER;
1323 incompatible_image_types (instantiator, dest_mask,
1324 IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
1325 | IMAGE_POINTER_MASK);
1326 force_mono = (type != IMAGE_COLOR_PIXMAP);
1329 /* Although I haven't found it documented yet, it appears that pointers are
1330 always colored via the default window colormap... Sigh. */
1331 if (type == IMAGE_POINTER)
1333 cmap = DefaultColormap(dpy, DefaultScreen(dpy));
1334 depth = DefaultDepthOfScreen (xs);
1335 visual = DefaultVisualOfScreen (xs);
1339 cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1340 depth = DEVICE_X_DEPTH (XDEVICE(device));
1341 visual = DEVICE_X_VISUAL (XDEVICE(device));
1344 cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1345 depth = DEVICE_X_DEPTH (XDEVICE(device));
1346 visual = DEVICE_X_VISUAL (XDEVICE(device));
1349 x_initialize_pixmap_image_instance (ii, 1, type);
1351 assert (!NILP (data));
1355 xzero (xpmattrs); /* want XpmInitAttributes() */
1356 xpmattrs.valuemask = XpmReturnPixels;
1359 /* Without this, we get a 1-bit version of the color image, which
1360 isn't quite right. With this, we get the mono image, which might
1361 be very different looking. */
1362 xpmattrs.valuemask |= XpmColorKey;
1363 xpmattrs.color_key = XPM_MONO;
1365 xpmattrs.valuemask |= XpmDepth;
1369 xpmattrs.closeness = 65535;
1370 xpmattrs.valuemask |= XpmCloseness;
1371 xpmattrs.depth = depth;
1372 xpmattrs.valuemask |= XpmDepth;
1373 xpmattrs.visual = visual;
1374 xpmattrs.valuemask |= XpmVisual;
1375 xpmattrs.colormap = cmap;
1376 xpmattrs.valuemask |= XpmColormap;
1379 color_symbols = extract_xpm_color_names (&xpmattrs, device, domain,
1380 color_symbol_alist);
1382 result = XpmCreatePixmapFromBuffer (dpy,
1383 XtWindow(DEVICE_XT_APP_SHELL (XDEVICE(device))),
1384 (char *) XSTRING_DATA (data),
1385 &pixmap, &mask, &xpmattrs);
1389 xfree (color_symbols);
1390 xpmattrs.colorsymbols = 0; /* in case XpmFreeAttr is too smart... */
1391 xpmattrs.numsymbols = 0;
1398 case XpmFileInvalid:
1400 xpm_free (&xpmattrs);
1401 signal_image_error ("invalid XPM data", data);
1403 case XpmColorFailed:
1406 xpm_free (&xpmattrs);
1409 /* second time; blow out. */
1410 signal_double_file_error ("Reading pixmap data",
1411 "color allocation failed",
1416 if (! (dest_mask & IMAGE_MONO_PIXMAP_MASK))
1418 /* second time; blow out. */
1419 signal_double_file_error ("Reading pixmap data",
1420 "color allocation failed",
1424 IMAGE_INSTANCE_TYPE (ii) = IMAGE_MONO_PIXMAP;
1430 xpm_free (&xpmattrs);
1431 signal_double_file_error ("Parsing pixmap data",
1432 "out of memory", data);
1436 xpm_free (&xpmattrs);
1437 signal_double_file_error_2 ("Parsing pixmap data",
1438 "unknown error code",
1439 make_int (result), data);
1444 h = xpmattrs.height;
1447 int npixels = xpmattrs.npixels;
1452 pixels = xnew_array (Pixel, npixels);
1453 memcpy (pixels, xpmattrs.pixels, npixels * sizeof (Pixel));
1458 IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
1459 IMAGE_INSTANCE_PIXMAP_MASK (ii) = (void*)mask;
1460 IMAGE_INSTANCE_X_COLORMAP (ii) = cmap;
1461 IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
1462 IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
1463 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = w;
1464 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = h;
1465 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
1466 find_keyword_in_vector (instantiator, Q_file);
1471 case IMAGE_MONO_PIXMAP:
1474 case IMAGE_COLOR_PIXMAP:
1476 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = depth;
1482 int npixels = xpmattrs.npixels;
1483 Pixel *pixels = xpmattrs.pixels;
1486 int xhot = 0, yhot = 0;
1488 if (xpmattrs.valuemask & XpmHotspot)
1490 xhot = xpmattrs.x_hotspot;
1491 XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii), xpmattrs.x_hotspot);
1493 if (xpmattrs.valuemask & XpmHotspot)
1495 yhot = xpmattrs.y_hotspot;
1496 XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii), xpmattrs.y_hotspot);
1498 check_pointer_sizes (xs, w, h, instantiator);
1500 /* If the loaded pixmap has colors allocated (meaning it came from an
1501 XPM file), then use those as the default colors for the cursor we
1502 create. Otherwise, default to pointer_fg and pointer_bg.
1506 /* With an XBM file, it's obvious which bit is foreground
1507 and which is background, or rather, it's implicit: in
1508 an XBM file, a 1 bit is foreground, and a 0 bit is
1511 XCreatePixmapCursor() assumes this property of the
1512 pixmap it is called with as well; the `foreground'
1513 color argument is used for the 1 bits.
1515 With an XPM file, it's tricker, since the elements of
1516 the pixmap don't represent FG and BG, but are actual
1517 pixel values. So we need to figure out which of those
1518 pixels is the foreground color and which is the
1519 background. We do it by comparing RGB and assuming
1520 that the darker color is the foreground. This works
1521 with the result of xbmtopbm|ppmtoxpm, at least.
1523 It might be nice if there was some way to tag the
1524 colors in the XPM file with whether they are the
1525 foreground - perhaps with logical color names somehow?
1527 Once we have decided which color is the foreground, we
1528 need to ensure that that color corresponds to a `1' bit
1529 in the Pixmap. The XPM library wrote into the (1-bit)
1530 pixmap with XPutPixel, which will ignore all but the
1531 least significant bit.
1533 This means that a 1 bit in the image corresponds to
1534 `fg' only if `fg.pixel' is odd.
1536 (This also means that the image will be all the same
1537 color if both `fg' and `bg' are odd or even, but we can
1538 safely assume that that won't happen if the XPM file is
1541 The desired result is that the image use `1' to
1542 represent the foreground color, and `0' to represent
1543 the background color. So, we may need to invert the
1544 image to accomplish this; we invert if fg is
1545 odd. (Remember that WhitePixel and BlackPixel are not
1546 necessarily 1 and 0 respectively, though I think it
1547 might be safe to assume that one of them is always 1
1548 and the other is always 0. We also pretty much need to
1549 assume that one is even and the other is odd.)
1552 fg.pixel = pixels[0]; /* pick a pixel at random. */
1553 bg.pixel = fg.pixel;
1554 for (i = 1; i < npixels; i++) /* Look for an "other" pixel value.*/
1556 bg.pixel = pixels[i];
1557 if (fg.pixel != bg.pixel)
1561 /* If (fg.pixel == bg.pixel) then probably something has
1562 gone wrong, but I don't think signalling an error would
1565 XQueryColor (dpy, cmap, &fg);
1566 XQueryColor (dpy, cmap, &bg);
1568 /* If the foreground is lighter than the background, swap them.
1569 (This occurs semi-randomly, depending on the ordering of the
1570 color list in the XPM file.)
1573 unsigned short fg_total = ((fg.red / 3) + (fg.green / 3)
1575 unsigned short bg_total = ((bg.red / 3) + (bg.green / 3)
1577 if (fg_total > bg_total)
1586 /* If the fg pixel corresponds to a `0' in the bitmap, invert it.
1587 (This occurs (only?) on servers with Black=0, White=1.)
1589 if ((fg.pixel & 1) == 0)
1593 gcv.function = GXxor;
1595 gc = XCreateGC (dpy, pixmap, (GCFunction | GCForeground),
1597 XFillRectangle (dpy, pixmap, gc, 0, 0, w, h);
1603 generate_cursor_fg_bg (device, &pointer_fg, &pointer_bg,
1605 IMAGE_INSTANCE_PIXMAP_FG (ii) = pointer_fg;
1606 IMAGE_INSTANCE_PIXMAP_BG (ii) = pointer_bg;
1609 IMAGE_INSTANCE_X_CURSOR (ii) =
1611 (dpy, pixmap, mask, &fg, &bg, xhot, yhot);
1620 xpm_free (&xpmattrs); /* after we've read pixels and hotspot */
1623 #endif /* HAVE_XPM */
1628 /**********************************************************************
1630 **********************************************************************/
1632 /* This is about to get redefined! */
1635 /* We have to define SYSV32 so that compface.h includes string.h
1636 instead of strings.h. */
1641 #include <compface.h>
1645 /* JMP_BUF cannot be used here because if it doesn't get defined
1646 to jmp_buf we end up with a conflicting type error with the
1647 definition in compface.h */
1648 extern jmp_buf comp_env;
1652 x_xface_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1653 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1654 int dest_mask, Lisp_Object domain)
1656 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1658 char *p, *bits, *bp;
1659 CONST char * volatile emsg = 0;
1660 CONST char * volatile dstring;
1662 assert (!NILP (data));
1664 GET_C_STRING_BINARY_DATA_ALLOCA (data, dstring);
1666 if ((p = strchr (dstring, ':')))
1671 /* Must use setjmp not SETJMP because we used jmp_buf above not JMP_BUF */
1672 if (!(stattis = setjmp (comp_env)))
1674 UnCompAll ((char *) dstring);
1681 emsg = "uncompface: internal error";
1684 emsg = "uncompface: insufficient or invalid data";
1687 emsg = "uncompface: excess data ignored";
1692 signal_simple_error_2 (emsg, data, Qimage);
1694 bp = bits = (char *) alloca (PIXELS / 8);
1696 /* the compface library exports char F[], which uses a single byte per
1697 pixel to represent a 48x48 bitmap. Yuck. */
1698 for (i = 0, p = F; i < (PIXELS / 8); ++i)
1701 /* reverse the bit order of each byte... */
1702 for (b = n = 0; b < 8; ++b)
1709 xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1710 pointer_bg, dest_mask, 48, 48, bits);
1713 #endif /* HAVE_XFACE */
1716 /**********************************************************************
1718 **********************************************************************/
1721 autodetect_validate (Lisp_Object instantiator)
1723 data_must_be_present (instantiator);
1727 autodetect_normalize (Lisp_Object instantiator,
1728 Lisp_Object console_type)
1730 Lisp_Object file = find_keyword_in_vector (instantiator, Q_data);
1731 Lisp_Object filename = Qnil;
1732 Lisp_Object data = Qnil;
1733 struct gcpro gcpro1, gcpro2, gcpro3;
1734 Lisp_Object alist = Qnil;
1736 GCPRO3 (filename, data, alist);
1738 if (NILP (file)) /* no conversion necessary */
1739 RETURN_UNGCPRO (instantiator);
1741 alist = tagged_vector_to_alist (instantiator);
1743 filename = locate_pixmap_file (file);
1744 if (!NILP (filename))
1747 /* #### Apparently some versions of XpmReadFileToData, which is
1748 called by pixmap_to_lisp_data, don't return an error value
1749 if the given file is not a valid XPM file. Instead, they
1750 just seg fault. It is definitely caused by passing a
1751 bitmap. To try and avoid this we check for bitmaps first. */
1753 data = bitmap_to_lisp_data (filename, &xhot, &yhot, 1);
1757 alist = remassq_no_quit (Q_data, alist);
1758 alist = Fcons (Fcons (Q_file, filename),
1759 Fcons (Fcons (Q_data, data), alist));
1761 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
1764 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
1767 alist = xbm_mask_file_munging (alist, filename, Qnil, console_type);
1770 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
1772 RETURN_UNGCPRO (result);
1777 data = pixmap_to_lisp_data (filename, 1);
1781 alist = remassq_no_quit (Q_data, alist);
1782 alist = Fcons (Fcons (Q_file, filename),
1783 Fcons (Fcons (Q_data, data), alist));
1784 alist = Fcons (Fcons (Q_color_symbols,
1785 evaluate_xpm_color_symbols ()),
1788 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
1790 RETURN_UNGCPRO (result);
1796 /* If we couldn't convert it, just put it back as it is.
1797 We might try to further frob it later as a cursor-font
1798 specification. (We can't do that now because we don't know
1799 what dest-types it's going to be instantiated into.) */
1801 Lisp_Object result = alist_to_tagged_vector (Qautodetect, alist);
1803 RETURN_UNGCPRO (result);
1808 autodetect_possible_dest_types (void)
1811 IMAGE_MONO_PIXMAP_MASK |
1812 IMAGE_COLOR_PIXMAP_MASK |
1813 IMAGE_POINTER_MASK |
1818 autodetect_instantiate (Lisp_Object image_instance,
1819 Lisp_Object instantiator,
1820 Lisp_Object pointer_fg,
1821 Lisp_Object pointer_bg,
1822 int dest_mask, Lisp_Object domain)
1824 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1825 struct gcpro gcpro1, gcpro2, gcpro3;
1826 Lisp_Object alist = Qnil;
1827 Lisp_Object result = Qnil;
1828 int is_cursor_font = 0;
1830 GCPRO3 (data, alist, result);
1832 alist = tagged_vector_to_alist (instantiator);
1833 if (dest_mask & IMAGE_POINTER_MASK)
1835 CONST char *name_ext;
1836 GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext);
1837 if (XmuCursorNameToIndex (name_ext) != -1)
1839 result = alist_to_tagged_vector (Qcursor_font, alist);
1844 if (!is_cursor_font)
1845 result = alist_to_tagged_vector (Qstring, alist);
1849 cursor_font_instantiate (image_instance, result, pointer_fg,
1850 pointer_bg, dest_mask, domain);
1852 string_instantiate (image_instance, result, pointer_fg,
1853 pointer_bg, dest_mask, domain);
1859 /**********************************************************************
1861 **********************************************************************/
1864 font_validate (Lisp_Object instantiator)
1866 data_must_be_present (instantiator);
1869 /* XmuCvtStringToCursor is bogus in the following ways:
1871 - When it can't convert the given string to a real cursor, it will
1872 sometimes return a "success" value, after triggering a BadPixmap
1873 error. It then gives you a cursor that will itself generate BadCursor
1874 errors. So we install this error handler to catch/notice the X error
1875 and take that as meaning "couldn't convert."
1877 - When you tell it to find a cursor file that doesn't exist, it prints
1878 an error message on stderr. You can't make it not do that.
1880 - Also, using Xmu means we can't properly hack Lisp_Image_Instance
1881 objects, or XPM files, or $XBMLANGPATH.
1884 /* Duplicate the behavior of XmuCvtStringToCursor() to bypass its bogusness. */
1886 static int XLoadFont_got_error;
1889 XLoadFont_error_handler (Display *dpy, XErrorEvent *xerror)
1891 XLoadFont_got_error = 1;
1896 safe_XLoadFont (Display *dpy, char *name)
1899 int (*old_handler) (Display *, XErrorEvent *);
1900 XLoadFont_got_error = 0;
1902 old_handler = XSetErrorHandler (XLoadFont_error_handler);
1903 font = XLoadFont (dpy, name);
1905 XSetErrorHandler (old_handler);
1906 if (XLoadFont_got_error) return 0;
1911 font_possible_dest_types (void)
1913 return IMAGE_POINTER_MASK;
1917 font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1918 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1919 int dest_mask, Lisp_Object domain)
1921 /* This function can GC */
1922 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1923 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1924 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1928 char source_name[MAXPATHLEN], mask_name[MAXPATHLEN], dummy;
1929 int source_char, mask_char;
1931 Lisp_Object foreground, background;
1933 if (!DEVICE_X_P (XDEVICE (device)))
1934 signal_simple_error ("Not an X device", device);
1936 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1938 if (!STRINGP (data) ||
1939 strncmp ("FONT ", (char *) XSTRING_DATA (data), 5))
1940 signal_simple_error ("Invalid font-glyph instantiator",
1943 if (!(dest_mask & IMAGE_POINTER_MASK))
1944 incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
1946 foreground = find_keyword_in_vector (instantiator, Q_foreground);
1947 if (NILP (foreground))
1948 foreground = pointer_fg;
1949 background = find_keyword_in_vector (instantiator, Q_background);
1950 if (NILP (background))
1951 background = pointer_bg;
1953 generate_cursor_fg_bg (device, &foreground, &background, &fg, &bg);
1955 count = sscanf ((char *) XSTRING_DATA (data),
1956 "FONT %s %d %s %d %c",
1957 source_name, &source_char,
1958 mask_name, &mask_char, &dummy);
1959 /* Allow "%s %d %d" as well... */
1960 if (count == 3 && (1 == sscanf (mask_name, "%d %c", &mask_char, &dummy)))
1961 count = 4, mask_name[0] = 0;
1963 if (count != 2 && count != 4)
1964 signal_simple_error ("invalid cursor specification", data);
1965 source = safe_XLoadFont (dpy, source_name);
1967 signal_simple_error_2 ("couldn't load font",
1968 build_string (source_name),
1972 else if (!mask_name[0])
1976 mask = safe_XLoadFont (dpy, mask_name);
1979 Fsignal (Qerror, list3 (build_string ("couldn't load font"),
1980 build_string (mask_name), data));
1985 /* #### call XQueryTextExtents() and check_pointer_sizes() here. */
1987 x_initialize_pixmap_image_instance (ii, 1, IMAGE_POINTER);
1988 IMAGE_INSTANCE_X_CURSOR (ii) =
1989 XCreateGlyphCursor (dpy, source, mask, source_char, mask_char,
1991 XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
1992 XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
1993 XUnloadFont (dpy, source);
1994 if (mask && mask != source) XUnloadFont (dpy, mask);
1998 /**********************************************************************
2000 **********************************************************************/
2003 cursor_font_validate (Lisp_Object instantiator)
2005 data_must_be_present (instantiator);
2009 cursor_font_possible_dest_types (void)
2011 return IMAGE_POINTER_MASK;
2015 cursor_font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2016 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2017 int dest_mask, Lisp_Object domain)
2019 /* This function can GC */
2020 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
2021 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2022 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
2025 CONST char *name_ext;
2026 Lisp_Object foreground, background;
2028 if (!DEVICE_X_P (XDEVICE (device)))
2029 signal_simple_error ("Not an X device", device);
2031 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2033 if (!(dest_mask & IMAGE_POINTER_MASK))
2034 incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
2036 GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext);
2037 if ((i = XmuCursorNameToIndex (name_ext)) == -1)
2038 signal_simple_error ("Unrecognized cursor-font name", data);
2040 x_initialize_pixmap_image_instance (ii, 1, IMAGE_POINTER);
2041 IMAGE_INSTANCE_X_CURSOR (ii) = XCreateFontCursor (dpy, i);
2042 foreground = find_keyword_in_vector (instantiator, Q_foreground);
2043 if (NILP (foreground))
2044 foreground = pointer_fg;
2045 background = find_keyword_in_vector (instantiator, Q_background);
2046 if (NILP (background))
2047 background = pointer_bg;
2048 maybe_recolor_cursor (image_instance, foreground, background);
2052 x_colorize_image_instance (Lisp_Object image_instance,
2053 Lisp_Object foreground, Lisp_Object background)
2055 struct Lisp_Image_Instance *p;
2057 p = XIMAGE_INSTANCE (image_instance);
2059 switch (IMAGE_INSTANCE_TYPE (p))
2061 case IMAGE_MONO_PIXMAP:
2062 IMAGE_INSTANCE_TYPE (p) = IMAGE_COLOR_PIXMAP;
2063 /* Make sure there aren't two pointers to the same mask, causing
2064 it to get freed twice. */
2065 IMAGE_INSTANCE_PIXMAP_MASK (p) = 0;
2073 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
2074 Drawable draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (IMAGE_INSTANCE_DEVICE (p))));
2075 Dimension d = DEVICE_X_DEPTH (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
2076 Pixmap new = XCreatePixmap (dpy, draw,
2077 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
2078 IMAGE_INSTANCE_PIXMAP_HEIGHT (p), d);
2082 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground));
2083 gcv.foreground = color.pixel;
2084 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background));
2085 gcv.background = color.pixel;
2086 gc = XCreateGC (dpy, new, GCBackground|GCForeground, &gcv);
2087 XCopyPlane (dpy, IMAGE_INSTANCE_X_PIXMAP (p), new, gc, 0, 0,
2088 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
2089 IMAGE_INSTANCE_PIXMAP_HEIGHT (p),
2092 IMAGE_INSTANCE_X_PIXMAP (p) = new;
2093 IMAGE_INSTANCE_PIXMAP_DEPTH (p) = d;
2094 IMAGE_INSTANCE_PIXMAP_FG (p) = foreground;
2095 IMAGE_INSTANCE_PIXMAP_BG (p) = background;
2101 /************************************************************************/
2102 /* subwindow and widget support */
2103 /************************************************************************/
2105 /* unmap the image if it is a widget. This is used by redisplay via
2106 redisplay_unmap_subwindows */
2108 x_unmap_subwindow (struct Lisp_Image_Instance *p)
2110 if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
2113 (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2114 IMAGE_INSTANCE_X_CLIPWINDOW (p));
2116 else /* must be a widget */
2118 XtUnmapWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p));
2122 /* map the subwindow. This is used by redisplay via
2123 redisplay_output_subwindow */
2125 x_map_subwindow (struct Lisp_Image_Instance *p, int x, int y,
2126 struct display_glyph_area* dga)
2128 if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
2130 Window subwindow = IMAGE_INSTANCE_X_SUBWINDOW_ID (p);
2131 XMoveResizeWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2132 IMAGE_INSTANCE_X_CLIPWINDOW (p),
2133 x, y, dga->width, dga->height);
2134 XMoveWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2135 subwindow, -dga->xoffset, -dga->yoffset);
2136 XMapWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2137 IMAGE_INSTANCE_X_CLIPWINDOW (p));
2139 else /* must be a widget */
2141 XtConfigureWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p),
2142 x + IMAGE_INSTANCE_X_WIDGET_XOFFSET (p),
2143 y + IMAGE_INSTANCE_X_WIDGET_YOFFSET (p),
2144 dga->width, dga->height, 0);
2145 XtMoveWidget (IMAGE_INSTANCE_X_WIDGET_ID (p),
2146 -dga->xoffset, -dga->yoffset);
2147 XtMapWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p));
2151 /* when you click on a widget you may activate another widget this
2152 needs to be checked and all appropriate widgets updated */
2154 x_update_subwindow (struct Lisp_Image_Instance *p)
2157 if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET)
2160 widget_value* wv = gui_items_to_widget_values
2161 (IMAGE_INSTANCE_WIDGET_ITEMS (p));
2163 /* This seems ugly, but I'm not sure what else to do. */
2164 if (EQ (IMAGE_INSTANCE_WIDGET_TYPE (p), Qtab_control))
2166 widget_value* cur = 0;
2167 /* Give each child label the correct foreground color. */
2168 Lisp_Object pixel = FACE_FOREGROUND
2169 (IMAGE_INSTANCE_WIDGET_FACE (p),
2170 IMAGE_INSTANCE_SUBWINDOW_FRAME (p));
2171 XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2172 XtSetArg (al [0], XtNtabForeground, fcolor.pixel);
2174 for (cur = wv->contents; cur; cur = cur->next)
2184 /* now modify the widget */
2185 lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (p),
2187 free_widget_value_tree (wv);
2188 /* update the colors and font */
2189 update_widget_face (p, IMAGE_INSTANCE_SUBWINDOW_FRAME (p));
2190 /* We have to do this otherwise Motif will unceremoniously
2191 resize us when the label gets set. */
2192 XtSetArg (al [0], XtNwidth, IMAGE_INSTANCE_WIDGET_WIDTH (p));
2193 XtSetArg (al [1], XtNheight, IMAGE_INSTANCE_WIDGET_HEIGHT (p));
2194 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (p), al, 2);
2199 /* instantiate and x type subwindow */
2201 x_subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2202 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2203 int dest_mask, Lisp_Object domain)
2205 /* This function can GC */
2206 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2207 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
2208 Lisp_Object frame = FW_FRAME (domain);
2209 struct frame* f = XFRAME (frame);
2213 XSetWindowAttributes xswa;
2215 unsigned int w = IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii),
2216 h = IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii);
2218 if (!DEVICE_X_P (XDEVICE (device)))
2219 signal_simple_error ("Not an X device", device);
2221 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2222 xs = DefaultScreenOfDisplay (dpy);
2224 IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW;
2226 pw = XtWindow (FRAME_X_TEXT_WIDGET (f));
2228 ii->data = xnew_and_zero (struct x_subwindow_data);
2230 IMAGE_INSTANCE_X_SUBWINDOW_PARENT (ii) = pw;
2231 IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (ii) = DisplayOfScreen (xs);
2233 xswa.backing_store = Always;
2234 valueMask |= CWBackingStore;
2235 xswa.colormap = DefaultColormapOfScreen (xs);
2236 valueMask |= CWColormap;
2238 /* Create a window for clipping */
2239 IMAGE_INSTANCE_X_CLIPWINDOW (ii) =
2240 XCreateWindow (dpy, pw, 0, 0, w, h, 0, CopyFromParent,
2241 InputOutput, CopyFromParent, valueMask,
2244 /* Now put the subwindow inside the clip window. */
2245 win = XCreateWindow (dpy, IMAGE_INSTANCE_X_CLIPWINDOW (ii),
2246 0, 0, w, h, 0, CopyFromParent,
2247 InputOutput, CopyFromParent, valueMask,
2250 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)win;
2254 /* #### Should this function exist? If there's any doubt I'm not implementing it --andyp */
2255 DEFUN ("change-subwindow-property", Fchange_subwindow_property, 3, 3, 0, /*
2256 For the given SUBWINDOW, set PROPERTY to DATA, which is a string.
2257 Subwindows are not currently implemented.
2259 (subwindow, property, data))
2262 struct Lisp_Subwindow *sw;
2265 CHECK_SUBWINDOW (subwindow);
2266 CHECK_STRING (property);
2267 CHECK_STRING (data);
2269 sw = XSUBWINDOW (subwindow);
2270 dpy = DisplayOfScreen (LISP_DEVICE_TO_X_SCREEN
2271 (FRAME_DEVICE (XFRAME (sw->frame))));
2273 property_atom = XInternAtom (dpy, (char *) XSTRING_DATA (property), False);
2274 XChangeProperty (dpy, sw->subwindow, property_atom, XA_STRING, 8,
2276 XSTRING_DATA (data),
2277 XSTRING_LENGTH (data));
2284 x_resize_subwindow (struct Lisp_Image_Instance* ii, int w, int h)
2286 if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
2288 XResizeWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (ii),
2289 IMAGE_INSTANCE_X_SUBWINDOW_ID (ii),
2292 else /* must be a widget */
2296 if (!XtIsRealized (IMAGE_INSTANCE_X_WIDGET_ID (ii)))
2299 XSETIMAGE_INSTANCE (sw, ii);
2300 signal_simple_error ("XEmacs bug: subwindow is not realized", sw);
2303 XtSetArg (al [0], XtNwidth, (Dimension)w);
2304 XtSetArg (al [1], XtNheight, (Dimension)h);
2305 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 2);
2312 /************************************************************************/
2314 /************************************************************************/
2317 update_widget_face (struct Lisp_Image_Instance* ii, Lisp_Object domain)
2320 #ifdef LWLIB_WIDGETS_MOTIF
2321 XmFontList fontList;
2324 Lisp_Object pixel = FACE_FOREGROUND
2325 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2326 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2327 XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2330 pixel = FACE_BACKGROUND
2331 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2332 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2333 bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2335 XtSetArg (al [0], XtNbackground, bcolor.pixel);
2336 XtSetArg (al [1], XtNforeground, fcolor.pixel);
2338 #ifdef LWLIB_WIDGETS_MOTIF
2339 fontList = XmFontListCreate
2340 (FONT_INSTANCE_X_FONT
2341 (XFONT_INSTANCE (widget_face_font_info
2342 (domain, IMAGE_INSTANCE_WIDGET_FACE (ii),
2343 0, 0))), XmSTRING_DEFAULT_CHARSET);
2344 XtSetArg (al [2], XmNfontList, fontList );
2346 XtSetArg (al [2], XtNfont, (void*)FONT_INSTANCE_X_FONT
2347 (XFONT_INSTANCE (widget_face_font_info
2349 IMAGE_INSTANCE_WIDGET_FACE (ii),
2352 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 3);
2353 #ifdef LWLIB_WIDGETS_MOTIF
2354 XmFontListFree (fontList);
2359 x_widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2360 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2361 int dest_mask, Lisp_Object domain,
2362 CONST char* type, widget_value* wv)
2364 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2365 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii), pixel;
2366 struct device* d = XDEVICE (device);
2367 Lisp_Object frame = FW_FRAME (domain);
2368 struct frame* f = XFRAME (frame);
2373 int id = new_lwlib_id ();
2374 widget_value* clip_wv;
2375 XColor fcolor, bcolor;
2377 if (!DEVICE_X_P (d))
2378 signal_simple_error ("Not an X device", device);
2380 /* have to set the type this late in case there is no device
2381 instantiation for a widget. But we can go ahead and do it without
2382 checking because there is always a generic instantiator. */
2383 IMAGE_INSTANCE_TYPE (ii) = IMAGE_WIDGET;
2385 if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
2386 GET_C_STRING_OS_DATA_ALLOCA (IMAGE_INSTANCE_WIDGET_TEXT (ii), nm);
2388 ii->data = xnew_and_zero (struct x_subwindow_data);
2390 /* Create a clip window to contain the subwidget. Incredibly the
2391 XEmacs manager seems to be the most appropriate widget for
2392 this. Nothing else is simple enough and yet does what is
2394 clip_wv = xmalloc_widget_value ();
2396 XtSetArg (al [ac], XtNresize, False); ac++;
2397 XtSetArg (al [ac], XtNwidth,
2398 (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii)); ac++;
2399 XtSetArg (al [ac], XtNheight,
2400 (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); ac++;
2402 clip_wv->enabled = True;
2403 clip_wv->nargs = ac;
2405 clip_wv->name = xstrdup ("clip-window");
2406 clip_wv->value = xstrdup ("clip-window");
2408 IMAGE_INSTANCE_X_CLIPWIDGET (ii)
2409 = lw_create_widget ("clip-window", "clip-window", new_lwlib_id (),
2410 clip_wv, FRAME_X_CONTAINER_WIDGET (f),
2413 free_widget_value_tree (clip_wv);
2415 /* copy any args we were given */
2419 lw_add_value_args_to_args (wv, al, &ac);
2421 /* Fixup the colors. We have to do this *before* the widget gets
2422 created so that Motif will fix up the shadow colors
2423 correctly. Once the widget is created Motif won't do this
2425 pixel = FACE_FOREGROUND
2426 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2427 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2428 fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2430 pixel = FACE_BACKGROUND
2431 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2432 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2433 bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2435 XtSetArg (al [ac], XtNbackground, bcolor.pixel); ac++;
2436 XtSetArg (al [ac], XtNforeground, fcolor.pixel); ac++;
2437 /* we cannot allow widgets to resize themselves */
2438 XtSetArg (al [ac], XtNresize, False); ac++;
2439 XtSetArg (al [ac], XtNwidth,
2440 (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii)); ac++;
2441 XtSetArg (al [ac], XtNheight,
2442 (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); ac++;
2447 wid = lw_create_widget (type, wv->name, id, wv, IMAGE_INSTANCE_X_CLIPWIDGET (ii),
2448 False, 0, popup_selection_callback, 0);
2450 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)wid;
2451 IMAGE_INSTANCE_X_WIDGET_LWID (ii) = id;
2453 /* update the font. */
2454 update_widget_face (ii, domain);
2456 /* Resize the widget here so that the values do not get copied by
2459 XtSetArg (al [ac], XtNwidth,
2460 (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii)); ac++;
2461 XtSetArg (al [ac], XtNheight,
2462 (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); ac++;
2463 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, ac);
2464 /* because the EmacsManager is the widgets parent we have to
2465 offset the redisplay of the widget by the amount the text
2466 widget is inside the manager. */
2468 XtSetArg (al [ac], XtNx, &IMAGE_INSTANCE_X_WIDGET_XOFFSET (ii)); ac++;
2469 XtSetArg (al [ac], XtNy, &IMAGE_INSTANCE_X_WIDGET_YOFFSET (ii)); ac++;
2470 XtGetValues (FRAME_X_TEXT_WIDGET (f), al, ac);
2474 free_widget_value_tree (wv);
2478 x_widget_set_property (Lisp_Object image_instance, Lisp_Object prop,
2481 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2483 if (EQ (prop, Q_text))
2486 widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2488 GET_C_STRING_OS_DATA_ALLOCA (val, str);
2490 lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, False);
2493 /* Modify the face properties of the widget */
2494 if (EQ (prop, Q_face))
2496 update_widget_face (ii, IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2502 /* get properties of a control */
2504 x_widget_property (Lisp_Object image_instance, Lisp_Object prop)
2506 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2507 /* get the text from a control */
2508 if (EQ (prop, Q_text))
2510 widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2511 return build_ext_string (wv->value, FORMAT_OS);
2516 /* Instantiate a button widget. Unfortunately instantiated widgets are
2517 particular to a frame since they need to have a parent. It's not
2518 like images where you just select the image into the context you
2519 want to display it in and BitBlt it. So images instances can have a
2520 many-to-one relationship with things you see, whereas widgets can
2521 only be one-to-one (i.e. per frame) */
2523 x_button_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2524 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2525 int dest_mask, Lisp_Object domain)
2527 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2528 Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2529 Lisp_Object glyph = find_keyword_in_vector (instantiator, Q_image);
2530 widget_value* wv = xmalloc_widget_value ();
2532 button_item_to_widget_value (gui, wv, 1, 1);
2536 if (!IMAGE_INSTANCEP (glyph))
2537 glyph = glyph_image_instance (glyph, domain, ERROR_ME, 1);
2540 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2541 pointer_bg, dest_mask, domain, "button", wv);
2543 /* add the image if one was given */
2544 if (!NILP (glyph) && IMAGE_INSTANCEP (glyph))
2548 #ifdef LWLIB_WIDGETS_MOTIF
2549 XtSetArg (al [ac], XmNlabelType, XmPIXMAP); ac++;
2550 XtSetArg (al [ac], XmNlabelPixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph));ac++;
2552 XtSetArg (al [ac], XtNpixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph)); ac++;
2554 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, ac);
2558 /* get properties of a button */
2560 x_button_property (Lisp_Object image_instance, Lisp_Object prop)
2562 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2563 /* check the state of a button */
2564 if (EQ (prop, Q_selected))
2566 widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2576 /* instantiate a progress gauge */
2578 x_progress_gauge_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2579 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2580 int dest_mask, Lisp_Object domain)
2582 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2583 Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2584 widget_value* wv = xmalloc_widget_value ();
2586 button_item_to_widget_value (gui, wv, 1, 1);
2588 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2589 pointer_bg, dest_mask, domain, "progress", wv);
2592 /* set the properties of a progres guage */
2594 x_progress_gauge_set_property (Lisp_Object image_instance, Lisp_Object prop,
2597 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2599 if (EQ (prop, Q_percent))
2603 XtSetArg (al[0], XtNvalue, XINT (val));
2604 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 1);
2610 /* instantiate an edit control */
2612 x_edit_field_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2613 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2614 int dest_mask, Lisp_Object domain)
2616 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2617 Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2618 widget_value* wv = xmalloc_widget_value ();
2620 button_item_to_widget_value (gui, wv, 1, 1);
2622 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2623 pointer_bg, dest_mask, domain, "text-field", wv);
2626 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
2627 /* instantiate a combo control */
2629 x_combo_box_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2630 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2631 int dest_mask, Lisp_Object domain)
2633 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2634 widget_value * wv = 0;
2635 /* This is not done generically because of sizing problems under
2637 widget_instantiate_1 (image_instance, instantiator, pointer_fg,
2638 pointer_bg, dest_mask, domain, 1, 0, 0);
2640 wv = gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2642 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2643 pointer_bg, dest_mask, domain, "combo-box", wv);
2648 x_tab_control_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2649 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2650 int dest_mask, Lisp_Object domain)
2652 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2659 gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2661 /* Give each child label the correct foreground color. */
2662 pixel = FACE_FOREGROUND
2663 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2664 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2665 fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2666 XtSetArg (al [0], XtNtabForeground, fcolor.pixel);
2668 for (cur = wv->contents; cur; cur = cur->next)
2677 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2678 pointer_bg, dest_mask, domain, "tab-control", wv);
2681 /* set the properties of a tab control */
2683 x_tab_control_set_property (Lisp_Object image_instance, Lisp_Object prop,
2686 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2688 if (EQ (prop, Q_items))
2690 widget_value * wv = 0, *cur;
2695 check_valid_item_list_1 (val);
2697 IMAGE_INSTANCE_WIDGET_ITEMS (ii) =
2698 Fcons (XCAR (IMAGE_INSTANCE_WIDGET_ITEMS (ii)),
2699 parse_gui_item_tree_children (val));
2701 wv = gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2703 /* Give each child label the correct foreground color. */
2704 pixel = FACE_FOREGROUND
2705 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2706 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2707 fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2708 XtSetArg (al [0], XtNtabForeground, fcolor.pixel);
2710 for (cur = wv->contents; cur; cur = cur->next)
2719 lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, True);
2721 free_widget_value_tree (wv);
2728 /* instantiate a static control possible for putting other things in */
2730 x_label_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2731 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2732 int dest_mask, Lisp_Object domain)
2734 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2735 Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2736 widget_value* wv = xmalloc_widget_value ();
2738 button_item_to_widget_value (gui, wv, 1, 1);
2740 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2741 pointer_bg, dest_mask, domain, "button", wv);
2743 #endif /* HAVE_WIDGETS */
2746 /************************************************************************/
2747 /* initialization */
2748 /************************************************************************/
2751 syms_of_glyphs_x (void)
2754 DEFSUBR (Fchange_subwindow_property);
2759 console_type_create_glyphs_x (void)
2763 CONSOLE_HAS_METHOD (x, print_image_instance);
2764 CONSOLE_HAS_METHOD (x, finalize_image_instance);
2765 CONSOLE_HAS_METHOD (x, image_instance_equal);
2766 CONSOLE_HAS_METHOD (x, image_instance_hash);
2767 CONSOLE_HAS_METHOD (x, colorize_image_instance);
2768 CONSOLE_HAS_METHOD (x, init_image_instance_from_eimage);
2769 CONSOLE_HAS_METHOD (x, locate_pixmap_file);
2770 CONSOLE_HAS_METHOD (x, unmap_subwindow);
2771 CONSOLE_HAS_METHOD (x, map_subwindow);
2772 CONSOLE_HAS_METHOD (x, resize_subwindow);
2773 CONSOLE_HAS_METHOD (x, update_subwindow);
2777 image_instantiator_format_create_glyphs_x (void)
2779 IIFORMAT_VALID_CONSOLE (x, nothing);
2780 IIFORMAT_VALID_CONSOLE (x, string);
2781 IIFORMAT_VALID_CONSOLE (x, layout);
2782 IIFORMAT_VALID_CONSOLE (x, formatted_string);
2783 IIFORMAT_VALID_CONSOLE (x, inherit);
2785 INITIALIZE_DEVICE_IIFORMAT (x, xpm);
2786 IIFORMAT_HAS_DEVMETHOD (x, xpm, instantiate);
2789 IIFORMAT_VALID_CONSOLE (x, jpeg);
2792 IIFORMAT_VALID_CONSOLE (x, tiff);
2795 IIFORMAT_VALID_CONSOLE (x, png);
2798 IIFORMAT_VALID_CONSOLE (x, gif);
2800 INITIALIZE_DEVICE_IIFORMAT (x, xbm);
2801 IIFORMAT_HAS_DEVMETHOD (x, xbm, instantiate);
2803 INITIALIZE_DEVICE_IIFORMAT (x, subwindow);
2804 IIFORMAT_HAS_DEVMETHOD (x, subwindow, instantiate);
2807 INITIALIZE_DEVICE_IIFORMAT (x, button);
2808 IIFORMAT_HAS_DEVMETHOD (x, button, property);
2809 IIFORMAT_HAS_DEVMETHOD (x, button, instantiate);
2811 INITIALIZE_DEVICE_IIFORMAT (x, widget);
2812 IIFORMAT_HAS_DEVMETHOD (x, widget, property);
2813 IIFORMAT_HAS_DEVMETHOD (x, widget, set_property);
2814 /* progress gauge */
2815 INITIALIZE_DEVICE_IIFORMAT (x, progress_gauge);
2816 IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, set_property);
2817 IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, instantiate);
2819 INITIALIZE_DEVICE_IIFORMAT (x, edit_field);
2820 IIFORMAT_HAS_DEVMETHOD (x, edit_field, instantiate);
2821 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
2823 INITIALIZE_DEVICE_IIFORMAT (x, combo_box);
2824 IIFORMAT_HAS_DEVMETHOD (x, combo_box, instantiate);
2825 IIFORMAT_HAS_SHARED_DEVMETHOD (x, combo_box, set_property, tab_control);
2827 /* tab control widget */
2828 INITIALIZE_DEVICE_IIFORMAT (x, tab_control);
2829 IIFORMAT_HAS_DEVMETHOD (x, tab_control, instantiate);
2830 IIFORMAT_HAS_DEVMETHOD (x, tab_control, set_property);
2832 INITIALIZE_DEVICE_IIFORMAT (x, label);
2833 IIFORMAT_HAS_DEVMETHOD (x, label, instantiate);
2835 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (cursor_font, "cursor-font");
2836 IIFORMAT_VALID_CONSOLE (x, cursor_font);
2838 IIFORMAT_HAS_METHOD (cursor_font, validate);
2839 IIFORMAT_HAS_METHOD (cursor_font, possible_dest_types);
2840 IIFORMAT_HAS_METHOD (cursor_font, instantiate);
2842 IIFORMAT_VALID_KEYWORD (cursor_font, Q_data, check_valid_string);
2843 IIFORMAT_VALID_KEYWORD (cursor_font, Q_foreground, check_valid_string);
2844 IIFORMAT_VALID_KEYWORD (cursor_font, Q_background, check_valid_string);
2846 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (font, "font");
2848 IIFORMAT_HAS_METHOD (font, validate);
2849 IIFORMAT_HAS_METHOD (font, possible_dest_types);
2850 IIFORMAT_HAS_METHOD (font, instantiate);
2851 IIFORMAT_VALID_CONSOLE (x, font);
2853 IIFORMAT_VALID_KEYWORD (font, Q_data, check_valid_string);
2854 IIFORMAT_VALID_KEYWORD (font, Q_foreground, check_valid_string);
2855 IIFORMAT_VALID_KEYWORD (font, Q_background, check_valid_string);
2858 INITIALIZE_DEVICE_IIFORMAT (x, xface);
2859 IIFORMAT_HAS_DEVMETHOD (x, xface, instantiate);
2862 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (autodetect,
2865 IIFORMAT_HAS_METHOD (autodetect, validate);
2866 IIFORMAT_HAS_METHOD (autodetect, normalize);
2867 IIFORMAT_HAS_METHOD (autodetect, possible_dest_types);
2868 IIFORMAT_HAS_METHOD (autodetect, instantiate);
2869 IIFORMAT_VALID_CONSOLE (x, autodetect);
2871 IIFORMAT_VALID_KEYWORD (autodetect, Q_data, check_valid_string);
2875 vars_of_glyphs_x (void)
2877 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path /*
2878 A list of the directories in which X bitmap files may be found.
2879 If nil, this is initialized from the "*bitmapFilePath" resource.
2880 This is used by the `make-image-instance' function (however, note that if
2881 the environment variable XBMLANGPATH is set, it is consulted first).
2883 Vx_bitmap_file_path = Qnil;
2887 complex_vars_of_glyphs_x (void)
2889 #define BUILD_GLYPH_INST(variable, name) \
2890 Fadd_spec_to_specifier \
2891 (GLYPH_IMAGE (XGLYPH (variable)), \
2892 vector3 (Qxbm, Q_data, \
2893 list3 (make_int (name##_width), \
2894 make_int (name##_height), \
2895 make_ext_string (name##_bits, \
2896 sizeof (name##_bits), \
2900 BUILD_GLYPH_INST (Vtruncation_glyph, truncator);
2901 BUILD_GLYPH_INST (Vcontinuation_glyph, continuer);
2902 BUILD_GLYPH_INST (Vxemacs_logo, xemacs);
2903 BUILD_GLYPH_INST (Vhscroll_glyph, hscroll);
2905 #undef BUILD_GLYPH_INST