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

   1 /* X-specific Lisp objects.
   2    Copyright (C) 1993, 1994 Free Software Foundation, Inc.
   3    Copyright (C) 1995 Board of Trustees, University of Illinois.
   4    Copyright (C) 1995 Tinker Systems
   5    Copyright (C) 1995, 1996 Ben Wing
   6    Copyright (C) 1995 Sun Microsystems
   7    Copyright (C) 1999 Andy Piper
   8
   9 This file is part of XEmacs.
  10
  11 XEmacs is free software; you can redistribute it and/or modify it
  12 under the terms of the GNU General Public License as published by the
  13 Free Software Foundation; either version 2, or (at your option) any
  14 later version.
  15
  16 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  17 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  18 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  19 for more details.
  20
  21 You should have received a copy of the GNU General Public License
  22 along with XEmacs; see the file COPYING.  If not, write to
  23 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 Boston, MA 02111-1307, USA.  */
  25
  26 /* Synched up with: Not in FSF. */
  27
  28 /* Original author: Jamie Zawinski for 19.8
  29    font-truename stuff added by Jamie Zawinski for 19.10
  30    subwindow support added by Chuck Thompson
  31    additional XPM support added by Chuck Thompson
  32    initial X-Face support added by Stig
  33    rewritten/restructured by Ben Wing for 19.12/19.13
  34    GIF/JPEG support added by Ben Wing for 19.14
  35    PNG support added by Bill Perry for 19.14
  36    Improved GIF/JPEG support added by Bill Perry for 19.14
  37    Cleanup/simplification of error handling by Ben Wing for 19.14
  38    Pointer/icon overhaul, more restructuring by Ben Wing for 19.14
  39    GIF support changed to external GIFlib 3.1 by Jareth Hein for 21.0
  40    Many changes for color work and optimizations by Jareth Hein for 21.0
  41    Switch of GIF/JPEG/PNG to new EImage intermediate code by Jareth Hein for 21.0
  42    TIFF code by Jareth Hein for 21.0
  43    GIF/JPEG/PNG/TIFF code moved to new glyph-eimage.c by Andy Piper for 21.0
  44    Subwindow and Widget support by Andy Piper for 21.2
  45
  46    TODO:
  47    Support the GrayScale, StaticColor and StaticGray visual classes.
  48    Convert images.el to C and stick it in here?
  49  */
  50
  51 #include <config.h>
  52 #include "lisp.h"
  53 #include "lstream.h"
  54 #include "console-x.h"
  55 #include "glyphs-x.h"
  56 #include "objects-x.h"
  57 #ifdef HAVE_WIDGETS
  58 #include "gui-x.h"
  59 #endif
  60 #include "xmu.h"
  61
  62 #include "buffer.h"
  63 #include "window.h"
  64 #include "frame.h"
  65 #include "insdel.h"
  66 #include "opaque.h"
  67 #include "gui.h"
  68 #include "faces.h"
  69
  70 #include "imgproc.h"
  71
  72 #include "sysfile.h"
  73
  74 #include <setjmp.h>
  75
  76 #ifdef FILE_CODING
  77 #include "file-coding.h"
  78 #endif
  79
  80 #ifdef LWLIB_WIDGETS_MOTIF
  81 #include <Xm/Xm.h>
  82 #endif
  83 #include <X11/IntrinsicP.h>
  84
  85 #if INTBITS == 32
  86 # define FOUR_BYTE_TYPE unsigned int
  87 #elif LONGBITS == 32
  88 # define FOUR_BYTE_TYPE unsigned long
  89 #elif SHORTBITS == 32
  90 # define FOUR_BYTE_TYPE unsigned short
  91 #else
  92 #error What kind of strange-ass system are we running on?
  93 #endif
  94
  95 #define LISP_DEVICE_TO_X_SCREEN(dev) XDefaultScreenOfDisplay (DEVICE_X_DISPLAY (XDEVICE (dev)))
  96
  97 DECLARE_IMAGE_INSTANTIATOR_FORMAT (nothing);
  98 DECLARE_IMAGE_INSTANTIATOR_FORMAT (string);
  99 DECLARE_IMAGE_INSTANTIATOR_FORMAT (formatted_string);
 100 DECLARE_IMAGE_INSTANTIATOR_FORMAT (inherit);
 101 DECLARE_IMAGE_INSTANTIATOR_FORMAT (layout);
 102 #ifdef HAVE_JPEG
 103 DECLARE_IMAGE_INSTANTIATOR_FORMAT (jpeg);
 104 #endif
 105 #ifdef HAVE_TIFF
 106 DECLARE_IMAGE_INSTANTIATOR_FORMAT (tiff);
 107 #endif
 108 #ifdef HAVE_PNG
 109 DECLARE_IMAGE_INSTANTIATOR_FORMAT (png);
 110 #endif
 111 #ifdef HAVE_GIF
 112 DECLARE_IMAGE_INSTANTIATOR_FORMAT (gif);
 113 #endif
 114 #ifdef HAVE_XPM
 115 DEFINE_DEVICE_IIFORMAT (x, xpm);
 116 #endif
 117 DEFINE_DEVICE_IIFORMAT (x, xbm);
 118 DEFINE_DEVICE_IIFORMAT (x, subwindow);
 119 #ifdef HAVE_XFACE
 120 DEFINE_DEVICE_IIFORMAT (x, xface);
 121 #endif
 122
 123 DEFINE_IMAGE_INSTANTIATOR_FORMAT (cursor_font);
 124 Lisp_Object Qcursor_font;
 125
 126 DEFINE_IMAGE_INSTANTIATOR_FORMAT (font);
 127
 128 DEFINE_IMAGE_INSTANTIATOR_FORMAT (autodetect);
 129
 130 #ifdef HAVE_WIDGETS
 131 DEFINE_DEVICE_IIFORMAT (x, widget);
 132 DEFINE_DEVICE_IIFORMAT (x, button);
 133 DEFINE_DEVICE_IIFORMAT (x, progress_gauge);
 134 DEFINE_DEVICE_IIFORMAT (x, edit_field);
 135 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
 136 DEFINE_DEVICE_IIFORMAT (x, combo_box);
 137 #endif
 138 DEFINE_DEVICE_IIFORMAT (x, tab_control);
 139 DEFINE_DEVICE_IIFORMAT (x, label);
 140 #endif
 141
 142 static void cursor_font_instantiate (Lisp_Object image_instance,
 143                                      Lisp_Object instantiator,
 144                                      Lisp_Object pointer_fg,
 145                                      Lisp_Object pointer_bg,
 146                                      int dest_mask,
 147                                      Lisp_Object domain);
 148
 149 #ifdef HAVE_WIDGETS
 150 static void
 151 update_widget_face (widget_value* wv,
 152                     struct Lisp_Image_Instance* ii, Lisp_Object domain);
 153 static void
 154 update_tab_widget_face (widget_value* wv,
 155                         struct 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 (struct 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 (struct 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 (struct Lisp_Image_Instance *p1,
 477                         struct 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 (struct 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 (struct 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 name;
 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 (struct 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 (struct 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 (struct 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 (struct 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   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1150   Pixmap mask = 0;
1151   CONST char *gcc_may_you_rot_in_hell;
1152
1153   if (!NILP (mask_data))
1154     {
1155       GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (mask_data))),
1156                                        gcc_may_you_rot_in_hell);
1157       mask =
1158         pixmap_from_xbm_inline (IMAGE_INSTANCE_DEVICE (ii),
1159                                 XINT (XCAR (mask_data)),
1160                                 XINT (XCAR (XCDR (mask_data))),
1161                                 (CONST unsigned char *)
1162                                 gcc_may_you_rot_in_hell);
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 *gcc_go_home;
1179
1180   assert (!NILP (data));
1181
1182   GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (data))),
1183                                    gcc_go_home);
1184
1185   xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1186                      pointer_bg, dest_mask, XINT (XCAR (data)),
1187                      XINT (XCAR (XCDR (data))), gcc_go_home);
1188 }
1189
1190 \f
1191 #ifdef HAVE_XPM
1192
1193 /**********************************************************************
1194  *                             XPM                                    *
1195  **********************************************************************/
1196  /* xpm 3.2g and better has XpmCreatePixmapFromBuffer()...
1197     There was no version number in xpm.h before 3.3, but this should do.
1198   */
1199 #if (XpmVersion >= 3) || defined(XpmExactColors)
1200 # define XPM_DOES_BUFFERS
1201 #endif
1202
1203 #ifndef XPM_DOES_BUFFERS
1204 Your version of XPM is too old.  You cannot compile with it.
1205 Upgrade to version 3.2g or better or compile with --with-xpm=no.
1206 #endif /* !XPM_DOES_BUFFERS */
1207
1208 static XpmColorSymbol *
1209 extract_xpm_color_names (XpmAttributes *xpmattrs, Lisp_Object device,
1210                          Lisp_Object domain,
1211                          Lisp_Object color_symbol_alist)
1212 {
1213   /* This function can GC */
1214   Display *dpy =  DEVICE_X_DISPLAY (XDEVICE(device));
1215   Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1216   XColor color;
1217   Lisp_Object rest;
1218   Lisp_Object results = Qnil;
1219   int i;
1220   XpmColorSymbol *symbols;
1221   struct gcpro gcpro1, gcpro2;
1222
1223   GCPRO2 (results, device);
1224
1225   /* We built up results to be (("name" . #<color>) ...) so that if an
1226      error happens we don't lose any malloc()ed data, or more importantly,
1227      leave any pixels allocated in the server. */
1228   i = 0;
1229   LIST_LOOP (rest, color_symbol_alist)
1230     {
1231       Lisp_Object cons = XCAR (rest);
1232       Lisp_Object name = XCAR (cons);
1233       Lisp_Object value = XCDR (cons);
1234       if (NILP (value))
1235         continue;
1236       if (STRINGP (value))
1237         value =
1238           Fmake_color_instance
1239             (value, device, encode_error_behavior_flag (ERROR_ME_NOT));
1240       else
1241         {
1242           assert (COLOR_SPECIFIERP (value));
1243           value = Fspecifier_instance (value, domain, Qnil, Qnil);
1244         }
1245       if (NILP (value))
1246         continue;
1247       results = noseeum_cons (noseeum_cons (name, value), results);
1248       i++;
1249     }
1250   UNGCPRO;                      /* no more evaluation */
1251
1252   if (i == 0) return 0;
1253
1254   symbols = xnew_array (XpmColorSymbol, i);
1255   xpmattrs->valuemask |= XpmColorSymbols;
1256   xpmattrs->colorsymbols = symbols;
1257   xpmattrs->numsymbols = i;
1258
1259   while (--i >= 0)
1260     {
1261       Lisp_Object cons = XCAR (results);
1262       color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (XCDR (cons)));
1263       /* Duplicate the pixel value so that we still have a lock on it if
1264          the pixel we were passed is later freed. */
1265       if (! XAllocColor (dpy, cmap, &color))
1266         abort ();  /* it must be allocable since we're just duplicating it */
1267
1268       symbols [i].name = (char *) XSTRING_DATA (XCAR (cons));
1269       symbols [i].pixel = color.pixel;
1270       symbols [i].value = 0;
1271       free_cons (XCONS (cons));
1272       cons = results;
1273       results = XCDR (results);
1274       free_cons (XCONS (cons));
1275     }
1276   return symbols;
1277 }
1278
1279 static void
1280 xpm_free (XpmAttributes *xpmattrs)
1281 {
1282   /* Could conceivably lose if XpmXXX returned an error without first
1283      initializing this structure, if we didn't know that initializing it
1284      to all zeros was ok (and also that it's ok to call XpmFreeAttributes()
1285      multiple times, since it zeros slots as it frees them...) */
1286   XpmFreeAttributes (xpmattrs);
1287 }
1288
1289 static void
1290 x_xpm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1291                                    Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1292                                    int dest_mask, Lisp_Object domain)
1293 {
1294   /* This function can GC */
1295   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1296   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1297   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1298   Display *dpy;
1299   Screen *xs;
1300   Colormap cmap;
1301   int depth;
1302   Visual *visual;
1303   Pixmap pixmap;
1304   Pixmap mask = 0;
1305   XpmAttributes xpmattrs;
1306   int result;
1307   XpmColorSymbol *color_symbols;
1308   Lisp_Object color_symbol_alist = find_keyword_in_vector (instantiator,
1309                                                            Q_color_symbols);
1310   enum image_instance_type type;
1311   int force_mono;
1312   unsigned int w, h;
1313
1314   if (!DEVICE_X_P (XDEVICE (device)))
1315     signal_simple_error ("Not an X device", device);
1316
1317   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1318   xs = DefaultScreenOfDisplay (dpy);
1319
1320   if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
1321     type = IMAGE_COLOR_PIXMAP;
1322   else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
1323     type = IMAGE_MONO_PIXMAP;
1324   else if (dest_mask & IMAGE_POINTER_MASK)
1325     type = IMAGE_POINTER;
1326   else
1327     incompatible_image_types (instantiator, dest_mask,
1328                               IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
1329                               | IMAGE_POINTER_MASK);
1330   force_mono = (type != IMAGE_COLOR_PIXMAP);
1331
1332 #if 1
1333   /* Although I haven't found it documented yet, it appears that pointers are
1334      always colored via the default window colormap... Sigh. */
1335   if (type == IMAGE_POINTER)
1336     {
1337       cmap = DefaultColormap(dpy, DefaultScreen(dpy));
1338       depth = DefaultDepthOfScreen (xs);
1339       visual = DefaultVisualOfScreen (xs);
1340     }
1341   else
1342     {
1343       cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1344       depth = DEVICE_X_DEPTH (XDEVICE(device));
1345       visual = DEVICE_X_VISUAL (XDEVICE(device));
1346     }
1347 #else
1348   cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1349   depth = DEVICE_X_DEPTH (XDEVICE(device));
1350   visual = DEVICE_X_VISUAL (XDEVICE(device));
1351 #endif
1352
1353   x_initialize_pixmap_image_instance (ii, 1, type);
1354
1355   assert (!NILP (data));
1356
1357  retry:
1358
1359   xzero (xpmattrs); /* want XpmInitAttributes() */
1360   xpmattrs.valuemask = XpmReturnPixels;
1361   if (force_mono)
1362     {
1363       /* Without this, we get a 1-bit version of the color image, which
1364          isn't quite right.  With this, we get the mono image, which might
1365          be very different looking. */
1366       xpmattrs.valuemask |= XpmColorKey;
1367       xpmattrs.color_key = XPM_MONO;
1368       xpmattrs.depth = 1;
1369       xpmattrs.valuemask |= XpmDepth;
1370     }
1371   else
1372     {
1373       xpmattrs.closeness = 65535;
1374       xpmattrs.valuemask |= XpmCloseness;
1375       xpmattrs.depth = depth;
1376       xpmattrs.valuemask |= XpmDepth;
1377       xpmattrs.visual = visual;
1378       xpmattrs.valuemask |= XpmVisual;
1379       xpmattrs.colormap = cmap;
1380       xpmattrs.valuemask |= XpmColormap;
1381     }
1382
1383   color_symbols = extract_xpm_color_names (&xpmattrs, device, domain,
1384                                            color_symbol_alist);
1385
1386   result = XpmCreatePixmapFromBuffer (dpy,
1387                                       XtWindow(DEVICE_XT_APP_SHELL (XDEVICE(device))),
1388                                       (char *) XSTRING_DATA (data),
1389                                       &pixmap, &mask, &xpmattrs);
1390
1391   if (color_symbols)
1392     {
1393       xfree (color_symbols);
1394       xpmattrs.colorsymbols = 0; /* in case XpmFreeAttr is too smart... */
1395       xpmattrs.numsymbols = 0;
1396     }
1397
1398   switch (result)
1399     {
1400     case XpmSuccess:
1401       break;
1402     case XpmFileInvalid:
1403       {
1404         xpm_free (&xpmattrs);
1405         signal_image_error ("invalid XPM data", data);
1406       }
1407     case XpmColorFailed:
1408     case XpmColorError:
1409       {
1410         xpm_free (&xpmattrs);
1411         if (force_mono)
1412           {
1413             /* second time; blow out. */
1414             signal_double_file_error ("Reading pixmap data",
1415                                       "color allocation failed",
1416                                       data);
1417           }
1418         else
1419           {
1420             if (! (dest_mask & IMAGE_MONO_PIXMAP_MASK))
1421               {
1422                 /* second time; blow out. */
1423                 signal_double_file_error ("Reading pixmap data",
1424                                           "color allocation failed",
1425                                           data);
1426               }
1427             force_mono = 1;
1428             IMAGE_INSTANCE_TYPE (ii) = IMAGE_MONO_PIXMAP;
1429             goto retry;
1430           }
1431       }
1432     case XpmNoMemory:
1433       {
1434         xpm_free (&xpmattrs);
1435         signal_double_file_error ("Parsing pixmap data",
1436                                   "out of memory", data);
1437       }
1438     default:
1439       {
1440         xpm_free (&xpmattrs);
1441         signal_double_file_error_2 ("Parsing pixmap data",
1442                                     "unknown error code",
1443                                     make_int (result), data);
1444       }
1445     }
1446
1447   w = xpmattrs.width;
1448   h = xpmattrs.height;
1449
1450   {
1451     int npixels = xpmattrs.npixels;
1452     Pixel *pixels;
1453
1454     if (npixels != 0)
1455       {
1456         pixels = xnew_array (Pixel, npixels);
1457         memcpy (pixels, xpmattrs.pixels, npixels * sizeof (Pixel));
1458       }
1459     else
1460       pixels = NULL;
1461
1462     IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
1463     IMAGE_INSTANCE_PIXMAP_MASK (ii) = (void*)mask;
1464     IMAGE_INSTANCE_X_COLORMAP (ii) = cmap;
1465     IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
1466     IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
1467     IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = w;
1468     IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = h;
1469     IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
1470       find_keyword_in_vector (instantiator, Q_file);
1471   }
1472
1473   switch (type)
1474     {
1475     case IMAGE_MONO_PIXMAP:
1476       break;
1477
1478     case IMAGE_COLOR_PIXMAP:
1479       {
1480         IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = depth;
1481       }
1482       break;
1483
1484     case IMAGE_POINTER:
1485       {
1486         int npixels = xpmattrs.npixels;
1487         Pixel *pixels = xpmattrs.pixels;
1488         XColor fg, bg;
1489         int i;
1490         int xhot = 0, yhot = 0;
1491
1492         if (xpmattrs.valuemask & XpmHotspot)
1493           {
1494             xhot = xpmattrs.x_hotspot;
1495             XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii), xpmattrs.x_hotspot);
1496           }
1497         if (xpmattrs.valuemask & XpmHotspot)
1498           {
1499             yhot = xpmattrs.y_hotspot;
1500             XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii), xpmattrs.y_hotspot);
1501           }
1502         check_pointer_sizes (xs, w, h, instantiator);
1503
1504         /* If the loaded pixmap has colors allocated (meaning it came from an
1505            XPM file), then use those as the default colors for the cursor we
1506            create.  Otherwise, default to pointer_fg and pointer_bg.
1507            */
1508         if (npixels >= 2)
1509           {
1510             /* With an XBM file, it's obvious which bit is foreground
1511                and which is background, or rather, it's implicit: in
1512                an XBM file, a 1 bit is foreground, and a 0 bit is
1513                background.
1514
1515                XCreatePixmapCursor() assumes this property of the
1516                pixmap it is called with as well; the `foreground'
1517                color argument is used for the 1 bits.
1518
1519                With an XPM file, it's tricker, since the elements of
1520                the pixmap don't represent FG and BG, but are actual
1521                pixel values.  So we need to figure out which of those
1522                pixels is the foreground color and which is the
1523                background.  We do it by comparing RGB and assuming
1524                that the darker color is the foreground.  This works
1525                with the result of xbmtopbm|ppmtoxpm, at least.
1526
1527                It might be nice if there was some way to tag the
1528                colors in the XPM file with whether they are the
1529                foreground - perhaps with logical color names somehow?
1530
1531                Once we have decided which color is the foreground, we
1532                need to ensure that that color corresponds to a `1' bit
1533                in the Pixmap.  The XPM library wrote into the (1-bit)
1534                pixmap with XPutPixel, which will ignore all but the
1535                least significant bit.
1536
1537                This means that a 1 bit in the image corresponds to
1538                `fg' only if `fg.pixel' is odd.
1539
1540                (This also means that the image will be all the same
1541                color if both `fg' and `bg' are odd or even, but we can
1542                safely assume that that won't happen if the XPM file is
1543                sensible I think.)
1544
1545                The desired result is that the image use `1' to
1546                represent the foreground color, and `0' to represent
1547                the background color.  So, we may need to invert the
1548                image to accomplish this; we invert if fg is
1549                odd. (Remember that WhitePixel and BlackPixel are not
1550                necessarily 1 and 0 respectively, though I think it
1551                might be safe to assume that one of them is always 1
1552                and the other is always 0.  We also pretty much need to
1553                assume that one is even and the other is odd.)
1554                */
1555
1556             fg.pixel = pixels[0];       /* pick a pixel at random. */
1557             bg.pixel = fg.pixel;
1558             for (i = 1; i < npixels; i++) /* Look for an "other" pixel value.*/
1559               {
1560                 bg.pixel = pixels[i];
1561                 if (fg.pixel != bg.pixel)
1562                   break;
1563               }
1564
1565             /* If (fg.pixel == bg.pixel) then probably something has
1566                gone wrong, but I don't think signalling an error would
1567                be appropriate. */
1568
1569             XQueryColor (dpy, cmap, &fg);
1570             XQueryColor (dpy, cmap, &bg);
1571
1572             /* If the foreground is lighter than the background, swap them.
1573                (This occurs semi-randomly, depending on the ordering of the
1574                color list in the XPM file.)
1575                */
1576             {
1577               unsigned short fg_total = ((fg.red / 3) + (fg.green / 3)
1578                                          + (fg.blue / 3));
1579               unsigned short bg_total = ((bg.red / 3) + (bg.green / 3)
1580                                          + (bg.blue / 3));
1581               if (fg_total > bg_total)
1582                 {
1583                   XColor swap;
1584                   swap = fg;
1585                   fg = bg;
1586                   bg = swap;
1587                 }
1588             }
1589
1590             /* If the fg pixel corresponds to a `0' in the bitmap, invert it.
1591                (This occurs (only?) on servers with Black=0, White=1.)
1592                */
1593             if ((fg.pixel & 1) == 0)
1594               {
1595                 XGCValues gcv;
1596                 GC gc;
1597                 gcv.function = GXxor;
1598                 gcv.foreground = 1;
1599                 gc = XCreateGC (dpy, pixmap, (GCFunction | GCForeground),
1600                                 &gcv);
1601                 XFillRectangle (dpy, pixmap, gc, 0, 0, w, h);
1602                 XFreeGC (dpy, gc);
1603               }
1604           }
1605         else
1606           {
1607             generate_cursor_fg_bg (device, &pointer_fg, &pointer_bg,
1608                                    &fg, &bg);
1609             IMAGE_INSTANCE_PIXMAP_FG (ii) = pointer_fg;
1610             IMAGE_INSTANCE_PIXMAP_BG (ii) = pointer_bg;
1611           }
1612
1613         IMAGE_INSTANCE_X_CURSOR (ii) =
1614           XCreatePixmapCursor
1615             (dpy, pixmap, mask, &fg, &bg, xhot, yhot);
1616       }
1617
1618       break;
1619
1620     default:
1621       abort ();
1622     }
1623
1624   xpm_free (&xpmattrs); /* after we've read pixels and hotspot */
1625 }
1626
1627 #endif /* HAVE_XPM */
1628
1629 \f
1630 #ifdef HAVE_XFACE
1631
1632 /**********************************************************************
1633  *                             X-Face                                 *
1634  **********************************************************************/
1635 #if defined(EXTERN)
1636 /* This is about to get redefined! */
1637 #undef EXTERN
1638 #endif
1639 /* We have to define SYSV32 so that compface.h includes string.h
1640    instead of strings.h. */
1641 #define SYSV32
1642 #ifdef __cplusplus
1643 extern "C" {
1644 #endif
1645 #include <compface.h>
1646 #ifdef __cplusplus
1647 }
1648 #endif
1649 /* JMP_BUF cannot be used here because if it doesn't get defined
1650    to jmp_buf we end up with a conflicting type error with the
1651    definition in compface.h */
1652 extern jmp_buf comp_env;
1653 #undef SYSV32
1654
1655 static void
1656 x_xface_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1657                      Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1658                      int dest_mask, Lisp_Object domain)
1659 {
1660   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1661   int i, stattis;
1662   char *p, *bits, *bp;
1663   CONST char * volatile emsg = 0;
1664   CONST char * volatile dstring;
1665
1666   assert (!NILP (data));
1667
1668   GET_C_STRING_BINARY_DATA_ALLOCA (data, dstring);
1669
1670   if ((p = strchr (dstring, ':')))
1671     {
1672       dstring = p + 1;
1673     }
1674
1675   /* Must use setjmp not SETJMP because we used jmp_buf above not JMP_BUF */
1676   if (!(stattis = setjmp (comp_env)))
1677     {
1678       UnCompAll ((char *) dstring);
1679       UnGenFace ();
1680     }
1681
1682   switch (stattis)
1683     {
1684     case -2:
1685       emsg = "uncompface: internal error";
1686       break;
1687     case -1:
1688       emsg = "uncompface: insufficient or invalid data";
1689       break;
1690     case 1:
1691       emsg = "uncompface: excess data ignored";
1692       break;
1693     }
1694
1695   if (emsg)
1696     signal_simple_error_2 (emsg, data, Qimage);
1697
1698   bp = bits = (char *) alloca (PIXELS / 8);
1699
1700   /* the compface library exports char F[], which uses a single byte per
1701      pixel to represent a 48x48 bitmap.  Yuck. */
1702   for (i = 0, p = F; i < (PIXELS / 8); ++i)
1703     {
1704       int n, b;
1705       /* reverse the bit order of each byte... */
1706       for (b = n = 0; b < 8; ++b)
1707         {
1708           n |= ((*p++) << b);
1709         }
1710       *bp++ = (char) n;
1711     }
1712
1713   xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1714                      pointer_bg, dest_mask, 48, 48, bits);
1715 }
1716
1717 #endif /* HAVE_XFACE */
1718
1719 \f
1720 /**********************************************************************
1721  *                       Autodetect                                      *
1722  **********************************************************************/
1723
1724 static void
1725 autodetect_validate (Lisp_Object instantiator)
1726 {
1727   data_must_be_present (instantiator);
1728 }
1729
1730 static Lisp_Object
1731 autodetect_normalize (Lisp_Object instantiator,
1732                                 Lisp_Object console_type)
1733 {
1734   Lisp_Object file = find_keyword_in_vector (instantiator, Q_data);
1735   Lisp_Object filename = Qnil;
1736   Lisp_Object data = Qnil;
1737   struct gcpro gcpro1, gcpro2, gcpro3;
1738   Lisp_Object alist = Qnil;
1739
1740   GCPRO3 (filename, data, alist);
1741
1742   if (NILP (file)) /* no conversion necessary */
1743     RETURN_UNGCPRO (instantiator);
1744
1745   alist = tagged_vector_to_alist (instantiator);
1746
1747   filename = locate_pixmap_file (file);
1748   if (!NILP (filename))
1749     {
1750       int xhot, yhot;
1751       /* #### Apparently some versions of XpmReadFileToData, which is
1752          called by pixmap_to_lisp_data, don't return an error value
1753          if the given file is not a valid XPM file.  Instead, they
1754          just seg fault.  It is definitely caused by passing a
1755          bitmap.  To try and avoid this we check for bitmaps first.  */
1756
1757       data = bitmap_to_lisp_data (filename, &xhot, &yhot, 1);
1758
1759       if (!EQ (data, Qt))
1760         {
1761           alist = remassq_no_quit (Q_data, alist);
1762           alist = Fcons (Fcons (Q_file, filename),
1763                          Fcons (Fcons (Q_data, data), alist));
1764           if (xhot != -1)
1765             alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
1766                            alist);
1767           if (yhot != -1)
1768             alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
1769                            alist);
1770
1771           alist = xbm_mask_file_munging (alist, filename, Qnil, console_type);
1772
1773           {
1774             Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
1775             free_alist (alist);
1776             RETURN_UNGCPRO (result);
1777           }
1778         }
1779
1780 #ifdef HAVE_XPM
1781       data = pixmap_to_lisp_data (filename, 1);
1782
1783       if (!EQ (data, Qt))
1784         {
1785           alist = remassq_no_quit (Q_data, alist);
1786           alist = Fcons (Fcons (Q_file, filename),
1787                          Fcons (Fcons (Q_data, data), alist));
1788           alist = Fcons (Fcons (Q_color_symbols,
1789                                 evaluate_xpm_color_symbols ()),
1790                          alist);
1791           {
1792             Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
1793             free_alist (alist);
1794             RETURN_UNGCPRO (result);
1795           }
1796         }
1797 #endif
1798     }
1799
1800   /* If we couldn't convert it, just put it back as it is.
1801      We might try to further frob it later as a cursor-font
1802      specification. (We can't do that now because we don't know
1803      what dest-types it's going to be instantiated into.) */
1804   {
1805     Lisp_Object result = alist_to_tagged_vector (Qautodetect, alist);
1806     free_alist (alist);
1807     RETURN_UNGCPRO (result);
1808   }
1809 }
1810
1811 static int
1812 autodetect_possible_dest_types (void)
1813 {
1814   return
1815     IMAGE_MONO_PIXMAP_MASK  |
1816     IMAGE_COLOR_PIXMAP_MASK |
1817     IMAGE_POINTER_MASK      |
1818     IMAGE_TEXT_MASK;
1819 }
1820
1821 static void
1822 autodetect_instantiate (Lisp_Object image_instance,
1823                                   Lisp_Object instantiator,
1824                                   Lisp_Object pointer_fg,
1825                                   Lisp_Object pointer_bg,
1826                                   int dest_mask, Lisp_Object domain)
1827 {
1828   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1829   struct gcpro gcpro1, gcpro2, gcpro3;
1830   Lisp_Object alist = Qnil;
1831   Lisp_Object result = Qnil;
1832   int is_cursor_font = 0;
1833
1834   GCPRO3 (data, alist, result);
1835
1836   alist = tagged_vector_to_alist (instantiator);
1837   if (dest_mask & IMAGE_POINTER_MASK)
1838     {
1839       CONST char *name_ext;
1840       GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext);
1841       if (XmuCursorNameToIndex (name_ext) != -1)
1842         {
1843           result = alist_to_tagged_vector (Qcursor_font, alist);
1844           is_cursor_font = 1;
1845         }
1846     }
1847
1848   if (!is_cursor_font)
1849     result = alist_to_tagged_vector (Qstring, alist);
1850   free_alist (alist);
1851
1852   if (is_cursor_font)
1853     cursor_font_instantiate (image_instance, result, pointer_fg,
1854                              pointer_bg, dest_mask, domain);
1855   else
1856     string_instantiate (image_instance, result, pointer_fg,
1857                         pointer_bg, dest_mask, domain);
1858
1859   UNGCPRO;
1860 }
1861
1862 \f
1863 /**********************************************************************
1864  *                              Font                                  *
1865  **********************************************************************/
1866
1867 static void
1868 font_validate (Lisp_Object instantiator)
1869 {
1870   data_must_be_present (instantiator);
1871 }
1872
1873 /* XmuCvtStringToCursor is bogus in the following ways:
1874
1875    - When it can't convert the given string to a real cursor, it will
1876      sometimes return a "success" value, after triggering a BadPixmap
1877      error.  It then gives you a cursor that will itself generate BadCursor
1878      errors.  So we install this error handler to catch/notice the X error
1879      and take that as meaning "couldn't convert."
1880
1881    - When you tell it to find a cursor file that doesn't exist, it prints
1882      an error message on stderr.  You can't make it not do that.
1883
1884    - Also, using Xmu means we can't properly hack Lisp_Image_Instance
1885      objects, or XPM files, or $XBMLANGPATH.
1886  */
1887
1888 /* Duplicate the behavior of XmuCvtStringToCursor() to bypass its bogusness. */
1889
1890 static int XLoadFont_got_error;
1891
1892 static int
1893 XLoadFont_error_handler (Display *dpy, XErrorEvent *xerror)
1894 {
1895   XLoadFont_got_error = 1;
1896   return 0;
1897 }
1898
1899 static Font
1900 safe_XLoadFont (Display *dpy, char *name)
1901 {
1902   Font font;
1903   int (*old_handler) (Display *, XErrorEvent *);
1904   XLoadFont_got_error = 0;
1905   XSync (dpy, 0);
1906   old_handler = XSetErrorHandler (XLoadFont_error_handler);
1907   font = XLoadFont (dpy, name);
1908   XSync (dpy, 0);
1909   XSetErrorHandler (old_handler);
1910   if (XLoadFont_got_error) return 0;
1911   return font;
1912 }
1913
1914 static int
1915 font_possible_dest_types (void)
1916 {
1917   return IMAGE_POINTER_MASK;
1918 }
1919
1920 static void
1921 font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1922                   Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1923                   int dest_mask, Lisp_Object domain)
1924 {
1925   /* This function can GC */
1926   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1927   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1928   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1929   Display *dpy;
1930   XColor fg, bg;
1931   Font source, mask;
1932   char source_name[MAXPATHLEN], mask_name[MAXPATHLEN], dummy;
1933   int source_char, mask_char;
1934   int count;
1935   Lisp_Object foreground, background;
1936
1937   if (!DEVICE_X_P (XDEVICE (device)))
1938     signal_simple_error ("Not an X device", device);
1939
1940   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1941
1942   if (!STRINGP (data) ||
1943       strncmp ("FONT ", (char *) XSTRING_DATA (data), 5))
1944     signal_simple_error ("Invalid font-glyph instantiator",
1945                          instantiator);
1946
1947   if (!(dest_mask & IMAGE_POINTER_MASK))
1948     incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
1949
1950   foreground = find_keyword_in_vector (instantiator, Q_foreground);
1951   if (NILP (foreground))
1952     foreground = pointer_fg;
1953   background = find_keyword_in_vector (instantiator, Q_background);
1954   if (NILP (background))
1955     background = pointer_bg;
1956
1957   generate_cursor_fg_bg (device, &foreground, &background, &fg, &bg);
1958
1959   count = sscanf ((char *) XSTRING_DATA (data),
1960                   "FONT %s %d %s %d %c",
1961                   source_name, &source_char,
1962                   mask_name, &mask_char, &dummy);
1963   /* Allow "%s %d %d" as well... */
1964   if (count == 3 && (1 == sscanf (mask_name, "%d %c", &mask_char, &dummy)))
1965     count = 4, mask_name[0] = 0;
1966
1967   if (count != 2 && count != 4)
1968     signal_simple_error ("invalid cursor specification", data);
1969   source = safe_XLoadFont (dpy, source_name);
1970   if (! source)
1971     signal_simple_error_2 ("couldn't load font",
1972                            build_string (source_name),
1973                            data);
1974   if (count == 2)
1975     mask = 0;
1976   else if (!mask_name[0])
1977     mask = source;
1978   else
1979     {
1980       mask = safe_XLoadFont (dpy, mask_name);
1981       if (!mask)
1982         /* continuable */
1983         Fsignal (Qerror, list3 (build_string ("couldn't load font"),
1984                                 build_string (mask_name), data));
1985     }
1986   if (!mask)
1987     mask_char = 0;
1988
1989   /* #### call XQueryTextExtents() and check_pointer_sizes() here. */
1990
1991   x_initialize_pixmap_image_instance (ii, 1, IMAGE_POINTER);
1992   IMAGE_INSTANCE_X_CURSOR (ii) =
1993     XCreateGlyphCursor (dpy, source, mask, source_char, mask_char,
1994                         &fg, &bg);
1995   XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
1996   XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
1997   XUnloadFont (dpy, source);
1998   if (mask && mask != source) XUnloadFont (dpy, mask);
1999 }
2000
2001 \f
2002 /**********************************************************************
2003  *                           Cursor-Font                              *
2004  **********************************************************************/
2005
2006 static void
2007 cursor_font_validate (Lisp_Object instantiator)
2008 {
2009   data_must_be_present (instantiator);
2010 }
2011
2012 static int
2013 cursor_font_possible_dest_types (void)
2014 {
2015   return IMAGE_POINTER_MASK;
2016 }
2017
2018 static void
2019 cursor_font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2020                          Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2021                          int dest_mask, Lisp_Object domain)
2022 {
2023   /* This function can GC */
2024   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
2025   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2026   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
2027   Display *dpy;
2028   int i;
2029   CONST char *name_ext;
2030   Lisp_Object foreground, background;
2031
2032   if (!DEVICE_X_P (XDEVICE (device)))
2033     signal_simple_error ("Not an X device", device);
2034
2035   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2036
2037   if (!(dest_mask & IMAGE_POINTER_MASK))
2038     incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
2039
2040   GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext);
2041   if ((i = XmuCursorNameToIndex (name_ext)) == -1)
2042     signal_simple_error ("Unrecognized cursor-font name", data);
2043
2044   x_initialize_pixmap_image_instance (ii, 1, IMAGE_POINTER);
2045   IMAGE_INSTANCE_X_CURSOR (ii) = XCreateFontCursor (dpy, i);
2046   foreground = find_keyword_in_vector (instantiator, Q_foreground);
2047   if (NILP (foreground))
2048     foreground = pointer_fg;
2049   background = find_keyword_in_vector (instantiator, Q_background);
2050   if (NILP (background))
2051     background = pointer_bg;
2052   maybe_recolor_cursor (image_instance, foreground, background);
2053 }
2054
2055 static int
2056 x_colorize_image_instance (Lisp_Object image_instance,
2057                            Lisp_Object foreground, Lisp_Object background)
2058 {
2059   struct Lisp_Image_Instance *p;
2060
2061   p = XIMAGE_INSTANCE (image_instance);
2062
2063   switch (IMAGE_INSTANCE_TYPE (p))
2064     {
2065     case IMAGE_MONO_PIXMAP:
2066       IMAGE_INSTANCE_TYPE (p) = IMAGE_COLOR_PIXMAP;
2067       /* Make sure there aren't two pointers to the same mask, causing
2068          it to get freed twice. */
2069       IMAGE_INSTANCE_PIXMAP_MASK (p) = 0;
2070       break;
2071
2072     default:
2073       return 0;
2074     }
2075
2076   {
2077     Display *dpy = DEVICE_X_DISPLAY (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
2078     Drawable draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (IMAGE_INSTANCE_DEVICE (p))));
2079     Dimension d = DEVICE_X_DEPTH (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
2080     Pixmap new = XCreatePixmap (dpy, draw,
2081                                 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
2082                                 IMAGE_INSTANCE_PIXMAP_HEIGHT (p), d);
2083     XColor color;
2084     XGCValues gcv;
2085     GC gc;
2086     color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground));
2087     gcv.foreground = color.pixel;
2088     color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background));
2089     gcv.background = color.pixel;
2090     gc = XCreateGC (dpy, new, GCBackground|GCForeground, &gcv);
2091     XCopyPlane (dpy, IMAGE_INSTANCE_X_PIXMAP (p), new, gc, 0, 0,
2092                 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
2093                 IMAGE_INSTANCE_PIXMAP_HEIGHT (p),
2094                 0, 0, 1);
2095     XFreeGC (dpy, gc);
2096     IMAGE_INSTANCE_X_PIXMAP (p) = new;
2097     IMAGE_INSTANCE_PIXMAP_DEPTH (p) = d;
2098     IMAGE_INSTANCE_PIXMAP_FG (p) = foreground;
2099     IMAGE_INSTANCE_PIXMAP_BG (p) = background;
2100     return 1;
2101   }
2102 }
2103
2104 \f
2105 /************************************************************************/
2106 /*                      subwindow and widget support                      */
2107 /************************************************************************/
2108
2109 /* unmap the image if it is a widget. This is used by redisplay via
2110    redisplay_unmap_subwindows */
2111 static void
2112 x_unmap_subwindow (struct Lisp_Image_Instance *p)
2113 {
2114   if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
2115     {
2116       XUnmapWindow
2117         (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2118          IMAGE_INSTANCE_X_CLIPWINDOW (p));
2119     }
2120   else                          /* must be a widget */
2121     {
2122       XtUnmapWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p));
2123     }
2124 }
2125
2126 /* map the subwindow. This is used by redisplay via
2127    redisplay_output_subwindow */
2128 static void
2129 x_map_subwindow (struct Lisp_Image_Instance *p, int x, int y,
2130                  struct display_glyph_area* dga)
2131 {
2132   if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
2133     {
2134       Window subwindow = IMAGE_INSTANCE_X_SUBWINDOW_ID (p);
2135       XMoveResizeWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2136                          IMAGE_INSTANCE_X_CLIPWINDOW (p),
2137                          x, y, dga->width, dga->height);
2138       XMoveWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2139                    subwindow, -dga->xoffset, -dga->yoffset);
2140       XMapWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2141                   IMAGE_INSTANCE_X_CLIPWINDOW (p));
2142     }
2143   else                          /* must be a widget */
2144     {
2145       XtConfigureWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p),
2146                          x + IMAGE_INSTANCE_X_WIDGET_XOFFSET (p),
2147                          y + IMAGE_INSTANCE_X_WIDGET_YOFFSET (p),
2148                          dga->width, dga->height, 0);
2149       XtMoveWidget (IMAGE_INSTANCE_X_WIDGET_ID (p),
2150                     -dga->xoffset, -dga->yoffset);
2151       XtMapWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p));
2152     }
2153 }
2154
2155 /* when you click on a widget you may activate another widget this
2156    needs to be checked and all appropriate widgets updated */
2157 static void
2158 x_update_subwindow (struct Lisp_Image_Instance *p)
2159 {
2160 #ifdef HAVE_WIDGETS
2161   if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET)
2162     {
2163       Arg al[5];
2164       widget_value* wv = gui_items_to_widget_values
2165         (IMAGE_INSTANCE_WIDGET_ITEMS (p));
2166
2167       /* This seems ugly, but I'm not sure what else to do. */
2168       if (EQ (IMAGE_INSTANCE_WIDGET_TYPE (p), Qtab_control))
2169         {
2170           update_tab_widget_face (wv, p,
2171                                   IMAGE_INSTANCE_SUBWINDOW_FRAME (p));
2172         }
2173       /* update the colors and font */
2174       update_widget_face (wv, p, IMAGE_INSTANCE_SUBWINDOW_FRAME (p));
2175
2176       /* now modify the widget */
2177       lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (p),
2178                              wv, True);
2179       free_widget_value_tree (wv);
2180       /* We have to do this otherwise Motif will unceremoniously
2181          resize us when the label gets set. */
2182       XtSetArg (al [0], XtNwidth, IMAGE_INSTANCE_WIDGET_WIDTH (p));
2183       XtSetArg (al [1], XtNheight, IMAGE_INSTANCE_WIDGET_HEIGHT (p));
2184       XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (p), al, 2);
2185     }
2186 #endif
2187 }
2188
2189 /* instantiate and x type subwindow */
2190 static void
2191 x_subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2192                         Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2193                         int dest_mask, Lisp_Object domain)
2194 {
2195   /* This function can GC */
2196   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2197   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
2198   Lisp_Object frame = FW_FRAME (domain);
2199   struct frame* f = XFRAME (frame);
2200   Display *dpy;
2201   Screen *xs;
2202   Window pw, win;
2203   XSetWindowAttributes xswa;
2204   Mask valueMask = 0;
2205   unsigned int w = IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii),
2206     h = IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii);
2207
2208   if (!DEVICE_X_P (XDEVICE (device)))
2209     signal_simple_error ("Not an X device", device);
2210
2211   dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2212   xs = DefaultScreenOfDisplay (dpy);
2213
2214   IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW;
2215
2216   pw = XtWindow (FRAME_X_TEXT_WIDGET (f));
2217
2218   ii->data = xnew_and_zero (struct x_subwindow_data);
2219
2220   IMAGE_INSTANCE_X_SUBWINDOW_PARENT (ii) = pw;
2221   IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (ii) = DisplayOfScreen (xs);
2222
2223   xswa.backing_store = Always;
2224   valueMask |= CWBackingStore;
2225   xswa.colormap = DefaultColormapOfScreen (xs);
2226   valueMask |= CWColormap;
2227
2228   /* Create a window for clipping */
2229   IMAGE_INSTANCE_X_CLIPWINDOW (ii) =
2230     XCreateWindow (dpy, pw, 0, 0, w, h, 0, CopyFromParent,
2231                    InputOutput, CopyFromParent, valueMask,
2232                    &xswa);
2233
2234   /* Now put the subwindow inside the clip window. */
2235   win = XCreateWindow (dpy, IMAGE_INSTANCE_X_CLIPWINDOW (ii),
2236                        0, 0, w, h, 0, CopyFromParent,
2237                        InputOutput, CopyFromParent, valueMask,
2238                        &xswa);
2239
2240   IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)win;
2241 }
2242
2243 #if 0
2244 /* #### Should this function exist? If there's any doubt I'm not implementing it --andyp */
2245 DEFUN ("change-subwindow-property", Fchange_subwindow_property, 3, 3, 0, /*
2246 For the given SUBWINDOW, set PROPERTY to DATA, which is a string.
2247 Subwindows are not currently implemented.
2248 */
2249        (subwindow, property, data))
2250 {
2251   Atom property_atom;
2252   struct Lisp_Subwindow *sw;
2253   Display *dpy;
2254
2255   CHECK_SUBWINDOW (subwindow);
2256   CHECK_STRING (property);
2257   CHECK_STRING (data);
2258
2259   sw = XSUBWINDOW (subwindow);
2260   dpy = DisplayOfScreen (LISP_DEVICE_TO_X_SCREEN
2261                          (FRAME_DEVICE (XFRAME (sw->frame))));
2262
2263   property_atom = XInternAtom (dpy, (char *) XSTRING_DATA (property), False);
2264   XChangeProperty (dpy, sw->subwindow, property_atom, XA_STRING, 8,
2265                    PropModeReplace,
2266                    XSTRING_DATA   (data),
2267                    XSTRING_LENGTH (data));
2268
2269   return property;
2270 }
2271 #endif
2272
2273 static void
2274 x_resize_subwindow (struct Lisp_Image_Instance* ii, int w, int h)
2275 {
2276   if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
2277     {
2278       XResizeWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (ii),
2279                      IMAGE_INSTANCE_X_SUBWINDOW_ID (ii),
2280                      w, h);
2281     }
2282   else                          /* must be a widget */
2283     {
2284       Arg al[2];
2285
2286       if (!XtIsRealized (IMAGE_INSTANCE_X_WIDGET_ID (ii)))
2287         {
2288           Lisp_Object sw;
2289           XSETIMAGE_INSTANCE (sw, ii);
2290           signal_simple_error ("XEmacs bug: subwindow is not realized", sw);
2291         }
2292
2293       XtSetArg (al [0], XtNwidth, (Dimension)w);
2294       XtSetArg (al [1], XtNheight, (Dimension)h);
2295       XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 2);
2296     }
2297 }
2298
2299 \f
2300 #ifdef HAVE_WIDGETS
2301
2302 /************************************************************************/
2303 /*                            widgets                            */
2304 /************************************************************************/
2305
2306 static void
2307 update_widget_face (widget_value* wv, struct Lisp_Image_Instance *ii,
2308                     Lisp_Object domain)
2309 {
2310 #ifdef LWLIB_WIDGETS_MOTIF
2311   XmFontList fontList;
2312 #endif
2313
2314   Lisp_Object pixel = FACE_FOREGROUND
2315     (IMAGE_INSTANCE_WIDGET_FACE (ii),
2316      domain);
2317   XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2318
2319   lw_add_widget_value_arg (wv, XtNforeground, fcolor.pixel);
2320 #ifdef LWLIB_WIDGETS_MOTIF
2321   fontList = XmFontListCreate
2322     (FONT_INSTANCE_X_FONT
2323      (XFONT_INSTANCE (widget_face_font_info
2324                       (domain,
2325                        IMAGE_INSTANCE_WIDGET_FACE (ii),
2326                        0, 0))), XmSTRING_DEFAULT_CHARSET);
2327   lw_add_widget_value_arg (wv, XmNfontList, (XtArgVal)fontList);
2328 #endif
2329   lw_add_widget_value_arg
2330     (wv, XtNfont, (XtArgVal)FONT_INSTANCE_X_FONT
2331      (XFONT_INSTANCE (widget_face_font_info
2332                       (domain,
2333                        IMAGE_INSTANCE_WIDGET_FACE (ii),
2334                        0, 0))));
2335 }
2336
2337 static void
2338 update_tab_widget_face (widget_value* wv, struct Lisp_Image_Instance *ii,
2339                         Lisp_Object domain)
2340 {
2341   if (wv->contents)
2342     {
2343       widget_value* val = wv->contents, *cur;
2344
2345       /* Give each child label the correct foreground color. */
2346       Lisp_Object pixel = FACE_FOREGROUND
2347         (IMAGE_INSTANCE_WIDGET_FACE (ii),
2348          domain);
2349       XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2350       lw_add_widget_value_arg (val, XtNtabForeground, fcolor.pixel);
2351
2352       for (cur = val->next; cur; cur = cur->next)
2353         {
2354           if (cur->value)
2355             {
2356               lw_copy_widget_value_args (val, cur);
2357             }
2358         }
2359     }
2360 }
2361
2362 static void
2363 x_widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2364                       Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2365                       int dest_mask, Lisp_Object domain,
2366                       CONST char* type, widget_value* wv)
2367 {
2368   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2369   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii), pixel;
2370   struct device* d = XDEVICE (device);
2371   Lisp_Object frame = FW_FRAME (domain);
2372   struct frame* f = XFRAME (frame);
2373   char* nm=0;
2374   Widget wid;
2375   Arg al [32];
2376   int ac = 0;
2377   int id = new_lwlib_id ();
2378   widget_value* clip_wv;
2379   XColor fcolor, bcolor;
2380
2381   if (!DEVICE_X_P (d))
2382     signal_simple_error ("Not an X device", device);
2383
2384   /* have to set the type this late in case there is no device
2385      instantiation for a widget. But we can go ahead and do it without
2386      checking because there is always a generic instantiator. */
2387   IMAGE_INSTANCE_TYPE (ii) = IMAGE_WIDGET;
2388
2389   if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
2390     GET_C_STRING_OS_DATA_ALLOCA (IMAGE_INSTANCE_WIDGET_TEXT (ii), nm);
2391
2392   ii->data = xnew_and_zero (struct x_subwindow_data);
2393
2394   /* Create a clip window to contain the subwidget. Incredibly the
2395      XEmacs manager seems to be the most appropriate widget for
2396      this. Nothing else is simple enough and yet does what is
2397      required. */
2398   clip_wv = xmalloc_widget_value ();
2399
2400   lw_add_widget_value_arg (clip_wv, XtNresize, False);
2401   lw_add_widget_value_arg (clip_wv, XtNwidth,
2402                            (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii));
2403   lw_add_widget_value_arg (clip_wv, XtNheight,
2404                            (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii));
2405   clip_wv->enabled = True;
2406
2407   clip_wv->name = xstrdup ("clip-window");
2408   clip_wv->value = xstrdup ("clip-window");
2409
2410   IMAGE_INSTANCE_X_CLIPWIDGET (ii)
2411     = lw_create_widget ("clip-window", "clip-window", new_lwlib_id (),
2412                         clip_wv, FRAME_X_CONTAINER_WIDGET (f),
2413                         False, 0, 0, 0);
2414
2415   free_widget_value_tree (clip_wv);
2416
2417   /* copy any args we were given */
2418   ac = 0;
2419   lw_add_value_args_to_args (wv, al, &ac);
2420
2421   /* Fixup the colors. We have to do this *before* the widget gets
2422      created so that Motif will fix up the shadow colors
2423      correctly. Once the widget is created Motif won't do this
2424      anymore...*/
2425   pixel = FACE_FOREGROUND
2426     (IMAGE_INSTANCE_WIDGET_FACE (ii),
2427      IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2428   fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2429
2430   pixel = FACE_BACKGROUND
2431     (IMAGE_INSTANCE_WIDGET_FACE (ii),
2432      IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2433   bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2434
2435   lw_add_widget_value_arg (wv, XtNbackground, bcolor.pixel);
2436   lw_add_widget_value_arg (wv, XtNforeground, fcolor.pixel);
2437   /* we cannot allow widgets to resize themselves */
2438   lw_add_widget_value_arg (wv, XtNresize, False);
2439   lw_add_widget_value_arg (wv, XtNwidth,
2440                            (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii));
2441   lw_add_widget_value_arg (wv, XtNheight,
2442                            (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii));
2443   /* update the font. */
2444   update_widget_face (wv, ii, domain);
2445
2446   wid = lw_create_widget (type, wv->name, id, wv, IMAGE_INSTANCE_X_CLIPWIDGET (ii),
2447                           False, 0, popup_selection_callback, 0);
2448
2449   IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)wid;
2450   IMAGE_INSTANCE_X_WIDGET_LWID (ii) = id;
2451
2452   /* Resize the widget here so that the values do not get copied by
2453      lwlib. */
2454   ac = 0;
2455   XtSetArg (al [ac], XtNwidth,
2456             (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii)); ac++;
2457   XtSetArg (al [ac], XtNheight,
2458             (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); ac++;
2459   XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, ac);
2460   /* because the EmacsManager is the widgets parent we have to
2461      offset the redisplay of the widget by the amount the text
2462      widget is inside the manager. */
2463   ac = 0;
2464   XtSetArg (al [ac], XtNx, &IMAGE_INSTANCE_X_WIDGET_XOFFSET (ii)); ac++;
2465   XtSetArg (al [ac], XtNy, &IMAGE_INSTANCE_X_WIDGET_YOFFSET (ii)); ac++;
2466   XtGetValues (FRAME_X_TEXT_WIDGET (f), al, ac);
2467
2468   XtMapWidget (wid);
2469
2470   free_widget_value_tree (wv);
2471 }
2472
2473 static Lisp_Object
2474 x_widget_set_property (Lisp_Object image_instance, Lisp_Object prop,
2475                        Lisp_Object val)
2476 {
2477   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2478
2479   /* Modify the text properties of the widget */
2480   if (EQ (prop, Q_text))
2481     {
2482       char* str;
2483       widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2484       CHECK_STRING (val);
2485       GET_C_STRING_OS_DATA_ALLOCA (val, str);
2486       wv->value = str;
2487       lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, False);
2488       return Qt;
2489     }
2490
2491   /* Modify the text properties of the widget */
2492   else if (EQ (prop, Q_face))
2493     {
2494       widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2495       update_widget_face (wv, ii, IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2496       lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, False);
2497       return Qt;
2498     }
2499   return Qunbound;
2500 }
2501
2502 /* get properties of a control */
2503 static Lisp_Object
2504 x_widget_property (Lisp_Object image_instance, Lisp_Object prop)
2505 {
2506   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2507   /* get the text from a control */
2508   if (EQ (prop, Q_text))
2509     {
2510       widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2511       return build_ext_string (wv->value, FORMAT_OS);
2512     }
2513   return Qunbound;
2514 }
2515
2516 /* Instantiate a button widget. Unfortunately instantiated widgets are
2517    particular to a frame since they need to have a parent. It's not
2518    like images where you just select the image into the context you
2519    want to display it in and BitBlt it. So images instances can have a
2520    many-to-one relationship with things you see, whereas widgets can
2521    only be one-to-one (i.e. per frame) */
2522 static void
2523 x_button_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2524                       Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2525                       int dest_mask, Lisp_Object domain)
2526 {
2527   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2528   Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2529   Lisp_Object glyph = find_keyword_in_vector (instantiator, Q_image);
2530   widget_value* wv = xmalloc_widget_value ();
2531
2532   button_item_to_widget_value (gui, wv, 1, 1);
2533
2534   if (!NILP (glyph))
2535     {
2536       if (!IMAGE_INSTANCEP (glyph))
2537         glyph = glyph_image_instance (glyph, domain, ERROR_ME, 1);
2538     }
2539
2540   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2541                         pointer_bg, dest_mask, domain, "button", wv);
2542
2543   /* add the image if one was given */
2544   if (!NILP (glyph) && IMAGE_INSTANCEP (glyph))
2545     {
2546       Arg al [2];
2547       int ac =0;
2548 #ifdef LWLIB_WIDGETS_MOTIF
2549       XtSetArg (al [ac], XmNlabelType, XmPIXMAP);       ac++;
2550       XtSetArg (al [ac], XmNlabelPixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph));ac++;
2551 #else
2552       XtSetArg (al [ac], XtNpixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph));  ac++;
2553 #endif
2554       XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, ac);
2555     }
2556 }
2557
2558 /* get properties of a button */
2559 static Lisp_Object
2560 x_button_property (Lisp_Object image_instance, Lisp_Object prop)
2561 {
2562   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2563   /* check the state of a button */
2564   if (EQ (prop, Q_selected))
2565     {
2566       widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2567
2568       if (wv->selected)
2569         return Qt;
2570       else
2571         return Qnil;
2572     }
2573   return Qunbound;
2574 }
2575
2576 /* instantiate a progress gauge */
2577 static void
2578 x_progress_gauge_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2579                         Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2580                         int dest_mask, Lisp_Object domain)
2581 {
2582   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2583   Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2584   widget_value* wv = xmalloc_widget_value ();
2585
2586   button_item_to_widget_value (gui, wv, 1, 1);
2587
2588   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2589                         pointer_bg, dest_mask, domain, "progress", wv);
2590 }
2591
2592 /* set the properties of a progres guage */
2593 static Lisp_Object
2594 x_progress_gauge_set_property (Lisp_Object image_instance, Lisp_Object prop,
2595                          Lisp_Object val)
2596 {
2597   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2598
2599   if (EQ (prop, Q_percent))
2600     {
2601       Arg al [1];
2602       CHECK_INT (val);
2603       XtSetArg (al[0], XtNvalue, XINT (val));
2604       XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 1);
2605       return Qt;
2606     }
2607   return Qunbound;
2608 }
2609
2610 /* instantiate an edit control */
2611 static void
2612 x_edit_field_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2613                     Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2614                     int dest_mask, Lisp_Object domain)
2615 {
2616   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2617   Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2618   widget_value* wv = xmalloc_widget_value ();
2619
2620   button_item_to_widget_value (gui, wv, 1, 1);
2621
2622   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2623                         pointer_bg, dest_mask, domain, "text-field", wv);
2624 }
2625
2626 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
2627 /* instantiate a combo control */
2628 static void
2629 x_combo_box_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2630                      Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2631                      int dest_mask, Lisp_Object domain)
2632 {
2633   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2634   widget_value * wv = 0;
2635   /* This is not done generically because of sizing problems under
2636      mswindows. */
2637   widget_instantiate_1 (image_instance, instantiator, pointer_fg,
2638                         pointer_bg, dest_mask, domain, 1, 0, 0);
2639
2640   wv = gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2641
2642   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2643                         pointer_bg, dest_mask, domain, "combo-box", wv);
2644 }
2645 #endif
2646
2647 static void
2648 x_tab_control_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2649                            Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2650                            int dest_mask, Lisp_Object domain)
2651 {
2652   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2653   widget_value * wv =
2654     gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2655
2656   update_tab_widget_face (wv, ii,
2657                           IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2658
2659   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2660                         pointer_bg, dest_mask, domain, "tab-control", wv);
2661 }
2662
2663 /* set the properties of a tab control */
2664 static Lisp_Object
2665 x_tab_control_set_property (Lisp_Object image_instance, Lisp_Object prop,
2666                             Lisp_Object val)
2667 {
2668   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2669
2670   if (EQ (prop, Q_items))
2671     {
2672       widget_value * wv = 0;
2673       check_valid_item_list_1 (val);
2674
2675       IMAGE_INSTANCE_WIDGET_ITEMS (ii) =
2676         Fcons (XCAR (IMAGE_INSTANCE_WIDGET_ITEMS (ii)),
2677                parse_gui_item_tree_children (val));
2678
2679       wv = gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2680
2681       update_tab_widget_face (wv, ii,
2682                               IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2683
2684       lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, True);
2685
2686       free_widget_value_tree (wv);
2687       return Qt;
2688     }
2689
2690   return Qunbound;
2691 }
2692
2693 /* instantiate a static control possible for putting other things in */
2694 static void
2695 x_label_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2696                      Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2697                      int dest_mask, Lisp_Object domain)
2698 {
2699   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2700   Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2701   widget_value* wv = xmalloc_widget_value ();
2702
2703   button_item_to_widget_value (gui, wv, 1, 1);
2704
2705   x_widget_instantiate (image_instance, instantiator, pointer_fg,
2706                         pointer_bg, dest_mask, domain, "button", wv);
2707 }
2708 #endif /* HAVE_WIDGETS */
2709
2710 \f
2711 /************************************************************************/
2712 /*                            initialization                            */
2713 /************************************************************************/
2714
2715 void
2716 syms_of_glyphs_x (void)
2717 {
2718 #if 0
2719   DEFSUBR (Fchange_subwindow_property);
2720 #endif
2721 }
2722
2723 void
2724 console_type_create_glyphs_x (void)
2725 {
2726   /* image methods */
2727
2728   CONSOLE_HAS_METHOD (x, print_image_instance);
2729   CONSOLE_HAS_METHOD (x, finalize_image_instance);
2730   CONSOLE_HAS_METHOD (x, image_instance_equal);
2731   CONSOLE_HAS_METHOD (x, image_instance_hash);
2732   CONSOLE_HAS_METHOD (x, colorize_image_instance);
2733   CONSOLE_HAS_METHOD (x, init_image_instance_from_eimage);
2734   CONSOLE_HAS_METHOD (x, locate_pixmap_file);
2735   CONSOLE_HAS_METHOD (x, unmap_subwindow);
2736   CONSOLE_HAS_METHOD (x, map_subwindow);
2737   CONSOLE_HAS_METHOD (x, resize_subwindow);
2738   CONSOLE_HAS_METHOD (x, update_subwindow);
2739 }
2740
2741 void
2742 image_instantiator_format_create_glyphs_x (void)
2743 {
2744   IIFORMAT_VALID_CONSOLE (x, nothing);
2745   IIFORMAT_VALID_CONSOLE (x, string);
2746   IIFORMAT_VALID_CONSOLE (x, layout);
2747   IIFORMAT_VALID_CONSOLE (x, formatted_string);
2748   IIFORMAT_VALID_CONSOLE (x, inherit);
2749 #ifdef HAVE_XPM
2750   INITIALIZE_DEVICE_IIFORMAT (x, xpm);
2751   IIFORMAT_HAS_DEVMETHOD (x, xpm, instantiate);
2752 #endif
2753 #ifdef HAVE_JPEG
2754   IIFORMAT_VALID_CONSOLE (x, jpeg);
2755 #endif
2756 #ifdef HAVE_TIFF
2757   IIFORMAT_VALID_CONSOLE (x, tiff);
2758 #endif
2759 #ifdef HAVE_PNG
2760   IIFORMAT_VALID_CONSOLE (x, png);
2761 #endif
2762 #ifdef HAVE_GIF
2763   IIFORMAT_VALID_CONSOLE (x, gif);
2764 #endif
2765   INITIALIZE_DEVICE_IIFORMAT (x, xbm);
2766   IIFORMAT_HAS_DEVMETHOD (x, xbm, instantiate);
2767
2768   INITIALIZE_DEVICE_IIFORMAT (x, subwindow);
2769   IIFORMAT_HAS_DEVMETHOD (x, subwindow, instantiate);
2770 #ifdef HAVE_WIDGETS
2771   /* button widget */
2772   INITIALIZE_DEVICE_IIFORMAT (x, button);
2773   IIFORMAT_HAS_DEVMETHOD (x, button, property);
2774   IIFORMAT_HAS_DEVMETHOD (x, button, instantiate);
2775
2776   INITIALIZE_DEVICE_IIFORMAT (x, widget);
2777   IIFORMAT_HAS_DEVMETHOD (x, widget, property);
2778   IIFORMAT_HAS_DEVMETHOD (x, widget, set_property);
2779   /* progress gauge */
2780   INITIALIZE_DEVICE_IIFORMAT (x, progress_gauge);
2781   IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, set_property);
2782   IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, instantiate);
2783   /* text field */
2784   INITIALIZE_DEVICE_IIFORMAT (x, edit_field);
2785   IIFORMAT_HAS_DEVMETHOD (x, edit_field, instantiate);
2786 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
2787   /* combo box */
2788   INITIALIZE_DEVICE_IIFORMAT (x, combo_box);
2789   IIFORMAT_HAS_DEVMETHOD (x, combo_box, instantiate);
2790   IIFORMAT_HAS_SHARED_DEVMETHOD (x, combo_box, set_property, tab_control);
2791 #endif
2792   /* tab control widget */
2793   INITIALIZE_DEVICE_IIFORMAT (x, tab_control);
2794   IIFORMAT_HAS_DEVMETHOD (x, tab_control, instantiate);
2795   IIFORMAT_HAS_DEVMETHOD (x, tab_control, set_property);
2796   /* label */
2797   INITIALIZE_DEVICE_IIFORMAT (x, label);
2798   IIFORMAT_HAS_DEVMETHOD (x, label, instantiate);
2799 #endif
2800   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (cursor_font, "cursor-font");
2801   IIFORMAT_VALID_CONSOLE (x, cursor_font);
2802
2803   IIFORMAT_HAS_METHOD (cursor_font, validate);
2804   IIFORMAT_HAS_METHOD (cursor_font, possible_dest_types);
2805   IIFORMAT_HAS_METHOD (cursor_font, instantiate);
2806
2807   IIFORMAT_VALID_KEYWORD (cursor_font, Q_data, check_valid_string);
2808   IIFORMAT_VALID_KEYWORD (cursor_font, Q_foreground, check_valid_string);
2809   IIFORMAT_VALID_KEYWORD (cursor_font, Q_background, check_valid_string);
2810
2811   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (font, "font");
2812
2813   IIFORMAT_HAS_METHOD (font, validate);
2814   IIFORMAT_HAS_METHOD (font, possible_dest_types);
2815   IIFORMAT_HAS_METHOD (font, instantiate);
2816   IIFORMAT_VALID_CONSOLE (x, font);
2817
2818   IIFORMAT_VALID_KEYWORD (font, Q_data, check_valid_string);
2819   IIFORMAT_VALID_KEYWORD (font, Q_foreground, check_valid_string);
2820   IIFORMAT_VALID_KEYWORD (font, Q_background, check_valid_string);
2821
2822 #ifdef HAVE_XFACE
2823   INITIALIZE_DEVICE_IIFORMAT (x, xface);
2824   IIFORMAT_HAS_DEVMETHOD (x, xface, instantiate);
2825 #endif
2826
2827   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (autodetect,
2828                                         "autodetect");
2829
2830   IIFORMAT_HAS_METHOD (autodetect, validate);
2831   IIFORMAT_HAS_METHOD (autodetect, normalize);
2832   IIFORMAT_HAS_METHOD (autodetect, possible_dest_types);
2833   IIFORMAT_HAS_METHOD (autodetect, instantiate);
2834   IIFORMAT_VALID_CONSOLE (x, autodetect);
2835
2836   IIFORMAT_VALID_KEYWORD (autodetect, Q_data, check_valid_string);
2837 }
2838
2839 void
2840 vars_of_glyphs_x (void)
2841 {
2842   DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path /*
2843 A list of the directories in which X bitmap files may be found.
2844 If nil, this is initialized from the "*bitmapFilePath" resource.
2845 This is used by the `make-image-instance' function (however, note that if
2846 the environment variable XBMLANGPATH is set, it is consulted first).
2847 */ );
2848   Vx_bitmap_file_path = Qnil;
2849 }
2850
2851 void
2852 complex_vars_of_glyphs_x (void)
2853 {
2854 #define BUILD_GLYPH_INST(variable, name)                        \
2855   Fadd_spec_to_specifier                                        \
2856     (GLYPH_IMAGE (XGLYPH (variable)),                           \
2857      vector3 (Qxbm, Q_data,                                     \
2858               list3 (make_int (name##_width),                   \
2859                      make_int (name##_height),                  \
2860                      make_ext_string (name##_bits,              \
2861                                       sizeof (name##_bits),     \
2862                                       FORMAT_BINARY))),         \
2863      Qglobal, Qx, Qnil)
2864
2865   BUILD_GLYPH_INST (Vtruncation_glyph, truncator);
2866   BUILD_GLYPH_INST (Vcontinuation_glyph, continuer);
2867   BUILD_GLYPH_INST (Vxemacs_logo, xemacs);
2868   BUILD_GLYPH_INST (Vhscroll_glyph, hscroll);
2869
2870 #undef BUILD_GLYPH_INST
2871 }