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    Copyright (C) 1999 Andy Piper
   8
   9 This file is part of XEmacs.
  10
  11 XEmacs is free software; you can redistribute it and/or modify it
  12 under the terms of the GNU General Public License as published by the
  13 Free Software Foundation; either version 2, or (at your option) any
  14 later version.
  15
  16 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  17 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  18 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  19 for more details.
  20
  21 You should have received a copy of the GNU General Public License
  22 along with XEmacs; see the file COPYING.  If not, write to
  23 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 Boston, MA 02111-1307, USA.  */
  25
  26 /* Synched up with: Not in FSF. */
  27
  28 /* Original author: Jamie Zawinski for 19.8
  29    font-truename stuff added by Jamie Zawinski for 19.10
  30    subwindow support added by Chuck Thompson
  31    additional XPM support added by Chuck Thompson
  32    initial X-Face support added by Stig
  33    rewritten/restructured by Ben Wing for 19.12/19.13
  34    GIF/JPEG support added by Ben Wing for 19.14
  35    PNG support added by Bill Perry for 19.14
  36    Improved GIF/JPEG support added by Bill Perry for 19.14
  37    Cleanup/simplification of error handling by Ben Wing for 19.14
  38    Pointer/icon overhaul, more restructuring by Ben Wing for 19.14
  39    GIF support changed to external GIFlib 3.1 by Jareth Hein for 21.0
  40    Many changes for color work and optimizations by Jareth Hein for 21.0
  41    Switch of GIF/JPEG/PNG to new EImage intermediate code by Jareth Hein for 21.0
  42    TIFF code by Jareth Hein for 21.0
  43    GIF/JPEG/PNG/TIFF code moved to new glyph-eimage.c by Andy Piper for 21.0
  44    Subwindow and Widget support by Andy Piper for 21.2
  45
  46    TODO:
  47    Support the GrayScale, StaticColor and StaticGray visual classes.
  48    Convert images.el to C and stick it in here?
  49  */
  50
  51 #include <config.h>
  52 #include "lisp.h"
  53 #include "lstream.h"
  54 #include "console-x.h"
  55 #include "glyphs-x.h"
  56 #include "objects-x.h"
  57 #ifdef HAVE_WIDGETS
  58 #include "gui-x.h"
  59 #endif
  60 #include "xmu.h"
  61
  62 #include "buffer.h"
  63 #include "window.h"
  64 #include "frame.h"
  65 #include "insdel.h"
  66 #include "opaque.h"
  67 #include "gui.h"
  68 #include "faces.h"
  69
  70 #include "imgproc.h"
  71
  72 #include "sysfile.h"
  73
  74 #include <setjmp.h>
  75
  76 #ifdef FILE_CODING
  77 #include "file-coding.h"
  78 #endif
  79
  80 #ifdef LWLIB_WIDGETS_MOTIF
  81 #include <Xm/Xm.h>
  82 #endif
  83 #include <X11/IntrinsicP.h>
  84
  85 #if INTBITS == 32
  86 # define FOUR_BYTE_TYPE unsigned int
  87 #elif LONGBITS == 32
  88 # define FOUR_BYTE_TYPE unsigned long
  89 #elif SHORTBITS == 32
  90 # define FOUR_BYTE_TYPE unsigned short
  91 #else
  92 #error What kind of strange-ass system are we running on?
  93 #endif
  94
  95 #define LISP_DEVICE_TO_X_SCREEN(dev) XDefaultScreenOfDisplay (DEVICE_X_DISPLAY (XDEVICE (dev)))
  96
  97 DECLARE_IMAGE_INSTANTIATOR_FORMAT (nothing);
  98 DECLARE_IMAGE_INSTANTIATOR_FORMAT (string);
  99 DECLARE_IMAGE_INSTANTIATOR_FORMAT (formatted_string);
 100 DECLARE_IMAGE_INSTANTIATOR_FORMAT (inherit);
 101 DECLARE_IMAGE_INSTANTIATOR_FORMAT (layout);
 102 #ifdef HAVE_JPEG
 103 DECLARE_IMAGE_INSTANTIATOR_FORMAT (jpeg);
 104 #endif
 105 #ifdef HAVE_TIFF
 106 DECLARE_IMAGE_INSTANTIATOR_FORMAT (tiff);
 107 #endif
 108 #ifdef HAVE_PNG
 109 DECLARE_IMAGE_INSTANTIATOR_FORMAT (png);
 110 #endif
 111 #ifdef HAVE_GIF
 112 DECLARE_IMAGE_INSTANTIATOR_FORMAT (gif);
 113 #endif
 114 #ifdef HAVE_XPM
 115 DEFINE_DEVICE_IIFORMAT (x, xpm);
 116 #endif
 117 DEFINE_DEVICE_IIFORMAT (x, xbm);
 118 DEFINE_DEVICE_IIFORMAT (x, subwindow);
 119 #ifdef HAVE_XFACE
 120 DEFINE_DEVICE_IIFORMAT (x, xface);
 121 #endif
 122
 123 DEFINE_IMAGE_INSTANTIATOR_FORMAT (cursor_font);
 124 Lisp_Object Qcursor_font;
 125
 126 DEFINE_IMAGE_INSTANTIATOR_FORMAT (font);
 127
 128 DEFINE_IMAGE_INSTANTIATOR_FORMAT (autodetect);
 129
 130 #ifdef HAVE_WIDGETS
 131 DEFINE_DEVICE_IIFORMAT (x, widget);
 132 DEFINE_DEVICE_IIFORMAT (x, button);
 133 DEFINE_DEVICE_IIFORMAT (x, progress_gauge);
 134 DEFINE_DEVICE_IIFORMAT (x, edit_field);
 135 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
 136 DEFINE_DEVICE_IIFORMAT (x, combo_box);
 137 #endif
 138 DEFINE_DEVICE_IIFORMAT (x, tab_control);
 139 DEFINE_DEVICE_IIFORMAT (x, label);
 140 #endif
 141
 142 static void cursor_font_instantiate (Lisp_Object image_instance,
 143                                      Lisp_Object instantiator,
 144                                      Lisp_Object pointer_fg,
 145                                      Lisp_Object pointer_bg,
 146                                      int dest_mask,
 147                                      Lisp_Object domain);
 148
 149 #ifdef HAVE_WIDGETS
 150 static void
 151 update_widget_face (struct Lisp_Image_Instance* ii, Lisp_Object domain);
 152 #endif
 153
 154 #include "bitmaps.h"
 155
 156 \f
 157 /************************************************************************/
 158 /*                      image instance methods                          */
 159 /************************************************************************/
 160
 161 /************************************************************************/
 162 /* convert from a series of RGB triples to an XImage formated for the   */
 163 /* proper display                                                       */
 164 /************************************************************************/
 165 static XImage *
 166 convert_EImage_to_XImage (Lisp_Object device, int width, int height,
 167                           unsigned char *pic, unsigned long **pixtbl,
 168                           int *npixels)
 169 {
 170   Display *dpy;
 171   Colormap cmap;
 172   Visual *vis;
 173   XImage *outimg;
 174   int depth, bitmap_pad, bits_per_pixel, byte_cnt, i, j;
 175   int rd,gr,bl,q;
 176   unsigned char *data, *ip, *dp;
 177   quant_table *qtable = 0;
 178   union {
 179     FOUR_BYTE_TYPE val;
 180     char cp[4];
 181   } conv;
 182
 183   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
 184   cmap = DEVICE_X_COLORMAP (XDEVICE(device));
 185   vis = DEVICE_X_VISUAL (XDEVICE(device));
 186   depth = DEVICE_X_DEPTH(XDEVICE(device));
 187
 188   if (vis->class == GrayScale || vis->class == StaticColor ||
 189       vis->class == StaticGray)
 190     {
 191       /* #### Implement me!!! */
 192       return NULL;
 193     }
 194
 195   if (vis->class == PseudoColor)
 196     {
 197       /* Quantize the image and get a histogram while we're at it.
 198          Do this first to save memory */
 199       qtable = build_EImage_quantable(pic, width, height, 256);
 200       if (qtable == NULL) return NULL;
 201     }
 202
 203   bitmap_pad = ((depth > 16) ? 32 :
 204                 (depth >  8) ? 16 :
 205                 8);
 206
 207   outimg = XCreateImage (dpy, vis,
 208                          depth, ZPixmap, 0, 0, width, height,
 209                          bitmap_pad, 0);
 210   if (!outimg) return NULL;
 211
 212   bits_per_pixel = outimg->bits_per_pixel;
 213   byte_cnt = bits_per_pixel >> 3;
 214
 215   data = (unsigned char *) xmalloc (outimg->bytes_per_line * height);
 216   if (!data)
 217     {
 218       XDestroyImage (outimg);
 219       return NULL;
 220     }
 221   outimg->data = (char *) data;
 222
 223   if (vis->class == PseudoColor)
 224     {
 225       unsigned long pixarray[256];
 226       int pixcount, n;
 227       /* use our quantize table to allocate the colors */
 228       pixcount = 32;
 229       *pixtbl = xnew_array (unsigned long, pixcount);
 230       *npixels = 0;
 231
 232       /* ### should implement a sort by popularity to assure proper allocation */
 233       n = *npixels;
 234       for (i = 0; i < qtable->num_active_colors; i++)
 235         {
 236           XColor color;
 237           int res;
 238
 239           color.red = qtable->rm[i] ? qtable->rm[i] << 8 : 0;
 240           color.green = qtable->gm[i] ? qtable->gm[i] << 8 : 0;
 241           color.blue = qtable->bm[i] ? qtable->bm[i] << 8 : 0;
 242           color.flags = DoRed | DoGreen | DoBlue;
 243           res = allocate_nearest_color (dpy, cmap, vis, &color);
 244           if (res > 0 && res < 3)
 245             {
 246               DO_REALLOC(*pixtbl, pixcount, n+1, unsigned long);
 247               (*pixtbl)[n] = color.pixel;
 248               n++;
 249             }
 250           pixarray[i] = color.pixel;
 251         }
 252       *npixels = n;
 253       ip = pic;
 254       for (i = 0; i < height; i++)
 255         {
 256           dp = data + (i * outimg->bytes_per_line);
 257           for (j = 0; j < width; j++)
 258             {
 259               rd = *ip++;
 260               gr = *ip++;
 261               bl = *ip++;
 262               conv.val = pixarray[QUANT_GET_COLOR(qtable,rd,gr,bl)];
 263 #if WORDS_BIGENDIAN
 264               if (outimg->byte_order == MSBFirst)
 265                 for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q];
 266               else
 267                 for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q];
 268 #else
 269               if (outimg->byte_order == MSBFirst)
 270                 for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q];
 271               else
 272                 for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q];
 273 #endif
 274             }
 275         }
 276       xfree(qtable);
 277     } else {
 278       unsigned long rshift,gshift,bshift,rbits,gbits,bbits,junk;
 279       junk = vis->red_mask;
 280       rshift = 0;
 281       while ((junk & 0x1) == 0)
 282         {
 283           junk = junk >> 1;
 284           rshift ++;
 285         }
 286       rbits = 0;
 287       while (junk != 0)
 288         {
 289           junk = junk >> 1;
 290           rbits++;
 291         }
 292       junk = vis->green_mask;
 293       gshift = 0;
 294       while ((junk & 0x1) == 0)
 295         {
 296           junk = junk >> 1;
 297           gshift ++;
 298         }
 299       gbits = 0;
 300       while (junk != 0)
 301         {
 302           junk = junk >> 1;
 303           gbits++;
 304         }
 305       junk = vis->blue_mask;
 306       bshift = 0;
 307       while ((junk & 0x1) == 0)
 308         {
 309           junk = junk >> 1;
 310           bshift ++;
 311         }
 312       bbits = 0;
 313       while (junk != 0)
 314         {
 315           junk = junk >> 1;
 316           bbits++;
 317         }
 318       ip = pic;
 319       for (i = 0; i < height; i++)
 320         {
 321           dp = data + (i * outimg->bytes_per_line);
 322           for (j = 0; j < width; j++)
 323             {
 324               if (rbits > 8)
 325                 rd = *ip++ << (rbits - 8);
 326               else
 327                 rd = *ip++ >> (8 - rbits);
 328               if (gbits > 8)
 329                 gr = *ip++ << (gbits - 8);
 330               else
 331                 gr = *ip++ >> (8 - gbits);
 332               if (bbits > 8)
 333                 bl = *ip++ << (bbits - 8);
 334               else
 335                 bl = *ip++ >> (8 - bbits);
 336
 337               conv.val = (rd << rshift) | (gr << gshift) | (bl << bshift);
 338 #if WORDS_BIGENDIAN
 339               if (outimg->byte_order == MSBFirst)
 340                 for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q];
 341               else
 342                 for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q];
 343 #else
 344               if (outimg->byte_order == MSBFirst)
 345                 for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q];
 346               else
 347                 for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q];
 348 #endif
 349             }
 350         }
 351     }
 352   return outimg;
 353 }
 354
 355
 356
 357 static void
 358 x_print_image_instance (struct Lisp_Image_Instance *p,
 359                         Lisp_Object printcharfun,
 360                         int escapeflag)
 361 {
 362   char buf[100];
 363
 364   switch (IMAGE_INSTANCE_TYPE (p))
 365     {
 366     case IMAGE_MONO_PIXMAP:
 367     case IMAGE_COLOR_PIXMAP:
 368     case IMAGE_POINTER:
 369       sprintf (buf, " (0x%lx", (unsigned long) IMAGE_INSTANCE_X_PIXMAP (p));
 370       write_c_string (buf, printcharfun);
 371       if (IMAGE_INSTANCE_X_MASK (p))
 372         {
 373           sprintf (buf, "/0x%lx", (unsigned long) IMAGE_INSTANCE_X_MASK (p));
 374           write_c_string (buf, printcharfun);
 375         }
 376       write_c_string (")", printcharfun);
 377       break;
 378     default:
 379       break;
 380     }
 381 }
 382
 383 #ifdef DEBUG_WIDGETS
 384 extern int debug_widget_instances;
 385 #endif
 386
 387 static void
 388 x_finalize_image_instance (struct Lisp_Image_Instance *p)
 389 {
 390   if (!p->data)
 391     return;
 392
 393   if (DEVICE_LIVE_P (XDEVICE (p->device)))
 394     {
 395       Display *dpy = DEVICE_X_DISPLAY (XDEVICE (p->device));
 396
 397       if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET)
 398         {
 399           if (IMAGE_INSTANCE_SUBWINDOW_ID (p))
 400             {
 401 #ifdef DEBUG_WIDGETS
 402               debug_widget_instances--;
 403               stderr_out ("widget destroyed, %d left\n", debug_widget_instances);
 404 #endif
 405               lw_destroy_widget (IMAGE_INSTANCE_X_WIDGET_ID (p));
 406               lw_destroy_widget (IMAGE_INSTANCE_X_CLIPWIDGET (p));
 407               IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0;
 408             }
 409         }
 410       else if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
 411         {
 412           if (IMAGE_INSTANCE_SUBWINDOW_ID (p))
 413             XDestroyWindow (dpy, IMAGE_INSTANCE_X_SUBWINDOW_ID (p));
 414           IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0;
 415         }
 416       else
 417         {
 418           int i;
 419           if (IMAGE_INSTANCE_PIXMAP_TIMEOUT (p))
 420             disable_glyph_animated_timeout (IMAGE_INSTANCE_PIXMAP_TIMEOUT (p));
 421
 422           if (IMAGE_INSTANCE_X_MASK (p) &&
 423               IMAGE_INSTANCE_X_MASK (p) != IMAGE_INSTANCE_X_PIXMAP (p))
 424             XFreePixmap (dpy, IMAGE_INSTANCE_X_MASK (p));
 425           IMAGE_INSTANCE_PIXMAP_MASK (p) = 0;
 426
 427           if (IMAGE_INSTANCE_X_PIXMAP_SLICES (p))
 428             {
 429               for (i = 0; i < IMAGE_INSTANCE_PIXMAP_MAXSLICE (p); i++)
 430                 if (IMAGE_INSTANCE_X_PIXMAP_SLICE (p,i))
 431                   {
 432                     XFreePixmap (dpy, IMAGE_INSTANCE_X_PIXMAP_SLICE (p,i));
 433                     IMAGE_INSTANCE_X_PIXMAP_SLICE (p, i) = 0;
 434                   }
 435               xfree (IMAGE_INSTANCE_X_PIXMAP_SLICES (p));
 436               IMAGE_INSTANCE_X_PIXMAP_SLICES (p) = 0;
 437             }
 438
 439           if (IMAGE_INSTANCE_X_CURSOR (p))
 440             {
 441               XFreeCursor (dpy, IMAGE_INSTANCE_X_CURSOR (p));
 442               IMAGE_INSTANCE_X_CURSOR (p) = 0;
 443             }
 444
 445           if (IMAGE_INSTANCE_X_NPIXELS (p) != 0)
 446             {
 447               XFreeColors (dpy,
 448                            IMAGE_INSTANCE_X_COLORMAP (p),
 449                            IMAGE_INSTANCE_X_PIXELS (p),
 450                            IMAGE_INSTANCE_X_NPIXELS (p), 0);
 451               IMAGE_INSTANCE_X_NPIXELS (p) = 0;
 452             }
 453         }
 454     }
 455   /* You can sometimes have pixels without a live device. I forget
 456      why, but that's why we free them here if we have a pixmap type
 457      image instance. It probably means that we might also get a memory
 458      leak with widgets. */
 459   if (IMAGE_INSTANCE_TYPE (p) != IMAGE_WIDGET
 460       && IMAGE_INSTANCE_TYPE (p) != IMAGE_SUBWINDOW
 461       && IMAGE_INSTANCE_X_PIXELS (p))
 462     {
 463       xfree (IMAGE_INSTANCE_X_PIXELS (p));
 464       IMAGE_INSTANCE_X_PIXELS (p) = 0;
 465     }
 466
 467   xfree (p->data);
 468   p->data = 0;
 469 }
 470
 471 static int
 472 x_image_instance_equal (struct Lisp_Image_Instance *p1,
 473                         struct Lisp_Image_Instance *p2, int depth)
 474 {
 475   switch (IMAGE_INSTANCE_TYPE (p1))
 476     {
 477     case IMAGE_MONO_PIXMAP:
 478     case IMAGE_COLOR_PIXMAP:
 479     case IMAGE_POINTER:
 480       if (IMAGE_INSTANCE_X_COLORMAP (p1) != IMAGE_INSTANCE_X_COLORMAP (p2) ||
 481           IMAGE_INSTANCE_X_NPIXELS (p1) != IMAGE_INSTANCE_X_NPIXELS (p2))
 482         return 0;
 483       break;
 484     default:
 485       break;
 486     }
 487
 488   return 1;
 489 }
 490
 491 static unsigned long
 492 x_image_instance_hash (struct Lisp_Image_Instance *p, int depth)
 493 {
 494   switch (IMAGE_INSTANCE_TYPE (p))
 495     {
 496     case IMAGE_MONO_PIXMAP:
 497     case IMAGE_COLOR_PIXMAP:
 498     case IMAGE_POINTER:
 499       return IMAGE_INSTANCE_X_NPIXELS (p);
 500     default:
 501       return 0;
 502     }
 503 }
 504
 505 /* Set all the slots in an image instance structure to reasonable
 506    default values.  This is used somewhere within an instantiate
 507    method.  It is assumed that the device slot within the image
 508    instance is already set -- this is the case when instantiate
 509    methods are called. */
 510
 511 static void
 512 x_initialize_pixmap_image_instance (struct Lisp_Image_Instance *ii,
 513                                     int slices,
 514                                     enum image_instance_type type)
 515 {
 516   ii->data = xnew_and_zero (struct x_image_instance_data);
 517   IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) = slices;
 518   IMAGE_INSTANCE_X_PIXMAP_SLICES (ii) =
 519     xnew_array_and_zero (Pixmap, slices);
 520   IMAGE_INSTANCE_TYPE (ii) = type;
 521   IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = Qnil;
 522   IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (ii) = Qnil;
 523   IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) = Qnil;
 524   IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) = Qnil;
 525   IMAGE_INSTANCE_PIXMAP_FG (ii) = Qnil;
 526   IMAGE_INSTANCE_PIXMAP_BG (ii) = Qnil;
 527 }
 528
 529 \f
 530 /************************************************************************/
 531 /*                        pixmap file functions                         */
 532 /************************************************************************/
 533
 534 /* Where bitmaps are; initialized from resource database */
 535 Lisp_Object Vx_bitmap_file_path;
 536
 537 #ifndef BITMAPDIR
 538 #define BITMAPDIR "/usr/include/X11/bitmaps"
 539 #endif
 540
 541 #define USE_XBMLANGPATH
 542
 543 /* Given a pixmap filename, look through all of the "standard" places
 544    where the file might be located.  Return a full pathname if found;
 545    otherwise, return Qnil. */
 546
 547 static Lisp_Object
 548 x_locate_pixmap_file (Lisp_Object name)
 549 {
 550   /* This function can GC if IN_REDISPLAY is false */
 551   Display *display;
 552
 553   /* Check non-absolute pathnames with a directory component relative to
 554      the search path; that's the way Xt does it. */
 555   /* #### Unix-specific */
 556   if (XSTRING_BYTE (name, 0) == '/' ||
 557       (XSTRING_BYTE (name, 0) == '.' &&
 558        (XSTRING_BYTE (name, 1) == '/' ||
 559         (XSTRING_BYTE (name, 1) == '.' &&
 560          (XSTRING_BYTE (name, 2) == '/')))))
 561     {
 562       if (!NILP (Ffile_readable_p (name)))
 563         return name;
 564       else
 565         return Qnil;
 566     }
 567
 568   if (NILP (Vdefault_x_device))
 569     /* This may occur during initialization. */
 570     return Qnil;
 571   else
 572     /* We only check the bitmapFilePath resource on the original X device. */
 573     display = DEVICE_X_DISPLAY (XDEVICE (Vdefault_x_device));
 574
 575 #ifdef USE_XBMLANGPATH
 576   {
 577     char *path = egetenv ("XBMLANGPATH");
 578     SubstitutionRec subs[1];
 579     subs[0].match = 'B';
 580     subs[0].substitution = (char *) XSTRING_DATA (name);
 581     /* #### Motif uses a big hairy default if $XBMLANGPATH isn't set.
 582        We don't.  If you want it used, set it. */
 583     if (path &&
 584         (path = XtResolvePathname (display, "bitmaps", 0, 0, path,
 585                                    subs, XtNumber (subs), 0)))
 586       {
 587         name = build_string (path);
 588         XtFree (path);
 589         return (name);
 590       }
 591   }
 592 #endif
 593
 594   if (NILP (Vx_bitmap_file_path))
 595     {
 596       char *type = 0;
 597       XrmValue value;
 598       if (XrmGetResource (XtDatabase (display),
 599                           "bitmapFilePath", "BitmapFilePath", &type, &value)
 600           && !strcmp (type, "String"))
 601         Vx_bitmap_file_path = decode_env_path (0, (char *) value.addr);
 602       Vx_bitmap_file_path = nconc2 (Vx_bitmap_file_path,
 603                                     (decode_path (BITMAPDIR)));
 604     }
 605
 606   {
 607     Lisp_Object found;
 608     if (locate_file (Vx_bitmap_file_path, name, Qnil, &found, R_OK) < 0)
 609       {
 610         Lisp_Object temp = list1 (Vdata_directory);
 611         struct gcpro gcpro1;
 612
 613         GCPRO1 (temp);
 614         locate_file (temp, name, Qnil, &found, R_OK);
 615         UNGCPRO;
 616       }
 617
 618     return found;
 619   }
 620 }
 621
 622 static Lisp_Object
 623 locate_pixmap_file (Lisp_Object name)
 624 {
 625   return x_locate_pixmap_file (name);
 626 }
 627
 628 #if 0
 629 static void
 630 write_lisp_string_to_temp_file (Lisp_Object string, char *filename_out)
 631 {
 632   Lisp_Object instream, outstream;
 633   Lstream *istr, *ostr;
 634   char tempbuf[1024]; /* some random amount */
 635   int fubar = 0;
 636   FILE *tmpfil;
 637   static Extbyte_dynarr *conversion_out_dynarr;
 638   Bytecount bstart, bend;
 639   struct gcpro gcpro1, gcpro2;
 640 #ifdef FILE_CODING
 641   Lisp_Object conv_out_stream;
 642   Lstream *costr;
 643   struct gcpro gcpro3;
 644 #endif
 645
 646   /* This function can GC */
 647   if (!conversion_out_dynarr)
 648     conversion_out_dynarr = Dynarr_new (Extbyte);
 649   else
 650     Dynarr_reset (conversion_out_dynarr);
 651
 652   /* Create the temporary file ... */
 653   sprintf (filename_out, "/tmp/emacs%d.XXXXXX", (int) getpid ());
 654   mktemp (filename_out);
 655   tmpfil = fopen (filename_out, "w");
 656   if (!tmpfil)
 657     {
 658       if (tmpfil)
 659         {
 660           int old_errno = errno;
 661           fclose (tmpfil);
 662           unlink (filename_out);
 663           errno = old_errno;
 664         }
 665       report_file_error ("Creating temp file",
 666                          list1 (build_string (filename_out)));
 667     }
 668
 669   CHECK_STRING (string);
 670   get_string_range_byte (string, Qnil, Qnil, &bstart, &bend,
 671                          GB_HISTORICAL_STRING_BEHAVIOR);
 672   instream = make_lisp_string_input_stream (string, bstart, bend);
 673   istr = XLSTREAM (instream);
 674   /* setup the out stream */
 675   outstream = make_dynarr_output_stream((unsigned_char_dynarr *)conversion_out_dynarr);
 676   ostr = XLSTREAM (outstream);
 677 #ifdef FILE_CODING
 678   /* setup the conversion stream */
 679   conv_out_stream = make_encoding_output_stream (ostr, Fget_coding_system(Qbinary));
 680   costr = XLSTREAM (conv_out_stream);
 681   GCPRO3 (instream, outstream, conv_out_stream);
 682 #else
 683   GCPRO2 (instream, outstream);
 684 #endif
 685
 686   /* Get the data while doing the conversion */
 687   while (1)
 688     {
 689       ssize_t size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
 690       if (!size_in_bytes)
 691         break;
 692       /* It does seem the flushes are necessary... */
 693 #ifdef FILE_CODING
 694       Lstream_write (costr, tempbuf, size_in_bytes);
 695       Lstream_flush (costr);
 696 #else
 697       Lstream_write (ostr, tempbuf, size_in_bytes);
 698 #endif
 699       Lstream_flush (ostr);
 700       if (fwrite ((unsigned char *)Dynarr_atp(conversion_out_dynarr, 0),
 701                   Dynarr_length(conversion_out_dynarr), 1, tmpfil) != 1)
 702         {
 703           fubar = 1;
 704           break;
 705         }
 706       /* reset the dynarr */
 707       Lstream_rewind(ostr);
 708     }
 709
 710   if (fclose (tmpfil) != 0)
 711     fubar = 1;
 712   Lstream_close (istr);
 713 #ifdef FILE_CODING
 714   Lstream_close (costr);
 715 #endif
 716   Lstream_close (ostr);
 717
 718   UNGCPRO;
 719   Lstream_delete (istr);
 720   Lstream_delete (ostr);
 721 #ifdef FILE_CODING
 722   Lstream_delete (costr);
 723 #endif
 724
 725   if (fubar)
 726     report_file_error ("Writing temp file",
 727                        list1 (build_string (filename_out)));
 728 }
 729 #endif /* 0 */
 730
 731 \f
 732 /************************************************************************/
 733 /*                           cursor functions                           */
 734 /************************************************************************/
 735
 736 /* Check that this server supports cursors of size WIDTH * HEIGHT.  If
 737    not, signal an error.  INSTANTIATOR is only used in the error
 738    message. */
 739
 740 static void
 741 check_pointer_sizes (Screen *xs, unsigned int width, unsigned int height,
 742                      Lisp_Object instantiator)
 743 {
 744   unsigned int best_width, best_height;
 745   if (! XQueryBestCursor (DisplayOfScreen (xs), RootWindowOfScreen (xs),
 746                           width, height, &best_width, &best_height))
 747     /* this means that an X error of some sort occurred (we trap
 748        these so they're not fatal). */
 749     signal_simple_error ("XQueryBestCursor() failed?", instantiator);
 750
 751   if (width > best_width || height > best_height)
 752     error_with_frob (instantiator,
 753                      "pointer too large (%dx%d): "
 754                      "server requires %dx%d or smaller",
 755                      width, height, best_width, best_height);
 756 }
 757
 758
 759 static void
 760 generate_cursor_fg_bg (Lisp_Object device, Lisp_Object *foreground,
 761                        Lisp_Object *background, XColor *xfg, XColor *xbg)
 762 {
 763   if (!NILP (*foreground) && !COLOR_INSTANCEP (*foreground))
 764     *foreground =
 765       Fmake_color_instance (*foreground, device,
 766                             encode_error_behavior_flag (ERROR_ME));
 767   if (COLOR_INSTANCEP (*foreground))
 768     *xfg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (*foreground));
 769   else
 770     {
 771       xfg->pixel = 0;
 772       xfg->red = xfg->green = xfg->blue = 0;
 773     }
 774
 775   if (!NILP (*background) && !COLOR_INSTANCEP (*background))
 776     *background =
 777       Fmake_color_instance (*background, device,
 778                             encode_error_behavior_flag (ERROR_ME));
 779   if (COLOR_INSTANCEP (*background))
 780     *xbg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (*background));
 781   else
 782     {
 783       xbg->pixel = 0;
 784       xbg->red = xbg->green = xbg->blue = ~0;
 785     }
 786 }
 787
 788 static void
 789 maybe_recolor_cursor (Lisp_Object image_instance, Lisp_Object foreground,
 790                       Lisp_Object background)
 791 {
 792   Lisp_Object device = XIMAGE_INSTANCE_DEVICE (image_instance);
 793   XColor xfg, xbg;
 794
 795   generate_cursor_fg_bg (device, &foreground, &background, &xfg, &xbg);
 796   if (!NILP (foreground) || !NILP (background))
 797     {
 798       XRecolorCursor (DEVICE_X_DISPLAY (XDEVICE (device)),
 799                       XIMAGE_INSTANCE_X_CURSOR (image_instance),
 800                       &xfg, &xbg);
 801       XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
 802       XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
 803     }
 804 }
 805
 806 \f
 807 /************************************************************************/
 808 /*                        color pixmap functions                        */
 809 /************************************************************************/
 810
 811 /* Initialize an image instance from an XImage.
 812
 813    DEST_MASK specifies the mask of allowed image types.
 814
 815    PIXELS and NPIXELS specify an array of pixels that are used in
 816    the image.  These need to be kept around for the duration of the
 817    image.  When the image instance is freed, XFreeColors() will
 818    automatically be called on all the pixels specified here; thus,
 819    you should have allocated the pixels yourself using XAllocColor()
 820    or the like.  The array passed in is used directly without
 821    being copied, so it should be heap data created with xmalloc().
 822    It will be freed using xfree() when the image instance is
 823    destroyed.
 824
 825    If this fails, signal an error.  INSTANTIATOR is only used
 826    in the error message.
 827
 828    #### This should be able to handle conversion into `pointer'.
 829    Use the same code as for `xpm'. */
 830
 831 static void
 832 init_image_instance_from_x_image (struct Lisp_Image_Instance *ii,
 833                                   XImage *ximage,
 834                                   int dest_mask,
 835                                   Colormap cmap,
 836                                   unsigned long *pixels,
 837                                   int npixels,
 838                                   int slices,
 839                                   Lisp_Object instantiator)
 840 {
 841   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
 842   Display *dpy;
 843   GC gc;
 844   Drawable d;
 845   Pixmap pixmap;
 846
 847   if (!DEVICE_X_P (XDEVICE (device)))
 848     signal_simple_error ("Not an X device", device);
 849
 850   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
 851   d = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
 852
 853   if (!(dest_mask & IMAGE_COLOR_PIXMAP_MASK))
 854     incompatible_image_types (instantiator, dest_mask,
 855                               IMAGE_COLOR_PIXMAP_MASK);
 856
 857   pixmap = XCreatePixmap (dpy, d, ximage->width,
 858                           ximage->height, ximage->depth);
 859   if (!pixmap)
 860     signal_simple_error ("Unable to create pixmap", instantiator);
 861
 862   gc = XCreateGC (dpy, pixmap, 0, NULL);
 863   if (!gc)
 864     {
 865       XFreePixmap (dpy, pixmap);
 866       signal_simple_error ("Unable to create GC", instantiator);
 867     }
 868
 869   XPutImage (dpy, pixmap, gc, ximage, 0, 0, 0, 0,
 870              ximage->width, ximage->height);
 871
 872   XFreeGC (dpy, gc);
 873
 874   x_initialize_pixmap_image_instance (ii, slices, IMAGE_COLOR_PIXMAP);
 875
 876   IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
 877     find_keyword_in_vector (instantiator, Q_file);
 878
 879   /* Fixup a set of pixmaps. */
 880   IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
 881
 882   IMAGE_INSTANCE_PIXMAP_MASK (ii) = 0;
 883   IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = ximage->width;
 884   IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = ximage->height;
 885   IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = ximage->depth;
 886   IMAGE_INSTANCE_X_COLORMAP (ii) = cmap;
 887   IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
 888   IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
 889 }
 890
 891 static void
 892 image_instance_add_x_image (struct Lisp_Image_Instance *ii,
 893                             XImage *ximage,
 894                             int slice,
 895                             Lisp_Object instantiator)
 896 {
 897   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
 898   Display *dpy;
 899   GC gc;
 900   Drawable d;
 901   Pixmap pixmap;
 902
 903   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
 904   d = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
 905
 906   pixmap = XCreatePixmap (dpy, d, ximage->width,
 907                           ximage->height, ximage->depth);
 908   if (!pixmap)
 909     signal_simple_error ("Unable to create pixmap", instantiator);
 910
 911   gc = XCreateGC (dpy, pixmap, 0, NULL);
 912   if (!gc)
 913     {
 914       XFreePixmap (dpy, pixmap);
 915       signal_simple_error ("Unable to create GC", instantiator);
 916     }
 917
 918   XPutImage (dpy, pixmap, gc, ximage, 0, 0, 0, 0,
 919              ximage->width, ximage->height);
 920
 921   XFreeGC (dpy, gc);
 922
 923   IMAGE_INSTANCE_X_PIXMAP_SLICE (ii, slice) = pixmap;
 924 }
 925
 926 static void
 927 x_init_image_instance_from_eimage (struct Lisp_Image_Instance *ii,
 928                                    int width, int height,
 929                                    int slices,
 930                                    unsigned char *eimage,
 931                                    int dest_mask,
 932                                    Lisp_Object instantiator,
 933                                    Lisp_Object domain)
 934 {
 935   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
 936   Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device));
 937   unsigned long *pixtbl = NULL;
 938   int npixels = 0;
 939   int slice;
 940   XImage* ximage;
 941
 942   for (slice = 0; slice < slices; slice++)
 943     {
 944       ximage = convert_EImage_to_XImage (device, width, height,
 945                                          eimage + (width * height * 3 * slice),
 946                                          &pixtbl, &npixels);
 947       if (!ximage)
 948         {
 949           if (pixtbl) xfree (pixtbl);
 950           signal_image_error("EImage to XImage conversion failed", instantiator);
 951         }
 952
 953       /* Now create the pixmap and set up the image instance */
 954       if (slice == 0)
 955         init_image_instance_from_x_image (ii, ximage, dest_mask,
 956                                           cmap, pixtbl, npixels, slices,
 957                                           instantiator);
 958       else
 959         image_instance_add_x_image (ii, ximage, slice, instantiator);
 960
 961       if (ximage)
 962         {
 963           if (ximage->data)
 964             {
 965               xfree (ximage->data);
 966               ximage->data = 0;
 967             }
 968           XDestroyImage (ximage);
 969           ximage = 0;
 970         }
 971     }
 972 }
 973
 974 int read_bitmap_data_from_file (CONST char *filename, unsigned int *width,
 975                                 unsigned int *height, unsigned char **datap,
 976                                 int *x_hot, int *y_hot)
 977 {
 978   return XmuReadBitmapDataFromFile (filename, width, height,
 979                                     datap, x_hot, y_hot);
 980 }
 981
 982 /* Given inline data for a mono pixmap, create and return the
 983    corresponding X object. */
 984
 985 static Pixmap
 986 pixmap_from_xbm_inline (Lisp_Object device, int width, int height,
 987                         /* Note that data is in ext-format! */
 988                         CONST Extbyte *bits)
 989 {
 990   return XCreatePixmapFromBitmapData (DEVICE_X_DISPLAY (XDEVICE(device)),
 991                                       XtWindow (DEVICE_XT_APP_SHELL (XDEVICE (device))),
 992                                       (char *) bits, width, height,
 993                                       1, 0, 1);
 994 }
 995
 996 /* Given inline data for a mono pixmap, initialize the given
 997    image instance accordingly. */
 998
 999 static void
1000 init_image_instance_from_xbm_inline (struct Lisp_Image_Instance *ii,
1001                                      int width, int height,
1002                                      /* Note that data is in ext-format! */
1003                                      CONST char *bits,
1004                                      Lisp_Object instantiator,
1005                                      Lisp_Object pointer_fg,
1006                                      Lisp_Object pointer_bg,
1007                                      int dest_mask,
1008                                      Pixmap mask,
1009                                      Lisp_Object mask_filename)
1010 {
1011   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1012   Lisp_Object foreground = find_keyword_in_vector (instantiator, Q_foreground);
1013   Lisp_Object background = find_keyword_in_vector (instantiator, Q_background);
1014   Display *dpy;
1015   Screen *scr;
1016   Drawable draw;
1017   enum image_instance_type type;
1018
1019   if (!DEVICE_X_P (XDEVICE (device)))
1020     signal_simple_error ("Not an X device", device);
1021
1022   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1023   draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
1024   scr = DefaultScreenOfDisplay (dpy);
1025
1026   if ((dest_mask & IMAGE_MONO_PIXMAP_MASK) &&
1027       (dest_mask & IMAGE_COLOR_PIXMAP_MASK))
1028     {
1029       if (!NILP (foreground) || !NILP (background))
1030         type = IMAGE_COLOR_PIXMAP;
1031       else
1032         type = IMAGE_MONO_PIXMAP;
1033     }
1034   else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
1035     type = IMAGE_MONO_PIXMAP;
1036   else if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
1037     type = IMAGE_COLOR_PIXMAP;
1038   else if (dest_mask & IMAGE_POINTER_MASK)
1039     type = IMAGE_POINTER;
1040   else
1041     incompatible_image_types (instantiator, dest_mask,
1042                               IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
1043                               | IMAGE_POINTER_MASK);
1044
1045   x_initialize_pixmap_image_instance (ii, 1, type);
1046   IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = width;
1047   IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = height;
1048   IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
1049     find_keyword_in_vector (instantiator, Q_file);
1050
1051   switch (type)
1052     {
1053     case IMAGE_MONO_PIXMAP:
1054       {
1055         IMAGE_INSTANCE_X_PIXMAP (ii) =
1056           pixmap_from_xbm_inline (device, width, height, (Extbyte *) bits);
1057       }
1058       break;
1059
1060     case IMAGE_COLOR_PIXMAP:
1061       {
1062         Dimension d = DEVICE_X_DEPTH (XDEVICE(device));
1063         unsigned long fg = BlackPixelOfScreen (scr);
1064         unsigned long bg = WhitePixelOfScreen (scr);
1065
1066         if (!NILP (foreground) && !COLOR_INSTANCEP (foreground))
1067           foreground =
1068             Fmake_color_instance (foreground, device,
1069                                   encode_error_behavior_flag (ERROR_ME));
1070
1071         if (COLOR_INSTANCEP (foreground))
1072           fg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground)).pixel;
1073
1074         if (!NILP (background) && !COLOR_INSTANCEP (background))
1075           background =
1076             Fmake_color_instance (background, device,
1077                                   encode_error_behavior_flag (ERROR_ME));
1078
1079         if (COLOR_INSTANCEP (background))
1080           bg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background)).pixel;
1081
1082         /* We used to duplicate the pixels using XAllocColor(), to protect
1083            against their getting freed.  Just as easy to just store the
1084            color instances here and GC-protect them, so this doesn't
1085            happen. */
1086         IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
1087         IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
1088         IMAGE_INSTANCE_X_PIXMAP (ii) =
1089           XCreatePixmapFromBitmapData (dpy, draw,
1090                                        (char *) bits, width, height,
1091                                        fg, bg, d);
1092         IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = d;
1093       }
1094       break;
1095
1096     case IMAGE_POINTER:
1097     {
1098         XColor fg_color, bg_color;
1099         Pixmap source;
1100
1101         check_pointer_sizes (scr, width, height, instantiator);
1102
1103         source =
1104           XCreatePixmapFromBitmapData (dpy, draw,
1105                                        (char *) bits, width, height,
1106                                        1, 0, 1);
1107
1108         if (NILP (foreground))
1109           foreground = pointer_fg;
1110         if (NILP (background))
1111           background = pointer_bg;
1112         generate_cursor_fg_bg (device, &foreground, &background,
1113                                &fg_color, &bg_color);
1114
1115         IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
1116         IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
1117         IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) =
1118           find_keyword_in_vector (instantiator, Q_hotspot_x);
1119         IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) =
1120           find_keyword_in_vector (instantiator, Q_hotspot_y);
1121         IMAGE_INSTANCE_X_CURSOR (ii) =
1122           XCreatePixmapCursor
1123             (dpy, source, mask, &fg_color, &bg_color,
1124              !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ?
1125              XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) : 0,
1126              !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) ?
1127              XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) : 0);
1128       }
1129       break;
1130
1131     default:
1132       abort ();
1133     }
1134 }
1135
1136 static void
1137 xbm_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator,
1138                    Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1139                    int dest_mask, int width, int height,
1140                    /* Note that data is in ext-format! */
1141                    CONST char *bits)
1142 {
1143   Lisp_Object mask_data = find_keyword_in_vector (instantiator, Q_mask_data);
1144   Lisp_Object mask_file = find_keyword_in_vector (instantiator, Q_mask_file);
1145   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1146   Pixmap mask = 0;
1147   CONST char *gcc_may_you_rot_in_hell;
1148
1149   if (!NILP (mask_data))
1150     {
1151       GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (mask_data))),
1152                                        gcc_may_you_rot_in_hell);
1153       mask =
1154         pixmap_from_xbm_inline (IMAGE_INSTANCE_DEVICE (ii),
1155                                 XINT (XCAR (mask_data)),
1156                                 XINT (XCAR (XCDR (mask_data))),
1157                                 (CONST unsigned char *)
1158                                 gcc_may_you_rot_in_hell);
1159     }
1160
1161   init_image_instance_from_xbm_inline (ii, width, height, bits,
1162                                        instantiator, pointer_fg, pointer_bg,
1163                                        dest_mask, mask, mask_file);
1164 }
1165
1166 /* Instantiate method for XBM's. */
1167
1168 static void
1169 x_xbm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1170                    Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1171                    int dest_mask, Lisp_Object domain)
1172 {
1173   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1174   CONST char *gcc_go_home;
1175
1176   assert (!NILP (data));
1177
1178   GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (data))),
1179                                    gcc_go_home);
1180
1181   xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1182                      pointer_bg, dest_mask, XINT (XCAR (data)),
1183                      XINT (XCAR (XCDR (data))), gcc_go_home);
1184 }
1185
1186 \f
1187 #ifdef HAVE_XPM
1188
1189 /**********************************************************************
1190  *                             XPM                                    *
1191  **********************************************************************/
1192  /* xpm 3.2g and better has XpmCreatePixmapFromBuffer()...
1193     There was no version number in xpm.h before 3.3, but this should do.
1194   */
1195 #if (XpmVersion >= 3) || defined(XpmExactColors)
1196 # define XPM_DOES_BUFFERS
1197 #endif
1198
1199 #ifndef XPM_DOES_BUFFERS
1200 Your version of XPM is too old.  You cannot compile with it.
1201 Upgrade to version 3.2g or better or compile with --with-xpm=no.
1202 #endif /* !XPM_DOES_BUFFERS */
1203
1204 static XpmColorSymbol *
1205 extract_xpm_color_names (XpmAttributes *xpmattrs, Lisp_Object device,
1206                          Lisp_Object domain,
1207                          Lisp_Object color_symbol_alist)
1208 {
1209   /* This function can GC */
1210   Display *dpy =  DEVICE_X_DISPLAY (XDEVICE(device));
1211   Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1212   XColor color;
1213   Lisp_Object rest;
1214   Lisp_Object results = Qnil;
1215   int i;
1216   XpmColorSymbol *symbols;
1217   struct gcpro gcpro1, gcpro2;
1218
1219   GCPRO2 (results, device);
1220
1221   /* We built up results to be (("name" . #<color>) ...) so that if an
1222      error happens we don't lose any malloc()ed data, or more importantly,
1223      leave any pixels allocated in the server. */
1224   i = 0;
1225   LIST_LOOP (rest, color_symbol_alist)
1226     {
1227       Lisp_Object cons = XCAR (rest);
1228       Lisp_Object name = XCAR (cons);
1229       Lisp_Object value = XCDR (cons);
1230       if (NILP (value))
1231         continue;
1232       if (STRINGP (value))
1233         value =
1234           Fmake_color_instance
1235             (value, device, encode_error_behavior_flag (ERROR_ME_NOT));
1236       else
1237         {
1238           assert (COLOR_SPECIFIERP (value));
1239           value = Fspecifier_instance (value, domain, Qnil, Qnil);
1240         }
1241       if (NILP (value))
1242         continue;
1243       results = noseeum_cons (noseeum_cons (name, value), results);
1244       i++;
1245     }
1246   UNGCPRO;                      /* no more evaluation */
1247
1248   if (i == 0) return 0;
1249
1250   symbols = xnew_array (XpmColorSymbol, i);
1251   xpmattrs->valuemask |= XpmColorSymbols;
1252   xpmattrs->colorsymbols = symbols;
1253   xpmattrs->numsymbols = i;
1254
1255   while (--i >= 0)
1256     {
1257       Lisp_Object cons = XCAR (results);
1258       color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (XCDR (cons)));
1259       /* Duplicate the pixel value so that we still have a lock on it if
1260          the pixel we were passed is later freed. */
1261       if (! XAllocColor (dpy, cmap, &color))
1262         abort ();  /* it must be allocable since we're just duplicating it */
1263
1264       symbols [i].name = (char *) XSTRING_DATA (XCAR (cons));
1265       symbols [i].pixel = color.pixel;
1266       symbols [i].value = 0;
1267       free_cons (XCONS (cons));
1268       cons = results;
1269       results = XCDR (results);
1270       free_cons (XCONS (cons));
1271     }
1272   return symbols;
1273 }
1274
1275 static void
1276 xpm_free (XpmAttributes *xpmattrs)
1277 {
1278   /* Could conceivably lose if XpmXXX returned an error without first
1279      initializing this structure, if we didn't know that initializing it
1280      to all zeros was ok (and also that it's ok to call XpmFreeAttributes()
1281      multiple times, since it zeros slots as it frees them...) */
1282   XpmFreeAttributes (xpmattrs);
1283 }
1284
1285 static void
1286 x_xpm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1287                                    Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1288                                    int dest_mask, Lisp_Object domain)
1289 {
1290   /* This function can GC */
1291   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1292   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1293   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1294   Display *dpy;
1295   Screen *xs;
1296   Colormap cmap;
1297   int depth;
1298   Visual *visual;
1299   Pixmap pixmap;
1300   Pixmap mask = 0;
1301   XpmAttributes xpmattrs;
1302   int result;
1303   XpmColorSymbol *color_symbols;
1304   Lisp_Object color_symbol_alist = find_keyword_in_vector (instantiator,
1305                                                            Q_color_symbols);
1306   enum image_instance_type type;
1307   int force_mono;
1308   unsigned int w, h;
1309
1310   if (!DEVICE_X_P (XDEVICE (device)))
1311     signal_simple_error ("Not an X device", device);
1312
1313   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1314   xs = DefaultScreenOfDisplay (dpy);
1315
1316   if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
1317     type = IMAGE_COLOR_PIXMAP;
1318   else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
1319     type = IMAGE_MONO_PIXMAP;
1320   else if (dest_mask & IMAGE_POINTER_MASK)
1321     type = IMAGE_POINTER;
1322   else
1323     incompatible_image_types (instantiator, dest_mask,
1324                               IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
1325                               | IMAGE_POINTER_MASK);
1326   force_mono = (type != IMAGE_COLOR_PIXMAP);
1327
1328 #if 1
1329   /* Although I haven't found it documented yet, it appears that pointers are
1330      always colored via the default window colormap... Sigh. */
1331   if (type == IMAGE_POINTER)
1332     {
1333       cmap = DefaultColormap(dpy, DefaultScreen(dpy));
1334       depth = DefaultDepthOfScreen (xs);
1335       visual = DefaultVisualOfScreen (xs);
1336     }
1337   else
1338     {
1339       cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1340       depth = DEVICE_X_DEPTH (XDEVICE(device));
1341       visual = DEVICE_X_VISUAL (XDEVICE(device));
1342     }
1343 #else
1344   cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1345   depth = DEVICE_X_DEPTH (XDEVICE(device));
1346   visual = DEVICE_X_VISUAL (XDEVICE(device));
1347 #endif
1348
1349   x_initialize_pixmap_image_instance (ii, 1, type);
1350
1351   assert (!NILP (data));
1352
1353  retry:
1354
1355   xzero (xpmattrs); /* want XpmInitAttributes() */
1356   xpmattrs.valuemask = XpmReturnPixels;
1357   if (force_mono)
1358     {
1359       /* Without this, we get a 1-bit version of the color image, which
1360          isn't quite right.  With this, we get the mono image, which might
1361          be very different looking. */
1362       xpmattrs.valuemask |= XpmColorKey;
1363       xpmattrs.color_key = XPM_MONO;
1364       xpmattrs.depth = 1;
1365       xpmattrs.valuemask |= XpmDepth;
1366     }
1367   else
1368     {
1369       xpmattrs.closeness = 65535;
1370       xpmattrs.valuemask |= XpmCloseness;
1371       xpmattrs.depth = depth;
1372       xpmattrs.valuemask |= XpmDepth;
1373       xpmattrs.visual = visual;
1374       xpmattrs.valuemask |= XpmVisual;
1375       xpmattrs.colormap = cmap;
1376       xpmattrs.valuemask |= XpmColormap;
1377     }
1378
1379   color_symbols = extract_xpm_color_names (&xpmattrs, device, domain,
1380                                            color_symbol_alist);
1381
1382   result = XpmCreatePixmapFromBuffer (dpy,
1383                                       XtWindow(DEVICE_XT_APP_SHELL (XDEVICE(device))),
1384                                       (char *) XSTRING_DATA (data),
1385                                       &pixmap, &mask, &xpmattrs);
1386
1387   if (color_symbols)
1388     {
1389       xfree (color_symbols);
1390       xpmattrs.colorsymbols = 0; /* in case XpmFreeAttr is too smart... */
1391       xpmattrs.numsymbols = 0;
1392     }
1393
1394   switch (result)
1395     {
1396     case XpmSuccess:
1397       break;
1398     case XpmFileInvalid:
1399       {
1400         xpm_free (&xpmattrs);
1401         signal_image_error ("invalid XPM data", data);
1402       }
1403     case XpmColorFailed:
1404     case XpmColorError:
1405       {
1406         xpm_free (&xpmattrs);
1407         if (force_mono)
1408           {
1409             /* second time; blow out. */
1410             signal_double_file_error ("Reading pixmap data",
1411                                       "color allocation failed",
1412                                       data);
1413           }
1414         else
1415           {
1416             if (! (dest_mask & IMAGE_MONO_PIXMAP_MASK))
1417               {
1418                 /* second time; blow out. */
1419                 signal_double_file_error ("Reading pixmap data",
1420                                           "color allocation failed",
1421                                           data);
1422               }
1423             force_mono = 1;
1424             IMAGE_INSTANCE_TYPE (ii) = IMAGE_MONO_PIXMAP;
1425             goto retry;
1426           }
1427       }
1428     case XpmNoMemory:
1429       {
1430         xpm_free (&xpmattrs);
1431         signal_double_file_error ("Parsing pixmap data",
1432                                   "out of memory", data);
1433       }
1434     default:
1435       {
1436         xpm_free (&xpmattrs);
1437         signal_double_file_error_2 ("Parsing pixmap data",
1438                                     "unknown error code",
1439                                     make_int (result), data);
1440       }
1441     }
1442
1443   w = xpmattrs.width;
1444   h = xpmattrs.height;
1445
1446   {
1447     int npixels = xpmattrs.npixels;
1448     Pixel *pixels;
1449
1450     if (npixels != 0)
1451       {
1452         pixels = xnew_array (Pixel, npixels);
1453         memcpy (pixels, xpmattrs.pixels, npixels * sizeof (Pixel));
1454       }
1455     else
1456       pixels = NULL;
1457
1458     IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
1459     IMAGE_INSTANCE_PIXMAP_MASK (ii) = (void*)mask;
1460     IMAGE_INSTANCE_X_COLORMAP (ii) = cmap;
1461     IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
1462     IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
1463     IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = w;
1464     IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = h;
1465     IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
1466       find_keyword_in_vector (instantiator, Q_file);
1467   }
1468
1469   switch (type)
1470     {
1471     case IMAGE_MONO_PIXMAP:
1472       break;
1473
1474     case IMAGE_COLOR_PIXMAP:
1475       {
1476         IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = depth;
1477       }
1478       break;
1479
1480     case IMAGE_POINTER:
1481       {
1482         int npixels = xpmattrs.npixels;
1483         Pixel *pixels = xpmattrs.pixels;
1484         XColor fg, bg;
1485         int i;
1486         int xhot = 0, yhot = 0;
1487
1488         if (xpmattrs.valuemask & XpmHotspot)
1489           {
1490             xhot = xpmattrs.x_hotspot;
1491             XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii), xpmattrs.x_hotspot);
1492           }
1493         if (xpmattrs.valuemask & XpmHotspot)
1494           {
1495             yhot = xpmattrs.y_hotspot;
1496             XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii), xpmattrs.y_hotspot);
1497           }
1498         check_pointer_sizes (xs, w, h, instantiator);
1499
1500         /* If the loaded pixmap has colors allocated (meaning it came from an
1501            XPM file), then use those as the default colors for the cursor we
1502            create.  Otherwise, default to pointer_fg and pointer_bg.
1503            */
1504         if (npixels >= 2)
1505           {
1506             /* With an XBM file, it's obvious which bit is foreground
1507                and which is background, or rather, it's implicit: in
1508                an XBM file, a 1 bit is foreground, and a 0 bit is
1509                background.
1510
1511                XCreatePixmapCursor() assumes this property of the
1512                pixmap it is called with as well; the `foreground'
1513                color argument is used for the 1 bits.
1514
1515                With an XPM file, it's tricker, since the elements of
1516                the pixmap don't represent FG and BG, but are actual
1517                pixel values.  So we need to figure out which of those
1518                pixels is the foreground color and which is the
1519                background.  We do it by comparing RGB and assuming
1520                that the darker color is the foreground.  This works
1521                with the result of xbmtopbm|ppmtoxpm, at least.
1522
1523                It might be nice if there was some way to tag the
1524                colors in the XPM file with whether they are the
1525                foreground - perhaps with logical color names somehow?
1526
1527                Once we have decided which color is the foreground, we
1528                need to ensure that that color corresponds to a `1' bit
1529                in the Pixmap.  The XPM library wrote into the (1-bit)
1530                pixmap with XPutPixel, which will ignore all but the
1531                least significant bit.
1532
1533                This means that a 1 bit in the image corresponds to
1534                `fg' only if `fg.pixel' is odd.
1535
1536                (This also means that the image will be all the same
1537                color if both `fg' and `bg' are odd or even, but we can
1538                safely assume that that won't happen if the XPM file is
1539                sensible I think.)
1540
1541                The desired result is that the image use `1' to
1542                represent the foreground color, and `0' to represent
1543                the background color.  So, we may need to invert the
1544                image to accomplish this; we invert if fg is
1545                odd. (Remember that WhitePixel and BlackPixel are not
1546                necessarily 1 and 0 respectively, though I think it
1547                might be safe to assume that one of them is always 1
1548                and the other is always 0.  We also pretty much need to
1549                assume that one is even and the other is odd.)
1550                */
1551
1552             fg.pixel = pixels[0];       /* pick a pixel at random. */
1553             bg.pixel = fg.pixel;
1554             for (i = 1; i < npixels; i++) /* Look for an "other" pixel value.*/
1555               {
1556                 bg.pixel = pixels[i];
1557                 if (fg.pixel != bg.pixel)
1558                   break;
1559               }
1560
1561             /* If (fg.pixel == bg.pixel) then probably something has
1562                gone wrong, but I don't think signalling an error would
1563                be appropriate. */
1564
1565             XQueryColor (dpy, cmap, &fg);
1566             XQueryColor (dpy, cmap, &bg);
1567
1568             /* If the foreground is lighter than the background, swap them.
1569                (This occurs semi-randomly, depending on the ordering of the
1570                color list in the XPM file.)
1571                */
1572             {
1573               unsigned short fg_total = ((fg.red / 3) + (fg.green / 3)
1574                                          + (fg.blue / 3));
1575               unsigned short bg_total = ((bg.red / 3) + (bg.green / 3)
1576                                          + (bg.blue / 3));
1577               if (fg_total > bg_total)
1578                 {
1579                   XColor swap;
1580                   swap = fg;
1581                   fg = bg;
1582                   bg = swap;
1583                 }
1584             }
1585
1586             /* If the fg pixel corresponds to a `0' in the bitmap, invert it.
1587                (This occurs (only?) on servers with Black=0, White=1.)
1588                */
1589             if ((fg.pixel & 1) == 0)
1590               {
1591                 XGCValues gcv;
1592                 GC gc;
1593                 gcv.function = GXxor;
1594                 gcv.foreground = 1;
1595                 gc = XCreateGC (dpy, pixmap, (GCFunction | GCForeground),
1596                                 &gcv);
1597                 XFillRectangle (dpy, pixmap, gc, 0, 0, w, h);
1598                 XFreeGC (dpy, gc);
1599               }
1600           }
1601         else
1602           {
1603             generate_cursor_fg_bg (device, &pointer_fg, &pointer_bg,
1604                                    &fg, &bg);
1605             IMAGE_INSTANCE_PIXMAP_FG (ii) = pointer_fg;
1606             IMAGE_INSTANCE_PIXMAP_BG (ii) = pointer_bg;
1607           }
1608
1609         IMAGE_INSTANCE_X_CURSOR (ii) =
1610           XCreatePixmapCursor
1611             (dpy, pixmap, mask, &fg, &bg, xhot, yhot);
1612       }
1613
1614       break;
1615
1616     default:
1617       abort ();
1618     }
1619
1620   xpm_free (&xpmattrs); /* after we've read pixels and hotspot */
1621 }
1622
1623 #endif /* HAVE_XPM */
1624
1625 \f
1626 #ifdef HAVE_XFACE
1627
1628 /**********************************************************************
1629  *                             X-Face                                 *
1630  **********************************************************************/
1631 #if defined(EXTERN)
1632 /* This is about to get redefined! */
1633 #undef EXTERN
1634 #endif
1635 /* We have to define SYSV32 so that compface.h includes string.h
1636    instead of strings.h. */
1637 #define SYSV32
1638 #ifdef __cplusplus
1639 extern "C" {
1640 #endif
1641 #include <compface.h>
1642 #ifdef __cplusplus
1643 }
1644 #endif
1645 /* JMP_BUF cannot be used here because if it doesn't get defined
1646    to jmp_buf we end up with a conflicting type error with the
1647    definition in compface.h */
1648 extern jmp_buf comp_env;
1649 #undef SYSV32
1650
1651 static void
1652 x_xface_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1653                      Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1654                      int dest_mask, Lisp_Object domain)
1655 {
1656   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1657   int i, stattis;
1658   char *p, *bits, *bp;
1659   CONST char * volatile emsg = 0;
1660   CONST char * volatile dstring;
1661
1662   assert (!NILP (data));
1663
1664   GET_C_STRING_BINARY_DATA_ALLOCA (data, dstring);
1665
1666   if ((p = strchr (dstring, ':')))
1667     {
1668       dstring = p + 1;
1669     }
1670
1671   /* Must use setjmp not SETJMP because we used jmp_buf above not JMP_BUF */
1672   if (!(stattis = setjmp (comp_env)))
1673     {
1674       UnCompAll ((char *) dstring);
1675       UnGenFace ();
1676     }
1677
1678   switch (stattis)
1679     {
1680     case -2:
1681       emsg = "uncompface: internal error";
1682       break;
1683     case -1:
1684       emsg = "uncompface: insufficient or invalid data";
1685       break;
1686     case 1:
1687       emsg = "uncompface: excess data ignored";
1688       break;
1689     }
1690
1691   if (emsg)
1692     signal_simple_error_2 (emsg, data, Qimage);
1693
1694   bp = bits = (char *) alloca (PIXELS / 8);
1695
1696   /* the compface library exports char F[], which uses a single byte per
1697      pixel to represent a 48x48 bitmap.  Yuck. */
1698   for (i = 0, p = F; i < (PIXELS / 8); ++i)
1699     {
1700       int n, b;
1701       /* reverse the bit order of each byte... */
1702       for (b = n = 0; b < 8; ++b)
1703         {
1704           n |= ((*p++) << b);
1705         }
1706       *bp++ = (char) n;
1707     }
1708
1709   xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1710                      pointer_bg, dest_mask, 48, 48, bits);
1711 }
1712
1713 #endif /* HAVE_XFACE */
1714
1715 \f
1716 /**********************************************************************
1717  *                       Autodetect                                      *
1718  **********************************************************************/
1719
1720 static void
1721 autodetect_validate (Lisp_Object instantiator)
1722 {
1723   data_must_be_present (instantiator);
1724 }
1725
1726 static Lisp_Object
1727 autodetect_normalize (Lisp_Object instantiator,
1728                                 Lisp_Object console_type)
1729 {
1730   Lisp_Object file = find_keyword_in_vector (instantiator, Q_data);
1731   Lisp_Object filename = Qnil;
1732   Lisp_Object data = Qnil;
1733   struct gcpro gcpro1, gcpro2, gcpro3;
1734   Lisp_Object alist = Qnil;
1735
1736   GCPRO3 (filename, data, alist);
1737
1738   if (NILP (file)) /* no conversion necessary */
1739     RETURN_UNGCPRO (instantiator);
1740
1741   alist = tagged_vector_to_alist (instantiator);
1742
1743   filename = locate_pixmap_file (file);
1744   if (!NILP (filename))
1745     {
1746       int xhot, yhot;
1747       /* #### Apparently some versions of XpmReadFileToData, which is
1748          called by pixmap_to_lisp_data, don't return an error value
1749          if the given file is not a valid XPM file.  Instead, they
1750          just seg fault.  It is definitely caused by passing a
1751          bitmap.  To try and avoid this we check for bitmaps first.  */
1752
1753       data = bitmap_to_lisp_data (filename, &xhot, &yhot, 1);
1754
1755       if (!EQ (data, Qt))
1756         {
1757           alist = remassq_no_quit (Q_data, alist);
1758           alist = Fcons (Fcons (Q_file, filename),
1759                          Fcons (Fcons (Q_data, data), alist));
1760           if (xhot != -1)
1761             alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
1762                            alist);
1763           if (yhot != -1)
1764             alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
1765                            alist);
1766
1767           alist = xbm_mask_file_munging (alist, filename, Qnil, console_type);
1768
1769           {
1770             Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
1771             free_alist (alist);
1772             RETURN_UNGCPRO (result);
1773           }
1774         }
1775
1776 #ifdef HAVE_XPM
1777       data = pixmap_to_lisp_data (filename, 1);
1778
1779       if (!EQ (data, Qt))
1780         {
1781           alist = remassq_no_quit (Q_data, alist);
1782           alist = Fcons (Fcons (Q_file, filename),
1783                          Fcons (Fcons (Q_data, data), alist));
1784           alist = Fcons (Fcons (Q_color_symbols,
1785                                 evaluate_xpm_color_symbols ()),
1786                          alist);
1787           {
1788             Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
1789             free_alist (alist);
1790             RETURN_UNGCPRO (result);
1791           }
1792         }
1793 #endif
1794     }
1795
1796   /* If we couldn't convert it, just put it back as it is.
1797      We might try to further frob it later as a cursor-font
1798      specification. (We can't do that now because we don't know
1799      what dest-types it's going to be instantiated into.) */
1800   {
1801     Lisp_Object result = alist_to_tagged_vector (Qautodetect, alist);
1802     free_alist (alist);
1803     RETURN_UNGCPRO (result);
1804   }
1805 }
1806
1807 static int
1808 autodetect_possible_dest_types (void)
1809 {
1810   return
1811     IMAGE_MONO_PIXMAP_MASK  |
1812     IMAGE_COLOR_PIXMAP_MASK |
1813     IMAGE_POINTER_MASK      |
1814     IMAGE_TEXT_MASK;
1815 }
1816
1817 static void
1818 autodetect_instantiate (Lisp_Object image_instance,
1819                                   Lisp_Object instantiator,
1820                                   Lisp_Object pointer_fg,
1821                                   Lisp_Object pointer_bg,
1822                                   int dest_mask, Lisp_Object domain)
1823 {
1824   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1825   struct gcpro gcpro1, gcpro2, gcpro3;
1826   Lisp_Object alist = Qnil;
1827   Lisp_Object result = Qnil;
1828   int is_cursor_font = 0;
1829
1830   GCPRO3 (data, alist, result);
1831
1832   alist = tagged_vector_to_alist (instantiator);
1833   if (dest_mask & IMAGE_POINTER_MASK)
1834     {
1835       CONST char *name_ext;
1836       GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext);
1837       if (XmuCursorNameToIndex (name_ext) != -1)
1838         {
1839           result = alist_to_tagged_vector (Qcursor_font, alist);
1840           is_cursor_font = 1;
1841         }
1842     }
1843
1844   if (!is_cursor_font)
1845     result = alist_to_tagged_vector (Qstring, alist);
1846   free_alist (alist);
1847
1848   if (is_cursor_font)
1849     cursor_font_instantiate (image_instance, result, pointer_fg,
1850                              pointer_bg, dest_mask, domain);
1851   else
1852     string_instantiate (image_instance, result, pointer_fg,
1853                         pointer_bg, dest_mask, domain);
1854
1855   UNGCPRO;
1856 }
1857
1858 \f
1859 /**********************************************************************
1860  *                              Font                                  *
1861  **********************************************************************/
1862
1863 static void
1864 font_validate (Lisp_Object instantiator)
1865 {
1866   data_must_be_present (instantiator);
1867 }
1868
1869 /* XmuCvtStringToCursor is bogus in the following ways:
1870
1871    - When it can't convert the given string to a real cursor, it will
1872      sometimes return a "success" value, after triggering a BadPixmap
1873      error.  It then gives you a cursor that will itself generate BadCursor
1874      errors.  So we install this error handler to catch/notice the X error
1875      and take that as meaning "couldn't convert."
1876
1877    - When you tell it to find a cursor file that doesn't exist, it prints
1878      an error message on stderr.  You can't make it not do that.
1879
1880    - Also, using Xmu means we can't properly hack Lisp_Image_Instance
1881      objects, or XPM files, or $XBMLANGPATH.
1882  */
1883
1884 /* Duplicate the behavior of XmuCvtStringToCursor() to bypass its bogusness. */
1885
1886 static int XLoadFont_got_error;
1887
1888 static int
1889 XLoadFont_error_handler (Display *dpy, XErrorEvent *xerror)
1890 {
1891   XLoadFont_got_error = 1;
1892   return 0;
1893 }
1894
1895 static Font
1896 safe_XLoadFont (Display *dpy, char *name)
1897 {
1898   Font font;
1899   int (*old_handler) (Display *, XErrorEvent *);
1900   XLoadFont_got_error = 0;
1901   XSync (dpy, 0);
1902   old_handler = XSetErrorHandler (XLoadFont_error_handler);
1903   font = XLoadFont (dpy, name);
1904   XSync (dpy, 0);
1905   XSetErrorHandler (old_handler);
1906   if (XLoadFont_got_error) return 0;
1907   return font;
1908 }
1909
1910 static int
1911 font_possible_dest_types (void)
1912 {
1913   return IMAGE_POINTER_MASK;
1914 }
1915
1916 static void
1917 font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1918                   Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1919                   int dest_mask, Lisp_Object domain)
1920 {
1921   /* This function can GC */
1922   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1923   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1924   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1925   Display *dpy;
1926   XColor fg, bg;
1927   Font source, mask;
1928   char source_name[MAXPATHLEN], mask_name[MAXPATHLEN], dummy;
1929   int source_char, mask_char;
1930   int count;
1931   Lisp_Object foreground, background;
1932
1933   if (!DEVICE_X_P (XDEVICE (device)))
1934     signal_simple_error ("Not an X device", device);
1935
1936   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1937
1938   if (!STRINGP (data) ||
1939       strncmp ("FONT ", (char *) XSTRING_DATA (data), 5))
1940     signal_simple_error ("Invalid font-glyph instantiator",
1941                          instantiator);
1942
1943   if (!(dest_mask & IMAGE_POINTER_MASK))
1944     incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
1945
1946   foreground = find_keyword_in_vector (instantiator, Q_foreground);
1947   if (NILP (foreground))
1948     foreground = pointer_fg;
1949   background = find_keyword_in_vector (instantiator, Q_background);
1950   if (NILP (background))
1951     background = pointer_bg;
1952
1953   generate_cursor_fg_bg (device, &foreground, &background, &fg, &bg);
1954
1955   count = sscanf ((char *) XSTRING_DATA (data),
1956                   "FONT %s %d %s %d %c",
1957                   source_name, &source_char,
1958                   mask_name, &mask_char, &dummy);
1959   /* Allow "%s %d %d" as well... */
1960   if (count == 3 && (1 == sscanf (mask_name, "%d %c", &mask_char, &dummy)))
1961     count = 4, mask_name[0] = 0;
1962
1963   if (count != 2 && count != 4)
1964     signal_simple_error ("invalid cursor specification", data);
1965   source = safe_XLoadFont (dpy, source_name);
1966   if (! source)
1967     signal_simple_error_2 ("couldn't load font",
1968                            build_string (source_name),
1969                            data);
1970   if (count == 2)
1971     mask = 0;
1972   else if (!mask_name[0])
1973     mask = source;
1974   else
1975     {
1976       mask = safe_XLoadFont (dpy, mask_name);
1977       if (!mask)
1978         /* continuable */
1979         Fsignal (Qerror, list3 (build_string ("couldn't load font"),
1980                                 build_string (mask_name), data));
1981     }
1982   if (!mask)
1983     mask_char = 0;
1984
1985   /* #### call XQueryTextExtents() and check_pointer_sizes() here. */
1986
1987   x_initialize_pixmap_image_instance (ii, 1, IMAGE_POINTER);
1988   IMAGE_INSTANCE_X_CURSOR (ii) =
1989     XCreateGlyphCursor (dpy, source, mask, source_char, mask_char,
1990                         &fg, &bg);
1991   XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
1992   XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
1993   XUnloadFont (dpy, source);
1994   if (mask && mask != source) XUnloadFont (dpy, mask);
1995 }
1996
1997 \f
1998 /**********************************************************************
1999  *                           Cursor-Font                              *
2000  **********************************************************************/
2001
2002 static void
2003 cursor_font_validate (Lisp_Object instantiator)
2004 {
2005   data_must_be_present (instantiator);
2006 }
2007
2008 static int
2009 cursor_font_possible_dest_types (void)
2010 {
2011   return IMAGE_POINTER_MASK;
2012 }
2013
2014 static void
2015 cursor_font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2016                          Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2017                          int dest_mask, Lisp_Object domain)
2018 {
2019   /* This function can GC */
2020   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
2021   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2022   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
2023   Display *dpy;
2024   int i;
2025   CONST char *name_ext;
2026   Lisp_Object foreground, background;
2027
2028   if (!DEVICE_X_P (XDEVICE (device)))
2029     signal_simple_error ("Not an X device", device);
2030
2031   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2032
2033   if (!(dest_mask & IMAGE_POINTER_MASK))
2034     incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
2035
2036   GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext);
2037   if ((i = XmuCursorNameToIndex (name_ext)) == -1)
2038     signal_simple_error ("Unrecognized cursor-font name", data);
2039
2040   x_initialize_pixmap_image_instance (ii, 1, IMAGE_POINTER);
2041   IMAGE_INSTANCE_X_CURSOR (ii) = XCreateFontCursor (dpy, i);
2042   foreground = find_keyword_in_vector (instantiator, Q_foreground);
2043   if (NILP (foreground))
2044     foreground = pointer_fg;
2045   background = find_keyword_in_vector (instantiator, Q_background);
2046   if (NILP (background))
2047     background = pointer_bg;
2048   maybe_recolor_cursor (image_instance, foreground, background);
2049 }
2050
2051 static int
2052 x_colorize_image_instance (Lisp_Object image_instance,
2053                            Lisp_Object foreground, Lisp_Object background)
2054 {
2055   struct Lisp_Image_Instance *p;
2056
2057   p = XIMAGE_INSTANCE (image_instance);
2058
2059   switch (IMAGE_INSTANCE_TYPE (p))
2060     {
2061     case IMAGE_MONO_PIXMAP:
2062       IMAGE_INSTANCE_TYPE (p) = IMAGE_COLOR_PIXMAP;
2063       /* Make sure there aren't two pointers to the same mask, causing
2064          it to get freed twice. */
2065       IMAGE_INSTANCE_PIXMAP_MASK (p) = 0;
2066       break;
2067
2068     default:
2069       return 0;
2070     }
2071
2072   {
2073     Display *dpy = DEVICE_X_DISPLAY (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
2074     Drawable draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (IMAGE_INSTANCE_DEVICE (p))));
2075     Dimension d = DEVICE_X_DEPTH (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
2076     Pixmap new = XCreatePixmap (dpy, draw,
2077                                 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
2078                                 IMAGE_INSTANCE_PIXMAP_HEIGHT (p), d);
2079     XColor color;
2080     XGCValues gcv;
2081     GC gc;
2082     color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground));
2083     gcv.foreground = color.pixel;
2084     color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background));
2085     gcv.background = color.pixel;
2086     gc = XCreateGC (dpy, new, GCBackground|GCForeground, &gcv);
2087     XCopyPlane (dpy, IMAGE_INSTANCE_X_PIXMAP (p), new, gc, 0, 0,
2088                 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
2089                 IMAGE_INSTANCE_PIXMAP_HEIGHT (p),
2090                 0, 0, 1);
2091     XFreeGC (dpy, gc);
2092     IMAGE_INSTANCE_X_PIXMAP (p) = new;
2093     IMAGE_INSTANCE_PIXMAP_DEPTH (p) = d;
2094     IMAGE_INSTANCE_PIXMAP_FG (p) = foreground;
2095     IMAGE_INSTANCE_PIXMAP_BG (p) = background;
2096     return 1;
2097   }
2098 }
2099
2100 \f
2101 /************************************************************************/
2102 /*                      subwindow and widget support                      */
2103 /************************************************************************/
2104
2105 /* unmap the image if it is a widget. This is used by redisplay via
2106    redisplay_unmap_subwindows */
2107 static void
2108 x_unmap_subwindow (struct Lisp_Image_Instance *p)
2109 {
2110   if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
2111     {
2112       XUnmapWindow
2113         (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2114          IMAGE_INSTANCE_X_CLIPWINDOW (p));
2115     }
2116   else                          /* must be a widget */
2117     {
2118       XtUnmapWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p));
2119     }
2120 }
2121
2122 /* map the subwindow. This is used by redisplay via
2123    redisplay_output_subwindow */
2124 static void
2125 x_map_subwindow (struct Lisp_Image_Instance *p, int x, int y,
2126                  struct display_glyph_area* dga)
2127 {
2128   if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
2129     {
2130       Window subwindow = IMAGE_INSTANCE_X_SUBWINDOW_ID (p);
2131       XMoveResizeWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2132                          IMAGE_INSTANCE_X_CLIPWINDOW (p),
2133                          x, y, dga->width, dga->height);
2134       XMoveWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2135                    subwindow, -dga->xoffset, -dga->yoffset);
2136       XMapWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2137                   IMAGE_INSTANCE_X_CLIPWINDOW (p));
2138     }
2139   else                          /* must be a widget */
2140     {
2141       XtConfigureWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p),
2142                          x + IMAGE_INSTANCE_X_WIDGET_XOFFSET (p),
2143                          y + IMAGE_INSTANCE_X_WIDGET_YOFFSET (p),
2144                          dga->width, dga->height, 0);
2145       XtMoveWidget (IMAGE_INSTANCE_X_WIDGET_ID (p),
2146                     -dga->xoffset, -dga->yoffset);
2147       XtMapWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p));
2148     }
2149 }
2150
2151 /* when you click on a widget you may activate another widget this
2152    needs to be checked and all appropriate widgets updated */
2153 static void
2154 x_update_subwindow (struct Lisp_Image_Instance *p)
2155 {
2156 #ifdef HAVE_WIDGETS
2157   if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET)
2158     {
2159       Arg al[5];
2160       widget_value* wv = gui_items_to_widget_values
2161         (IMAGE_INSTANCE_WIDGET_ITEMS (p));
2162
2163       /* This seems ugly, but I'm not sure what else to do. */
2164       if (EQ (IMAGE_INSTANCE_WIDGET_TYPE (p), Qtab_control))
2165         {
2166           widget_value* cur = 0;
2167           /* Give each child label the correct foreground color. */
2168           Lisp_Object pixel = FACE_FOREGROUND
2169             (IMAGE_INSTANCE_WIDGET_FACE (p),
2170              IMAGE_INSTANCE_SUBWINDOW_FRAME (p));
2171           XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2172           XtSetArg (al [0], XtNtabForeground, fcolor.pixel);
2173
2174           for (cur = wv->contents; cur; cur = cur->next)
2175             {
2176               if (cur->value)
2177                 {
2178                   cur->nargs = 1;
2179                   cur->args = al;
2180                 }
2181             }
2182         }
2183
2184       /* now modify the widget */
2185       lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (p),
2186                              wv, True);
2187       free_widget_value_tree (wv);
2188       /* update the colors and font */
2189       update_widget_face (p, IMAGE_INSTANCE_SUBWINDOW_FRAME (p));
2190       /* We have to do this otherwise Motif will unceremoniously
2191          resize us when the label gets set. */
2192       XtSetArg (al [0], XtNwidth, IMAGE_INSTANCE_WIDGET_WIDTH (p));
2193       XtSetArg (al [1], XtNheight, IMAGE_INSTANCE_WIDGET_HEIGHT (p));
2194       XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (p), al, 2);
2195     }
2196 #endif
2197 }
2198
2199 /* instantiate and x type subwindow */
2200 static void
2201 x_subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2202                         Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2203                         int dest_mask, Lisp_Object domain)
2204 {
2205   /* This function can GC */
2206   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2207   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
2208   Lisp_Object frame = FW_FRAME (domain);
2209   struct frame* f = XFRAME (frame);
2210   Display *dpy;
2211   Screen *xs;
2212   Window pw, win;
2213   XSetWindowAttributes xswa;
2214   Mask valueMask = 0;
2215   unsigned int w = IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii),
2216     h = IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii);
2217
2218   if (!DEVICE_X_P (XDEVICE (device)))
2219     signal_simple_error ("Not an X device", device);
2220
2221   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2222   xs = DefaultScreenOfDisplay (dpy);
2223
2224   IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW;
2225
2226   pw = XtWindow (FRAME_X_TEXT_WIDGET (f));
2227
2228   ii->data = xnew_and_zero (struct x_subwindow_data);
2229
2230   IMAGE_INSTANCE_X_SUBWINDOW_PARENT (ii) = pw;
2231   IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (ii) = DisplayOfScreen (xs);
2232
2233   xswa.backing_store = Always;
2234   valueMask |= CWBackingStore;
2235   xswa.colormap = DefaultColormapOfScreen (xs);
2236   valueMask |= CWColormap;
2237
2238   /* Create a window for clipping */
2239   IMAGE_INSTANCE_X_CLIPWINDOW (ii) =
2240     XCreateWindow (dpy, pw, 0, 0, w, h, 0, CopyFromParent,
2241                    InputOutput, CopyFromParent, valueMask,
2242                    &xswa);
2243
2244   /* Now put the subwindow inside the clip window. */
2245   win = XCreateWindow (dpy, IMAGE_INSTANCE_X_CLIPWINDOW (ii),
2246                        0, 0, w, h, 0, CopyFromParent,
2247                        InputOutput, CopyFromParent, valueMask,
2248                        &xswa);
2249
2250   IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)win;
2251 }
2252
2253 #if 0
2254 /* #### Should this function exist? If there's any doubt I'm not implementing it --andyp */
2255 DEFUN ("change-subwindow-property", Fchange_subwindow_property, 3, 3, 0, /*
2256 For the given SUBWINDOW, set PROPERTY to DATA, which is a string.
2257 Subwindows are not currently implemented.
2258 */
2259        (subwindow, property, data))
2260 {
2261   Atom property_atom;
2262   struct Lisp_Subwindow *sw;
2263   Display *dpy;
2264
2265   CHECK_SUBWINDOW (subwindow);
2266   CHECK_STRING (property);
2267   CHECK_STRING (data);
2268
2269   sw = XSUBWINDOW (subwindow);
2270   dpy = DisplayOfScreen (LISP_DEVICE_TO_X_SCREEN
2271                          (FRAME_DEVICE (XFRAME (sw->frame))));
2272
2273   property_atom = XInternAtom (dpy, (char *) XSTRING_DATA (property), False);
2274   XChangeProperty (dpy, sw->subwindow, property_atom, XA_STRING, 8,
2275                    PropModeReplace,
2276                    XSTRING_DATA   (data),
2277                    XSTRING_LENGTH (data));
2278
2279   return property;
2280 }
2281 #endif
2282
2283 static void
2284 x_resize_subwindow (struct Lisp_Image_Instance* ii, int w, int h)
2285 {
2286   if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
2287     {
2288       XResizeWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (ii),
2289                      IMAGE_INSTANCE_X_SUBWINDOW_ID (ii),
2290                      w, h);
2291     }
2292   else                          /* must be a widget */
2293     {
2294       Arg al[2];
2295
2296       if (!XtIsRealized (IMAGE_INSTANCE_X_WIDGET_ID (ii)))
2297         {
2298           Lisp_Object sw;
2299           XSETIMAGE_INSTANCE (sw, ii);
2300           signal_simple_error ("XEmacs bug: subwindow is not realized", sw);
2301         }
2302
2303       XtSetArg (al [0], XtNwidth, (Dimension)w);
2304       XtSetArg (al [1], XtNheight, (Dimension)h);
2305       XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 2);
2306     }
2307 }
2308
2309 \f
2310 #ifdef HAVE_WIDGETS
2311
2312 /************************************************************************/
2313 /*                            widgets                            */
2314 /************************************************************************/
2315
2316 static void
2317 update_widget_face (struct Lisp_Image_Instance* ii, Lisp_Object domain)
2318 {
2319   Arg al[3];
2320 #ifdef LWLIB_WIDGETS_MOTIF
2321   XmFontList fontList;
2322 #endif
2323
2324   Lisp_Object pixel = FACE_FOREGROUND
2325     (IMAGE_INSTANCE_WIDGET_FACE (ii),
2326      IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2327   XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2328   XColor bcolor;
2329
2330   pixel = FACE_BACKGROUND
2331     (IMAGE_INSTANCE_WIDGET_FACE (ii),
2332      IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2333   bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2334
2335   XtSetArg (al [0], XtNbackground, bcolor.pixel);
2336   XtSetArg (al [1], XtNforeground, fcolor.pixel);
2337
2338 #ifdef LWLIB_WIDGETS_MOTIF
2339   fontList = XmFontListCreate
2340     (FONT_INSTANCE_X_FONT
2341      (XFONT_INSTANCE (widget_face_font_info
2342                       (domain, IMAGE_INSTANCE_WIDGET_FACE (ii),
2343                        0, 0))), XmSTRING_DEFAULT_CHARSET);
2344   XtSetArg (al [2], XmNfontList, fontList );
2345 #else
2346   XtSetArg (al [2], XtNfont, (void*)FONT_INSTANCE_X_FONT
2347             (XFONT_INSTANCE (widget_face_font_info
2348                              (domain,
2349                               IMAGE_INSTANCE_WIDGET_FACE (ii),
2350                               0, 0))));
2351 #endif
2352   XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 3);
2353 #ifdef LWLIB_WIDGETS_MOTIF
2354   XmFontListFree (fontList);
2355 #endif
2356 }
2357
2358 static void
2359 x_widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2360                       Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2361                       int dest_mask, Lisp_Object domain,
2362                       CONST char* type, widget_value* wv)
2363 {
2364   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2365   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii), pixel;
2366   struct device* d = XDEVICE (device);
2367   Lisp_Object frame = FW_FRAME (domain);
2368   struct frame* f = XFRAME (frame);
2369   char* nm=0;
2370   Widget wid;
2371   Arg al [32];
2372   int ac = 0;
2373   int id = new_lwlib_id ();
2374   widget_value* clip_wv;
2375   XColor fcolor, bcolor;
2376
2377   if (!DEVICE_X_P (d))
2378     signal_simple_error ("Not an X device", device);
2379
2380   /* have to set the type this late in case there is no device
2381      instantiation for a widget. But we can go ahead and do it without
2382      checking because there is always a generic instantiator. */
2383   IMAGE_INSTANCE_TYPE (ii) = IMAGE_WIDGET;
2384
2385   if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
2386     GET_C_STRING_OS_DATA_ALLOCA (IMAGE_INSTANCE_WIDGET_TEXT (ii), nm);
2387
2388   ii->data = xnew_and_zero (struct x_subwindow_data);
2389
2390   /* Create a clip window to contain the subwidget. Incredibly the
2391      XEmacs manager seems to be the most appropriate widget for
2392      this. Nothing else is simple enough and yet does what is
2393      required. */
2394   clip_wv = xmalloc_widget_value ();
2395
2396   XtSetArg (al [ac], XtNresize, False);                 ac++;
2397   XtSetArg (al [ac], XtNwidth,
2398             (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii)); ac++;
2399   XtSetArg (al [ac], XtNheight,
2400             (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); ac++;
2401
2402   clip_wv->enabled = True;
2403   clip_wv->nargs = ac;
2404   clip_wv->args = al;
2405   clip_wv->name = xstrdup ("clip-window");
2406   clip_wv->value = xstrdup ("clip-window");
2407
2408   IMAGE_INSTANCE_X_CLIPWIDGET (ii)
2409     = lw_create_widget ("clip-window", "clip-window", new_lwlib_id (),
2410                         clip_wv, FRAME_X_CONTAINER_WIDGET (f),
2411                         False, 0, 0, 0);
2412
2413   free_widget_value_tree (clip_wv);
2414
2415   /* copy any args we were given */
2416   ac = 0;
2417
2418   if (wv->nargs)
2419     lw_add_value_args_to_args (wv, al, &ac);
2420
2421   /* Fixup the colors. We have to do this *before* the widget gets
2422      created so that Motif will fix up the shadow colors
2423      correctly. Once the widget is created Motif won't do this
2424      anymore...*/
2425   pixel = FACE_FOREGROUND
2426     (IMAGE_INSTANCE_WIDGET_FACE (ii),
2427      IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2428   fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2429
2430   pixel = FACE_BACKGROUND
2431     (IMAGE_INSTANCE_WIDGET_FACE (ii),
2432      IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2433   bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2434
2435   XtSetArg (al [ac], XtNbackground, bcolor.pixel);              ac++;
2436   XtSetArg (al [ac], XtNforeground, fcolor.pixel);              ac++;
2437   /* we cannot allow widgets to resize themselves */
2438   XtSetArg (al [ac], XtNresize, False);                 ac++;
2439   XtSetArg (al [ac], XtNwidth,
2440             (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii)); ac++;
2441   XtSetArg (al [ac], XtNheight,
2442             (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); ac++;
2443
2444   wv->nargs = ac;
2445   wv->args = al;
2446
2447   wid = lw_create_widget (type, wv->name, id, wv, IMAGE_INSTANCE_X_CLIPWIDGET (ii),
2448                           False, 0, popup_selection_callback, 0);
2449
2450   IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)wid;
2451   IMAGE_INSTANCE_X_WIDGET_LWID (ii) = id;
2452
2453   /* update the font. */
2454   update_widget_face (ii, domain);
2455
2456   /* Resize the widget here so that the values do not get copied by
2457      lwlib. */
2458   ac = 0;
2459   XtSetArg (al [ac], XtNwidth,
2460             (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii)); ac++;
2461   XtSetArg (al [ac], XtNheight,
2462             (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); ac++;
2463   XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, ac);
2464   /* because the EmacsManager is the widgets parent we have to
2465      offset the redisplay of the widget by the amount the text
2466      widget is inside the manager. */
2467   ac = 0;
2468   XtSetArg (al [ac], XtNx, &IMAGE_INSTANCE_X_WIDGET_XOFFSET (ii)); ac++;
2469   XtSetArg (al [ac], XtNy, &IMAGE_INSTANCE_X_WIDGET_YOFFSET (ii)); ac++;
2470   XtGetValues (FRAME_X_TEXT_WIDGET (f), al, ac);
2471
2472   XtMapWidget (wid);
2473
2474   free_widget_value_tree (wv);
2475 }
2476
2477 static Lisp_Object
2478 x_widget_set_property (Lisp_Object image_instance, Lisp_Object prop,
2479                        Lisp_Object val)
2480 {
2481   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2482
2483   if (EQ (prop, Q_text))
2484     {
2485       char* str;
2486       widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2487       CHECK_STRING (val);
2488       GET_C_STRING_OS_DATA_ALLOCA (val, str);
2489       wv->value = str;
2490       lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, False);
2491       return Qt;
2492     }
2493   /* Modify the face properties of the widget */
2494   if (EQ (prop, Q_face))
2495     {
2496       update_widget_face (ii, IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2497       return Qt;
2498     }
2499   return Qunbound;
2500 }
2501
2502 /* get properties of a control */
2503 static Lisp_Object
2504 x_widget_property (Lisp_Object image_instance, Lisp_Object prop)
2505 {
2506   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2507   /* get the text from a control */
2508   if (EQ (prop, Q_text))
2509     {
2510       widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2511       return build_ext_string (wv->value, FORMAT_OS);
2512     }
2513   return Qunbound;
2514 }
2515
2516 /* Instantiate a button widget. Unfortunately instantiated widgets are
2517    particular to a frame since they need to have a parent. It's not
2518    like images where you just select the image into the context you
2519    want to display it in and BitBlt it. So images instances can have a
2520    many-to-one relationship with things you see, whereas widgets can
2521    only be one-to-one (i.e. per frame) */
2522 static void
2523 x_button_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2524                       Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2525                       int dest_mask, Lisp_Object domain)
2526 {
2527   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2528   Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2529   Lisp_Object glyph = find_keyword_in_vector (instantiator, Q_image);
2530   widget_value* wv = xmalloc_widget_value ();
2531
2532   button_item_to_widget_value (gui, wv, 1, 1);
2533
2534   if (!NILP (glyph))
2535     {
2536       if (!IMAGE_INSTANCEP (glyph))
2537         glyph = glyph_image_instance (glyph, domain, ERROR_ME, 1);
2538     }
2539
2540   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2541                         pointer_bg, dest_mask, domain, "button", wv);
2542
2543   /* add the image if one was given */
2544   if (!NILP (glyph) && IMAGE_INSTANCEP (glyph))
2545     {
2546       Arg al [2];
2547       int ac =0;
2548 #ifdef LWLIB_WIDGETS_MOTIF
2549       XtSetArg (al [ac], XmNlabelType, XmPIXMAP);       ac++;
2550       XtSetArg (al [ac], XmNlabelPixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph));ac++;
2551 #else
2552       XtSetArg (al [ac], XtNpixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph));  ac++;
2553 #endif
2554       XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, ac);
2555     }
2556 }
2557
2558 /* get properties of a button */
2559 static Lisp_Object
2560 x_button_property (Lisp_Object image_instance, Lisp_Object prop)
2561 {
2562   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2563   /* check the state of a button */
2564   if (EQ (prop, Q_selected))
2565     {
2566       widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2567
2568       if (wv->selected)
2569         return Qt;
2570       else
2571         return Qnil;
2572     }
2573   return Qunbound;
2574 }
2575
2576 /* instantiate a progress gauge */
2577 static void
2578 x_progress_gauge_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2579                         Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2580                         int dest_mask, Lisp_Object domain)
2581 {
2582   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2583   Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2584   widget_value* wv = xmalloc_widget_value ();
2585
2586   button_item_to_widget_value (gui, wv, 1, 1);
2587
2588   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2589                         pointer_bg, dest_mask, domain, "progress", wv);
2590 }
2591
2592 /* set the properties of a progres guage */
2593 static Lisp_Object
2594 x_progress_gauge_set_property (Lisp_Object image_instance, Lisp_Object prop,
2595                          Lisp_Object val)
2596 {
2597   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2598
2599   if (EQ (prop, Q_percent))
2600     {
2601       Arg al [1];
2602       CHECK_INT (val);
2603       XtSetArg (al[0], XtNvalue, XINT (val));
2604       XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 1);
2605       return Qt;
2606     }
2607   return Qunbound;
2608 }
2609
2610 /* instantiate an edit control */
2611 static void
2612 x_edit_field_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2613                     Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2614                     int dest_mask, Lisp_Object domain)
2615 {
2616   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2617   Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2618   widget_value* wv = xmalloc_widget_value ();
2619
2620   button_item_to_widget_value (gui, wv, 1, 1);
2621
2622   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2623                         pointer_bg, dest_mask, domain, "text-field", wv);
2624 }
2625
2626 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
2627 /* instantiate a combo control */
2628 static void
2629 x_combo_box_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2630                      Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2631                      int dest_mask, Lisp_Object domain)
2632 {
2633   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2634   widget_value * wv = 0;
2635   /* This is not done generically because of sizing problems under
2636      mswindows. */
2637   widget_instantiate_1 (image_instance, instantiator, pointer_fg,
2638                         pointer_bg, dest_mask, domain, 1, 0, 0);
2639
2640   wv = gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2641
2642   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2643                         pointer_bg, dest_mask, domain, "combo-box", wv);
2644 }
2645 #endif
2646
2647 static void
2648 x_tab_control_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2649                            Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2650                            int dest_mask, Lisp_Object domain)
2651 {
2652   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2653   Arg al [1];
2654   XColor fcolor;
2655   Lisp_Object pixel;
2656   widget_value* cur;
2657
2658   widget_value * wv =
2659     gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2660
2661   /* Give each child label the correct foreground color. */
2662   pixel = FACE_FOREGROUND
2663     (IMAGE_INSTANCE_WIDGET_FACE (ii),
2664      IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2665   fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2666   XtSetArg (al [0], XtNtabForeground, fcolor.pixel);
2667
2668   for (cur = wv->contents; cur; cur = cur->next)
2669     {
2670       if (cur->value)
2671         {
2672           cur->nargs = 1;
2673           cur->args = al;
2674         }
2675     }
2676
2677   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2678                         pointer_bg, dest_mask, domain, "tab-control", wv);
2679 }
2680
2681 /* set the properties of a tab control */
2682 static Lisp_Object
2683 x_tab_control_set_property (Lisp_Object image_instance, Lisp_Object prop,
2684                             Lisp_Object val)
2685 {
2686   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2687
2688   if (EQ (prop, Q_items))
2689     {
2690       widget_value * wv = 0, *cur;
2691       Arg al [1];
2692       XColor fcolor;
2693       Lisp_Object pixel;
2694
2695       check_valid_item_list_1 (val);
2696
2697       IMAGE_INSTANCE_WIDGET_ITEMS (ii) =
2698         Fcons (XCAR (IMAGE_INSTANCE_WIDGET_ITEMS (ii)),
2699                parse_gui_item_tree_children (val));
2700
2701       wv = gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2702
2703       /* Give each child label the correct foreground color. */
2704       pixel = FACE_FOREGROUND
2705         (IMAGE_INSTANCE_WIDGET_FACE (ii),
2706          IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2707       fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2708       XtSetArg (al [0], XtNtabForeground, fcolor.pixel);
2709
2710       for (cur = wv->contents; cur; cur = cur->next)
2711         {
2712           if (cur->value)
2713             {
2714               cur->nargs = 1;
2715               cur->args = al;
2716             }
2717         }
2718
2719       lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, True);
2720
2721       free_widget_value_tree (wv);
2722       return Qt;
2723     }
2724
2725   return Qunbound;
2726 }
2727
2728 /* instantiate a static control possible for putting other things in */
2729 static void
2730 x_label_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2731                      Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2732                      int dest_mask, Lisp_Object domain)
2733 {
2734   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2735   Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2736   widget_value* wv = xmalloc_widget_value ();
2737
2738   button_item_to_widget_value (gui, wv, 1, 1);
2739
2740   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2741                         pointer_bg, dest_mask, domain, "button", wv);
2742 }
2743 #endif /* HAVE_WIDGETS */
2744
2745 \f
2746 /************************************************************************/
2747 /*                            initialization                            */
2748 /************************************************************************/
2749
2750 void
2751 syms_of_glyphs_x (void)
2752 {
2753 #if 0
2754   DEFSUBR (Fchange_subwindow_property);
2755 #endif
2756 }
2757
2758 void
2759 console_type_create_glyphs_x (void)
2760 {
2761   /* image methods */
2762
2763   CONSOLE_HAS_METHOD (x, print_image_instance);
2764   CONSOLE_HAS_METHOD (x, finalize_image_instance);
2765   CONSOLE_HAS_METHOD (x, image_instance_equal);
2766   CONSOLE_HAS_METHOD (x, image_instance_hash);
2767   CONSOLE_HAS_METHOD (x, colorize_image_instance);
2768   CONSOLE_HAS_METHOD (x, init_image_instance_from_eimage);
2769   CONSOLE_HAS_METHOD (x, locate_pixmap_file);
2770   CONSOLE_HAS_METHOD (x, unmap_subwindow);
2771   CONSOLE_HAS_METHOD (x, map_subwindow);
2772   CONSOLE_HAS_METHOD (x, resize_subwindow);
2773   CONSOLE_HAS_METHOD (x, update_subwindow);
2774 }
2775
2776 void
2777 image_instantiator_format_create_glyphs_x (void)
2778 {
2779   IIFORMAT_VALID_CONSOLE (x, nothing);
2780   IIFORMAT_VALID_CONSOLE (x, string);
2781   IIFORMAT_VALID_CONSOLE (x, layout);
2782   IIFORMAT_VALID_CONSOLE (x, formatted_string);
2783   IIFORMAT_VALID_CONSOLE (x, inherit);
2784 #ifdef HAVE_XPM
2785   INITIALIZE_DEVICE_IIFORMAT (x, xpm);
2786   IIFORMAT_HAS_DEVMETHOD (x, xpm, instantiate);
2787 #endif
2788 #ifdef HAVE_JPEG
2789   IIFORMAT_VALID_CONSOLE (x, jpeg);
2790 #endif
2791 #ifdef HAVE_TIFF
2792   IIFORMAT_VALID_CONSOLE (x, tiff);
2793 #endif
2794 #ifdef HAVE_PNG
2795   IIFORMAT_VALID_CONSOLE (x, png);
2796 #endif
2797 #ifdef HAVE_GIF
2798   IIFORMAT_VALID_CONSOLE (x, gif);
2799 #endif
2800   INITIALIZE_DEVICE_IIFORMAT (x, xbm);
2801   IIFORMAT_HAS_DEVMETHOD (x, xbm, instantiate);
2802
2803   INITIALIZE_DEVICE_IIFORMAT (x, subwindow);
2804   IIFORMAT_HAS_DEVMETHOD (x, subwindow, instantiate);
2805 #ifdef HAVE_WIDGETS
2806   /* button widget */
2807   INITIALIZE_DEVICE_IIFORMAT (x, button);
2808   IIFORMAT_HAS_DEVMETHOD (x, button, property);
2809   IIFORMAT_HAS_DEVMETHOD (x, button, instantiate);
2810
2811   INITIALIZE_DEVICE_IIFORMAT (x, widget);
2812   IIFORMAT_HAS_DEVMETHOD (x, widget, property);
2813   IIFORMAT_HAS_DEVMETHOD (x, widget, set_property);
2814   /* progress gauge */
2815   INITIALIZE_DEVICE_IIFORMAT (x, progress_gauge);
2816   IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, set_property);
2817   IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, instantiate);
2818   /* text field */
2819   INITIALIZE_DEVICE_IIFORMAT (x, edit_field);
2820   IIFORMAT_HAS_DEVMETHOD (x, edit_field, instantiate);
2821 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
2822   /* combo box */
2823   INITIALIZE_DEVICE_IIFORMAT (x, combo_box);
2824   IIFORMAT_HAS_DEVMETHOD (x, combo_box, instantiate);
2825   IIFORMAT_HAS_SHARED_DEVMETHOD (x, combo_box, set_property, tab_control);
2826 #endif
2827   /* tab control widget */
2828   INITIALIZE_DEVICE_IIFORMAT (x, tab_control);
2829   IIFORMAT_HAS_DEVMETHOD (x, tab_control, instantiate);
2830   IIFORMAT_HAS_DEVMETHOD (x, tab_control, set_property);
2831   /* label */
2832   INITIALIZE_DEVICE_IIFORMAT (x, label);
2833   IIFORMAT_HAS_DEVMETHOD (x, label, instantiate);
2834 #endif
2835   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (cursor_font, "cursor-font");
2836   IIFORMAT_VALID_CONSOLE (x, cursor_font);
2837
2838   IIFORMAT_HAS_METHOD (cursor_font, validate);
2839   IIFORMAT_HAS_METHOD (cursor_font, possible_dest_types);
2840   IIFORMAT_HAS_METHOD (cursor_font, instantiate);
2841
2842   IIFORMAT_VALID_KEYWORD (cursor_font, Q_data, check_valid_string);
2843   IIFORMAT_VALID_KEYWORD (cursor_font, Q_foreground, check_valid_string);
2844   IIFORMAT_VALID_KEYWORD (cursor_font, Q_background, check_valid_string);
2845
2846   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (font, "font");
2847
2848   IIFORMAT_HAS_METHOD (font, validate);
2849   IIFORMAT_HAS_METHOD (font, possible_dest_types);
2850   IIFORMAT_HAS_METHOD (font, instantiate);
2851   IIFORMAT_VALID_CONSOLE (x, font);
2852
2853   IIFORMAT_VALID_KEYWORD (font, Q_data, check_valid_string);
2854   IIFORMAT_VALID_KEYWORD (font, Q_foreground, check_valid_string);
2855   IIFORMAT_VALID_KEYWORD (font, Q_background, check_valid_string);
2856
2857 #ifdef HAVE_XFACE
2858   INITIALIZE_DEVICE_IIFORMAT (x, xface);
2859   IIFORMAT_HAS_DEVMETHOD (x, xface, instantiate);
2860 #endif
2861
2862   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (autodetect,
2863                                         "autodetect");
2864
2865   IIFORMAT_HAS_METHOD (autodetect, validate);
2866   IIFORMAT_HAS_METHOD (autodetect, normalize);
2867   IIFORMAT_HAS_METHOD (autodetect, possible_dest_types);
2868   IIFORMAT_HAS_METHOD (autodetect, instantiate);
2869   IIFORMAT_VALID_CONSOLE (x, autodetect);
2870
2871   IIFORMAT_VALID_KEYWORD (autodetect, Q_data, check_valid_string);
2872 }
2873
2874 void
2875 vars_of_glyphs_x (void)
2876 {
2877   DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path /*
2878 A list of the directories in which X bitmap files may be found.
2879 If nil, this is initialized from the "*bitmapFilePath" resource.
2880 This is used by the `make-image-instance' function (however, note that if
2881 the environment variable XBMLANGPATH is set, it is consulted first).
2882 */ );
2883   Vx_bitmap_file_path = Qnil;
2884 }
2885
2886 void
2887 complex_vars_of_glyphs_x (void)
2888 {
2889 #define BUILD_GLYPH_INST(variable, name)                        \
2890   Fadd_spec_to_specifier                                        \
2891     (GLYPH_IMAGE (XGLYPH (variable)),                           \
2892      vector3 (Qxbm, Q_data,                                     \
2893               list3 (make_int (name##_width),                   \
2894                      make_int (name##_height),                  \
2895                      make_ext_string (name##_bits,              \
2896                                       sizeof (name##_bits),     \
2897                                       FORMAT_BINARY))),         \
2898      Qglobal, Qx, Qnil)
2899
2900   BUILD_GLYPH_INST (Vtruncation_glyph, truncator);
2901   BUILD_GLYPH_INST (Vcontinuation_glyph, continuer);
2902   BUILD_GLYPH_INST (Vxemacs_logo, xemacs);
2903   BUILD_GLYPH_INST (Vhscroll_glyph, hscroll);
2904
2905 #undef BUILD_GLYPH_INST
2906 }