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