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