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

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