Contents of release-21-2 at 1999-07-05-18.
[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 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 for 21.0
44
45    TODO:
46    Convert images.el to C and stick it in here?
47  */
48
49 #include <config.h>
50 #include "lisp.h"
51 #include "lstream.h"
52 #include "console-x.h"
53 #include "glyphs-x.h"
54 #include "objects-x.h"
55 #include "gui-x.h"
56 #include "xmu.h"
57
58 #include "buffer.h"
59 #include "window.h"
60 #include "frame.h"
61 #include "insdel.h"
62 #include "opaque.h"
63 #include "gui.h"
64 #include "faces.h"
65
66 #include "imgproc.h"
67
68 #include "sysfile.h"
69
70 #include <setjmp.h>
71
72 #ifdef FILE_CODING
73 #include "file-coding.h"
74 #endif
75
76 #ifdef LWLIB_USES_MOTIF
77 #include <Xm/Xm.h>
78 #endif
79 #include <X11/IntrinsicP.h>
80
81 #if INTBITS == 32
82 # define FOUR_BYTE_TYPE unsigned int
83 #elif LONGBITS == 32
84 # define FOUR_BYTE_TYPE unsigned long
85 #elif SHORTBITS == 32
86 # define FOUR_BYTE_TYPE unsigned short
87 #else
88 #error What kind of strange-ass system are we running on?
89 #endif
90
91 #define LISP_DEVICE_TO_X_SCREEN(dev) XDefaultScreenOfDisplay (DEVICE_X_DISPLAY (XDEVICE (dev)))
92
93 DECLARE_IMAGE_INSTANTIATOR_FORMAT (nothing);
94 DECLARE_IMAGE_INSTANTIATOR_FORMAT (string);
95 DECLARE_IMAGE_INSTANTIATOR_FORMAT (formatted_string);
96 DECLARE_IMAGE_INSTANTIATOR_FORMAT (inherit);
97 #ifdef HAVE_JPEG
98 DECLARE_IMAGE_INSTANTIATOR_FORMAT (jpeg);
99 #endif
100 #ifdef HAVE_TIFF
101 DECLARE_IMAGE_INSTANTIATOR_FORMAT (tiff);
102 #endif  
103 #ifdef HAVE_PNG
104 DECLARE_IMAGE_INSTANTIATOR_FORMAT (png);
105 #endif  
106 #ifdef HAVE_GIF
107 DECLARE_IMAGE_INSTANTIATOR_FORMAT (gif);
108 #endif  
109 #ifdef HAVE_XPM
110 DEFINE_DEVICE_IIFORMAT (x, xpm);
111 #endif
112 DEFINE_DEVICE_IIFORMAT (x, xbm);
113 DEFINE_DEVICE_IIFORMAT (x, subwindow);
114 #ifdef HAVE_XFACE
115 DEFINE_DEVICE_IIFORMAT (x, xface);
116 #endif
117
118 DEFINE_IMAGE_INSTANTIATOR_FORMAT (cursor_font);
119 Lisp_Object Qcursor_font;
120
121 DEFINE_IMAGE_INSTANTIATOR_FORMAT (font);
122
123 DEFINE_IMAGE_INSTANTIATOR_FORMAT (autodetect);
124
125 DEFINE_DEVICE_IIFORMAT (x, widget);
126 DEFINE_DEVICE_IIFORMAT (x, button);
127 DEFINE_DEVICE_IIFORMAT (x, progress_gauge);
128 DEFINE_DEVICE_IIFORMAT (x, edit_field);
129 DEFINE_DEVICE_IIFORMAT (x, combo_box);
130
131 static void cursor_font_instantiate (Lisp_Object image_instance,
132                                      Lisp_Object instantiator,
133                                      Lisp_Object pointer_fg,
134                                      Lisp_Object pointer_bg,
135                                      int dest_mask,
136                                      Lisp_Object domain);
137
138 #include "bitmaps.h"
139
140 \f
141 /************************************************************************/
142 /*                      image instance methods                          */
143 /************************************************************************/
144
145 /************************************************************************/
146 /* convert from a series of RGB triples to an XImage formated for the   */
147 /* proper display                                                       */
148 /************************************************************************/
149 static XImage *
150 convert_EImage_to_XImage (Lisp_Object device, int width, int height,
151                           unsigned char *pic, unsigned long **pixtbl,
152                           int *npixels)
153 {
154   Display *dpy;
155   Colormap cmap;
156   Visual *vis;
157   XImage *outimg;
158   int depth, bitmap_pad, bits_per_pixel, byte_cnt, i, j;
159   int rd,gr,bl,q;
160   unsigned char *data, *ip, *dp;
161   quant_table *qtable = 0;
162   union {
163     FOUR_BYTE_TYPE val;
164     char cp[4];
165   } conv;
166
167   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
168   cmap = DEVICE_X_COLORMAP (XDEVICE(device));
169   vis = DEVICE_X_VISUAL (XDEVICE(device));
170   depth = DEVICE_X_DEPTH(XDEVICE(device));
171
172   if (vis->class == PseudoColor)
173     {
174       /* Quantize the image and get a histogram while we're at it.
175          Do this first to save memory */
176       qtable = build_EImage_quantable(pic, width, height, 256);
177       if (qtable == NULL) return NULL;
178     }
179
180   bitmap_pad = ((depth > 16) ? 32 :
181                 (depth >  8) ? 16 :
182                 8);
183
184   outimg = XCreateImage (dpy, vis,
185                          depth, ZPixmap, 0, 0, width, height,
186                          bitmap_pad, 0);
187   if (!outimg) return NULL;
188
189   bits_per_pixel = outimg->bits_per_pixel;
190   byte_cnt = bits_per_pixel >> 3;
191
192   data = (unsigned char *) xmalloc (outimg->bytes_per_line * height);
193   if (!data)
194     {
195       XDestroyImage (outimg);
196       return NULL;
197     }
198   outimg->data = (char *) data;
199
200   if (vis->class == PseudoColor)
201     {
202       unsigned long pixarray[256];
203       int pixcount, n;
204       /* use our quantize table to allocate the colors */
205       pixcount = 32;
206       *pixtbl = xnew_array (unsigned long, pixcount);
207       *npixels = 0;
208
209       /* ### should implement a sort by popularity to assure proper allocation */
210       n = *npixels;
211       for (i = 0; i < qtable->num_active_colors; i++)
212         {
213           XColor color;
214           int res;
215
216           color.red = qtable->rm[i] ? qtable->rm[i] << 8 : 0;
217           color.green = qtable->gm[i] ? qtable->gm[i] << 8 : 0;
218           color.blue = qtable->bm[i] ? qtable->bm[i] << 8 : 0;
219           color.flags = DoRed | DoGreen | DoBlue;
220           res = allocate_nearest_color (dpy, cmap, vis, &color);
221           if (res > 0 && res < 3)
222             {
223               DO_REALLOC(*pixtbl, pixcount, n+1, unsigned long);
224               (*pixtbl)[n] = color.pixel;
225               n++;
226             }
227           pixarray[i] = color.pixel;
228         }
229       *npixels = n;
230       ip = pic;
231       for (i = 0; i < height; i++)
232         {
233           dp = data + (i * outimg->bytes_per_line);
234           for (j = 0; j < width; j++)
235             {
236               rd = *ip++;
237               gr = *ip++;
238               bl = *ip++;
239               conv.val = pixarray[QUANT_GET_COLOR(qtable,rd,gr,bl)];
240 #if WORDS_BIGENDIAN
241               if (outimg->byte_order == MSBFirst)
242                 for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q];
243               else
244                 for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q];
245 #else
246               if (outimg->byte_order == MSBFirst)
247                 for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q];
248               else
249                 for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q];
250 #endif
251             }
252         }
253       xfree(qtable);
254     } else {
255       unsigned long rshift,gshift,bshift,rbits,gbits,bbits,junk;
256       junk = vis->red_mask;
257       rshift = 0;
258       while ((junk & 0x1) == 0)
259         {
260           junk = junk >> 1;
261           rshift ++;
262         }
263       rbits = 0;
264       while (junk != 0)
265         {
266           junk = junk >> 1;
267           rbits++;
268         }
269       junk = vis->green_mask;
270       gshift = 0;
271       while ((junk & 0x1) == 0)
272         {
273           junk = junk >> 1;
274           gshift ++;
275         }
276       gbits = 0;
277       while (junk != 0)
278         {
279           junk = junk >> 1;
280           gbits++;
281         }
282       junk = vis->blue_mask;
283       bshift = 0;
284       while ((junk & 0x1) == 0)
285         {
286           junk = junk >> 1;
287           bshift ++;
288         }
289       bbits = 0;
290       while (junk != 0)
291         {
292           junk = junk >> 1;
293           bbits++;
294         }
295       ip = pic;
296       for (i = 0; i < height; i++)
297         {
298           dp = data + (i * outimg->bytes_per_line);
299           for (j = 0; j < width; j++)
300             {
301               if (rbits > 8)
302                 rd = *ip++ << (rbits - 8);
303               else
304                 rd = *ip++ >> (8 - rbits);
305               if (gbits > 8)
306                 gr = *ip++ << (gbits - 8);
307               else
308                 gr = *ip++ >> (8 - gbits);
309               if (bbits > 8)
310                 bl = *ip++ << (bbits - 8);
311               else
312                 bl = *ip++ >> (8 - bbits);
313
314               conv.val = (rd << rshift) | (gr << gshift) | (bl << bshift);
315 #if WORDS_BIGENDIAN
316               if (outimg->byte_order == MSBFirst)
317                 for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q];
318               else
319                 for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q];
320 #else
321               if (outimg->byte_order == MSBFirst)
322                 for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q];
323               else
324                 for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q];
325 #endif
326             }
327         }
328     }
329   return outimg;
330 }
331
332
333
334 static void
335 x_print_image_instance (struct Lisp_Image_Instance *p,
336                         Lisp_Object printcharfun,
337                         int escapeflag)
338 {
339   char buf[100];
340
341   switch (IMAGE_INSTANCE_TYPE (p))
342     {
343     case IMAGE_MONO_PIXMAP:
344     case IMAGE_COLOR_PIXMAP:
345     case IMAGE_POINTER:
346       sprintf (buf, " (0x%lx", (unsigned long) IMAGE_INSTANCE_X_PIXMAP (p));
347       write_c_string (buf, printcharfun);
348       if (IMAGE_INSTANCE_X_MASK (p))
349         {
350           sprintf (buf, "/0x%lx", (unsigned long) IMAGE_INSTANCE_X_MASK (p));
351           write_c_string (buf, printcharfun);
352         }
353       write_c_string (")", printcharfun);
354       break;
355     default:
356       break;
357     }
358 }
359
360 static void
361 x_finalize_image_instance (struct Lisp_Image_Instance *p)
362 {
363   if (!p->data)
364     return;
365
366   if (DEVICE_LIVE_P (XDEVICE (p->device)))
367     {
368       Display *dpy = DEVICE_X_DISPLAY (XDEVICE (p->device));
369
370       if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET)
371         {
372           if (IMAGE_INSTANCE_SUBWINDOW_ID (p))
373             {
374               XtUnmanageChild (IMAGE_INSTANCE_X_WIDGET_ID (p));
375               XtDestroyWidget (IMAGE_INSTANCE_X_WIDGET_ID (p));
376               IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0;
377             }
378         }
379       else if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
380         {
381           if (IMAGE_INSTANCE_SUBWINDOW_ID (p))
382             XDestroyWindow (dpy, IMAGE_INSTANCE_X_SUBWINDOW_ID (p));
383           IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0;
384         }
385       else
386         {
387           if (IMAGE_INSTANCE_X_PIXMAP (p))
388             XFreePixmap (dpy, IMAGE_INSTANCE_X_PIXMAP (p));
389           if (IMAGE_INSTANCE_X_MASK (p) &&
390               IMAGE_INSTANCE_X_MASK (p) != IMAGE_INSTANCE_X_PIXMAP (p))
391             XFreePixmap (dpy, IMAGE_INSTANCE_X_MASK (p));
392           IMAGE_INSTANCE_X_PIXMAP (p) = 0;
393           IMAGE_INSTANCE_X_MASK (p) = 0;
394           
395           if (IMAGE_INSTANCE_X_CURSOR (p))
396             {
397               XFreeCursor (dpy, IMAGE_INSTANCE_X_CURSOR (p));
398               IMAGE_INSTANCE_X_CURSOR (p) = 0;
399             }
400           
401           if (IMAGE_INSTANCE_X_NPIXELS (p) != 0)
402             {
403               XFreeColors (dpy,
404                            IMAGE_INSTANCE_X_COLORMAP (p),
405                            IMAGE_INSTANCE_X_PIXELS (p),
406                            IMAGE_INSTANCE_X_NPIXELS (p), 0);
407               IMAGE_INSTANCE_X_NPIXELS (p) = 0;
408             }
409         }
410     }
411   if (IMAGE_INSTANCE_X_PIXELS (p))
412     {
413       xfree (IMAGE_INSTANCE_X_PIXELS (p));
414       IMAGE_INSTANCE_X_PIXELS (p) = 0;
415     }
416
417   xfree (p->data);
418   p->data = 0;
419 }
420
421 static int
422 x_image_instance_equal (struct Lisp_Image_Instance *p1,
423                         struct Lisp_Image_Instance *p2, int depth)
424 {
425   switch (IMAGE_INSTANCE_TYPE (p1))
426     {
427     case IMAGE_MONO_PIXMAP:
428     case IMAGE_COLOR_PIXMAP:
429     case IMAGE_POINTER:
430       if (IMAGE_INSTANCE_X_COLORMAP (p1) != IMAGE_INSTANCE_X_COLORMAP (p2) ||
431           IMAGE_INSTANCE_X_NPIXELS (p1) != IMAGE_INSTANCE_X_NPIXELS (p2))
432         return 0;
433       break;
434     default:
435       break;
436     }
437
438   return 1;
439 }
440
441 static unsigned long
442 x_image_instance_hash (struct Lisp_Image_Instance *p, int depth)
443 {
444   switch (IMAGE_INSTANCE_TYPE (p))
445     {
446     case IMAGE_MONO_PIXMAP:
447     case IMAGE_COLOR_PIXMAP:
448     case IMAGE_POINTER:
449       return IMAGE_INSTANCE_X_NPIXELS (p);
450     default:
451       return 0;
452     }
453 }
454
455 /* Set all the slots in an image instance structure to reasonable
456    default values.  This is used somewhere within an instantiate
457    method.  It is assumed that the device slot within the image
458    instance is already set -- this is the case when instantiate
459    methods are called. */
460
461 static void
462 x_initialize_pixmap_image_instance (struct Lisp_Image_Instance *ii,
463                                     enum image_instance_type type)
464 {
465   ii->data = xnew_and_zero (struct x_image_instance_data);
466   IMAGE_INSTANCE_TYPE (ii) = type;
467   IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = Qnil;
468   IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (ii) = Qnil;
469   IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) = Qnil;
470   IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) = Qnil;
471   IMAGE_INSTANCE_PIXMAP_FG (ii) = Qnil;
472   IMAGE_INSTANCE_PIXMAP_BG (ii) = Qnil;
473 }
474
475 \f
476 /************************************************************************/
477 /*                        pixmap file functions                         */
478 /************************************************************************/
479
480 /* Where bitmaps are; initialized from resource database */
481 Lisp_Object Vx_bitmap_file_path;
482
483 #ifndef BITMAPDIR
484 #define BITMAPDIR "/usr/include/X11/bitmaps"
485 #endif
486
487 #define USE_XBMLANGPATH
488
489 /* Given a pixmap filename, look through all of the "standard" places
490    where the file might be located.  Return a full pathname if found;
491    otherwise, return Qnil. */
492
493 static Lisp_Object
494 x_locate_pixmap_file (Lisp_Object name)
495 {
496   /* This function can GC if IN_REDISPLAY is false */
497   Display *display;
498
499   /* Check non-absolute pathnames with a directory component relative to
500      the search path; that's the way Xt does it. */
501   /* #### Unix-specific */
502   if (XSTRING_BYTE (name, 0) == '/' ||
503       (XSTRING_BYTE (name, 0) == '.' &&
504        (XSTRING_BYTE (name, 1) == '/' ||
505         (XSTRING_BYTE (name, 1) == '.' &&
506          (XSTRING_BYTE (name, 2) == '/')))))
507     {
508       if (!NILP (Ffile_readable_p (name)))
509         return name;
510       else
511         return Qnil;
512     }
513
514   if (NILP (Vdefault_x_device))
515     /* This may occur during initialization. */
516     return Qnil;
517   else
518     /* We only check the bitmapFilePath resource on the original X device. */
519     display = DEVICE_X_DISPLAY (XDEVICE (Vdefault_x_device));
520
521 #ifdef USE_XBMLANGPATH
522   {
523     char *path = egetenv ("XBMLANGPATH");
524     SubstitutionRec subs[1];
525     subs[0].match = 'B';
526     subs[0].substitution = (char *) XSTRING_DATA (name);
527     /* #### Motif uses a big hairy default if $XBMLANGPATH isn't set.
528        We don't.  If you want it used, set it. */
529     if (path &&
530         (path = XtResolvePathname (display, "bitmaps", 0, 0, path,
531                                    subs, XtNumber (subs), 0)))
532       {
533         name = build_string (path);
534         XtFree (path);
535         return (name);
536       }
537   }
538 #endif
539
540   if (NILP (Vx_bitmap_file_path))
541     {
542       char *type = 0;
543       XrmValue value;
544       if (XrmGetResource (XtDatabase (display),
545                           "bitmapFilePath", "BitmapFilePath", &type, &value)
546           && !strcmp (type, "String"))
547         Vx_bitmap_file_path = decode_env_path (0, (char *) value.addr);
548       Vx_bitmap_file_path = nconc2 (Vx_bitmap_file_path,
549                                     (decode_path (BITMAPDIR)));
550     }
551
552   {
553     Lisp_Object found;
554     if (locate_file (Vx_bitmap_file_path, name, Qnil, &found, R_OK) < 0)
555       {
556         Lisp_Object temp = list1 (Vdata_directory);
557         struct gcpro gcpro1;
558
559         GCPRO1 (temp);
560         locate_file (temp, name, Qnil, &found, R_OK);
561         UNGCPRO;
562       }
563
564     return found;
565   }
566 }
567
568 static Lisp_Object
569 locate_pixmap_file (Lisp_Object name)
570 {
571   return x_locate_pixmap_file (name);
572 }
573
574 #if 0
575 static void
576 write_lisp_string_to_temp_file (Lisp_Object string, char *filename_out)
577 {
578   Lisp_Object instream, outstream;
579   Lstream *istr, *ostr;
580   char tempbuf[1024]; /* some random amount */
581   int fubar = 0;
582   FILE *tmpfil;
583   static Extbyte_dynarr *conversion_out_dynarr;
584   Bytecount bstart, bend;
585   struct gcpro gcpro1, gcpro2;
586 #ifdef FILE_CODING
587   Lisp_Object conv_out_stream;
588   Lstream *costr;
589   struct gcpro gcpro3;
590 #endif
591
592   /* This function can GC */
593   if (!conversion_out_dynarr)
594     conversion_out_dynarr = Dynarr_new (Extbyte);
595   else
596     Dynarr_reset (conversion_out_dynarr);
597
598   /* Create the temporary file ... */
599   sprintf (filename_out, "/tmp/emacs%d.XXXXXX", (int) getpid ());
600   mktemp (filename_out);
601   tmpfil = fopen (filename_out, "w");
602   if (!tmpfil)
603     {
604       if (tmpfil)
605         {
606           int old_errno = errno;
607           fclose (tmpfil);
608           unlink (filename_out);
609           errno = old_errno;
610         }
611       report_file_error ("Creating temp file",
612                          list1 (build_string (filename_out)));
613     }
614
615   CHECK_STRING (string);
616   get_string_range_byte (string, Qnil, Qnil, &bstart, &bend,
617                          GB_HISTORICAL_STRING_BEHAVIOR);
618   instream = make_lisp_string_input_stream (string, bstart, bend);
619   istr = XLSTREAM (instream);
620   /* setup the out stream */
621   outstream = make_dynarr_output_stream((unsigned_char_dynarr *)conversion_out_dynarr);
622   ostr = XLSTREAM (outstream);
623 #ifdef FILE_CODING
624   /* setup the conversion stream */
625   conv_out_stream = make_encoding_output_stream (ostr, Fget_coding_system(Qbinary));
626   costr = XLSTREAM (conv_out_stream);
627   GCPRO3 (instream, outstream, conv_out_stream);
628 #else
629   GCPRO2 (instream, outstream);
630 #endif
631
632   /* Get the data while doing the conversion */
633   while (1)
634     {
635       int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
636       if (!size_in_bytes)
637         break;
638       /* It does seem the flushes are necessary... */
639 #ifdef FILE_CODING
640       Lstream_write (costr, tempbuf, size_in_bytes);
641       Lstream_flush (costr);
642 #else
643       Lstream_write (ostr, tempbuf, size_in_bytes);
644 #endif
645       Lstream_flush (ostr);
646       if (fwrite ((unsigned char *)Dynarr_atp(conversion_out_dynarr, 0),
647                   Dynarr_length(conversion_out_dynarr), 1, tmpfil) != 1)
648         {
649           fubar = 1;
650           break;
651         }
652       /* reset the dynarr */
653       Lstream_rewind(ostr);
654     }
655
656   if (fclose (tmpfil) != 0)
657     fubar = 1;
658   Lstream_close (istr);
659 #ifdef FILE_CODING
660   Lstream_close (costr);
661 #endif
662   Lstream_close (ostr);
663
664   UNGCPRO;
665   Lstream_delete (istr);
666   Lstream_delete (ostr);
667 #ifdef FILE_CODING
668   Lstream_delete (costr);
669 #endif
670
671   if (fubar)
672     report_file_error ("Writing temp file",
673                        list1 (build_string (filename_out)));
674 }
675 #endif /* 0 */
676
677 \f
678 /************************************************************************/
679 /*                           cursor functions                           */
680 /************************************************************************/
681
682 /* Check that this server supports cursors of size WIDTH * HEIGHT.  If
683    not, signal an error.  INSTANTIATOR is only used in the error
684    message. */
685
686 static void
687 check_pointer_sizes (Screen *xs, unsigned int width, unsigned int height,
688                      Lisp_Object instantiator)
689 {
690   unsigned int best_width, best_height;
691   if (! XQueryBestCursor (DisplayOfScreen (xs), RootWindowOfScreen (xs),
692                           width, height, &best_width, &best_height))
693     /* this means that an X error of some sort occurred (we trap
694        these so they're not fatal). */
695     signal_simple_error ("XQueryBestCursor() failed?", instantiator);
696
697   if (width > best_width || height > best_height)
698     error_with_frob (instantiator,
699                      "pointer too large (%dx%d): "
700                      "server requires %dx%d or smaller",
701                      width, height, best_width, best_height);
702 }
703
704
705 static void
706 generate_cursor_fg_bg (Lisp_Object device, Lisp_Object *foreground,
707                        Lisp_Object *background, XColor *xfg, XColor *xbg)
708 {
709   if (!NILP (*foreground) && !COLOR_INSTANCEP (*foreground))
710     *foreground =
711       Fmake_color_instance (*foreground, device,
712                             encode_error_behavior_flag (ERROR_ME));
713   if (COLOR_INSTANCEP (*foreground))
714     *xfg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (*foreground));
715   else
716     {
717       xfg->pixel = 0;
718       xfg->red = xfg->green = xfg->blue = 0;
719     }
720
721   if (!NILP (*background) && !COLOR_INSTANCEP (*background))
722     *background =
723       Fmake_color_instance (*background, device,
724                             encode_error_behavior_flag (ERROR_ME));
725   if (COLOR_INSTANCEP (*background))
726     *xbg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (*background));
727   else
728     {
729       xbg->pixel = 0;
730       xbg->red = xbg->green = xbg->blue = ~0;
731     }
732 }
733
734 static void
735 maybe_recolor_cursor (Lisp_Object image_instance, Lisp_Object foreground,
736                       Lisp_Object background)
737 {
738   Lisp_Object device = XIMAGE_INSTANCE_DEVICE (image_instance);
739   XColor xfg, xbg;
740
741   generate_cursor_fg_bg (device, &foreground, &background, &xfg, &xbg);
742   if (!NILP (foreground) || !NILP (background))
743     {
744       XRecolorCursor (DEVICE_X_DISPLAY (XDEVICE (device)),
745                       XIMAGE_INSTANCE_X_CURSOR (image_instance),
746                       &xfg, &xbg);
747       XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
748       XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
749     }
750 }
751
752 \f
753 /************************************************************************/
754 /*                        color pixmap functions                        */
755 /************************************************************************/
756
757 /* Initialize an image instance from an XImage.
758
759    DEST_MASK specifies the mask of allowed image types.
760
761    PIXELS and NPIXELS specify an array of pixels that are used in
762    the image.  These need to be kept around for the duration of the
763    image.  When the image instance is freed, XFreeColors() will
764    automatically be called on all the pixels specified here; thus,
765    you should have allocated the pixels yourself using XAllocColor()
766    or the like.  The array passed in is used directly without
767    being copied, so it should be heap data created with xmalloc().
768    It will be freed using xfree() when the image instance is
769    destroyed.
770
771    If this fails, signal an error.  INSTANTIATOR is only used
772    in the error message.
773
774    #### This should be able to handle conversion into `pointer'.
775    Use the same code as for `xpm'. */
776
777 static void
778 init_image_instance_from_x_image (struct Lisp_Image_Instance *ii,
779                                   XImage *ximage,
780                                   int dest_mask,
781                                   Colormap cmap,
782                                   unsigned long *pixels,
783                                   int npixels,
784                                   Lisp_Object instantiator)
785 {
786   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
787   Display *dpy;
788   GC gc;
789   Drawable d;
790   Pixmap pixmap;
791
792   if (!DEVICE_X_P (XDEVICE (device)))
793     signal_simple_error ("Not an X device", device);
794
795   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
796   d = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
797
798   if (!(dest_mask & IMAGE_COLOR_PIXMAP_MASK))
799     incompatible_image_types (instantiator, dest_mask,
800                               IMAGE_COLOR_PIXMAP_MASK);
801
802   pixmap = XCreatePixmap (dpy, d, ximage->width,
803                           ximage->height, ximage->depth);
804   if (!pixmap)
805     signal_simple_error ("Unable to create pixmap", instantiator);
806
807   gc = XCreateGC (dpy, pixmap, 0, NULL);
808   if (!gc)
809     {
810       XFreePixmap (dpy, pixmap);
811       signal_simple_error ("Unable to create GC", instantiator);
812     }
813
814   XPutImage (dpy, pixmap, gc, ximage, 0, 0, 0, 0,
815              ximage->width, ximage->height);
816
817   XFreeGC (dpy, gc);
818
819   x_initialize_pixmap_image_instance (ii, IMAGE_COLOR_PIXMAP);
820
821   IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
822     find_keyword_in_vector (instantiator, Q_file);
823
824   IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
825   IMAGE_INSTANCE_X_MASK (ii) = 0;
826   IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = ximage->width;
827   IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = ximage->height;
828   IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = ximage->depth;
829   IMAGE_INSTANCE_X_COLORMAP (ii) = cmap;
830   IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
831   IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
832 }
833
834 static void
835 x_init_image_instance_from_eimage (struct Lisp_Image_Instance *ii,
836                                    int width, int height,
837                                    unsigned char *eimage,
838                                    int dest_mask,
839                                    Lisp_Object instantiator,
840                                    Lisp_Object domain)
841 {
842   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
843   Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device));
844   unsigned long *pixtbl = NULL;
845   int npixels = 0;
846   XImage* ximage;
847
848   ximage = convert_EImage_to_XImage (device, width, height, eimage,
849                                      &pixtbl, &npixels);
850   if (!ximage)
851     {
852       if (pixtbl) xfree (pixtbl);
853       signal_image_error("EImage to XImage conversion failed", instantiator);
854     }
855
856   /* Now create the pixmap and set up the image instance */
857   init_image_instance_from_x_image (ii, ximage, dest_mask,
858                                     cmap, pixtbl, npixels,
859                                     instantiator);
860
861   if (ximage)
862     {
863       if (ximage->data)
864         {
865           xfree (ximage->data);
866           ximage->data = 0;
867         }
868       XDestroyImage (ximage);
869     }
870 }
871
872 int read_bitmap_data_from_file (CONST char *filename, unsigned int *width,
873                                 unsigned int *height, unsigned char **datap,
874                                 int *x_hot, int *y_hot)
875 {
876   return XmuReadBitmapDataFromFile (filename, width, height,
877                                     datap, x_hot, y_hot);
878 }
879
880 /* Given inline data for a mono pixmap, create and return the
881    corresponding X object. */
882
883 static Pixmap
884 pixmap_from_xbm_inline (Lisp_Object device, int width, int height,
885                         /* Note that data is in ext-format! */
886                         CONST Extbyte *bits)
887 {
888   return XCreatePixmapFromBitmapData (DEVICE_X_DISPLAY (XDEVICE(device)),
889                                       XtWindow (DEVICE_XT_APP_SHELL (XDEVICE (device))),
890                                       (char *) bits, width, height,
891                                       1, 0, 1);
892 }
893
894 /* Given inline data for a mono pixmap, initialize the given
895    image instance accordingly. */
896
897 static void
898 init_image_instance_from_xbm_inline (struct Lisp_Image_Instance *ii,
899                                      int width, int height,
900                                      /* Note that data is in ext-format! */
901                                      CONST char *bits,
902                                      Lisp_Object instantiator,
903                                      Lisp_Object pointer_fg,
904                                      Lisp_Object pointer_bg,
905                                      int dest_mask,
906                                      Pixmap mask,
907                                      Lisp_Object mask_filename)
908 {
909   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
910   Lisp_Object foreground = find_keyword_in_vector (instantiator, Q_foreground);
911   Lisp_Object background = find_keyword_in_vector (instantiator, Q_background);
912   Display *dpy;
913   Screen *scr;
914   Drawable draw;
915   enum image_instance_type type;
916
917   if (!DEVICE_X_P (XDEVICE (device)))
918     signal_simple_error ("Not an X device", device);
919
920   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
921   draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
922   scr = DefaultScreenOfDisplay (dpy);
923
924   if ((dest_mask & IMAGE_MONO_PIXMAP_MASK) &&
925       (dest_mask & IMAGE_COLOR_PIXMAP_MASK))
926     {
927       if (!NILP (foreground) || !NILP (background))
928         type = IMAGE_COLOR_PIXMAP;
929       else
930         type = IMAGE_MONO_PIXMAP;
931     }
932   else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
933     type = IMAGE_MONO_PIXMAP;
934   else if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
935     type = IMAGE_COLOR_PIXMAP;
936   else if (dest_mask & IMAGE_POINTER_MASK)
937     type = IMAGE_POINTER;
938   else
939     incompatible_image_types (instantiator, dest_mask,
940                               IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
941                               | IMAGE_POINTER_MASK);
942
943   x_initialize_pixmap_image_instance (ii, type);
944   IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = width;
945   IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = height;
946   IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
947     find_keyword_in_vector (instantiator, Q_file);
948
949   switch (type)
950     {
951     case IMAGE_MONO_PIXMAP:
952       {
953         IMAGE_INSTANCE_X_PIXMAP (ii) =
954           pixmap_from_xbm_inline (device, width, height, (Extbyte *) bits);
955       }
956       break;
957
958     case IMAGE_COLOR_PIXMAP:
959       {
960         Dimension d = DEVICE_X_DEPTH (XDEVICE(device));
961         unsigned long fg = BlackPixelOfScreen (scr);
962         unsigned long bg = WhitePixelOfScreen (scr);
963
964         if (!NILP (foreground) && !COLOR_INSTANCEP (foreground))
965           foreground =
966             Fmake_color_instance (foreground, device,
967                                   encode_error_behavior_flag (ERROR_ME));
968
969         if (COLOR_INSTANCEP (foreground))
970           fg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground)).pixel;
971
972         if (!NILP (background) && !COLOR_INSTANCEP (background))
973           background =
974             Fmake_color_instance (background, device,
975                                   encode_error_behavior_flag (ERROR_ME));
976
977         if (COLOR_INSTANCEP (background))
978           bg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background)).pixel;
979
980         /* We used to duplicate the pixels using XAllocColor(), to protect
981            against their getting freed.  Just as easy to just store the
982            color instances here and GC-protect them, so this doesn't
983            happen. */
984         IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
985         IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
986         IMAGE_INSTANCE_X_PIXMAP (ii) =
987           XCreatePixmapFromBitmapData (dpy, draw,
988                                        (char *) bits, width, height,
989                                        fg, bg, d);
990         IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = d;
991       }
992       break;
993
994     case IMAGE_POINTER:
995     {
996         XColor fg_color, bg_color;
997         Pixmap source;
998
999         check_pointer_sizes (scr, width, height, instantiator);
1000
1001         source =
1002           XCreatePixmapFromBitmapData (dpy, draw,
1003                                        (char *) bits, width, height,
1004                                        1, 0, 1);
1005
1006         if (NILP (foreground))
1007           foreground = pointer_fg;
1008         if (NILP (background))
1009           background = pointer_bg;
1010         generate_cursor_fg_bg (device, &foreground, &background,
1011                                &fg_color, &bg_color);
1012
1013         IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
1014         IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
1015         IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) =
1016           find_keyword_in_vector (instantiator, Q_hotspot_x);
1017         IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) =
1018           find_keyword_in_vector (instantiator, Q_hotspot_y);
1019         IMAGE_INSTANCE_X_CURSOR (ii) =
1020           XCreatePixmapCursor
1021             (dpy, source, mask, &fg_color, &bg_color,
1022              !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ?
1023              XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) : 0,
1024              !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) ?
1025              XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) : 0);
1026       }
1027       break;
1028
1029     default:
1030       abort ();
1031     }
1032 }
1033
1034 static void
1035 xbm_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator,
1036                    Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1037                    int dest_mask, int width, int height,
1038                    /* Note that data is in ext-format! */
1039                    CONST char *bits)
1040 {
1041   Lisp_Object mask_data = find_keyword_in_vector (instantiator, Q_mask_data);
1042   Lisp_Object mask_file = find_keyword_in_vector (instantiator, Q_mask_file);
1043   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1044   Pixmap mask = 0;
1045   CONST char *gcc_may_you_rot_in_hell;
1046
1047   if (!NILP (mask_data))
1048     {
1049       GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (mask_data))),
1050                                        gcc_may_you_rot_in_hell);
1051       mask =
1052         pixmap_from_xbm_inline (IMAGE_INSTANCE_DEVICE (ii),
1053                                 XINT (XCAR (mask_data)),
1054                                 XINT (XCAR (XCDR (mask_data))),
1055                                 (CONST unsigned char *)
1056                                 gcc_may_you_rot_in_hell);
1057     }
1058
1059   init_image_instance_from_xbm_inline (ii, width, height, bits,
1060                                        instantiator, pointer_fg, pointer_bg,
1061                                        dest_mask, mask, mask_file);
1062 }
1063
1064 /* Instantiate method for XBM's. */
1065
1066 static void
1067 x_xbm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1068                    Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1069                    int dest_mask, Lisp_Object domain)
1070 {
1071   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1072   CONST char *gcc_go_home;
1073
1074   assert (!NILP (data));
1075
1076   GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (data))),
1077                                    gcc_go_home);
1078
1079   xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1080                      pointer_bg, dest_mask, XINT (XCAR (data)),
1081                      XINT (XCAR (XCDR (data))), gcc_go_home);
1082 }
1083
1084 \f
1085 #ifdef HAVE_XPM
1086
1087 /**********************************************************************
1088  *                             XPM                                    *
1089  **********************************************************************/
1090  /* xpm 3.2g and better has XpmCreatePixmapFromBuffer()...
1091     There was no version number in xpm.h before 3.3, but this should do.
1092   */
1093 #if (XpmVersion >= 3) || defined(XpmExactColors)
1094 # define XPM_DOES_BUFFERS
1095 #endif
1096
1097 #ifndef XPM_DOES_BUFFERS
1098 Your version of XPM is too old.  You cannot compile with it.
1099 Upgrade to version 3.2g or better or compile with --with-xpm=no.
1100 #endif /* !XPM_DOES_BUFFERS */
1101
1102 static XpmColorSymbol *
1103 extract_xpm_color_names (XpmAttributes *xpmattrs, Lisp_Object device,
1104                          Lisp_Object domain,
1105                          Lisp_Object color_symbol_alist)
1106 {
1107   /* This function can GC */
1108   Display *dpy =  DEVICE_X_DISPLAY (XDEVICE(device));
1109   Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1110   XColor color;
1111   Lisp_Object rest;
1112   Lisp_Object results = Qnil;
1113   int i;
1114   XpmColorSymbol *symbols;
1115   struct gcpro gcpro1, gcpro2;
1116
1117   GCPRO2 (results, device);
1118
1119   /* We built up results to be (("name" . #<color>) ...) so that if an
1120      error happens we don't lose any malloc()ed data, or more importantly,
1121      leave any pixels allocated in the server. */
1122   i = 0;
1123   LIST_LOOP (rest, color_symbol_alist)
1124     {
1125       Lisp_Object cons = XCAR (rest);
1126       Lisp_Object name = XCAR (cons);
1127       Lisp_Object value = XCDR (cons);
1128       if (NILP (value))
1129         continue;
1130       if (STRINGP (value))
1131         value =
1132           Fmake_color_instance
1133             (value, device, encode_error_behavior_flag (ERROR_ME_NOT));
1134       else
1135         {
1136           assert (COLOR_SPECIFIERP (value));
1137           value = Fspecifier_instance (value, domain, Qnil, Qnil);
1138         }
1139       if (NILP (value))
1140         continue;
1141       results = noseeum_cons (noseeum_cons (name, value), results);
1142       i++;
1143     }
1144   UNGCPRO;                      /* no more evaluation */
1145
1146   if (i == 0) return 0;
1147
1148   symbols = xnew_array (XpmColorSymbol, i);
1149   xpmattrs->valuemask |= XpmColorSymbols;
1150   xpmattrs->colorsymbols = symbols;
1151   xpmattrs->numsymbols = i;
1152
1153   while (--i >= 0)
1154     {
1155       Lisp_Object cons = XCAR (results);
1156       color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (XCDR (cons)));
1157       /* Duplicate the pixel value so that we still have a lock on it if
1158          the pixel we were passed is later freed. */
1159       if (! XAllocColor (dpy, cmap, &color))
1160         abort ();  /* it must be allocable since we're just duplicating it */
1161
1162       symbols [i].name = (char *) XSTRING_DATA (XCAR (cons));
1163       symbols [i].pixel = color.pixel;
1164       symbols [i].value = 0;
1165       free_cons (XCONS (cons));
1166       cons = results;
1167       results = XCDR (results);
1168       free_cons (XCONS (cons));
1169     }
1170   return symbols;
1171 }
1172
1173 static void
1174 xpm_free (XpmAttributes *xpmattrs)
1175 {
1176   /* Could conceivably lose if XpmXXX returned an error without first
1177      initializing this structure, if we didn't know that initializing it
1178      to all zeros was ok (and also that it's ok to call XpmFreeAttributes()
1179      multiple times, since it zeros slots as it frees them...) */
1180   XpmFreeAttributes (xpmattrs);
1181 }
1182
1183 static void
1184 x_xpm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1185                                    Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1186                                    int dest_mask, Lisp_Object domain)
1187 {
1188   /* This function can GC */
1189   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1190   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1191   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1192   Display *dpy;
1193   Screen *xs;
1194   Colormap cmap;
1195   int depth;
1196   Visual *visual;
1197   Pixmap pixmap;
1198   Pixmap mask = 0;
1199   XpmAttributes xpmattrs;
1200   int result;
1201   XpmColorSymbol *color_symbols;
1202   Lisp_Object color_symbol_alist = find_keyword_in_vector (instantiator,
1203                                                            Q_color_symbols);
1204   enum image_instance_type type;
1205   int force_mono;
1206   unsigned int w, h;
1207
1208   if (!DEVICE_X_P (XDEVICE (device)))
1209     signal_simple_error ("Not an X device", device);
1210
1211   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1212   xs = DefaultScreenOfDisplay (dpy);
1213
1214   if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
1215     type = IMAGE_COLOR_PIXMAP;
1216   else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
1217     type = IMAGE_MONO_PIXMAP;
1218   else if (dest_mask & IMAGE_POINTER_MASK)
1219     type = IMAGE_POINTER;
1220   else
1221     incompatible_image_types (instantiator, dest_mask,
1222                               IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
1223                               | IMAGE_POINTER_MASK);
1224   force_mono = (type != IMAGE_COLOR_PIXMAP);
1225
1226 #if 1
1227   /* Although I haven't found it documented yet, it appears that pointers are
1228      always colored via the default window colormap... Sigh. */
1229   if (type == IMAGE_POINTER)
1230     {
1231       cmap = DefaultColormap(dpy, DefaultScreen(dpy));
1232       depth = DefaultDepthOfScreen (xs);
1233       visual = DefaultVisualOfScreen (xs);
1234     }
1235   else
1236     {
1237       cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1238       depth = DEVICE_X_DEPTH (XDEVICE(device));
1239       visual = DEVICE_X_VISUAL (XDEVICE(device));
1240     }
1241 #else
1242   cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1243   depth = DEVICE_X_DEPTH (XDEVICE(device));
1244   visual = DEVICE_X_VISUAL (XDEVICE(device));
1245 #endif
1246
1247   x_initialize_pixmap_image_instance (ii, type);
1248
1249   assert (!NILP (data));
1250
1251  retry:
1252
1253   xzero (xpmattrs); /* want XpmInitAttributes() */
1254   xpmattrs.valuemask = XpmReturnPixels;
1255   if (force_mono)
1256     {
1257       /* Without this, we get a 1-bit version of the color image, which
1258          isn't quite right.  With this, we get the mono image, which might
1259          be very different looking. */
1260       xpmattrs.valuemask |= XpmColorKey;
1261       xpmattrs.color_key = XPM_MONO;
1262       xpmattrs.depth = 1;
1263       xpmattrs.valuemask |= XpmDepth;
1264     }
1265   else
1266     {
1267       xpmattrs.closeness = 65535;
1268       xpmattrs.valuemask |= XpmCloseness;
1269       xpmattrs.depth = depth;
1270       xpmattrs.valuemask |= XpmDepth;
1271       xpmattrs.visual = visual;
1272       xpmattrs.valuemask |= XpmVisual;
1273       xpmattrs.colormap = cmap;
1274       xpmattrs.valuemask |= XpmColormap;
1275     }
1276
1277   color_symbols = extract_xpm_color_names (&xpmattrs, device, domain,
1278                                            color_symbol_alist);
1279
1280   result = XpmCreatePixmapFromBuffer (dpy,
1281                                       XtWindow(DEVICE_XT_APP_SHELL (XDEVICE(device))),
1282                                       (char *) XSTRING_DATA (data),
1283                                       &pixmap, &mask, &xpmattrs);
1284
1285   if (color_symbols)
1286     {
1287       xfree (color_symbols);
1288       xpmattrs.colorsymbols = 0; /* in case XpmFreeAttr is too smart... */
1289       xpmattrs.numsymbols = 0;
1290     }
1291
1292   switch (result)
1293     {
1294     case XpmSuccess:
1295       break;
1296     case XpmFileInvalid:
1297       {
1298         xpm_free (&xpmattrs);
1299         signal_image_error ("invalid XPM data", data);
1300       }
1301     case XpmColorFailed:
1302     case XpmColorError:
1303       {
1304         xpm_free (&xpmattrs);
1305         if (force_mono)
1306           {
1307             /* second time; blow out. */
1308             signal_double_file_error ("Reading pixmap data",
1309                                       "color allocation failed",
1310                                       data);
1311           }
1312         else
1313           {
1314             if (! (dest_mask & IMAGE_MONO_PIXMAP_MASK))
1315               {
1316                 /* second time; blow out. */
1317                 signal_double_file_error ("Reading pixmap data",
1318                                           "color allocation failed",
1319                                           data);
1320               }
1321             force_mono = 1;
1322             IMAGE_INSTANCE_TYPE (ii) = IMAGE_MONO_PIXMAP;
1323             goto retry;
1324           }
1325       }
1326     case XpmNoMemory:
1327       {
1328         xpm_free (&xpmattrs);
1329         signal_double_file_error ("Parsing pixmap data",
1330                                   "out of memory", data);
1331       }
1332     default:
1333       {
1334         xpm_free (&xpmattrs);
1335         signal_double_file_error_2 ("Parsing pixmap data",
1336                                     "unknown error code",
1337                                     make_int (result), data);
1338       }
1339     }
1340
1341   w = xpmattrs.width;
1342   h = xpmattrs.height;
1343
1344   {
1345     int npixels = xpmattrs.npixels;
1346     Pixel *pixels;
1347
1348     if (npixels != 0)
1349       {
1350         pixels = xnew_array (Pixel, npixels);
1351         memcpy (pixels, xpmattrs.pixels, npixels * sizeof (Pixel));
1352       }
1353     else
1354       pixels = NULL;
1355
1356     IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
1357     IMAGE_INSTANCE_X_MASK (ii) = mask;
1358     IMAGE_INSTANCE_X_COLORMAP (ii) = cmap;
1359     IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
1360     IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
1361     IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = w;
1362     IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = h;
1363     IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
1364       find_keyword_in_vector (instantiator, Q_file);
1365   }
1366
1367   switch (type)
1368     {
1369     case IMAGE_MONO_PIXMAP:
1370       break;
1371
1372     case IMAGE_COLOR_PIXMAP:
1373       {
1374         IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = depth;
1375       }
1376       break;
1377
1378     case IMAGE_POINTER:
1379       {
1380         int npixels = xpmattrs.npixels;
1381         Pixel *pixels = xpmattrs.pixels;
1382         XColor fg, bg;
1383         int i;
1384         int xhot = 0, yhot = 0;
1385
1386         if (xpmattrs.valuemask & XpmHotspot)
1387           {
1388             xhot = xpmattrs.x_hotspot;
1389             XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii), xpmattrs.x_hotspot);
1390           }
1391         if (xpmattrs.valuemask & XpmHotspot)
1392           {
1393             yhot = xpmattrs.y_hotspot;
1394             XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii), xpmattrs.y_hotspot);
1395           }
1396         check_pointer_sizes (xs, w, h, instantiator);
1397
1398         /* If the loaded pixmap has colors allocated (meaning it came from an
1399            XPM file), then use those as the default colors for the cursor we
1400            create.  Otherwise, default to pointer_fg and pointer_bg.
1401            */
1402         if (npixels >= 2)
1403           {
1404             /* With an XBM file, it's obvious which bit is foreground
1405                and which is background, or rather, it's implicit: in
1406                an XBM file, a 1 bit is foreground, and a 0 bit is
1407                background.
1408
1409                XCreatePixmapCursor() assumes this property of the
1410                pixmap it is called with as well; the `foreground'
1411                color argument is used for the 1 bits.
1412
1413                With an XPM file, it's tricker, since the elements of
1414                the pixmap don't represent FG and BG, but are actual
1415                pixel values.  So we need to figure out which of those
1416                pixels is the foreground color and which is the
1417                background.  We do it by comparing RGB and assuming
1418                that the darker color is the foreground.  This works
1419                with the result of xbmtopbm|ppmtoxpm, at least.
1420
1421                It might be nice if there was some way to tag the
1422                colors in the XPM file with whether they are the
1423                foreground - perhaps with logical color names somehow?
1424
1425                Once we have decided which color is the foreground, we
1426                need to ensure that that color corresponds to a `1' bit
1427                in the Pixmap.  The XPM library wrote into the (1-bit)
1428                pixmap with XPutPixel, which will ignore all but the
1429                least significant bit.
1430
1431                This means that a 1 bit in the image corresponds to
1432                `fg' only if `fg.pixel' is odd.
1433
1434                (This also means that the image will be all the same
1435                color if both `fg' and `bg' are odd or even, but we can
1436                safely assume that that won't happen if the XPM file is
1437                sensible I think.)
1438
1439                The desired result is that the image use `1' to
1440                represent the foreground color, and `0' to represent
1441                the background color.  So, we may need to invert the
1442                image to accomplish this; we invert if fg is
1443                odd. (Remember that WhitePixel and BlackPixel are not
1444                necessarily 1 and 0 respectively, though I think it
1445                might be safe to assume that one of them is always 1
1446                and the other is always 0.  We also pretty much need to
1447                assume that one is even and the other is odd.)
1448                */
1449
1450             fg.pixel = pixels[0];       /* pick a pixel at random. */
1451             bg.pixel = fg.pixel;
1452             for (i = 1; i < npixels; i++) /* Look for an "other" pixel value.*/
1453               {
1454                 bg.pixel = pixels[i];
1455                 if (fg.pixel != bg.pixel)
1456                   break;
1457               }
1458
1459             /* If (fg.pixel == bg.pixel) then probably something has
1460                gone wrong, but I don't think signalling an error would
1461                be appropriate. */
1462
1463             XQueryColor (dpy, cmap, &fg);
1464             XQueryColor (dpy, cmap, &bg);
1465
1466             /* If the foreground is lighter than the background, swap them.
1467                (This occurs semi-randomly, depending on the ordering of the
1468                color list in the XPM file.)
1469                */
1470             {
1471               unsigned short fg_total = ((fg.red / 3) + (fg.green / 3)
1472                                          + (fg.blue / 3));
1473               unsigned short bg_total = ((bg.red / 3) + (bg.green / 3)
1474                                          + (bg.blue / 3));
1475               if (fg_total > bg_total)
1476                 {
1477                   XColor swap;
1478                   swap = fg;
1479                   fg = bg;
1480                   bg = swap;
1481                 }
1482             }
1483
1484             /* If the fg pixel corresponds to a `0' in the bitmap, invert it.
1485                (This occurs (only?) on servers with Black=0, White=1.)
1486                */
1487             if ((fg.pixel & 1) == 0)
1488               {
1489                 XGCValues gcv;
1490                 GC gc;
1491                 gcv.function = GXxor;
1492                 gcv.foreground = 1;
1493                 gc = XCreateGC (dpy, pixmap, (GCFunction | GCForeground),
1494                                 &gcv);
1495                 XFillRectangle (dpy, pixmap, gc, 0, 0, w, h);
1496                 XFreeGC (dpy, gc);
1497               }
1498           }
1499         else
1500           {
1501             generate_cursor_fg_bg (device, &pointer_fg, &pointer_bg,
1502                                    &fg, &bg);
1503             IMAGE_INSTANCE_PIXMAP_FG (ii) = pointer_fg;
1504             IMAGE_INSTANCE_PIXMAP_BG (ii) = pointer_bg;
1505           }
1506
1507         IMAGE_INSTANCE_X_CURSOR (ii) =
1508           XCreatePixmapCursor
1509             (dpy, pixmap, mask, &fg, &bg, xhot, yhot);
1510       }
1511
1512       break;
1513
1514     default:
1515       abort ();
1516     }
1517
1518   xpm_free (&xpmattrs); /* after we've read pixels and hotspot */
1519 }
1520
1521 #endif /* HAVE_XPM */
1522
1523 \f
1524 #ifdef HAVE_XFACE
1525
1526 /**********************************************************************
1527  *                             X-Face                                 *
1528  **********************************************************************/
1529 #if defined(EXTERN)
1530 /* This is about to get redefined! */
1531 #undef EXTERN
1532 #endif
1533 /* We have to define SYSV32 so that compface.h includes string.h
1534    instead of strings.h. */
1535 #define SYSV32
1536 #ifdef __cplusplus
1537 extern "C" {
1538 #endif
1539 #include <compface.h>
1540 #ifdef __cplusplus
1541 }
1542 #endif
1543 /* JMP_BUF cannot be used here because if it doesn't get defined
1544    to jmp_buf we end up with a conflicting type error with the
1545    definition in compface.h */
1546 extern jmp_buf comp_env;
1547 #undef SYSV32
1548
1549 static void
1550 x_xface_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1551                      Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1552                      int dest_mask, Lisp_Object domain)
1553 {
1554   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1555   int i, stattis;
1556   char *p, *bits, *bp;
1557   CONST char * volatile emsg = 0;
1558   CONST char * volatile dstring;
1559
1560   assert (!NILP (data));
1561
1562   GET_C_STRING_BINARY_DATA_ALLOCA (data, dstring);
1563
1564   if ((p = strchr (dstring, ':')))
1565     {
1566       dstring = p + 1;
1567     }
1568
1569   /* Must use setjmp not SETJMP because we used jmp_buf above not JMP_BUF */
1570   if (!(stattis = setjmp (comp_env)))
1571     {
1572       UnCompAll ((char *) dstring);
1573       UnGenFace ();
1574     }
1575
1576   switch (stattis)
1577     {
1578     case -2:
1579       emsg = "uncompface: internal error";
1580       break;
1581     case -1:
1582       emsg = "uncompface: insufficient or invalid data";
1583       break;
1584     case 1:
1585       emsg = "uncompface: excess data ignored";
1586       break;
1587     }
1588
1589   if (emsg)
1590     signal_simple_error_2 (emsg, data, Qimage);
1591
1592   bp = bits = (char *) alloca (PIXELS / 8);
1593
1594   /* the compface library exports char F[], which uses a single byte per
1595      pixel to represent a 48x48 bitmap.  Yuck. */
1596   for (i = 0, p = F; i < (PIXELS / 8); ++i)
1597     {
1598       int n, b;
1599       /* reverse the bit order of each byte... */
1600       for (b = n = 0; b < 8; ++b)
1601         {
1602           n |= ((*p++) << b);
1603         }
1604       *bp++ = (char) n;
1605     }
1606
1607   xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1608                      pointer_bg, dest_mask, 48, 48, bits);
1609 }
1610
1611 #endif /* HAVE_XFACE */
1612
1613 \f
1614 /**********************************************************************
1615  *                       Autodetect                                      *
1616  **********************************************************************/
1617
1618 static void
1619 autodetect_validate (Lisp_Object instantiator)
1620 {
1621   data_must_be_present (instantiator);
1622 }
1623
1624 static Lisp_Object
1625 autodetect_normalize (Lisp_Object instantiator,
1626                                 Lisp_Object console_type)
1627 {
1628   Lisp_Object file = find_keyword_in_vector (instantiator, Q_data);
1629   Lisp_Object filename = Qnil;
1630   Lisp_Object data = Qnil;
1631   struct gcpro gcpro1, gcpro2, gcpro3;
1632   Lisp_Object alist = Qnil;
1633
1634   GCPRO3 (filename, data, alist);
1635
1636   if (NILP (file)) /* no conversion necessary */
1637     RETURN_UNGCPRO (instantiator);
1638
1639   alist = tagged_vector_to_alist (instantiator);
1640
1641   filename = locate_pixmap_file (file);
1642   if (!NILP (filename))
1643     {
1644       int xhot, yhot;
1645       /* #### Apparently some versions of XpmReadFileToData, which is
1646          called by pixmap_to_lisp_data, don't return an error value
1647          if the given file is not a valid XPM file.  Instead, they
1648          just seg fault.  It is definitely caused by passing a
1649          bitmap.  To try and avoid this we check for bitmaps first.  */
1650
1651       data = bitmap_to_lisp_data (filename, &xhot, &yhot, 1);
1652
1653       if (!EQ (data, Qt))
1654         {
1655           alist = remassq_no_quit (Q_data, alist);
1656           alist = Fcons (Fcons (Q_file, filename),
1657                          Fcons (Fcons (Q_data, data), alist));
1658           if (xhot != -1)
1659             alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
1660                            alist);
1661           if (yhot != -1)
1662             alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
1663                            alist);
1664
1665           alist = xbm_mask_file_munging (alist, filename, Qnil, console_type);
1666
1667           {
1668             Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
1669             free_alist (alist);
1670             RETURN_UNGCPRO (result);
1671           }
1672         }
1673
1674 #ifdef HAVE_XPM
1675       data = pixmap_to_lisp_data (filename, 1);
1676
1677       if (!EQ (data, Qt))
1678         {
1679           alist = remassq_no_quit (Q_data, alist);
1680           alist = Fcons (Fcons (Q_file, filename),
1681                          Fcons (Fcons (Q_data, data), alist));
1682           alist = Fcons (Fcons (Q_color_symbols,
1683                                 evaluate_xpm_color_symbols ()),
1684                          alist);
1685           {
1686             Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
1687             free_alist (alist);
1688             RETURN_UNGCPRO (result);
1689           }
1690         }
1691 #endif
1692     }
1693
1694   /* If we couldn't convert it, just put it back as it is.
1695      We might try to further frob it later as a cursor-font
1696      specification. (We can't do that now because we don't know
1697      what dest-types it's going to be instantiated into.) */
1698   {
1699     Lisp_Object result = alist_to_tagged_vector (Qautodetect, alist);
1700     free_alist (alist);
1701     RETURN_UNGCPRO (result);
1702   }
1703 }
1704
1705 static int
1706 autodetect_possible_dest_types (void)
1707 {
1708   return
1709     IMAGE_MONO_PIXMAP_MASK  |
1710     IMAGE_COLOR_PIXMAP_MASK |
1711     IMAGE_POINTER_MASK      |
1712     IMAGE_TEXT_MASK;
1713 }
1714
1715 static void
1716 autodetect_instantiate (Lisp_Object image_instance,
1717                                   Lisp_Object instantiator,
1718                                   Lisp_Object pointer_fg,
1719                                   Lisp_Object pointer_bg,
1720                                   int dest_mask, Lisp_Object domain)
1721 {
1722   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1723   struct gcpro gcpro1, gcpro2, gcpro3;
1724   Lisp_Object alist = Qnil;
1725   Lisp_Object result = Qnil;
1726   int is_cursor_font = 0;
1727
1728   GCPRO3 (data, alist, result);
1729
1730   alist = tagged_vector_to_alist (instantiator);
1731   if (dest_mask & IMAGE_POINTER_MASK)
1732     {
1733       CONST char *name_ext;
1734       GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext);
1735       if (XmuCursorNameToIndex (name_ext) != -1)
1736         {
1737           result = alist_to_tagged_vector (Qcursor_font, alist);
1738           is_cursor_font = 1;
1739         }
1740     }
1741
1742   if (!is_cursor_font)
1743     result = alist_to_tagged_vector (Qstring, alist);
1744   free_alist (alist);
1745
1746   if (is_cursor_font)
1747     cursor_font_instantiate (image_instance, result, pointer_fg,
1748                              pointer_bg, dest_mask, domain);
1749   else
1750     string_instantiate (image_instance, result, pointer_fg,
1751                         pointer_bg, dest_mask, domain);
1752
1753   UNGCPRO;
1754 }
1755
1756 \f
1757 /**********************************************************************
1758  *                              Font                                  *
1759  **********************************************************************/
1760
1761 static void
1762 font_validate (Lisp_Object instantiator)
1763 {
1764   data_must_be_present (instantiator);
1765 }
1766
1767 /* XmuCvtStringToCursor is bogus in the following ways:
1768
1769    - When it can't convert the given string to a real cursor, it will
1770      sometimes return a "success" value, after triggering a BadPixmap
1771      error.  It then gives you a cursor that will itself generate BadCursor
1772      errors.  So we install this error handler to catch/notice the X error
1773      and take that as meaning "couldn't convert."
1774
1775    - When you tell it to find a cursor file that doesn't exist, it prints
1776      an error message on stderr.  You can't make it not do that.
1777
1778    - Also, using Xmu means we can't properly hack Lisp_Image_Instance
1779      objects, or XPM files, or $XBMLANGPATH.
1780  */
1781
1782 /* Duplicate the behavior of XmuCvtStringToCursor() to bypass its bogusness. */
1783
1784 static int XLoadFont_got_error;
1785
1786 static int
1787 XLoadFont_error_handler (Display *dpy, XErrorEvent *xerror)
1788 {
1789   XLoadFont_got_error = 1;
1790   return 0;
1791 }
1792
1793 static Font
1794 safe_XLoadFont (Display *dpy, char *name)
1795 {
1796   Font font;
1797   int (*old_handler) (Display *, XErrorEvent *);
1798   XLoadFont_got_error = 0;
1799   XSync (dpy, 0);
1800   old_handler = XSetErrorHandler (XLoadFont_error_handler);
1801   font = XLoadFont (dpy, name);
1802   XSync (dpy, 0);
1803   XSetErrorHandler (old_handler);
1804   if (XLoadFont_got_error) return 0;
1805   return font;
1806 }
1807
1808 static int
1809 font_possible_dest_types (void)
1810 {
1811   return IMAGE_POINTER_MASK;
1812 }
1813
1814 static void
1815 font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1816                   Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1817                   int dest_mask, Lisp_Object domain)
1818 {
1819   /* This function can GC */
1820   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1821   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1822   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1823   Display *dpy;
1824   XColor fg, bg;
1825   Font source, mask;
1826   char source_name[MAXPATHLEN], mask_name[MAXPATHLEN], dummy;
1827   int source_char, mask_char;
1828   int count;
1829   Lisp_Object foreground, background;
1830
1831   if (!DEVICE_X_P (XDEVICE (device)))
1832     signal_simple_error ("Not an X device", device);
1833
1834   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1835
1836   if (!STRINGP (data) ||
1837       strncmp ("FONT ", (char *) XSTRING_DATA (data), 5))
1838     signal_simple_error ("Invalid font-glyph instantiator",
1839                          instantiator);
1840
1841   if (!(dest_mask & IMAGE_POINTER_MASK))
1842     incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
1843
1844   foreground = find_keyword_in_vector (instantiator, Q_foreground);
1845   if (NILP (foreground))
1846     foreground = pointer_fg;
1847   background = find_keyword_in_vector (instantiator, Q_background);
1848   if (NILP (background))
1849     background = pointer_bg;
1850
1851   generate_cursor_fg_bg (device, &foreground, &background, &fg, &bg);
1852
1853   count = sscanf ((char *) XSTRING_DATA (data),
1854                   "FONT %s %d %s %d %c",
1855                   source_name, &source_char,
1856                   mask_name, &mask_char, &dummy);
1857   /* Allow "%s %d %d" as well... */
1858   if (count == 3 && (1 == sscanf (mask_name, "%d %c", &mask_char, &dummy)))
1859     count = 4, mask_name[0] = 0;
1860
1861   if (count != 2 && count != 4)
1862     signal_simple_error ("invalid cursor specification", data);
1863   source = safe_XLoadFont (dpy, source_name);
1864   if (! source)
1865     signal_simple_error_2 ("couldn't load font",
1866                            build_string (source_name),
1867                            data);
1868   if (count == 2)
1869     mask = 0;
1870   else if (!mask_name[0])
1871     mask = source;
1872   else
1873     {
1874       mask = safe_XLoadFont (dpy, mask_name);
1875       if (!mask)
1876         /* continuable */
1877         Fsignal (Qerror, list3 (build_string ("couldn't load font"),
1878                                 build_string (mask_name), data));
1879     }
1880   if (!mask)
1881     mask_char = 0;
1882
1883   /* #### call XQueryTextExtents() and check_pointer_sizes() here. */
1884
1885   x_initialize_pixmap_image_instance (ii, IMAGE_POINTER);
1886   IMAGE_INSTANCE_X_CURSOR (ii) =
1887     XCreateGlyphCursor (dpy, source, mask, source_char, mask_char,
1888                         &fg, &bg);
1889   XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
1890   XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
1891   XUnloadFont (dpy, source);
1892   if (mask && mask != source) XUnloadFont (dpy, mask);
1893 }
1894
1895 \f
1896 /**********************************************************************
1897  *                           Cursor-Font                              *
1898  **********************************************************************/
1899
1900 static void
1901 cursor_font_validate (Lisp_Object instantiator)
1902 {
1903   data_must_be_present (instantiator);
1904 }
1905
1906 static int
1907 cursor_font_possible_dest_types (void)
1908 {
1909   return IMAGE_POINTER_MASK;
1910 }
1911
1912 static void
1913 cursor_font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1914                          Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1915                          int dest_mask, Lisp_Object domain)
1916 {
1917   /* This function can GC */
1918   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1919   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1920   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1921   Display *dpy;
1922   int i;
1923   CONST char *name_ext;
1924   Lisp_Object foreground, background;
1925
1926   if (!DEVICE_X_P (XDEVICE (device)))
1927     signal_simple_error ("Not an X device", device);
1928
1929   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1930
1931   if (!(dest_mask & IMAGE_POINTER_MASK))
1932     incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
1933
1934   GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext);
1935   if ((i = XmuCursorNameToIndex (name_ext)) == -1)
1936     signal_simple_error ("Unrecognized cursor-font name", data);
1937
1938   x_initialize_pixmap_image_instance (ii, IMAGE_POINTER);
1939   IMAGE_INSTANCE_X_CURSOR (ii) = XCreateFontCursor (dpy, i);
1940   foreground = find_keyword_in_vector (instantiator, Q_foreground);
1941   if (NILP (foreground))
1942     foreground = pointer_fg;
1943   background = find_keyword_in_vector (instantiator, Q_background);
1944   if (NILP (background))
1945     background = pointer_bg;
1946   maybe_recolor_cursor (image_instance, foreground, background);
1947 }
1948
1949 static int
1950 x_colorize_image_instance (Lisp_Object image_instance,
1951                            Lisp_Object foreground, Lisp_Object background)
1952 {
1953   struct Lisp_Image_Instance *p;
1954
1955   p = XIMAGE_INSTANCE (image_instance);
1956
1957   switch (IMAGE_INSTANCE_TYPE (p))
1958     {
1959     case IMAGE_MONO_PIXMAP:
1960       IMAGE_INSTANCE_TYPE (p) = IMAGE_COLOR_PIXMAP;
1961       /* Make sure there aren't two pointers to the same mask, causing
1962          it to get freed twice. */
1963       IMAGE_INSTANCE_X_MASK (p) = 0;
1964       break;
1965
1966     default:
1967       return 0;
1968     }
1969
1970   {
1971     Display *dpy = DEVICE_X_DISPLAY (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
1972     Drawable draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (IMAGE_INSTANCE_DEVICE (p))));
1973     Dimension d = DEVICE_X_DEPTH (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
1974     Pixmap new = XCreatePixmap (dpy, draw,
1975                                 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
1976                                 IMAGE_INSTANCE_PIXMAP_HEIGHT (p), d);
1977     XColor color;
1978     XGCValues gcv;
1979     GC gc;
1980     color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground));
1981     gcv.foreground = color.pixel;
1982     color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background));
1983     gcv.background = color.pixel;
1984     gc = XCreateGC (dpy, new, GCBackground|GCForeground, &gcv);
1985     XCopyPlane (dpy, IMAGE_INSTANCE_X_PIXMAP (p), new, gc, 0, 0,
1986                 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
1987                 IMAGE_INSTANCE_PIXMAP_HEIGHT (p),
1988                 0, 0, 1);
1989     XFreeGC (dpy, gc);
1990     IMAGE_INSTANCE_X_PIXMAP (p) = new;
1991     IMAGE_INSTANCE_PIXMAP_DEPTH (p) = d;
1992     IMAGE_INSTANCE_PIXMAP_FG (p) = foreground;
1993     IMAGE_INSTANCE_PIXMAP_BG (p) = background;
1994     return 1;
1995   }
1996 }
1997
1998 \f
1999 /************************************************************************/
2000 /*                      subwindow and widget support                      */
2001 /************************************************************************/
2002
2003 /* unmap the image if it is a widget. This is used by redisplay via
2004    redisplay_unmap_subwindows */
2005 static void
2006 x_unmap_subwindow (struct Lisp_Image_Instance *p)
2007 {
2008   if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
2009     {
2010       XUnmapWindow 
2011         (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (p)), 
2012          IMAGE_INSTANCE_X_SUBWINDOW_ID (p));
2013     }
2014   else                          /* must be a widget */
2015     {
2016       XtUnmapWidget (IMAGE_INSTANCE_X_WIDGET_ID (p));
2017     }
2018 }
2019
2020 /* map the subwindow. This is used by redisplay via
2021    redisplay_output_subwindow */
2022 static void
2023 x_map_subwindow (struct Lisp_Image_Instance *p, int x, int y)
2024 {
2025   if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
2026     {
2027       Window subwindow = IMAGE_INSTANCE_X_SUBWINDOW_ID (p);
2028       Screen* screen = IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (p);
2029       XMapWindow (DisplayOfScreen (screen), subwindow);
2030       XMoveWindow (DisplayOfScreen (screen), subwindow, x, y);
2031     }
2032   else                          /* must be a widget */
2033     {
2034       XtMoveWidget (IMAGE_INSTANCE_X_WIDGET_ID (p), 
2035                     x + IMAGE_INSTANCE_X_WIDGET_XOFFSET (p),
2036                     y + IMAGE_INSTANCE_X_WIDGET_YOFFSET (p));
2037       XtMapWidget (IMAGE_INSTANCE_X_WIDGET_ID (p));
2038     }
2039 }
2040
2041 /* when you click on a widget you may activate another widget this
2042    needs to be checked and all appropriate widgets updated */
2043 static void
2044 x_update_subwindow (struct Lisp_Image_Instance *p)
2045 {
2046   if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET)
2047     {
2048       widget_value* wv = xmalloc_widget_value ();
2049       button_item_to_widget_value (IMAGE_INSTANCE_WIDGET_SINGLE_ITEM (p),
2050                                    wv, 1, 1);
2051       lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (p), 
2052                              wv, 1);
2053     }
2054 }
2055
2056 /* instantiate and x type subwindow */
2057 static void
2058 x_subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2059                         Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2060                         int dest_mask, Lisp_Object domain)
2061 {
2062   /* This function can GC */
2063   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2064   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
2065   Lisp_Object frame = FW_FRAME (domain);
2066   struct frame* f = XFRAME (frame);
2067   Display *dpy;
2068   Screen *xs;
2069   Window pw, win;
2070   XSetWindowAttributes xswa;
2071   Mask valueMask = 0;
2072   unsigned int w = IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii), 
2073     h = IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii);
2074
2075   if (!DEVICE_X_P (XDEVICE (device)))
2076     signal_simple_error ("Not an X device", device);
2077
2078   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2079   xs = DefaultScreenOfDisplay (dpy);
2080
2081   IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW;
2082
2083   pw = XtWindow (FRAME_X_TEXT_WIDGET (f));
2084
2085   ii->data = xnew_and_zero (struct x_subwindow_data);
2086
2087   IMAGE_INSTANCE_X_SUBWINDOW_PARENT (ii) = pw;
2088   IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (ii) = xs;
2089
2090   xswa.backing_store = Always;
2091   valueMask |= CWBackingStore;
2092   xswa.colormap = DefaultColormapOfScreen (xs);
2093   valueMask |= CWColormap;
2094   
2095   win = XCreateWindow (dpy, pw, 0, 0, w, h, 0, CopyFromParent,
2096                        InputOutput, CopyFromParent, valueMask,
2097                        &xswa);
2098   
2099   IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)win;
2100 }
2101
2102 #if 0
2103 /* #### Should this function exist? If there's any doubt I'm not implementing it --andyp */
2104 DEFUN ("change-subwindow-property", Fchange_subwindow_property, 3, 3, 0, /*
2105 For the given SUBWINDOW, set PROPERTY to DATA, which is a string.
2106 Subwindows are not currently implemented.
2107 */
2108        (subwindow, property, data))
2109 {
2110   Atom property_atom;
2111   struct Lisp_Subwindow *sw;
2112   Display *dpy;
2113
2114   CHECK_SUBWINDOW (subwindow);
2115   CHECK_STRING (property);
2116   CHECK_STRING (data);
2117
2118   sw = XSUBWINDOW (subwindow);
2119   dpy = DisplayOfScreen (LISP_DEVICE_TO_X_SCREEN
2120                          (FRAME_DEVICE (XFRAME (sw->frame))));
2121
2122   property_atom = XInternAtom (dpy, (char *) XSTRING_DATA (property), False);
2123   XChangeProperty (dpy, sw->subwindow, property_atom, XA_STRING, 8,
2124                    PropModeReplace,
2125                    XSTRING_DATA   (data),
2126                    XSTRING_LENGTH (data));
2127
2128   return property;
2129 }
2130 #endif
2131
2132 static void 
2133 x_resize_subwindow (struct Lisp_Image_Instance* ii, int w, int h)
2134 {
2135   XResizeWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (ii)),
2136                  IMAGE_INSTANCE_X_SUBWINDOW_ID (ii),
2137                  w, h);
2138 }
2139
2140 /************************************************************************/
2141 /*                            widgets                            */
2142 /************************************************************************/
2143
2144 static void
2145 x_widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2146                       Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2147                       int dest_mask, Lisp_Object domain,
2148                       CONST char* type, widget_value* wv)
2149 {
2150   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2151   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii), pixel;
2152   struct device* d = XDEVICE (device);
2153   Lisp_Object frame = FW_FRAME (domain);
2154   struct frame* f = XFRAME (frame);
2155   XColor fcolor, bcolor;
2156   Extbyte* nm=0;
2157   Widget wid;
2158   Arg al [32];
2159   int ac = 0;
2160   int id = new_lwlib_id ();
2161
2162   if (!DEVICE_X_P (d))
2163     signal_simple_error ("Not an mswindows device", device);
2164
2165   /* have to set the type this late in case there is no device
2166      instantiation for a widget. But we can go ahead and do it without
2167      checking because there is always a generic instantiator. */
2168   IMAGE_INSTANCE_TYPE (ii) = IMAGE_WIDGET;
2169
2170   if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
2171     GET_C_STRING_OS_DATA_ALLOCA (IMAGE_INSTANCE_WIDGET_TEXT (ii), nm);
2172
2173   ii->data = xnew_and_zero (struct x_subwindow_data);
2174
2175   /* copy any args we were given */
2176   if (wv->nargs)
2177     lw_add_value_args_to_args (wv, al, &ac);
2178
2179   /* add our own arguments */
2180   pixel = FACE_FOREGROUND 
2181     (IMAGE_INSTANCE_WIDGET_FACE (ii),
2182      IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2183   fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2184   pixel = FACE_BACKGROUND
2185     (IMAGE_INSTANCE_WIDGET_FACE (ii),
2186      IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2187   bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2188
2189   XtSetArg (al [ac], XtNbackground, bcolor.pixel);              ac++;
2190   XtSetArg (al [ac], XtNforeground, fcolor.pixel);              ac++;
2191   XtSetArg (al [ac], XtNfont, (void*)FONT_INSTANCE_X_FONT 
2192             (XFONT_INSTANCE (widget_face_font_info 
2193                              (domain, 
2194                               IMAGE_INSTANCE_WIDGET_FACE (ii),
2195                               0, 0))));                 ac++;
2196
2197   wv->nargs = ac;
2198   wv->args = al;
2199   
2200   wid = lw_create_widget (type, wv->name, id, wv, FRAME_X_CONTAINER_WIDGET (f),
2201                           False, 0, popup_selection_callback, 0);
2202
2203   IMAGE_INSTANCE_X_WIDGET_LWID (ii) = id;
2204
2205   /* because the EmacsManager is the widgets parent we have to
2206      offset the redisplay of the widget by the amount the text
2207      widget is inside the manager. */
2208   ac = 0;
2209   XtSetArg (al [ac], XtNwidth, 
2210             (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii)); ac++;
2211   XtSetArg (al [ac], XtNheight, 
2212             (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); ac++;
2213   XtSetValues (wid, al, ac);
2214   /* finally get offsets in the frame */
2215   ac = 0;
2216   XtSetArg (al [ac], XtNx, &IMAGE_INSTANCE_X_WIDGET_XOFFSET (ii)); ac++;
2217   XtSetArg (al [ac], XtNy, &IMAGE_INSTANCE_X_WIDGET_YOFFSET (ii)); ac++;
2218   XtGetValues (FRAME_X_TEXT_WIDGET (f), al, ac);
2219
2220   IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)wid; 
2221
2222   free_widget_value (wv);
2223 }
2224
2225 static Lisp_Object
2226 x_widget_set_property (Lisp_Object image_instance, Lisp_Object prop,
2227                        Lisp_Object val)
2228 {
2229   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2230
2231   if (EQ (prop, Q_text))
2232     {
2233       Extbyte* str=0;
2234       widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2235       CHECK_STRING (val);
2236       GET_C_STRING_OS_DATA_ALLOCA (val, str);
2237       wv->value = str;
2238       lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, False);
2239       return Qt;
2240     }
2241   return Qunbound;
2242 }
2243
2244 /* get properties of a control */
2245 static Lisp_Object
2246 x_widget_property (Lisp_Object image_instance, Lisp_Object prop)
2247 {
2248   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2249   /* get the text from a control */
2250   if (EQ (prop, Q_text))
2251     {
2252       widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2253       return build_ext_string (wv->value, FORMAT_OS);
2254     }
2255   return Qunbound;
2256 }
2257
2258 /* Instantiate a button widget. Unfortunately instantiated widgets are
2259    particular to a frame since they need to have a parent. It's not
2260    like images where you just select the image into the context you
2261    want to display it in and BitBlt it. So images instances can have a
2262    many-to-one relationship with things you see, whereas widgets can
2263    only be one-to-one (i.e. per frame) */
2264 static void
2265 x_button_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2266                       Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2267                       int dest_mask, Lisp_Object domain)
2268 {
2269   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2270   Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2271   Lisp_Object glyph = find_keyword_in_vector (instantiator, Q_image);
2272   widget_value* wv = xmalloc_widget_value ();
2273
2274   button_item_to_widget_value (gui, wv, 1, 1);
2275
2276   if (!NILP (glyph))
2277     {
2278       if (!IMAGE_INSTANCEP (glyph))
2279         glyph = glyph_image_instance (glyph, domain, ERROR_ME, 1);
2280     }
2281
2282   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2283                         pointer_bg, dest_mask, domain, "button", wv);
2284
2285   /* add the image if one was given */
2286   if (!NILP (glyph) && IMAGE_INSTANCEP (glyph))
2287     {
2288       Arg al [2];
2289       int ac =0;
2290 #ifdef LWLIB_USES_MOTIF
2291       XtSetArg (al [ac], XmNlabelType, XmPIXMAP);       ac++;
2292       XtSetArg (al [ac], XmNlabelPixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph));ac++;
2293 #else
2294       XtSetArg (al [ac], XtNpixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph));  ac++;
2295 #endif
2296       XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, ac);
2297     }
2298 }
2299
2300 /* get properties of a button */
2301 static Lisp_Object
2302 x_button_property (Lisp_Object image_instance, Lisp_Object prop)
2303 {
2304   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2305   /* check the state of a button */
2306   if (EQ (prop, Q_selected))
2307     {
2308       widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2309
2310       if (wv->selected)
2311         return Qt;
2312       else
2313         return Qnil;
2314     }
2315   return Qunbound;
2316 }
2317
2318 /* instantiate a progress gauge */
2319 static void
2320 x_progress_gauge_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2321                         Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2322                         int dest_mask, Lisp_Object domain)
2323 {
2324   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2325   Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2326   widget_value* wv = xmalloc_widget_value ();
2327
2328   button_item_to_widget_value (gui, wv, 1, 1);
2329
2330   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2331                         pointer_bg, dest_mask, domain, "progress", wv);
2332 }
2333
2334 /* set the properties of a progres guage */
2335 static Lisp_Object
2336 x_progress_gauge_set_property (Lisp_Object image_instance, Lisp_Object prop,
2337                          Lisp_Object val)
2338 {
2339   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2340
2341   if (EQ (prop, Q_percent))
2342     {
2343       Arg al [1];
2344       CHECK_INT (val);
2345       XtSetArg (al[0], XtNvalue, XINT (val));
2346       XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 1);
2347       return Qt;
2348     }
2349   return Qunbound;
2350 }
2351
2352 /* instantiate an edit control */
2353 static void
2354 x_edit_field_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2355                     Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2356                     int dest_mask, Lisp_Object domain)
2357 {
2358   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2359   Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2360   widget_value* wv = xmalloc_widget_value ();
2361   
2362   button_item_to_widget_value (gui, wv, 1, 1);
2363   
2364   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2365                         pointer_bg, dest_mask, domain, "text-field", wv);
2366 }
2367
2368 /* instantiate a combo control */
2369 static void
2370 x_combo_box_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2371                      Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2372                      int dest_mask, Lisp_Object domain)
2373 {
2374   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2375   Lisp_Object rest;
2376   Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2377   widget_value* wv = xmalloc_widget_value ();
2378
2379   button_item_to_widget_value (gui, wv, 1, 1);
2380   
2381   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2382                         pointer_bg, dest_mask, domain, "combo-box", wv);
2383   /* add items to the combo box */
2384   LIST_LOOP (rest, Fplist_get (IMAGE_INSTANCE_WIDGET_PROPS (ii), Q_items, Qnil))
2385     {
2386 #if 0
2387       Extbyte* str;
2388       XmString xmstr;
2389       GET_C_STRING_OS_DATA_ALLOCA (XCAR (rest), str);
2390       xmstr = XmStringCreate (str, XmSTRING_DEFAULT_CHARSET);
2391       XmListAddItem (IMAGE_INSTANCE_X_WIDGET_ID (ii), xmstr, 0);
2392       XmStringFree (xmstr);
2393 #endif
2394     }
2395 }
2396
2397 \f
2398 /************************************************************************/
2399 /*                            initialization                            */
2400 /************************************************************************/
2401
2402 void
2403 syms_of_glyphs_x (void)
2404 {
2405 #if 0
2406   DEFSUBR (Fchange_subwindow_property);
2407 #endif
2408 }
2409
2410 void
2411 console_type_create_glyphs_x (void)
2412 {
2413   /* image methods */
2414
2415   CONSOLE_HAS_METHOD (x, print_image_instance);
2416   CONSOLE_HAS_METHOD (x, finalize_image_instance);
2417   CONSOLE_HAS_METHOD (x, image_instance_equal);
2418   CONSOLE_HAS_METHOD (x, image_instance_hash);
2419   CONSOLE_HAS_METHOD (x, colorize_image_instance);
2420   CONSOLE_HAS_METHOD (x, init_image_instance_from_eimage);
2421   CONSOLE_HAS_METHOD (x, locate_pixmap_file);
2422   CONSOLE_HAS_METHOD (x, unmap_subwindow);
2423   CONSOLE_HAS_METHOD (x, map_subwindow);
2424   CONSOLE_HAS_METHOD (x, resize_subwindow);
2425   CONSOLE_HAS_METHOD (x, update_subwindow);
2426 }
2427
2428 void
2429 image_instantiator_format_create_glyphs_x (void)
2430 {
2431   IIFORMAT_VALID_CONSOLE (x, nothing);
2432   IIFORMAT_VALID_CONSOLE (x, string);
2433   IIFORMAT_VALID_CONSOLE (x, formatted_string);
2434   IIFORMAT_VALID_CONSOLE (x, inherit);
2435 #ifdef HAVE_XPM
2436   INITIALIZE_DEVICE_IIFORMAT (x, xpm);
2437   IIFORMAT_HAS_DEVMETHOD (x, xpm, instantiate);
2438 #endif
2439 #ifdef HAVE_JPEG
2440   IIFORMAT_VALID_CONSOLE (x, jpeg);
2441 #endif
2442 #ifdef HAVE_TIFF
2443   IIFORMAT_VALID_CONSOLE (x, tiff);
2444 #endif  
2445 #ifdef HAVE_PNG
2446   IIFORMAT_VALID_CONSOLE (x, png);
2447 #endif  
2448 #ifdef HAVE_GIF
2449   IIFORMAT_VALID_CONSOLE (x, gif);
2450 #endif  
2451   INITIALIZE_DEVICE_IIFORMAT (x, xbm);
2452   IIFORMAT_HAS_DEVMETHOD (x, xbm, instantiate);
2453
2454   INITIALIZE_DEVICE_IIFORMAT (x, subwindow);
2455   IIFORMAT_HAS_DEVMETHOD (x, subwindow, instantiate);
2456
2457   /* button widget */
2458   INITIALIZE_DEVICE_IIFORMAT (x, button);
2459   IIFORMAT_HAS_DEVMETHOD (x, button, property);
2460   IIFORMAT_HAS_DEVMETHOD (x, button, instantiate);
2461
2462   INITIALIZE_DEVICE_IIFORMAT (x, widget);
2463   IIFORMAT_HAS_DEVMETHOD (x, widget, property);
2464   IIFORMAT_HAS_DEVMETHOD (x, widget, set_property);
2465   /* progress gauge */
2466   INITIALIZE_DEVICE_IIFORMAT (x, progress_gauge);
2467   IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, set_property);
2468   IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, instantiate);
2469   /* text field */
2470   INITIALIZE_DEVICE_IIFORMAT (x, edit_field);
2471   IIFORMAT_HAS_DEVMETHOD (x, edit_field, instantiate);
2472   /* combo box */
2473   INITIALIZE_DEVICE_IIFORMAT (x, combo_box);
2474   IIFORMAT_HAS_DEVMETHOD (x, combo_box, instantiate);
2475
2476   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (cursor_font, "cursor-font");
2477   IIFORMAT_VALID_CONSOLE (x, cursor_font);
2478
2479   IIFORMAT_HAS_METHOD (cursor_font, validate);
2480   IIFORMAT_HAS_METHOD (cursor_font, possible_dest_types);
2481   IIFORMAT_HAS_METHOD (cursor_font, instantiate);
2482
2483   IIFORMAT_VALID_KEYWORD (cursor_font, Q_data, check_valid_string);
2484   IIFORMAT_VALID_KEYWORD (cursor_font, Q_foreground, check_valid_string);
2485   IIFORMAT_VALID_KEYWORD (cursor_font, Q_background, check_valid_string);
2486
2487   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (font, "font");
2488
2489   IIFORMAT_HAS_METHOD (font, validate);
2490   IIFORMAT_HAS_METHOD (font, possible_dest_types);
2491   IIFORMAT_HAS_METHOD (font, instantiate);
2492   IIFORMAT_VALID_CONSOLE (x, font);
2493
2494   IIFORMAT_VALID_KEYWORD (font, Q_data, check_valid_string);
2495   IIFORMAT_VALID_KEYWORD (font, Q_foreground, check_valid_string);
2496   IIFORMAT_VALID_KEYWORD (font, Q_background, check_valid_string);
2497
2498 #ifdef HAVE_XFACE
2499   INITIALIZE_DEVICE_IIFORMAT (x, xface);
2500   IIFORMAT_HAS_DEVMETHOD (x, xface, instantiate);
2501 #endif
2502
2503   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (autodetect,
2504                                         "autodetect");
2505
2506   IIFORMAT_HAS_METHOD (autodetect, validate);
2507   IIFORMAT_HAS_METHOD (autodetect, normalize);
2508   IIFORMAT_HAS_METHOD (autodetect, possible_dest_types);
2509   IIFORMAT_HAS_METHOD (autodetect, instantiate);
2510   IIFORMAT_VALID_CONSOLE (x, autodetect);
2511
2512   IIFORMAT_VALID_KEYWORD (autodetect, Q_data, check_valid_string);
2513 }
2514
2515 void
2516 vars_of_glyphs_x (void)
2517 {
2518   DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path /*
2519 A list of the directories in which X bitmap files may be found.
2520 If nil, this is initialized from the "*bitmapFilePath" resource.
2521 This is used by the `make-image-instance' function (however, note that if
2522 the environment variable XBMLANGPATH is set, it is consulted first).
2523 */ );
2524   Vx_bitmap_file_path = Qnil;
2525 }
2526
2527 void
2528 complex_vars_of_glyphs_x (void)
2529 {
2530 #define BUILD_GLYPH_INST(variable, name)                        \
2531   Fadd_spec_to_specifier                                        \
2532     (GLYPH_IMAGE (XGLYPH (variable)),                           \
2533      vector3 (Qxbm, Q_data,                                     \
2534               list3 (make_int (name##_width),                   \
2535                      make_int (name##_height),                  \
2536                      make_ext_string (name##_bits,              \
2537                                       sizeof (name##_bits),     \
2538                                       FORMAT_BINARY))),         \
2539      Qglobal, Qx, Qnil)
2540
2541   BUILD_GLYPH_INST (Vtruncation_glyph, truncator);
2542   BUILD_GLYPH_INST (Vcontinuation_glyph, continuer);
2543   BUILD_GLYPH_INST (Vxemacs_logo, xemacs);
2544   BUILD_GLYPH_INST (Vhscroll_glyph, hscroll);
2545
2546 #undef BUILD_GLYPH_INST
2547 }