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, 2000 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 (widget_value* wv,
152 struct Lisp_Image_Instance* ii, Lisp_Object domain);
154 update_tab_widget_face (widget_value* wv,
155 struct Lisp_Image_Instance* ii, Lisp_Object domain);
161 /************************************************************************/
162 /* image instance methods */
163 /************************************************************************/
165 /************************************************************************/
166 /* convert from a series of RGB triples to an XImage formated for the */
168 /************************************************************************/
170 convert_EImage_to_XImage (Lisp_Object device, int width, int height,
171 unsigned char *pic, unsigned long **pixtbl,
178 int depth, bitmap_pad, bits_per_pixel, byte_cnt, i, j;
180 unsigned char *data, *ip, *dp;
181 quant_table *qtable = 0;
187 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
188 cmap = DEVICE_X_COLORMAP (XDEVICE(device));
189 vis = DEVICE_X_VISUAL (XDEVICE(device));
190 depth = DEVICE_X_DEPTH(XDEVICE(device));
192 if (vis->class == GrayScale || vis->class == StaticColor ||
193 vis->class == StaticGray)
195 /* #### Implement me!!! */
199 if (vis->class == PseudoColor)
201 /* Quantize the image and get a histogram while we're at it.
202 Do this first to save memory */
203 qtable = build_EImage_quantable(pic, width, height, 256);
204 if (qtable == NULL) return NULL;
207 bitmap_pad = ((depth > 16) ? 32 :
211 outimg = XCreateImage (dpy, vis,
212 depth, ZPixmap, 0, 0, width, height,
214 if (!outimg) return NULL;
216 bits_per_pixel = outimg->bits_per_pixel;
217 byte_cnt = bits_per_pixel >> 3;
219 data = (unsigned char *) xmalloc (outimg->bytes_per_line * height);
222 XDestroyImage (outimg);
225 outimg->data = (char *) data;
227 if (vis->class == PseudoColor)
229 unsigned long pixarray[256];
231 /* use our quantize table to allocate the colors */
233 *pixtbl = xnew_array (unsigned long, pixcount);
236 /* ### should implement a sort by popularity to assure proper allocation */
238 for (i = 0; i < qtable->num_active_colors; i++)
243 color.red = qtable->rm[i] ? qtable->rm[i] << 8 : 0;
244 color.green = qtable->gm[i] ? qtable->gm[i] << 8 : 0;
245 color.blue = qtable->bm[i] ? qtable->bm[i] << 8 : 0;
246 color.flags = DoRed | DoGreen | DoBlue;
247 res = allocate_nearest_color (dpy, cmap, vis, &color);
248 if (res > 0 && res < 3)
250 DO_REALLOC(*pixtbl, pixcount, n+1, unsigned long);
251 (*pixtbl)[n] = color.pixel;
254 pixarray[i] = color.pixel;
258 for (i = 0; i < height; i++)
260 dp = data + (i * outimg->bytes_per_line);
261 for (j = 0; j < width; j++)
266 conv.val = pixarray[QUANT_GET_COLOR(qtable,rd,gr,bl)];
268 if (outimg->byte_order == MSBFirst)
269 for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q];
271 for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q];
273 if (outimg->byte_order == MSBFirst)
274 for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q];
276 for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q];
282 unsigned long rshift,gshift,bshift,rbits,gbits,bbits,junk;
283 junk = vis->red_mask;
285 while ((junk & 0x1) == 0)
296 junk = vis->green_mask;
298 while ((junk & 0x1) == 0)
309 junk = vis->blue_mask;
311 while ((junk & 0x1) == 0)
323 for (i = 0; i < height; i++)
325 dp = data + (i * outimg->bytes_per_line);
326 for (j = 0; j < width; j++)
329 rd = *ip++ << (rbits - 8);
331 rd = *ip++ >> (8 - rbits);
333 gr = *ip++ << (gbits - 8);
335 gr = *ip++ >> (8 - gbits);
337 bl = *ip++ << (bbits - 8);
339 bl = *ip++ >> (8 - bbits);
341 conv.val = (rd << rshift) | (gr << gshift) | (bl << bshift);
343 if (outimg->byte_order == MSBFirst)
344 for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q];
346 for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q];
348 if (outimg->byte_order == MSBFirst)
349 for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q];
351 for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q];
362 x_print_image_instance (struct Lisp_Image_Instance *p,
363 Lisp_Object printcharfun,
368 switch (IMAGE_INSTANCE_TYPE (p))
370 case IMAGE_MONO_PIXMAP:
371 case IMAGE_COLOR_PIXMAP:
373 sprintf (buf, " (0x%lx", (unsigned long) IMAGE_INSTANCE_X_PIXMAP (p));
374 write_c_string (buf, printcharfun);
375 if (IMAGE_INSTANCE_X_MASK (p))
377 sprintf (buf, "/0x%lx", (unsigned long) IMAGE_INSTANCE_X_MASK (p));
378 write_c_string (buf, printcharfun);
380 write_c_string (")", printcharfun);
388 extern int debug_widget_instances;
392 x_finalize_image_instance (struct Lisp_Image_Instance *p)
397 if (DEVICE_LIVE_P (XDEVICE (p->device)))
399 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (p->device));
401 if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET)
403 if (IMAGE_INSTANCE_SUBWINDOW_ID (p))
406 debug_widget_instances--;
407 stderr_out ("widget destroyed, %d left\n", debug_widget_instances);
409 lw_destroy_widget (IMAGE_INSTANCE_X_WIDGET_ID (p));
410 lw_destroy_widget (IMAGE_INSTANCE_X_CLIPWIDGET (p));
411 IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0;
414 else if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
416 if (IMAGE_INSTANCE_SUBWINDOW_ID (p))
417 XDestroyWindow (dpy, IMAGE_INSTANCE_X_SUBWINDOW_ID (p));
418 IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0;
423 if (IMAGE_INSTANCE_PIXMAP_TIMEOUT (p))
424 disable_glyph_animated_timeout (IMAGE_INSTANCE_PIXMAP_TIMEOUT (p));
426 if (IMAGE_INSTANCE_X_MASK (p) &&
427 IMAGE_INSTANCE_X_MASK (p) != IMAGE_INSTANCE_X_PIXMAP (p))
428 XFreePixmap (dpy, IMAGE_INSTANCE_X_MASK (p));
429 IMAGE_INSTANCE_PIXMAP_MASK (p) = 0;
431 if (IMAGE_INSTANCE_X_PIXMAP_SLICES (p))
433 for (i = 0; i < IMAGE_INSTANCE_PIXMAP_MAXSLICE (p); i++)
434 if (IMAGE_INSTANCE_X_PIXMAP_SLICE (p,i))
436 XFreePixmap (dpy, IMAGE_INSTANCE_X_PIXMAP_SLICE (p,i));
437 IMAGE_INSTANCE_X_PIXMAP_SLICE (p, i) = 0;
439 xfree (IMAGE_INSTANCE_X_PIXMAP_SLICES (p));
440 IMAGE_INSTANCE_X_PIXMAP_SLICES (p) = 0;
443 if (IMAGE_INSTANCE_X_CURSOR (p))
445 XFreeCursor (dpy, IMAGE_INSTANCE_X_CURSOR (p));
446 IMAGE_INSTANCE_X_CURSOR (p) = 0;
449 if (IMAGE_INSTANCE_X_NPIXELS (p) != 0)
452 IMAGE_INSTANCE_X_COLORMAP (p),
453 IMAGE_INSTANCE_X_PIXELS (p),
454 IMAGE_INSTANCE_X_NPIXELS (p), 0);
455 IMAGE_INSTANCE_X_NPIXELS (p) = 0;
459 /* You can sometimes have pixels without a live device. I forget
460 why, but that's why we free them here if we have a pixmap type
461 image instance. It probably means that we might also get a memory
462 leak with widgets. */
463 if (IMAGE_INSTANCE_TYPE (p) != IMAGE_WIDGET
464 && IMAGE_INSTANCE_TYPE (p) != IMAGE_SUBWINDOW
465 && IMAGE_INSTANCE_X_PIXELS (p))
467 xfree (IMAGE_INSTANCE_X_PIXELS (p));
468 IMAGE_INSTANCE_X_PIXELS (p) = 0;
476 x_image_instance_equal (struct Lisp_Image_Instance *p1,
477 struct Lisp_Image_Instance *p2, int depth)
479 switch (IMAGE_INSTANCE_TYPE (p1))
481 case IMAGE_MONO_PIXMAP:
482 case IMAGE_COLOR_PIXMAP:
484 if (IMAGE_INSTANCE_X_COLORMAP (p1) != IMAGE_INSTANCE_X_COLORMAP (p2) ||
485 IMAGE_INSTANCE_X_NPIXELS (p1) != IMAGE_INSTANCE_X_NPIXELS (p2))
496 x_image_instance_hash (struct Lisp_Image_Instance *p, int depth)
498 switch (IMAGE_INSTANCE_TYPE (p))
500 case IMAGE_MONO_PIXMAP:
501 case IMAGE_COLOR_PIXMAP:
503 return IMAGE_INSTANCE_X_NPIXELS (p);
509 /* Set all the slots in an image instance structure to reasonable
510 default values. This is used somewhere within an instantiate
511 method. It is assumed that the device slot within the image
512 instance is already set -- this is the case when instantiate
513 methods are called. */
516 x_initialize_pixmap_image_instance (struct Lisp_Image_Instance *ii,
518 enum image_instance_type type)
520 ii->data = xnew_and_zero (struct x_image_instance_data);
521 IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) = slices;
522 IMAGE_INSTANCE_X_PIXMAP_SLICES (ii) =
523 xnew_array_and_zero (Pixmap, slices);
524 IMAGE_INSTANCE_TYPE (ii) = type;
525 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = Qnil;
526 IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (ii) = Qnil;
527 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) = Qnil;
528 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) = Qnil;
529 IMAGE_INSTANCE_PIXMAP_FG (ii) = Qnil;
530 IMAGE_INSTANCE_PIXMAP_BG (ii) = Qnil;
534 /************************************************************************/
535 /* pixmap file functions */
536 /************************************************************************/
538 /* Where bitmaps are; initialized from resource database */
539 Lisp_Object Vx_bitmap_file_path;
542 #define BITMAPDIR "/usr/include/X11/bitmaps"
545 #define USE_XBMLANGPATH
547 /* Given a pixmap filename, look through all of the "standard" places
548 where the file might be located. Return a full pathname if found;
549 otherwise, return Qnil. */
552 x_locate_pixmap_file (Lisp_Object name)
554 /* This function can GC if IN_REDISPLAY is false */
557 /* Check non-absolute pathnames with a directory component relative to
558 the search path; that's the way Xt does it. */
559 /* #### Unix-specific */
560 if (XSTRING_BYTE (name, 0) == '/' ||
561 (XSTRING_BYTE (name, 0) == '.' &&
562 (XSTRING_BYTE (name, 1) == '/' ||
563 (XSTRING_BYTE (name, 1) == '.' &&
564 (XSTRING_BYTE (name, 2) == '/')))))
566 if (!NILP (Ffile_readable_p (name)))
572 if (NILP (Vdefault_x_device))
573 /* This may occur during initialization. */
576 /* We only check the bitmapFilePath resource on the original X device. */
577 display = DEVICE_X_DISPLAY (XDEVICE (Vdefault_x_device));
579 #ifdef USE_XBMLANGPATH
581 char *path = egetenv ("XBMLANGPATH");
582 SubstitutionRec subs[1];
584 subs[0].substitution = (char *) XSTRING_DATA (name);
585 /* #### Motif uses a big hairy default if $XBMLANGPATH isn't set.
586 We don't. If you want it used, set it. */
588 (path = XtResolvePathname (display, "bitmaps", 0, 0, path,
589 subs, XtNumber (subs), 0)))
591 name = build_string (path);
598 if (NILP (Vx_bitmap_file_path))
602 if (XrmGetResource (XtDatabase (display),
603 "bitmapFilePath", "BitmapFilePath", &type, &value)
604 && !strcmp (type, "String"))
605 Vx_bitmap_file_path = decode_env_path (0, (char *) value.addr);
606 Vx_bitmap_file_path = nconc2 (Vx_bitmap_file_path,
607 (decode_path (BITMAPDIR)));
612 if (locate_file (Vx_bitmap_file_path, name, Qnil, &found, R_OK) < 0)
614 Lisp_Object temp = list1 (Vdata_directory);
618 locate_file (temp, name, Qnil, &found, R_OK);
627 locate_pixmap_file (Lisp_Object name)
629 return x_locate_pixmap_file (name);
634 write_lisp_string_to_temp_file (Lisp_Object string, char *filename_out)
636 Lisp_Object instream, outstream;
637 Lstream *istr, *ostr;
638 char tempbuf[1024]; /* some random amount */
641 static Extbyte_dynarr *conversion_out_dynarr;
642 Bytecount bstart, bend;
643 struct gcpro gcpro1, gcpro2;
645 Lisp_Object conv_out_stream;
650 /* This function can GC */
651 if (!conversion_out_dynarr)
652 conversion_out_dynarr = Dynarr_new (Extbyte);
654 Dynarr_reset (conversion_out_dynarr);
656 /* Create the temporary file ... */
657 sprintf (filename_out, "/tmp/emacs%d.XXXXXX", (int) getpid ());
658 mktemp (filename_out);
659 tmpfil = fopen (filename_out, "w");
664 int old_errno = errno;
666 unlink (filename_out);
669 report_file_error ("Creating temp file",
670 list1 (build_string (filename_out)));
673 CHECK_STRING (string);
674 get_string_range_byte (string, Qnil, Qnil, &bstart, &bend,
675 GB_HISTORICAL_STRING_BEHAVIOR);
676 instream = make_lisp_string_input_stream (string, bstart, bend);
677 istr = XLSTREAM (instream);
678 /* setup the out stream */
679 outstream = make_dynarr_output_stream((unsigned_char_dynarr *)conversion_out_dynarr);
680 ostr = XLSTREAM (outstream);
682 /* setup the conversion stream */
683 conv_out_stream = make_encoding_output_stream (ostr, Fget_coding_system(Qbinary));
684 costr = XLSTREAM (conv_out_stream);
685 GCPRO3 (instream, outstream, conv_out_stream);
687 GCPRO2 (instream, outstream);
690 /* Get the data while doing the conversion */
693 ssize_t size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
696 /* It does seem the flushes are necessary... */
698 Lstream_write (costr, tempbuf, size_in_bytes);
699 Lstream_flush (costr);
701 Lstream_write (ostr, tempbuf, size_in_bytes);
703 Lstream_flush (ostr);
704 if (fwrite ((unsigned char *)Dynarr_atp(conversion_out_dynarr, 0),
705 Dynarr_length(conversion_out_dynarr), 1, tmpfil) != 1)
710 /* reset the dynarr */
711 Lstream_rewind(ostr);
714 if (fclose (tmpfil) != 0)
716 Lstream_close (istr);
718 Lstream_close (costr);
720 Lstream_close (ostr);
723 Lstream_delete (istr);
724 Lstream_delete (ostr);
726 Lstream_delete (costr);
730 report_file_error ("Writing temp file",
731 list1 (build_string (filename_out)));
736 /************************************************************************/
737 /* cursor functions */
738 /************************************************************************/
740 /* Check that this server supports cursors of size WIDTH * HEIGHT. If
741 not, signal an error. INSTANTIATOR is only used in the error
745 check_pointer_sizes (Screen *xs, unsigned int width, unsigned int height,
746 Lisp_Object instantiator)
748 unsigned int best_width, best_height;
749 if (! XQueryBestCursor (DisplayOfScreen (xs), RootWindowOfScreen (xs),
750 width, height, &best_width, &best_height))
751 /* this means that an X error of some sort occurred (we trap
752 these so they're not fatal). */
753 signal_simple_error ("XQueryBestCursor() failed?", instantiator);
755 if (width > best_width || height > best_height)
756 error_with_frob (instantiator,
757 "pointer too large (%dx%d): "
758 "server requires %dx%d or smaller",
759 width, height, best_width, best_height);
764 generate_cursor_fg_bg (Lisp_Object device, Lisp_Object *foreground,
765 Lisp_Object *background, XColor *xfg, XColor *xbg)
767 if (!NILP (*foreground) && !COLOR_INSTANCEP (*foreground))
769 Fmake_color_instance (*foreground, device,
770 encode_error_behavior_flag (ERROR_ME));
771 if (COLOR_INSTANCEP (*foreground))
772 *xfg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (*foreground));
776 xfg->red = xfg->green = xfg->blue = 0;
779 if (!NILP (*background) && !COLOR_INSTANCEP (*background))
781 Fmake_color_instance (*background, device,
782 encode_error_behavior_flag (ERROR_ME));
783 if (COLOR_INSTANCEP (*background))
784 *xbg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (*background));
788 xbg->red = xbg->green = xbg->blue = ~0;
793 maybe_recolor_cursor (Lisp_Object image_instance, Lisp_Object foreground,
794 Lisp_Object background)
796 Lisp_Object device = XIMAGE_INSTANCE_DEVICE (image_instance);
799 generate_cursor_fg_bg (device, &foreground, &background, &xfg, &xbg);
800 if (!NILP (foreground) || !NILP (background))
802 XRecolorCursor (DEVICE_X_DISPLAY (XDEVICE (device)),
803 XIMAGE_INSTANCE_X_CURSOR (image_instance),
805 XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
806 XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
811 /************************************************************************/
812 /* color pixmap functions */
813 /************************************************************************/
815 /* Initialize an image instance from an XImage.
817 DEST_MASK specifies the mask of allowed image types.
819 PIXELS and NPIXELS specify an array of pixels that are used in
820 the image. These need to be kept around for the duration of the
821 image. When the image instance is freed, XFreeColors() will
822 automatically be called on all the pixels specified here; thus,
823 you should have allocated the pixels yourself using XAllocColor()
824 or the like. The array passed in is used directly without
825 being copied, so it should be heap data created with xmalloc().
826 It will be freed using xfree() when the image instance is
829 If this fails, signal an error. INSTANTIATOR is only used
830 in the error message.
832 #### This should be able to handle conversion into `pointer'.
833 Use the same code as for `xpm'. */
836 init_image_instance_from_x_image (struct Lisp_Image_Instance *ii,
840 unsigned long *pixels,
843 Lisp_Object instantiator)
845 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
851 if (!DEVICE_X_P (XDEVICE (device)))
852 signal_simple_error ("Not an X device", device);
854 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
855 d = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
857 if (!(dest_mask & IMAGE_COLOR_PIXMAP_MASK))
858 incompatible_image_types (instantiator, dest_mask,
859 IMAGE_COLOR_PIXMAP_MASK);
861 pixmap = XCreatePixmap (dpy, d, ximage->width,
862 ximage->height, ximage->depth);
864 signal_simple_error ("Unable to create pixmap", instantiator);
866 gc = XCreateGC (dpy, pixmap, 0, NULL);
869 XFreePixmap (dpy, pixmap);
870 signal_simple_error ("Unable to create GC", instantiator);
873 XPutImage (dpy, pixmap, gc, ximage, 0, 0, 0, 0,
874 ximage->width, ximage->height);
878 x_initialize_pixmap_image_instance (ii, slices, IMAGE_COLOR_PIXMAP);
880 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
881 find_keyword_in_vector (instantiator, Q_file);
883 /* Fixup a set of pixmaps. */
884 IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
886 IMAGE_INSTANCE_PIXMAP_MASK (ii) = 0;
887 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = ximage->width;
888 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = ximage->height;
889 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = ximage->depth;
890 IMAGE_INSTANCE_X_COLORMAP (ii) = cmap;
891 IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
892 IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
896 image_instance_add_x_image (struct Lisp_Image_Instance *ii,
899 Lisp_Object instantiator)
901 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
907 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
908 d = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
910 pixmap = XCreatePixmap (dpy, d, ximage->width,
911 ximage->height, ximage->depth);
913 signal_simple_error ("Unable to create pixmap", instantiator);
915 gc = XCreateGC (dpy, pixmap, 0, NULL);
918 XFreePixmap (dpy, pixmap);
919 signal_simple_error ("Unable to create GC", instantiator);
922 XPutImage (dpy, pixmap, gc, ximage, 0, 0, 0, 0,
923 ximage->width, ximage->height);
927 IMAGE_INSTANCE_X_PIXMAP_SLICE (ii, slice) = pixmap;
931 x_init_image_instance_from_eimage (struct Lisp_Image_Instance *ii,
932 int width, int height,
934 unsigned char *eimage,
936 Lisp_Object instantiator,
939 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
940 Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device));
941 unsigned long *pixtbl = NULL;
946 for (slice = 0; slice < slices; slice++)
948 ximage = convert_EImage_to_XImage (device, width, height,
949 eimage + (width * height * 3 * slice),
953 if (pixtbl) xfree (pixtbl);
954 signal_image_error("EImage to XImage conversion failed", instantiator);
957 /* Now create the pixmap and set up the image instance */
959 init_image_instance_from_x_image (ii, ximage, dest_mask,
960 cmap, pixtbl, npixels, slices,
963 image_instance_add_x_image (ii, ximage, slice, instantiator);
969 xfree (ximage->data);
972 XDestroyImage (ximage);
978 int read_bitmap_data_from_file (CONST char *filename, unsigned int *width,
979 unsigned int *height, unsigned char **datap,
980 int *x_hot, int *y_hot)
982 return XmuReadBitmapDataFromFile (filename, width, height,
983 datap, x_hot, y_hot);
986 /* Given inline data for a mono pixmap, create and return the
987 corresponding X object. */
990 pixmap_from_xbm_inline (Lisp_Object device, int width, int height,
991 /* Note that data is in ext-format! */
994 return XCreatePixmapFromBitmapData (DEVICE_X_DISPLAY (XDEVICE(device)),
995 XtWindow (DEVICE_XT_APP_SHELL (XDEVICE (device))),
996 (char *) bits, width, height,
1000 /* Given inline data for a mono pixmap, initialize the given
1001 image instance accordingly. */
1004 init_image_instance_from_xbm_inline (struct Lisp_Image_Instance *ii,
1005 int width, int height,
1006 /* Note that data is in ext-format! */
1008 Lisp_Object instantiator,
1009 Lisp_Object pointer_fg,
1010 Lisp_Object pointer_bg,
1013 Lisp_Object mask_filename)
1015 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1016 Lisp_Object foreground = find_keyword_in_vector (instantiator, Q_foreground);
1017 Lisp_Object background = find_keyword_in_vector (instantiator, Q_background);
1021 enum image_instance_type type;
1023 if (!DEVICE_X_P (XDEVICE (device)))
1024 signal_simple_error ("Not an X device", device);
1026 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1027 draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
1028 scr = DefaultScreenOfDisplay (dpy);
1030 if ((dest_mask & IMAGE_MONO_PIXMAP_MASK) &&
1031 (dest_mask & IMAGE_COLOR_PIXMAP_MASK))
1033 if (!NILP (foreground) || !NILP (background))
1034 type = IMAGE_COLOR_PIXMAP;
1036 type = IMAGE_MONO_PIXMAP;
1038 else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
1039 type = IMAGE_MONO_PIXMAP;
1040 else if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
1041 type = IMAGE_COLOR_PIXMAP;
1042 else if (dest_mask & IMAGE_POINTER_MASK)
1043 type = IMAGE_POINTER;
1045 incompatible_image_types (instantiator, dest_mask,
1046 IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
1047 | IMAGE_POINTER_MASK);
1049 x_initialize_pixmap_image_instance (ii, 1, type);
1050 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = width;
1051 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = height;
1052 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
1053 find_keyword_in_vector (instantiator, Q_file);
1057 case IMAGE_MONO_PIXMAP:
1059 IMAGE_INSTANCE_X_PIXMAP (ii) =
1060 pixmap_from_xbm_inline (device, width, height, (Extbyte *) bits);
1064 case IMAGE_COLOR_PIXMAP:
1066 Dimension d = DEVICE_X_DEPTH (XDEVICE(device));
1067 unsigned long fg = BlackPixelOfScreen (scr);
1068 unsigned long bg = WhitePixelOfScreen (scr);
1070 if (!NILP (foreground) && !COLOR_INSTANCEP (foreground))
1072 Fmake_color_instance (foreground, device,
1073 encode_error_behavior_flag (ERROR_ME));
1075 if (COLOR_INSTANCEP (foreground))
1076 fg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground)).pixel;
1078 if (!NILP (background) && !COLOR_INSTANCEP (background))
1080 Fmake_color_instance (background, device,
1081 encode_error_behavior_flag (ERROR_ME));
1083 if (COLOR_INSTANCEP (background))
1084 bg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background)).pixel;
1086 /* We used to duplicate the pixels using XAllocColor(), to protect
1087 against their getting freed. Just as easy to just store the
1088 color instances here and GC-protect them, so this doesn't
1090 IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
1091 IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
1092 IMAGE_INSTANCE_X_PIXMAP (ii) =
1093 XCreatePixmapFromBitmapData (dpy, draw,
1094 (char *) bits, width, height,
1096 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = d;
1102 XColor fg_color, bg_color;
1105 check_pointer_sizes (scr, width, height, instantiator);
1108 XCreatePixmapFromBitmapData (dpy, draw,
1109 (char *) bits, width, height,
1112 if (NILP (foreground))
1113 foreground = pointer_fg;
1114 if (NILP (background))
1115 background = pointer_bg;
1116 generate_cursor_fg_bg (device, &foreground, &background,
1117 &fg_color, &bg_color);
1119 IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
1120 IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
1121 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) =
1122 find_keyword_in_vector (instantiator, Q_hotspot_x);
1123 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) =
1124 find_keyword_in_vector (instantiator, Q_hotspot_y);
1125 IMAGE_INSTANCE_X_CURSOR (ii) =
1127 (dpy, source, mask, &fg_color, &bg_color,
1128 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ?
1129 XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) : 0,
1130 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) ?
1131 XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) : 0);
1141 xbm_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator,
1142 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1143 int dest_mask, int width, int height,
1144 /* Note that data is in ext-format! */
1147 Lisp_Object mask_data = find_keyword_in_vector (instantiator, Q_mask_data);
1148 Lisp_Object mask_file = find_keyword_in_vector (instantiator, Q_mask_file);
1149 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1151 CONST char *gcc_may_you_rot_in_hell;
1153 if (!NILP (mask_data))
1155 GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (mask_data))),
1156 gcc_may_you_rot_in_hell);
1158 pixmap_from_xbm_inline (IMAGE_INSTANCE_DEVICE (ii),
1159 XINT (XCAR (mask_data)),
1160 XINT (XCAR (XCDR (mask_data))),
1161 (CONST unsigned char *)
1162 gcc_may_you_rot_in_hell);
1165 init_image_instance_from_xbm_inline (ii, width, height, bits,
1166 instantiator, pointer_fg, pointer_bg,
1167 dest_mask, mask, mask_file);
1170 /* Instantiate method for XBM's. */
1173 x_xbm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1174 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1175 int dest_mask, Lisp_Object domain)
1177 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1178 CONST char *gcc_go_home;
1180 assert (!NILP (data));
1182 GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (data))),
1185 xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1186 pointer_bg, dest_mask, XINT (XCAR (data)),
1187 XINT (XCAR (XCDR (data))), gcc_go_home);
1193 /**********************************************************************
1195 **********************************************************************/
1196 /* xpm 3.2g and better has XpmCreatePixmapFromBuffer()...
1197 There was no version number in xpm.h before 3.3, but this should do.
1199 #if (XpmVersion >= 3) || defined(XpmExactColors)
1200 # define XPM_DOES_BUFFERS
1203 #ifndef XPM_DOES_BUFFERS
1204 Your version of XPM is too old. You cannot compile with it.
1205 Upgrade to version 3.2g or better or compile with --with-xpm=no.
1206 #endif /* !XPM_DOES_BUFFERS */
1208 static XpmColorSymbol *
1209 extract_xpm_color_names (XpmAttributes *xpmattrs, Lisp_Object device,
1211 Lisp_Object color_symbol_alist)
1213 /* This function can GC */
1214 Display *dpy = DEVICE_X_DISPLAY (XDEVICE(device));
1215 Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1218 Lisp_Object results = Qnil;
1220 XpmColorSymbol *symbols;
1221 struct gcpro gcpro1, gcpro2;
1223 GCPRO2 (results, device);
1225 /* We built up results to be (("name" . #<color>) ...) so that if an
1226 error happens we don't lose any malloc()ed data, or more importantly,
1227 leave any pixels allocated in the server. */
1229 LIST_LOOP (rest, color_symbol_alist)
1231 Lisp_Object cons = XCAR (rest);
1232 Lisp_Object name = XCAR (cons);
1233 Lisp_Object value = XCDR (cons);
1236 if (STRINGP (value))
1238 Fmake_color_instance
1239 (value, device, encode_error_behavior_flag (ERROR_ME_NOT));
1242 assert (COLOR_SPECIFIERP (value));
1243 value = Fspecifier_instance (value, domain, Qnil, Qnil);
1247 results = noseeum_cons (noseeum_cons (name, value), results);
1250 UNGCPRO; /* no more evaluation */
1252 if (i == 0) return 0;
1254 symbols = xnew_array (XpmColorSymbol, i);
1255 xpmattrs->valuemask |= XpmColorSymbols;
1256 xpmattrs->colorsymbols = symbols;
1257 xpmattrs->numsymbols = i;
1261 Lisp_Object cons = XCAR (results);
1262 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (XCDR (cons)));
1263 /* Duplicate the pixel value so that we still have a lock on it if
1264 the pixel we were passed is later freed. */
1265 if (! XAllocColor (dpy, cmap, &color))
1266 abort (); /* it must be allocable since we're just duplicating it */
1268 symbols [i].name = (char *) XSTRING_DATA (XCAR (cons));
1269 symbols [i].pixel = color.pixel;
1270 symbols [i].value = 0;
1271 free_cons (XCONS (cons));
1273 results = XCDR (results);
1274 free_cons (XCONS (cons));
1280 xpm_free (XpmAttributes *xpmattrs)
1282 /* Could conceivably lose if XpmXXX returned an error without first
1283 initializing this structure, if we didn't know that initializing it
1284 to all zeros was ok (and also that it's ok to call XpmFreeAttributes()
1285 multiple times, since it zeros slots as it frees them...) */
1286 XpmFreeAttributes (xpmattrs);
1290 x_xpm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1291 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1292 int dest_mask, Lisp_Object domain)
1294 /* This function can GC */
1295 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1296 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1297 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1305 XpmAttributes xpmattrs;
1307 XpmColorSymbol *color_symbols;
1308 Lisp_Object color_symbol_alist = find_keyword_in_vector (instantiator,
1310 enum image_instance_type type;
1314 if (!DEVICE_X_P (XDEVICE (device)))
1315 signal_simple_error ("Not an X device", device);
1317 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1318 xs = DefaultScreenOfDisplay (dpy);
1320 if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
1321 type = IMAGE_COLOR_PIXMAP;
1322 else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
1323 type = IMAGE_MONO_PIXMAP;
1324 else if (dest_mask & IMAGE_POINTER_MASK)
1325 type = IMAGE_POINTER;
1327 incompatible_image_types (instantiator, dest_mask,
1328 IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
1329 | IMAGE_POINTER_MASK);
1330 force_mono = (type != IMAGE_COLOR_PIXMAP);
1333 /* Although I haven't found it documented yet, it appears that pointers are
1334 always colored via the default window colormap... Sigh. */
1335 if (type == IMAGE_POINTER)
1337 cmap = DefaultColormap(dpy, DefaultScreen(dpy));
1338 depth = DefaultDepthOfScreen (xs);
1339 visual = DefaultVisualOfScreen (xs);
1343 cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1344 depth = DEVICE_X_DEPTH (XDEVICE(device));
1345 visual = DEVICE_X_VISUAL (XDEVICE(device));
1348 cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1349 depth = DEVICE_X_DEPTH (XDEVICE(device));
1350 visual = DEVICE_X_VISUAL (XDEVICE(device));
1353 x_initialize_pixmap_image_instance (ii, 1, type);
1355 assert (!NILP (data));
1359 xzero (xpmattrs); /* want XpmInitAttributes() */
1360 xpmattrs.valuemask = XpmReturnPixels;
1363 /* Without this, we get a 1-bit version of the color image, which
1364 isn't quite right. With this, we get the mono image, which might
1365 be very different looking. */
1366 xpmattrs.valuemask |= XpmColorKey;
1367 xpmattrs.color_key = XPM_MONO;
1369 xpmattrs.valuemask |= XpmDepth;
1373 xpmattrs.closeness = 65535;
1374 xpmattrs.valuemask |= XpmCloseness;
1375 xpmattrs.depth = depth;
1376 xpmattrs.valuemask |= XpmDepth;
1377 xpmattrs.visual = visual;
1378 xpmattrs.valuemask |= XpmVisual;
1379 xpmattrs.colormap = cmap;
1380 xpmattrs.valuemask |= XpmColormap;
1383 color_symbols = extract_xpm_color_names (&xpmattrs, device, domain,
1384 color_symbol_alist);
1386 result = XpmCreatePixmapFromBuffer (dpy,
1387 XtWindow(DEVICE_XT_APP_SHELL (XDEVICE(device))),
1388 (char *) XSTRING_DATA (data),
1389 &pixmap, &mask, &xpmattrs);
1393 xfree (color_symbols);
1394 xpmattrs.colorsymbols = 0; /* in case XpmFreeAttr is too smart... */
1395 xpmattrs.numsymbols = 0;
1402 case XpmFileInvalid:
1404 xpm_free (&xpmattrs);
1405 signal_image_error ("invalid XPM data", data);
1407 case XpmColorFailed:
1410 xpm_free (&xpmattrs);
1413 /* second time; blow out. */
1414 signal_double_file_error ("Reading pixmap data",
1415 "color allocation failed",
1420 if (! (dest_mask & IMAGE_MONO_PIXMAP_MASK))
1422 /* second time; blow out. */
1423 signal_double_file_error ("Reading pixmap data",
1424 "color allocation failed",
1428 IMAGE_INSTANCE_TYPE (ii) = IMAGE_MONO_PIXMAP;
1434 xpm_free (&xpmattrs);
1435 signal_double_file_error ("Parsing pixmap data",
1436 "out of memory", data);
1440 xpm_free (&xpmattrs);
1441 signal_double_file_error_2 ("Parsing pixmap data",
1442 "unknown error code",
1443 make_int (result), data);
1448 h = xpmattrs.height;
1451 int npixels = xpmattrs.npixels;
1456 pixels = xnew_array (Pixel, npixels);
1457 memcpy (pixels, xpmattrs.pixels, npixels * sizeof (Pixel));
1462 IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
1463 IMAGE_INSTANCE_PIXMAP_MASK (ii) = (void*)mask;
1464 IMAGE_INSTANCE_X_COLORMAP (ii) = cmap;
1465 IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
1466 IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
1467 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = w;
1468 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = h;
1469 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
1470 find_keyword_in_vector (instantiator, Q_file);
1475 case IMAGE_MONO_PIXMAP:
1478 case IMAGE_COLOR_PIXMAP:
1480 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = depth;
1486 int npixels = xpmattrs.npixels;
1487 Pixel *pixels = xpmattrs.pixels;
1490 int xhot = 0, yhot = 0;
1492 if (xpmattrs.valuemask & XpmHotspot)
1494 xhot = xpmattrs.x_hotspot;
1495 XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii), xpmattrs.x_hotspot);
1497 if (xpmattrs.valuemask & XpmHotspot)
1499 yhot = xpmattrs.y_hotspot;
1500 XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii), xpmattrs.y_hotspot);
1502 check_pointer_sizes (xs, w, h, instantiator);
1504 /* If the loaded pixmap has colors allocated (meaning it came from an
1505 XPM file), then use those as the default colors for the cursor we
1506 create. Otherwise, default to pointer_fg and pointer_bg.
1510 /* With an XBM file, it's obvious which bit is foreground
1511 and which is background, or rather, it's implicit: in
1512 an XBM file, a 1 bit is foreground, and a 0 bit is
1515 XCreatePixmapCursor() assumes this property of the
1516 pixmap it is called with as well; the `foreground'
1517 color argument is used for the 1 bits.
1519 With an XPM file, it's tricker, since the elements of
1520 the pixmap don't represent FG and BG, but are actual
1521 pixel values. So we need to figure out which of those
1522 pixels is the foreground color and which is the
1523 background. We do it by comparing RGB and assuming
1524 that the darker color is the foreground. This works
1525 with the result of xbmtopbm|ppmtoxpm, at least.
1527 It might be nice if there was some way to tag the
1528 colors in the XPM file with whether they are the
1529 foreground - perhaps with logical color names somehow?
1531 Once we have decided which color is the foreground, we
1532 need to ensure that that color corresponds to a `1' bit
1533 in the Pixmap. The XPM library wrote into the (1-bit)
1534 pixmap with XPutPixel, which will ignore all but the
1535 least significant bit.
1537 This means that a 1 bit in the image corresponds to
1538 `fg' only if `fg.pixel' is odd.
1540 (This also means that the image will be all the same
1541 color if both `fg' and `bg' are odd or even, but we can
1542 safely assume that that won't happen if the XPM file is
1545 The desired result is that the image use `1' to
1546 represent the foreground color, and `0' to represent
1547 the background color. So, we may need to invert the
1548 image to accomplish this; we invert if fg is
1549 odd. (Remember that WhitePixel and BlackPixel are not
1550 necessarily 1 and 0 respectively, though I think it
1551 might be safe to assume that one of them is always 1
1552 and the other is always 0. We also pretty much need to
1553 assume that one is even and the other is odd.)
1556 fg.pixel = pixels[0]; /* pick a pixel at random. */
1557 bg.pixel = fg.pixel;
1558 for (i = 1; i < npixels; i++) /* Look for an "other" pixel value.*/
1560 bg.pixel = pixels[i];
1561 if (fg.pixel != bg.pixel)
1565 /* If (fg.pixel == bg.pixel) then probably something has
1566 gone wrong, but I don't think signalling an error would
1569 XQueryColor (dpy, cmap, &fg);
1570 XQueryColor (dpy, cmap, &bg);
1572 /* If the foreground is lighter than the background, swap them.
1573 (This occurs semi-randomly, depending on the ordering of the
1574 color list in the XPM file.)
1577 unsigned short fg_total = ((fg.red / 3) + (fg.green / 3)
1579 unsigned short bg_total = ((bg.red / 3) + (bg.green / 3)
1581 if (fg_total > bg_total)
1590 /* If the fg pixel corresponds to a `0' in the bitmap, invert it.
1591 (This occurs (only?) on servers with Black=0, White=1.)
1593 if ((fg.pixel & 1) == 0)
1597 gcv.function = GXxor;
1599 gc = XCreateGC (dpy, pixmap, (GCFunction | GCForeground),
1601 XFillRectangle (dpy, pixmap, gc, 0, 0, w, h);
1607 generate_cursor_fg_bg (device, &pointer_fg, &pointer_bg,
1609 IMAGE_INSTANCE_PIXMAP_FG (ii) = pointer_fg;
1610 IMAGE_INSTANCE_PIXMAP_BG (ii) = pointer_bg;
1613 IMAGE_INSTANCE_X_CURSOR (ii) =
1615 (dpy, pixmap, mask, &fg, &bg, xhot, yhot);
1624 xpm_free (&xpmattrs); /* after we've read pixels and hotspot */
1627 #endif /* HAVE_XPM */
1632 /**********************************************************************
1634 **********************************************************************/
1636 /* This is about to get redefined! */
1639 /* We have to define SYSV32 so that compface.h includes string.h
1640 instead of strings.h. */
1645 #include <compface.h>
1649 /* JMP_BUF cannot be used here because if it doesn't get defined
1650 to jmp_buf we end up with a conflicting type error with the
1651 definition in compface.h */
1652 extern jmp_buf comp_env;
1656 x_xface_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1657 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1658 int dest_mask, Lisp_Object domain)
1660 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1662 char *p, *bits, *bp;
1663 CONST char * volatile emsg = 0;
1664 CONST char * volatile dstring;
1666 assert (!NILP (data));
1668 GET_C_STRING_BINARY_DATA_ALLOCA (data, dstring);
1670 if ((p = strchr (dstring, ':')))
1675 /* Must use setjmp not SETJMP because we used jmp_buf above not JMP_BUF */
1676 if (!(stattis = setjmp (comp_env)))
1678 UnCompAll ((char *) dstring);
1685 emsg = "uncompface: internal error";
1688 emsg = "uncompface: insufficient or invalid data";
1691 emsg = "uncompface: excess data ignored";
1696 signal_simple_error_2 (emsg, data, Qimage);
1698 bp = bits = (char *) alloca (PIXELS / 8);
1700 /* the compface library exports char F[], which uses a single byte per
1701 pixel to represent a 48x48 bitmap. Yuck. */
1702 for (i = 0, p = F; i < (PIXELS / 8); ++i)
1705 /* reverse the bit order of each byte... */
1706 for (b = n = 0; b < 8; ++b)
1713 xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1714 pointer_bg, dest_mask, 48, 48, bits);
1717 #endif /* HAVE_XFACE */
1720 /**********************************************************************
1722 **********************************************************************/
1725 autodetect_validate (Lisp_Object instantiator)
1727 data_must_be_present (instantiator);
1731 autodetect_normalize (Lisp_Object instantiator,
1732 Lisp_Object console_type)
1734 Lisp_Object file = find_keyword_in_vector (instantiator, Q_data);
1735 Lisp_Object filename = Qnil;
1736 Lisp_Object data = Qnil;
1737 struct gcpro gcpro1, gcpro2, gcpro3;
1738 Lisp_Object alist = Qnil;
1740 GCPRO3 (filename, data, alist);
1742 if (NILP (file)) /* no conversion necessary */
1743 RETURN_UNGCPRO (instantiator);
1745 alist = tagged_vector_to_alist (instantiator);
1747 filename = locate_pixmap_file (file);
1748 if (!NILP (filename))
1751 /* #### Apparently some versions of XpmReadFileToData, which is
1752 called by pixmap_to_lisp_data, don't return an error value
1753 if the given file is not a valid XPM file. Instead, they
1754 just seg fault. It is definitely caused by passing a
1755 bitmap. To try and avoid this we check for bitmaps first. */
1757 data = bitmap_to_lisp_data (filename, &xhot, &yhot, 1);
1761 alist = remassq_no_quit (Q_data, alist);
1762 alist = Fcons (Fcons (Q_file, filename),
1763 Fcons (Fcons (Q_data, data), alist));
1765 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
1768 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
1771 alist = xbm_mask_file_munging (alist, filename, Qnil, console_type);
1774 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
1776 RETURN_UNGCPRO (result);
1781 data = pixmap_to_lisp_data (filename, 1);
1785 alist = remassq_no_quit (Q_data, alist);
1786 alist = Fcons (Fcons (Q_file, filename),
1787 Fcons (Fcons (Q_data, data), alist));
1788 alist = Fcons (Fcons (Q_color_symbols,
1789 evaluate_xpm_color_symbols ()),
1792 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
1794 RETURN_UNGCPRO (result);
1800 /* If we couldn't convert it, just put it back as it is.
1801 We might try to further frob it later as a cursor-font
1802 specification. (We can't do that now because we don't know
1803 what dest-types it's going to be instantiated into.) */
1805 Lisp_Object result = alist_to_tagged_vector (Qautodetect, alist);
1807 RETURN_UNGCPRO (result);
1812 autodetect_possible_dest_types (void)
1815 IMAGE_MONO_PIXMAP_MASK |
1816 IMAGE_COLOR_PIXMAP_MASK |
1817 IMAGE_POINTER_MASK |
1822 autodetect_instantiate (Lisp_Object image_instance,
1823 Lisp_Object instantiator,
1824 Lisp_Object pointer_fg,
1825 Lisp_Object pointer_bg,
1826 int dest_mask, Lisp_Object domain)
1828 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1829 struct gcpro gcpro1, gcpro2, gcpro3;
1830 Lisp_Object alist = Qnil;
1831 Lisp_Object result = Qnil;
1832 int is_cursor_font = 0;
1834 GCPRO3 (data, alist, result);
1836 alist = tagged_vector_to_alist (instantiator);
1837 if (dest_mask & IMAGE_POINTER_MASK)
1839 CONST char *name_ext;
1840 GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext);
1841 if (XmuCursorNameToIndex (name_ext) != -1)
1843 result = alist_to_tagged_vector (Qcursor_font, alist);
1848 if (!is_cursor_font)
1849 result = alist_to_tagged_vector (Qstring, alist);
1853 cursor_font_instantiate (image_instance, result, pointer_fg,
1854 pointer_bg, dest_mask, domain);
1856 string_instantiate (image_instance, result, pointer_fg,
1857 pointer_bg, dest_mask, domain);
1863 /**********************************************************************
1865 **********************************************************************/
1868 font_validate (Lisp_Object instantiator)
1870 data_must_be_present (instantiator);
1873 /* XmuCvtStringToCursor is bogus in the following ways:
1875 - When it can't convert the given string to a real cursor, it will
1876 sometimes return a "success" value, after triggering a BadPixmap
1877 error. It then gives you a cursor that will itself generate BadCursor
1878 errors. So we install this error handler to catch/notice the X error
1879 and take that as meaning "couldn't convert."
1881 - When you tell it to find a cursor file that doesn't exist, it prints
1882 an error message on stderr. You can't make it not do that.
1884 - Also, using Xmu means we can't properly hack Lisp_Image_Instance
1885 objects, or XPM files, or $XBMLANGPATH.
1888 /* Duplicate the behavior of XmuCvtStringToCursor() to bypass its bogusness. */
1890 static int XLoadFont_got_error;
1893 XLoadFont_error_handler (Display *dpy, XErrorEvent *xerror)
1895 XLoadFont_got_error = 1;
1900 safe_XLoadFont (Display *dpy, char *name)
1903 int (*old_handler) (Display *, XErrorEvent *);
1904 XLoadFont_got_error = 0;
1906 old_handler = XSetErrorHandler (XLoadFont_error_handler);
1907 font = XLoadFont (dpy, name);
1909 XSetErrorHandler (old_handler);
1910 if (XLoadFont_got_error) return 0;
1915 font_possible_dest_types (void)
1917 return IMAGE_POINTER_MASK;
1921 font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1922 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1923 int dest_mask, Lisp_Object domain)
1925 /* This function can GC */
1926 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1927 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1928 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1932 char source_name[MAXPATHLEN], mask_name[MAXPATHLEN], dummy;
1933 int source_char, mask_char;
1935 Lisp_Object foreground, background;
1937 if (!DEVICE_X_P (XDEVICE (device)))
1938 signal_simple_error ("Not an X device", device);
1940 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1942 if (!STRINGP (data) ||
1943 strncmp ("FONT ", (char *) XSTRING_DATA (data), 5))
1944 signal_simple_error ("Invalid font-glyph instantiator",
1947 if (!(dest_mask & IMAGE_POINTER_MASK))
1948 incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
1950 foreground = find_keyword_in_vector (instantiator, Q_foreground);
1951 if (NILP (foreground))
1952 foreground = pointer_fg;
1953 background = find_keyword_in_vector (instantiator, Q_background);
1954 if (NILP (background))
1955 background = pointer_bg;
1957 generate_cursor_fg_bg (device, &foreground, &background, &fg, &bg);
1959 count = sscanf ((char *) XSTRING_DATA (data),
1960 "FONT %s %d %s %d %c",
1961 source_name, &source_char,
1962 mask_name, &mask_char, &dummy);
1963 /* Allow "%s %d %d" as well... */
1964 if (count == 3 && (1 == sscanf (mask_name, "%d %c", &mask_char, &dummy)))
1965 count = 4, mask_name[0] = 0;
1967 if (count != 2 && count != 4)
1968 signal_simple_error ("invalid cursor specification", data);
1969 source = safe_XLoadFont (dpy, source_name);
1971 signal_simple_error_2 ("couldn't load font",
1972 build_string (source_name),
1976 else if (!mask_name[0])
1980 mask = safe_XLoadFont (dpy, mask_name);
1983 Fsignal (Qerror, list3 (build_string ("couldn't load font"),
1984 build_string (mask_name), data));
1989 /* #### call XQueryTextExtents() and check_pointer_sizes() here. */
1991 x_initialize_pixmap_image_instance (ii, 1, IMAGE_POINTER);
1992 IMAGE_INSTANCE_X_CURSOR (ii) =
1993 XCreateGlyphCursor (dpy, source, mask, source_char, mask_char,
1995 XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
1996 XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
1997 XUnloadFont (dpy, source);
1998 if (mask && mask != source) XUnloadFont (dpy, mask);
2002 /**********************************************************************
2004 **********************************************************************/
2007 cursor_font_validate (Lisp_Object instantiator)
2009 data_must_be_present (instantiator);
2013 cursor_font_possible_dest_types (void)
2015 return IMAGE_POINTER_MASK;
2019 cursor_font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2020 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2021 int dest_mask, Lisp_Object domain)
2023 /* This function can GC */
2024 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
2025 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2026 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
2029 CONST char *name_ext;
2030 Lisp_Object foreground, background;
2032 if (!DEVICE_X_P (XDEVICE (device)))
2033 signal_simple_error ("Not an X device", device);
2035 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2037 if (!(dest_mask & IMAGE_POINTER_MASK))
2038 incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
2040 GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext);
2041 if ((i = XmuCursorNameToIndex (name_ext)) == -1)
2042 signal_simple_error ("Unrecognized cursor-font name", data);
2044 x_initialize_pixmap_image_instance (ii, 1, IMAGE_POINTER);
2045 IMAGE_INSTANCE_X_CURSOR (ii) = XCreateFontCursor (dpy, i);
2046 foreground = find_keyword_in_vector (instantiator, Q_foreground);
2047 if (NILP (foreground))
2048 foreground = pointer_fg;
2049 background = find_keyword_in_vector (instantiator, Q_background);
2050 if (NILP (background))
2051 background = pointer_bg;
2052 maybe_recolor_cursor (image_instance, foreground, background);
2056 x_colorize_image_instance (Lisp_Object image_instance,
2057 Lisp_Object foreground, Lisp_Object background)
2059 struct Lisp_Image_Instance *p;
2061 p = XIMAGE_INSTANCE (image_instance);
2063 switch (IMAGE_INSTANCE_TYPE (p))
2065 case IMAGE_MONO_PIXMAP:
2066 IMAGE_INSTANCE_TYPE (p) = IMAGE_COLOR_PIXMAP;
2067 /* Make sure there aren't two pointers to the same mask, causing
2068 it to get freed twice. */
2069 IMAGE_INSTANCE_PIXMAP_MASK (p) = 0;
2077 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
2078 Drawable draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (IMAGE_INSTANCE_DEVICE (p))));
2079 Dimension d = DEVICE_X_DEPTH (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
2080 Pixmap new = XCreatePixmap (dpy, draw,
2081 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
2082 IMAGE_INSTANCE_PIXMAP_HEIGHT (p), d);
2086 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground));
2087 gcv.foreground = color.pixel;
2088 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background));
2089 gcv.background = color.pixel;
2090 gc = XCreateGC (dpy, new, GCBackground|GCForeground, &gcv);
2091 XCopyPlane (dpy, IMAGE_INSTANCE_X_PIXMAP (p), new, gc, 0, 0,
2092 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
2093 IMAGE_INSTANCE_PIXMAP_HEIGHT (p),
2096 IMAGE_INSTANCE_X_PIXMAP (p) = new;
2097 IMAGE_INSTANCE_PIXMAP_DEPTH (p) = d;
2098 IMAGE_INSTANCE_PIXMAP_FG (p) = foreground;
2099 IMAGE_INSTANCE_PIXMAP_BG (p) = background;
2105 /************************************************************************/
2106 /* subwindow and widget support */
2107 /************************************************************************/
2109 /* unmap the image if it is a widget. This is used by redisplay via
2110 redisplay_unmap_subwindows */
2112 x_unmap_subwindow (struct Lisp_Image_Instance *p)
2114 if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
2117 (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2118 IMAGE_INSTANCE_X_CLIPWINDOW (p));
2120 else /* must be a widget */
2122 XtUnmapWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p));
2126 /* map the subwindow. This is used by redisplay via
2127 redisplay_output_subwindow */
2129 x_map_subwindow (struct Lisp_Image_Instance *p, int x, int y,
2130 struct display_glyph_area* dga)
2132 if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
2134 Window subwindow = IMAGE_INSTANCE_X_SUBWINDOW_ID (p);
2135 XMoveResizeWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2136 IMAGE_INSTANCE_X_CLIPWINDOW (p),
2137 x, y, dga->width, dga->height);
2138 XMoveWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2139 subwindow, -dga->xoffset, -dga->yoffset);
2140 XMapWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2141 IMAGE_INSTANCE_X_CLIPWINDOW (p));
2143 else /* must be a widget */
2145 XtConfigureWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p),
2146 x + IMAGE_INSTANCE_X_WIDGET_XOFFSET (p),
2147 y + IMAGE_INSTANCE_X_WIDGET_YOFFSET (p),
2148 dga->width, dga->height, 0);
2149 XtMoveWidget (IMAGE_INSTANCE_X_WIDGET_ID (p),
2150 -dga->xoffset, -dga->yoffset);
2151 XtMapWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p));
2155 /* when you click on a widget you may activate another widget this
2156 needs to be checked and all appropriate widgets updated */
2158 x_update_subwindow (struct Lisp_Image_Instance *p)
2161 if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET)
2163 widget_value* wv = gui_items_to_widget_values
2164 (IMAGE_INSTANCE_WIDGET_ITEMS (p));
2166 /* This seems ugly, but I'm not sure what else to do. */
2167 if (EQ (IMAGE_INSTANCE_WIDGET_TYPE (p), Qtab_control))
2169 update_tab_widget_face (wv, p,
2170 IMAGE_INSTANCE_SUBWINDOW_FRAME (p));
2172 /* update the colors and font */
2173 update_widget_face (wv, p, IMAGE_INSTANCE_SUBWINDOW_FRAME (p));
2175 /* now modify the widget */
2176 lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (p),
2178 free_widget_value_tree (wv);
2179 /* subwindow resizing now gets done by the parent function. */
2184 /* instantiate and x type subwindow */
2186 x_subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2187 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2188 int dest_mask, Lisp_Object domain)
2190 /* This function can GC */
2191 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2192 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
2193 Lisp_Object frame = FW_FRAME (domain);
2194 struct frame* f = XFRAME (frame);
2198 XSetWindowAttributes xswa;
2200 unsigned int w = IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii),
2201 h = IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii);
2203 if (!DEVICE_X_P (XDEVICE (device)))
2204 signal_simple_error ("Not an X device", device);
2206 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2207 xs = DefaultScreenOfDisplay (dpy);
2209 IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW;
2211 pw = XtWindow (FRAME_X_TEXT_WIDGET (f));
2213 ii->data = xnew_and_zero (struct x_subwindow_data);
2215 IMAGE_INSTANCE_X_SUBWINDOW_PARENT (ii) = pw;
2216 IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (ii) = DisplayOfScreen (xs);
2218 xswa.backing_store = Always;
2219 valueMask |= CWBackingStore;
2220 xswa.colormap = DefaultColormapOfScreen (xs);
2221 valueMask |= CWColormap;
2223 /* Create a window for clipping */
2224 IMAGE_INSTANCE_X_CLIPWINDOW (ii) =
2225 XCreateWindow (dpy, pw, 0, 0, w, h, 0, CopyFromParent,
2226 InputOutput, CopyFromParent, valueMask,
2229 /* Now put the subwindow inside the clip window. */
2230 win = XCreateWindow (dpy, IMAGE_INSTANCE_X_CLIPWINDOW (ii),
2231 0, 0, w, h, 0, CopyFromParent,
2232 InputOutput, CopyFromParent, valueMask,
2235 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)win;
2239 /* #### Should this function exist? If there's any doubt I'm not implementing it --andyp */
2240 DEFUN ("change-subwindow-property", Fchange_subwindow_property, 3, 3, 0, /*
2241 For the given SUBWINDOW, set PROPERTY to DATA, which is a string.
2242 Subwindows are not currently implemented.
2244 (subwindow, property, data))
2247 struct Lisp_Subwindow *sw;
2250 CHECK_SUBWINDOW (subwindow);
2251 CHECK_STRING (property);
2252 CHECK_STRING (data);
2254 sw = XSUBWINDOW (subwindow);
2255 dpy = DisplayOfScreen (LISP_DEVICE_TO_X_SCREEN
2256 (FRAME_DEVICE (XFRAME (sw->frame))));
2258 property_atom = XInternAtom (dpy, (char *) XSTRING_DATA (property), False);
2259 XChangeProperty (dpy, sw->subwindow, property_atom, XA_STRING, 8,
2261 XSTRING_DATA (data),
2262 XSTRING_LENGTH (data));
2269 x_resize_subwindow (struct Lisp_Image_Instance* ii, int w, int h)
2271 if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
2273 XResizeWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (ii),
2274 IMAGE_INSTANCE_X_SUBWINDOW_ID (ii),
2277 else /* must be a widget */
2281 if (!XtIsRealized (IMAGE_INSTANCE_X_WIDGET_ID (ii)))
2284 XSETIMAGE_INSTANCE (sw, ii);
2285 signal_simple_error ("XEmacs bug: subwindow is not realized", sw);
2288 XtSetArg (al [0], XtNwidth, (Dimension)w);
2289 XtSetArg (al [1], XtNheight, (Dimension)h);
2290 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 2);
2297 /************************************************************************/
2299 /************************************************************************/
2302 update_widget_face (widget_value* wv, struct Lisp_Image_Instance *ii,
2305 #ifdef LWLIB_WIDGETS_MOTIF
2306 XmFontList fontList;
2308 /* Update the foreground. */
2309 Lisp_Object pixel = FACE_FOREGROUND
2310 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2312 XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel)), bcolor;
2313 lw_add_widget_value_arg (wv, XtNforeground, fcolor.pixel);
2315 /* Update the background. */
2316 pixel = FACE_BACKGROUND (IMAGE_INSTANCE_WIDGET_FACE (ii),
2318 bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2319 lw_add_widget_value_arg (wv, XtNbackground, bcolor.pixel);
2321 #ifdef LWLIB_WIDGETS_MOTIF
2322 fontList = XmFontListCreate
2323 (FONT_INSTANCE_X_FONT
2324 (XFONT_INSTANCE (query_string_font
2325 (IMAGE_INSTANCE_WIDGET_TEXT (ii),
2326 IMAGE_INSTANCE_WIDGET_FACE (ii),
2327 domain))), XmSTRING_DEFAULT_CHARSET);
2328 lw_add_widget_value_arg (wv, XmNfontList, (XtArgVal)fontList);
2330 lw_add_widget_value_arg
2331 (wv, XtNfont, (XtArgVal)FONT_INSTANCE_X_FONT
2332 (XFONT_INSTANCE (query_string_font
2333 (IMAGE_INSTANCE_WIDGET_TEXT (ii),
2334 IMAGE_INSTANCE_WIDGET_FACE (ii),
2339 update_tab_widget_face (widget_value* wv, struct Lisp_Image_Instance *ii,
2344 widget_value* val = wv->contents, *cur;
2346 /* Give each child label the correct foreground color. */
2347 Lisp_Object pixel = FACE_FOREGROUND
2348 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2350 XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2351 lw_add_widget_value_arg (val, XtNtabForeground, fcolor.pixel);
2353 for (cur = val->next; cur; cur = cur->next)
2357 lw_copy_widget_value_args (val, cur);
2364 x_widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2365 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2366 int dest_mask, Lisp_Object domain,
2367 CONST char* type, widget_value* wv)
2369 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2370 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii), pixel;
2371 struct device* d = XDEVICE (device);
2372 Lisp_Object frame = FW_FRAME (domain);
2373 struct frame* f = XFRAME (frame);
2378 int id = new_lwlib_id ();
2379 widget_value* clip_wv;
2380 XColor fcolor, bcolor;
2382 if (!DEVICE_X_P (d))
2383 signal_simple_error ("Not an X device", device);
2385 /* have to set the type this late in case there is no device
2386 instantiation for a widget. But we can go ahead and do it without
2387 checking because there is always a generic instantiator. */
2388 IMAGE_INSTANCE_TYPE (ii) = IMAGE_WIDGET;
2390 if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
2391 GET_C_STRING_OS_DATA_ALLOCA (IMAGE_INSTANCE_WIDGET_TEXT (ii), nm);
2393 ii->data = xnew_and_zero (struct x_subwindow_data);
2395 /* Create a clip window to contain the subwidget. Incredibly the
2396 XEmacs manager seems to be the most appropriate widget for
2397 this. Nothing else is simple enough and yet does what is
2399 clip_wv = xmalloc_widget_value ();
2401 lw_add_widget_value_arg (clip_wv, XtNresize, False);
2402 lw_add_widget_value_arg (clip_wv, XtNwidth,
2403 (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii));
2404 lw_add_widget_value_arg (clip_wv, XtNheight,
2405 (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii));
2406 clip_wv->enabled = True;
2408 clip_wv->name = xstrdup ("clip-window");
2409 clip_wv->value = xstrdup ("clip-window");
2411 IMAGE_INSTANCE_X_CLIPWIDGET (ii)
2412 = lw_create_widget ("clip-window", "clip-window", new_lwlib_id (),
2413 clip_wv, FRAME_X_CONTAINER_WIDGET (f),
2416 free_widget_value_tree (clip_wv);
2418 /* copy any args we were given */
2420 lw_add_value_args_to_args (wv, al, &ac);
2422 /* Fixup the colors. We have to do this *before* the widget gets
2423 created so that Motif will fix up the shadow colors
2424 correctly. Once the widget is created Motif won't do this
2426 pixel = FACE_FOREGROUND
2427 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2428 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2429 fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2431 pixel = FACE_BACKGROUND
2432 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2433 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2434 bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2436 lw_add_widget_value_arg (wv, XtNbackground, bcolor.pixel);
2437 lw_add_widget_value_arg (wv, XtNforeground, fcolor.pixel);
2438 /* we cannot allow widgets to resize themselves */
2439 lw_add_widget_value_arg (wv, XtNresize, False);
2440 lw_add_widget_value_arg (wv, XtNwidth,
2441 (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii));
2442 lw_add_widget_value_arg (wv, XtNheight,
2443 (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii));
2444 /* update the font. */
2445 update_widget_face (wv, ii, domain);
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 /* Resize the widget here so that the values do not get copied by
2456 XtSetArg (al [ac], XtNwidth,
2457 (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii)); ac++;
2458 XtSetArg (al [ac], XtNheight,
2459 (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); ac++;
2460 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, ac);
2461 /* because the EmacsManager is the widgets parent we have to
2462 offset the redisplay of the widget by the amount the text
2463 widget is inside the manager. */
2465 XtSetArg (al [ac], XtNx, &IMAGE_INSTANCE_X_WIDGET_XOFFSET (ii)); ac++;
2466 XtSetArg (al [ac], XtNy, &IMAGE_INSTANCE_X_WIDGET_YOFFSET (ii)); ac++;
2467 XtGetValues (FRAME_X_TEXT_WIDGET (f), al, ac);
2469 XtSetMappedWhenManaged (wid, TRUE);
2471 free_widget_value_tree (wv);
2475 x_widget_set_property (Lisp_Object image_instance, Lisp_Object prop,
2478 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2480 /* Modify the text properties of the widget */
2481 if (EQ (prop, Q_text))
2484 widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2486 GET_C_STRING_OS_DATA_ALLOCA (val, str);
2488 lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, False);
2491 /* Modify the text properties of the widget */
2492 else if (EQ (prop, Q_face))
2494 widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2495 update_widget_face (wv, ii, IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2496 lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, False);
2501 /* get properties of a control */
2503 x_widget_property (Lisp_Object image_instance, Lisp_Object prop)
2505 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2506 /* get the text from a control */
2507 if (EQ (prop, Q_text))
2509 widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2510 return build_ext_string (wv->value, FORMAT_OS);
2515 /* Instantiate a button widget. Unfortunately instantiated widgets are
2516 particular to a frame since they need to have a parent. It's not
2517 like images where you just select the image into the context you
2518 want to display it in and BitBlt it. So images instances can have a
2519 many-to-one relationship with things you see, whereas widgets can
2520 only be one-to-one (i.e. per frame) */
2522 x_button_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2523 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2524 int dest_mask, Lisp_Object domain)
2526 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2527 Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2528 Lisp_Object glyph = find_keyword_in_vector (instantiator, Q_image);
2529 widget_value* wv = xmalloc_widget_value ();
2531 button_item_to_widget_value (gui, wv, 1, 1);
2535 if (!IMAGE_INSTANCEP (glyph))
2536 glyph = glyph_image_instance (glyph, domain, ERROR_ME, 1);
2539 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2540 pointer_bg, dest_mask, domain, "button", wv);
2542 /* add the image if one was given */
2543 if (!NILP (glyph) && IMAGE_INSTANCEP (glyph))
2547 #ifdef LWLIB_WIDGETS_MOTIF
2548 XtSetArg (al [ac], XmNlabelType, XmPIXMAP); ac++;
2549 XtSetArg (al [ac], XmNlabelPixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph));ac++;
2551 XtSetArg (al [ac], XtNpixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph)); ac++;
2553 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, ac);
2557 /* get properties of a button */
2559 x_button_property (Lisp_Object image_instance, Lisp_Object prop)
2561 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2562 /* check the state of a button */
2563 if (EQ (prop, Q_selected))
2565 widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2575 /* instantiate a progress gauge */
2577 x_progress_gauge_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2578 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2579 int dest_mask, Lisp_Object domain)
2581 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2582 Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2583 widget_value* wv = xmalloc_widget_value ();
2585 button_item_to_widget_value (gui, wv, 1, 1);
2587 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2588 pointer_bg, dest_mask, domain, "progress", wv);
2591 /* set the properties of a progres guage */
2593 x_progress_gauge_set_property (Lisp_Object image_instance, Lisp_Object prop,
2596 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2598 if (EQ (prop, Q_percent))
2602 XtSetArg (al[0], XtNvalue, XINT (val));
2603 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 1);
2609 /* instantiate an edit control */
2611 x_edit_field_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2612 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2613 int dest_mask, Lisp_Object domain)
2615 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2616 Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2617 widget_value* wv = xmalloc_widget_value ();
2619 button_item_to_widget_value (gui, wv, 1, 1);
2621 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2622 pointer_bg, dest_mask, domain, "text-field", wv);
2625 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
2626 /* instantiate a combo control */
2628 x_combo_box_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2629 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2630 int dest_mask, Lisp_Object domain)
2632 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2633 widget_value * wv = 0;
2634 /* This is not done generically because of sizing problems under
2636 widget_instantiate (image_instance, instantiator, pointer_fg,
2637 pointer_bg, dest_mask, domain);
2639 wv = gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2641 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2642 pointer_bg, dest_mask, domain, "combo-box", wv);
2647 x_tab_control_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2648 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2649 int dest_mask, Lisp_Object domain)
2651 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2653 gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2655 update_tab_widget_face (wv, ii,
2656 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2658 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2659 pointer_bg, dest_mask, domain, "tab-control", wv);
2662 /* set the properties of a tab control */
2664 x_tab_control_set_property (Lisp_Object image_instance, Lisp_Object prop,
2667 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2669 if (EQ (prop, Q_items))
2671 widget_value * wv = 0;
2672 check_valid_item_list_1 (val);
2674 IMAGE_INSTANCE_WIDGET_ITEMS (ii) =
2675 Fcons (XCAR (IMAGE_INSTANCE_WIDGET_ITEMS (ii)),
2676 parse_gui_item_tree_children (val));
2678 wv = gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2680 update_tab_widget_face (wv, ii,
2681 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2683 lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, True);
2685 free_widget_value_tree (wv);
2692 /* instantiate a static control possible for putting other things in */
2694 x_label_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2695 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2696 int dest_mask, Lisp_Object domain)
2698 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2699 Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2700 widget_value* wv = xmalloc_widget_value ();
2702 button_item_to_widget_value (gui, wv, 1, 1);
2704 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2705 pointer_bg, dest_mask, domain, "button", wv);
2707 #endif /* HAVE_WIDGETS */
2710 /************************************************************************/
2711 /* initialization */
2712 /************************************************************************/
2715 syms_of_glyphs_x (void)
2718 DEFSUBR (Fchange_subwindow_property);
2723 console_type_create_glyphs_x (void)
2727 CONSOLE_HAS_METHOD (x, print_image_instance);
2728 CONSOLE_HAS_METHOD (x, finalize_image_instance);
2729 CONSOLE_HAS_METHOD (x, image_instance_equal);
2730 CONSOLE_HAS_METHOD (x, image_instance_hash);
2731 CONSOLE_HAS_METHOD (x, colorize_image_instance);
2732 CONSOLE_HAS_METHOD (x, init_image_instance_from_eimage);
2733 CONSOLE_HAS_METHOD (x, locate_pixmap_file);
2734 CONSOLE_HAS_METHOD (x, unmap_subwindow);
2735 CONSOLE_HAS_METHOD (x, map_subwindow);
2736 CONSOLE_HAS_METHOD (x, resize_subwindow);
2737 CONSOLE_HAS_METHOD (x, update_subwindow);
2741 image_instantiator_format_create_glyphs_x (void)
2743 IIFORMAT_VALID_CONSOLE (x, nothing);
2744 IIFORMAT_VALID_CONSOLE (x, string);
2745 IIFORMAT_VALID_CONSOLE (x, layout);
2746 IIFORMAT_VALID_CONSOLE (x, formatted_string);
2747 IIFORMAT_VALID_CONSOLE (x, inherit);
2749 INITIALIZE_DEVICE_IIFORMAT (x, xpm);
2750 IIFORMAT_HAS_DEVMETHOD (x, xpm, instantiate);
2753 IIFORMAT_VALID_CONSOLE (x, jpeg);
2756 IIFORMAT_VALID_CONSOLE (x, tiff);
2759 IIFORMAT_VALID_CONSOLE (x, png);
2762 IIFORMAT_VALID_CONSOLE (x, gif);
2764 INITIALIZE_DEVICE_IIFORMAT (x, xbm);
2765 IIFORMAT_HAS_DEVMETHOD (x, xbm, instantiate);
2767 INITIALIZE_DEVICE_IIFORMAT (x, subwindow);
2768 IIFORMAT_HAS_DEVMETHOD (x, subwindow, instantiate);
2771 INITIALIZE_DEVICE_IIFORMAT (x, button);
2772 IIFORMAT_HAS_DEVMETHOD (x, button, property);
2773 IIFORMAT_HAS_DEVMETHOD (x, button, instantiate);
2775 INITIALIZE_DEVICE_IIFORMAT (x, widget);
2776 IIFORMAT_HAS_DEVMETHOD (x, widget, property);
2777 IIFORMAT_HAS_DEVMETHOD (x, widget, set_property);
2778 /* progress gauge */
2779 INITIALIZE_DEVICE_IIFORMAT (x, progress_gauge);
2780 IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, set_property);
2781 IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, instantiate);
2783 INITIALIZE_DEVICE_IIFORMAT (x, edit_field);
2784 IIFORMAT_HAS_DEVMETHOD (x, edit_field, instantiate);
2785 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
2787 INITIALIZE_DEVICE_IIFORMAT (x, combo_box);
2788 IIFORMAT_HAS_DEVMETHOD (x, combo_box, instantiate);
2789 IIFORMAT_HAS_SHARED_DEVMETHOD (x, combo_box, set_property, tab_control);
2791 /* tab control widget */
2792 INITIALIZE_DEVICE_IIFORMAT (x, tab_control);
2793 IIFORMAT_HAS_DEVMETHOD (x, tab_control, instantiate);
2794 IIFORMAT_HAS_DEVMETHOD (x, tab_control, set_property);
2796 INITIALIZE_DEVICE_IIFORMAT (x, label);
2797 IIFORMAT_HAS_DEVMETHOD (x, label, instantiate);
2799 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (cursor_font, "cursor-font");
2800 IIFORMAT_VALID_CONSOLE (x, cursor_font);
2802 IIFORMAT_HAS_METHOD (cursor_font, validate);
2803 IIFORMAT_HAS_METHOD (cursor_font, possible_dest_types);
2804 IIFORMAT_HAS_METHOD (cursor_font, instantiate);
2806 IIFORMAT_VALID_KEYWORD (cursor_font, Q_data, check_valid_string);
2807 IIFORMAT_VALID_KEYWORD (cursor_font, Q_foreground, check_valid_string);
2808 IIFORMAT_VALID_KEYWORD (cursor_font, Q_background, check_valid_string);
2810 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (font, "font");
2812 IIFORMAT_HAS_METHOD (font, validate);
2813 IIFORMAT_HAS_METHOD (font, possible_dest_types);
2814 IIFORMAT_HAS_METHOD (font, instantiate);
2815 IIFORMAT_VALID_CONSOLE (x, font);
2817 IIFORMAT_VALID_KEYWORD (font, Q_data, check_valid_string);
2818 IIFORMAT_VALID_KEYWORD (font, Q_foreground, check_valid_string);
2819 IIFORMAT_VALID_KEYWORD (font, Q_background, check_valid_string);
2822 INITIALIZE_DEVICE_IIFORMAT (x, xface);
2823 IIFORMAT_HAS_DEVMETHOD (x, xface, instantiate);
2826 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (autodetect,
2829 IIFORMAT_HAS_METHOD (autodetect, validate);
2830 IIFORMAT_HAS_METHOD (autodetect, normalize);
2831 IIFORMAT_HAS_METHOD (autodetect, possible_dest_types);
2832 IIFORMAT_HAS_METHOD (autodetect, instantiate);
2833 IIFORMAT_VALID_CONSOLE (x, autodetect);
2835 IIFORMAT_VALID_KEYWORD (autodetect, Q_data, check_valid_string);
2839 vars_of_glyphs_x (void)
2841 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path /*
2842 A list of the directories in which X bitmap files may be found.
2843 If nil, this is initialized from the "*bitmapFilePath" resource.
2844 This is used by the `make-image-instance' function (however, note that if
2845 the environment variable XBMLANGPATH is set, it is consulted first).
2847 Vx_bitmap_file_path = Qnil;
2851 complex_vars_of_glyphs_x (void)
2853 #define BUILD_GLYPH_INST(variable, name) \
2854 Fadd_spec_to_specifier \
2855 (GLYPH_IMAGE (XGLYPH (variable)), \
2856 vector3 (Qxbm, Q_data, \
2857 list3 (make_int (name##_width), \
2858 make_int (name##_height), \
2859 make_ext_string (name##_bits, \
2860 sizeof (name##_bits), \
2864 BUILD_GLYPH_INST (Vtruncation_glyph, truncator);
2865 BUILD_GLYPH_INST (Vcontinuation_glyph, continuer);
2866 BUILD_GLYPH_INST (Vxemacs_logo, xemacs);
2867 BUILD_GLYPH_INST (Vhscroll_glyph, hscroll);
2869 #undef BUILD_GLYPH_INST