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