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 Convert images.el to C and stick it in here?
53 #include "console-x.h"
55 #include "objects-x.h"
76 #include "file-coding.h"
79 #ifdef LWLIB_WIDGETS_MOTIF
82 #include <X11/IntrinsicP.h>
85 # define FOUR_BYTE_TYPE unsigned int
87 # define FOUR_BYTE_TYPE unsigned long
89 # define FOUR_BYTE_TYPE unsigned short
91 #error What kind of strange-ass system are we running on?
94 #define LISP_DEVICE_TO_X_SCREEN(dev) XDefaultScreenOfDisplay (DEVICE_X_DISPLAY (XDEVICE (dev)))
96 DECLARE_IMAGE_INSTANTIATOR_FORMAT (nothing);
97 DECLARE_IMAGE_INSTANTIATOR_FORMAT (string);
98 DECLARE_IMAGE_INSTANTIATOR_FORMAT (formatted_string);
99 DECLARE_IMAGE_INSTANTIATOR_FORMAT (inherit);
100 DECLARE_IMAGE_INSTANTIATOR_FORMAT (layout);
102 DECLARE_IMAGE_INSTANTIATOR_FORMAT (jpeg);
105 DECLARE_IMAGE_INSTANTIATOR_FORMAT (tiff);
108 DECLARE_IMAGE_INSTANTIATOR_FORMAT (png);
111 DECLARE_IMAGE_INSTANTIATOR_FORMAT (gif);
114 DEFINE_DEVICE_IIFORMAT (x, xpm);
116 DEFINE_DEVICE_IIFORMAT (x, xbm);
117 DEFINE_DEVICE_IIFORMAT (x, subwindow);
119 DEFINE_DEVICE_IIFORMAT (x, xface);
122 DEFINE_IMAGE_INSTANTIATOR_FORMAT (cursor_font);
123 Lisp_Object Qcursor_font;
125 DEFINE_IMAGE_INSTANTIATOR_FORMAT (font);
127 DEFINE_IMAGE_INSTANTIATOR_FORMAT (autodetect);
130 DEFINE_DEVICE_IIFORMAT (x, widget);
131 DEFINE_DEVICE_IIFORMAT (x, button);
132 DEFINE_DEVICE_IIFORMAT (x, progress_gauge);
133 DEFINE_DEVICE_IIFORMAT (x, edit_field);
134 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
135 DEFINE_DEVICE_IIFORMAT (x, combo_box);
137 DEFINE_DEVICE_IIFORMAT (x, tab_control);
138 DEFINE_DEVICE_IIFORMAT (x, label);
141 static void cursor_font_instantiate (Lisp_Object image_instance,
142 Lisp_Object instantiator,
143 Lisp_Object pointer_fg,
144 Lisp_Object pointer_bg,
150 update_widget_face (struct Lisp_Image_Instance* ii, Lisp_Object domain);
156 /************************************************************************/
157 /* image instance methods */
158 /************************************************************************/
160 /************************************************************************/
161 /* convert from a series of RGB triples to an XImage formated for the */
163 /************************************************************************/
165 convert_EImage_to_XImage (Lisp_Object device, int width, int height,
166 unsigned char *pic, unsigned long **pixtbl,
173 int depth, bitmap_pad, bits_per_pixel, byte_cnt, i, j;
175 unsigned char *data, *ip, *dp;
176 quant_table *qtable = 0;
182 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
183 cmap = DEVICE_X_COLORMAP (XDEVICE(device));
184 vis = DEVICE_X_VISUAL (XDEVICE(device));
185 depth = DEVICE_X_DEPTH(XDEVICE(device));
187 if (vis->class == PseudoColor)
189 /* Quantize the image and get a histogram while we're at it.
190 Do this first to save memory */
191 qtable = build_EImage_quantable(pic, width, height, 256);
192 if (qtable == NULL) return NULL;
195 bitmap_pad = ((depth > 16) ? 32 :
199 outimg = XCreateImage (dpy, vis,
200 depth, ZPixmap, 0, 0, width, height,
202 if (!outimg) return NULL;
204 bits_per_pixel = outimg->bits_per_pixel;
205 byte_cnt = bits_per_pixel >> 3;
207 data = (unsigned char *) xmalloc (outimg->bytes_per_line * height);
210 XDestroyImage (outimg);
213 outimg->data = (char *) data;
215 if (vis->class == PseudoColor)
217 unsigned long pixarray[256];
219 /* use our quantize table to allocate the colors */
221 *pixtbl = xnew_array (unsigned long, pixcount);
224 /* ### should implement a sort by popularity to assure proper allocation */
226 for (i = 0; i < qtable->num_active_colors; i++)
231 color.red = qtable->rm[i] ? qtable->rm[i] << 8 : 0;
232 color.green = qtable->gm[i] ? qtable->gm[i] << 8 : 0;
233 color.blue = qtable->bm[i] ? qtable->bm[i] << 8 : 0;
234 color.flags = DoRed | DoGreen | DoBlue;
235 res = allocate_nearest_color (dpy, cmap, vis, &color);
236 if (res > 0 && res < 3)
238 DO_REALLOC(*pixtbl, pixcount, n+1, unsigned long);
239 (*pixtbl)[n] = color.pixel;
242 pixarray[i] = color.pixel;
246 for (i = 0; i < height; i++)
248 dp = data + (i * outimg->bytes_per_line);
249 for (j = 0; j < width; j++)
254 conv.val = pixarray[QUANT_GET_COLOR(qtable,rd,gr,bl)];
256 if (outimg->byte_order == MSBFirst)
257 for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q];
259 for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q];
261 if (outimg->byte_order == MSBFirst)
262 for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q];
264 for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q];
270 unsigned long rshift,gshift,bshift,rbits,gbits,bbits,junk;
271 junk = vis->red_mask;
273 while ((junk & 0x1) == 0)
284 junk = vis->green_mask;
286 while ((junk & 0x1) == 0)
297 junk = vis->blue_mask;
299 while ((junk & 0x1) == 0)
311 for (i = 0; i < height; i++)
313 dp = data + (i * outimg->bytes_per_line);
314 for (j = 0; j < width; j++)
317 rd = *ip++ << (rbits - 8);
319 rd = *ip++ >> (8 - rbits);
321 gr = *ip++ << (gbits - 8);
323 gr = *ip++ >> (8 - gbits);
325 bl = *ip++ << (bbits - 8);
327 bl = *ip++ >> (8 - bbits);
329 conv.val = (rd << rshift) | (gr << gshift) | (bl << bshift);
331 if (outimg->byte_order == MSBFirst)
332 for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q];
334 for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q];
336 if (outimg->byte_order == MSBFirst)
337 for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q];
339 for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q];
350 x_print_image_instance (struct Lisp_Image_Instance *p,
351 Lisp_Object printcharfun,
356 switch (IMAGE_INSTANCE_TYPE (p))
358 case IMAGE_MONO_PIXMAP:
359 case IMAGE_COLOR_PIXMAP:
361 sprintf (buf, " (0x%lx", (unsigned long) IMAGE_INSTANCE_X_PIXMAP (p));
362 write_c_string (buf, printcharfun);
363 if (IMAGE_INSTANCE_X_MASK (p))
365 sprintf (buf, "/0x%lx", (unsigned long) IMAGE_INSTANCE_X_MASK (p));
366 write_c_string (buf, printcharfun);
368 write_c_string (")", printcharfun);
376 extern int debug_widget_instances;
380 x_finalize_image_instance (struct Lisp_Image_Instance *p)
385 if (DEVICE_LIVE_P (XDEVICE (p->device)))
387 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (p->device));
389 if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET)
391 if (IMAGE_INSTANCE_SUBWINDOW_ID (p))
394 debug_widget_instances--;
395 stderr_out ("widget destroyed, %d left\n", debug_widget_instances);
397 lw_destroy_widget (IMAGE_INSTANCE_X_WIDGET_ID (p));
398 lw_destroy_widget (IMAGE_INSTANCE_X_CLIPWIDGET (p));
399 IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0;
402 else if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
404 if (IMAGE_INSTANCE_SUBWINDOW_ID (p))
405 XDestroyWindow (dpy, IMAGE_INSTANCE_X_SUBWINDOW_ID (p));
406 IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0;
411 if (IMAGE_INSTANCE_PIXMAP_TIMEOUT (p))
412 disable_glyph_animated_timeout (IMAGE_INSTANCE_PIXMAP_TIMEOUT (p));
414 if (IMAGE_INSTANCE_X_MASK (p) &&
415 IMAGE_INSTANCE_X_MASK (p) != IMAGE_INSTANCE_X_PIXMAP (p))
416 XFreePixmap (dpy, IMAGE_INSTANCE_X_MASK (p));
417 IMAGE_INSTANCE_PIXMAP_MASK (p) = 0;
419 if (IMAGE_INSTANCE_X_PIXMAP_SLICES (p))
421 for (i = 0; i < IMAGE_INSTANCE_PIXMAP_MAXSLICE (p); i++)
422 if (IMAGE_INSTANCE_X_PIXMAP_SLICE (p,i))
424 XFreePixmap (dpy, IMAGE_INSTANCE_X_PIXMAP_SLICE (p,i));
425 IMAGE_INSTANCE_X_PIXMAP_SLICE (p, i) = 0;
427 xfree (IMAGE_INSTANCE_X_PIXMAP_SLICES (p));
428 IMAGE_INSTANCE_X_PIXMAP_SLICES (p) = 0;
431 if (IMAGE_INSTANCE_X_CURSOR (p))
433 XFreeCursor (dpy, IMAGE_INSTANCE_X_CURSOR (p));
434 IMAGE_INSTANCE_X_CURSOR (p) = 0;
437 if (IMAGE_INSTANCE_X_NPIXELS (p) != 0)
440 IMAGE_INSTANCE_X_COLORMAP (p),
441 IMAGE_INSTANCE_X_PIXELS (p),
442 IMAGE_INSTANCE_X_NPIXELS (p), 0);
443 IMAGE_INSTANCE_X_NPIXELS (p) = 0;
447 /* You can sometimes have pixels without a live device. I forget
448 why, but that's why we free them here if we have a pixmap type
449 image instance. It probably means that we might also get a memory
450 leak with widgets. */
451 if (IMAGE_INSTANCE_TYPE (p) != IMAGE_WIDGET
452 && IMAGE_INSTANCE_TYPE (p) != IMAGE_SUBWINDOW
453 && IMAGE_INSTANCE_X_PIXELS (p))
455 xfree (IMAGE_INSTANCE_X_PIXELS (p));
456 IMAGE_INSTANCE_X_PIXELS (p) = 0;
464 x_image_instance_equal (struct Lisp_Image_Instance *p1,
465 struct Lisp_Image_Instance *p2, int depth)
467 switch (IMAGE_INSTANCE_TYPE (p1))
469 case IMAGE_MONO_PIXMAP:
470 case IMAGE_COLOR_PIXMAP:
472 if (IMAGE_INSTANCE_X_COLORMAP (p1) != IMAGE_INSTANCE_X_COLORMAP (p2) ||
473 IMAGE_INSTANCE_X_NPIXELS (p1) != IMAGE_INSTANCE_X_NPIXELS (p2))
484 x_image_instance_hash (struct Lisp_Image_Instance *p, int depth)
486 switch (IMAGE_INSTANCE_TYPE (p))
488 case IMAGE_MONO_PIXMAP:
489 case IMAGE_COLOR_PIXMAP:
491 return IMAGE_INSTANCE_X_NPIXELS (p);
497 /* Set all the slots in an image instance structure to reasonable
498 default values. This is used somewhere within an instantiate
499 method. It is assumed that the device slot within the image
500 instance is already set -- this is the case when instantiate
501 methods are called. */
504 x_initialize_pixmap_image_instance (struct Lisp_Image_Instance *ii,
506 enum image_instance_type type)
508 ii->data = xnew_and_zero (struct x_image_instance_data);
509 IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) = slices;
510 IMAGE_INSTANCE_X_PIXMAP_SLICES (ii) =
511 xnew_array_and_zero (Pixmap, slices);
512 IMAGE_INSTANCE_TYPE (ii) = type;
513 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = Qnil;
514 IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (ii) = Qnil;
515 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) = Qnil;
516 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) = Qnil;
517 IMAGE_INSTANCE_PIXMAP_FG (ii) = Qnil;
518 IMAGE_INSTANCE_PIXMAP_BG (ii) = Qnil;
522 /************************************************************************/
523 /* pixmap file functions */
524 /************************************************************************/
526 /* Where bitmaps are; initialized from resource database */
527 Lisp_Object Vx_bitmap_file_path;
530 #define BITMAPDIR "/usr/include/X11/bitmaps"
533 #define USE_XBMLANGPATH
535 /* Given a pixmap filename, look through all of the "standard" places
536 where the file might be located. Return a full pathname if found;
537 otherwise, return Qnil. */
540 x_locate_pixmap_file (Lisp_Object name)
542 /* This function can GC if IN_REDISPLAY is false */
545 /* Check non-absolute pathnames with a directory component relative to
546 the search path; that's the way Xt does it. */
547 /* #### Unix-specific */
548 if (XSTRING_BYTE (name, 0) == '/' ||
549 (XSTRING_BYTE (name, 0) == '.' &&
550 (XSTRING_BYTE (name, 1) == '/' ||
551 (XSTRING_BYTE (name, 1) == '.' &&
552 (XSTRING_BYTE (name, 2) == '/')))))
554 if (!NILP (Ffile_readable_p (name)))
560 if (NILP (Vdefault_x_device))
561 /* This may occur during initialization. */
564 /* We only check the bitmapFilePath resource on the original X device. */
565 display = DEVICE_X_DISPLAY (XDEVICE (Vdefault_x_device));
567 #ifdef USE_XBMLANGPATH
569 char *path = egetenv ("XBMLANGPATH");
570 SubstitutionRec subs[1];
572 subs[0].substitution = (char *) XSTRING_DATA (name);
573 /* #### Motif uses a big hairy default if $XBMLANGPATH isn't set.
574 We don't. If you want it used, set it. */
576 (path = XtResolvePathname (display, "bitmaps", 0, 0, path,
577 subs, XtNumber (subs), 0)))
579 name = build_string (path);
586 if (NILP (Vx_bitmap_file_path))
590 if (XrmGetResource (XtDatabase (display),
591 "bitmapFilePath", "BitmapFilePath", &type, &value)
592 && !strcmp (type, "String"))
593 Vx_bitmap_file_path = decode_env_path (0, (char *) value.addr);
594 Vx_bitmap_file_path = nconc2 (Vx_bitmap_file_path,
595 (decode_path (BITMAPDIR)));
600 if (locate_file (Vx_bitmap_file_path, name, Qnil, &found, R_OK) < 0)
602 Lisp_Object temp = list1 (Vdata_directory);
606 locate_file (temp, name, Qnil, &found, R_OK);
615 locate_pixmap_file (Lisp_Object name)
617 return x_locate_pixmap_file (name);
622 write_lisp_string_to_temp_file (Lisp_Object string, char *filename_out)
624 Lisp_Object instream, outstream;
625 Lstream *istr, *ostr;
626 char tempbuf[1024]; /* some random amount */
629 static Extbyte_dynarr *conversion_out_dynarr;
630 Bytecount bstart, bend;
631 struct gcpro gcpro1, gcpro2;
633 Lisp_Object conv_out_stream;
638 /* This function can GC */
639 if (!conversion_out_dynarr)
640 conversion_out_dynarr = Dynarr_new (Extbyte);
642 Dynarr_reset (conversion_out_dynarr);
644 /* Create the temporary file ... */
645 sprintf (filename_out, "/tmp/emacs%d.XXXXXX", (int) getpid ());
646 mktemp (filename_out);
647 tmpfil = fopen (filename_out, "w");
652 int old_errno = errno;
654 unlink (filename_out);
657 report_file_error ("Creating temp file",
658 list1 (build_string (filename_out)));
661 CHECK_STRING (string);
662 get_string_range_byte (string, Qnil, Qnil, &bstart, &bend,
663 GB_HISTORICAL_STRING_BEHAVIOR);
664 instream = make_lisp_string_input_stream (string, bstart, bend);
665 istr = XLSTREAM (instream);
666 /* setup the out stream */
667 outstream = make_dynarr_output_stream((unsigned_char_dynarr *)conversion_out_dynarr);
668 ostr = XLSTREAM (outstream);
670 /* setup the conversion stream */
671 conv_out_stream = make_encoding_output_stream (ostr, Fget_coding_system(Qbinary));
672 costr = XLSTREAM (conv_out_stream);
673 GCPRO3 (instream, outstream, conv_out_stream);
675 GCPRO2 (instream, outstream);
678 /* Get the data while doing the conversion */
681 int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
684 /* It does seem the flushes are necessary... */
686 Lstream_write (costr, tempbuf, size_in_bytes);
687 Lstream_flush (costr);
689 Lstream_write (ostr, tempbuf, size_in_bytes);
691 Lstream_flush (ostr);
692 if (fwrite ((unsigned char *)Dynarr_atp(conversion_out_dynarr, 0),
693 Dynarr_length(conversion_out_dynarr), 1, tmpfil) != 1)
698 /* reset the dynarr */
699 Lstream_rewind(ostr);
702 if (fclose (tmpfil) != 0)
704 Lstream_close (istr);
706 Lstream_close (costr);
708 Lstream_close (ostr);
711 Lstream_delete (istr);
712 Lstream_delete (ostr);
714 Lstream_delete (costr);
718 report_file_error ("Writing temp file",
719 list1 (build_string (filename_out)));
724 /************************************************************************/
725 /* cursor functions */
726 /************************************************************************/
728 /* Check that this server supports cursors of size WIDTH * HEIGHT. If
729 not, signal an error. INSTANTIATOR is only used in the error
733 check_pointer_sizes (Screen *xs, unsigned int width, unsigned int height,
734 Lisp_Object instantiator)
736 unsigned int best_width, best_height;
737 if (! XQueryBestCursor (DisplayOfScreen (xs), RootWindowOfScreen (xs),
738 width, height, &best_width, &best_height))
739 /* this means that an X error of some sort occurred (we trap
740 these so they're not fatal). */
741 signal_simple_error ("XQueryBestCursor() failed?", instantiator);
743 if (width > best_width || height > best_height)
744 error_with_frob (instantiator,
745 "pointer too large (%dx%d): "
746 "server requires %dx%d or smaller",
747 width, height, best_width, best_height);
752 generate_cursor_fg_bg (Lisp_Object device, Lisp_Object *foreground,
753 Lisp_Object *background, XColor *xfg, XColor *xbg)
755 if (!NILP (*foreground) && !COLOR_INSTANCEP (*foreground))
757 Fmake_color_instance (*foreground, device,
758 encode_error_behavior_flag (ERROR_ME));
759 if (COLOR_INSTANCEP (*foreground))
760 *xfg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (*foreground));
764 xfg->red = xfg->green = xfg->blue = 0;
767 if (!NILP (*background) && !COLOR_INSTANCEP (*background))
769 Fmake_color_instance (*background, device,
770 encode_error_behavior_flag (ERROR_ME));
771 if (COLOR_INSTANCEP (*background))
772 *xbg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (*background));
776 xbg->red = xbg->green = xbg->blue = ~0;
781 maybe_recolor_cursor (Lisp_Object image_instance, Lisp_Object foreground,
782 Lisp_Object background)
784 Lisp_Object device = XIMAGE_INSTANCE_DEVICE (image_instance);
787 generate_cursor_fg_bg (device, &foreground, &background, &xfg, &xbg);
788 if (!NILP (foreground) || !NILP (background))
790 XRecolorCursor (DEVICE_X_DISPLAY (XDEVICE (device)),
791 XIMAGE_INSTANCE_X_CURSOR (image_instance),
793 XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
794 XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
799 /************************************************************************/
800 /* color pixmap functions */
801 /************************************************************************/
803 /* Initialize an image instance from an XImage.
805 DEST_MASK specifies the mask of allowed image types.
807 PIXELS and NPIXELS specify an array of pixels that are used in
808 the image. These need to be kept around for the duration of the
809 image. When the image instance is freed, XFreeColors() will
810 automatically be called on all the pixels specified here; thus,
811 you should have allocated the pixels yourself using XAllocColor()
812 or the like. The array passed in is used directly without
813 being copied, so it should be heap data created with xmalloc().
814 It will be freed using xfree() when the image instance is
817 If this fails, signal an error. INSTANTIATOR is only used
818 in the error message.
820 #### This should be able to handle conversion into `pointer'.
821 Use the same code as for `xpm'. */
824 init_image_instance_from_x_image (struct Lisp_Image_Instance *ii,
828 unsigned long *pixels,
831 Lisp_Object instantiator)
833 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
839 if (!DEVICE_X_P (XDEVICE (device)))
840 signal_simple_error ("Not an X device", device);
842 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
843 d = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
845 if (!(dest_mask & IMAGE_COLOR_PIXMAP_MASK))
846 incompatible_image_types (instantiator, dest_mask,
847 IMAGE_COLOR_PIXMAP_MASK);
849 pixmap = XCreatePixmap (dpy, d, ximage->width,
850 ximage->height, ximage->depth);
852 signal_simple_error ("Unable to create pixmap", instantiator);
854 gc = XCreateGC (dpy, pixmap, 0, NULL);
857 XFreePixmap (dpy, pixmap);
858 signal_simple_error ("Unable to create GC", instantiator);
861 XPutImage (dpy, pixmap, gc, ximage, 0, 0, 0, 0,
862 ximage->width, ximage->height);
866 x_initialize_pixmap_image_instance (ii, slices, IMAGE_COLOR_PIXMAP);
868 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
869 find_keyword_in_vector (instantiator, Q_file);
871 /* Fixup a set of pixmaps. */
872 IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
874 IMAGE_INSTANCE_PIXMAP_MASK (ii) = 0;
875 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = ximage->width;
876 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = ximage->height;
877 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = ximage->depth;
878 IMAGE_INSTANCE_X_COLORMAP (ii) = cmap;
879 IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
880 IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
884 image_instance_add_x_image (struct Lisp_Image_Instance *ii,
887 Lisp_Object instantiator)
889 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
895 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
896 d = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
898 pixmap = XCreatePixmap (dpy, d, ximage->width,
899 ximage->height, ximage->depth);
901 signal_simple_error ("Unable to create pixmap", instantiator);
903 gc = XCreateGC (dpy, pixmap, 0, NULL);
906 XFreePixmap (dpy, pixmap);
907 signal_simple_error ("Unable to create GC", instantiator);
910 XPutImage (dpy, pixmap, gc, ximage, 0, 0, 0, 0,
911 ximage->width, ximage->height);
915 IMAGE_INSTANCE_X_PIXMAP_SLICE (ii, slice) = pixmap;
919 x_init_image_instance_from_eimage (struct Lisp_Image_Instance *ii,
920 int width, int height,
922 unsigned char *eimage,
924 Lisp_Object instantiator,
927 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
928 Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device));
929 unsigned long *pixtbl = NULL;
934 for (slice = 0; slice < slices; slice++)
936 ximage = convert_EImage_to_XImage (device, width, height,
937 eimage + (width * height * 3 * slice),
941 if (pixtbl) xfree (pixtbl);
942 signal_image_error("EImage to XImage conversion failed", instantiator);
945 /* Now create the pixmap and set up the image instance */
947 init_image_instance_from_x_image (ii, ximage, dest_mask,
948 cmap, pixtbl, npixels, slices,
951 image_instance_add_x_image (ii, ximage, slice, instantiator);
957 xfree (ximage->data);
960 XDestroyImage (ximage);
966 int read_bitmap_data_from_file (CONST char *filename, unsigned int *width,
967 unsigned int *height, unsigned char **datap,
968 int *x_hot, int *y_hot)
970 return XmuReadBitmapDataFromFile (filename, width, height,
971 datap, x_hot, y_hot);
974 /* Given inline data for a mono pixmap, create and return the
975 corresponding X object. */
978 pixmap_from_xbm_inline (Lisp_Object device, int width, int height,
979 /* Note that data is in ext-format! */
982 return XCreatePixmapFromBitmapData (DEVICE_X_DISPLAY (XDEVICE(device)),
983 XtWindow (DEVICE_XT_APP_SHELL (XDEVICE (device))),
984 (char *) bits, width, height,
988 /* Given inline data for a mono pixmap, initialize the given
989 image instance accordingly. */
992 init_image_instance_from_xbm_inline (struct Lisp_Image_Instance *ii,
993 int width, int height,
994 /* Note that data is in ext-format! */
996 Lisp_Object instantiator,
997 Lisp_Object pointer_fg,
998 Lisp_Object pointer_bg,
1001 Lisp_Object mask_filename)
1003 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1004 Lisp_Object foreground = find_keyword_in_vector (instantiator, Q_foreground);
1005 Lisp_Object background = find_keyword_in_vector (instantiator, Q_background);
1009 enum image_instance_type type;
1011 if (!DEVICE_X_P (XDEVICE (device)))
1012 signal_simple_error ("Not an X device", device);
1014 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1015 draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
1016 scr = DefaultScreenOfDisplay (dpy);
1018 if ((dest_mask & IMAGE_MONO_PIXMAP_MASK) &&
1019 (dest_mask & IMAGE_COLOR_PIXMAP_MASK))
1021 if (!NILP (foreground) || !NILP (background))
1022 type = IMAGE_COLOR_PIXMAP;
1024 type = IMAGE_MONO_PIXMAP;
1026 else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
1027 type = IMAGE_MONO_PIXMAP;
1028 else if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
1029 type = IMAGE_COLOR_PIXMAP;
1030 else if (dest_mask & IMAGE_POINTER_MASK)
1031 type = IMAGE_POINTER;
1033 incompatible_image_types (instantiator, dest_mask,
1034 IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
1035 | IMAGE_POINTER_MASK);
1037 x_initialize_pixmap_image_instance (ii, 1, type);
1038 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = width;
1039 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = height;
1040 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
1041 find_keyword_in_vector (instantiator, Q_file);
1045 case IMAGE_MONO_PIXMAP:
1047 IMAGE_INSTANCE_X_PIXMAP (ii) =
1048 pixmap_from_xbm_inline (device, width, height, (Extbyte *) bits);
1052 case IMAGE_COLOR_PIXMAP:
1054 Dimension d = DEVICE_X_DEPTH (XDEVICE(device));
1055 unsigned long fg = BlackPixelOfScreen (scr);
1056 unsigned long bg = WhitePixelOfScreen (scr);
1058 if (!NILP (foreground) && !COLOR_INSTANCEP (foreground))
1060 Fmake_color_instance (foreground, device,
1061 encode_error_behavior_flag (ERROR_ME));
1063 if (COLOR_INSTANCEP (foreground))
1064 fg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground)).pixel;
1066 if (!NILP (background) && !COLOR_INSTANCEP (background))
1068 Fmake_color_instance (background, device,
1069 encode_error_behavior_flag (ERROR_ME));
1071 if (COLOR_INSTANCEP (background))
1072 bg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background)).pixel;
1074 /* We used to duplicate the pixels using XAllocColor(), to protect
1075 against their getting freed. Just as easy to just store the
1076 color instances here and GC-protect them, so this doesn't
1078 IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
1079 IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
1080 IMAGE_INSTANCE_X_PIXMAP (ii) =
1081 XCreatePixmapFromBitmapData (dpy, draw,
1082 (char *) bits, width, height,
1084 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = d;
1090 XColor fg_color, bg_color;
1093 check_pointer_sizes (scr, width, height, instantiator);
1096 XCreatePixmapFromBitmapData (dpy, draw,
1097 (char *) bits, width, height,
1100 if (NILP (foreground))
1101 foreground = pointer_fg;
1102 if (NILP (background))
1103 background = pointer_bg;
1104 generate_cursor_fg_bg (device, &foreground, &background,
1105 &fg_color, &bg_color);
1107 IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
1108 IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
1109 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) =
1110 find_keyword_in_vector (instantiator, Q_hotspot_x);
1111 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) =
1112 find_keyword_in_vector (instantiator, Q_hotspot_y);
1113 IMAGE_INSTANCE_X_CURSOR (ii) =
1115 (dpy, source, mask, &fg_color, &bg_color,
1116 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ?
1117 XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) : 0,
1118 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) ?
1119 XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) : 0);
1129 xbm_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator,
1130 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1131 int dest_mask, int width, int height,
1132 /* Note that data is in ext-format! */
1135 Lisp_Object mask_data = find_keyword_in_vector (instantiator, Q_mask_data);
1136 Lisp_Object mask_file = find_keyword_in_vector (instantiator, Q_mask_file);
1137 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1139 CONST char *gcc_may_you_rot_in_hell;
1141 if (!NILP (mask_data))
1143 GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (mask_data))),
1144 gcc_may_you_rot_in_hell);
1146 pixmap_from_xbm_inline (IMAGE_INSTANCE_DEVICE (ii),
1147 XINT (XCAR (mask_data)),
1148 XINT (XCAR (XCDR (mask_data))),
1149 (CONST unsigned char *)
1150 gcc_may_you_rot_in_hell);
1153 init_image_instance_from_xbm_inline (ii, width, height, bits,
1154 instantiator, pointer_fg, pointer_bg,
1155 dest_mask, mask, mask_file);
1158 /* Instantiate method for XBM's. */
1161 x_xbm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1162 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1163 int dest_mask, Lisp_Object domain)
1165 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1166 CONST char *gcc_go_home;
1168 assert (!NILP (data));
1170 GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (data))),
1173 xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1174 pointer_bg, dest_mask, XINT (XCAR (data)),
1175 XINT (XCAR (XCDR (data))), gcc_go_home);
1181 /**********************************************************************
1183 **********************************************************************/
1184 /* xpm 3.2g and better has XpmCreatePixmapFromBuffer()...
1185 There was no version number in xpm.h before 3.3, but this should do.
1187 #if (XpmVersion >= 3) || defined(XpmExactColors)
1188 # define XPM_DOES_BUFFERS
1191 #ifndef XPM_DOES_BUFFERS
1192 Your version of XPM is too old. You cannot compile with it.
1193 Upgrade to version 3.2g or better or compile with --with-xpm=no.
1194 #endif /* !XPM_DOES_BUFFERS */
1196 static XpmColorSymbol *
1197 extract_xpm_color_names (XpmAttributes *xpmattrs, Lisp_Object device,
1199 Lisp_Object color_symbol_alist)
1201 /* This function can GC */
1202 Display *dpy = DEVICE_X_DISPLAY (XDEVICE(device));
1203 Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1206 Lisp_Object results = Qnil;
1208 XpmColorSymbol *symbols;
1209 struct gcpro gcpro1, gcpro2;
1211 GCPRO2 (results, device);
1213 /* We built up results to be (("name" . #<color>) ...) so that if an
1214 error happens we don't lose any malloc()ed data, or more importantly,
1215 leave any pixels allocated in the server. */
1217 LIST_LOOP (rest, color_symbol_alist)
1219 Lisp_Object cons = XCAR (rest);
1220 Lisp_Object name = XCAR (cons);
1221 Lisp_Object value = XCDR (cons);
1224 if (STRINGP (value))
1226 Fmake_color_instance
1227 (value, device, encode_error_behavior_flag (ERROR_ME_NOT));
1230 assert (COLOR_SPECIFIERP (value));
1231 value = Fspecifier_instance (value, domain, Qnil, Qnil);
1235 results = noseeum_cons (noseeum_cons (name, value), results);
1238 UNGCPRO; /* no more evaluation */
1240 if (i == 0) return 0;
1242 symbols = xnew_array (XpmColorSymbol, i);
1243 xpmattrs->valuemask |= XpmColorSymbols;
1244 xpmattrs->colorsymbols = symbols;
1245 xpmattrs->numsymbols = i;
1249 Lisp_Object cons = XCAR (results);
1250 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (XCDR (cons)));
1251 /* Duplicate the pixel value so that we still have a lock on it if
1252 the pixel we were passed is later freed. */
1253 if (! XAllocColor (dpy, cmap, &color))
1254 abort (); /* it must be allocable since we're just duplicating it */
1256 symbols [i].name = (char *) XSTRING_DATA (XCAR (cons));
1257 symbols [i].pixel = color.pixel;
1258 symbols [i].value = 0;
1259 free_cons (XCONS (cons));
1261 results = XCDR (results);
1262 free_cons (XCONS (cons));
1268 xpm_free (XpmAttributes *xpmattrs)
1270 /* Could conceivably lose if XpmXXX returned an error without first
1271 initializing this structure, if we didn't know that initializing it
1272 to all zeros was ok (and also that it's ok to call XpmFreeAttributes()
1273 multiple times, since it zeros slots as it frees them...) */
1274 XpmFreeAttributes (xpmattrs);
1278 x_xpm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1279 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1280 int dest_mask, Lisp_Object domain)
1282 /* This function can GC */
1283 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1284 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1285 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1293 XpmAttributes xpmattrs;
1295 XpmColorSymbol *color_symbols;
1296 Lisp_Object color_symbol_alist = find_keyword_in_vector (instantiator,
1298 enum image_instance_type type;
1302 if (!DEVICE_X_P (XDEVICE (device)))
1303 signal_simple_error ("Not an X device", device);
1305 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1306 xs = DefaultScreenOfDisplay (dpy);
1308 if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
1309 type = IMAGE_COLOR_PIXMAP;
1310 else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
1311 type = IMAGE_MONO_PIXMAP;
1312 else if (dest_mask & IMAGE_POINTER_MASK)
1313 type = IMAGE_POINTER;
1315 incompatible_image_types (instantiator, dest_mask,
1316 IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
1317 | IMAGE_POINTER_MASK);
1318 force_mono = (type != IMAGE_COLOR_PIXMAP);
1321 /* Although I haven't found it documented yet, it appears that pointers are
1322 always colored via the default window colormap... Sigh. */
1323 if (type == IMAGE_POINTER)
1325 cmap = DefaultColormap(dpy, DefaultScreen(dpy));
1326 depth = DefaultDepthOfScreen (xs);
1327 visual = DefaultVisualOfScreen (xs);
1331 cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1332 depth = DEVICE_X_DEPTH (XDEVICE(device));
1333 visual = DEVICE_X_VISUAL (XDEVICE(device));
1336 cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1337 depth = DEVICE_X_DEPTH (XDEVICE(device));
1338 visual = DEVICE_X_VISUAL (XDEVICE(device));
1341 x_initialize_pixmap_image_instance (ii, 1, type);
1343 assert (!NILP (data));
1347 xzero (xpmattrs); /* want XpmInitAttributes() */
1348 xpmattrs.valuemask = XpmReturnPixels;
1351 /* Without this, we get a 1-bit version of the color image, which
1352 isn't quite right. With this, we get the mono image, which might
1353 be very different looking. */
1354 xpmattrs.valuemask |= XpmColorKey;
1355 xpmattrs.color_key = XPM_MONO;
1357 xpmattrs.valuemask |= XpmDepth;
1361 xpmattrs.closeness = 65535;
1362 xpmattrs.valuemask |= XpmCloseness;
1363 xpmattrs.depth = depth;
1364 xpmattrs.valuemask |= XpmDepth;
1365 xpmattrs.visual = visual;
1366 xpmattrs.valuemask |= XpmVisual;
1367 xpmattrs.colormap = cmap;
1368 xpmattrs.valuemask |= XpmColormap;
1371 color_symbols = extract_xpm_color_names (&xpmattrs, device, domain,
1372 color_symbol_alist);
1374 result = XpmCreatePixmapFromBuffer (dpy,
1375 XtWindow(DEVICE_XT_APP_SHELL (XDEVICE(device))),
1376 (char *) XSTRING_DATA (data),
1377 &pixmap, &mask, &xpmattrs);
1381 xfree (color_symbols);
1382 xpmattrs.colorsymbols = 0; /* in case XpmFreeAttr is too smart... */
1383 xpmattrs.numsymbols = 0;
1390 case XpmFileInvalid:
1392 xpm_free (&xpmattrs);
1393 signal_image_error ("invalid XPM data", data);
1395 case XpmColorFailed:
1398 xpm_free (&xpmattrs);
1401 /* second time; blow out. */
1402 signal_double_file_error ("Reading pixmap data",
1403 "color allocation failed",
1408 if (! (dest_mask & IMAGE_MONO_PIXMAP_MASK))
1410 /* second time; blow out. */
1411 signal_double_file_error ("Reading pixmap data",
1412 "color allocation failed",
1416 IMAGE_INSTANCE_TYPE (ii) = IMAGE_MONO_PIXMAP;
1422 xpm_free (&xpmattrs);
1423 signal_double_file_error ("Parsing pixmap data",
1424 "out of memory", data);
1428 xpm_free (&xpmattrs);
1429 signal_double_file_error_2 ("Parsing pixmap data",
1430 "unknown error code",
1431 make_int (result), data);
1436 h = xpmattrs.height;
1439 int npixels = xpmattrs.npixels;
1444 pixels = xnew_array (Pixel, npixels);
1445 memcpy (pixels, xpmattrs.pixels, npixels * sizeof (Pixel));
1450 IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
1451 IMAGE_INSTANCE_PIXMAP_MASK (ii) = (void*)mask;
1452 IMAGE_INSTANCE_X_COLORMAP (ii) = cmap;
1453 IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
1454 IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
1455 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = w;
1456 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = h;
1457 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
1458 find_keyword_in_vector (instantiator, Q_file);
1463 case IMAGE_MONO_PIXMAP:
1466 case IMAGE_COLOR_PIXMAP:
1468 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = depth;
1474 int npixels = xpmattrs.npixels;
1475 Pixel *pixels = xpmattrs.pixels;
1478 int xhot = 0, yhot = 0;
1480 if (xpmattrs.valuemask & XpmHotspot)
1482 xhot = xpmattrs.x_hotspot;
1483 XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii), xpmattrs.x_hotspot);
1485 if (xpmattrs.valuemask & XpmHotspot)
1487 yhot = xpmattrs.y_hotspot;
1488 XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii), xpmattrs.y_hotspot);
1490 check_pointer_sizes (xs, w, h, instantiator);
1492 /* If the loaded pixmap has colors allocated (meaning it came from an
1493 XPM file), then use those as the default colors for the cursor we
1494 create. Otherwise, default to pointer_fg and pointer_bg.
1498 /* With an XBM file, it's obvious which bit is foreground
1499 and which is background, or rather, it's implicit: in
1500 an XBM file, a 1 bit is foreground, and a 0 bit is
1503 XCreatePixmapCursor() assumes this property of the
1504 pixmap it is called with as well; the `foreground'
1505 color argument is used for the 1 bits.
1507 With an XPM file, it's tricker, since the elements of
1508 the pixmap don't represent FG and BG, but are actual
1509 pixel values. So we need to figure out which of those
1510 pixels is the foreground color and which is the
1511 background. We do it by comparing RGB and assuming
1512 that the darker color is the foreground. This works
1513 with the result of xbmtopbm|ppmtoxpm, at least.
1515 It might be nice if there was some way to tag the
1516 colors in the XPM file with whether they are the
1517 foreground - perhaps with logical color names somehow?
1519 Once we have decided which color is the foreground, we
1520 need to ensure that that color corresponds to a `1' bit
1521 in the Pixmap. The XPM library wrote into the (1-bit)
1522 pixmap with XPutPixel, which will ignore all but the
1523 least significant bit.
1525 This means that a 1 bit in the image corresponds to
1526 `fg' only if `fg.pixel' is odd.
1528 (This also means that the image will be all the same
1529 color if both `fg' and `bg' are odd or even, but we can
1530 safely assume that that won't happen if the XPM file is
1533 The desired result is that the image use `1' to
1534 represent the foreground color, and `0' to represent
1535 the background color. So, we may need to invert the
1536 image to accomplish this; we invert if fg is
1537 odd. (Remember that WhitePixel and BlackPixel are not
1538 necessarily 1 and 0 respectively, though I think it
1539 might be safe to assume that one of them is always 1
1540 and the other is always 0. We also pretty much need to
1541 assume that one is even and the other is odd.)
1544 fg.pixel = pixels[0]; /* pick a pixel at random. */
1545 bg.pixel = fg.pixel;
1546 for (i = 1; i < npixels; i++) /* Look for an "other" pixel value.*/
1548 bg.pixel = pixels[i];
1549 if (fg.pixel != bg.pixel)
1553 /* If (fg.pixel == bg.pixel) then probably something has
1554 gone wrong, but I don't think signalling an error would
1557 XQueryColor (dpy, cmap, &fg);
1558 XQueryColor (dpy, cmap, &bg);
1560 /* If the foreground is lighter than the background, swap them.
1561 (This occurs semi-randomly, depending on the ordering of the
1562 color list in the XPM file.)
1565 unsigned short fg_total = ((fg.red / 3) + (fg.green / 3)
1567 unsigned short bg_total = ((bg.red / 3) + (bg.green / 3)
1569 if (fg_total > bg_total)
1578 /* If the fg pixel corresponds to a `0' in the bitmap, invert it.
1579 (This occurs (only?) on servers with Black=0, White=1.)
1581 if ((fg.pixel & 1) == 0)
1585 gcv.function = GXxor;
1587 gc = XCreateGC (dpy, pixmap, (GCFunction | GCForeground),
1589 XFillRectangle (dpy, pixmap, gc, 0, 0, w, h);
1595 generate_cursor_fg_bg (device, &pointer_fg, &pointer_bg,
1597 IMAGE_INSTANCE_PIXMAP_FG (ii) = pointer_fg;
1598 IMAGE_INSTANCE_PIXMAP_BG (ii) = pointer_bg;
1601 IMAGE_INSTANCE_X_CURSOR (ii) =
1603 (dpy, pixmap, mask, &fg, &bg, xhot, yhot);
1612 xpm_free (&xpmattrs); /* after we've read pixels and hotspot */
1615 #endif /* HAVE_XPM */
1620 /**********************************************************************
1622 **********************************************************************/
1624 /* This is about to get redefined! */
1627 /* We have to define SYSV32 so that compface.h includes string.h
1628 instead of strings.h. */
1633 #include <compface.h>
1637 /* JMP_BUF cannot be used here because if it doesn't get defined
1638 to jmp_buf we end up with a conflicting type error with the
1639 definition in compface.h */
1640 extern jmp_buf comp_env;
1644 x_xface_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1645 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1646 int dest_mask, Lisp_Object domain)
1648 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1650 char *p, *bits, *bp;
1651 CONST char * volatile emsg = 0;
1652 CONST char * volatile dstring;
1654 assert (!NILP (data));
1656 GET_C_STRING_BINARY_DATA_ALLOCA (data, dstring);
1658 if ((p = strchr (dstring, ':')))
1663 /* Must use setjmp not SETJMP because we used jmp_buf above not JMP_BUF */
1664 if (!(stattis = setjmp (comp_env)))
1666 UnCompAll ((char *) dstring);
1673 emsg = "uncompface: internal error";
1676 emsg = "uncompface: insufficient or invalid data";
1679 emsg = "uncompface: excess data ignored";
1684 signal_simple_error_2 (emsg, data, Qimage);
1686 bp = bits = (char *) alloca (PIXELS / 8);
1688 /* the compface library exports char F[], which uses a single byte per
1689 pixel to represent a 48x48 bitmap. Yuck. */
1690 for (i = 0, p = F; i < (PIXELS / 8); ++i)
1693 /* reverse the bit order of each byte... */
1694 for (b = n = 0; b < 8; ++b)
1701 xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1702 pointer_bg, dest_mask, 48, 48, bits);
1705 #endif /* HAVE_XFACE */
1708 /**********************************************************************
1710 **********************************************************************/
1713 autodetect_validate (Lisp_Object instantiator)
1715 data_must_be_present (instantiator);
1719 autodetect_normalize (Lisp_Object instantiator,
1720 Lisp_Object console_type)
1722 Lisp_Object file = find_keyword_in_vector (instantiator, Q_data);
1723 Lisp_Object filename = Qnil;
1724 Lisp_Object data = Qnil;
1725 struct gcpro gcpro1, gcpro2, gcpro3;
1726 Lisp_Object alist = Qnil;
1728 GCPRO3 (filename, data, alist);
1730 if (NILP (file)) /* no conversion necessary */
1731 RETURN_UNGCPRO (instantiator);
1733 alist = tagged_vector_to_alist (instantiator);
1735 filename = locate_pixmap_file (file);
1736 if (!NILP (filename))
1739 /* #### Apparently some versions of XpmReadFileToData, which is
1740 called by pixmap_to_lisp_data, don't return an error value
1741 if the given file is not a valid XPM file. Instead, they
1742 just seg fault. It is definitely caused by passing a
1743 bitmap. To try and avoid this we check for bitmaps first. */
1745 data = bitmap_to_lisp_data (filename, &xhot, &yhot, 1);
1749 alist = remassq_no_quit (Q_data, alist);
1750 alist = Fcons (Fcons (Q_file, filename),
1751 Fcons (Fcons (Q_data, data), alist));
1753 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
1756 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
1759 alist = xbm_mask_file_munging (alist, filename, Qnil, console_type);
1762 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
1764 RETURN_UNGCPRO (result);
1769 data = pixmap_to_lisp_data (filename, 1);
1773 alist = remassq_no_quit (Q_data, alist);
1774 alist = Fcons (Fcons (Q_file, filename),
1775 Fcons (Fcons (Q_data, data), alist));
1776 alist = Fcons (Fcons (Q_color_symbols,
1777 evaluate_xpm_color_symbols ()),
1780 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
1782 RETURN_UNGCPRO (result);
1788 /* If we couldn't convert it, just put it back as it is.
1789 We might try to further frob it later as a cursor-font
1790 specification. (We can't do that now because we don't know
1791 what dest-types it's going to be instantiated into.) */
1793 Lisp_Object result = alist_to_tagged_vector (Qautodetect, alist);
1795 RETURN_UNGCPRO (result);
1800 autodetect_possible_dest_types (void)
1803 IMAGE_MONO_PIXMAP_MASK |
1804 IMAGE_COLOR_PIXMAP_MASK |
1805 IMAGE_POINTER_MASK |
1810 autodetect_instantiate (Lisp_Object image_instance,
1811 Lisp_Object instantiator,
1812 Lisp_Object pointer_fg,
1813 Lisp_Object pointer_bg,
1814 int dest_mask, Lisp_Object domain)
1816 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1817 struct gcpro gcpro1, gcpro2, gcpro3;
1818 Lisp_Object alist = Qnil;
1819 Lisp_Object result = Qnil;
1820 int is_cursor_font = 0;
1822 GCPRO3 (data, alist, result);
1824 alist = tagged_vector_to_alist (instantiator);
1825 if (dest_mask & IMAGE_POINTER_MASK)
1827 CONST char *name_ext;
1828 GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext);
1829 if (XmuCursorNameToIndex (name_ext) != -1)
1831 result = alist_to_tagged_vector (Qcursor_font, alist);
1836 if (!is_cursor_font)
1837 result = alist_to_tagged_vector (Qstring, alist);
1841 cursor_font_instantiate (image_instance, result, pointer_fg,
1842 pointer_bg, dest_mask, domain);
1844 string_instantiate (image_instance, result, pointer_fg,
1845 pointer_bg, dest_mask, domain);
1851 /**********************************************************************
1853 **********************************************************************/
1856 font_validate (Lisp_Object instantiator)
1858 data_must_be_present (instantiator);
1861 /* XmuCvtStringToCursor is bogus in the following ways:
1863 - When it can't convert the given string to a real cursor, it will
1864 sometimes return a "success" value, after triggering a BadPixmap
1865 error. It then gives you a cursor that will itself generate BadCursor
1866 errors. So we install this error handler to catch/notice the X error
1867 and take that as meaning "couldn't convert."
1869 - When you tell it to find a cursor file that doesn't exist, it prints
1870 an error message on stderr. You can't make it not do that.
1872 - Also, using Xmu means we can't properly hack Lisp_Image_Instance
1873 objects, or XPM files, or $XBMLANGPATH.
1876 /* Duplicate the behavior of XmuCvtStringToCursor() to bypass its bogusness. */
1878 static int XLoadFont_got_error;
1881 XLoadFont_error_handler (Display *dpy, XErrorEvent *xerror)
1883 XLoadFont_got_error = 1;
1888 safe_XLoadFont (Display *dpy, char *name)
1891 int (*old_handler) (Display *, XErrorEvent *);
1892 XLoadFont_got_error = 0;
1894 old_handler = XSetErrorHandler (XLoadFont_error_handler);
1895 font = XLoadFont (dpy, name);
1897 XSetErrorHandler (old_handler);
1898 if (XLoadFont_got_error) return 0;
1903 font_possible_dest_types (void)
1905 return IMAGE_POINTER_MASK;
1909 font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1910 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1911 int dest_mask, Lisp_Object domain)
1913 /* This function can GC */
1914 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1915 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1916 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1920 char source_name[MAXPATHLEN], mask_name[MAXPATHLEN], dummy;
1921 int source_char, mask_char;
1923 Lisp_Object foreground, background;
1925 if (!DEVICE_X_P (XDEVICE (device)))
1926 signal_simple_error ("Not an X device", device);
1928 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1930 if (!STRINGP (data) ||
1931 strncmp ("FONT ", (char *) XSTRING_DATA (data), 5))
1932 signal_simple_error ("Invalid font-glyph instantiator",
1935 if (!(dest_mask & IMAGE_POINTER_MASK))
1936 incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
1938 foreground = find_keyword_in_vector (instantiator, Q_foreground);
1939 if (NILP (foreground))
1940 foreground = pointer_fg;
1941 background = find_keyword_in_vector (instantiator, Q_background);
1942 if (NILP (background))
1943 background = pointer_bg;
1945 generate_cursor_fg_bg (device, &foreground, &background, &fg, &bg);
1947 count = sscanf ((char *) XSTRING_DATA (data),
1948 "FONT %s %d %s %d %c",
1949 source_name, &source_char,
1950 mask_name, &mask_char, &dummy);
1951 /* Allow "%s %d %d" as well... */
1952 if (count == 3 && (1 == sscanf (mask_name, "%d %c", &mask_char, &dummy)))
1953 count = 4, mask_name[0] = 0;
1955 if (count != 2 && count != 4)
1956 signal_simple_error ("invalid cursor specification", data);
1957 source = safe_XLoadFont (dpy, source_name);
1959 signal_simple_error_2 ("couldn't load font",
1960 build_string (source_name),
1964 else if (!mask_name[0])
1968 mask = safe_XLoadFont (dpy, mask_name);
1971 Fsignal (Qerror, list3 (build_string ("couldn't load font"),
1972 build_string (mask_name), data));
1977 /* #### call XQueryTextExtents() and check_pointer_sizes() here. */
1979 x_initialize_pixmap_image_instance (ii, 1, IMAGE_POINTER);
1980 IMAGE_INSTANCE_X_CURSOR (ii) =
1981 XCreateGlyphCursor (dpy, source, mask, source_char, mask_char,
1983 XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
1984 XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
1985 XUnloadFont (dpy, source);
1986 if (mask && mask != source) XUnloadFont (dpy, mask);
1990 /**********************************************************************
1992 **********************************************************************/
1995 cursor_font_validate (Lisp_Object instantiator)
1997 data_must_be_present (instantiator);
2001 cursor_font_possible_dest_types (void)
2003 return IMAGE_POINTER_MASK;
2007 cursor_font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2008 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2009 int dest_mask, Lisp_Object domain)
2011 /* This function can GC */
2012 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
2013 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2014 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
2017 CONST char *name_ext;
2018 Lisp_Object foreground, background;
2020 if (!DEVICE_X_P (XDEVICE (device)))
2021 signal_simple_error ("Not an X device", device);
2023 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2025 if (!(dest_mask & IMAGE_POINTER_MASK))
2026 incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
2028 GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext);
2029 if ((i = XmuCursorNameToIndex (name_ext)) == -1)
2030 signal_simple_error ("Unrecognized cursor-font name", data);
2032 x_initialize_pixmap_image_instance (ii, 1, IMAGE_POINTER);
2033 IMAGE_INSTANCE_X_CURSOR (ii) = XCreateFontCursor (dpy, i);
2034 foreground = find_keyword_in_vector (instantiator, Q_foreground);
2035 if (NILP (foreground))
2036 foreground = pointer_fg;
2037 background = find_keyword_in_vector (instantiator, Q_background);
2038 if (NILP (background))
2039 background = pointer_bg;
2040 maybe_recolor_cursor (image_instance, foreground, background);
2044 x_colorize_image_instance (Lisp_Object image_instance,
2045 Lisp_Object foreground, Lisp_Object background)
2047 struct Lisp_Image_Instance *p;
2049 p = XIMAGE_INSTANCE (image_instance);
2051 switch (IMAGE_INSTANCE_TYPE (p))
2053 case IMAGE_MONO_PIXMAP:
2054 IMAGE_INSTANCE_TYPE (p) = IMAGE_COLOR_PIXMAP;
2055 /* Make sure there aren't two pointers to the same mask, causing
2056 it to get freed twice. */
2057 IMAGE_INSTANCE_PIXMAP_MASK (p) = 0;
2065 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
2066 Drawable draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (IMAGE_INSTANCE_DEVICE (p))));
2067 Dimension d = DEVICE_X_DEPTH (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
2068 Pixmap new = XCreatePixmap (dpy, draw,
2069 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
2070 IMAGE_INSTANCE_PIXMAP_HEIGHT (p), d);
2074 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground));
2075 gcv.foreground = color.pixel;
2076 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background));
2077 gcv.background = color.pixel;
2078 gc = XCreateGC (dpy, new, GCBackground|GCForeground, &gcv);
2079 XCopyPlane (dpy, IMAGE_INSTANCE_X_PIXMAP (p), new, gc, 0, 0,
2080 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
2081 IMAGE_INSTANCE_PIXMAP_HEIGHT (p),
2084 IMAGE_INSTANCE_X_PIXMAP (p) = new;
2085 IMAGE_INSTANCE_PIXMAP_DEPTH (p) = d;
2086 IMAGE_INSTANCE_PIXMAP_FG (p) = foreground;
2087 IMAGE_INSTANCE_PIXMAP_BG (p) = background;
2093 /************************************************************************/
2094 /* subwindow and widget support */
2095 /************************************************************************/
2097 /* unmap the image if it is a widget. This is used by redisplay via
2098 redisplay_unmap_subwindows */
2100 x_unmap_subwindow (struct Lisp_Image_Instance *p)
2102 if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
2105 (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2106 IMAGE_INSTANCE_X_CLIPWINDOW (p));
2108 else /* must be a widget */
2110 XtUnmapWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p));
2114 /* map the subwindow. This is used by redisplay via
2115 redisplay_output_subwindow */
2117 x_map_subwindow (struct Lisp_Image_Instance *p, int x, int y,
2118 struct display_glyph_area* dga)
2120 if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
2122 Window subwindow = IMAGE_INSTANCE_X_SUBWINDOW_ID (p);
2123 XMoveResizeWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2124 IMAGE_INSTANCE_X_CLIPWINDOW (p),
2125 x, y, dga->width, dga->height);
2126 XMoveWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2127 subwindow, -dga->xoffset, -dga->yoffset);
2128 XMapWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2129 IMAGE_INSTANCE_X_CLIPWINDOW (p));
2131 else /* must be a widget */
2133 XtConfigureWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p),
2134 x + IMAGE_INSTANCE_X_WIDGET_XOFFSET (p),
2135 y + IMAGE_INSTANCE_X_WIDGET_YOFFSET (p),
2136 dga->width, dga->height, 0);
2137 XtMoveWidget (IMAGE_INSTANCE_X_WIDGET_ID (p),
2138 -dga->xoffset, -dga->yoffset);
2139 XtMapWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p));
2143 /* when you click on a widget you may activate another widget this
2144 needs to be checked and all appropriate widgets updated */
2146 x_update_subwindow (struct Lisp_Image_Instance *p)
2149 if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET)
2152 widget_value* wv = gui_items_to_widget_values
2153 (IMAGE_INSTANCE_WIDGET_ITEMS (p));
2155 /* This seems ugly, but I'm not sure what else to do. */
2156 if (EQ (IMAGE_INSTANCE_WIDGET_TYPE (p), Qtab_control))
2158 widget_value* cur = 0;
2159 /* Give each child label the correct foreground color. */
2160 Lisp_Object pixel = FACE_FOREGROUND
2161 (IMAGE_INSTANCE_WIDGET_FACE (p),
2162 IMAGE_INSTANCE_SUBWINDOW_FRAME (p));
2163 XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2164 XtSetArg (al [0], XtNtabForeground, fcolor.pixel);
2166 for (cur = wv->contents; cur; cur = cur->next)
2176 /* now modify the widget */
2177 lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (p),
2179 free_widget_value_tree (wv);
2180 /* update the colors and font */
2181 update_widget_face (p, IMAGE_INSTANCE_SUBWINDOW_FRAME (p));
2182 /* We have to do this otherwise Motif will unceremoniously
2183 resize us when the label gets set. */
2184 XtSetArg (al [0], XtNwidth, IMAGE_INSTANCE_WIDGET_WIDTH (p));
2185 XtSetArg (al [1], XtNheight, IMAGE_INSTANCE_WIDGET_HEIGHT (p));
2186 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (p), al, 2);
2191 /* instantiate and x type subwindow */
2193 x_subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2194 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2195 int dest_mask, Lisp_Object domain)
2197 /* This function can GC */
2198 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2199 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
2200 Lisp_Object frame = FW_FRAME (domain);
2201 struct frame* f = XFRAME (frame);
2205 XSetWindowAttributes xswa;
2207 unsigned int w = IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii),
2208 h = IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii);
2210 if (!DEVICE_X_P (XDEVICE (device)))
2211 signal_simple_error ("Not an X device", device);
2213 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2214 xs = DefaultScreenOfDisplay (dpy);
2216 IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW;
2218 pw = XtWindow (FRAME_X_TEXT_WIDGET (f));
2220 ii->data = xnew_and_zero (struct x_subwindow_data);
2222 IMAGE_INSTANCE_X_SUBWINDOW_PARENT (ii) = pw;
2223 IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (ii) = DisplayOfScreen (xs);
2225 xswa.backing_store = Always;
2226 valueMask |= CWBackingStore;
2227 xswa.colormap = DefaultColormapOfScreen (xs);
2228 valueMask |= CWColormap;
2230 /* Create a window for clipping */
2231 IMAGE_INSTANCE_X_CLIPWINDOW (ii) =
2232 XCreateWindow (dpy, pw, 0, 0, w, h, 0, CopyFromParent,
2233 InputOutput, CopyFromParent, valueMask,
2236 /* Now put the subwindow inside the clip window. */
2237 win = XCreateWindow (dpy, IMAGE_INSTANCE_X_CLIPWINDOW (ii),
2238 0, 0, w, h, 0, CopyFromParent,
2239 InputOutput, CopyFromParent, valueMask,
2242 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)win;
2246 /* #### Should this function exist? If there's any doubt I'm not implementing it --andyp */
2247 DEFUN ("change-subwindow-property", Fchange_subwindow_property, 3, 3, 0, /*
2248 For the given SUBWINDOW, set PROPERTY to DATA, which is a string.
2249 Subwindows are not currently implemented.
2251 (subwindow, property, data))
2254 struct Lisp_Subwindow *sw;
2257 CHECK_SUBWINDOW (subwindow);
2258 CHECK_STRING (property);
2259 CHECK_STRING (data);
2261 sw = XSUBWINDOW (subwindow);
2262 dpy = DisplayOfScreen (LISP_DEVICE_TO_X_SCREEN
2263 (FRAME_DEVICE (XFRAME (sw->frame))));
2265 property_atom = XInternAtom (dpy, (char *) XSTRING_DATA (property), False);
2266 XChangeProperty (dpy, sw->subwindow, property_atom, XA_STRING, 8,
2268 XSTRING_DATA (data),
2269 XSTRING_LENGTH (data));
2276 x_resize_subwindow (struct Lisp_Image_Instance* ii, int w, int h)
2278 if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
2280 XResizeWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (ii),
2281 IMAGE_INSTANCE_X_SUBWINDOW_ID (ii),
2284 else /* must be a widget */
2288 if (!XtIsRealized (IMAGE_INSTANCE_X_WIDGET_ID (ii)))
2291 XSETIMAGE_INSTANCE (sw, ii);
2292 signal_simple_error ("XEmacs bug: subwindow is not realized", sw);
2295 XtSetArg (al [0], XtNwidth, (Dimension)w);
2296 XtSetArg (al [1], XtNheight, (Dimension)h);
2297 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 2);
2304 /************************************************************************/
2306 /************************************************************************/
2309 update_widget_face (struct Lisp_Image_Instance* ii, Lisp_Object domain)
2312 #ifdef LWLIB_WIDGETS_MOTIF
2313 XmFontList fontList;
2316 Lisp_Object pixel = FACE_FOREGROUND
2317 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2318 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2319 XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2322 pixel = FACE_BACKGROUND
2323 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2324 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2325 bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2327 XtSetArg (al [0], XtNbackground, bcolor.pixel);
2328 XtSetArg (al [1], XtNforeground, fcolor.pixel);
2330 #ifdef LWLIB_WIDGETS_MOTIF
2331 fontList = XmFontListCreate
2332 (FONT_INSTANCE_X_FONT
2333 (XFONT_INSTANCE (widget_face_font_info
2334 (domain, IMAGE_INSTANCE_WIDGET_FACE (ii),
2335 0, 0))), XmSTRING_DEFAULT_CHARSET);
2336 XtSetArg (al [2], XmNfontList, fontList );
2338 XtSetArg (al [2], XtNfont, (void*)FONT_INSTANCE_X_FONT
2339 (XFONT_INSTANCE (widget_face_font_info
2341 IMAGE_INSTANCE_WIDGET_FACE (ii),
2344 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 3);
2345 #ifdef LWLIB_WIDGETS_MOTIF
2346 XmFontListFree (fontList);
2351 x_widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2352 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2353 int dest_mask, Lisp_Object domain,
2354 CONST char* type, widget_value* wv)
2356 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2357 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii), pixel;
2358 struct device* d = XDEVICE (device);
2359 Lisp_Object frame = FW_FRAME (domain);
2360 struct frame* f = XFRAME (frame);
2365 int id = new_lwlib_id ();
2366 widget_value* clip_wv;
2367 XColor fcolor, bcolor;
2369 if (!DEVICE_X_P (d))
2370 signal_simple_error ("Not an X device", device);
2372 /* have to set the type this late in case there is no device
2373 instantiation for a widget. But we can go ahead and do it without
2374 checking because there is always a generic instantiator. */
2375 IMAGE_INSTANCE_TYPE (ii) = IMAGE_WIDGET;
2377 if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
2378 GET_C_STRING_OS_DATA_ALLOCA (IMAGE_INSTANCE_WIDGET_TEXT (ii), nm);
2380 ii->data = xnew_and_zero (struct x_subwindow_data);
2382 /* Create a clip window to contain the subwidget. Incredibly the
2383 XEmacs manager seems to be the most appropriate widget for
2384 this. Nothing else is simple enough and yet does what is
2386 clip_wv = xmalloc_widget_value ();
2388 XtSetArg (al [ac], XtNresize, False); ac++;
2389 XtSetArg (al [ac], XtNwidth,
2390 (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii)); ac++;
2391 XtSetArg (al [ac], XtNheight,
2392 (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); ac++;
2394 clip_wv->enabled = True;
2395 clip_wv->nargs = ac;
2397 clip_wv->name = xstrdup ("clip-window");
2398 clip_wv->value = xstrdup ("clip-window");
2400 IMAGE_INSTANCE_X_CLIPWIDGET (ii)
2401 = lw_create_widget ("clip-window", "clip-window", new_lwlib_id (),
2402 clip_wv, FRAME_X_CONTAINER_WIDGET (f),
2405 free_widget_value_tree (clip_wv);
2407 /* copy any args we were given */
2411 lw_add_value_args_to_args (wv, al, &ac);
2413 /* Fixup the colors. We have to do this *before* the widget gets
2414 created so that Motif will fix up the shadow colors
2415 correctly. Once the widget is created Motif won't do this
2417 pixel = FACE_FOREGROUND
2418 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2419 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2420 fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2422 pixel = FACE_BACKGROUND
2423 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2424 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2425 bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2427 XtSetArg (al [ac], XtNbackground, bcolor.pixel); ac++;
2428 XtSetArg (al [ac], XtNforeground, fcolor.pixel); ac++;
2429 /* we cannot allow widgets to resize themselves */
2430 XtSetArg (al [ac], XtNresize, False); ac++;
2431 XtSetArg (al [ac], XtNwidth,
2432 (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii)); ac++;
2433 XtSetArg (al [ac], XtNheight,
2434 (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); ac++;
2439 wid = lw_create_widget (type, wv->name, id, wv, IMAGE_INSTANCE_X_CLIPWIDGET (ii),
2440 False, 0, popup_selection_callback, 0);
2442 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)wid;
2443 IMAGE_INSTANCE_X_WIDGET_LWID (ii) = id;
2445 /* update the font. */
2446 update_widget_face (ii, domain);
2448 /* Resize the widget here so that the values do not get copied by
2451 XtSetArg (al [ac], XtNwidth,
2452 (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii)); ac++;
2453 XtSetArg (al [ac], XtNheight,
2454 (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); ac++;
2455 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, ac);
2456 /* because the EmacsManager is the widgets parent we have to
2457 offset the redisplay of the widget by the amount the text
2458 widget is inside the manager. */
2460 XtSetArg (al [ac], XtNx, &IMAGE_INSTANCE_X_WIDGET_XOFFSET (ii)); ac++;
2461 XtSetArg (al [ac], XtNy, &IMAGE_INSTANCE_X_WIDGET_YOFFSET (ii)); ac++;
2462 XtGetValues (FRAME_X_TEXT_WIDGET (f), al, ac);
2466 free_widget_value_tree (wv);
2470 x_widget_set_property (Lisp_Object image_instance, Lisp_Object prop,
2473 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2475 if (EQ (prop, Q_text))
2478 widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2480 GET_C_STRING_OS_DATA_ALLOCA (val, str);
2482 lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, False);
2485 /* Modify the face properties of the widget */
2486 if (EQ (prop, Q_face))
2488 update_widget_face (ii, IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2494 /* get properties of a control */
2496 x_widget_property (Lisp_Object image_instance, Lisp_Object prop)
2498 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2499 /* get the text from a control */
2500 if (EQ (prop, Q_text))
2502 widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2503 return build_ext_string (wv->value, FORMAT_OS);
2508 /* Instantiate a button widget. Unfortunately instantiated widgets are
2509 particular to a frame since they need to have a parent. It's not
2510 like images where you just select the image into the context you
2511 want to display it in and BitBlt it. So images instances can have a
2512 many-to-one relationship with things you see, whereas widgets can
2513 only be one-to-one (i.e. per frame) */
2515 x_button_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2516 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2517 int dest_mask, Lisp_Object domain)
2519 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2520 Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2521 Lisp_Object glyph = find_keyword_in_vector (instantiator, Q_image);
2522 widget_value* wv = xmalloc_widget_value ();
2524 button_item_to_widget_value (gui, wv, 1, 1);
2528 if (!IMAGE_INSTANCEP (glyph))
2529 glyph = glyph_image_instance (glyph, domain, ERROR_ME, 1);
2532 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2533 pointer_bg, dest_mask, domain, "button", wv);
2535 /* add the image if one was given */
2536 if (!NILP (glyph) && IMAGE_INSTANCEP (glyph))
2540 #ifdef LWLIB_WIDGETS_MOTIF
2541 XtSetArg (al [ac], XmNlabelType, XmPIXMAP); ac++;
2542 XtSetArg (al [ac], XmNlabelPixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph));ac++;
2544 XtSetArg (al [ac], XtNpixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph)); ac++;
2546 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, ac);
2550 /* get properties of a button */
2552 x_button_property (Lisp_Object image_instance, Lisp_Object prop)
2554 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2555 /* check the state of a button */
2556 if (EQ (prop, Q_selected))
2558 widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2568 /* instantiate a progress gauge */
2570 x_progress_gauge_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2571 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2572 int dest_mask, Lisp_Object domain)
2574 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2575 Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2576 widget_value* wv = xmalloc_widget_value ();
2578 button_item_to_widget_value (gui, wv, 1, 1);
2580 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2581 pointer_bg, dest_mask, domain, "progress", wv);
2584 /* set the properties of a progres guage */
2586 x_progress_gauge_set_property (Lisp_Object image_instance, Lisp_Object prop,
2589 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2591 if (EQ (prop, Q_percent))
2595 XtSetArg (al[0], XtNvalue, XINT (val));
2596 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 1);
2602 /* instantiate an edit control */
2604 x_edit_field_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2605 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2606 int dest_mask, Lisp_Object domain)
2608 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2609 Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2610 widget_value* wv = xmalloc_widget_value ();
2612 button_item_to_widget_value (gui, wv, 1, 1);
2614 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2615 pointer_bg, dest_mask, domain, "text-field", wv);
2618 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
2619 /* instantiate a combo control */
2621 x_combo_box_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2622 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2623 int dest_mask, Lisp_Object domain)
2625 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2626 widget_value * wv = 0;
2627 /* This is not done generically because of sizing problems under
2629 widget_instantiate_1 (image_instance, instantiator, pointer_fg,
2630 pointer_bg, dest_mask, domain, 1, 0, 0);
2632 wv = gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2634 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2635 pointer_bg, dest_mask, domain, "combo-box", wv);
2640 x_tab_control_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2641 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2642 int dest_mask, Lisp_Object domain)
2644 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2651 gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2653 /* Give each child label the correct foreground color. */
2654 pixel = FACE_FOREGROUND
2655 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2656 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2657 fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2658 XtSetArg (al [0], XtNtabForeground, fcolor.pixel);
2660 for (cur = wv->contents; cur; cur = cur->next)
2669 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2670 pointer_bg, dest_mask, domain, "tab-control", wv);
2673 /* set the properties of a tab control */
2675 x_tab_control_set_property (Lisp_Object image_instance, Lisp_Object prop,
2678 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2680 if (EQ (prop, Q_items))
2682 widget_value * wv = 0, *cur;
2687 check_valid_item_list_1 (val);
2689 IMAGE_INSTANCE_WIDGET_ITEMS (ii) =
2690 Fcons (XCAR (IMAGE_INSTANCE_WIDGET_ITEMS (ii)),
2691 parse_gui_item_tree_children (val));
2693 wv = gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2695 /* Give each child label the correct foreground color. */
2696 pixel = FACE_FOREGROUND
2697 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2698 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2699 fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2700 XtSetArg (al [0], XtNtabForeground, fcolor.pixel);
2702 for (cur = wv->contents; cur; cur = cur->next)
2711 lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, True);
2713 free_widget_value_tree (wv);
2720 /* instantiate a static control possible for putting other things in */
2722 x_label_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2723 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2724 int dest_mask, Lisp_Object domain)
2726 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2727 Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2728 widget_value* wv = xmalloc_widget_value ();
2730 button_item_to_widget_value (gui, wv, 1, 1);
2732 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2733 pointer_bg, dest_mask, domain, "button", wv);
2735 #endif /* HAVE_WIDGETS */
2738 /************************************************************************/
2739 /* initialization */
2740 /************************************************************************/
2743 syms_of_glyphs_x (void)
2746 DEFSUBR (Fchange_subwindow_property);
2751 console_type_create_glyphs_x (void)
2755 CONSOLE_HAS_METHOD (x, print_image_instance);
2756 CONSOLE_HAS_METHOD (x, finalize_image_instance);
2757 CONSOLE_HAS_METHOD (x, image_instance_equal);
2758 CONSOLE_HAS_METHOD (x, image_instance_hash);
2759 CONSOLE_HAS_METHOD (x, colorize_image_instance);
2760 CONSOLE_HAS_METHOD (x, init_image_instance_from_eimage);
2761 CONSOLE_HAS_METHOD (x, locate_pixmap_file);
2762 CONSOLE_HAS_METHOD (x, unmap_subwindow);
2763 CONSOLE_HAS_METHOD (x, map_subwindow);
2764 CONSOLE_HAS_METHOD (x, resize_subwindow);
2765 CONSOLE_HAS_METHOD (x, update_subwindow);
2769 image_instantiator_format_create_glyphs_x (void)
2771 IIFORMAT_VALID_CONSOLE (x, nothing);
2772 IIFORMAT_VALID_CONSOLE (x, string);
2773 IIFORMAT_VALID_CONSOLE (x, layout);
2774 IIFORMAT_VALID_CONSOLE (x, formatted_string);
2775 IIFORMAT_VALID_CONSOLE (x, inherit);
2777 INITIALIZE_DEVICE_IIFORMAT (x, xpm);
2778 IIFORMAT_HAS_DEVMETHOD (x, xpm, instantiate);
2781 IIFORMAT_VALID_CONSOLE (x, jpeg);
2784 IIFORMAT_VALID_CONSOLE (x, tiff);
2787 IIFORMAT_VALID_CONSOLE (x, png);
2790 IIFORMAT_VALID_CONSOLE (x, gif);
2792 INITIALIZE_DEVICE_IIFORMAT (x, xbm);
2793 IIFORMAT_HAS_DEVMETHOD (x, xbm, instantiate);
2795 INITIALIZE_DEVICE_IIFORMAT (x, subwindow);
2796 IIFORMAT_HAS_DEVMETHOD (x, subwindow, instantiate);
2799 INITIALIZE_DEVICE_IIFORMAT (x, button);
2800 IIFORMAT_HAS_DEVMETHOD (x, button, property);
2801 IIFORMAT_HAS_DEVMETHOD (x, button, instantiate);
2803 INITIALIZE_DEVICE_IIFORMAT (x, widget);
2804 IIFORMAT_HAS_DEVMETHOD (x, widget, property);
2805 IIFORMAT_HAS_DEVMETHOD (x, widget, set_property);
2806 /* progress gauge */
2807 INITIALIZE_DEVICE_IIFORMAT (x, progress_gauge);
2808 IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, set_property);
2809 IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, instantiate);
2811 INITIALIZE_DEVICE_IIFORMAT (x, edit_field);
2812 IIFORMAT_HAS_DEVMETHOD (x, edit_field, instantiate);
2813 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
2815 INITIALIZE_DEVICE_IIFORMAT (x, combo_box);
2816 IIFORMAT_HAS_DEVMETHOD (x, combo_box, instantiate);
2817 IIFORMAT_HAS_SHARED_DEVMETHOD (x, combo_box, set_property, tab_control);
2819 /* tab control widget */
2820 INITIALIZE_DEVICE_IIFORMAT (x, tab_control);
2821 IIFORMAT_HAS_DEVMETHOD (x, tab_control, instantiate);
2822 IIFORMAT_HAS_DEVMETHOD (x, tab_control, set_property);
2824 INITIALIZE_DEVICE_IIFORMAT (x, label);
2825 IIFORMAT_HAS_DEVMETHOD (x, label, instantiate);
2827 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (cursor_font, "cursor-font");
2828 IIFORMAT_VALID_CONSOLE (x, cursor_font);
2830 IIFORMAT_HAS_METHOD (cursor_font, validate);
2831 IIFORMAT_HAS_METHOD (cursor_font, possible_dest_types);
2832 IIFORMAT_HAS_METHOD (cursor_font, instantiate);
2834 IIFORMAT_VALID_KEYWORD (cursor_font, Q_data, check_valid_string);
2835 IIFORMAT_VALID_KEYWORD (cursor_font, Q_foreground, check_valid_string);
2836 IIFORMAT_VALID_KEYWORD (cursor_font, Q_background, check_valid_string);
2838 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (font, "font");
2840 IIFORMAT_HAS_METHOD (font, validate);
2841 IIFORMAT_HAS_METHOD (font, possible_dest_types);
2842 IIFORMAT_HAS_METHOD (font, instantiate);
2843 IIFORMAT_VALID_CONSOLE (x, font);
2845 IIFORMAT_VALID_KEYWORD (font, Q_data, check_valid_string);
2846 IIFORMAT_VALID_KEYWORD (font, Q_foreground, check_valid_string);
2847 IIFORMAT_VALID_KEYWORD (font, Q_background, check_valid_string);
2850 INITIALIZE_DEVICE_IIFORMAT (x, xface);
2851 IIFORMAT_HAS_DEVMETHOD (x, xface, instantiate);
2854 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (autodetect,
2857 IIFORMAT_HAS_METHOD (autodetect, validate);
2858 IIFORMAT_HAS_METHOD (autodetect, normalize);
2859 IIFORMAT_HAS_METHOD (autodetect, possible_dest_types);
2860 IIFORMAT_HAS_METHOD (autodetect, instantiate);
2861 IIFORMAT_VALID_CONSOLE (x, autodetect);
2863 IIFORMAT_VALID_KEYWORD (autodetect, Q_data, check_valid_string);
2867 vars_of_glyphs_x (void)
2869 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path /*
2870 A list of the directories in which X bitmap files may be found.
2871 If nil, this is initialized from the "*bitmapFilePath" resource.
2872 This is used by the `make-image-instance' function (however, note that if
2873 the environment variable XBMLANGPATH is set, it is consulted first).
2875 Vx_bitmap_file_path = Qnil;
2879 complex_vars_of_glyphs_x (void)
2881 #define BUILD_GLYPH_INST(variable, name) \
2882 Fadd_spec_to_specifier \
2883 (GLYPH_IMAGE (XGLYPH (variable)), \
2884 vector3 (Qxbm, Q_data, \
2885 list3 (make_int (name##_width), \
2886 make_int (name##_height), \
2887 make_ext_string (name##_bits, \
2888 sizeof (name##_bits), \
2892 BUILD_GLYPH_INST (Vtruncation_glyph, truncator);
2893 BUILD_GLYPH_INST (Vcontinuation_glyph, continuer);
2894 BUILD_GLYPH_INST (Vxemacs_logo, xemacs);
2895 BUILD_GLYPH_INST (Vhscroll_glyph, hscroll);
2897 #undef BUILD_GLYPH_INST