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_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 (Lisp_Image_Instance *p1,
477 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 (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 (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)))
567 return Fexpand_file_name (name, Qnil);
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 (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 (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 (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 (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 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1152 if (!NILP (mask_data))
1154 CONST char *ext_data;
1156 TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (XCDR (XCDR (mask_data))),
1157 C_STRING_ALLOCA, ext_data,
1159 mask = pixmap_from_xbm_inline (IMAGE_INSTANCE_DEVICE (ii),
1160 XINT (XCAR (mask_data)),
1161 XINT (XCAR (XCDR (mask_data))),
1162 (CONST unsigned char *) ext_data);
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 *ext_data;
1180 assert (!NILP (data));
1182 TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (XCDR (XCDR (data))),
1183 C_STRING_ALLOCA, ext_data,
1186 xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1187 pointer_bg, dest_mask, XINT (XCAR (data)),
1188 XINT (XCAR (XCDR (data))), ext_data);
1194 /**********************************************************************
1196 **********************************************************************/
1197 /* xpm 3.2g and better has XpmCreatePixmapFromBuffer()...
1198 There was no version number in xpm.h before 3.3, but this should do.
1200 #if (XpmVersion >= 3) || defined(XpmExactColors)
1201 # define XPM_DOES_BUFFERS
1204 #ifndef XPM_DOES_BUFFERS
1205 Your version of XPM is too old. You cannot compile with it.
1206 Upgrade to version 3.2g or better or compile with --with-xpm=no.
1207 #endif /* !XPM_DOES_BUFFERS */
1209 static XpmColorSymbol *
1210 extract_xpm_color_names (XpmAttributes *xpmattrs, Lisp_Object device,
1212 Lisp_Object color_symbol_alist)
1214 /* This function can GC */
1215 Display *dpy = DEVICE_X_DISPLAY (XDEVICE(device));
1216 Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1219 Lisp_Object results = Qnil;
1221 XpmColorSymbol *symbols;
1222 struct gcpro gcpro1, gcpro2;
1224 GCPRO2 (results, device);
1226 /* We built up results to be (("name" . #<color>) ...) so that if an
1227 error happens we don't lose any malloc()ed data, or more importantly,
1228 leave any pixels allocated in the server. */
1230 LIST_LOOP (rest, color_symbol_alist)
1232 Lisp_Object cons = XCAR (rest);
1233 Lisp_Object name = XCAR (cons);
1234 Lisp_Object value = XCDR (cons);
1237 if (STRINGP (value))
1239 Fmake_color_instance
1240 (value, device, encode_error_behavior_flag (ERROR_ME_NOT));
1243 assert (COLOR_SPECIFIERP (value));
1244 value = Fspecifier_instance (value, domain, Qnil, Qnil);
1248 results = noseeum_cons (noseeum_cons (name, value), results);
1251 UNGCPRO; /* no more evaluation */
1253 if (i == 0) return 0;
1255 symbols = xnew_array (XpmColorSymbol, i);
1256 xpmattrs->valuemask |= XpmColorSymbols;
1257 xpmattrs->colorsymbols = symbols;
1258 xpmattrs->numsymbols = i;
1262 Lisp_Object cons = XCAR (results);
1263 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (XCDR (cons)));
1264 /* Duplicate the pixel value so that we still have a lock on it if
1265 the pixel we were passed is later freed. */
1266 if (! XAllocColor (dpy, cmap, &color))
1267 abort (); /* it must be allocable since we're just duplicating it */
1269 symbols [i].name = (char *) XSTRING_DATA (XCAR (cons));
1270 symbols [i].pixel = color.pixel;
1271 symbols [i].value = 0;
1272 free_cons (XCONS (cons));
1274 results = XCDR (results);
1275 free_cons (XCONS (cons));
1281 xpm_free (XpmAttributes *xpmattrs)
1283 /* Could conceivably lose if XpmXXX returned an error without first
1284 initializing this structure, if we didn't know that initializing it
1285 to all zeros was ok (and also that it's ok to call XpmFreeAttributes()
1286 multiple times, since it zeros slots as it frees them...) */
1287 XpmFreeAttributes (xpmattrs);
1291 x_xpm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1292 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1293 int dest_mask, Lisp_Object domain)
1295 /* This function can GC */
1296 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1297 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1298 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1306 XpmAttributes xpmattrs;
1308 XpmColorSymbol *color_symbols;
1309 Lisp_Object color_symbol_alist = find_keyword_in_vector (instantiator,
1311 enum image_instance_type type;
1315 if (!DEVICE_X_P (XDEVICE (device)))
1316 signal_simple_error ("Not an X device", device);
1318 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1319 xs = DefaultScreenOfDisplay (dpy);
1321 if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
1322 type = IMAGE_COLOR_PIXMAP;
1323 else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
1324 type = IMAGE_MONO_PIXMAP;
1325 else if (dest_mask & IMAGE_POINTER_MASK)
1326 type = IMAGE_POINTER;
1328 incompatible_image_types (instantiator, dest_mask,
1329 IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
1330 | IMAGE_POINTER_MASK);
1331 force_mono = (type != IMAGE_COLOR_PIXMAP);
1334 /* Although I haven't found it documented yet, it appears that pointers are
1335 always colored via the default window colormap... Sigh. */
1336 if (type == IMAGE_POINTER)
1338 cmap = DefaultColormap(dpy, DefaultScreen(dpy));
1339 depth = DefaultDepthOfScreen (xs);
1340 visual = DefaultVisualOfScreen (xs);
1344 cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1345 depth = DEVICE_X_DEPTH (XDEVICE(device));
1346 visual = DEVICE_X_VISUAL (XDEVICE(device));
1349 cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1350 depth = DEVICE_X_DEPTH (XDEVICE(device));
1351 visual = DEVICE_X_VISUAL (XDEVICE(device));
1354 x_initialize_pixmap_image_instance (ii, 1, type);
1356 assert (!NILP (data));
1360 xzero (xpmattrs); /* want XpmInitAttributes() */
1361 xpmattrs.valuemask = XpmReturnPixels;
1364 /* Without this, we get a 1-bit version of the color image, which
1365 isn't quite right. With this, we get the mono image, which might
1366 be very different looking. */
1367 xpmattrs.valuemask |= XpmColorKey;
1368 xpmattrs.color_key = XPM_MONO;
1370 xpmattrs.valuemask |= XpmDepth;
1374 xpmattrs.closeness = 65535;
1375 xpmattrs.valuemask |= XpmCloseness;
1376 xpmattrs.depth = depth;
1377 xpmattrs.valuemask |= XpmDepth;
1378 xpmattrs.visual = visual;
1379 xpmattrs.valuemask |= XpmVisual;
1380 xpmattrs.colormap = cmap;
1381 xpmattrs.valuemask |= XpmColormap;
1384 color_symbols = extract_xpm_color_names (&xpmattrs, device, domain,
1385 color_symbol_alist);
1387 result = XpmCreatePixmapFromBuffer (dpy,
1388 XtWindow(DEVICE_XT_APP_SHELL (XDEVICE(device))),
1389 (char *) XSTRING_DATA (data),
1390 &pixmap, &mask, &xpmattrs);
1394 xfree (color_symbols);
1395 xpmattrs.colorsymbols = 0; /* in case XpmFreeAttr is too smart... */
1396 xpmattrs.numsymbols = 0;
1403 case XpmFileInvalid:
1405 xpm_free (&xpmattrs);
1406 signal_image_error ("invalid XPM data", data);
1408 case XpmColorFailed:
1411 xpm_free (&xpmattrs);
1414 /* second time; blow out. */
1415 signal_double_file_error ("Reading pixmap data",
1416 "color allocation failed",
1421 if (! (dest_mask & IMAGE_MONO_PIXMAP_MASK))
1423 /* second time; blow out. */
1424 signal_double_file_error ("Reading pixmap data",
1425 "color allocation failed",
1429 IMAGE_INSTANCE_TYPE (ii) = IMAGE_MONO_PIXMAP;
1435 xpm_free (&xpmattrs);
1436 signal_double_file_error ("Parsing pixmap data",
1437 "out of memory", data);
1441 xpm_free (&xpmattrs);
1442 signal_double_file_error_2 ("Parsing pixmap data",
1443 "unknown error code",
1444 make_int (result), data);
1449 h = xpmattrs.height;
1452 int npixels = xpmattrs.npixels;
1457 pixels = xnew_array (Pixel, npixels);
1458 memcpy (pixels, xpmattrs.pixels, npixels * sizeof (Pixel));
1463 IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
1464 IMAGE_INSTANCE_PIXMAP_MASK (ii) = (void*)mask;
1465 IMAGE_INSTANCE_X_COLORMAP (ii) = cmap;
1466 IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
1467 IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
1468 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = w;
1469 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = h;
1470 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
1471 find_keyword_in_vector (instantiator, Q_file);
1476 case IMAGE_MONO_PIXMAP:
1479 case IMAGE_COLOR_PIXMAP:
1481 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = depth;
1487 int npixels = xpmattrs.npixels;
1488 Pixel *pixels = xpmattrs.pixels;
1491 int xhot = 0, yhot = 0;
1493 if (xpmattrs.valuemask & XpmHotspot)
1495 xhot = xpmattrs.x_hotspot;
1496 XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii), xpmattrs.x_hotspot);
1498 if (xpmattrs.valuemask & XpmHotspot)
1500 yhot = xpmattrs.y_hotspot;
1501 XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii), xpmattrs.y_hotspot);
1503 check_pointer_sizes (xs, w, h, instantiator);
1505 /* If the loaded pixmap has colors allocated (meaning it came from an
1506 XPM file), then use those as the default colors for the cursor we
1507 create. Otherwise, default to pointer_fg and pointer_bg.
1511 /* With an XBM file, it's obvious which bit is foreground
1512 and which is background, or rather, it's implicit: in
1513 an XBM file, a 1 bit is foreground, and a 0 bit is
1516 XCreatePixmapCursor() assumes this property of the
1517 pixmap it is called with as well; the `foreground'
1518 color argument is used for the 1 bits.
1520 With an XPM file, it's tricker, since the elements of
1521 the pixmap don't represent FG and BG, but are actual
1522 pixel values. So we need to figure out which of those
1523 pixels is the foreground color and which is the
1524 background. We do it by comparing RGB and assuming
1525 that the darker color is the foreground. This works
1526 with the result of xbmtopbm|ppmtoxpm, at least.
1528 It might be nice if there was some way to tag the
1529 colors in the XPM file with whether they are the
1530 foreground - perhaps with logical color names somehow?
1532 Once we have decided which color is the foreground, we
1533 need to ensure that that color corresponds to a `1' bit
1534 in the Pixmap. The XPM library wrote into the (1-bit)
1535 pixmap with XPutPixel, which will ignore all but the
1536 least significant bit.
1538 This means that a 1 bit in the image corresponds to
1539 `fg' only if `fg.pixel' is odd.
1541 (This also means that the image will be all the same
1542 color if both `fg' and `bg' are odd or even, but we can
1543 safely assume that that won't happen if the XPM file is
1546 The desired result is that the image use `1' to
1547 represent the foreground color, and `0' to represent
1548 the background color. So, we may need to invert the
1549 image to accomplish this; we invert if fg is
1550 odd. (Remember that WhitePixel and BlackPixel are not
1551 necessarily 1 and 0 respectively, though I think it
1552 might be safe to assume that one of them is always 1
1553 and the other is always 0. We also pretty much need to
1554 assume that one is even and the other is odd.)
1557 fg.pixel = pixels[0]; /* pick a pixel at random. */
1558 bg.pixel = fg.pixel;
1559 for (i = 1; i < npixels; i++) /* Look for an "other" pixel value.*/
1561 bg.pixel = pixels[i];
1562 if (fg.pixel != bg.pixel)
1566 /* If (fg.pixel == bg.pixel) then probably something has
1567 gone wrong, but I don't think signalling an error would
1570 XQueryColor (dpy, cmap, &fg);
1571 XQueryColor (dpy, cmap, &bg);
1573 /* If the foreground is lighter than the background, swap them.
1574 (This occurs semi-randomly, depending on the ordering of the
1575 color list in the XPM file.)
1578 unsigned short fg_total = ((fg.red / 3) + (fg.green / 3)
1580 unsigned short bg_total = ((bg.red / 3) + (bg.green / 3)
1582 if (fg_total > bg_total)
1591 /* If the fg pixel corresponds to a `0' in the bitmap, invert it.
1592 (This occurs (only?) on servers with Black=0, White=1.)
1594 if ((fg.pixel & 1) == 0)
1598 gcv.function = GXxor;
1600 gc = XCreateGC (dpy, pixmap, (GCFunction | GCForeground),
1602 XFillRectangle (dpy, pixmap, gc, 0, 0, w, h);
1608 generate_cursor_fg_bg (device, &pointer_fg, &pointer_bg,
1610 IMAGE_INSTANCE_PIXMAP_FG (ii) = pointer_fg;
1611 IMAGE_INSTANCE_PIXMAP_BG (ii) = pointer_bg;
1614 IMAGE_INSTANCE_X_CURSOR (ii) =
1616 (dpy, pixmap, mask, &fg, &bg, xhot, yhot);
1625 xpm_free (&xpmattrs); /* after we've read pixels and hotspot */
1628 #endif /* HAVE_XPM */
1633 /**********************************************************************
1635 **********************************************************************/
1637 /* This is about to get redefined! */
1640 /* We have to define SYSV32 so that compface.h includes string.h
1641 instead of strings.h. */
1646 #include <compface.h>
1650 /* JMP_BUF cannot be used here because if it doesn't get defined
1651 to jmp_buf we end up with a conflicting type error with the
1652 definition in compface.h */
1653 extern jmp_buf comp_env;
1657 x_xface_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1658 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1659 int dest_mask, Lisp_Object domain)
1661 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1663 char *p, *bits, *bp;
1664 CONST char * volatile emsg = 0;
1665 CONST char * volatile dstring;
1667 assert (!NILP (data));
1669 TO_EXTERNAL_FORMAT (LISP_STRING, data,
1670 C_STRING_ALLOCA, dstring,
1673 if ((p = strchr (dstring, ':')))
1678 /* Must use setjmp not SETJMP because we used jmp_buf above not JMP_BUF */
1679 if (!(stattis = setjmp (comp_env)))
1681 UnCompAll ((char *) dstring);
1688 emsg = "uncompface: internal error";
1691 emsg = "uncompface: insufficient or invalid data";
1694 emsg = "uncompface: excess data ignored";
1699 signal_simple_error_2 (emsg, data, Qimage);
1701 bp = bits = (char *) alloca (PIXELS / 8);
1703 /* the compface library exports char F[], which uses a single byte per
1704 pixel to represent a 48x48 bitmap. Yuck. */
1705 for (i = 0, p = F; i < (PIXELS / 8); ++i)
1708 /* reverse the bit order of each byte... */
1709 for (b = n = 0; b < 8; ++b)
1716 xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1717 pointer_bg, dest_mask, 48, 48, bits);
1720 #endif /* HAVE_XFACE */
1723 /**********************************************************************
1725 **********************************************************************/
1728 autodetect_validate (Lisp_Object instantiator)
1730 data_must_be_present (instantiator);
1734 autodetect_normalize (Lisp_Object instantiator,
1735 Lisp_Object console_type)
1737 Lisp_Object file = find_keyword_in_vector (instantiator, Q_data);
1738 Lisp_Object filename = Qnil;
1739 Lisp_Object data = Qnil;
1740 struct gcpro gcpro1, gcpro2, gcpro3;
1741 Lisp_Object alist = Qnil;
1743 GCPRO3 (filename, data, alist);
1745 if (NILP (file)) /* no conversion necessary */
1746 RETURN_UNGCPRO (instantiator);
1748 alist = tagged_vector_to_alist (instantiator);
1750 filename = locate_pixmap_file (file);
1751 if (!NILP (filename))
1754 /* #### Apparently some versions of XpmReadFileToData, which is
1755 called by pixmap_to_lisp_data, don't return an error value
1756 if the given file is not a valid XPM file. Instead, they
1757 just seg fault. It is definitely caused by passing a
1758 bitmap. To try and avoid this we check for bitmaps first. */
1760 data = bitmap_to_lisp_data (filename, &xhot, &yhot, 1);
1764 alist = remassq_no_quit (Q_data, alist);
1765 alist = Fcons (Fcons (Q_file, filename),
1766 Fcons (Fcons (Q_data, data), alist));
1768 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
1771 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
1774 alist = xbm_mask_file_munging (alist, filename, Qnil, console_type);
1777 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
1779 RETURN_UNGCPRO (result);
1784 data = pixmap_to_lisp_data (filename, 1);
1788 alist = remassq_no_quit (Q_data, alist);
1789 alist = Fcons (Fcons (Q_file, filename),
1790 Fcons (Fcons (Q_data, data), alist));
1791 alist = Fcons (Fcons (Q_color_symbols,
1792 evaluate_xpm_color_symbols ()),
1795 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
1797 RETURN_UNGCPRO (result);
1803 /* If we couldn't convert it, just put it back as it is.
1804 We might try to further frob it later as a cursor-font
1805 specification. (We can't do that now because we don't know
1806 what dest-types it's going to be instantiated into.) */
1808 Lisp_Object result = alist_to_tagged_vector (Qautodetect, alist);
1810 RETURN_UNGCPRO (result);
1815 autodetect_possible_dest_types (void)
1818 IMAGE_MONO_PIXMAP_MASK |
1819 IMAGE_COLOR_PIXMAP_MASK |
1820 IMAGE_POINTER_MASK |
1825 autodetect_instantiate (Lisp_Object image_instance,
1826 Lisp_Object instantiator,
1827 Lisp_Object pointer_fg,
1828 Lisp_Object pointer_bg,
1829 int dest_mask, Lisp_Object domain)
1831 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1832 struct gcpro gcpro1, gcpro2, gcpro3;
1833 Lisp_Object alist = Qnil;
1834 Lisp_Object result = Qnil;
1835 int is_cursor_font = 0;
1837 GCPRO3 (data, alist, result);
1839 alist = tagged_vector_to_alist (instantiator);
1840 if (dest_mask & IMAGE_POINTER_MASK)
1842 CONST char *name_ext;
1843 TO_EXTERNAL_FORMAT (LISP_STRING, data,
1844 C_STRING_ALLOCA, name_ext,
1846 if (XmuCursorNameToIndex (name_ext) != -1)
1848 result = alist_to_tagged_vector (Qcursor_font, alist);
1853 if (!is_cursor_font)
1854 result = alist_to_tagged_vector (Qstring, alist);
1858 cursor_font_instantiate (image_instance, result, pointer_fg,
1859 pointer_bg, dest_mask, domain);
1861 string_instantiate (image_instance, result, pointer_fg,
1862 pointer_bg, dest_mask, domain);
1868 /**********************************************************************
1870 **********************************************************************/
1873 font_validate (Lisp_Object instantiator)
1875 data_must_be_present (instantiator);
1878 /* XmuCvtStringToCursor is bogus in the following ways:
1880 - When it can't convert the given string to a real cursor, it will
1881 sometimes return a "success" value, after triggering a BadPixmap
1882 error. It then gives you a cursor that will itself generate BadCursor
1883 errors. So we install this error handler to catch/notice the X error
1884 and take that as meaning "couldn't convert."
1886 - When you tell it to find a cursor file that doesn't exist, it prints
1887 an error message on stderr. You can't make it not do that.
1889 - Also, using Xmu means we can't properly hack Lisp_Image_Instance
1890 objects, or XPM files, or $XBMLANGPATH.
1893 /* Duplicate the behavior of XmuCvtStringToCursor() to bypass its bogusness. */
1895 static int XLoadFont_got_error;
1898 XLoadFont_error_handler (Display *dpy, XErrorEvent *xerror)
1900 XLoadFont_got_error = 1;
1905 safe_XLoadFont (Display *dpy, char *name)
1908 int (*old_handler) (Display *, XErrorEvent *);
1909 XLoadFont_got_error = 0;
1911 old_handler = XSetErrorHandler (XLoadFont_error_handler);
1912 font = XLoadFont (dpy, name);
1914 XSetErrorHandler (old_handler);
1915 if (XLoadFont_got_error) return 0;
1920 font_possible_dest_types (void)
1922 return IMAGE_POINTER_MASK;
1926 font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1927 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1928 int dest_mask, Lisp_Object domain)
1930 /* This function can GC */
1931 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1932 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1933 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1937 char source_name[MAXPATHLEN], mask_name[MAXPATHLEN], dummy;
1938 int source_char, mask_char;
1940 Lisp_Object foreground, background;
1942 if (!DEVICE_X_P (XDEVICE (device)))
1943 signal_simple_error ("Not an X device", device);
1945 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1947 if (!STRINGP (data) ||
1948 strncmp ("FONT ", (char *) XSTRING_DATA (data), 5))
1949 signal_simple_error ("Invalid font-glyph instantiator",
1952 if (!(dest_mask & IMAGE_POINTER_MASK))
1953 incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
1955 foreground = find_keyword_in_vector (instantiator, Q_foreground);
1956 if (NILP (foreground))
1957 foreground = pointer_fg;
1958 background = find_keyword_in_vector (instantiator, Q_background);
1959 if (NILP (background))
1960 background = pointer_bg;
1962 generate_cursor_fg_bg (device, &foreground, &background, &fg, &bg);
1964 count = sscanf ((char *) XSTRING_DATA (data),
1965 "FONT %s %d %s %d %c",
1966 source_name, &source_char,
1967 mask_name, &mask_char, &dummy);
1968 /* Allow "%s %d %d" as well... */
1969 if (count == 3 && (1 == sscanf (mask_name, "%d %c", &mask_char, &dummy)))
1970 count = 4, mask_name[0] = 0;
1972 if (count != 2 && count != 4)
1973 signal_simple_error ("invalid cursor specification", data);
1974 source = safe_XLoadFont (dpy, source_name);
1976 signal_simple_error_2 ("couldn't load font",
1977 build_string (source_name),
1981 else if (!mask_name[0])
1985 mask = safe_XLoadFont (dpy, mask_name);
1988 Fsignal (Qerror, list3 (build_string ("couldn't load font"),
1989 build_string (mask_name), data));
1994 /* #### call XQueryTextExtents() and check_pointer_sizes() here. */
1996 x_initialize_pixmap_image_instance (ii, 1, IMAGE_POINTER);
1997 IMAGE_INSTANCE_X_CURSOR (ii) =
1998 XCreateGlyphCursor (dpy, source, mask, source_char, mask_char,
2000 XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
2001 XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
2002 XUnloadFont (dpy, source);
2003 if (mask && mask != source) XUnloadFont (dpy, mask);
2007 /**********************************************************************
2009 **********************************************************************/
2012 cursor_font_validate (Lisp_Object instantiator)
2014 data_must_be_present (instantiator);
2018 cursor_font_possible_dest_types (void)
2020 return IMAGE_POINTER_MASK;
2024 cursor_font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2025 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2026 int dest_mask, Lisp_Object domain)
2028 /* This function can GC */
2029 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
2030 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2031 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
2034 CONST char *name_ext;
2035 Lisp_Object foreground, background;
2037 if (!DEVICE_X_P (XDEVICE (device)))
2038 signal_simple_error ("Not an X device", device);
2040 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2042 if (!(dest_mask & IMAGE_POINTER_MASK))
2043 incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
2045 TO_EXTERNAL_FORMAT (LISP_STRING, data,
2046 C_STRING_ALLOCA, name_ext,
2048 if ((i = XmuCursorNameToIndex (name_ext)) == -1)
2049 signal_simple_error ("Unrecognized cursor-font name", data);
2051 x_initialize_pixmap_image_instance (ii, 1, IMAGE_POINTER);
2052 IMAGE_INSTANCE_X_CURSOR (ii) = XCreateFontCursor (dpy, i);
2053 foreground = find_keyword_in_vector (instantiator, Q_foreground);
2054 if (NILP (foreground))
2055 foreground = pointer_fg;
2056 background = find_keyword_in_vector (instantiator, Q_background);
2057 if (NILP (background))
2058 background = pointer_bg;
2059 maybe_recolor_cursor (image_instance, foreground, background);
2063 x_colorize_image_instance (Lisp_Object image_instance,
2064 Lisp_Object foreground, Lisp_Object background)
2066 Lisp_Image_Instance *p;
2068 p = XIMAGE_INSTANCE (image_instance);
2070 switch (IMAGE_INSTANCE_TYPE (p))
2072 case IMAGE_MONO_PIXMAP:
2073 IMAGE_INSTANCE_TYPE (p) = IMAGE_COLOR_PIXMAP;
2074 /* Make sure there aren't two pointers to the same mask, causing
2075 it to get freed twice. */
2076 IMAGE_INSTANCE_PIXMAP_MASK (p) = 0;
2084 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
2085 Drawable draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (IMAGE_INSTANCE_DEVICE (p))));
2086 Dimension d = DEVICE_X_DEPTH (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
2087 Pixmap new = XCreatePixmap (dpy, draw,
2088 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
2089 IMAGE_INSTANCE_PIXMAP_HEIGHT (p), d);
2093 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground));
2094 gcv.foreground = color.pixel;
2095 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background));
2096 gcv.background = color.pixel;
2097 gc = XCreateGC (dpy, new, GCBackground|GCForeground, &gcv);
2098 XCopyPlane (dpy, IMAGE_INSTANCE_X_PIXMAP (p), new, gc, 0, 0,
2099 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
2100 IMAGE_INSTANCE_PIXMAP_HEIGHT (p),
2103 IMAGE_INSTANCE_X_PIXMAP (p) = new;
2104 IMAGE_INSTANCE_PIXMAP_DEPTH (p) = d;
2105 IMAGE_INSTANCE_PIXMAP_FG (p) = foreground;
2106 IMAGE_INSTANCE_PIXMAP_BG (p) = background;
2112 /************************************************************************/
2113 /* subwindow and widget support */
2114 /************************************************************************/
2116 /* unmap the image if it is a widget. This is used by redisplay via
2117 redisplay_unmap_subwindows */
2119 x_unmap_subwindow (Lisp_Image_Instance *p)
2121 if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
2124 (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2125 IMAGE_INSTANCE_X_CLIPWINDOW (p));
2127 else /* must be a widget */
2129 XtUnmapWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p));
2133 /* map the subwindow. This is used by redisplay via
2134 redisplay_output_subwindow */
2136 x_map_subwindow (Lisp_Image_Instance *p, int x, int y,
2137 struct display_glyph_area* dga)
2139 if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
2141 Window subwindow = IMAGE_INSTANCE_X_SUBWINDOW_ID (p);
2142 XMoveResizeWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2143 IMAGE_INSTANCE_X_CLIPWINDOW (p),
2144 x, y, dga->width, dga->height);
2145 XMoveWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2146 subwindow, -dga->xoffset, -dga->yoffset);
2147 XMapWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2148 IMAGE_INSTANCE_X_CLIPWINDOW (p));
2150 else /* must be a widget */
2152 XtConfigureWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p),
2153 x + IMAGE_INSTANCE_X_WIDGET_XOFFSET (p),
2154 y + IMAGE_INSTANCE_X_WIDGET_YOFFSET (p),
2155 dga->width, dga->height, 0);
2156 XtMoveWidget (IMAGE_INSTANCE_X_WIDGET_ID (p),
2157 -dga->xoffset, -dga->yoffset);
2158 XtMapWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p));
2162 /* when you click on a widget you may activate another widget this
2163 needs to be checked and all appropriate widgets updated */
2165 x_update_subwindow (Lisp_Image_Instance *p)
2168 if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET)
2170 widget_value* wv = gui_items_to_widget_values
2171 (IMAGE_INSTANCE_WIDGET_ITEMS (p));
2173 /* This seems ugly, but I'm not sure what else to do. */
2174 if (EQ (IMAGE_INSTANCE_WIDGET_TYPE (p), Qtab_control))
2176 update_tab_widget_face (wv, p,
2177 IMAGE_INSTANCE_SUBWINDOW_FRAME (p));
2179 /* update the colors and font */
2180 update_widget_face (wv, p, IMAGE_INSTANCE_SUBWINDOW_FRAME (p));
2182 /* now modify the widget */
2183 lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (p),
2185 free_widget_value_tree (wv);
2186 /* subwindow resizing now gets done by the parent function. */
2191 /* instantiate and x type subwindow */
2193 x_subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2194 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2195 int dest_mask, Lisp_Object domain)
2197 /* This function can GC */
2198 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2199 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
2200 Lisp_Object frame = FW_FRAME (domain);
2201 struct frame* f = XFRAME (frame);
2205 XSetWindowAttributes xswa;
2207 unsigned int w = IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii),
2208 h = IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii);
2210 if (!DEVICE_X_P (XDEVICE (device)))
2211 signal_simple_error ("Not an X device", device);
2213 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2214 xs = DefaultScreenOfDisplay (dpy);
2216 IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW;
2218 pw = XtWindow (FRAME_X_TEXT_WIDGET (f));
2220 ii->data = xnew_and_zero (struct x_subwindow_data);
2222 IMAGE_INSTANCE_X_SUBWINDOW_PARENT (ii) = pw;
2223 IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (ii) = DisplayOfScreen (xs);
2225 xswa.backing_store = Always;
2226 valueMask |= CWBackingStore;
2227 xswa.colormap = DefaultColormapOfScreen (xs);
2228 valueMask |= CWColormap;
2230 /* Create a window for clipping */
2231 IMAGE_INSTANCE_X_CLIPWINDOW (ii) =
2232 XCreateWindow (dpy, pw, 0, 0, w, h, 0, CopyFromParent,
2233 InputOutput, CopyFromParent, valueMask,
2236 /* Now put the subwindow inside the clip window. */
2237 win = XCreateWindow (dpy, IMAGE_INSTANCE_X_CLIPWINDOW (ii),
2238 0, 0, w, h, 0, CopyFromParent,
2239 InputOutput, CopyFromParent, valueMask,
2242 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)win;
2246 /* #### Should this function exist? If there's any doubt I'm not implementing it --andyp */
2247 DEFUN ("change-subwindow-property", Fchange_subwindow_property, 3, 3, 0, /*
2248 For the given SUBWINDOW, set PROPERTY to DATA, which is a string.
2249 Subwindows are not currently implemented.
2251 (subwindow, property, data))
2257 CHECK_SUBWINDOW (subwindow);
2258 CHECK_STRING (property);
2259 CHECK_STRING (data);
2261 sw = XSUBWINDOW (subwindow);
2262 dpy = DisplayOfScreen (LISP_DEVICE_TO_X_SCREEN
2263 (FRAME_DEVICE (XFRAME (sw->frame))));
2265 property_atom = XInternAtom (dpy, (char *) XSTRING_DATA (property), False);
2266 XChangeProperty (dpy, sw->subwindow, property_atom, XA_STRING, 8,
2268 XSTRING_DATA (data),
2269 XSTRING_LENGTH (data));
2276 x_resize_subwindow (Lisp_Image_Instance* ii, int w, int h)
2278 if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
2280 XResizeWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (ii),
2281 IMAGE_INSTANCE_X_SUBWINDOW_ID (ii),
2284 else /* must be a widget */
2288 if ( !XtIsManaged(IMAGE_INSTANCE_X_WIDGET_ID (ii))
2290 IMAGE_INSTANCE_X_WIDGET_ID (ii)->core.being_destroyed )
2293 XSETIMAGE_INSTANCE (sw, ii);
2294 signal_simple_error ("XEmacs bug: subwindow is deleted", sw);
2297 XtSetArg (al [0], XtNwidth, (Dimension)w);
2298 XtSetArg (al [1], XtNheight, (Dimension)h);
2299 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 2);
2306 /************************************************************************/
2308 /************************************************************************/
2311 update_widget_face (widget_value* wv, Lisp_Image_Instance *ii,
2314 #ifdef LWLIB_WIDGETS_MOTIF
2315 XmFontList fontList;
2317 /* Update the foreground. */
2318 Lisp_Object pixel = FACE_FOREGROUND
2319 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2321 XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel)), bcolor;
2322 lw_add_widget_value_arg (wv, XtNforeground, fcolor.pixel);
2324 /* Update the background. */
2325 pixel = FACE_BACKGROUND (IMAGE_INSTANCE_WIDGET_FACE (ii),
2327 bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2328 lw_add_widget_value_arg (wv, XtNbackground, bcolor.pixel);
2330 #ifdef LWLIB_WIDGETS_MOTIF
2331 fontList = XmFontListCreate
2332 (FONT_INSTANCE_X_FONT
2333 (XFONT_INSTANCE (query_string_font
2334 (IMAGE_INSTANCE_WIDGET_TEXT (ii),
2335 IMAGE_INSTANCE_WIDGET_FACE (ii),
2336 domain))), XmSTRING_DEFAULT_CHARSET);
2337 lw_add_widget_value_arg (wv, XmNfontList, (XtArgVal)fontList);
2339 lw_add_widget_value_arg
2340 (wv, XtNfont, (XtArgVal)FONT_INSTANCE_X_FONT
2341 (XFONT_INSTANCE (query_string_font
2342 (IMAGE_INSTANCE_WIDGET_TEXT (ii),
2343 IMAGE_INSTANCE_WIDGET_FACE (ii),
2348 update_tab_widget_face (widget_value* wv, Lisp_Image_Instance *ii,
2353 widget_value* val = wv->contents, *cur;
2355 /* Give each child label the correct foreground color. */
2356 Lisp_Object pixel = FACE_FOREGROUND
2357 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2359 XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2360 lw_add_widget_value_arg (val, XtNtabForeground, fcolor.pixel);
2362 for (cur = val->next; cur; cur = cur->next)
2366 lw_copy_widget_value_args (val, cur);
2373 x_widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2374 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2375 int dest_mask, Lisp_Object domain,
2376 CONST char* type, widget_value* wv)
2378 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2379 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii), pixel;
2380 struct device* d = XDEVICE (device);
2381 Lisp_Object frame = FW_FRAME (domain);
2382 struct frame* f = XFRAME (frame);
2387 int id = new_lwlib_id ();
2388 widget_value* clip_wv;
2389 XColor fcolor, bcolor;
2391 if (!DEVICE_X_P (d))
2392 signal_simple_error ("Not an X device", device);
2394 /* have to set the type this late in case there is no device
2395 instantiation for a widget. But we can go ahead and do it without
2396 checking because there is always a generic instantiator. */
2397 IMAGE_INSTANCE_TYPE (ii) = IMAGE_WIDGET;
2399 if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
2400 TO_EXTERNAL_FORMAT (LISP_STRING, IMAGE_INSTANCE_WIDGET_TEXT (ii),
2401 C_STRING_ALLOCA, nm,
2404 ii->data = xnew_and_zero (struct x_subwindow_data);
2406 /* Create a clip window to contain the subwidget. Incredibly the
2407 XEmacs manager seems to be the most appropriate widget for
2408 this. Nothing else is simple enough and yet does what is
2410 clip_wv = xmalloc_widget_value ();
2412 lw_add_widget_value_arg (clip_wv, XtNresize, False);
2413 lw_add_widget_value_arg (clip_wv, XtNwidth,
2414 (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii));
2415 lw_add_widget_value_arg (clip_wv, XtNheight,
2416 (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii));
2417 clip_wv->enabled = True;
2419 clip_wv->name = xstrdup ("clip-window");
2420 clip_wv->value = xstrdup ("clip-window");
2422 IMAGE_INSTANCE_X_CLIPWIDGET (ii)
2423 = lw_create_widget ("clip-window", "clip-window", new_lwlib_id (),
2424 clip_wv, FRAME_X_CONTAINER_WIDGET (f),
2427 free_widget_value_tree (clip_wv);
2429 /* copy any args we were given */
2431 lw_add_value_args_to_args (wv, al, &ac);
2433 /* Fixup the colors. We have to do this *before* the widget gets
2434 created so that Motif will fix up the shadow colors
2435 correctly. Once the widget is created Motif won't do this
2437 pixel = FACE_FOREGROUND
2438 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2439 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2440 fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2442 pixel = FACE_BACKGROUND
2443 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2444 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2445 bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2447 lw_add_widget_value_arg (wv, XtNbackground, bcolor.pixel);
2448 lw_add_widget_value_arg (wv, XtNforeground, fcolor.pixel);
2449 /* we cannot allow widgets to resize themselves */
2450 lw_add_widget_value_arg (wv, XtNresize, False);
2451 lw_add_widget_value_arg (wv, XtNwidth,
2452 (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii));
2453 lw_add_widget_value_arg (wv, XtNheight,
2454 (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii));
2455 /* update the font. */
2456 update_widget_face (wv, ii, domain);
2458 wid = lw_create_widget (type, wv->name, id, wv, IMAGE_INSTANCE_X_CLIPWIDGET (ii),
2459 False, 0, popup_selection_callback, 0);
2461 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)wid;
2462 IMAGE_INSTANCE_X_WIDGET_LWID (ii) = id;
2464 /* Resize the widget here so that the values do not get copied by
2467 XtSetArg (al [ac], XtNwidth,
2468 (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii)); ac++;
2469 XtSetArg (al [ac], XtNheight,
2470 (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); ac++;
2471 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, ac);
2472 /* because the EmacsManager is the widgets parent we have to
2473 offset the redisplay of the widget by the amount the text
2474 widget is inside the manager. */
2476 XtSetArg (al [ac], XtNx, &IMAGE_INSTANCE_X_WIDGET_XOFFSET (ii)); ac++;
2477 XtSetArg (al [ac], XtNy, &IMAGE_INSTANCE_X_WIDGET_YOFFSET (ii)); ac++;
2478 XtGetValues (FRAME_X_TEXT_WIDGET (f), al, ac);
2480 XtSetMappedWhenManaged (wid, TRUE);
2482 free_widget_value_tree (wv);
2486 x_widget_set_property (Lisp_Object image_instance, Lisp_Object prop,
2489 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2491 /* Modify the text properties of the widget */
2492 if (EQ (prop, Q_text))
2495 widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2497 TO_EXTERNAL_FORMAT (LISP_STRING, val,
2498 C_STRING_ALLOCA, str,
2501 lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, False);
2504 /* Modify the text properties of the widget */
2505 else if (EQ (prop, Q_face))
2507 widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2508 update_widget_face (wv, ii, IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2509 lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, False);
2514 /* get properties of a control */
2516 x_widget_property (Lisp_Object image_instance, Lisp_Object prop)
2518 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2519 /* get the text from a control */
2520 if (EQ (prop, Q_text))
2522 widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2523 return build_ext_string (wv->value, Qnative);
2528 /* Instantiate a button widget. Unfortunately instantiated widgets are
2529 particular to a frame since they need to have a parent. It's not
2530 like images where you just select the image into the context you
2531 want to display it in and BitBlt it. So images instances can have a
2532 many-to-one relationship with things you see, whereas widgets can
2533 only be one-to-one (i.e. per frame) */
2535 x_button_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2536 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2537 int dest_mask, Lisp_Object domain)
2539 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2540 Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2541 Lisp_Object glyph = find_keyword_in_vector (instantiator, Q_image);
2542 widget_value* wv = xmalloc_widget_value ();
2544 button_item_to_widget_value (gui, wv, 1, 1);
2548 if (!IMAGE_INSTANCEP (glyph))
2549 glyph = glyph_image_instance (glyph, domain, ERROR_ME, 1);
2552 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2553 pointer_bg, dest_mask, domain, "button", wv);
2555 /* add the image if one was given */
2556 if (!NILP (glyph) && IMAGE_INSTANCEP (glyph)
2557 && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (glyph)))
2561 #ifdef LWLIB_WIDGETS_MOTIF
2562 XtSetArg (al [ac], XmNlabelType, XmPIXMAP); ac++;
2563 XtSetArg (al [ac], XmNlabelPixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph));ac++;
2565 XtSetArg (al [ac], XtNpixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph)); ac++;
2567 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, ac);
2571 /* get properties of a button */
2573 x_button_property (Lisp_Object image_instance, Lisp_Object prop)
2575 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2576 /* check the state of a button */
2577 if (EQ (prop, Q_selected))
2579 widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2589 /* instantiate a progress gauge */
2591 x_progress_gauge_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2592 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2593 int dest_mask, Lisp_Object domain)
2595 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2596 Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2597 widget_value* wv = xmalloc_widget_value ();
2599 button_item_to_widget_value (gui, wv, 1, 1);
2601 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2602 pointer_bg, dest_mask, domain, "progress", wv);
2605 /* set the properties of a progres guage */
2607 x_progress_gauge_set_property (Lisp_Object image_instance, Lisp_Object prop,
2610 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2612 if (EQ (prop, Q_percent))
2616 XtSetArg (al[0], XtNvalue, XINT (val));
2617 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 1);
2623 /* instantiate an edit control */
2625 x_edit_field_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2626 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2627 int dest_mask, Lisp_Object domain)
2629 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2630 Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2631 widget_value* wv = xmalloc_widget_value ();
2633 button_item_to_widget_value (gui, wv, 1, 1);
2635 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2636 pointer_bg, dest_mask, domain, "text-field", wv);
2639 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
2640 /* instantiate a combo control */
2642 x_combo_box_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2643 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2644 int dest_mask, Lisp_Object domain)
2646 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2647 widget_value * wv = 0;
2648 /* This is not done generically because of sizing problems under
2650 widget_instantiate (image_instance, instantiator, pointer_fg,
2651 pointer_bg, dest_mask, domain);
2653 wv = gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2655 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2656 pointer_bg, dest_mask, domain, "combo-box", wv);
2661 x_tab_control_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2662 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2663 int dest_mask, Lisp_Object domain)
2665 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2667 gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2669 update_tab_widget_face (wv, ii,
2670 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2672 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2673 pointer_bg, dest_mask, domain, "tab-control", wv);
2676 /* set the properties of a tab control */
2678 x_tab_control_set_property (Lisp_Object image_instance, Lisp_Object prop,
2681 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2683 if (EQ (prop, Q_items))
2685 widget_value * wv = 0;
2686 check_valid_item_list_1 (val);
2688 IMAGE_INSTANCE_WIDGET_ITEMS (ii) =
2689 Fcons (XCAR (IMAGE_INSTANCE_WIDGET_ITEMS (ii)),
2690 parse_gui_item_tree_children (val));
2692 wv = gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2694 update_tab_widget_face (wv, ii,
2695 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2697 lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, True);
2699 free_widget_value_tree (wv);
2706 /* instantiate a static control possible for putting other things in */
2708 x_label_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2709 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2710 int dest_mask, Lisp_Object domain)
2712 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2713 Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2714 widget_value* wv = xmalloc_widget_value ();
2716 button_item_to_widget_value (gui, wv, 1, 1);
2718 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2719 pointer_bg, dest_mask, domain, "button", wv);
2721 #endif /* HAVE_WIDGETS */
2724 /************************************************************************/
2725 /* initialization */
2726 /************************************************************************/
2729 syms_of_glyphs_x (void)
2732 DEFSUBR (Fchange_subwindow_property);
2737 console_type_create_glyphs_x (void)
2741 CONSOLE_HAS_METHOD (x, print_image_instance);
2742 CONSOLE_HAS_METHOD (x, finalize_image_instance);
2743 CONSOLE_HAS_METHOD (x, image_instance_equal);
2744 CONSOLE_HAS_METHOD (x, image_instance_hash);
2745 CONSOLE_HAS_METHOD (x, colorize_image_instance);
2746 CONSOLE_HAS_METHOD (x, init_image_instance_from_eimage);
2747 CONSOLE_HAS_METHOD (x, locate_pixmap_file);
2748 CONSOLE_HAS_METHOD (x, unmap_subwindow);
2749 CONSOLE_HAS_METHOD (x, map_subwindow);
2750 CONSOLE_HAS_METHOD (x, resize_subwindow);
2751 CONSOLE_HAS_METHOD (x, update_subwindow);
2755 image_instantiator_format_create_glyphs_x (void)
2757 IIFORMAT_VALID_CONSOLE (x, nothing);
2758 IIFORMAT_VALID_CONSOLE (x, string);
2759 IIFORMAT_VALID_CONSOLE (x, layout);
2760 IIFORMAT_VALID_CONSOLE (x, formatted_string);
2761 IIFORMAT_VALID_CONSOLE (x, inherit);
2763 INITIALIZE_DEVICE_IIFORMAT (x, xpm);
2764 IIFORMAT_HAS_DEVMETHOD (x, xpm, instantiate);
2767 IIFORMAT_VALID_CONSOLE (x, jpeg);
2770 IIFORMAT_VALID_CONSOLE (x, tiff);
2773 IIFORMAT_VALID_CONSOLE (x, png);
2776 IIFORMAT_VALID_CONSOLE (x, gif);
2778 INITIALIZE_DEVICE_IIFORMAT (x, xbm);
2779 IIFORMAT_HAS_DEVMETHOD (x, xbm, instantiate);
2781 INITIALIZE_DEVICE_IIFORMAT (x, subwindow);
2782 IIFORMAT_HAS_DEVMETHOD (x, subwindow, instantiate);
2785 INITIALIZE_DEVICE_IIFORMAT (x, button);
2786 IIFORMAT_HAS_DEVMETHOD (x, button, property);
2787 IIFORMAT_HAS_DEVMETHOD (x, button, instantiate);
2789 INITIALIZE_DEVICE_IIFORMAT (x, widget);
2790 IIFORMAT_HAS_DEVMETHOD (x, widget, property);
2791 IIFORMAT_HAS_DEVMETHOD (x, widget, set_property);
2792 /* progress gauge */
2793 INITIALIZE_DEVICE_IIFORMAT (x, progress_gauge);
2794 IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, set_property);
2795 IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, instantiate);
2797 INITIALIZE_DEVICE_IIFORMAT (x, edit_field);
2798 IIFORMAT_HAS_DEVMETHOD (x, edit_field, instantiate);
2799 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
2801 INITIALIZE_DEVICE_IIFORMAT (x, combo_box);
2802 IIFORMAT_HAS_DEVMETHOD (x, combo_box, instantiate);
2803 IIFORMAT_HAS_SHARED_DEVMETHOD (x, combo_box, set_property, tab_control);
2805 /* tab control widget */
2806 INITIALIZE_DEVICE_IIFORMAT (x, tab_control);
2807 IIFORMAT_HAS_DEVMETHOD (x, tab_control, instantiate);
2808 IIFORMAT_HAS_DEVMETHOD (x, tab_control, set_property);
2810 INITIALIZE_DEVICE_IIFORMAT (x, label);
2811 IIFORMAT_HAS_DEVMETHOD (x, label, instantiate);
2813 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (cursor_font, "cursor-font");
2814 IIFORMAT_VALID_CONSOLE (x, cursor_font);
2816 IIFORMAT_HAS_METHOD (cursor_font, validate);
2817 IIFORMAT_HAS_METHOD (cursor_font, possible_dest_types);
2818 IIFORMAT_HAS_METHOD (cursor_font, instantiate);
2820 IIFORMAT_VALID_KEYWORD (cursor_font, Q_data, check_valid_string);
2821 IIFORMAT_VALID_KEYWORD (cursor_font, Q_foreground, check_valid_string);
2822 IIFORMAT_VALID_KEYWORD (cursor_font, Q_background, check_valid_string);
2824 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (font, "font");
2826 IIFORMAT_HAS_METHOD (font, validate);
2827 IIFORMAT_HAS_METHOD (font, possible_dest_types);
2828 IIFORMAT_HAS_METHOD (font, instantiate);
2829 IIFORMAT_VALID_CONSOLE (x, font);
2831 IIFORMAT_VALID_KEYWORD (font, Q_data, check_valid_string);
2832 IIFORMAT_VALID_KEYWORD (font, Q_foreground, check_valid_string);
2833 IIFORMAT_VALID_KEYWORD (font, Q_background, check_valid_string);
2836 INITIALIZE_DEVICE_IIFORMAT (x, xface);
2837 IIFORMAT_HAS_DEVMETHOD (x, xface, instantiate);
2840 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (autodetect,
2843 IIFORMAT_HAS_METHOD (autodetect, validate);
2844 IIFORMAT_HAS_METHOD (autodetect, normalize);
2845 IIFORMAT_HAS_METHOD (autodetect, possible_dest_types);
2846 IIFORMAT_HAS_METHOD (autodetect, instantiate);
2847 IIFORMAT_VALID_CONSOLE (x, autodetect);
2849 IIFORMAT_VALID_KEYWORD (autodetect, Q_data, check_valid_string);
2853 vars_of_glyphs_x (void)
2855 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path /*
2856 A list of the directories in which X bitmap files may be found.
2857 If nil, this is initialized from the "*bitmapFilePath" resource.
2858 This is used by the `make-image-instance' function (however, note that if
2859 the environment variable XBMLANGPATH is set, it is consulted first).
2861 Vx_bitmap_file_path = Qnil;
2865 complex_vars_of_glyphs_x (void)
2867 #define BUILD_GLYPH_INST(variable, name) \
2868 Fadd_spec_to_specifier \
2869 (GLYPH_IMAGE (XGLYPH (variable)), \
2870 vector3 (Qxbm, Q_data, \
2871 list3 (make_int (name##_width), \
2872 make_int (name##_height), \
2873 make_ext_string (name##_bits, \
2874 sizeof (name##_bits), \
2878 BUILD_GLYPH_INST (Vtruncation_glyph, truncator);
2879 BUILD_GLYPH_INST (Vcontinuation_glyph, continuer);
2880 BUILD_GLYPH_INST (Vxemacs_logo, xemacs);
2881 BUILD_GLYPH_INST (Vhscroll_glyph, hscroll);
2883 #undef BUILD_GLYPH_INST