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