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