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

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