2b6d35079a9af726a3d35a5497c45f7430b26a86
[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 *p, *bits, *bp;
1674   const char * volatile emsg = 0;
1675   const char * volatile dstring;
1676
1677   assert (!NILP (data));
1678
1679   TO_EXTERNAL_FORMAT (LISP_STRING, data,
1680                       C_STRING_ALLOCA, dstring,
1681                       Qbinary);
1682
1683   if ((p = strchr (dstring, ':')))
1684     {
1685       dstring = p + 1;
1686     }
1687
1688   /* Must use setjmp not SETJMP because we used jmp_buf above not JMP_BUF */
1689   if (!(stattis = setjmp (comp_env)))
1690     {
1691       UnCompAll ((char *) dstring);
1692       UnGenFace ();
1693     }
1694
1695   switch (stattis)
1696     {
1697     case -2:
1698       emsg = "uncompface: internal error";
1699       break;
1700     case -1:
1701       emsg = "uncompface: insufficient or invalid data";
1702       break;
1703     case 1:
1704       emsg = "uncompface: excess data ignored";
1705       break;
1706     }
1707
1708   if (emsg)
1709     signal_simple_error_2 (emsg, data, Qimage);
1710
1711   bp = bits = (char *) alloca (PIXELS / 8);
1712
1713   /* the compface library exports char F[], which uses a single byte per
1714      pixel to represent a 48x48 bitmap.  Yuck. */
1715   for (i = 0, p = F; i < (PIXELS / 8); ++i)
1716     {
1717       int n, b;
1718       /* reverse the bit order of each byte... */
1719       for (b = n = 0; b < 8; ++b)
1720         {
1721           n |= ((*p++) << b);
1722         }
1723       *bp++ = (char) n;
1724     }
1725
1726   xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1727                      pointer_bg, dest_mask, 48, 48, bits);
1728 }
1729
1730 #endif /* HAVE_XFACE */
1731
1732 \f
1733 /**********************************************************************
1734  *                       Autodetect                                      *
1735  **********************************************************************/
1736
1737 static void
1738 autodetect_validate (Lisp_Object instantiator)
1739 {
1740   data_must_be_present (instantiator);
1741 }
1742
1743 static Lisp_Object
1744 autodetect_normalize (Lisp_Object instantiator,
1745                       Lisp_Object console_type)
1746 {
1747   Lisp_Object file = find_keyword_in_vector (instantiator, Q_data);
1748   Lisp_Object filename = Qnil;
1749   Lisp_Object data = Qnil;
1750   struct gcpro gcpro1, gcpro2, gcpro3;
1751   Lisp_Object alist = Qnil;
1752
1753   GCPRO3 (filename, data, alist);
1754
1755   if (NILP (file)) /* no conversion necessary */
1756     RETURN_UNGCPRO (instantiator);
1757
1758   alist = tagged_vector_to_alist (instantiator);
1759
1760   filename = locate_pixmap_file (file);
1761   if (!NILP (filename))
1762     {
1763       int xhot, yhot;
1764       /* #### Apparently some versions of XpmReadFileToData, which is
1765          called by pixmap_to_lisp_data, don't return an error value
1766          if the given file is not a valid XPM file.  Instead, they
1767          just seg fault.  It is definitely caused by passing a
1768          bitmap.  To try and avoid this we check for bitmaps first.  */
1769
1770       data = bitmap_to_lisp_data (filename, &xhot, &yhot, 1);
1771
1772       if (!EQ (data, Qt))
1773         {
1774           alist = remassq_no_quit (Q_data, alist);
1775           alist = Fcons (Fcons (Q_file, filename),
1776                          Fcons (Fcons (Q_data, data), alist));
1777           if (xhot != -1)
1778             alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
1779                            alist);
1780           if (yhot != -1)
1781             alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
1782                            alist);
1783
1784           alist = xbm_mask_file_munging (alist, filename, Qnil, console_type);
1785
1786           {
1787             Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
1788             free_alist (alist);
1789             RETURN_UNGCPRO (result);
1790           }
1791         }
1792
1793 #ifdef HAVE_XPM
1794       data = pixmap_to_lisp_data (filename, 1);
1795
1796       if (!EQ (data, Qt))
1797         {
1798           alist = remassq_no_quit (Q_data, alist);
1799           alist = Fcons (Fcons (Q_file, filename),
1800                          Fcons (Fcons (Q_data, data), alist));
1801           alist = Fcons (Fcons (Q_color_symbols,
1802                                 evaluate_xpm_color_symbols ()),
1803                          alist);
1804           {
1805             Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
1806             free_alist (alist);
1807             RETURN_UNGCPRO (result);
1808           }
1809         }
1810 #endif
1811     }
1812
1813   /* If we couldn't convert it, just put it back as it is.
1814      We might try to further frob it later as a cursor-font
1815      specification. (We can't do that now because we don't know
1816      what dest-types it's going to be instantiated into.) */
1817   {
1818     Lisp_Object result = alist_to_tagged_vector (Qautodetect, alist);
1819     free_alist (alist);
1820     RETURN_UNGCPRO (result);
1821   }
1822 }
1823
1824 static int
1825 autodetect_possible_dest_types (void)
1826 {
1827   return
1828     IMAGE_MONO_PIXMAP_MASK  |
1829     IMAGE_COLOR_PIXMAP_MASK |
1830     IMAGE_POINTER_MASK      |
1831     IMAGE_TEXT_MASK;
1832 }
1833
1834 static void
1835 autodetect_instantiate (Lisp_Object image_instance,
1836                         Lisp_Object instantiator,
1837                         Lisp_Object pointer_fg,
1838                         Lisp_Object pointer_bg,
1839                         int dest_mask, Lisp_Object domain)
1840 {
1841   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1842   struct gcpro gcpro1, gcpro2, gcpro3;
1843   Lisp_Object alist = Qnil;
1844   Lisp_Object result = Qnil;
1845   int is_cursor_font = 0;
1846
1847   GCPRO3 (data, alist, result);
1848
1849   alist = tagged_vector_to_alist (instantiator);
1850   if (dest_mask & IMAGE_POINTER_MASK)
1851     {
1852       const char *name_ext;
1853       TO_EXTERNAL_FORMAT (LISP_STRING, data,
1854                           C_STRING_ALLOCA, name_ext,
1855                           Qfile_name);
1856       if (XmuCursorNameToIndex (name_ext) != -1)
1857         {
1858           result = alist_to_tagged_vector (Qcursor_font, alist);
1859           is_cursor_font = 1;
1860         }
1861     }
1862
1863   if (!is_cursor_font)
1864     result = alist_to_tagged_vector (Qstring, alist);
1865   free_alist (alist);
1866
1867   if (is_cursor_font)
1868     cursor_font_instantiate (image_instance, result, pointer_fg,
1869                              pointer_bg, dest_mask, domain);
1870   else
1871     string_instantiate (image_instance, result, pointer_fg,
1872                         pointer_bg, dest_mask, domain);
1873
1874   UNGCPRO;
1875 }
1876
1877 \f
1878 /**********************************************************************
1879  *                              Font                                  *
1880  **********************************************************************/
1881
1882 static void
1883 font_validate (Lisp_Object instantiator)
1884 {
1885   data_must_be_present (instantiator);
1886 }
1887
1888 /* XmuCvtStringToCursor is bogus in the following ways:
1889
1890    - When it can't convert the given string to a real cursor, it will
1891      sometimes return a "success" value, after triggering a BadPixmap
1892      error.  It then gives you a cursor that will itself generate BadCursor
1893      errors.  So we install this error handler to catch/notice the X error
1894      and take that as meaning "couldn't convert."
1895
1896    - When you tell it to find a cursor file that doesn't exist, it prints
1897      an error message on stderr.  You can't make it not do that.
1898
1899    - Also, using Xmu means we can't properly hack Lisp_Image_Instance
1900      objects, or XPM files, or $XBMLANGPATH.
1901  */
1902
1903 /* Duplicate the behavior of XmuCvtStringToCursor() to bypass its bogusness. */
1904
1905 static int XLoadFont_got_error;
1906
1907 static int
1908 XLoadFont_error_handler (Display *dpy, XErrorEvent *xerror)
1909 {
1910   XLoadFont_got_error = 1;
1911   return 0;
1912 }
1913
1914 static Font
1915 safe_XLoadFont (Display *dpy, char *name)
1916 {
1917   Font font;
1918   int (*old_handler) (Display *, XErrorEvent *);
1919   XLoadFont_got_error = 0;
1920   XSync (dpy, 0);
1921   old_handler = XSetErrorHandler (XLoadFont_error_handler);
1922   font = XLoadFont (dpy, name);
1923   XSync (dpy, 0);
1924   XSetErrorHandler (old_handler);
1925   if (XLoadFont_got_error) return 0;
1926   return font;
1927 }
1928
1929 static int
1930 font_possible_dest_types (void)
1931 {
1932   return IMAGE_POINTER_MASK;
1933 }
1934
1935 static void
1936 font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1937                   Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1938                   int dest_mask, Lisp_Object domain)
1939 {
1940   /* This function can GC */
1941   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1942   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1943   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1944   Display *dpy;
1945   XColor fg, bg;
1946   Font source, mask;
1947   char source_name[MAXPATHLEN], mask_name[MAXPATHLEN], dummy;
1948   int source_char, mask_char;
1949   int count;
1950   Lisp_Object foreground, background;
1951
1952   if (!DEVICE_X_P (XDEVICE (device)))
1953     signal_simple_error ("Not an X device", device);
1954
1955   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1956
1957   if (!STRINGP (data) ||
1958       strncmp ("FONT ", (char *) XSTRING_DATA (data), 5))
1959     signal_simple_error ("Invalid font-glyph instantiator",
1960                          instantiator);
1961
1962   if (!(dest_mask & IMAGE_POINTER_MASK))
1963     incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
1964
1965   foreground = find_keyword_in_vector (instantiator, Q_foreground);
1966   if (NILP (foreground))
1967     foreground = pointer_fg;
1968   background = find_keyword_in_vector (instantiator, Q_background);
1969   if (NILP (background))
1970     background = pointer_bg;
1971
1972   generate_cursor_fg_bg (device, &foreground, &background, &fg, &bg);
1973
1974   count = sscanf ((char *) XSTRING_DATA (data),
1975                   "FONT %s %d %s %d %c",
1976                   source_name, &source_char,
1977                   mask_name, &mask_char, &dummy);
1978   /* Allow "%s %d %d" as well... */
1979   if (count == 3 && (1 == sscanf (mask_name, "%d %c", &mask_char, &dummy)))
1980     count = 4, mask_name[0] = 0;
1981
1982   if (count != 2 && count != 4)
1983     signal_simple_error ("invalid cursor specification", data);
1984   source = safe_XLoadFont (dpy, source_name);
1985   if (! source)
1986     signal_simple_error_2 ("couldn't load font",
1987                            build_string (source_name),
1988                            data);
1989   if (count == 2)
1990     mask = 0;
1991   else if (!mask_name[0])
1992     mask = source;
1993   else
1994     {
1995       mask = safe_XLoadFont (dpy, mask_name);
1996       if (!mask)
1997         /* continuable */
1998         Fsignal (Qerror, list3 (build_string ("couldn't load font"),
1999                                 build_string (mask_name), data));
2000     }
2001   if (!mask)
2002     mask_char = 0;
2003
2004   /* #### call XQueryTextExtents() and check_pointer_sizes() here. */
2005
2006   x_initialize_pixmap_image_instance (ii, 1, IMAGE_POINTER);
2007   IMAGE_INSTANCE_X_CURSOR (ii) =
2008     XCreateGlyphCursor (dpy, source, mask, source_char, mask_char,
2009                         &fg, &bg);
2010   XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
2011   XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
2012   XUnloadFont (dpy, source);
2013   if (mask && mask != source) XUnloadFont (dpy, mask);
2014 }
2015
2016 \f
2017 /**********************************************************************
2018  *                           Cursor-Font                              *
2019  **********************************************************************/
2020
2021 static void
2022 cursor_font_validate (Lisp_Object instantiator)
2023 {
2024   data_must_be_present (instantiator);
2025 }
2026
2027 static int
2028 cursor_font_possible_dest_types (void)
2029 {
2030   return IMAGE_POINTER_MASK;
2031 }
2032
2033 static void
2034 cursor_font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2035                          Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2036                          int dest_mask, Lisp_Object domain)
2037 {
2038   /* This function can GC */
2039   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
2040   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2041   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
2042   Display *dpy;
2043   int i;
2044   const char *name_ext;
2045   Lisp_Object foreground, background;
2046
2047   if (!DEVICE_X_P (XDEVICE (device)))
2048     signal_simple_error ("Not an X device", device);
2049
2050   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2051
2052   if (!(dest_mask & IMAGE_POINTER_MASK))
2053     incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
2054
2055   TO_EXTERNAL_FORMAT (LISP_STRING, data,
2056                       C_STRING_ALLOCA, name_ext,
2057                       Qfile_name);
2058   if ((i = XmuCursorNameToIndex (name_ext)) == -1)
2059     signal_simple_error ("Unrecognized cursor-font name", data);
2060
2061   x_initialize_pixmap_image_instance (ii, 1, IMAGE_POINTER);
2062   IMAGE_INSTANCE_X_CURSOR (ii) = XCreateFontCursor (dpy, i);
2063   foreground = find_keyword_in_vector (instantiator, Q_foreground);
2064   if (NILP (foreground))
2065     foreground = pointer_fg;
2066   background = find_keyword_in_vector (instantiator, Q_background);
2067   if (NILP (background))
2068     background = pointer_bg;
2069   maybe_recolor_cursor (image_instance, foreground, background);
2070 }
2071
2072 static int
2073 x_colorize_image_instance (Lisp_Object image_instance,
2074                            Lisp_Object foreground, Lisp_Object background)
2075 {
2076   Lisp_Image_Instance *p;
2077
2078   p = XIMAGE_INSTANCE (image_instance);
2079
2080   switch (IMAGE_INSTANCE_TYPE (p))
2081     {
2082     case IMAGE_MONO_PIXMAP:
2083       IMAGE_INSTANCE_TYPE (p) = IMAGE_COLOR_PIXMAP;
2084       /* Make sure there aren't two pointers to the same mask, causing
2085          it to get freed twice. */
2086       IMAGE_INSTANCE_PIXMAP_MASK (p) = 0;
2087       break;
2088
2089     default:
2090       return 0;
2091     }
2092
2093   {
2094     Display *dpy = DEVICE_X_DISPLAY (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
2095     Drawable draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (IMAGE_INSTANCE_DEVICE (p))));
2096     Dimension d = DEVICE_X_DEPTH (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
2097     Pixmap new = XCreatePixmap (dpy, draw,
2098                                 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
2099                                 IMAGE_INSTANCE_PIXMAP_HEIGHT (p), d);
2100     XColor color;
2101     XGCValues gcv;
2102     GC gc;
2103     color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground));
2104     gcv.foreground = color.pixel;
2105     color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background));
2106     gcv.background = color.pixel;
2107     gc = XCreateGC (dpy, new, GCBackground|GCForeground, &gcv);
2108     XCopyPlane (dpy, IMAGE_INSTANCE_X_PIXMAP (p), new, gc, 0, 0,
2109                 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
2110                 IMAGE_INSTANCE_PIXMAP_HEIGHT (p),
2111                 0, 0, 1);
2112     XFreeGC (dpy, gc);
2113     IMAGE_INSTANCE_X_PIXMAP (p) = new;
2114     IMAGE_INSTANCE_PIXMAP_DEPTH (p) = d;
2115     IMAGE_INSTANCE_PIXMAP_FG (p) = foreground;
2116     IMAGE_INSTANCE_PIXMAP_BG (p) = background;
2117     return 1;
2118   }
2119 }
2120
2121 \f
2122 /************************************************************************/
2123 /*                      subwindow and widget support                      */
2124 /************************************************************************/
2125
2126 /* unmap the image if it is a widget. This is used by redisplay via
2127    redisplay_unmap_subwindows */
2128 static void
2129 x_unmap_subwindow (Lisp_Image_Instance *p)
2130 {
2131   if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
2132     {
2133       XUnmapWindow
2134         (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2135          IMAGE_INSTANCE_X_CLIPWINDOW (p));
2136     }
2137   else                          /* must be a widget */
2138     {
2139       XtUnmapWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p));
2140     }
2141 }
2142
2143 /* map the subwindow. This is used by redisplay via
2144    redisplay_output_subwindow */
2145 static void
2146 x_map_subwindow (Lisp_Image_Instance *p, int x, int y,
2147                  struct display_glyph_area* dga)
2148 {
2149   if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
2150     {
2151       Window subwindow = IMAGE_INSTANCE_X_SUBWINDOW_ID (p);
2152       XMoveResizeWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2153                          IMAGE_INSTANCE_X_CLIPWINDOW (p),
2154                          x, y, dga->width, dga->height);
2155       XMoveWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2156                    subwindow, -dga->xoffset, -dga->yoffset);
2157       XMapWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2158                   IMAGE_INSTANCE_X_CLIPWINDOW (p));
2159     }
2160   else                          /* must be a widget */
2161     {
2162       XtConfigureWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p),
2163                          x + IMAGE_INSTANCE_X_WIDGET_XOFFSET (p),
2164                          y + IMAGE_INSTANCE_X_WIDGET_YOFFSET (p),
2165                          dga->width, dga->height, 0);
2166       XtMoveWidget (IMAGE_INSTANCE_X_WIDGET_ID (p),
2167                     -dga->xoffset, -dga->yoffset);
2168       XtMapWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p));
2169     }
2170 }
2171
2172 /* when you click on a widget you may activate another widget this
2173    needs to be checked and all appropriate widgets updated */
2174 static void
2175 x_update_subwindow (Lisp_Image_Instance *p)
2176 {
2177   /* Update the subwindow size if necessary. */
2178   if (IMAGE_INSTANCE_SIZE_CHANGED (p))
2179     {
2180       XResizeWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2181                      IMAGE_INSTANCE_X_SUBWINDOW_ID (p),
2182                      IMAGE_INSTANCE_WIDTH (p),
2183                      IMAGE_INSTANCE_HEIGHT (p));
2184     }
2185 }
2186
2187 /* Update all attributes that have changed. Lwlib actually does most
2188    of this for us. */
2189 static void
2190 x_update_widget (Lisp_Image_Instance *p)
2191 {
2192   /* This function can GC if IN_REDISPLAY is false. */
2193 #ifdef HAVE_WIDGETS
2194   widget_value* wv = 0;
2195
2196   /* First get the items if they have changed since this is a
2197      structural change. As such it will nuke all added values so we
2198      need to update most other things after the items have changed.*/
2199   if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (p))
2200     {
2201       Lisp_Object image_instance;
2202
2203       XSETIMAGE_INSTANCE (image_instance, p);
2204       wv = gui_items_to_widget_values
2205         (image_instance, IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (p));
2206       wv->change = STRUCTURAL_CHANGE;
2207       /* now modify the widget */
2208       lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (p),
2209                              wv, True);
2210       free_widget_value_tree (wv);
2211     }
2212
2213   /* Now do non structural updates. */
2214   wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (p));
2215
2216   if (!wv)
2217     return;
2218
2219   /* Possibly update the colors and font */
2220   if (IMAGE_INSTANCE_WIDGET_FACE_CHANGED (p)
2221       ||
2222       XFRAME (IMAGE_INSTANCE_FRAME (p))->faces_changed
2223       ||
2224       IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (p))
2225     {
2226       update_widget_face (wv, p, IMAGE_INSTANCE_FRAME (p));
2227     }
2228
2229   /* Possibly update the text. */
2230   if (IMAGE_INSTANCE_TEXT_CHANGED (p))
2231     {
2232       char* str;
2233       Lisp_Object val = IMAGE_INSTANCE_WIDGET_TEXT (p);
2234       TO_EXTERNAL_FORMAT (LISP_STRING, val,
2235                           C_STRING_ALLOCA, str,
2236                           Qnative);
2237       wv->value = str;
2238     }
2239
2240   /* Possibly update the size. */
2241   if (IMAGE_INSTANCE_SIZE_CHANGED (p)
2242       ||
2243       IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (p)
2244       ||
2245       IMAGE_INSTANCE_TEXT_CHANGED (p))
2246     {
2247       assert (IMAGE_INSTANCE_X_WIDGET_ID (p) &&
2248               IMAGE_INSTANCE_X_CLIPWIDGET (p)) ;
2249
2250       if (IMAGE_INSTANCE_X_WIDGET_ID (p)->core.being_destroyed
2251           || !XtIsManaged(IMAGE_INSTANCE_X_WIDGET_ID (p)))
2252         {
2253           Lisp_Object sw;
2254           XSETIMAGE_INSTANCE (sw, p);
2255           signal_simple_error ("XEmacs bug: subwindow is deleted", sw);
2256         }
2257
2258       lw_add_widget_value_arg (wv, XtNwidth,
2259                                (Dimension)IMAGE_INSTANCE_WIDTH (p));
2260       lw_add_widget_value_arg (wv, XtNheight,
2261                                (Dimension)IMAGE_INSTANCE_HEIGHT (p));
2262     }
2263
2264   /* now modify the widget */
2265   lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (p),
2266                          wv, False);
2267 #endif
2268 }
2269
2270 /* instantiate and x type subwindow */
2271 static void
2272 x_subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2273                         Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2274                         int dest_mask, Lisp_Object domain)
2275 {
2276   /* This function can GC */
2277   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2278   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
2279   Lisp_Object frame = DOMAIN_FRAME (domain);
2280   struct frame* f = XFRAME (frame);
2281   Display *dpy;
2282   Screen *xs;
2283   Window pw, win;
2284   XSetWindowAttributes xswa;
2285   Mask valueMask = 0;
2286   unsigned int w = IMAGE_INSTANCE_WIDTH (ii),
2287     h = IMAGE_INSTANCE_HEIGHT (ii);
2288
2289   if (!DEVICE_X_P (XDEVICE (device)))
2290     signal_simple_error ("Not an X device", device);
2291
2292   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2293   xs = DefaultScreenOfDisplay (dpy);
2294
2295   IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW;
2296
2297   pw = XtWindow (FRAME_X_TEXT_WIDGET (f));
2298
2299   ii->data = xnew_and_zero (struct x_subwindow_data);
2300
2301   IMAGE_INSTANCE_X_SUBWINDOW_PARENT (ii) = pw;
2302   IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (ii) = DisplayOfScreen (xs);
2303
2304   xswa.backing_store = Always;
2305   valueMask |= CWBackingStore;
2306   xswa.colormap = DefaultColormapOfScreen (xs);
2307   valueMask |= CWColormap;
2308
2309   /* Create a window for clipping */
2310   IMAGE_INSTANCE_X_CLIPWINDOW (ii) =
2311     XCreateWindow (dpy, pw, 0, 0, w, h, 0, CopyFromParent,
2312                    InputOutput, CopyFromParent, valueMask,
2313                    &xswa);
2314
2315   /* Now put the subwindow inside the clip window. */
2316   win = XCreateWindow (dpy, IMAGE_INSTANCE_X_CLIPWINDOW (ii),
2317                        0, 0, w, h, 0, CopyFromParent,
2318                        InputOutput, CopyFromParent, valueMask,
2319                        &xswa);
2320
2321   IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)win;
2322 }
2323
2324 #if 0
2325 /* #### Should this function exist? If there's any doubt I'm not implementing it --andyp */
2326 DEFUN ("change-subwindow-property", Fchange_subwindow_property, 3, 3, 0, /*
2327 For the given SUBWINDOW, set PROPERTY to DATA, which is a string.
2328 Subwindows are not currently implemented.
2329 */
2330        (subwindow, property, data))
2331 {
2332   Atom property_atom;
2333   Lisp_Subwindow *sw;
2334   Display *dpy;
2335
2336   CHECK_SUBWINDOW (subwindow);
2337   CHECK_STRING (property);
2338   CHECK_STRING (data);
2339
2340   sw = XSUBWINDOW (subwindow);
2341   dpy = DisplayOfScreen (LISP_DEVICE_TO_X_SCREEN
2342                          (FRAME_DEVICE (XFRAME (sw->frame))));
2343
2344   property_atom = XInternAtom (dpy, (char *) XSTRING_DATA (property), False);
2345   XChangeProperty (dpy, sw->subwindow, property_atom, XA_STRING, 8,
2346                    PropModeReplace,
2347                    XSTRING_DATA   (data),
2348                    XSTRING_LENGTH (data));
2349
2350   return property;
2351 }
2352 #endif
2353
2354 \f
2355 #ifdef HAVE_WIDGETS
2356
2357 /************************************************************************/
2358 /*                            widgets                            */
2359 /************************************************************************/
2360
2361 static void
2362 update_widget_face (widget_value* wv, Lisp_Image_Instance *ii,
2363                     Lisp_Object domain)
2364 {
2365 #ifdef LWLIB_WIDGETS_MOTIF
2366   XmFontList fontList;
2367 #endif
2368   /* Update the foreground. */
2369   Lisp_Object pixel = FACE_FOREGROUND
2370     (IMAGE_INSTANCE_WIDGET_FACE (ii),
2371      domain);
2372   XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel)), bcolor;
2373   lw_add_widget_value_arg (wv, XtNforeground, fcolor.pixel);
2374
2375   /* Update the background. */
2376   pixel = FACE_BACKGROUND (IMAGE_INSTANCE_WIDGET_FACE (ii),
2377                            domain);
2378   bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2379   lw_add_widget_value_arg (wv, XtNbackground, bcolor.pixel);
2380
2381 #ifdef LWLIB_WIDGETS_MOTIF
2382   fontList = XmFontListCreate
2383     (FONT_INSTANCE_X_FONT
2384      (XFONT_INSTANCE (query_string_font
2385                       (IMAGE_INSTANCE_WIDGET_TEXT (ii),
2386                        IMAGE_INSTANCE_WIDGET_FACE (ii),
2387                        domain))),  XmSTRING_DEFAULT_CHARSET);
2388   lw_add_widget_value_arg (wv, XmNfontList, (XtArgVal)fontList);
2389 #endif
2390   lw_add_widget_value_arg
2391     (wv, XtNfont, (XtArgVal)FONT_INSTANCE_X_FONT
2392      (XFONT_INSTANCE (query_string_font
2393                       (IMAGE_INSTANCE_WIDGET_TEXT (ii),
2394                        IMAGE_INSTANCE_WIDGET_FACE (ii),
2395                        domain))));
2396 }
2397
2398 static void
2399 update_tab_widget_face (widget_value* wv, Lisp_Image_Instance *ii,
2400                         Lisp_Object domain)
2401 {
2402   if (wv->contents)
2403     {
2404       widget_value* val = wv->contents, *cur;
2405
2406       /* Give each child label the correct foreground color. */
2407       Lisp_Object pixel = FACE_FOREGROUND
2408         (IMAGE_INSTANCE_WIDGET_FACE (ii),
2409          domain);
2410       XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2411       lw_add_widget_value_arg (val, XtNtabForeground, fcolor.pixel);
2412
2413       for (cur = val->next; cur; cur = cur->next)
2414         {
2415           if (cur->value)
2416             {
2417               lw_copy_widget_value_args (val, cur);
2418             }
2419         }
2420     }
2421 }
2422
2423 static void
2424 x_widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2425                       Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2426                       int dest_mask, Lisp_Object domain,
2427                       const char* type, widget_value* wv)
2428 {
2429   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2430   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii), pixel;
2431   struct device* d = XDEVICE (device);
2432   Lisp_Object frame = DOMAIN_FRAME (domain);
2433   struct frame* f = XFRAME (frame);
2434   char* nm=0;
2435   Widget wid;
2436   Arg al [32];
2437   int ac = 0;
2438   int id = new_lwlib_id ();
2439   widget_value* clip_wv;
2440   XColor fcolor, bcolor;
2441
2442   if (!DEVICE_X_P (d))
2443     signal_simple_error ("Not an X device", device);
2444
2445   /* have to set the type this late in case there is no device
2446      instantiation for a widget. But we can go ahead and do it without
2447      checking because there is always a generic instantiator. */
2448   IMAGE_INSTANCE_TYPE (ii) = IMAGE_WIDGET;
2449
2450   if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
2451     TO_EXTERNAL_FORMAT (LISP_STRING, IMAGE_INSTANCE_WIDGET_TEXT (ii),
2452                         C_STRING_ALLOCA, nm,
2453                         Qnative);
2454
2455   ii->data = xnew_and_zero (struct x_subwindow_data);
2456
2457   /* Create a clip window to contain the subwidget. Incredibly the
2458      XEmacs manager seems to be the most appropriate widget for
2459      this. Nothing else is simple enough and yet does what is
2460      required. */
2461   clip_wv = xmalloc_widget_value ();
2462
2463   lw_add_widget_value_arg (clip_wv, XtNresize, False);
2464   lw_add_widget_value_arg (clip_wv, XtNwidth,
2465                            (Dimension)IMAGE_INSTANCE_WIDTH (ii));
2466   lw_add_widget_value_arg (clip_wv, XtNheight,
2467                            (Dimension)IMAGE_INSTANCE_HEIGHT (ii));
2468   clip_wv->enabled = True;
2469
2470   clip_wv->name = xstrdup ("clip-window");
2471   clip_wv->value = xstrdup ("clip-window");
2472
2473   IMAGE_INSTANCE_X_CLIPWIDGET (ii)
2474     = lw_create_widget ("clip-window", "clip-window", new_lwlib_id (),
2475                         clip_wv, FRAME_X_CONTAINER_WIDGET (f),
2476                         False, 0, 0, 0);
2477
2478   free_widget_value_tree (clip_wv);
2479
2480   /* copy any args we were given */
2481   ac = 0;
2482   lw_add_value_args_to_args (wv, al, &ac);
2483
2484   /* Fixup the colors. We have to do this *before* the widget gets
2485      created so that Motif will fix up the shadow colors
2486      correctly. Once the widget is created Motif won't do this
2487      anymore...*/
2488   pixel = FACE_FOREGROUND
2489     (IMAGE_INSTANCE_WIDGET_FACE (ii),
2490      IMAGE_INSTANCE_FRAME (ii));
2491   fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2492
2493   pixel = FACE_BACKGROUND
2494     (IMAGE_INSTANCE_WIDGET_FACE (ii),
2495      IMAGE_INSTANCE_FRAME (ii));
2496   bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2497
2498   lw_add_widget_value_arg (wv, XtNbackground, bcolor.pixel);
2499   lw_add_widget_value_arg (wv, XtNforeground, fcolor.pixel);
2500   /* we cannot allow widgets to resize themselves */
2501   lw_add_widget_value_arg (wv, XtNresize, False);
2502   lw_add_widget_value_arg (wv, XtNwidth,
2503                            (Dimension)IMAGE_INSTANCE_WIDTH (ii));
2504   lw_add_widget_value_arg (wv, XtNheight,
2505                            (Dimension)IMAGE_INSTANCE_HEIGHT (ii));
2506   /* update the font. */
2507   update_widget_face (wv, ii, domain);
2508
2509   wid = lw_create_widget (type, wv->name, id, wv, IMAGE_INSTANCE_X_CLIPWIDGET (ii),
2510                           False, 0, popup_selection_callback, 0);
2511
2512   IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)wid;
2513   IMAGE_INSTANCE_X_WIDGET_LWID (ii) = id;
2514   /* because the EmacsManager is the widgets parent we have to
2515      offset the redisplay of the widget by the amount the text
2516      widget is inside the manager. */
2517   ac = 0;
2518   XtSetArg (al [ac], XtNx, &IMAGE_INSTANCE_X_WIDGET_XOFFSET (ii)); ac++;
2519   XtSetArg (al [ac], XtNy, &IMAGE_INSTANCE_X_WIDGET_YOFFSET (ii)); ac++;
2520   XtGetValues (FRAME_X_TEXT_WIDGET (f), al, ac);
2521
2522   XtSetMappedWhenManaged (wid, TRUE);
2523
2524   free_widget_value_tree (wv);
2525   /* A kludgy but simple way to make sure the callback for a widget
2526      doesn't get deleted. */
2527   gcpro_popup_callbacks (id);
2528 }
2529
2530 /* get properties of a control */
2531 static Lisp_Object
2532 x_widget_property (Lisp_Object image_instance, Lisp_Object prop)
2533 {
2534   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2535   /* get the text from a control */
2536   if (EQ (prop, Q_text))
2537     {
2538       widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2539       return build_ext_string (wv->value, Qnative);
2540     }
2541   return Qunbound;
2542 }
2543
2544 /* Instantiate a layout control for putting other widgets in. */
2545 static void
2546 x_native_layout_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2547                              Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2548                              int dest_mask, Lisp_Object domain)
2549 {
2550   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2551
2552   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2553                         pointer_bg, dest_mask, domain, "layout", 0);
2554 }
2555
2556 /* Instantiate a button widget. Unfortunately instantiated widgets are
2557    particular to a frame since they need to have a parent. It's not
2558    like images where you just select the image into the context you
2559    want to display it in and BitBlt it. So images instances can have a
2560    many-to-one relationship with things you see, whereas widgets can
2561    only be one-to-one (i.e. per frame) */
2562 static void
2563 x_button_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2564                       Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2565                       int dest_mask, Lisp_Object domain)
2566 {
2567   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2568   Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2569   Lisp_Object glyph = find_keyword_in_vector (instantiator, Q_image);
2570   widget_value* wv = gui_items_to_widget_values (image_instance, gui);
2571
2572   if (!NILP (glyph))
2573     {
2574       if (!IMAGE_INSTANCEP (glyph))
2575         glyph = glyph_image_instance (glyph, domain, ERROR_ME, 1);
2576     }
2577
2578   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2579                         pointer_bg, dest_mask, domain, "button", wv);
2580
2581   /* add the image if one was given */
2582   if (!NILP (glyph) && IMAGE_INSTANCEP (glyph)
2583       && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (glyph)))
2584     {
2585       Arg al [2];
2586       int ac =0;
2587 #ifdef LWLIB_WIDGETS_MOTIF
2588       XtSetArg (al [ac], XmNlabelType, XmPIXMAP);       ac++;
2589       XtSetArg (al [ac], XmNlabelPixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph));ac++;
2590 #else
2591       XtSetArg (al [ac], XtNpixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph));  ac++;
2592 #endif
2593       XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, ac);
2594     }
2595 }
2596
2597 /* Update a button's clicked state.
2598
2599    #### This is overkill, but it works. Right now this causes all
2600    button instances to flash for some reason buried deep in lwlib. In
2601    theory this should be the Right Thing to do since lwlib should only
2602    merge in changed values - and if nothing has changed then nothing
2603    should get done. This may be because of the args stuff,
2604    i.e. although the arg contents may be the same the args look
2605    different and so are re-applied to the widget. */
2606 static void
2607 x_button_update (Lisp_Object image_instance)
2608 {
2609   /* This function can GC if IN_REDISPLAY is false. */
2610   Lisp_Image_Instance *p = XIMAGE_INSTANCE (image_instance);
2611   widget_value* wv =
2612     gui_items_to_widget_values (image_instance,
2613                                 IMAGE_INSTANCE_WIDGET_ITEMS (p));
2614
2615   /* now modify the widget */
2616   lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (p),
2617                          wv, True);
2618   free_widget_value_tree (wv);
2619 }
2620
2621 /* get properties of a button */
2622 static Lisp_Object
2623 x_button_property (Lisp_Object image_instance, Lisp_Object prop)
2624 {
2625   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2626   /* check the state of a button */
2627   if (EQ (prop, Q_selected))
2628     {
2629       widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2630
2631       if (wv->selected)
2632         return Qt;
2633       else
2634         return Qnil;
2635     }
2636   return Qunbound;
2637 }
2638
2639 /* instantiate a progress gauge */
2640 static void
2641 x_progress_gauge_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2642                         Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2643                         int dest_mask, Lisp_Object domain)
2644 {
2645   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2646   Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2647   widget_value* wv = gui_items_to_widget_values (image_instance, gui);
2648
2649   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2650                         pointer_bg, dest_mask, domain, "progress", wv);
2651 }
2652
2653 /* set the properties of a progres guage */
2654 static void
2655 x_progress_gauge_update (Lisp_Object image_instance)
2656 {
2657   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2658
2659   if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii))
2660     {
2661       Arg al [1];
2662       Lisp_Object val;
2663 #ifdef ERROR_CHECK_GLYPHS
2664       assert (GUI_ITEMP (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii)));
2665 #endif
2666       val = XGUI_ITEM (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))->value;
2667       XtSetArg (al[0], XtNvalue, XINT (val));
2668       XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 1);
2669     }
2670 }
2671
2672 /* instantiate an edit control */
2673 static void
2674 x_edit_field_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2675                     Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2676                     int dest_mask, Lisp_Object domain)
2677 {
2678   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2679   Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2680   widget_value* wv = gui_items_to_widget_values (image_instance, gui);
2681
2682   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2683                         pointer_bg, dest_mask, domain, "text-field", wv);
2684 }
2685
2686 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
2687 /* instantiate a combo control */
2688 static void
2689 x_combo_box_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2690                      Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2691                      int dest_mask, Lisp_Object domain)
2692 {
2693   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2694   widget_value * wv = 0;
2695   /* This is not done generically because of sizing problems under
2696      mswindows. */
2697   widget_instantiate (image_instance, instantiator, pointer_fg,
2698                       pointer_bg, dest_mask, domain);
2699
2700   wv = gui_items_to_widget_values (image_instance,
2701                                    IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2702
2703   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2704                         pointer_bg, dest_mask, domain, "combo-box", wv);
2705 }
2706 #endif
2707
2708 static void
2709 x_tab_control_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2710                            Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2711                            int dest_mask, Lisp_Object domain)
2712 {
2713   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2714   widget_value * wv =
2715     gui_items_to_widget_values (image_instance,
2716                                 IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2717
2718   update_tab_widget_face (wv, ii,
2719                           IMAGE_INSTANCE_FRAME (ii));
2720
2721   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2722                         pointer_bg, dest_mask, domain, "tab-control", wv);
2723 }
2724
2725 /* set the properties of a tab control */
2726 static void
2727 x_tab_control_update (Lisp_Object image_instance)
2728 {
2729   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2730
2731   /* Possibly update the face. */
2732   if (IMAGE_INSTANCE_WIDGET_FACE_CHANGED (ii)
2733       ||
2734       XFRAME (IMAGE_INSTANCE_FRAME (ii))->faces_changed
2735       ||
2736       IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii))
2737     {
2738       widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2739
2740       /* #### I don't know why this can occur. */
2741       if (!wv)
2742         return;
2743
2744       update_tab_widget_face (wv, ii,
2745                               IMAGE_INSTANCE_FRAME (ii));
2746
2747       lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, True);
2748     }
2749 }
2750
2751 /* instantiate a static control possible for putting other things in */
2752 static void
2753 x_label_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2754                      Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2755                      int dest_mask, Lisp_Object domain)
2756 {
2757   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2758   Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2759   widget_value* wv = gui_items_to_widget_values (image_instance, gui);
2760
2761   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2762                         pointer_bg, dest_mask, domain, "button", wv);
2763 }
2764 #endif /* HAVE_WIDGETS */
2765
2766 \f
2767 /************************************************************************/
2768 /*                            initialization                            */
2769 /************************************************************************/
2770
2771 void
2772 syms_of_glyphs_x (void)
2773 {
2774 #if 0
2775   DEFSUBR (Fchange_subwindow_property);
2776 #endif
2777 }
2778
2779 void
2780 console_type_create_glyphs_x (void)
2781 {
2782   /* image methods */
2783
2784   CONSOLE_HAS_METHOD (x, print_image_instance);
2785   CONSOLE_HAS_METHOD (x, finalize_image_instance);
2786   CONSOLE_HAS_METHOD (x, image_instance_equal);
2787   CONSOLE_HAS_METHOD (x, image_instance_hash);
2788   CONSOLE_HAS_METHOD (x, colorize_image_instance);
2789   CONSOLE_HAS_METHOD (x, init_image_instance_from_eimage);
2790   CONSOLE_HAS_METHOD (x, locate_pixmap_file);
2791   CONSOLE_HAS_METHOD (x, unmap_subwindow);
2792   CONSOLE_HAS_METHOD (x, map_subwindow);
2793   CONSOLE_HAS_METHOD (x, update_widget);
2794   CONSOLE_HAS_METHOD (x, update_subwindow);
2795 }
2796
2797 void
2798 image_instantiator_format_create_glyphs_x (void)
2799 {
2800   IIFORMAT_VALID_CONSOLE (x, nothing);
2801   IIFORMAT_VALID_CONSOLE (x, string);
2802 #ifdef HAVE_WIDGETS
2803   IIFORMAT_VALID_CONSOLE (x, layout);
2804 #endif
2805   IIFORMAT_VALID_CONSOLE (x, formatted_string);
2806   IIFORMAT_VALID_CONSOLE (x, inherit);
2807 #ifdef HAVE_XPM
2808   INITIALIZE_DEVICE_IIFORMAT (x, xpm);
2809   IIFORMAT_HAS_DEVMETHOD (x, xpm, instantiate);
2810 #endif
2811 #ifdef HAVE_JPEG
2812   IIFORMAT_VALID_CONSOLE (x, jpeg);
2813 #endif
2814 #ifdef HAVE_TIFF
2815   IIFORMAT_VALID_CONSOLE (x, tiff);
2816 #endif
2817 #ifdef HAVE_PNG
2818   IIFORMAT_VALID_CONSOLE (x, png);
2819 #endif
2820 #ifdef HAVE_GIF
2821   IIFORMAT_VALID_CONSOLE (x, gif);
2822 #endif
2823   INITIALIZE_DEVICE_IIFORMAT (x, xbm);
2824   IIFORMAT_HAS_DEVMETHOD (x, xbm, instantiate);
2825
2826   INITIALIZE_DEVICE_IIFORMAT (x, subwindow);
2827   IIFORMAT_HAS_DEVMETHOD (x, subwindow, instantiate);
2828 #ifdef HAVE_WIDGETS
2829   /* layout widget */
2830   INITIALIZE_DEVICE_IIFORMAT (x, native_layout);
2831   IIFORMAT_HAS_DEVMETHOD (x, native_layout, instantiate);
2832   /* button widget */
2833   INITIALIZE_DEVICE_IIFORMAT (x, button);
2834   IIFORMAT_HAS_DEVMETHOD (x, button, property);
2835   IIFORMAT_HAS_DEVMETHOD (x, button, instantiate);
2836   IIFORMAT_HAS_DEVMETHOD (x, button, update);
2837   /* general widget methods. */
2838   INITIALIZE_DEVICE_IIFORMAT (x, widget);
2839   IIFORMAT_HAS_DEVMETHOD (x, widget, property);
2840   /* progress gauge */
2841   INITIALIZE_DEVICE_IIFORMAT (x, progress_gauge);
2842   IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, update);
2843   IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, instantiate);
2844   /* text field */
2845   INITIALIZE_DEVICE_IIFORMAT (x, edit_field);
2846   IIFORMAT_HAS_DEVMETHOD (x, edit_field, instantiate);
2847 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
2848   /* combo box */
2849   INITIALIZE_DEVICE_IIFORMAT (x, combo_box);
2850   IIFORMAT_HAS_DEVMETHOD (x, combo_box, instantiate);
2851   IIFORMAT_HAS_SHARED_DEVMETHOD (x, combo_box, update, tab_control);
2852 #endif
2853   /* tab control widget */
2854   INITIALIZE_DEVICE_IIFORMAT (x, tab_control);
2855   IIFORMAT_HAS_DEVMETHOD (x, tab_control, instantiate);
2856   IIFORMAT_HAS_DEVMETHOD (x, tab_control, update);
2857   /* label */
2858   INITIALIZE_DEVICE_IIFORMAT (x, label);
2859   IIFORMAT_HAS_DEVMETHOD (x, label, instantiate);
2860 #endif
2861   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (cursor_font, "cursor-font");
2862   IIFORMAT_VALID_CONSOLE (x, cursor_font);
2863
2864   IIFORMAT_HAS_METHOD (cursor_font, validate);
2865   IIFORMAT_HAS_METHOD (cursor_font, possible_dest_types);
2866   IIFORMAT_HAS_METHOD (cursor_font, instantiate);
2867
2868   IIFORMAT_VALID_KEYWORD (cursor_font, Q_data, check_valid_string);
2869   IIFORMAT_VALID_KEYWORD (cursor_font, Q_foreground, check_valid_string);
2870   IIFORMAT_VALID_KEYWORD (cursor_font, Q_background, check_valid_string);
2871
2872   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (font, "font");
2873
2874   IIFORMAT_HAS_METHOD (font, validate);
2875   IIFORMAT_HAS_METHOD (font, possible_dest_types);
2876   IIFORMAT_HAS_METHOD (font, instantiate);
2877   IIFORMAT_VALID_CONSOLE (x, font);
2878
2879   IIFORMAT_VALID_KEYWORD (font, Q_data, check_valid_string);
2880   IIFORMAT_VALID_KEYWORD (font, Q_foreground, check_valid_string);
2881   IIFORMAT_VALID_KEYWORD (font, Q_background, check_valid_string);
2882
2883 #ifdef HAVE_XFACE
2884   INITIALIZE_DEVICE_IIFORMAT (x, xface);
2885   IIFORMAT_HAS_DEVMETHOD (x, xface, instantiate);
2886 #endif
2887
2888   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (autodetect,
2889                                         "autodetect");
2890
2891   IIFORMAT_HAS_METHOD (autodetect, validate);
2892   IIFORMAT_HAS_METHOD (autodetect, normalize);
2893   IIFORMAT_HAS_METHOD (autodetect, possible_dest_types);
2894   IIFORMAT_HAS_METHOD (autodetect, instantiate);
2895   IIFORMAT_VALID_CONSOLE (x, autodetect);
2896
2897   IIFORMAT_VALID_KEYWORD (autodetect, Q_data, check_valid_string);
2898 }
2899
2900 void
2901 vars_of_glyphs_x (void)
2902 {
2903   DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path /*
2904 A list of the directories in which X bitmap files may be found.
2905 If nil, this is initialized from the "*bitmapFilePath" resource.
2906 This is used by the `make-image-instance' function (however, note that if
2907 the environment variable XBMLANGPATH is set, it is consulted first).
2908 */ );
2909   Vx_bitmap_file_path = Qnil;
2910 }
2911
2912 void
2913 complex_vars_of_glyphs_x (void)
2914 {
2915 #define BUILD_GLYPH_INST(variable, name)                        \
2916   Fadd_spec_to_specifier                                        \
2917     (GLYPH_IMAGE (XGLYPH (variable)),                           \
2918      vector3 (Qxbm, Q_data,                                     \
2919               list3 (make_int (name##_width),                   \
2920                      make_int (name##_height),                  \
2921                      make_ext_string (name##_bits,              \
2922                                       sizeof (name##_bits),     \
2923                                       Qbinary))),               \
2924      Qglobal, Qx, Qnil)
2925
2926   BUILD_GLYPH_INST (Vtruncation_glyph, truncator);
2927   BUILD_GLYPH_INST (Vcontinuation_glyph, continuer);
2928   BUILD_GLYPH_INST (Vxemacs_logo, xemacs);
2929   BUILD_GLYPH_INST (Vhscroll_glyph, hscroll);
2930
2931 #undef BUILD_GLYPH_INST
2932 }