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 Lisp_Image_Instance* ii, Lisp_Object domain);
154 update_tab_widget_face (widget_value* wv,
155 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 (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 (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_X_WIDGET_ID (p) = 0;
412 IMAGE_INSTANCE_X_CLIPWIDGET (p) = 0;
415 else if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
417 if (IMAGE_INSTANCE_SUBWINDOW_ID (p))
418 XDestroyWindow (dpy, IMAGE_INSTANCE_X_SUBWINDOW_ID (p));
419 IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0;
424 if (IMAGE_INSTANCE_PIXMAP_TIMEOUT (p))
425 disable_glyph_animated_timeout (IMAGE_INSTANCE_PIXMAP_TIMEOUT (p));
427 if (IMAGE_INSTANCE_X_MASK (p) &&
428 IMAGE_INSTANCE_X_MASK (p) != IMAGE_INSTANCE_X_PIXMAP (p))
429 XFreePixmap (dpy, IMAGE_INSTANCE_X_MASK (p));
430 IMAGE_INSTANCE_PIXMAP_MASK (p) = 0;
432 if (IMAGE_INSTANCE_X_PIXMAP_SLICES (p))
434 for (i = 0; i < IMAGE_INSTANCE_PIXMAP_MAXSLICE (p); i++)
435 if (IMAGE_INSTANCE_X_PIXMAP_SLICE (p,i))
437 XFreePixmap (dpy, IMAGE_INSTANCE_X_PIXMAP_SLICE (p,i));
438 IMAGE_INSTANCE_X_PIXMAP_SLICE (p, i) = 0;
440 xfree (IMAGE_INSTANCE_X_PIXMAP_SLICES (p));
441 IMAGE_INSTANCE_X_PIXMAP_SLICES (p) = 0;
444 if (IMAGE_INSTANCE_X_CURSOR (p))
446 XFreeCursor (dpy, IMAGE_INSTANCE_X_CURSOR (p));
447 IMAGE_INSTANCE_X_CURSOR (p) = 0;
450 if (IMAGE_INSTANCE_X_NPIXELS (p) != 0)
453 IMAGE_INSTANCE_X_COLORMAP (p),
454 IMAGE_INSTANCE_X_PIXELS (p),
455 IMAGE_INSTANCE_X_NPIXELS (p), 0);
456 IMAGE_INSTANCE_X_NPIXELS (p) = 0;
460 /* You can sometimes have pixels without a live device. I forget
461 why, but that's why we free them here if we have a pixmap type
462 image instance. It probably means that we might also get a memory
463 leak with widgets. */
464 if (IMAGE_INSTANCE_TYPE (p) != IMAGE_WIDGET
465 && IMAGE_INSTANCE_TYPE (p) != IMAGE_SUBWINDOW
466 && IMAGE_INSTANCE_X_PIXELS (p))
468 xfree (IMAGE_INSTANCE_X_PIXELS (p));
469 IMAGE_INSTANCE_X_PIXELS (p) = 0;
477 x_image_instance_equal (Lisp_Image_Instance *p1,
478 Lisp_Image_Instance *p2, int depth)
480 switch (IMAGE_INSTANCE_TYPE (p1))
482 case IMAGE_MONO_PIXMAP:
483 case IMAGE_COLOR_PIXMAP:
485 if (IMAGE_INSTANCE_X_COLORMAP (p1) != IMAGE_INSTANCE_X_COLORMAP (p2) ||
486 IMAGE_INSTANCE_X_NPIXELS (p1) != IMAGE_INSTANCE_X_NPIXELS (p2))
497 x_image_instance_hash (Lisp_Image_Instance *p, int depth)
499 switch (IMAGE_INSTANCE_TYPE (p))
501 case IMAGE_MONO_PIXMAP:
502 case IMAGE_COLOR_PIXMAP:
504 return IMAGE_INSTANCE_X_NPIXELS (p);
510 /* Set all the slots in an image instance structure to reasonable
511 default values. This is used somewhere within an instantiate
512 method. It is assumed that the device slot within the image
513 instance is already set -- this is the case when instantiate
514 methods are called. */
517 x_initialize_pixmap_image_instance (Lisp_Image_Instance *ii,
519 enum image_instance_type type)
521 ii->data = xnew_and_zero (struct x_image_instance_data);
522 IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) = slices;
523 IMAGE_INSTANCE_X_PIXMAP_SLICES (ii) =
524 xnew_array_and_zero (Pixmap, slices);
525 IMAGE_INSTANCE_TYPE (ii) = type;
526 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = Qnil;
527 IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (ii) = Qnil;
528 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) = Qnil;
529 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) = Qnil;
530 IMAGE_INSTANCE_PIXMAP_FG (ii) = Qnil;
531 IMAGE_INSTANCE_PIXMAP_BG (ii) = Qnil;
535 /************************************************************************/
536 /* pixmap file functions */
537 /************************************************************************/
539 /* Where bitmaps are; initialized from resource database */
540 Lisp_Object Vx_bitmap_file_path;
543 #define BITMAPDIR "/usr/include/X11/bitmaps"
546 #define USE_XBMLANGPATH
548 /* Given a pixmap filename, look through all of the "standard" places
549 where the file might be located. Return a full pathname if found;
550 otherwise, return Qnil. */
553 x_locate_pixmap_file (Lisp_Object name)
555 /* This function can GC if IN_REDISPLAY is false */
558 /* Check non-absolute pathnames with a directory component relative to
559 the search path; that's the way Xt does it. */
560 /* #### Unix-specific */
561 if (XSTRING_BYTE (name, 0) == '/' ||
562 (XSTRING_BYTE (name, 0) == '.' &&
563 (XSTRING_BYTE (name, 1) == '/' ||
564 (XSTRING_BYTE (name, 1) == '.' &&
565 (XSTRING_BYTE (name, 2) == '/')))))
567 if (!NILP (Ffile_readable_p (name)))
568 return Fexpand_file_name (name, Qnil);
573 if (NILP (Vdefault_x_device))
574 /* This may occur during initialization. */
577 /* We only check the bitmapFilePath resource on the original X device. */
578 display = DEVICE_X_DISPLAY (XDEVICE (Vdefault_x_device));
580 #ifdef USE_XBMLANGPATH
582 char *path = egetenv ("XBMLANGPATH");
583 SubstitutionRec subs[1];
585 subs[0].substitution = (char *) XSTRING_DATA (name);
586 /* #### Motif uses a big hairy default if $XBMLANGPATH isn't set.
587 We don't. If you want it used, set it. */
589 (path = XtResolvePathname (display, "bitmaps", 0, 0, path,
590 subs, XtNumber (subs), 0)))
592 name = build_string (path);
599 if (NILP (Vx_bitmap_file_path))
603 if (XrmGetResource (XtDatabase (display),
604 "bitmapFilePath", "BitmapFilePath", &type, &value)
605 && !strcmp (type, "String"))
606 Vx_bitmap_file_path = decode_env_path (0, (char *) value.addr);
607 Vx_bitmap_file_path = nconc2 (Vx_bitmap_file_path,
608 (decode_path (BITMAPDIR)));
613 if (locate_file (Vx_bitmap_file_path, name, Qnil, &found, R_OK) < 0)
615 Lisp_Object temp = list1 (Vdata_directory);
619 locate_file (temp, name, Qnil, &found, R_OK);
628 locate_pixmap_file (Lisp_Object name)
630 return x_locate_pixmap_file (name);
635 write_lisp_string_to_temp_file (Lisp_Object string, char *filename_out)
637 Lisp_Object instream, outstream;
638 Lstream *istr, *ostr;
639 char tempbuf[1024]; /* some random amount */
642 static Extbyte_dynarr *conversion_out_dynarr;
643 Bytecount bstart, bend;
644 struct gcpro gcpro1, gcpro2;
646 Lisp_Object conv_out_stream;
651 /* This function can GC */
652 if (!conversion_out_dynarr)
653 conversion_out_dynarr = Dynarr_new (Extbyte);
655 Dynarr_reset (conversion_out_dynarr);
657 /* Create the temporary file ... */
658 sprintf (filename_out, "/tmp/emacs%d.XXXXXX", (int) getpid ());
659 mktemp (filename_out);
660 tmpfil = fopen (filename_out, "w");
665 int old_errno = errno;
667 unlink (filename_out);
670 report_file_error ("Creating temp file",
671 list1 (build_string (filename_out)));
674 CHECK_STRING (string);
675 get_string_range_byte (string, Qnil, Qnil, &bstart, &bend,
676 GB_HISTORICAL_STRING_BEHAVIOR);
677 instream = make_lisp_string_input_stream (string, bstart, bend);
678 istr = XLSTREAM (instream);
679 /* setup the out stream */
680 outstream = make_dynarr_output_stream((unsigned_char_dynarr *)conversion_out_dynarr);
681 ostr = XLSTREAM (outstream);
683 /* setup the conversion stream */
684 conv_out_stream = make_encoding_output_stream (ostr, Fget_coding_system(Qbinary));
685 costr = XLSTREAM (conv_out_stream);
686 GCPRO3 (instream, outstream, conv_out_stream);
688 GCPRO2 (instream, outstream);
691 /* Get the data while doing the conversion */
694 ssize_t size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
697 /* It does seem the flushes are necessary... */
699 Lstream_write (costr, tempbuf, size_in_bytes);
700 Lstream_flush (costr);
702 Lstream_write (ostr, tempbuf, size_in_bytes);
704 Lstream_flush (ostr);
705 if (fwrite ((unsigned char *)Dynarr_atp(conversion_out_dynarr, 0),
706 Dynarr_length(conversion_out_dynarr), 1, tmpfil) != 1)
711 /* reset the dynarr */
712 Lstream_rewind(ostr);
715 if (fclose (tmpfil) != 0)
717 Lstream_close (istr);
719 Lstream_close (costr);
721 Lstream_close (ostr);
724 Lstream_delete (istr);
725 Lstream_delete (ostr);
727 Lstream_delete (costr);
731 report_file_error ("Writing temp file",
732 list1 (build_string (filename_out)));
737 /************************************************************************/
738 /* cursor functions */
739 /************************************************************************/
741 /* Check that this server supports cursors of size WIDTH * HEIGHT. If
742 not, signal an error. INSTANTIATOR is only used in the error
746 check_pointer_sizes (Screen *xs, unsigned int width, unsigned int height,
747 Lisp_Object instantiator)
749 unsigned int best_width, best_height;
750 if (! XQueryBestCursor (DisplayOfScreen (xs), RootWindowOfScreen (xs),
751 width, height, &best_width, &best_height))
752 /* this means that an X error of some sort occurred (we trap
753 these so they're not fatal). */
754 signal_simple_error ("XQueryBestCursor() failed?", instantiator);
756 if (width > best_width || height > best_height)
757 error_with_frob (instantiator,
758 "pointer too large (%dx%d): "
759 "server requires %dx%d or smaller",
760 width, height, best_width, best_height);
765 generate_cursor_fg_bg (Lisp_Object device, Lisp_Object *foreground,
766 Lisp_Object *background, XColor *xfg, XColor *xbg)
768 if (!NILP (*foreground) && !COLOR_INSTANCEP (*foreground))
770 Fmake_color_instance (*foreground, device,
771 encode_error_behavior_flag (ERROR_ME));
772 if (COLOR_INSTANCEP (*foreground))
773 *xfg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (*foreground));
777 xfg->red = xfg->green = xfg->blue = 0;
780 if (!NILP (*background) && !COLOR_INSTANCEP (*background))
782 Fmake_color_instance (*background, device,
783 encode_error_behavior_flag (ERROR_ME));
784 if (COLOR_INSTANCEP (*background))
785 *xbg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (*background));
789 xbg->red = xbg->green = xbg->blue = ~0;
794 maybe_recolor_cursor (Lisp_Object image_instance, Lisp_Object foreground,
795 Lisp_Object background)
797 Lisp_Object device = XIMAGE_INSTANCE_DEVICE (image_instance);
800 generate_cursor_fg_bg (device, &foreground, &background, &xfg, &xbg);
801 if (!NILP (foreground) || !NILP (background))
803 XRecolorCursor (DEVICE_X_DISPLAY (XDEVICE (device)),
804 XIMAGE_INSTANCE_X_CURSOR (image_instance),
806 XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
807 XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
812 /************************************************************************/
813 /* color pixmap functions */
814 /************************************************************************/
816 /* Initialize an image instance from an XImage.
818 DEST_MASK specifies the mask of allowed image types.
820 PIXELS and NPIXELS specify an array of pixels that are used in
821 the image. These need to be kept around for the duration of the
822 image. When the image instance is freed, XFreeColors() will
823 automatically be called on all the pixels specified here; thus,
824 you should have allocated the pixels yourself using XAllocColor()
825 or the like. The array passed in is used directly without
826 being copied, so it should be heap data created with xmalloc().
827 It will be freed using xfree() when the image instance is
830 If this fails, signal an error. INSTANTIATOR is only used
831 in the error message.
833 #### This should be able to handle conversion into `pointer'.
834 Use the same code as for `xpm'. */
837 init_image_instance_from_x_image (Lisp_Image_Instance *ii,
841 unsigned long *pixels,
844 Lisp_Object instantiator)
846 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
852 if (!DEVICE_X_P (XDEVICE (device)))
853 signal_simple_error ("Not an X device", device);
855 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
856 d = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
858 if (!(dest_mask & IMAGE_COLOR_PIXMAP_MASK))
859 incompatible_image_types (instantiator, dest_mask,
860 IMAGE_COLOR_PIXMAP_MASK);
862 pixmap = XCreatePixmap (dpy, d, ximage->width,
863 ximage->height, ximage->depth);
865 signal_simple_error ("Unable to create pixmap", instantiator);
867 gc = XCreateGC (dpy, pixmap, 0, NULL);
870 XFreePixmap (dpy, pixmap);
871 signal_simple_error ("Unable to create GC", instantiator);
874 XPutImage (dpy, pixmap, gc, ximage, 0, 0, 0, 0,
875 ximage->width, ximage->height);
879 x_initialize_pixmap_image_instance (ii, slices, IMAGE_COLOR_PIXMAP);
881 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
882 find_keyword_in_vector (instantiator, Q_file);
884 /* Fixup a set of pixmaps. */
885 IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
887 IMAGE_INSTANCE_PIXMAP_MASK (ii) = 0;
888 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = ximage->width;
889 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = ximage->height;
890 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = ximage->depth;
891 IMAGE_INSTANCE_X_COLORMAP (ii) = cmap;
892 IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
893 IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
897 image_instance_add_x_image (Lisp_Image_Instance *ii,
900 Lisp_Object instantiator)
902 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
908 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
909 d = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
911 pixmap = XCreatePixmap (dpy, d, ximage->width,
912 ximage->height, ximage->depth);
914 signal_simple_error ("Unable to create pixmap", instantiator);
916 gc = XCreateGC (dpy, pixmap, 0, NULL);
919 XFreePixmap (dpy, pixmap);
920 signal_simple_error ("Unable to create GC", instantiator);
923 XPutImage (dpy, pixmap, gc, ximage, 0, 0, 0, 0,
924 ximage->width, ximage->height);
928 IMAGE_INSTANCE_X_PIXMAP_SLICE (ii, slice) = pixmap;
932 x_init_image_instance_from_eimage (Lisp_Image_Instance *ii,
933 int width, int height,
935 unsigned char *eimage,
937 Lisp_Object instantiator,
940 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
941 Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device));
942 unsigned long *pixtbl = NULL;
947 for (slice = 0; slice < slices; slice++)
949 ximage = convert_EImage_to_XImage (device, width, height,
950 eimage + (width * height * 3 * slice),
954 if (pixtbl) xfree (pixtbl);
955 signal_image_error("EImage to XImage conversion failed", instantiator);
958 /* Now create the pixmap and set up the image instance */
960 init_image_instance_from_x_image (ii, ximage, dest_mask,
961 cmap, pixtbl, npixels, slices,
964 image_instance_add_x_image (ii, ximage, slice, instantiator);
970 xfree (ximage->data);
973 XDestroyImage (ximage);
979 int read_bitmap_data_from_file (const char *filename, unsigned int *width,
980 unsigned int *height, unsigned char **datap,
981 int *x_hot, int *y_hot)
983 return XmuReadBitmapDataFromFile (filename, width, height,
984 datap, x_hot, y_hot);
987 /* Given inline data for a mono pixmap, create and return the
988 corresponding X object. */
991 pixmap_from_xbm_inline (Lisp_Object device, int width, int height,
992 /* Note that data is in ext-format! */
995 return XCreatePixmapFromBitmapData (DEVICE_X_DISPLAY (XDEVICE(device)),
996 XtWindow (DEVICE_XT_APP_SHELL (XDEVICE (device))),
997 (char *) bits, width, height,
1001 /* Given inline data for a mono pixmap, initialize the given
1002 image instance accordingly. */
1005 init_image_instance_from_xbm_inline (Lisp_Image_Instance *ii,
1006 int width, int height,
1007 /* Note that data is in ext-format! */
1009 Lisp_Object instantiator,
1010 Lisp_Object pointer_fg,
1011 Lisp_Object pointer_bg,
1014 Lisp_Object mask_filename)
1016 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1017 Lisp_Object foreground = find_keyword_in_vector (instantiator, Q_foreground);
1018 Lisp_Object background = find_keyword_in_vector (instantiator, Q_background);
1022 enum image_instance_type type;
1024 if (!DEVICE_X_P (XDEVICE (device)))
1025 signal_simple_error ("Not an X device", device);
1027 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1028 draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
1029 scr = DefaultScreenOfDisplay (dpy);
1031 if ((dest_mask & IMAGE_MONO_PIXMAP_MASK) &&
1032 (dest_mask & IMAGE_COLOR_PIXMAP_MASK))
1034 if (!NILP (foreground) || !NILP (background))
1035 type = IMAGE_COLOR_PIXMAP;
1037 type = IMAGE_MONO_PIXMAP;
1039 else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
1040 type = IMAGE_MONO_PIXMAP;
1041 else if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
1042 type = IMAGE_COLOR_PIXMAP;
1043 else if (dest_mask & IMAGE_POINTER_MASK)
1044 type = IMAGE_POINTER;
1046 incompatible_image_types (instantiator, dest_mask,
1047 IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
1048 | IMAGE_POINTER_MASK);
1050 x_initialize_pixmap_image_instance (ii, 1, type);
1051 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = width;
1052 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = height;
1053 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
1054 find_keyword_in_vector (instantiator, Q_file);
1058 case IMAGE_MONO_PIXMAP:
1060 IMAGE_INSTANCE_X_PIXMAP (ii) =
1061 pixmap_from_xbm_inline (device, width, height, (Extbyte *) bits);
1065 case IMAGE_COLOR_PIXMAP:
1067 Dimension d = DEVICE_X_DEPTH (XDEVICE(device));
1068 unsigned long fg = BlackPixelOfScreen (scr);
1069 unsigned long bg = WhitePixelOfScreen (scr);
1071 if (!NILP (foreground) && !COLOR_INSTANCEP (foreground))
1073 Fmake_color_instance (foreground, device,
1074 encode_error_behavior_flag (ERROR_ME));
1076 if (COLOR_INSTANCEP (foreground))
1077 fg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground)).pixel;
1079 if (!NILP (background) && !COLOR_INSTANCEP (background))
1081 Fmake_color_instance (background, device,
1082 encode_error_behavior_flag (ERROR_ME));
1084 if (COLOR_INSTANCEP (background))
1085 bg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background)).pixel;
1087 /* We used to duplicate the pixels using XAllocColor(), to protect
1088 against their getting freed. Just as easy to just store the
1089 color instances here and GC-protect them, so this doesn't
1091 IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
1092 IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
1093 IMAGE_INSTANCE_X_PIXMAP (ii) =
1094 XCreatePixmapFromBitmapData (dpy, draw,
1095 (char *) bits, width, height,
1097 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = d;
1103 XColor fg_color, bg_color;
1106 check_pointer_sizes (scr, width, height, instantiator);
1109 XCreatePixmapFromBitmapData (dpy, draw,
1110 (char *) bits, width, height,
1113 if (NILP (foreground))
1114 foreground = pointer_fg;
1115 if (NILP (background))
1116 background = pointer_bg;
1117 generate_cursor_fg_bg (device, &foreground, &background,
1118 &fg_color, &bg_color);
1120 IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
1121 IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
1122 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) =
1123 find_keyword_in_vector (instantiator, Q_hotspot_x);
1124 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) =
1125 find_keyword_in_vector (instantiator, Q_hotspot_y);
1126 IMAGE_INSTANCE_X_CURSOR (ii) =
1128 (dpy, source, mask, &fg_color, &bg_color,
1129 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ?
1130 XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) : 0,
1131 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) ?
1132 XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) : 0);
1142 xbm_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator,
1143 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1144 int dest_mask, int width, int height,
1145 /* Note that data is in ext-format! */
1148 Lisp_Object mask_data = find_keyword_in_vector (instantiator, Q_mask_data);
1149 Lisp_Object mask_file = find_keyword_in_vector (instantiator, Q_mask_file);
1150 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1153 if (!NILP (mask_data))
1155 const char *ext_data;
1157 TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (XCDR (XCDR (mask_data))),
1158 C_STRING_ALLOCA, ext_data,
1160 mask = pixmap_from_xbm_inline (IMAGE_INSTANCE_DEVICE (ii),
1161 XINT (XCAR (mask_data)),
1162 XINT (XCAR (XCDR (mask_data))),
1163 (const unsigned char *) ext_data);
1166 init_image_instance_from_xbm_inline (ii, width, height, bits,
1167 instantiator, pointer_fg, pointer_bg,
1168 dest_mask, mask, mask_file);
1171 /* Instantiate method for XBM's. */
1174 x_xbm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1175 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1176 int dest_mask, Lisp_Object domain)
1178 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1179 const char *ext_data;
1181 assert (!NILP (data));
1183 TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (XCDR (XCDR (data))),
1184 C_STRING_ALLOCA, ext_data,
1187 xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1188 pointer_bg, dest_mask, XINT (XCAR (data)),
1189 XINT (XCAR (XCDR (data))), ext_data);
1195 /**********************************************************************
1197 **********************************************************************/
1198 /* xpm 3.2g and better has XpmCreatePixmapFromBuffer()...
1199 There was no version number in xpm.h before 3.3, but this should do.
1201 #if (XpmVersion >= 3) || defined(XpmExactColors)
1202 # define XPM_DOES_BUFFERS
1205 #ifndef XPM_DOES_BUFFERS
1206 Your version of XPM is too old. You cannot compile with it.
1207 Upgrade to version 3.2g or better or compile with --with-xpm=no.
1208 #endif /* !XPM_DOES_BUFFERS */
1210 static XpmColorSymbol *
1211 extract_xpm_color_names (XpmAttributes *xpmattrs, Lisp_Object device,
1213 Lisp_Object color_symbol_alist)
1215 /* This function can GC */
1216 Display *dpy = DEVICE_X_DISPLAY (XDEVICE(device));
1217 Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1220 Lisp_Object results = Qnil;
1222 XpmColorSymbol *symbols;
1223 struct gcpro gcpro1, gcpro2;
1225 GCPRO2 (results, device);
1227 /* We built up results to be (("name" . #<color>) ...) so that if an
1228 error happens we don't lose any malloc()ed data, or more importantly,
1229 leave any pixels allocated in the server. */
1231 LIST_LOOP (rest, color_symbol_alist)
1233 Lisp_Object cons = XCAR (rest);
1234 Lisp_Object name = XCAR (cons);
1235 Lisp_Object value = XCDR (cons);
1238 if (STRINGP (value))
1240 Fmake_color_instance
1241 (value, device, encode_error_behavior_flag (ERROR_ME_NOT));
1244 assert (COLOR_SPECIFIERP (value));
1245 value = Fspecifier_instance (value, domain, Qnil, Qnil);
1249 results = noseeum_cons (noseeum_cons (name, value), results);
1252 UNGCPRO; /* no more evaluation */
1254 if (i == 0) return 0;
1256 symbols = xnew_array (XpmColorSymbol, i);
1257 xpmattrs->valuemask |= XpmColorSymbols;
1258 xpmattrs->colorsymbols = symbols;
1259 xpmattrs->numsymbols = i;
1263 Lisp_Object cons = XCAR (results);
1264 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (XCDR (cons)));
1265 /* Duplicate the pixel value so that we still have a lock on it if
1266 the pixel we were passed is later freed. */
1267 if (! XAllocColor (dpy, cmap, &color))
1268 abort (); /* it must be allocable since we're just duplicating it */
1270 symbols [i].name = (char *) XSTRING_DATA (XCAR (cons));
1271 symbols [i].pixel = color.pixel;
1272 symbols [i].value = 0;
1273 free_cons (XCONS (cons));
1275 results = XCDR (results);
1276 free_cons (XCONS (cons));
1282 xpm_free (XpmAttributes *xpmattrs)
1284 /* Could conceivably lose if XpmXXX returned an error without first
1285 initializing this structure, if we didn't know that initializing it
1286 to all zeros was ok (and also that it's ok to call XpmFreeAttributes()
1287 multiple times, since it zeros slots as it frees them...) */
1288 XpmFreeAttributes (xpmattrs);
1292 x_xpm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1293 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1294 int dest_mask, Lisp_Object domain)
1296 /* This function can GC */
1297 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1298 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1299 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1307 XpmAttributes xpmattrs;
1309 XpmColorSymbol *color_symbols;
1310 Lisp_Object color_symbol_alist = find_keyword_in_vector (instantiator,
1312 enum image_instance_type type;
1316 if (!DEVICE_X_P (XDEVICE (device)))
1317 signal_simple_error ("Not an X device", device);
1319 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1320 xs = DefaultScreenOfDisplay (dpy);
1322 if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
1323 type = IMAGE_COLOR_PIXMAP;
1324 else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
1325 type = IMAGE_MONO_PIXMAP;
1326 else if (dest_mask & IMAGE_POINTER_MASK)
1327 type = IMAGE_POINTER;
1329 incompatible_image_types (instantiator, dest_mask,
1330 IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
1331 | IMAGE_POINTER_MASK);
1332 force_mono = (type != IMAGE_COLOR_PIXMAP);
1335 /* Although I haven't found it documented yet, it appears that pointers are
1336 always colored via the default window colormap... Sigh. */
1337 if (type == IMAGE_POINTER)
1339 cmap = DefaultColormap(dpy, DefaultScreen(dpy));
1340 depth = DefaultDepthOfScreen (xs);
1341 visual = DefaultVisualOfScreen (xs);
1345 cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1346 depth = DEVICE_X_DEPTH (XDEVICE(device));
1347 visual = DEVICE_X_VISUAL (XDEVICE(device));
1350 cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1351 depth = DEVICE_X_DEPTH (XDEVICE(device));
1352 visual = DEVICE_X_VISUAL (XDEVICE(device));
1355 x_initialize_pixmap_image_instance (ii, 1, type);
1357 assert (!NILP (data));
1361 xzero (xpmattrs); /* want XpmInitAttributes() */
1362 xpmattrs.valuemask = XpmReturnPixels;
1365 /* Without this, we get a 1-bit version of the color image, which
1366 isn't quite right. With this, we get the mono image, which might
1367 be very different looking. */
1368 xpmattrs.valuemask |= XpmColorKey;
1369 xpmattrs.color_key = XPM_MONO;
1371 xpmattrs.valuemask |= XpmDepth;
1375 xpmattrs.closeness = 65535;
1376 xpmattrs.valuemask |= XpmCloseness;
1377 xpmattrs.depth = depth;
1378 xpmattrs.valuemask |= XpmDepth;
1379 xpmattrs.visual = visual;
1380 xpmattrs.valuemask |= XpmVisual;
1381 xpmattrs.colormap = cmap;
1382 xpmattrs.valuemask |= XpmColormap;
1385 color_symbols = extract_xpm_color_names (&xpmattrs, device, domain,
1386 color_symbol_alist);
1388 result = XpmCreatePixmapFromBuffer (dpy,
1389 XtWindow(DEVICE_XT_APP_SHELL (XDEVICE(device))),
1390 (char *) XSTRING_DATA (data),
1391 &pixmap, &mask, &xpmattrs);
1395 xfree (color_symbols);
1396 xpmattrs.colorsymbols = 0; /* in case XpmFreeAttr is too smart... */
1397 xpmattrs.numsymbols = 0;
1404 case XpmFileInvalid:
1406 xpm_free (&xpmattrs);
1407 signal_image_error ("invalid XPM data", data);
1409 case XpmColorFailed:
1412 xpm_free (&xpmattrs);
1415 /* second time; blow out. */
1416 signal_double_file_error ("Reading pixmap data",
1417 "color allocation failed",
1422 if (! (dest_mask & IMAGE_MONO_PIXMAP_MASK))
1424 /* second time; blow out. */
1425 signal_double_file_error ("Reading pixmap data",
1426 "color allocation failed",
1430 IMAGE_INSTANCE_TYPE (ii) = IMAGE_MONO_PIXMAP;
1436 xpm_free (&xpmattrs);
1437 signal_double_file_error ("Parsing pixmap data",
1438 "out of memory", data);
1442 xpm_free (&xpmattrs);
1443 signal_double_file_error_2 ("Parsing pixmap data",
1444 "unknown error code",
1445 make_int (result), data);
1450 h = xpmattrs.height;
1453 int npixels = xpmattrs.npixels;
1458 pixels = xnew_array (Pixel, npixels);
1459 memcpy (pixels, xpmattrs.pixels, npixels * sizeof (Pixel));
1464 IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
1465 IMAGE_INSTANCE_PIXMAP_MASK (ii) = (void*)mask;
1466 IMAGE_INSTANCE_X_COLORMAP (ii) = cmap;
1467 IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
1468 IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
1469 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = w;
1470 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = h;
1471 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
1472 find_keyword_in_vector (instantiator, Q_file);
1477 case IMAGE_MONO_PIXMAP:
1480 case IMAGE_COLOR_PIXMAP:
1482 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = depth;
1488 int npixels = xpmattrs.npixels;
1489 Pixel *pixels = xpmattrs.pixels;
1492 int xhot = 0, yhot = 0;
1494 if (xpmattrs.valuemask & XpmHotspot)
1496 xhot = xpmattrs.x_hotspot;
1497 XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii), xpmattrs.x_hotspot);
1499 if (xpmattrs.valuemask & XpmHotspot)
1501 yhot = xpmattrs.y_hotspot;
1502 XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii), xpmattrs.y_hotspot);
1504 check_pointer_sizes (xs, w, h, instantiator);
1506 /* If the loaded pixmap has colors allocated (meaning it came from an
1507 XPM file), then use those as the default colors for the cursor we
1508 create. Otherwise, default to pointer_fg and pointer_bg.
1512 /* With an XBM file, it's obvious which bit is foreground
1513 and which is background, or rather, it's implicit: in
1514 an XBM file, a 1 bit is foreground, and a 0 bit is
1517 XCreatePixmapCursor() assumes this property of the
1518 pixmap it is called with as well; the `foreground'
1519 color argument is used for the 1 bits.
1521 With an XPM file, it's tricker, since the elements of
1522 the pixmap don't represent FG and BG, but are actual
1523 pixel values. So we need to figure out which of those
1524 pixels is the foreground color and which is the
1525 background. We do it by comparing RGB and assuming
1526 that the darker color is the foreground. This works
1527 with the result of xbmtopbm|ppmtoxpm, at least.
1529 It might be nice if there was some way to tag the
1530 colors in the XPM file with whether they are the
1531 foreground - perhaps with logical color names somehow?
1533 Once we have decided which color is the foreground, we
1534 need to ensure that that color corresponds to a `1' bit
1535 in the Pixmap. The XPM library wrote into the (1-bit)
1536 pixmap with XPutPixel, which will ignore all but the
1537 least significant bit.
1539 This means that a 1 bit in the image corresponds to
1540 `fg' only if `fg.pixel' is odd.
1542 (This also means that the image will be all the same
1543 color if both `fg' and `bg' are odd or even, but we can
1544 safely assume that that won't happen if the XPM file is
1547 The desired result is that the image use `1' to
1548 represent the foreground color, and `0' to represent
1549 the background color. So, we may need to invert the
1550 image to accomplish this; we invert if fg is
1551 odd. (Remember that WhitePixel and BlackPixel are not
1552 necessarily 1 and 0 respectively, though I think it
1553 might be safe to assume that one of them is always 1
1554 and the other is always 0. We also pretty much need to
1555 assume that one is even and the other is odd.)
1558 fg.pixel = pixels[0]; /* pick a pixel at random. */
1559 bg.pixel = fg.pixel;
1560 for (i = 1; i < npixels; i++) /* Look for an "other" pixel value.*/
1562 bg.pixel = pixels[i];
1563 if (fg.pixel != bg.pixel)
1567 /* If (fg.pixel == bg.pixel) then probably something has
1568 gone wrong, but I don't think signalling an error would
1571 XQueryColor (dpy, cmap, &fg);
1572 XQueryColor (dpy, cmap, &bg);
1574 /* If the foreground is lighter than the background, swap them.
1575 (This occurs semi-randomly, depending on the ordering of the
1576 color list in the XPM file.)
1579 unsigned short fg_total = ((fg.red / 3) + (fg.green / 3)
1581 unsigned short bg_total = ((bg.red / 3) + (bg.green / 3)
1583 if (fg_total > bg_total)
1592 /* If the fg pixel corresponds to a `0' in the bitmap, invert it.
1593 (This occurs (only?) on servers with Black=0, White=1.)
1595 if ((fg.pixel & 1) == 0)
1599 gcv.function = GXxor;
1601 gc = XCreateGC (dpy, pixmap, (GCFunction | GCForeground),
1603 XFillRectangle (dpy, pixmap, gc, 0, 0, w, h);
1609 generate_cursor_fg_bg (device, &pointer_fg, &pointer_bg,
1611 IMAGE_INSTANCE_PIXMAP_FG (ii) = pointer_fg;
1612 IMAGE_INSTANCE_PIXMAP_BG (ii) = pointer_bg;
1615 IMAGE_INSTANCE_X_CURSOR (ii) =
1617 (dpy, pixmap, mask, &fg, &bg, xhot, yhot);
1626 xpm_free (&xpmattrs); /* after we've read pixels and hotspot */
1629 #endif /* HAVE_XPM */
1634 /**********************************************************************
1636 **********************************************************************/
1638 /* This is about to get redefined! */
1641 /* We have to define SYSV32 so that compface.h includes string.h
1642 instead of strings.h. */
1647 #include <compface.h>
1651 /* JMP_BUF cannot be used here because if it doesn't get defined
1652 to jmp_buf we end up with a conflicting type error with the
1653 definition in compface.h */
1654 extern jmp_buf comp_env;
1658 x_xface_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1659 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1660 int dest_mask, Lisp_Object domain)
1662 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1664 char *p, *bits, *bp;
1665 const char * volatile emsg = 0;
1666 const char * volatile dstring;
1668 assert (!NILP (data));
1670 TO_EXTERNAL_FORMAT (LISP_STRING, data,
1671 C_STRING_ALLOCA, dstring,
1674 if ((p = strchr (dstring, ':')))
1679 /* Must use setjmp not SETJMP because we used jmp_buf above not JMP_BUF */
1680 if (!(stattis = setjmp (comp_env)))
1682 UnCompAll ((char *) dstring);
1689 emsg = "uncompface: internal error";
1692 emsg = "uncompface: insufficient or invalid data";
1695 emsg = "uncompface: excess data ignored";
1700 signal_simple_error_2 (emsg, data, Qimage);
1702 bp = bits = (char *) alloca (PIXELS / 8);
1704 /* the compface library exports char F[], which uses a single byte per
1705 pixel to represent a 48x48 bitmap. Yuck. */
1706 for (i = 0, p = F; i < (PIXELS / 8); ++i)
1709 /* reverse the bit order of each byte... */
1710 for (b = n = 0; b < 8; ++b)
1717 xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1718 pointer_bg, dest_mask, 48, 48, bits);
1721 #endif /* HAVE_XFACE */
1724 /**********************************************************************
1726 **********************************************************************/
1729 autodetect_validate (Lisp_Object instantiator)
1731 data_must_be_present (instantiator);
1735 autodetect_normalize (Lisp_Object instantiator,
1736 Lisp_Object console_type)
1738 Lisp_Object file = find_keyword_in_vector (instantiator, Q_data);
1739 Lisp_Object filename = Qnil;
1740 Lisp_Object data = Qnil;
1741 struct gcpro gcpro1, gcpro2, gcpro3;
1742 Lisp_Object alist = Qnil;
1744 GCPRO3 (filename, data, alist);
1746 if (NILP (file)) /* no conversion necessary */
1747 RETURN_UNGCPRO (instantiator);
1749 alist = tagged_vector_to_alist (instantiator);
1751 filename = locate_pixmap_file (file);
1752 if (!NILP (filename))
1755 /* #### Apparently some versions of XpmReadFileToData, which is
1756 called by pixmap_to_lisp_data, don't return an error value
1757 if the given file is not a valid XPM file. Instead, they
1758 just seg fault. It is definitely caused by passing a
1759 bitmap. To try and avoid this we check for bitmaps first. */
1761 data = bitmap_to_lisp_data (filename, &xhot, &yhot, 1);
1765 alist = remassq_no_quit (Q_data, alist);
1766 alist = Fcons (Fcons (Q_file, filename),
1767 Fcons (Fcons (Q_data, data), alist));
1769 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
1772 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
1775 alist = xbm_mask_file_munging (alist, filename, Qnil, console_type);
1778 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
1780 RETURN_UNGCPRO (result);
1785 data = pixmap_to_lisp_data (filename, 1);
1789 alist = remassq_no_quit (Q_data, alist);
1790 alist = Fcons (Fcons (Q_file, filename),
1791 Fcons (Fcons (Q_data, data), alist));
1792 alist = Fcons (Fcons (Q_color_symbols,
1793 evaluate_xpm_color_symbols ()),
1796 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
1798 RETURN_UNGCPRO (result);
1804 /* If we couldn't convert it, just put it back as it is.
1805 We might try to further frob it later as a cursor-font
1806 specification. (We can't do that now because we don't know
1807 what dest-types it's going to be instantiated into.) */
1809 Lisp_Object result = alist_to_tagged_vector (Qautodetect, alist);
1811 RETURN_UNGCPRO (result);
1816 autodetect_possible_dest_types (void)
1819 IMAGE_MONO_PIXMAP_MASK |
1820 IMAGE_COLOR_PIXMAP_MASK |
1821 IMAGE_POINTER_MASK |
1826 autodetect_instantiate (Lisp_Object image_instance,
1827 Lisp_Object instantiator,
1828 Lisp_Object pointer_fg,
1829 Lisp_Object pointer_bg,
1830 int dest_mask, Lisp_Object domain)
1832 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1833 struct gcpro gcpro1, gcpro2, gcpro3;
1834 Lisp_Object alist = Qnil;
1835 Lisp_Object result = Qnil;
1836 int is_cursor_font = 0;
1838 GCPRO3 (data, alist, result);
1840 alist = tagged_vector_to_alist (instantiator);
1841 if (dest_mask & IMAGE_POINTER_MASK)
1843 const char *name_ext;
1844 TO_EXTERNAL_FORMAT (LISP_STRING, data,
1845 C_STRING_ALLOCA, name_ext,
1847 if (XmuCursorNameToIndex (name_ext) != -1)
1849 result = alist_to_tagged_vector (Qcursor_font, alist);
1854 if (!is_cursor_font)
1855 result = alist_to_tagged_vector (Qstring, alist);
1859 cursor_font_instantiate (image_instance, result, pointer_fg,
1860 pointer_bg, dest_mask, domain);
1862 string_instantiate (image_instance, result, pointer_fg,
1863 pointer_bg, dest_mask, domain);
1869 /**********************************************************************
1871 **********************************************************************/
1874 font_validate (Lisp_Object instantiator)
1876 data_must_be_present (instantiator);
1879 /* XmuCvtStringToCursor is bogus in the following ways:
1881 - When it can't convert the given string to a real cursor, it will
1882 sometimes return a "success" value, after triggering a BadPixmap
1883 error. It then gives you a cursor that will itself generate BadCursor
1884 errors. So we install this error handler to catch/notice the X error
1885 and take that as meaning "couldn't convert."
1887 - When you tell it to find a cursor file that doesn't exist, it prints
1888 an error message on stderr. You can't make it not do that.
1890 - Also, using Xmu means we can't properly hack Lisp_Image_Instance
1891 objects, or XPM files, or $XBMLANGPATH.
1894 /* Duplicate the behavior of XmuCvtStringToCursor() to bypass its bogusness. */
1896 static int XLoadFont_got_error;
1899 XLoadFont_error_handler (Display *dpy, XErrorEvent *xerror)
1901 XLoadFont_got_error = 1;
1906 safe_XLoadFont (Display *dpy, char *name)
1909 int (*old_handler) (Display *, XErrorEvent *);
1910 XLoadFont_got_error = 0;
1912 old_handler = XSetErrorHandler (XLoadFont_error_handler);
1913 font = XLoadFont (dpy, name);
1915 XSetErrorHandler (old_handler);
1916 if (XLoadFont_got_error) return 0;
1921 font_possible_dest_types (void)
1923 return IMAGE_POINTER_MASK;
1927 font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1928 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1929 int dest_mask, Lisp_Object domain)
1931 /* This function can GC */
1932 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1933 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1934 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1938 char source_name[MAXPATHLEN], mask_name[MAXPATHLEN], dummy;
1939 int source_char, mask_char;
1941 Lisp_Object foreground, background;
1943 if (!DEVICE_X_P (XDEVICE (device)))
1944 signal_simple_error ("Not an X device", device);
1946 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1948 if (!STRINGP (data) ||
1949 strncmp ("FONT ", (char *) XSTRING_DATA (data), 5))
1950 signal_simple_error ("Invalid font-glyph instantiator",
1953 if (!(dest_mask & IMAGE_POINTER_MASK))
1954 incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
1956 foreground = find_keyword_in_vector (instantiator, Q_foreground);
1957 if (NILP (foreground))
1958 foreground = pointer_fg;
1959 background = find_keyword_in_vector (instantiator, Q_background);
1960 if (NILP (background))
1961 background = pointer_bg;
1963 generate_cursor_fg_bg (device, &foreground, &background, &fg, &bg);
1965 count = sscanf ((char *) XSTRING_DATA (data),
1966 "FONT %s %d %s %d %c",
1967 source_name, &source_char,
1968 mask_name, &mask_char, &dummy);
1969 /* Allow "%s %d %d" as well... */
1970 if (count == 3 && (1 == sscanf (mask_name, "%d %c", &mask_char, &dummy)))
1971 count = 4, mask_name[0] = 0;
1973 if (count != 2 && count != 4)
1974 signal_simple_error ("invalid cursor specification", data);
1975 source = safe_XLoadFont (dpy, source_name);
1977 signal_simple_error_2 ("couldn't load font",
1978 build_string (source_name),
1982 else if (!mask_name[0])
1986 mask = safe_XLoadFont (dpy, mask_name);
1989 Fsignal (Qerror, list3 (build_string ("couldn't load font"),
1990 build_string (mask_name), data));
1995 /* #### call XQueryTextExtents() and check_pointer_sizes() here. */
1997 x_initialize_pixmap_image_instance (ii, 1, IMAGE_POINTER);
1998 IMAGE_INSTANCE_X_CURSOR (ii) =
1999 XCreateGlyphCursor (dpy, source, mask, source_char, mask_char,
2001 XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
2002 XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
2003 XUnloadFont (dpy, source);
2004 if (mask && mask != source) XUnloadFont (dpy, mask);
2008 /**********************************************************************
2010 **********************************************************************/
2013 cursor_font_validate (Lisp_Object instantiator)
2015 data_must_be_present (instantiator);
2019 cursor_font_possible_dest_types (void)
2021 return IMAGE_POINTER_MASK;
2025 cursor_font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2026 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2027 int dest_mask, Lisp_Object domain)
2029 /* This function can GC */
2030 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
2031 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2032 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
2035 const char *name_ext;
2036 Lisp_Object foreground, background;
2038 if (!DEVICE_X_P (XDEVICE (device)))
2039 signal_simple_error ("Not an X device", device);
2041 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2043 if (!(dest_mask & IMAGE_POINTER_MASK))
2044 incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
2046 TO_EXTERNAL_FORMAT (LISP_STRING, data,
2047 C_STRING_ALLOCA, name_ext,
2049 if ((i = XmuCursorNameToIndex (name_ext)) == -1)
2050 signal_simple_error ("Unrecognized cursor-font name", data);
2052 x_initialize_pixmap_image_instance (ii, 1, IMAGE_POINTER);
2053 IMAGE_INSTANCE_X_CURSOR (ii) = XCreateFontCursor (dpy, i);
2054 foreground = find_keyword_in_vector (instantiator, Q_foreground);
2055 if (NILP (foreground))
2056 foreground = pointer_fg;
2057 background = find_keyword_in_vector (instantiator, Q_background);
2058 if (NILP (background))
2059 background = pointer_bg;
2060 maybe_recolor_cursor (image_instance, foreground, background);
2064 x_colorize_image_instance (Lisp_Object image_instance,
2065 Lisp_Object foreground, Lisp_Object background)
2067 Lisp_Image_Instance *p;
2069 p = XIMAGE_INSTANCE (image_instance);
2071 switch (IMAGE_INSTANCE_TYPE (p))
2073 case IMAGE_MONO_PIXMAP:
2074 IMAGE_INSTANCE_TYPE (p) = IMAGE_COLOR_PIXMAP;
2075 /* Make sure there aren't two pointers to the same mask, causing
2076 it to get freed twice. */
2077 IMAGE_INSTANCE_PIXMAP_MASK (p) = 0;
2085 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
2086 Drawable draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (IMAGE_INSTANCE_DEVICE (p))));
2087 Dimension d = DEVICE_X_DEPTH (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
2088 Pixmap new = XCreatePixmap (dpy, draw,
2089 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
2090 IMAGE_INSTANCE_PIXMAP_HEIGHT (p), d);
2094 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground));
2095 gcv.foreground = color.pixel;
2096 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background));
2097 gcv.background = color.pixel;
2098 gc = XCreateGC (dpy, new, GCBackground|GCForeground, &gcv);
2099 XCopyPlane (dpy, IMAGE_INSTANCE_X_PIXMAP (p), new, gc, 0, 0,
2100 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
2101 IMAGE_INSTANCE_PIXMAP_HEIGHT (p),
2104 IMAGE_INSTANCE_X_PIXMAP (p) = new;
2105 IMAGE_INSTANCE_PIXMAP_DEPTH (p) = d;
2106 IMAGE_INSTANCE_PIXMAP_FG (p) = foreground;
2107 IMAGE_INSTANCE_PIXMAP_BG (p) = background;
2113 /************************************************************************/
2114 /* subwindow and widget support */
2115 /************************************************************************/
2117 /* unmap the image if it is a widget. This is used by redisplay via
2118 redisplay_unmap_subwindows */
2120 x_unmap_subwindow (Lisp_Image_Instance *p)
2122 if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
2125 (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2126 IMAGE_INSTANCE_X_CLIPWINDOW (p));
2128 else /* must be a widget */
2130 XtUnmapWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p));
2134 /* map the subwindow. This is used by redisplay via
2135 redisplay_output_subwindow */
2137 x_map_subwindow (Lisp_Image_Instance *p, int x, int y,
2138 struct display_glyph_area* dga)
2140 if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
2142 Window subwindow = IMAGE_INSTANCE_X_SUBWINDOW_ID (p);
2143 XMoveResizeWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2144 IMAGE_INSTANCE_X_CLIPWINDOW (p),
2145 x, y, dga->width, dga->height);
2146 XMoveWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2147 subwindow, -dga->xoffset, -dga->yoffset);
2148 XMapWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2149 IMAGE_INSTANCE_X_CLIPWINDOW (p));
2151 else /* must be a widget */
2153 XtConfigureWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p),
2154 x + IMAGE_INSTANCE_X_WIDGET_XOFFSET (p),
2155 y + IMAGE_INSTANCE_X_WIDGET_YOFFSET (p),
2156 dga->width, dga->height, 0);
2157 XtMoveWidget (IMAGE_INSTANCE_X_WIDGET_ID (p),
2158 -dga->xoffset, -dga->yoffset);
2159 XtMapWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p));
2163 /* when you click on a widget you may activate another widget this
2164 needs to be checked and all appropriate widgets updated */
2166 x_update_subwindow (Lisp_Image_Instance *p)
2168 /* Update the subwindow size if necessary. */
2169 if (IMAGE_INSTANCE_SIZE_CHANGED (p))
2171 XResizeWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2172 IMAGE_INSTANCE_X_SUBWINDOW_ID (p),
2173 IMAGE_INSTANCE_WIDTH (p),
2174 IMAGE_INSTANCE_HEIGHT (p));
2178 /* Update all attributes that have changed. Lwlib actually does most
2181 x_update_widget (Lisp_Image_Instance *p)
2183 /* This function can GC if IN_REDISPLAY is false. */
2185 widget_value* wv = 0;
2187 /* First get the items if they have changed since this is a
2188 structural change. As such it will nuke all added values so we
2189 need to update most other things after the items have changed.*/
2190 if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (p))
2192 wv = gui_items_to_widget_values
2193 (IMAGE_INSTANCE_WIDGET_ITEMS (p));
2194 wv->change = STRUCTURAL_CHANGE;
2195 /* now modify the widget */
2196 lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (p),
2198 free_widget_value_tree (wv);
2201 /* Now do non structural updates. */
2202 wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (p));
2204 /* Possibly update the colors and font */
2205 if (IMAGE_INSTANCE_WIDGET_FACE_CHANGED (p)
2207 XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (p))->faces_changed
2209 IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (p))
2211 update_widget_face (wv, p, IMAGE_INSTANCE_SUBWINDOW_FRAME (p));
2214 /* Possibly update the text. */
2215 if (IMAGE_INSTANCE_TEXT_CHANGED (p))
2218 Lisp_Object val = IMAGE_INSTANCE_WIDGET_TEXT (p);
2219 TO_EXTERNAL_FORMAT (LISP_STRING, val,
2220 C_STRING_ALLOCA, str,
2225 /* Possibly update the size. */
2226 if (IMAGE_INSTANCE_SIZE_CHANGED (p)
2228 IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (p))
2230 assert (IMAGE_INSTANCE_X_WIDGET_ID (p) &&
2231 IMAGE_INSTANCE_X_CLIPWIDGET (p)) ;
2233 if (IMAGE_INSTANCE_X_WIDGET_ID (p)->core.being_destroyed
2234 || !XtIsManaged(IMAGE_INSTANCE_X_WIDGET_ID (p)))
2237 XSETIMAGE_INSTANCE (sw, p);
2238 signal_simple_error ("XEmacs bug: subwindow is deleted", sw);
2241 lw_add_widget_value_arg (wv, XtNwidth,
2242 (Dimension)IMAGE_INSTANCE_WIDTH (p));
2243 lw_add_widget_value_arg (wv, XtNheight,
2244 (Dimension)IMAGE_INSTANCE_HEIGHT (p));
2247 /* now modify the widget */
2248 lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (p),
2253 /* instantiate and x type subwindow */
2255 x_subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2256 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2257 int dest_mask, Lisp_Object domain)
2259 /* This function can GC */
2260 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2261 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
2262 Lisp_Object frame = FW_FRAME (domain);
2263 struct frame* f = XFRAME (frame);
2267 XSetWindowAttributes xswa;
2269 unsigned int w = IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii),
2270 h = IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii);
2272 if (!DEVICE_X_P (XDEVICE (device)))
2273 signal_simple_error ("Not an X device", device);
2275 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2276 xs = DefaultScreenOfDisplay (dpy);
2278 IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW;
2280 pw = XtWindow (FRAME_X_TEXT_WIDGET (f));
2282 ii->data = xnew_and_zero (struct x_subwindow_data);
2284 IMAGE_INSTANCE_X_SUBWINDOW_PARENT (ii) = pw;
2285 IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (ii) = DisplayOfScreen (xs);
2287 xswa.backing_store = Always;
2288 valueMask |= CWBackingStore;
2289 xswa.colormap = DefaultColormapOfScreen (xs);
2290 valueMask |= CWColormap;
2292 /* Create a window for clipping */
2293 IMAGE_INSTANCE_X_CLIPWINDOW (ii) =
2294 XCreateWindow (dpy, pw, 0, 0, w, h, 0, CopyFromParent,
2295 InputOutput, CopyFromParent, valueMask,
2298 /* Now put the subwindow inside the clip window. */
2299 win = XCreateWindow (dpy, IMAGE_INSTANCE_X_CLIPWINDOW (ii),
2300 0, 0, w, h, 0, CopyFromParent,
2301 InputOutput, CopyFromParent, valueMask,
2304 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)win;
2308 /* #### Should this function exist? If there's any doubt I'm not implementing it --andyp */
2309 DEFUN ("change-subwindow-property", Fchange_subwindow_property, 3, 3, 0, /*
2310 For the given SUBWINDOW, set PROPERTY to DATA, which is a string.
2311 Subwindows are not currently implemented.
2313 (subwindow, property, data))
2319 CHECK_SUBWINDOW (subwindow);
2320 CHECK_STRING (property);
2321 CHECK_STRING (data);
2323 sw = XSUBWINDOW (subwindow);
2324 dpy = DisplayOfScreen (LISP_DEVICE_TO_X_SCREEN
2325 (FRAME_DEVICE (XFRAME (sw->frame))));
2327 property_atom = XInternAtom (dpy, (char *) XSTRING_DATA (property), False);
2328 XChangeProperty (dpy, sw->subwindow, property_atom, XA_STRING, 8,
2330 XSTRING_DATA (data),
2331 XSTRING_LENGTH (data));
2340 /************************************************************************/
2342 /************************************************************************/
2345 update_widget_face (widget_value* wv, Lisp_Image_Instance *ii,
2348 #ifdef LWLIB_WIDGETS_MOTIF
2349 XmFontList fontList;
2351 /* Update the foreground. */
2352 Lisp_Object pixel = FACE_FOREGROUND
2353 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2355 XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel)), bcolor;
2356 lw_add_widget_value_arg (wv, XtNforeground, fcolor.pixel);
2358 /* Update the background. */
2359 pixel = FACE_BACKGROUND (IMAGE_INSTANCE_WIDGET_FACE (ii),
2361 bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2362 lw_add_widget_value_arg (wv, XtNbackground, bcolor.pixel);
2364 #ifdef LWLIB_WIDGETS_MOTIF
2365 fontList = XmFontListCreate
2366 (FONT_INSTANCE_X_FONT
2367 (XFONT_INSTANCE (query_string_font
2368 (IMAGE_INSTANCE_WIDGET_TEXT (ii),
2369 IMAGE_INSTANCE_WIDGET_FACE (ii),
2370 domain))), XmSTRING_DEFAULT_CHARSET);
2371 lw_add_widget_value_arg (wv, XmNfontList, (XtArgVal)fontList);
2373 lw_add_widget_value_arg
2374 (wv, XtNfont, (XtArgVal)FONT_INSTANCE_X_FONT
2375 (XFONT_INSTANCE (query_string_font
2376 (IMAGE_INSTANCE_WIDGET_TEXT (ii),
2377 IMAGE_INSTANCE_WIDGET_FACE (ii),
2382 update_tab_widget_face (widget_value* wv, Lisp_Image_Instance *ii,
2387 widget_value* val = wv->contents, *cur;
2389 /* Give each child label the correct foreground color. */
2390 Lisp_Object pixel = FACE_FOREGROUND
2391 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2393 XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2394 lw_add_widget_value_arg (val, XtNtabForeground, fcolor.pixel);
2396 for (cur = val->next; cur; cur = cur->next)
2400 lw_copy_widget_value_args (val, cur);
2407 x_widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2408 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2409 int dest_mask, Lisp_Object domain,
2410 const char* type, widget_value* wv)
2412 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2413 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii), pixel;
2414 struct device* d = XDEVICE (device);
2415 Lisp_Object frame = FW_FRAME (domain);
2416 struct frame* f = XFRAME (frame);
2421 int id = new_lwlib_id ();
2422 widget_value* clip_wv;
2423 XColor fcolor, bcolor;
2425 if (!DEVICE_X_P (d))
2426 signal_simple_error ("Not an X device", device);
2428 /* have to set the type this late in case there is no device
2429 instantiation for a widget. But we can go ahead and do it without
2430 checking because there is always a generic instantiator. */
2431 IMAGE_INSTANCE_TYPE (ii) = IMAGE_WIDGET;
2433 if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
2434 TO_EXTERNAL_FORMAT (LISP_STRING, IMAGE_INSTANCE_WIDGET_TEXT (ii),
2435 C_STRING_ALLOCA, nm,
2438 ii->data = xnew_and_zero (struct x_subwindow_data);
2440 /* Create a clip window to contain the subwidget. Incredibly the
2441 XEmacs manager seems to be the most appropriate widget for
2442 this. Nothing else is simple enough and yet does what is
2444 clip_wv = xmalloc_widget_value ();
2446 lw_add_widget_value_arg (clip_wv, XtNresize, False);
2447 lw_add_widget_value_arg (clip_wv, XtNwidth,
2448 (Dimension)IMAGE_INSTANCE_WIDTH (ii));
2449 lw_add_widget_value_arg (clip_wv, XtNheight,
2450 (Dimension)IMAGE_INSTANCE_HEIGHT (ii));
2451 clip_wv->enabled = True;
2453 clip_wv->name = xstrdup ("clip-window");
2454 clip_wv->value = xstrdup ("clip-window");
2456 IMAGE_INSTANCE_X_CLIPWIDGET (ii)
2457 = lw_create_widget ("clip-window", "clip-window", new_lwlib_id (),
2458 clip_wv, FRAME_X_CONTAINER_WIDGET (f),
2461 free_widget_value_tree (clip_wv);
2463 /* copy any args we were given */
2465 lw_add_value_args_to_args (wv, al, &ac);
2467 /* Fixup the colors. We have to do this *before* the widget gets
2468 created so that Motif will fix up the shadow colors
2469 correctly. Once the widget is created Motif won't do this
2471 pixel = FACE_FOREGROUND
2472 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2473 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2474 fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2476 pixel = FACE_BACKGROUND
2477 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2478 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2479 bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2481 lw_add_widget_value_arg (wv, XtNbackground, bcolor.pixel);
2482 lw_add_widget_value_arg (wv, XtNforeground, fcolor.pixel);
2483 /* we cannot allow widgets to resize themselves */
2484 lw_add_widget_value_arg (wv, XtNresize, False);
2485 lw_add_widget_value_arg (wv, XtNwidth,
2486 (Dimension)IMAGE_INSTANCE_WIDTH (ii));
2487 lw_add_widget_value_arg (wv, XtNheight,
2488 (Dimension)IMAGE_INSTANCE_HEIGHT (ii));
2489 /* update the font. */
2490 update_widget_face (wv, ii, domain);
2492 wid = lw_create_widget (type, wv->name, id, wv, IMAGE_INSTANCE_X_CLIPWIDGET (ii),
2493 False, 0, popup_selection_callback, 0);
2495 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)wid;
2496 IMAGE_INSTANCE_X_WIDGET_LWID (ii) = id;
2498 /* Resize the widget here so that the values do not get copied by
2501 XtSetArg (al [ac], XtNwidth,
2502 (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii)); ac++;
2503 XtSetArg (al [ac], XtNheight,
2504 (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); ac++;
2505 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, ac);
2507 /* because the EmacsManager is the widgets parent we have to
2508 offset the redisplay of the widget by the amount the text
2509 widget is inside the manager. */
2511 XtSetArg (al [ac], XtNx, &IMAGE_INSTANCE_X_WIDGET_XOFFSET (ii)); ac++;
2512 XtSetArg (al [ac], XtNy, &IMAGE_INSTANCE_X_WIDGET_YOFFSET (ii)); ac++;
2513 XtGetValues (FRAME_X_TEXT_WIDGET (f), al, ac);
2515 XtSetMappedWhenManaged (wid, TRUE);
2517 free_widget_value_tree (wv);
2520 /* get properties of a control */
2522 x_widget_property (Lisp_Object image_instance, Lisp_Object prop)
2524 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2525 /* get the text from a control */
2526 if (EQ (prop, Q_text))
2528 widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2529 return build_ext_string (wv->value, Qnative);
2534 /* Instantiate a button widget. Unfortunately instantiated widgets are
2535 particular to a frame since they need to have a parent. It's not
2536 like images where you just select the image into the context you
2537 want to display it in and BitBlt it. So images instances can have a
2538 many-to-one relationship with things you see, whereas widgets can
2539 only be one-to-one (i.e. per frame) */
2541 x_button_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2542 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2543 int dest_mask, Lisp_Object domain)
2545 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2546 Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2547 Lisp_Object glyph = find_keyword_in_vector (instantiator, Q_image);
2548 widget_value* wv = xmalloc_widget_value ();
2550 button_item_to_widget_value (gui, wv, 1, 1);
2554 if (!IMAGE_INSTANCEP (glyph))
2555 glyph = glyph_image_instance (glyph, domain, ERROR_ME, 1);
2558 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2559 pointer_bg, dest_mask, domain, "button", wv);
2561 /* add the image if one was given */
2562 if (!NILP (glyph) && IMAGE_INSTANCEP (glyph)
2563 && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (glyph)))
2567 #ifdef LWLIB_WIDGETS_MOTIF
2568 XtSetArg (al [ac], XmNlabelType, XmPIXMAP); ac++;
2569 XtSetArg (al [ac], XmNlabelPixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph));ac++;
2571 XtSetArg (al [ac], XtNpixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph)); ac++;
2573 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, ac);
2577 /* get properties of a button */
2579 x_button_property (Lisp_Object image_instance, Lisp_Object prop)
2581 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2582 /* check the state of a button */
2583 if (EQ (prop, Q_selected))
2585 widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2595 /* instantiate a progress gauge */
2597 x_progress_gauge_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2598 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2599 int dest_mask, Lisp_Object domain)
2601 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2602 Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2603 widget_value* wv = xmalloc_widget_value ();
2605 button_item_to_widget_value (gui, wv, 1, 1);
2607 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2608 pointer_bg, dest_mask, domain, "progress", wv);
2611 /* set the properties of a progres guage */
2613 x_progress_gauge_update (Lisp_Object image_instance)
2615 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2617 if (IMAGE_INSTANCE_WIDGET_PERCENT_CHANGED (ii))
2620 /* #### I'm not convinced we should store this in the plist. */
2621 Lisp_Object val = Fplist_get (IMAGE_INSTANCE_WIDGET_PROPS (ii),
2623 XtSetArg (al[0], XtNvalue, XINT (val));
2624 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 1);
2628 /* instantiate an edit control */
2630 x_edit_field_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2631 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2632 int dest_mask, Lisp_Object domain)
2634 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2635 Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2636 widget_value* wv = xmalloc_widget_value ();
2638 button_item_to_widget_value (gui, wv, 1, 1);
2640 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2641 pointer_bg, dest_mask, domain, "text-field", wv);
2644 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
2645 /* instantiate a combo control */
2647 x_combo_box_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 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2652 widget_value * wv = 0;
2653 /* This is not done generically because of sizing problems under
2655 widget_instantiate (image_instance, instantiator, pointer_fg,
2656 pointer_bg, dest_mask, domain);
2658 wv = gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2660 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2661 pointer_bg, dest_mask, domain, "combo-box", wv);
2666 x_tab_control_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2667 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2668 int dest_mask, Lisp_Object domain)
2670 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2672 gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2674 update_tab_widget_face (wv, ii,
2675 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2677 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2678 pointer_bg, dest_mask, domain, "tab-control", wv);
2681 /* set the properties of a tab control */
2683 x_tab_control_update (Lisp_Object image_instance)
2685 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2687 /* Possibly update the face. */
2688 if (IMAGE_INSTANCE_WIDGET_FACE_CHANGED (ii)
2690 XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii))->faces_changed
2692 IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii))
2694 widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2695 update_tab_widget_face (wv, ii,
2696 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2698 lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, True);
2702 /* instantiate a static control possible for putting other things in */
2704 x_label_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2705 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2706 int dest_mask, Lisp_Object domain)
2708 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2709 Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2710 widget_value* wv = xmalloc_widget_value ();
2712 button_item_to_widget_value (gui, wv, 1, 1);
2714 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2715 pointer_bg, dest_mask, domain, "button", wv);
2717 #endif /* HAVE_WIDGETS */
2720 /************************************************************************/
2721 /* initialization */
2722 /************************************************************************/
2725 syms_of_glyphs_x (void)
2728 DEFSUBR (Fchange_subwindow_property);
2733 console_type_create_glyphs_x (void)
2737 CONSOLE_HAS_METHOD (x, print_image_instance);
2738 CONSOLE_HAS_METHOD (x, finalize_image_instance);
2739 CONSOLE_HAS_METHOD (x, image_instance_equal);
2740 CONSOLE_HAS_METHOD (x, image_instance_hash);
2741 CONSOLE_HAS_METHOD (x, colorize_image_instance);
2742 CONSOLE_HAS_METHOD (x, init_image_instance_from_eimage);
2743 CONSOLE_HAS_METHOD (x, locate_pixmap_file);
2744 CONSOLE_HAS_METHOD (x, unmap_subwindow);
2745 CONSOLE_HAS_METHOD (x, map_subwindow);
2746 CONSOLE_HAS_METHOD (x, update_widget);
2747 CONSOLE_HAS_METHOD (x, update_subwindow);
2751 image_instantiator_format_create_glyphs_x (void)
2753 IIFORMAT_VALID_CONSOLE (x, nothing);
2754 IIFORMAT_VALID_CONSOLE (x, string);
2755 IIFORMAT_VALID_CONSOLE (x, layout);
2756 IIFORMAT_VALID_CONSOLE (x, formatted_string);
2757 IIFORMAT_VALID_CONSOLE (x, inherit);
2759 INITIALIZE_DEVICE_IIFORMAT (x, xpm);
2760 IIFORMAT_HAS_DEVMETHOD (x, xpm, instantiate);
2763 IIFORMAT_VALID_CONSOLE (x, jpeg);
2766 IIFORMAT_VALID_CONSOLE (x, tiff);
2769 IIFORMAT_VALID_CONSOLE (x, png);
2772 IIFORMAT_VALID_CONSOLE (x, gif);
2774 INITIALIZE_DEVICE_IIFORMAT (x, xbm);
2775 IIFORMAT_HAS_DEVMETHOD (x, xbm, instantiate);
2777 INITIALIZE_DEVICE_IIFORMAT (x, subwindow);
2778 IIFORMAT_HAS_DEVMETHOD (x, subwindow, instantiate);
2781 INITIALIZE_DEVICE_IIFORMAT (x, button);
2782 IIFORMAT_HAS_DEVMETHOD (x, button, property);
2783 IIFORMAT_HAS_DEVMETHOD (x, button, instantiate);
2785 INITIALIZE_DEVICE_IIFORMAT (x, widget);
2786 IIFORMAT_HAS_DEVMETHOD (x, widget, property);
2787 /* progress gauge */
2788 INITIALIZE_DEVICE_IIFORMAT (x, progress_gauge);
2789 IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, update);
2790 IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, instantiate);
2792 INITIALIZE_DEVICE_IIFORMAT (x, edit_field);
2793 IIFORMAT_HAS_DEVMETHOD (x, edit_field, instantiate);
2794 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
2796 INITIALIZE_DEVICE_IIFORMAT (x, combo_box);
2797 IIFORMAT_HAS_DEVMETHOD (x, combo_box, instantiate);
2798 IIFORMAT_HAS_SHARED_DEVMETHOD (x, combo_box, update, tab_control);
2800 /* tab control widget */
2801 INITIALIZE_DEVICE_IIFORMAT (x, tab_control);
2802 IIFORMAT_HAS_DEVMETHOD (x, tab_control, instantiate);
2803 IIFORMAT_HAS_DEVMETHOD (x, tab_control, update);
2805 INITIALIZE_DEVICE_IIFORMAT (x, label);
2806 IIFORMAT_HAS_DEVMETHOD (x, label, instantiate);
2808 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (cursor_font, "cursor-font");
2809 IIFORMAT_VALID_CONSOLE (x, cursor_font);
2811 IIFORMAT_HAS_METHOD (cursor_font, validate);
2812 IIFORMAT_HAS_METHOD (cursor_font, possible_dest_types);
2813 IIFORMAT_HAS_METHOD (cursor_font, instantiate);
2815 IIFORMAT_VALID_KEYWORD (cursor_font, Q_data, check_valid_string);
2816 IIFORMAT_VALID_KEYWORD (cursor_font, Q_foreground, check_valid_string);
2817 IIFORMAT_VALID_KEYWORD (cursor_font, Q_background, check_valid_string);
2819 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (font, "font");
2821 IIFORMAT_HAS_METHOD (font, validate);
2822 IIFORMAT_HAS_METHOD (font, possible_dest_types);
2823 IIFORMAT_HAS_METHOD (font, instantiate);
2824 IIFORMAT_VALID_CONSOLE (x, font);
2826 IIFORMAT_VALID_KEYWORD (font, Q_data, check_valid_string);
2827 IIFORMAT_VALID_KEYWORD (font, Q_foreground, check_valid_string);
2828 IIFORMAT_VALID_KEYWORD (font, Q_background, check_valid_string);
2831 INITIALIZE_DEVICE_IIFORMAT (x, xface);
2832 IIFORMAT_HAS_DEVMETHOD (x, xface, instantiate);
2835 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (autodetect,
2838 IIFORMAT_HAS_METHOD (autodetect, validate);
2839 IIFORMAT_HAS_METHOD (autodetect, normalize);
2840 IIFORMAT_HAS_METHOD (autodetect, possible_dest_types);
2841 IIFORMAT_HAS_METHOD (autodetect, instantiate);
2842 IIFORMAT_VALID_CONSOLE (x, autodetect);
2844 IIFORMAT_VALID_KEYWORD (autodetect, Q_data, check_valid_string);
2848 vars_of_glyphs_x (void)
2850 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path /*
2851 A list of the directories in which X bitmap files may be found.
2852 If nil, this is initialized from the "*bitmapFilePath" resource.
2853 This is used by the `make-image-instance' function (however, note that if
2854 the environment variable XBMLANGPATH is set, it is consulted first).
2856 Vx_bitmap_file_path = Qnil;
2860 complex_vars_of_glyphs_x (void)
2862 #define BUILD_GLYPH_INST(variable, name) \
2863 Fadd_spec_to_specifier \
2864 (GLYPH_IMAGE (XGLYPH (variable)), \
2865 vector3 (Qxbm, Q_data, \
2866 list3 (make_int (name##_width), \
2867 make_int (name##_height), \
2868 make_ext_string (name##_bits, \
2869 sizeof (name##_bits), \
2873 BUILD_GLYPH_INST (Vtruncation_glyph, truncator);
2874 BUILD_GLYPH_INST (Vcontinuation_glyph, continuer);
2875 BUILD_GLYPH_INST (Vxemacs_logo, xemacs);
2876 BUILD_GLYPH_INST (Vhscroll_glyph, hscroll);
2878 #undef BUILD_GLYPH_INST