This commit was generated by cvs2svn to compensate for changes in r1383,
[chise/xemacs-chise.git.1] / src / glyphs-x.c
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
8
9 This file is part of XEmacs.
10
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
14 later version.
15
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
19 for more details.
20
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.  */
25
26 /* Synched up with: Not in FSF. */
27
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
45
46    TODO:
47    Support the GrayScale, StaticColor and StaticGray visual classes.
48    Convert images.el to C and stick it in here?
49  */
50
51 #include <config.h>
52 #include "lisp.h"
53 #include "lstream.h"
54 #include "console-x.h"
55 #include "glyphs-x.h"
56 #include "objects-x.h"
57 #ifdef HAVE_WIDGETS
58 #include "gui-x.h"
59 #endif
60 #include "xmu.h"
61
62 #include "buffer.h"
63 #include "window.h"
64 #include "frame.h"
65 #include "insdel.h"
66 #include "opaque.h"
67 #include "gui.h"
68 #include "faces.h"
69
70 #include "imgproc.h"
71
72 #include "sysfile.h"
73
74 #include <setjmp.h>
75
76 #ifdef FILE_CODING
77 #include "file-coding.h"
78 #endif
79
80 #ifdef LWLIB_WIDGETS_MOTIF
81 #include <Xm/Xm.h>
82 #endif
83 #include <X11/IntrinsicP.h>
84
85 #if INTBITS == 32
86 # define FOUR_BYTE_TYPE unsigned int
87 #elif LONGBITS == 32
88 # define FOUR_BYTE_TYPE unsigned long
89 #elif SHORTBITS == 32
90 # define FOUR_BYTE_TYPE unsigned short
91 #else
92 #error What kind of strange-ass system are we running on?
93 #endif
94
95 #define LISP_DEVICE_TO_X_SCREEN(dev) XDefaultScreenOfDisplay (DEVICE_X_DISPLAY (XDEVICE (dev)))
96
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);
102 #ifdef HAVE_JPEG
103 DECLARE_IMAGE_INSTANTIATOR_FORMAT (jpeg);
104 #endif
105 #ifdef HAVE_TIFF
106 DECLARE_IMAGE_INSTANTIATOR_FORMAT (tiff);
107 #endif
108 #ifdef HAVE_PNG
109 DECLARE_IMAGE_INSTANTIATOR_FORMAT (png);
110 #endif
111 #ifdef HAVE_GIF
112 DECLARE_IMAGE_INSTANTIATOR_FORMAT (gif);
113 #endif
114 #ifdef HAVE_XPM
115 DEFINE_DEVICE_IIFORMAT (x, xpm);
116 #endif
117 DEFINE_DEVICE_IIFORMAT (x, xbm);
118 DEFINE_DEVICE_IIFORMAT (x, subwindow);
119 #ifdef HAVE_XFACE
120 DEFINE_DEVICE_IIFORMAT (x, xface);
121 #endif
122
123 DEFINE_IMAGE_INSTANTIATOR_FORMAT (cursor_font);
124 Lisp_Object Qcursor_font;
125
126 DEFINE_IMAGE_INSTANTIATOR_FORMAT (font);
127
128 DEFINE_IMAGE_INSTANTIATOR_FORMAT (autodetect);
129
130 #ifdef HAVE_WIDGETS
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);
137 #endif
138 DEFINE_DEVICE_IIFORMAT (x, tab_control);
139 DEFINE_DEVICE_IIFORMAT (x, label);
140 #endif
141
142 static void cursor_font_instantiate (Lisp_Object image_instance,
143                                      Lisp_Object instantiator,
144                                      Lisp_Object pointer_fg,
145                                      Lisp_Object pointer_bg,
146                                      int dest_mask,
147                                      Lisp_Object domain);
148
149 #ifdef HAVE_WIDGETS
150 static void
151 update_widget_face (widget_value* wv,
152                     Lisp_Image_Instance* ii, Lisp_Object domain);
153 static void
154 update_tab_widget_face (widget_value* wv,
155                         Lisp_Image_Instance* ii, Lisp_Object domain);
156 #endif
157
158 #include "bitmaps.h"
159
160 \f
161 /************************************************************************/
162 /*                      image instance methods                          */
163 /************************************************************************/
164
165 /************************************************************************/
166 /* convert from a series of RGB triples to an XImage formated for the   */
167 /* proper display                                                       */
168 /************************************************************************/
169 static XImage *
170 convert_EImage_to_XImage (Lisp_Object device, int width, int height,
171                           unsigned char *pic, unsigned long **pixtbl,
172                           int *npixels)
173 {
174   Display *dpy;
175   Colormap cmap;
176   Visual *vis;
177   XImage *outimg;
178   int depth, bitmap_pad, bits_per_pixel, byte_cnt, i, j;
179   int rd,gr,bl,q;
180   unsigned char *data, *ip, *dp;
181   quant_table *qtable = 0;
182   union {
183     FOUR_BYTE_TYPE val;
184     char cp[4];
185   } conv;
186
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));
191
192   if (vis->class == GrayScale || vis->class == StaticColor ||
193       vis->class == StaticGray)
194     {
195       /* #### Implement me!!! */
196       return NULL;
197     }
198
199   if (vis->class == PseudoColor)
200     {
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;
205     }
206
207   bitmap_pad = ((depth > 16) ? 32 :
208                 (depth >  8) ? 16 :
209                 8);
210
211   outimg = XCreateImage (dpy, vis,
212                          depth, ZPixmap, 0, 0, width, height,
213                          bitmap_pad, 0);
214   if (!outimg) return NULL;
215
216   bits_per_pixel = outimg->bits_per_pixel;
217   byte_cnt = bits_per_pixel >> 3;
218
219   data = (unsigned char *) xmalloc (outimg->bytes_per_line * height);
220   if (!data)
221     {
222       XDestroyImage (outimg);
223       return NULL;
224     }
225   outimg->data = (char *) data;
226
227   if (vis->class == PseudoColor)
228     {
229       unsigned long pixarray[256];
230       int pixcount, n;
231       /* use our quantize table to allocate the colors */
232       pixcount = 32;
233       *pixtbl = xnew_array (unsigned long, pixcount);
234       *npixels = 0;
235
236       /* #### should implement a sort by popularity to assure proper allocation */
237       n = *npixels;
238       for (i = 0; i < qtable->num_active_colors; i++)
239         {
240           XColor color;
241           int res;
242
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)
249             {
250               DO_REALLOC(*pixtbl, pixcount, n+1, unsigned long);
251               (*pixtbl)[n] = color.pixel;
252               n++;
253             }
254           pixarray[i] = color.pixel;
255         }
256       *npixels = n;
257       ip = pic;
258       for (i = 0; i < height; i++)
259         {
260           dp = data + (i * outimg->bytes_per_line);
261           for (j = 0; j < width; j++)
262             {
263               rd = *ip++;
264               gr = *ip++;
265               bl = *ip++;
266               conv.val = pixarray[QUANT_GET_COLOR(qtable,rd,gr,bl)];
267 #if WORDS_BIGENDIAN
268               if (outimg->byte_order == MSBFirst)
269                 for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q];
270               else
271                 for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q];
272 #else
273               if (outimg->byte_order == MSBFirst)
274                 for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q];
275               else
276                 for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q];
277 #endif
278             }
279         }
280       xfree(qtable);
281     } else {
282       unsigned long rshift,gshift,bshift,rbits,gbits,bbits,junk;
283       junk = vis->red_mask;
284       rshift = 0;
285       while ((junk & 0x1) == 0)
286         {
287           junk = junk >> 1;
288           rshift ++;
289         }
290       rbits = 0;
291       while (junk != 0)
292         {
293           junk = junk >> 1;
294           rbits++;
295         }
296       junk = vis->green_mask;
297       gshift = 0;
298       while ((junk & 0x1) == 0)
299         {
300           junk = junk >> 1;
301           gshift ++;
302         }
303       gbits = 0;
304       while (junk != 0)
305         {
306           junk = junk >> 1;
307           gbits++;
308         }
309       junk = vis->blue_mask;
310       bshift = 0;
311       while ((junk & 0x1) == 0)
312         {
313           junk = junk >> 1;
314           bshift ++;
315         }
316       bbits = 0;
317       while (junk != 0)
318         {
319           junk = junk >> 1;
320           bbits++;
321         }
322       ip = pic;
323       for (i = 0; i < height; i++)
324         {
325           dp = data + (i * outimg->bytes_per_line);
326           for (j = 0; j < width; j++)
327             {
328               if (rbits > 8)
329                 rd = *ip++ << (rbits - 8);
330               else
331                 rd = *ip++ >> (8 - rbits);
332               if (gbits > 8)
333                 gr = *ip++ << (gbits - 8);
334               else
335                 gr = *ip++ >> (8 - gbits);
336               if (bbits > 8)
337                 bl = *ip++ << (bbits - 8);
338               else
339                 bl = *ip++ >> (8 - bbits);
340
341               conv.val = (rd << rshift) | (gr << gshift) | (bl << bshift);
342 #if WORDS_BIGENDIAN
343               if (outimg->byte_order == MSBFirst)
344                 for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q];
345               else
346                 for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q];
347 #else
348               if (outimg->byte_order == MSBFirst)
349                 for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q];
350               else
351                 for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q];
352 #endif
353             }
354         }
355     }
356   return outimg;
357 }
358
359
360
361 static void
362 x_print_image_instance (Lisp_Image_Instance *p,
363                         Lisp_Object printcharfun,
364                         int escapeflag)
365 {
366   char buf[100];
367
368   switch (IMAGE_INSTANCE_TYPE (p))
369     {
370     case IMAGE_MONO_PIXMAP:
371     case IMAGE_COLOR_PIXMAP:
372     case IMAGE_POINTER:
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))
376         {
377           sprintf (buf, "/0x%lx", (unsigned long) IMAGE_INSTANCE_X_MASK (p));
378           write_c_string (buf, printcharfun);
379         }
380       write_c_string (")", printcharfun);
381       break;
382     default:
383       break;
384     }
385 }
386
387 #ifdef DEBUG_WIDGETS
388 extern int debug_widget_instances;
389 #endif
390
391 static void
392 x_finalize_image_instance (Lisp_Image_Instance *p)
393 {
394   if (!p->data)
395     return;
396
397   if (DEVICE_LIVE_P (XDEVICE (p->device)))
398     {
399       Display *dpy = DEVICE_X_DISPLAY (XDEVICE (p->device));
400
401       if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET)
402         {
403           if (IMAGE_INSTANCE_SUBWINDOW_ID (p))
404             {
405 #ifdef DEBUG_WIDGETS
406               debug_widget_instances--;
407               stderr_out ("widget destroyed, %d left\n", debug_widget_instances);
408 #endif
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;
413             }
414         }
415       else if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
416         {
417           if (IMAGE_INSTANCE_SUBWINDOW_ID (p))
418             XDestroyWindow (dpy, IMAGE_INSTANCE_X_SUBWINDOW_ID (p));
419           IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0;
420         }
421       else
422         {
423           int i;
424           if (IMAGE_INSTANCE_PIXMAP_TIMEOUT (p))
425             disable_glyph_animated_timeout (IMAGE_INSTANCE_PIXMAP_TIMEOUT (p));
426
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;
431
432           if (IMAGE_INSTANCE_X_PIXMAP_SLICES (p))
433             {
434               for (i = 0; i < IMAGE_INSTANCE_PIXMAP_MAXSLICE (p); i++)
435                 if (IMAGE_INSTANCE_X_PIXMAP_SLICE (p,i))
436                   {
437                     XFreePixmap (dpy, IMAGE_INSTANCE_X_PIXMAP_SLICE (p,i));
438                     IMAGE_INSTANCE_X_PIXMAP_SLICE (p, i) = 0;
439                   }
440               xfree (IMAGE_INSTANCE_X_PIXMAP_SLICES (p));
441               IMAGE_INSTANCE_X_PIXMAP_SLICES (p) = 0;
442             }
443
444           if (IMAGE_INSTANCE_X_CURSOR (p))
445             {
446               XFreeCursor (dpy, IMAGE_INSTANCE_X_CURSOR (p));
447               IMAGE_INSTANCE_X_CURSOR (p) = 0;
448             }
449
450           if (IMAGE_INSTANCE_X_NPIXELS (p) != 0)
451             {
452               XFreeColors (dpy,
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;
457             }
458         }
459     }
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))
467     {
468       xfree (IMAGE_INSTANCE_X_PIXELS (p));
469       IMAGE_INSTANCE_X_PIXELS (p) = 0;
470     }
471
472   xfree (p->data);
473   p->data = 0;
474 }
475
476 static int
477 x_image_instance_equal (Lisp_Image_Instance *p1,
478                         Lisp_Image_Instance *p2, int depth)
479 {
480   switch (IMAGE_INSTANCE_TYPE (p1))
481     {
482     case IMAGE_MONO_PIXMAP:
483     case IMAGE_COLOR_PIXMAP:
484     case IMAGE_POINTER:
485       if (IMAGE_INSTANCE_X_COLORMAP (p1) != IMAGE_INSTANCE_X_COLORMAP (p2) ||
486           IMAGE_INSTANCE_X_NPIXELS (p1) != IMAGE_INSTANCE_X_NPIXELS (p2))
487         return 0;
488       break;
489     default:
490       break;
491     }
492
493   return 1;
494 }
495
496 static unsigned long
497 x_image_instance_hash (Lisp_Image_Instance *p, int depth)
498 {
499   switch (IMAGE_INSTANCE_TYPE (p))
500     {
501     case IMAGE_MONO_PIXMAP:
502     case IMAGE_COLOR_PIXMAP:
503     case IMAGE_POINTER:
504       return IMAGE_INSTANCE_X_NPIXELS (p);
505     default:
506       return 0;
507     }
508 }
509
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. */
515
516 static void
517 x_initialize_pixmap_image_instance (Lisp_Image_Instance *ii,
518                                     int slices,
519                                     enum image_instance_type type)
520 {
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;
532 }
533
534 \f
535 /************************************************************************/
536 /*                        pixmap file functions                         */
537 /************************************************************************/
538
539 /* Where bitmaps are; initialized from resource database */
540 Lisp_Object Vx_bitmap_file_path;
541
542 #ifndef BITMAPDIR
543 #define BITMAPDIR "/usr/include/X11/bitmaps"
544 #endif
545
546 #define USE_XBMLANGPATH
547
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. */
551
552 static Lisp_Object
553 x_locate_pixmap_file (Lisp_Object name)
554 {
555   /* This function can GC if IN_REDISPLAY is false */
556   Display *display;
557
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) == '/')))))
566     {
567       if (!NILP (Ffile_readable_p (name)))
568         return Fexpand_file_name (name, Qnil);
569       else
570         return Qnil;
571     }
572
573   if (NILP (Vdefault_x_device))
574     /* This may occur during initialization. */
575     return Qnil;
576   else
577     /* We only check the bitmapFilePath resource on the original X device. */
578     display = DEVICE_X_DISPLAY (XDEVICE (Vdefault_x_device));
579
580 #ifdef USE_XBMLANGPATH
581   {
582     char *path = egetenv ("XBMLANGPATH");
583     SubstitutionRec subs[1];
584     subs[0].match = 'B';
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. */
588     if (path &&
589         (path = XtResolvePathname (display, "bitmaps", 0, 0, path,
590                                    subs, XtNumber (subs), 0)))
591       {
592         name = build_string (path);
593         XtFree (path);
594         return (name);
595       }
596   }
597 #endif
598
599   if (NILP (Vx_bitmap_file_path))
600     {
601       char *type = 0;
602       XrmValue value;
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)));
609     }
610
611   {
612     Lisp_Object found;
613     if (locate_file (Vx_bitmap_file_path, name, Qnil, &found, R_OK) < 0)
614       {
615         Lisp_Object temp = list1 (Vdata_directory);
616         struct gcpro gcpro1;
617
618         GCPRO1 (temp);
619         locate_file (temp, name, Qnil, &found, R_OK);
620         UNGCPRO;
621       }
622
623     return found;
624   }
625 }
626
627 static Lisp_Object
628 locate_pixmap_file (Lisp_Object name)
629 {
630   return x_locate_pixmap_file (name);
631 }
632
633 #if 0
634 static void
635 write_lisp_string_to_temp_file (Lisp_Object string, char *filename_out)
636 {
637   Lisp_Object instream, outstream;
638   Lstream *istr, *ostr;
639   char tempbuf[1024]; /* some random amount */
640   int fubar = 0;
641   FILE *tmpfil;
642   static Extbyte_dynarr *conversion_out_dynarr;
643   Bytecount bstart, bend;
644   struct gcpro gcpro1, gcpro2;
645 #ifdef FILE_CODING
646   Lisp_Object conv_out_stream;
647   Lstream *costr;
648   struct gcpro gcpro3;
649 #endif
650
651   /* This function can GC */
652   if (!conversion_out_dynarr)
653     conversion_out_dynarr = Dynarr_new (Extbyte);
654   else
655     Dynarr_reset (conversion_out_dynarr);
656
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");
661   if (!tmpfil)
662     {
663       if (tmpfil)
664         {
665           int old_errno = errno;
666           fclose (tmpfil);
667           unlink (filename_out);
668           errno = old_errno;
669         }
670       report_file_error ("Creating temp file",
671                          list1 (build_string (filename_out)));
672     }
673
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);
682 #ifdef FILE_CODING
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);
687 #else
688   GCPRO2 (instream, outstream);
689 #endif
690
691   /* Get the data while doing the conversion */
692   while (1)
693     {
694       ssize_t size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
695       if (!size_in_bytes)
696         break;
697       /* It does seem the flushes are necessary... */
698 #ifdef FILE_CODING
699       Lstream_write (costr, tempbuf, size_in_bytes);
700       Lstream_flush (costr);
701 #else
702       Lstream_write (ostr, tempbuf, size_in_bytes);
703 #endif
704       Lstream_flush (ostr);
705       if (fwrite ((unsigned char *)Dynarr_atp(conversion_out_dynarr, 0),
706                   Dynarr_length(conversion_out_dynarr), 1, tmpfil) != 1)
707         {
708           fubar = 1;
709           break;
710         }
711       /* reset the dynarr */
712       Lstream_rewind(ostr);
713     }
714
715   if (fclose (tmpfil) != 0)
716     fubar = 1;
717   Lstream_close (istr);
718 #ifdef FILE_CODING
719   Lstream_close (costr);
720 #endif
721   Lstream_close (ostr);
722
723   UNGCPRO;
724   Lstream_delete (istr);
725   Lstream_delete (ostr);
726 #ifdef FILE_CODING
727   Lstream_delete (costr);
728 #endif
729
730   if (fubar)
731     report_file_error ("Writing temp file",
732                        list1 (build_string (filename_out)));
733 }
734 #endif /* 0 */
735
736 \f
737 /************************************************************************/
738 /*                           cursor functions                           */
739 /************************************************************************/
740
741 /* Check that this server supports cursors of size WIDTH * HEIGHT.  If
742    not, signal an error.  INSTANTIATOR is only used in the error
743    message. */
744
745 static void
746 check_pointer_sizes (Screen *xs, unsigned int width, unsigned int height,
747                      Lisp_Object instantiator)
748 {
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);
755
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);
761 }
762
763
764 static void
765 generate_cursor_fg_bg (Lisp_Object device, Lisp_Object *foreground,
766                        Lisp_Object *background, XColor *xfg, XColor *xbg)
767 {
768   if (!NILP (*foreground) && !COLOR_INSTANCEP (*foreground))
769     *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));
774   else
775     {
776       xfg->pixel = 0;
777       xfg->red = xfg->green = xfg->blue = 0;
778     }
779
780   if (!NILP (*background) && !COLOR_INSTANCEP (*background))
781     *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));
786   else
787     {
788       xbg->pixel = 0;
789       xbg->red = xbg->green = xbg->blue = ~0;
790     }
791 }
792
793 static void
794 maybe_recolor_cursor (Lisp_Object image_instance, Lisp_Object foreground,
795                       Lisp_Object background)
796 {
797   Lisp_Object device = XIMAGE_INSTANCE_DEVICE (image_instance);
798   XColor xfg, xbg;
799
800   generate_cursor_fg_bg (device, &foreground, &background, &xfg, &xbg);
801   if (!NILP (foreground) || !NILP (background))
802     {
803       XRecolorCursor (DEVICE_X_DISPLAY (XDEVICE (device)),
804                       XIMAGE_INSTANCE_X_CURSOR (image_instance),
805                       &xfg, &xbg);
806       XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
807       XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
808     }
809 }
810
811 \f
812 /************************************************************************/
813 /*                        color pixmap functions                        */
814 /************************************************************************/
815
816 /* Initialize an image instance from an XImage.
817
818    DEST_MASK specifies the mask of allowed image types.
819
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
828    destroyed.
829
830    If this fails, signal an error.  INSTANTIATOR is only used
831    in the error message.
832
833    #### This should be able to handle conversion into `pointer'.
834    Use the same code as for `xpm'. */
835
836 static void
837 init_image_instance_from_x_image (Lisp_Image_Instance *ii,
838                                   XImage *ximage,
839                                   int dest_mask,
840                                   Colormap cmap,
841                                   unsigned long *pixels,
842                                   int npixels,
843                                   int slices,
844                                   Lisp_Object instantiator)
845 {
846   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
847   Display *dpy;
848   GC gc;
849   Drawable d;
850   Pixmap pixmap;
851
852   if (!DEVICE_X_P (XDEVICE (device)))
853     signal_simple_error ("Not an X device", device);
854
855   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
856   d = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
857
858   if (!(dest_mask & IMAGE_COLOR_PIXMAP_MASK))
859     incompatible_image_types (instantiator, dest_mask,
860                               IMAGE_COLOR_PIXMAP_MASK);
861
862   pixmap = XCreatePixmap (dpy, d, ximage->width,
863                           ximage->height, ximage->depth);
864   if (!pixmap)
865     signal_simple_error ("Unable to create pixmap", instantiator);
866
867   gc = XCreateGC (dpy, pixmap, 0, NULL);
868   if (!gc)
869     {
870       XFreePixmap (dpy, pixmap);
871       signal_simple_error ("Unable to create GC", instantiator);
872     }
873
874   XPutImage (dpy, pixmap, gc, ximage, 0, 0, 0, 0,
875              ximage->width, ximage->height);
876
877   XFreeGC (dpy, gc);
878
879   x_initialize_pixmap_image_instance (ii, slices, IMAGE_COLOR_PIXMAP);
880
881   IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
882     find_keyword_in_vector (instantiator, Q_file);
883
884   /* Fixup a set of pixmaps. */
885   IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
886
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;
894 }
895
896 static void
897 image_instance_add_x_image (Lisp_Image_Instance *ii,
898                             XImage *ximage,
899                             int slice,
900                             Lisp_Object instantiator)
901 {
902   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
903   Display *dpy;
904   GC gc;
905   Drawable d;
906   Pixmap pixmap;
907
908   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
909   d = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
910
911   pixmap = XCreatePixmap (dpy, d, ximage->width,
912                           ximage->height, ximage->depth);
913   if (!pixmap)
914     signal_simple_error ("Unable to create pixmap", instantiator);
915
916   gc = XCreateGC (dpy, pixmap, 0, NULL);
917   if (!gc)
918     {
919       XFreePixmap (dpy, pixmap);
920       signal_simple_error ("Unable to create GC", instantiator);
921     }
922
923   XPutImage (dpy, pixmap, gc, ximage, 0, 0, 0, 0,
924              ximage->width, ximage->height);
925
926   XFreeGC (dpy, gc);
927
928   IMAGE_INSTANCE_X_PIXMAP_SLICE (ii, slice) = pixmap;
929 }
930
931 static void
932 x_init_image_instance_from_eimage (Lisp_Image_Instance *ii,
933                                    int width, int height,
934                                    int slices,
935                                    unsigned char *eimage,
936                                    int dest_mask,
937                                    Lisp_Object instantiator,
938                                    Lisp_Object domain)
939 {
940   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
941   Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device));
942   unsigned long *pixtbl = NULL;
943   int npixels = 0;
944   int slice;
945   XImage* ximage;
946
947   for (slice = 0; slice < slices; slice++)
948     {
949       ximage = convert_EImage_to_XImage (device, width, height,
950                                          eimage + (width * height * 3 * slice),
951                                          &pixtbl, &npixels);
952       if (!ximage)
953         {
954           if (pixtbl) xfree (pixtbl);
955           signal_image_error("EImage to XImage conversion failed", instantiator);
956         }
957
958       /* Now create the pixmap and set up the image instance */
959       if (slice == 0)
960         init_image_instance_from_x_image (ii, ximage, dest_mask,
961                                           cmap, pixtbl, npixels, slices,
962                                           instantiator);
963       else
964         image_instance_add_x_image (ii, ximage, slice, instantiator);
965
966       if (ximage)
967         {
968           if (ximage->data)
969             {
970               xfree (ximage->data);
971               ximage->data = 0;
972             }
973           XDestroyImage (ximage);
974           ximage = 0;
975         }
976     }
977 }
978
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)
982 {
983   return XmuReadBitmapDataFromFile (filename, width, height,
984                                     datap, x_hot, y_hot);
985 }
986
987 /* Given inline data for a mono pixmap, create and return the
988    corresponding X object. */
989
990 static Pixmap
991 pixmap_from_xbm_inline (Lisp_Object device, int width, int height,
992                         /* Note that data is in ext-format! */
993                         const Extbyte *bits)
994 {
995   return XCreatePixmapFromBitmapData (DEVICE_X_DISPLAY (XDEVICE(device)),
996                                       XtWindow (DEVICE_XT_APP_SHELL (XDEVICE (device))),
997                                       (char *) bits, width, height,
998                                       1, 0, 1);
999 }
1000
1001 /* Given inline data for a mono pixmap, initialize the given
1002    image instance accordingly. */
1003
1004 static void
1005 init_image_instance_from_xbm_inline (Lisp_Image_Instance *ii,
1006                                      int width, int height,
1007                                      /* Note that data is in ext-format! */
1008                                      const char *bits,
1009                                      Lisp_Object instantiator,
1010                                      Lisp_Object pointer_fg,
1011                                      Lisp_Object pointer_bg,
1012                                      int dest_mask,
1013                                      Pixmap mask,
1014                                      Lisp_Object mask_filename)
1015 {
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);
1019   Display *dpy;
1020   Screen *scr;
1021   Drawable draw;
1022   enum image_instance_type type;
1023
1024   if (!DEVICE_X_P (XDEVICE (device)))
1025     signal_simple_error ("Not an X device", device);
1026
1027   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1028   draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
1029   scr = DefaultScreenOfDisplay (dpy);
1030
1031   if ((dest_mask & IMAGE_MONO_PIXMAP_MASK) &&
1032       (dest_mask & IMAGE_COLOR_PIXMAP_MASK))
1033     {
1034       if (!NILP (foreground) || !NILP (background))
1035         type = IMAGE_COLOR_PIXMAP;
1036       else
1037         type = IMAGE_MONO_PIXMAP;
1038     }
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;
1045   else
1046     incompatible_image_types (instantiator, dest_mask,
1047                               IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
1048                               | IMAGE_POINTER_MASK);
1049
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);
1055
1056   switch (type)
1057     {
1058     case IMAGE_MONO_PIXMAP:
1059       {
1060         IMAGE_INSTANCE_X_PIXMAP (ii) =
1061           pixmap_from_xbm_inline (device, width, height, (Extbyte *) bits);
1062       }
1063       break;
1064
1065     case IMAGE_COLOR_PIXMAP:
1066       {
1067         Dimension d = DEVICE_X_DEPTH (XDEVICE(device));
1068         unsigned long fg = BlackPixelOfScreen (scr);
1069         unsigned long bg = WhitePixelOfScreen (scr);
1070
1071         if (!NILP (foreground) && !COLOR_INSTANCEP (foreground))
1072           foreground =
1073             Fmake_color_instance (foreground, device,
1074                                   encode_error_behavior_flag (ERROR_ME));
1075
1076         if (COLOR_INSTANCEP (foreground))
1077           fg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground)).pixel;
1078
1079         if (!NILP (background) && !COLOR_INSTANCEP (background))
1080           background =
1081             Fmake_color_instance (background, device,
1082                                   encode_error_behavior_flag (ERROR_ME));
1083
1084         if (COLOR_INSTANCEP (background))
1085           bg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background)).pixel;
1086
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
1090            happen. */
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,
1096                                        fg, bg, d);
1097         IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = d;
1098       }
1099       break;
1100
1101     case IMAGE_POINTER:
1102     {
1103         XColor fg_color, bg_color;
1104         Pixmap source;
1105
1106         check_pointer_sizes (scr, width, height, instantiator);
1107
1108         source =
1109           XCreatePixmapFromBitmapData (dpy, draw,
1110                                        (char *) bits, width, height,
1111                                        1, 0, 1);
1112
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);
1119
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) =
1127           XCreatePixmapCursor
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);
1133       }
1134       break;
1135
1136     default:
1137       abort ();
1138     }
1139 }
1140
1141 static void
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! */
1146                    const char *bits)
1147 {
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);
1151   Pixmap mask = 0;
1152
1153   if (!NILP (mask_data))
1154     {
1155       const char *ext_data;
1156
1157       TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (XCDR (XCDR (mask_data))),
1158                           C_STRING_ALLOCA, ext_data,
1159                           Qbinary);
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);
1164     }
1165
1166   init_image_instance_from_xbm_inline (ii, width, height, bits,
1167                                        instantiator, pointer_fg, pointer_bg,
1168                                        dest_mask, mask, mask_file);
1169 }
1170
1171 /* Instantiate method for XBM's. */
1172
1173 static void
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)
1177 {
1178   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1179   const char *ext_data;
1180
1181   assert (!NILP (data));
1182
1183   TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (XCDR (XCDR (data))),
1184                       C_STRING_ALLOCA, ext_data,
1185                       Qbinary);
1186
1187   xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1188                      pointer_bg, dest_mask, XINT (XCAR (data)),
1189                      XINT (XCAR (XCDR (data))), ext_data);
1190 }
1191
1192 \f
1193 #ifdef HAVE_XPM
1194
1195 /**********************************************************************
1196  *                             XPM                                    *
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.
1200   */
1201 #if (XpmVersion >= 3) || defined(XpmExactColors)
1202 # define XPM_DOES_BUFFERS
1203 #endif
1204
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 */
1209
1210 static XpmColorSymbol *
1211 extract_xpm_color_names (XpmAttributes *xpmattrs, Lisp_Object device,
1212                          Lisp_Object domain,
1213                          Lisp_Object color_symbol_alist)
1214 {
1215   /* This function can GC */
1216   Display *dpy =  DEVICE_X_DISPLAY (XDEVICE(device));
1217   Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1218   XColor color;
1219   Lisp_Object rest;
1220   Lisp_Object results = Qnil;
1221   int i;
1222   XpmColorSymbol *symbols;
1223   struct gcpro gcpro1, gcpro2;
1224
1225   GCPRO2 (results, device);
1226
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. */
1230   i = 0;
1231   LIST_LOOP (rest, color_symbol_alist)
1232     {
1233       Lisp_Object cons = XCAR (rest);
1234       Lisp_Object name = XCAR (cons);
1235       Lisp_Object value = XCDR (cons);
1236       if (NILP (value))
1237         continue;
1238       if (STRINGP (value))
1239         value =
1240           Fmake_color_instance
1241             (value, device, encode_error_behavior_flag (ERROR_ME_NOT));
1242       else
1243         {
1244           assert (COLOR_SPECIFIERP (value));
1245           value = Fspecifier_instance (value, domain, Qnil, Qnil);
1246         }
1247       if (NILP (value))
1248         continue;
1249       results = noseeum_cons (noseeum_cons (name, value), results);
1250       i++;
1251     }
1252   UNGCPRO;                      /* no more evaluation */
1253
1254   if (i == 0) return 0;
1255
1256   symbols = xnew_array (XpmColorSymbol, i);
1257   xpmattrs->valuemask |= XpmColorSymbols;
1258   xpmattrs->colorsymbols = symbols;
1259   xpmattrs->numsymbols = i;
1260
1261   while (--i >= 0)
1262     {
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 */
1269
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));
1274       cons = results;
1275       results = XCDR (results);
1276       free_cons (XCONS (cons));
1277     }
1278   return symbols;
1279 }
1280
1281 static void
1282 xpm_free (XpmAttributes *xpmattrs)
1283 {
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);
1289 }
1290
1291 static void
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)
1295 {
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);
1300   Display *dpy;
1301   Screen *xs;
1302   Colormap cmap;
1303   int depth;
1304   Visual *visual;
1305   Pixmap pixmap;
1306   Pixmap mask = 0;
1307   XpmAttributes xpmattrs;
1308   int result;
1309   XpmColorSymbol *color_symbols;
1310   Lisp_Object color_symbol_alist = find_keyword_in_vector (instantiator,
1311                                                            Q_color_symbols);
1312   enum image_instance_type type;
1313   int force_mono;
1314   unsigned int w, h;
1315
1316   if (!DEVICE_X_P (XDEVICE (device)))
1317     signal_simple_error ("Not an X device", device);
1318
1319   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1320   xs = DefaultScreenOfDisplay (dpy);
1321
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;
1328   else
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);
1333
1334 #if 1
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)
1338     {
1339       cmap = DefaultColormap(dpy, DefaultScreen(dpy));
1340       depth = DefaultDepthOfScreen (xs);
1341       visual = DefaultVisualOfScreen (xs);
1342     }
1343   else
1344     {
1345       cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1346       depth = DEVICE_X_DEPTH (XDEVICE(device));
1347       visual = DEVICE_X_VISUAL (XDEVICE(device));
1348     }
1349 #else
1350   cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1351   depth = DEVICE_X_DEPTH (XDEVICE(device));
1352   visual = DEVICE_X_VISUAL (XDEVICE(device));
1353 #endif
1354
1355   x_initialize_pixmap_image_instance (ii, 1, type);
1356
1357   assert (!NILP (data));
1358
1359  retry:
1360
1361   xzero (xpmattrs); /* want XpmInitAttributes() */
1362   xpmattrs.valuemask = XpmReturnPixels;
1363   if (force_mono)
1364     {
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;
1370       xpmattrs.depth = 1;
1371       xpmattrs.valuemask |= XpmDepth;
1372     }
1373   else
1374     {
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;
1383     }
1384
1385   color_symbols = extract_xpm_color_names (&xpmattrs, device, domain,
1386                                            color_symbol_alist);
1387
1388   result = XpmCreatePixmapFromBuffer (dpy,
1389                                       XtWindow(DEVICE_XT_APP_SHELL (XDEVICE(device))),
1390                                       (char *) XSTRING_DATA (data),
1391                                       &pixmap, &mask, &xpmattrs);
1392
1393   if (color_symbols)
1394     {
1395       xfree (color_symbols);
1396       xpmattrs.colorsymbols = 0; /* in case XpmFreeAttr is too smart... */
1397       xpmattrs.numsymbols = 0;
1398     }
1399
1400   switch (result)
1401     {
1402     case XpmSuccess:
1403       break;
1404     case XpmFileInvalid:
1405       {
1406         xpm_free (&xpmattrs);
1407         signal_image_error ("invalid XPM data", data);
1408       }
1409     case XpmColorFailed:
1410     case XpmColorError:
1411       {
1412         xpm_free (&xpmattrs);
1413         if (force_mono)
1414           {
1415             /* second time; blow out. */
1416             signal_double_file_error ("Reading pixmap data",
1417                                       "color allocation failed",
1418                                       data);
1419           }
1420         else
1421           {
1422             if (! (dest_mask & IMAGE_MONO_PIXMAP_MASK))
1423               {
1424                 /* second time; blow out. */
1425                 signal_double_file_error ("Reading pixmap data",
1426                                           "color allocation failed",
1427                                           data);
1428               }
1429             force_mono = 1;
1430             IMAGE_INSTANCE_TYPE (ii) = IMAGE_MONO_PIXMAP;
1431             goto retry;
1432           }
1433       }
1434     case XpmNoMemory:
1435       {
1436         xpm_free (&xpmattrs);
1437         signal_double_file_error ("Parsing pixmap data",
1438                                   "out of memory", data);
1439       }
1440     default:
1441       {
1442         xpm_free (&xpmattrs);
1443         signal_double_file_error_2 ("Parsing pixmap data",
1444                                     "unknown error code",
1445                                     make_int (result), data);
1446       }
1447     }
1448
1449   w = xpmattrs.width;
1450   h = xpmattrs.height;
1451
1452   {
1453     int npixels = xpmattrs.npixels;
1454     Pixel *pixels;
1455
1456     if (npixels != 0)
1457       {
1458         pixels = xnew_array (Pixel, npixels);
1459         memcpy (pixels, xpmattrs.pixels, npixels * sizeof (Pixel));
1460       }
1461     else
1462       pixels = NULL;
1463
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);
1473   }
1474
1475   switch (type)
1476     {
1477     case IMAGE_MONO_PIXMAP:
1478       break;
1479
1480     case IMAGE_COLOR_PIXMAP:
1481       {
1482         IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = depth;
1483       }
1484       break;
1485
1486     case IMAGE_POINTER:
1487       {
1488         int npixels = xpmattrs.npixels;
1489         Pixel *pixels = xpmattrs.pixels;
1490         XColor fg, bg;
1491         int i;
1492         int xhot = 0, yhot = 0;
1493
1494         if (xpmattrs.valuemask & XpmHotspot)
1495           {
1496             xhot = xpmattrs.x_hotspot;
1497             XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii), xpmattrs.x_hotspot);
1498           }
1499         if (xpmattrs.valuemask & XpmHotspot)
1500           {
1501             yhot = xpmattrs.y_hotspot;
1502             XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii), xpmattrs.y_hotspot);
1503           }
1504         check_pointer_sizes (xs, w, h, instantiator);
1505
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.
1509            */
1510         if (npixels >= 2)
1511           {
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
1515                background.
1516
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.
1520
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.
1528
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?
1532
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.
1538
1539                This means that a 1 bit in the image corresponds to
1540                `fg' only if `fg.pixel' is odd.
1541
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
1545                sensible I think.)
1546
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.)
1556                */
1557
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.*/
1561               {
1562                 bg.pixel = pixels[i];
1563                 if (fg.pixel != bg.pixel)
1564                   break;
1565               }
1566
1567             /* If (fg.pixel == bg.pixel) then probably something has
1568                gone wrong, but I don't think signalling an error would
1569                be appropriate. */
1570
1571             XQueryColor (dpy, cmap, &fg);
1572             XQueryColor (dpy, cmap, &bg);
1573
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.)
1577                */
1578             {
1579               unsigned short fg_total = ((fg.red / 3) + (fg.green / 3)
1580                                          + (fg.blue / 3));
1581               unsigned short bg_total = ((bg.red / 3) + (bg.green / 3)
1582                                          + (bg.blue / 3));
1583               if (fg_total > bg_total)
1584                 {
1585                   XColor swap;
1586                   swap = fg;
1587                   fg = bg;
1588                   bg = swap;
1589                 }
1590             }
1591
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.)
1594                */
1595             if ((fg.pixel & 1) == 0)
1596               {
1597                 XGCValues gcv;
1598                 GC gc;
1599                 gcv.function = GXxor;
1600                 gcv.foreground = 1;
1601                 gc = XCreateGC (dpy, pixmap, (GCFunction | GCForeground),
1602                                 &gcv);
1603                 XFillRectangle (dpy, pixmap, gc, 0, 0, w, h);
1604                 XFreeGC (dpy, gc);
1605               }
1606           }
1607         else
1608           {
1609             generate_cursor_fg_bg (device, &pointer_fg, &pointer_bg,
1610                                    &fg, &bg);
1611             IMAGE_INSTANCE_PIXMAP_FG (ii) = pointer_fg;
1612             IMAGE_INSTANCE_PIXMAP_BG (ii) = pointer_bg;
1613           }
1614
1615         IMAGE_INSTANCE_X_CURSOR (ii) =
1616           XCreatePixmapCursor
1617             (dpy, pixmap, mask, &fg, &bg, xhot, yhot);
1618       }
1619
1620       break;
1621
1622     default:
1623       abort ();
1624     }
1625
1626   xpm_free (&xpmattrs); /* after we've read pixels and hotspot */
1627 }
1628
1629 #endif /* HAVE_XPM */
1630
1631 \f
1632 #ifdef HAVE_XFACE
1633
1634 /**********************************************************************
1635  *                             X-Face                                 *
1636  **********************************************************************/
1637 #if defined(EXTERN)
1638 /* This is about to get redefined! */
1639 #undef EXTERN
1640 #endif
1641 /* We have to define SYSV32 so that compface.h includes string.h
1642    instead of strings.h. */
1643 #define SYSV32
1644 #ifdef __cplusplus
1645 extern "C" {
1646 #endif
1647 #include <compface.h>
1648 #ifdef __cplusplus
1649 }
1650 #endif
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;
1655 #undef SYSV32
1656
1657 static void
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)
1661 {
1662   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1663   int i, stattis;
1664   char *p, *bits, *bp;
1665   const char * volatile emsg = 0;
1666   const char * volatile dstring;
1667
1668   assert (!NILP (data));
1669
1670   TO_EXTERNAL_FORMAT (LISP_STRING, data,
1671                       C_STRING_ALLOCA, dstring,
1672                       Qbinary);
1673
1674   if ((p = strchr (dstring, ':')))
1675     {
1676       dstring = p + 1;
1677     }
1678
1679   /* Must use setjmp not SETJMP because we used jmp_buf above not JMP_BUF */
1680   if (!(stattis = setjmp (comp_env)))
1681     {
1682       UnCompAll ((char *) dstring);
1683       UnGenFace ();
1684     }
1685
1686   switch (stattis)
1687     {
1688     case -2:
1689       emsg = "uncompface: internal error";
1690       break;
1691     case -1:
1692       emsg = "uncompface: insufficient or invalid data";
1693       break;
1694     case 1:
1695       emsg = "uncompface: excess data ignored";
1696       break;
1697     }
1698
1699   if (emsg)
1700     signal_simple_error_2 (emsg, data, Qimage);
1701
1702   bp = bits = (char *) alloca (PIXELS / 8);
1703
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)
1707     {
1708       int n, b;
1709       /* reverse the bit order of each byte... */
1710       for (b = n = 0; b < 8; ++b)
1711         {
1712           n |= ((*p++) << b);
1713         }
1714       *bp++ = (char) n;
1715     }
1716
1717   xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1718                      pointer_bg, dest_mask, 48, 48, bits);
1719 }
1720
1721 #endif /* HAVE_XFACE */
1722
1723 \f
1724 /**********************************************************************
1725  *                       Autodetect                                      *
1726  **********************************************************************/
1727
1728 static void
1729 autodetect_validate (Lisp_Object instantiator)
1730 {
1731   data_must_be_present (instantiator);
1732 }
1733
1734 static Lisp_Object
1735 autodetect_normalize (Lisp_Object instantiator,
1736                       Lisp_Object console_type)
1737 {
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;
1743
1744   GCPRO3 (filename, data, alist);
1745
1746   if (NILP (file)) /* no conversion necessary */
1747     RETURN_UNGCPRO (instantiator);
1748
1749   alist = tagged_vector_to_alist (instantiator);
1750
1751   filename = locate_pixmap_file (file);
1752   if (!NILP (filename))
1753     {
1754       int xhot, yhot;
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.  */
1760
1761       data = bitmap_to_lisp_data (filename, &xhot, &yhot, 1);
1762
1763       if (!EQ (data, Qt))
1764         {
1765           alist = remassq_no_quit (Q_data, alist);
1766           alist = Fcons (Fcons (Q_file, filename),
1767                          Fcons (Fcons (Q_data, data), alist));
1768           if (xhot != -1)
1769             alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
1770                            alist);
1771           if (yhot != -1)
1772             alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
1773                            alist);
1774
1775           alist = xbm_mask_file_munging (alist, filename, Qnil, console_type);
1776
1777           {
1778             Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
1779             free_alist (alist);
1780             RETURN_UNGCPRO (result);
1781           }
1782         }
1783
1784 #ifdef HAVE_XPM
1785       data = pixmap_to_lisp_data (filename, 1);
1786
1787       if (!EQ (data, Qt))
1788         {
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 ()),
1794                          alist);
1795           {
1796             Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
1797             free_alist (alist);
1798             RETURN_UNGCPRO (result);
1799           }
1800         }
1801 #endif
1802     }
1803
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.) */
1808   {
1809     Lisp_Object result = alist_to_tagged_vector (Qautodetect, alist);
1810     free_alist (alist);
1811     RETURN_UNGCPRO (result);
1812   }
1813 }
1814
1815 static int
1816 autodetect_possible_dest_types (void)
1817 {
1818   return
1819     IMAGE_MONO_PIXMAP_MASK  |
1820     IMAGE_COLOR_PIXMAP_MASK |
1821     IMAGE_POINTER_MASK      |
1822     IMAGE_TEXT_MASK;
1823 }
1824
1825 static void
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)
1831 {
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;
1837
1838   GCPRO3 (data, alist, result);
1839
1840   alist = tagged_vector_to_alist (instantiator);
1841   if (dest_mask & IMAGE_POINTER_MASK)
1842     {
1843       const char *name_ext;
1844       TO_EXTERNAL_FORMAT (LISP_STRING, data,
1845                           C_STRING_ALLOCA, name_ext,
1846                           Qfile_name);
1847       if (XmuCursorNameToIndex (name_ext) != -1)
1848         {
1849           result = alist_to_tagged_vector (Qcursor_font, alist);
1850           is_cursor_font = 1;
1851         }
1852     }
1853
1854   if (!is_cursor_font)
1855     result = alist_to_tagged_vector (Qstring, alist);
1856   free_alist (alist);
1857
1858   if (is_cursor_font)
1859     cursor_font_instantiate (image_instance, result, pointer_fg,
1860                              pointer_bg, dest_mask, domain);
1861   else
1862     string_instantiate (image_instance, result, pointer_fg,
1863                         pointer_bg, dest_mask, domain);
1864
1865   UNGCPRO;
1866 }
1867
1868 \f
1869 /**********************************************************************
1870  *                              Font                                  *
1871  **********************************************************************/
1872
1873 static void
1874 font_validate (Lisp_Object instantiator)
1875 {
1876   data_must_be_present (instantiator);
1877 }
1878
1879 /* XmuCvtStringToCursor is bogus in the following ways:
1880
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."
1886
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.
1889
1890    - Also, using Xmu means we can't properly hack Lisp_Image_Instance
1891      objects, or XPM files, or $XBMLANGPATH.
1892  */
1893
1894 /* Duplicate the behavior of XmuCvtStringToCursor() to bypass its bogusness. */
1895
1896 static int XLoadFont_got_error;
1897
1898 static int
1899 XLoadFont_error_handler (Display *dpy, XErrorEvent *xerror)
1900 {
1901   XLoadFont_got_error = 1;
1902   return 0;
1903 }
1904
1905 static Font
1906 safe_XLoadFont (Display *dpy, char *name)
1907 {
1908   Font font;
1909   int (*old_handler) (Display *, XErrorEvent *);
1910   XLoadFont_got_error = 0;
1911   XSync (dpy, 0);
1912   old_handler = XSetErrorHandler (XLoadFont_error_handler);
1913   font = XLoadFont (dpy, name);
1914   XSync (dpy, 0);
1915   XSetErrorHandler (old_handler);
1916   if (XLoadFont_got_error) return 0;
1917   return font;
1918 }
1919
1920 static int
1921 font_possible_dest_types (void)
1922 {
1923   return IMAGE_POINTER_MASK;
1924 }
1925
1926 static void
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)
1930 {
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);
1935   Display *dpy;
1936   XColor fg, bg;
1937   Font source, mask;
1938   char source_name[MAXPATHLEN], mask_name[MAXPATHLEN], dummy;
1939   int source_char, mask_char;
1940   int count;
1941   Lisp_Object foreground, background;
1942
1943   if (!DEVICE_X_P (XDEVICE (device)))
1944     signal_simple_error ("Not an X device", device);
1945
1946   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1947
1948   if (!STRINGP (data) ||
1949       strncmp ("FONT ", (char *) XSTRING_DATA (data), 5))
1950     signal_simple_error ("Invalid font-glyph instantiator",
1951                          instantiator);
1952
1953   if (!(dest_mask & IMAGE_POINTER_MASK))
1954     incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
1955
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;
1962
1963   generate_cursor_fg_bg (device, &foreground, &background, &fg, &bg);
1964
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;
1972
1973   if (count != 2 && count != 4)
1974     signal_simple_error ("invalid cursor specification", data);
1975   source = safe_XLoadFont (dpy, source_name);
1976   if (! source)
1977     signal_simple_error_2 ("couldn't load font",
1978                            build_string (source_name),
1979                            data);
1980   if (count == 2)
1981     mask = 0;
1982   else if (!mask_name[0])
1983     mask = source;
1984   else
1985     {
1986       mask = safe_XLoadFont (dpy, mask_name);
1987       if (!mask)
1988         /* continuable */
1989         Fsignal (Qerror, list3 (build_string ("couldn't load font"),
1990                                 build_string (mask_name), data));
1991     }
1992   if (!mask)
1993     mask_char = 0;
1994
1995   /* #### call XQueryTextExtents() and check_pointer_sizes() here. */
1996
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,
2000                         &fg, &bg);
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);
2005 }
2006
2007 \f
2008 /**********************************************************************
2009  *                           Cursor-Font                              *
2010  **********************************************************************/
2011
2012 static void
2013 cursor_font_validate (Lisp_Object instantiator)
2014 {
2015   data_must_be_present (instantiator);
2016 }
2017
2018 static int
2019 cursor_font_possible_dest_types (void)
2020 {
2021   return IMAGE_POINTER_MASK;
2022 }
2023
2024 static void
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)
2028 {
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);
2033   Display *dpy;
2034   int i;
2035   const char *name_ext;
2036   Lisp_Object foreground, background;
2037
2038   if (!DEVICE_X_P (XDEVICE (device)))
2039     signal_simple_error ("Not an X device", device);
2040
2041   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2042
2043   if (!(dest_mask & IMAGE_POINTER_MASK))
2044     incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
2045
2046   TO_EXTERNAL_FORMAT (LISP_STRING, data,
2047                       C_STRING_ALLOCA, name_ext,
2048                       Qfile_name);
2049   if ((i = XmuCursorNameToIndex (name_ext)) == -1)
2050     signal_simple_error ("Unrecognized cursor-font name", data);
2051
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);
2061 }
2062
2063 static int
2064 x_colorize_image_instance (Lisp_Object image_instance,
2065                            Lisp_Object foreground, Lisp_Object background)
2066 {
2067   Lisp_Image_Instance *p;
2068
2069   p = XIMAGE_INSTANCE (image_instance);
2070
2071   switch (IMAGE_INSTANCE_TYPE (p))
2072     {
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;
2078       break;
2079
2080     default:
2081       return 0;
2082     }
2083
2084   {
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);
2091     XColor color;
2092     XGCValues gcv;
2093     GC gc;
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),
2102                 0, 0, 1);
2103     XFreeGC (dpy, gc);
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;
2108     return 1;
2109   }
2110 }
2111
2112 \f
2113 /************************************************************************/
2114 /*                      subwindow and widget support                      */
2115 /************************************************************************/
2116
2117 /* unmap the image if it is a widget. This is used by redisplay via
2118    redisplay_unmap_subwindows */
2119 static void
2120 x_unmap_subwindow (Lisp_Image_Instance *p)
2121 {
2122   if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
2123     {
2124       XUnmapWindow
2125         (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2126          IMAGE_INSTANCE_X_CLIPWINDOW (p));
2127     }
2128   else                          /* must be a widget */
2129     {
2130       XtUnmapWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p));
2131     }
2132 }
2133
2134 /* map the subwindow. This is used by redisplay via
2135    redisplay_output_subwindow */
2136 static void
2137 x_map_subwindow (Lisp_Image_Instance *p, int x, int y,
2138                  struct display_glyph_area* dga)
2139 {
2140   if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
2141     {
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));
2150     }
2151   else                          /* must be a widget */
2152     {
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));
2160     }
2161 }
2162
2163 /* when you click on a widget you may activate another widget this
2164    needs to be checked and all appropriate widgets updated */
2165 static void
2166 x_update_subwindow (Lisp_Image_Instance *p)
2167 {
2168   /* Update the subwindow size if necessary. */
2169   if (IMAGE_INSTANCE_SIZE_CHANGED (p))
2170     {
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));
2175     }
2176 }
2177
2178 /* Update all attributes that have changed. Lwlib actually does most
2179    of this for us. */
2180 static void
2181 x_update_widget (Lisp_Image_Instance *p)
2182 {
2183   /* This function can GC if IN_REDISPLAY is false. */
2184 #ifdef HAVE_WIDGETS
2185   widget_value* wv = 0;
2186
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))
2191     {
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),
2197                              wv, True);
2198       free_widget_value_tree (wv);
2199     }
2200
2201   /* Now do non structural updates. */
2202   wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (p));
2203
2204   /* Possibly update the colors and font */
2205   if (IMAGE_INSTANCE_WIDGET_FACE_CHANGED (p) 
2206       ||
2207       XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (p))->faces_changed
2208       ||
2209       IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (p))
2210     {
2211       update_widget_face (wv, p, IMAGE_INSTANCE_SUBWINDOW_FRAME (p));
2212     }
2213
2214   /* Possibly update the text. */
2215   if (IMAGE_INSTANCE_TEXT_CHANGED (p))
2216     {
2217       char* str;
2218       Lisp_Object val = IMAGE_INSTANCE_WIDGET_TEXT (p);
2219       TO_EXTERNAL_FORMAT (LISP_STRING, val,
2220                           C_STRING_ALLOCA, str,
2221                           Qnative);
2222       wv->value = str;
2223     }
2224
2225   /* Possibly update the size. */
2226   if (IMAGE_INSTANCE_SIZE_CHANGED (p)
2227       ||
2228       IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (p))
2229     {
2230       assert (IMAGE_INSTANCE_X_WIDGET_ID (p) &&
2231               IMAGE_INSTANCE_X_CLIPWIDGET (p)) ;
2232
2233       if (IMAGE_INSTANCE_X_WIDGET_ID (p)->core.being_destroyed
2234           || !XtIsManaged(IMAGE_INSTANCE_X_WIDGET_ID (p)))
2235         {
2236           Lisp_Object sw;
2237           XSETIMAGE_INSTANCE (sw, p);
2238           signal_simple_error ("XEmacs bug: subwindow is deleted", sw);
2239         }
2240
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));
2245     }
2246
2247   /* now modify the widget */
2248   lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (p),
2249                          wv, False);
2250 #endif
2251 }
2252
2253 /* instantiate and x type subwindow */
2254 static void
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)
2258 {
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);
2264   Display *dpy;
2265   Screen *xs;
2266   Window pw, win;
2267   XSetWindowAttributes xswa;
2268   Mask valueMask = 0;
2269   unsigned int w = IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii),
2270     h = IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii);
2271
2272   if (!DEVICE_X_P (XDEVICE (device)))
2273     signal_simple_error ("Not an X device", device);
2274
2275   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2276   xs = DefaultScreenOfDisplay (dpy);
2277
2278   IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW;
2279
2280   pw = XtWindow (FRAME_X_TEXT_WIDGET (f));
2281
2282   ii->data = xnew_and_zero (struct x_subwindow_data);
2283
2284   IMAGE_INSTANCE_X_SUBWINDOW_PARENT (ii) = pw;
2285   IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (ii) = DisplayOfScreen (xs);
2286
2287   xswa.backing_store = Always;
2288   valueMask |= CWBackingStore;
2289   xswa.colormap = DefaultColormapOfScreen (xs);
2290   valueMask |= CWColormap;
2291
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,
2296                    &xswa);
2297
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,
2302                        &xswa);
2303
2304   IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)win;
2305 }
2306
2307 #if 0
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.
2312 */
2313        (subwindow, property, data))
2314 {
2315   Atom property_atom;
2316   Lisp_Subwindow *sw;
2317   Display *dpy;
2318
2319   CHECK_SUBWINDOW (subwindow);
2320   CHECK_STRING (property);
2321   CHECK_STRING (data);
2322
2323   sw = XSUBWINDOW (subwindow);
2324   dpy = DisplayOfScreen (LISP_DEVICE_TO_X_SCREEN
2325                          (FRAME_DEVICE (XFRAME (sw->frame))));
2326
2327   property_atom = XInternAtom (dpy, (char *) XSTRING_DATA (property), False);
2328   XChangeProperty (dpy, sw->subwindow, property_atom, XA_STRING, 8,
2329                    PropModeReplace,
2330                    XSTRING_DATA   (data),
2331                    XSTRING_LENGTH (data));
2332
2333   return property;
2334 }
2335 #endif
2336
2337 \f
2338 #ifdef HAVE_WIDGETS
2339
2340 /************************************************************************/
2341 /*                            widgets                            */
2342 /************************************************************************/
2343
2344 static void
2345 update_widget_face (widget_value* wv, Lisp_Image_Instance *ii,
2346                     Lisp_Object domain)
2347 {
2348 #ifdef LWLIB_WIDGETS_MOTIF
2349   XmFontList fontList;
2350 #endif
2351   /* Update the foreground. */
2352   Lisp_Object pixel = FACE_FOREGROUND
2353     (IMAGE_INSTANCE_WIDGET_FACE (ii),
2354      domain);
2355   XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel)), bcolor;
2356   lw_add_widget_value_arg (wv, XtNforeground, fcolor.pixel);
2357
2358   /* Update the background. */
2359   pixel = FACE_BACKGROUND (IMAGE_INSTANCE_WIDGET_FACE (ii),
2360                            domain);
2361   bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2362   lw_add_widget_value_arg (wv, XtNbackground, bcolor.pixel);
2363
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);
2372 #endif
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),
2378                        domain))));
2379 }
2380
2381 static void
2382 update_tab_widget_face (widget_value* wv, Lisp_Image_Instance *ii,
2383                         Lisp_Object domain)
2384 {
2385   if (wv->contents)
2386     {
2387       widget_value* val = wv->contents, *cur;
2388
2389       /* Give each child label the correct foreground color. */
2390       Lisp_Object pixel = FACE_FOREGROUND
2391         (IMAGE_INSTANCE_WIDGET_FACE (ii),
2392          domain);
2393       XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2394       lw_add_widget_value_arg (val, XtNtabForeground, fcolor.pixel);
2395
2396       for (cur = val->next; cur; cur = cur->next)
2397         {
2398           if (cur->value)
2399             {
2400               lw_copy_widget_value_args (val, cur);
2401             }
2402         }
2403     }
2404 }
2405
2406 static void
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)
2411 {
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);
2417   char* nm=0;
2418   Widget wid;
2419   Arg al [32];
2420   int ac = 0;
2421   int id = new_lwlib_id ();
2422   widget_value* clip_wv;
2423   XColor fcolor, bcolor;
2424
2425   if (!DEVICE_X_P (d))
2426     signal_simple_error ("Not an X device", device);
2427
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;
2432
2433   if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
2434     TO_EXTERNAL_FORMAT (LISP_STRING, IMAGE_INSTANCE_WIDGET_TEXT (ii),
2435                         C_STRING_ALLOCA, nm,
2436                         Qnative);
2437
2438   ii->data = xnew_and_zero (struct x_subwindow_data);
2439
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
2443      required. */
2444   clip_wv = xmalloc_widget_value ();
2445
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;
2452
2453   clip_wv->name = xstrdup ("clip-window");
2454   clip_wv->value = xstrdup ("clip-window");
2455
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),
2459                         False, 0, 0, 0);
2460
2461   free_widget_value_tree (clip_wv);
2462
2463   /* copy any args we were given */
2464   ac = 0;
2465   lw_add_value_args_to_args (wv, al, &ac);
2466
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
2470      anymore...*/
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));
2475
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));
2480
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);
2491
2492   wid = lw_create_widget (type, wv->name, id, wv, IMAGE_INSTANCE_X_CLIPWIDGET (ii),
2493                           False, 0, popup_selection_callback, 0);
2494
2495   IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)wid;
2496   IMAGE_INSTANCE_X_WIDGET_LWID (ii) = id;
2497
2498   /* Resize the widget here so that the values do not get copied by
2499      lwlib. */
2500   ac = 0;
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);
2506   /* because the EmacsManager is the widgets parent we have to
2507      offset the redisplay of the widget by the amount the text
2508      widget is inside the manager. */
2509   ac = 0;
2510   XtSetArg (al [ac], XtNx, &IMAGE_INSTANCE_X_WIDGET_XOFFSET (ii)); ac++;
2511   XtSetArg (al [ac], XtNy, &IMAGE_INSTANCE_X_WIDGET_YOFFSET (ii)); ac++;
2512   XtGetValues (FRAME_X_TEXT_WIDGET (f), al, ac);
2513
2514   XtSetMappedWhenManaged (wid, TRUE);
2515
2516   free_widget_value_tree (wv);
2517 }
2518
2519 /* get properties of a control */
2520 static Lisp_Object
2521 x_widget_property (Lisp_Object image_instance, Lisp_Object prop)
2522 {
2523   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2524   /* get the text from a control */
2525   if (EQ (prop, Q_text))
2526     {
2527       widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2528       return build_ext_string (wv->value, Qnative);
2529     }
2530   return Qunbound;
2531 }
2532
2533 /* Instantiate a button widget. Unfortunately instantiated widgets are
2534    particular to a frame since they need to have a parent. It's not
2535    like images where you just select the image into the context you
2536    want to display it in and BitBlt it. So images instances can have a
2537    many-to-one relationship with things you see, whereas widgets can
2538    only be one-to-one (i.e. per frame) */
2539 static void
2540 x_button_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2541                       Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2542                       int dest_mask, Lisp_Object domain)
2543 {
2544   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2545   Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2546   Lisp_Object glyph = find_keyword_in_vector (instantiator, Q_image);
2547   widget_value* wv = xmalloc_widget_value ();
2548
2549   button_item_to_widget_value (gui, wv, 1, 1);
2550
2551   if (!NILP (glyph))
2552     {
2553       if (!IMAGE_INSTANCEP (glyph))
2554         glyph = glyph_image_instance (glyph, domain, ERROR_ME, 1);
2555     }
2556
2557   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2558                         pointer_bg, dest_mask, domain, "button", wv);
2559
2560   /* add the image if one was given */
2561   if (!NILP (glyph) && IMAGE_INSTANCEP (glyph)
2562       && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (glyph)))
2563     {
2564       Arg al [2];
2565       int ac =0;
2566 #ifdef LWLIB_WIDGETS_MOTIF
2567       XtSetArg (al [ac], XmNlabelType, XmPIXMAP);       ac++;
2568       XtSetArg (al [ac], XmNlabelPixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph));ac++;
2569 #else
2570       XtSetArg (al [ac], XtNpixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph));  ac++;
2571 #endif
2572       XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, ac);
2573     }
2574 }
2575
2576 /* get properties of a button */
2577 static Lisp_Object
2578 x_button_property (Lisp_Object image_instance, Lisp_Object prop)
2579 {
2580   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2581   /* check the state of a button */
2582   if (EQ (prop, Q_selected))
2583     {
2584       widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2585
2586       if (wv->selected)
2587         return Qt;
2588       else
2589         return Qnil;
2590     }
2591   return Qunbound;
2592 }
2593
2594 /* instantiate a progress gauge */
2595 static void
2596 x_progress_gauge_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2597                         Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2598                         int dest_mask, Lisp_Object domain)
2599 {
2600   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2601   Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2602   widget_value* wv = xmalloc_widget_value ();
2603
2604   button_item_to_widget_value (gui, wv, 1, 1);
2605
2606   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2607                         pointer_bg, dest_mask, domain, "progress", wv);
2608 }
2609
2610 /* set the properties of a progres guage */
2611 static void
2612 x_progress_gauge_update (Lisp_Object image_instance)
2613 {
2614   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2615
2616   if (IMAGE_INSTANCE_WIDGET_PERCENT_CHANGED (ii))
2617     {
2618       Arg al [1];
2619       /* #### I'm not convinced we should store this in the plist. */
2620       Lisp_Object val = Fplist_get (IMAGE_INSTANCE_WIDGET_PROPS (ii),
2621                                     Q_percent, Qnil);
2622       XtSetArg (al[0], XtNvalue, XINT (val));
2623       XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 1);
2624     }
2625 }
2626
2627 /* instantiate an edit control */
2628 static void
2629 x_edit_field_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2630                     Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2631                     int dest_mask, Lisp_Object domain)
2632 {
2633   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2634   Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2635   widget_value* wv = xmalloc_widget_value ();
2636
2637   button_item_to_widget_value (gui, wv, 1, 1);
2638
2639   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2640                         pointer_bg, dest_mask, domain, "text-field", wv);
2641 }
2642
2643 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
2644 /* instantiate a combo control */
2645 static void
2646 x_combo_box_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2647                      Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2648                      int dest_mask, Lisp_Object domain)
2649 {
2650   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2651   widget_value * wv = 0;
2652   /* This is not done generically because of sizing problems under
2653      mswindows. */
2654   widget_instantiate (image_instance, instantiator, pointer_fg,
2655                       pointer_bg, dest_mask, domain);
2656
2657   wv = gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2658
2659   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2660                         pointer_bg, dest_mask, domain, "combo-box", wv);
2661 }
2662 #endif
2663
2664 static void
2665 x_tab_control_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2666                            Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2667                            int dest_mask, Lisp_Object domain)
2668 {
2669   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2670   widget_value * wv =
2671     gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2672
2673   update_tab_widget_face (wv, ii,
2674                           IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2675
2676   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2677                         pointer_bg, dest_mask, domain, "tab-control", wv);
2678 }
2679
2680 /* set the properties of a tab control */
2681 static void
2682 x_tab_control_update (Lisp_Object image_instance) 
2683 {
2684   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2685
2686   /* Possibly update the face. */
2687   if (IMAGE_INSTANCE_WIDGET_FACE_CHANGED (ii) 
2688       ||
2689       XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii))->faces_changed
2690       ||
2691       IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii))
2692     {
2693       widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2694       update_tab_widget_face (wv, ii,
2695                               IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2696
2697       lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, True);
2698     }
2699 }
2700
2701 /* instantiate a static control possible for putting other things in */
2702 static void
2703 x_label_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2704                      Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2705                      int dest_mask, Lisp_Object domain)
2706 {
2707   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2708   Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2709   widget_value* wv = xmalloc_widget_value ();
2710
2711   button_item_to_widget_value (gui, wv, 1, 1);
2712
2713   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2714                         pointer_bg, dest_mask, domain, "button", wv);
2715 }
2716 #endif /* HAVE_WIDGETS */
2717
2718 \f
2719 /************************************************************************/
2720 /*                            initialization                            */
2721 /************************************************************************/
2722
2723 void
2724 syms_of_glyphs_x (void)
2725 {
2726 #if 0
2727   DEFSUBR (Fchange_subwindow_property);
2728 #endif
2729 }
2730
2731 void
2732 console_type_create_glyphs_x (void)
2733 {
2734   /* image methods */
2735
2736   CONSOLE_HAS_METHOD (x, print_image_instance);
2737   CONSOLE_HAS_METHOD (x, finalize_image_instance);
2738   CONSOLE_HAS_METHOD (x, image_instance_equal);
2739   CONSOLE_HAS_METHOD (x, image_instance_hash);
2740   CONSOLE_HAS_METHOD (x, colorize_image_instance);
2741   CONSOLE_HAS_METHOD (x, init_image_instance_from_eimage);
2742   CONSOLE_HAS_METHOD (x, locate_pixmap_file);
2743   CONSOLE_HAS_METHOD (x, unmap_subwindow);
2744   CONSOLE_HAS_METHOD (x, map_subwindow);
2745   CONSOLE_HAS_METHOD (x, update_widget);
2746   CONSOLE_HAS_METHOD (x, update_subwindow);
2747 }
2748
2749 void
2750 image_instantiator_format_create_glyphs_x (void)
2751 {
2752   IIFORMAT_VALID_CONSOLE (x, nothing);
2753   IIFORMAT_VALID_CONSOLE (x, string);
2754   IIFORMAT_VALID_CONSOLE (x, layout);
2755   IIFORMAT_VALID_CONSOLE (x, formatted_string);
2756   IIFORMAT_VALID_CONSOLE (x, inherit);
2757 #ifdef HAVE_XPM
2758   INITIALIZE_DEVICE_IIFORMAT (x, xpm);
2759   IIFORMAT_HAS_DEVMETHOD (x, xpm, instantiate);
2760 #endif
2761 #ifdef HAVE_JPEG
2762   IIFORMAT_VALID_CONSOLE (x, jpeg);
2763 #endif
2764 #ifdef HAVE_TIFF
2765   IIFORMAT_VALID_CONSOLE (x, tiff);
2766 #endif
2767 #ifdef HAVE_PNG
2768   IIFORMAT_VALID_CONSOLE (x, png);
2769 #endif
2770 #ifdef HAVE_GIF
2771   IIFORMAT_VALID_CONSOLE (x, gif);
2772 #endif
2773   INITIALIZE_DEVICE_IIFORMAT (x, xbm);
2774   IIFORMAT_HAS_DEVMETHOD (x, xbm, instantiate);
2775
2776   INITIALIZE_DEVICE_IIFORMAT (x, subwindow);
2777   IIFORMAT_HAS_DEVMETHOD (x, subwindow, instantiate);
2778 #ifdef HAVE_WIDGETS
2779   /* button widget */
2780   INITIALIZE_DEVICE_IIFORMAT (x, button);
2781   IIFORMAT_HAS_DEVMETHOD (x, button, property);
2782   IIFORMAT_HAS_DEVMETHOD (x, button, instantiate);
2783
2784   INITIALIZE_DEVICE_IIFORMAT (x, widget);
2785   IIFORMAT_HAS_DEVMETHOD (x, widget, property);
2786   /* progress gauge */
2787   INITIALIZE_DEVICE_IIFORMAT (x, progress_gauge);
2788   IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, update);
2789   IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, instantiate);
2790   /* text field */
2791   INITIALIZE_DEVICE_IIFORMAT (x, edit_field);
2792   IIFORMAT_HAS_DEVMETHOD (x, edit_field, instantiate);
2793 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
2794   /* combo box */
2795   INITIALIZE_DEVICE_IIFORMAT (x, combo_box);
2796   IIFORMAT_HAS_DEVMETHOD (x, combo_box, instantiate);
2797   IIFORMAT_HAS_SHARED_DEVMETHOD (x, combo_box, update, tab_control);
2798 #endif
2799   /* tab control widget */
2800   INITIALIZE_DEVICE_IIFORMAT (x, tab_control);
2801   IIFORMAT_HAS_DEVMETHOD (x, tab_control, instantiate);
2802   IIFORMAT_HAS_DEVMETHOD (x, tab_control, update);
2803   /* label */
2804   INITIALIZE_DEVICE_IIFORMAT (x, label);
2805   IIFORMAT_HAS_DEVMETHOD (x, label, instantiate);
2806 #endif
2807   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (cursor_font, "cursor-font");
2808   IIFORMAT_VALID_CONSOLE (x, cursor_font);
2809
2810   IIFORMAT_HAS_METHOD (cursor_font, validate);
2811   IIFORMAT_HAS_METHOD (cursor_font, possible_dest_types);
2812   IIFORMAT_HAS_METHOD (cursor_font, instantiate);
2813
2814   IIFORMAT_VALID_KEYWORD (cursor_font, Q_data, check_valid_string);
2815   IIFORMAT_VALID_KEYWORD (cursor_font, Q_foreground, check_valid_string);
2816   IIFORMAT_VALID_KEYWORD (cursor_font, Q_background, check_valid_string);
2817
2818   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (font, "font");
2819
2820   IIFORMAT_HAS_METHOD (font, validate);
2821   IIFORMAT_HAS_METHOD (font, possible_dest_types);
2822   IIFORMAT_HAS_METHOD (font, instantiate);
2823   IIFORMAT_VALID_CONSOLE (x, font);
2824
2825   IIFORMAT_VALID_KEYWORD (font, Q_data, check_valid_string);
2826   IIFORMAT_VALID_KEYWORD (font, Q_foreground, check_valid_string);
2827   IIFORMAT_VALID_KEYWORD (font, Q_background, check_valid_string);
2828
2829 #ifdef HAVE_XFACE
2830   INITIALIZE_DEVICE_IIFORMAT (x, xface);
2831   IIFORMAT_HAS_DEVMETHOD (x, xface, instantiate);
2832 #endif
2833
2834   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (autodetect,
2835                                         "autodetect");
2836
2837   IIFORMAT_HAS_METHOD (autodetect, validate);
2838   IIFORMAT_HAS_METHOD (autodetect, normalize);
2839   IIFORMAT_HAS_METHOD (autodetect, possible_dest_types);
2840   IIFORMAT_HAS_METHOD (autodetect, instantiate);
2841   IIFORMAT_VALID_CONSOLE (x, autodetect);
2842
2843   IIFORMAT_VALID_KEYWORD (autodetect, Q_data, check_valid_string);
2844 }
2845
2846 void
2847 vars_of_glyphs_x (void)
2848 {
2849   DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path /*
2850 A list of the directories in which X bitmap files may be found.
2851 If nil, this is initialized from the "*bitmapFilePath" resource.
2852 This is used by the `make-image-instance' function (however, note that if
2853 the environment variable XBMLANGPATH is set, it is consulted first).
2854 */ );
2855   Vx_bitmap_file_path = Qnil;
2856 }
2857
2858 void
2859 complex_vars_of_glyphs_x (void)
2860 {
2861 #define BUILD_GLYPH_INST(variable, name)                        \
2862   Fadd_spec_to_specifier                                        \
2863     (GLYPH_IMAGE (XGLYPH (variable)),                           \
2864      vector3 (Qxbm, Q_data,                                     \
2865               list3 (make_int (name##_width),                   \
2866                      make_int (name##_height),                  \
2867                      make_ext_string (name##_bits,              \
2868                                       sizeof (name##_bits),     \
2869                                       Qbinary))),               \
2870      Qglobal, Qx, Qnil)
2871
2872   BUILD_GLYPH_INST (Vtruncation_glyph, truncator);
2873   BUILD_GLYPH_INST (Vcontinuation_glyph, continuer);
2874   BUILD_GLYPH_INST (Vxemacs_logo, xemacs);
2875   BUILD_GLYPH_INST (Vhscroll_glyph, hscroll);
2876
2877 #undef BUILD_GLYPH_INST
2878 }