git.chise.org Git - chise/xemacs-chise.git.1/blob - src/glyphs-x.c

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