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

   1 /* X-specific Lisp objects.
   2    Copyright (C) 1993, 1994 Free Software Foundation, Inc.
   3    Copyright (C) 1995 Board of Trustees, University of Illinois.
   4    Copyright (C) 1995 Tinker Systems
   5    Copyright (C) 1995, 1996 Ben Wing
   6    Copyright (C) 1995 Sun Microsystems
   7
   8 This file is part of XEmacs.
   9
  10 XEmacs is free software; you can redistribute it and/or modify it
  11 under the terms of the GNU General Public License as published by the
  12 Free Software Foundation; either version 2, or (at your option) any
  13 later version.
  14
  15 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  16 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  17 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  18 for more details.
  19
  20 You should have received a copy of the GNU General Public License
  21 along with XEmacs; see the file COPYING.  If not, write to
  22 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 Boston, MA 02111-1307, USA.  */
  24
  25 /* Synched up with: Not in FSF. */
  26
  27 /* Original author: Jamie Zawinski for 19.8
  28    font-truename stuff added by Jamie Zawinski for 19.10
  29    subwindow support added by Chuck Thompson
  30    additional XPM support added by Chuck Thompson
  31    initial X-Face support added by Stig
  32    rewritten/restructured by Ben Wing for 19.12/19.13
  33    GIF/JPEG support added by Ben Wing for 19.14
  34    PNG support added by Bill Perry for 19.14
  35    Improved GIF/JPEG support added by Bill Perry for 19.14
  36    Cleanup/simplification of error handling by Ben Wing for 19.14
  37    Pointer/icon overhaul, more restructuring by Ben Wing for 19.14
  38    GIF support changed to external GIFlib 3.1 by Jareth Hein for 21.0
  39    Many changes for color work and optimizations by Jareth Hein for 21.0
  40    Switch of GIF/JPEG/PNG to new EImage intermediate code by Jareth Hein for 21.0
  41    TIFF code by Jareth Hein for 21.0
  42    GIF/JPEG/PNG/TIFF code moved to new glyph-eimage.c for 21.0
  43    Gtk version by William Perry for 21.1
  44
  45    TODO:
  46    Support the GrayScale, StaticColor and StaticGray visual classes.
  47    Convert images.el to C and stick it in here?
  48  */
  49
  50 #include <config.h>
  51 #include "lisp.h"
  52 #include "lstream.h"
  53 #include "console-gtk.h"
  54 #include "glyphs.h"
  55 #include "glyphs-gtk.h"
  56 #include "objects-gtk.h"
  57 #include "gui-gtk.h"
  58 #include "ui-gtk.h"
  59
  60 #include "buffer.h"
  61 #include "window.h"
  62 #include "frame.h"
  63 #include "insdel.h"
  64 #include "opaque.h"
  65 #include "faces.h"
  66
  67 #include "imgproc.h"
  68
  69 #include "sysfile.h"
  70
  71 #include <setjmp.h>
  72
  73 #ifdef FILE_CODING
  74 #include "file-coding.h"
  75 #endif
  76
  77 #if INTBITS == 32
  78 # define FOUR_BYTE_TYPE unsigned int
  79 #elif LONGBITS == 32
  80 # define FOUR_BYTE_TYPE unsigned long
  81 #elif SHORTBITS == 32
  82 # define FOUR_BYTE_TYPE unsigned short
  83 #else
  84 #error What kind of strange-ass system are we running on?
  85 #endif
  86
  87 DECLARE_IMAGE_INSTANTIATOR_FORMAT (nothing);
  88 DECLARE_IMAGE_INSTANTIATOR_FORMAT (string);
  89 DECLARE_IMAGE_INSTANTIATOR_FORMAT (formatted_string);
  90 DECLARE_IMAGE_INSTANTIATOR_FORMAT (inherit);
  91 #ifdef HAVE_JPEG
  92 DECLARE_IMAGE_INSTANTIATOR_FORMAT (jpeg);
  93 #endif
  94 #ifdef HAVE_TIFF
  95 DECLARE_IMAGE_INSTANTIATOR_FORMAT (tiff);
  96 #endif
  97 #ifdef HAVE_PNG
  98 DECLARE_IMAGE_INSTANTIATOR_FORMAT (png);
  99 #endif
 100 #ifdef HAVE_GIF
 101 DECLARE_IMAGE_INSTANTIATOR_FORMAT (gif);
 102 #endif
 103
 104 #ifdef HAVE_XFACE
 105 DEFINE_DEVICE_IIFORMAT (gtk, xface);
 106 Lisp_Object Qxface;
 107 #endif
 108
 109 #ifdef HAVE_XPM
 110 DEFINE_DEVICE_IIFORMAT (gtk, xpm);
 111 #endif
 112
 113 DEFINE_DEVICE_IIFORMAT (gtk, xbm);
 114 DEFINE_DEVICE_IIFORMAT (gtk, subwindow);
 115
 116 DEFINE_IMAGE_INSTANTIATOR_FORMAT (cursor_font);
 117 Lisp_Object Qcursor_font;
 118
 119 DEFINE_IMAGE_INSTANTIATOR_FORMAT (font);
 120
 121 DEFINE_IMAGE_INSTANTIATOR_FORMAT (autodetect);
 122
 123 #ifdef HAVE_WIDGETS
 124 DECLARE_IMAGE_INSTANTIATOR_FORMAT (layout);
 125 DEFINE_DEVICE_IIFORMAT (gtk, widget);
 126 DEFINE_DEVICE_IIFORMAT (gtk, native_layout);
 127 DEFINE_DEVICE_IIFORMAT (gtk, button);
 128 DEFINE_DEVICE_IIFORMAT (gtk, progress_gauge);
 129 DEFINE_DEVICE_IIFORMAT (gtk, edit_field);
 130 DEFINE_DEVICE_IIFORMAT (gtk, combo_box);
 131 DEFINE_DEVICE_IIFORMAT (gtk, tab_control);
 132 DEFINE_DEVICE_IIFORMAT (gtk, label);
 133 #endif
 134
 135 static void update_widget_face (GtkWidget *w, Lisp_Image_Instance *ii,
 136                                 Lisp_Object domain);
 137 static void cursor_font_instantiate (Lisp_Object image_instance,
 138                                      Lisp_Object instantiator,
 139                                      Lisp_Object pointer_fg,
 140                                      Lisp_Object pointer_bg,
 141                                      int dest_mask,
 142                                      Lisp_Object domain);
 143
 144 static gint cursor_name_to_index (const char *name);
 145
 146 #ifndef BitmapSuccess
 147 #define BitmapSuccess           0
 148 #define BitmapOpenFailed        1
 149 #define BitmapFileInvalid       2
 150 #define BitmapNoMemory          3
 151 #endif
 152
 153 #include "bitmaps.h"
 154
 155 DEFINE_IMAGE_INSTANTIATOR_FORMAT (gtk_resource);
 156 Lisp_Object Q_resource_type, Q_resource_id;
 157 Lisp_Object Qgtk_resource;
 158 #ifdef HAVE_WIDGETS
 159 Lisp_Object Qgtk_widget_instantiate_internal, Qgtk_widget_property_internal;
 160 Lisp_Object Qgtk_widget_redisplay_internal, Qgtk_widget_set_style;
 161 #endif
 162
 163 #define CONST const
 164
 165 \f
 166 /************************************************************************/
 167 /*                      image instance methods                          */
 168 /************************************************************************/
 169
 170 /************************************************************************/
 171 /* convert from a series of RGB triples to an XImage formated for the   */
 172 /* proper display                                                       */
 173 /************************************************************************/
 174 static GdkImage *
 175 convert_EImage_to_GDKImage (Lisp_Object device, int width, int height,
 176                             unsigned char *pic, unsigned long **pixtbl,
 177                             int *npixels)
 178 {
 179   GdkColormap *cmap;
 180   GdkVisual *vis;
 181   GdkImage *outimg;
 182   int depth, byte_cnt, i, j;
 183   int rd,gr,bl,q;
 184   unsigned char *data, *ip, *dp = NULL;
 185   quant_table *qtable = NULL;
 186   union {
 187     FOUR_BYTE_TYPE val;
 188     char cp[4];
 189   } conv;
 190
 191   cmap = DEVICE_GTK_COLORMAP (XDEVICE(device));
 192   vis = DEVICE_GTK_VISUAL (XDEVICE(device));
 193   depth = DEVICE_GTK_DEPTH(XDEVICE(device));
 194
 195   if (vis->type == GDK_VISUAL_GRAYSCALE || vis->type == GDK_VISUAL_STATIC_COLOR ||
 196       vis->type == GDK_VISUAL_STATIC_GRAY)
 197     {
 198       /* #### Implement me!!! */
 199       return NULL;
 200     }
 201
 202   if (vis->type == GDK_VISUAL_PSEUDO_COLOR)
 203     {
 204       /* Quantize the image and get a histogram while we're at it.
 205          Do this first to save memory */
 206       qtable = build_EImage_quantable(pic, width, height, 256);
 207       if (qtable == NULL) return NULL;
 208     }
 209
 210   /* The first parameter (GdkWindow *) is allowed to be NULL if we
 211   ** specify the depth */
 212   outimg = gdk_image_new (GDK_IMAGE_FASTEST, vis, width, height);
 213
 214   if (!outimg) return NULL;
 215
 216   byte_cnt = outimg->bpp;
 217
 218   data = (unsigned char *) outimg->mem;
 219
 220   if (!data)
 221     {
 222       gdk_image_destroy (outimg);
 223       return NULL;
 224     }
 225
 226   if (vis->type == GDK_VISUAL_PSEUDO_COLOR)
 227     {
 228       unsigned long pixarray[256];
 229       int pixcount, n;
 230       /* use our quantize table to allocate the colors */
 231       pixcount = 32;
 232       *pixtbl = xnew_array (unsigned long, pixcount);
 233       *npixels = 0;
 234
 235       /* ### should implement a sort by popularity to assure proper allocation */
 236       n = *npixels;
 237       for (i = 0; i < qtable->num_active_colors; i++)
 238         {
 239           GdkColor color;
 240           int res;
 241
 242           color.red = qtable->rm[i] ? qtable->rm[i] << 8 : 0;
 243           color.green = qtable->gm[i] ? qtable->gm[i] << 8 : 0;
 244           color.blue = qtable->bm[i] ? qtable->bm[i] << 8 : 0;
 245           res = allocate_nearest_color (cmap, vis, &color);
 246           if (res > 0 && res < 3)
 247             {
 248               DO_REALLOC(*pixtbl, pixcount, n+1, unsigned long);
 249               (*pixtbl)[n] = color.pixel;
 250               n++;
 251             }
 252           pixarray[i] = color.pixel;
 253         }
 254       *npixels = n;
 255       ip = pic;
 256       for (i = 0; i < height; i++)
 257         {
 258           dp = data + (i * outimg->bpl);
 259           for (j = 0; j < width; j++)
 260             {
 261               rd = *ip++;
 262               gr = *ip++;
 263               bl = *ip++;
 264               conv.val = pixarray[QUANT_GET_COLOR(qtable,rd,gr,bl)];
 265 #if WORDS_BIGENDIAN
 266               if (outimg->byte_order == GDK_MSB_FIRST)
 267                 for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q];
 268               else
 269                 for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q];
 270 #else
 271               if (outimg->byte_order == GDK_MSB_FIRST)
 272                 for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q];
 273               else
 274                 for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q];
 275 #endif
 276             }
 277         }
 278       xfree(qtable);
 279     } else {
 280       unsigned long rshift,gshift,bshift,rbits,gbits,bbits,junk;
 281       junk = vis->red_mask;
 282       rshift = 0;
 283       while ((junk & 0x1) == 0)
 284         {
 285           junk = junk >> 1;
 286           rshift ++;
 287         }
 288       rbits = 0;
 289       while (junk != 0)
 290         {
 291           junk = junk >> 1;
 292           rbits++;
 293         }
 294       junk = vis->green_mask;
 295       gshift = 0;
 296       while ((junk & 0x1) == 0)
 297         {
 298           junk = junk >> 1;
 299           gshift ++;
 300         }
 301       gbits = 0;
 302       while (junk != 0)
 303         {
 304           junk = junk >> 1;
 305           gbits++;
 306         }
 307       junk = vis->blue_mask;
 308       bshift = 0;
 309       while ((junk & 0x1) == 0)
 310         {
 311           junk = junk >> 1;
 312           bshift ++;
 313         }
 314       bbits = 0;
 315       while (junk != 0)
 316         {
 317           junk = junk >> 1;
 318           bbits++;
 319         }
 320       ip = pic;
 321       for (i = 0; i < height; i++)
 322         {
 323           dp = data + (i * outimg->bpl);
 324           for (j = 0; j < width; j++)
 325             {
 326               if (rbits > 8)
 327                 rd = *ip++ << (rbits - 8);
 328               else
 329                 rd = *ip++ >> (8 - rbits);
 330               if (gbits > 8)
 331                 gr = *ip++ << (gbits - 8);
 332               else
 333                 gr = *ip++ >> (8 - gbits);
 334               if (bbits > 8)
 335                 bl = *ip++ << (bbits - 8);
 336               else
 337                 bl = *ip++ >> (8 - bbits);
 338
 339               conv.val = (rd << rshift) | (gr << gshift) | (bl << bshift);
 340 #if WORDS_BIGENDIAN
 341               if (outimg->byte_order == GDK_MSB_FIRST)
 342                 for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q];
 343               else
 344                 for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q];
 345 #else
 346               if (outimg->byte_order == GDK_MSB_FIRST)
 347                 for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q];
 348               else
 349                 for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q];
 350 #endif
 351             }
 352         }
 353     }
 354   return outimg;
 355 }
 356
 357 static void
 358 gtk_print_image_instance (struct Lisp_Image_Instance *p,
 359                           Lisp_Object printcharfun,
 360                           int escapeflag)
 361 {
 362   char buf[100];
 363
 364   switch (IMAGE_INSTANCE_TYPE (p))
 365     {
 366     case IMAGE_MONO_PIXMAP:
 367     case IMAGE_COLOR_PIXMAP:
 368     case IMAGE_POINTER:
 369       sprintf (buf, " (0x%lx", (unsigned long) IMAGE_INSTANCE_GTK_PIXMAP (p));
 370       write_c_string (buf, printcharfun);
 371       if (IMAGE_INSTANCE_GTK_MASK (p))
 372         {
 373           sprintf (buf, "/0x%lx", (unsigned long) IMAGE_INSTANCE_GTK_MASK (p));
 374           write_c_string (buf, printcharfun);
 375         }
 376       write_c_string (")", printcharfun);
 377       break;
 378 #if HAVE_SUBWINDOWS
 379     case IMAGE_SUBWINDOW:
 380       /* #### implement me */
 381 #endif
 382     default:
 383       break;
 384     }
 385 }
 386
 387 static void
 388 gtk_finalize_image_instance (struct Lisp_Image_Instance *p)
 389 {
 390   if (!p->data)
 391     return;
 392
 393   if (DEVICE_LIVE_P (XDEVICE (p->device)))
 394     {
 395       if (0)
 396         ;
 397 #ifdef HAVE_WIDGETS
 398       if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET)
 399         {
 400           if (IMAGE_INSTANCE_SUBWINDOW_ID (p))
 401             {
 402               gtk_widget_destroy (IMAGE_INSTANCE_SUBWINDOW_ID (p));
 403
 404               /* We can release the callbacks again. */
 405               /* #### FIXME! */
 406               /* ungcpro_popup_callbacks (...); */
 407
 408               /* IMAGE_INSTANCE_GTK_WIDGET_ID (p) = 0; */
 409               IMAGE_INSTANCE_GTK_CLIPWIDGET (p) = 0;
 410             }
 411         }
 412 #endif
 413       else if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
 414         {
 415           abort();
 416         }
 417       else
 418         {
 419           int i;
 420           if (IMAGE_INSTANCE_PIXMAP_TIMEOUT (p))
 421             disable_glyph_animated_timeout (IMAGE_INSTANCE_PIXMAP_TIMEOUT (p));
 422
 423           if (IMAGE_INSTANCE_GTK_MASK (p) &&
 424               IMAGE_INSTANCE_GTK_MASK (p) != IMAGE_INSTANCE_GTK_PIXMAP (p))
 425             gdk_pixmap_unref (IMAGE_INSTANCE_GTK_MASK (p));
 426           IMAGE_INSTANCE_PIXMAP_MASK (p) = 0;
 427
 428           if (IMAGE_INSTANCE_GTK_PIXMAP_SLICES (p))
 429             {
 430               for (i = 0; i < IMAGE_INSTANCE_PIXMAP_MAXSLICE (p); i++)
 431                 if (IMAGE_INSTANCE_GTK_PIXMAP_SLICE (p,i))
 432                   {
 433                     gdk_pixmap_unref (IMAGE_INSTANCE_GTK_PIXMAP_SLICE (p,i));
 434                     IMAGE_INSTANCE_GTK_PIXMAP_SLICE (p, i) = 0;
 435                   }
 436               xfree (IMAGE_INSTANCE_GTK_PIXMAP_SLICES (p));
 437               IMAGE_INSTANCE_GTK_PIXMAP_SLICES (p) = 0;
 438             }
 439
 440           if (IMAGE_INSTANCE_GTK_CURSOR (p))
 441             {
 442               gdk_cursor_destroy (IMAGE_INSTANCE_GTK_CURSOR (p));
 443               IMAGE_INSTANCE_GTK_CURSOR (p) = 0;
 444             }
 445         }
 446
 447 #if 0
 448             /* #### BILL!!! */
 449       if (IMAGE_INSTANCE_GTK_NPIXELS (p) != 0)
 450         {
 451           XFreeColors (dpy,
 452                        IMAGE_INSTANCE_GTK_COLORMAP (p),
 453                        IMAGE_INSTANCE_GTK_PIXELS (p),
 454                        IMAGE_INSTANCE_GTK_NPIXELS (p), 0);
 455           IMAGE_INSTANCE_GTK_NPIXELS (p) = 0;
 456         }
 457 #endif
 458     }
 459
 460   if (IMAGE_INSTANCE_TYPE (p) != IMAGE_WIDGET
 461       && IMAGE_INSTANCE_TYPE (p) != IMAGE_SUBWINDOW
 462       && IMAGE_INSTANCE_GTK_PIXELS (p))
 463     {
 464       xfree (IMAGE_INSTANCE_GTK_PIXELS (p));
 465       IMAGE_INSTANCE_GTK_PIXELS (p) = 0;
 466     }
 467
 468   xfree (p->data);
 469   p->data = 0;
 470 }
 471
 472 static int
 473 gtk_image_instance_equal (struct Lisp_Image_Instance *p1,
 474                           struct Lisp_Image_Instance *p2, int depth)
 475 {
 476   switch (IMAGE_INSTANCE_TYPE (p1))
 477     {
 478     case IMAGE_MONO_PIXMAP:
 479     case IMAGE_COLOR_PIXMAP:
 480     case IMAGE_POINTER:
 481       if (IMAGE_INSTANCE_GTK_COLORMAP (p1) != IMAGE_INSTANCE_GTK_COLORMAP (p2) ||
 482           IMAGE_INSTANCE_GTK_NPIXELS (p1) != IMAGE_INSTANCE_GTK_NPIXELS (p2))
 483         return 0;
 484 #if HAVE_SUBWINDOWS
 485     case IMAGE_SUBWINDOW:
 486       /* #### implement me */
 487 #endif
 488       break;
 489     default:
 490       break;
 491     }
 492
 493   return 1;
 494 }
 495
 496 static unsigned long
 497 gtk_image_instance_hash (struct Lisp_Image_Instance *p, int depth)
 498 {
 499   switch (IMAGE_INSTANCE_TYPE (p))
 500     {
 501     case IMAGE_MONO_PIXMAP:
 502     case IMAGE_COLOR_PIXMAP:
 503     case IMAGE_POINTER:
 504       return IMAGE_INSTANCE_GTK_NPIXELS (p);
 505 #if HAVE_SUBWINDOWS
 506     case IMAGE_SUBWINDOW:
 507       /* #### implement me */
 508       return 0;
 509 #endif
 510     default:
 511       return 0;
 512     }
 513 }
 514
 515 /* Set all the slots in an image instance structure to reasonable
 516    default values.  This is used somewhere within an instantiate
 517    method.  It is assumed that the device slot within the image
 518    instance is already set -- this is the case when instantiate
 519    methods are called. */
 520
 521 static void
 522 gtk_initialize_pixmap_image_instance (struct Lisp_Image_Instance *ii,
 523                                       int slices,
 524                                       enum image_instance_type type)
 525 {
 526   ii->data = xnew_and_zero (struct gtk_image_instance_data);
 527   IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) = slices;
 528   IMAGE_INSTANCE_GTK_PIXMAP_SLICES (ii) =
 529     xnew_array_and_zero (GdkPixmap *, slices);
 530   IMAGE_INSTANCE_TYPE (ii) = type;
 531   IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = Qnil;
 532   IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (ii) = Qnil;
 533   IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) = Qnil;
 534   IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) = Qnil;
 535   IMAGE_INSTANCE_PIXMAP_FG (ii) = Qnil;
 536   IMAGE_INSTANCE_PIXMAP_BG (ii) = Qnil;
 537 }
 538
 539 \f
 540 /************************************************************************/
 541 /*                        pixmap file functions                         */
 542 /************************************************************************/
 543
 544 /* Where bitmaps are; initialized from resource database */
 545 Lisp_Object Vgtk_bitmap_file_path;
 546
 547 #ifndef BITMAPDIR
 548 #define BITMAPDIR "/usr/include/X11/bitmaps"
 549 #endif
 550
 551 /* Given a pixmap filename, look through all of the "standard" places
 552    where the file might be located.  Return a full pathname if found;
 553    otherwise, return Qnil. */
 554
 555 static Lisp_Object
 556 gtk_locate_pixmap_file (Lisp_Object name)
 557 {
 558   /* This function can GC if IN_REDISPLAY is false */
 559
 560   /* Check non-absolute pathnames with a directory component relative to
 561      the search path; that's the way Xt does it. */
 562   /* #### Unix-specific */
 563   if (XSTRING_BYTE (name, 0) == '/' ||
 564       (XSTRING_BYTE (name, 0) == '.' &&
 565        (XSTRING_BYTE (name, 1) == '/' ||
 566         (XSTRING_BYTE (name, 1) == '.' &&
 567          (XSTRING_BYTE (name, 2) == '/')))))
 568     {
 569       if (!NILP (Ffile_readable_p (name)))
 570         return name;
 571       else
 572         return Qnil;
 573     }
 574
 575   if (NILP (Vdefault_gtk_device))
 576     /* This may occur during intialization. */
 577     return Qnil;
 578
 579   if (NILP (Vgtk_bitmap_file_path))
 580     {
 581       Vgtk_bitmap_file_path = nconc2 (Vgtk_bitmap_file_path,
 582                                       (decode_path (BITMAPDIR)));
 583     }
 584
 585   {
 586     Lisp_Object found;
 587     if (locate_file (Vgtk_bitmap_file_path, name, Qnil, &found, R_OK) < 0)
 588       {
 589         Lisp_Object temp = list1 (Vdata_directory);
 590         struct gcpro gcpro1;
 591
 592         GCPRO1 (temp);
 593         locate_file (temp, name, Qnil, &found, R_OK);
 594         UNGCPRO;
 595       }
 596
 597     return found;
 598   }
 599 }
 600
 601 static Lisp_Object
 602 locate_pixmap_file (Lisp_Object name)
 603 {
 604   return gtk_locate_pixmap_file (name);
 605 }
 606
 607 \f
 608 /************************************************************************/
 609 /*                           cursor functions                           */
 610 /************************************************************************/
 611
 612 /* Check that this server supports cursors of size WIDTH * HEIGHT.  If
 613    not, signal an error.  INSTANTIATOR is only used in the error
 614    message. */
 615
 616 static void
 617 check_pointer_sizes (unsigned int width, unsigned int height,
 618                      Lisp_Object instantiator)
 619 {
 620     /* #### BILL!!! There is no way to call XQueryBestCursor from Gdk! */
 621 #if 0
 622   unsigned int best_width, best_height;
 623   if (! XQueryBestCursor (DisplayOfScreen (xs), RootWindowOfScreen (xs),
 624                           width, height, &best_width, &best_height))
 625     /* this means that an X error of some sort occurred (we trap
 626        these so they're not fatal). */
 627     signal_simple_error ("XQueryBestCursor() failed?", instantiator);
 628
 629   if (width > best_width || height > best_height)
 630     error_with_frob (instantiator,
 631                      "pointer too large (%dx%d): "
 632                      "server requires %dx%d or smaller",
 633                      width, height, best_width, best_height);
 634 #endif
 635 }
 636
 637 static void
 638 generate_cursor_fg_bg (Lisp_Object device, Lisp_Object *foreground,
 639                        Lisp_Object *background, GdkColor *xfg, GdkColor *xbg)
 640 {
 641   if (!NILP (*foreground) && !COLOR_INSTANCEP (*foreground))
 642     *foreground =
 643       Fmake_color_instance (*foreground, device,
 644                             encode_error_behavior_flag (ERROR_ME));
 645   if (COLOR_INSTANCEP (*foreground))
 646     *xfg = * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (*foreground));
 647   else
 648     {
 649       xfg->pixel = 0;
 650       xfg->red = xfg->green = xfg->blue = 0;
 651     }
 652
 653   if (!NILP (*background) && !COLOR_INSTANCEP (*background))
 654     *background =
 655       Fmake_color_instance (*background, device,
 656                             encode_error_behavior_flag (ERROR_ME));
 657   if (COLOR_INSTANCEP (*background))
 658     *xbg = * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (*background));
 659   else
 660     {
 661       xbg->pixel = 0;
 662       xbg->red = xbg->green = xbg->blue = ~0;
 663     }
 664 }
 665
 666 static void
 667 maybe_recolor_cursor (Lisp_Object image_instance, Lisp_Object foreground,
 668                       Lisp_Object background)
 669 {
 670 #if 0
 671     /* #### BILL!!! */
 672   Lisp_Object device = XIMAGE_INSTANCE_DEVICE (image_instance);
 673   GdkColor xfg, xbg;
 674
 675   generate_cursor_fg_bg (device, &foreground, &background, &xfg, &xbg);
 676   if (!NILP (foreground) || !NILP (background))
 677     {
 678       XRecolorCursor (DEVICE_X_DISPLAY (XDEVICE (device)),
 679                       XIMAGE_INSTANCE_GTK_CURSOR (image_instance),
 680                       &xfg, &xbg);
 681       XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
 682       XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
 683     }
 684 #else
 685   /* stderr_out ("Don't know how to recolor cursors in Gtk!\n"); */
 686 #endif
 687 }
 688
 689 \f
 690 /************************************************************************/
 691 /*                        color pixmap functions                        */
 692 /************************************************************************/
 693
 694 /* Initialize an image instance from an XImage.
 695
 696    DEST_MASK specifies the mask of allowed image types.
 697
 698    PIXELS and NPIXELS specify an array of pixels that are used in
 699    the image.  These need to be kept around for the duration of the
 700    image.  When the image instance is freed, XFreeColors() will
 701    automatically be called on all the pixels specified here; thus,
 702    you should have allocated the pixels yourself using XAllocColor()
 703    or the like.  The array passed in is used directly without
 704    being copied, so it should be heap data created with xmalloc().
 705    It will be freed using xfree() when the image instance is
 706    destroyed.
 707
 708    If this fails, signal an error.  INSTANTIATOR is only used
 709    in the error message.
 710
 711    #### This should be able to handle conversion into `pointer'.
 712    Use the same code as for `xpm'. */
 713
 714 static void
 715 init_image_instance_from_gdk_image (struct Lisp_Image_Instance *ii,
 716                                     GdkImage *gdk_image,
 717                                     int dest_mask,
 718                                     GdkColormap *cmap,
 719                                     unsigned long *pixels,
 720                                     int npixels,
 721                                     int slices,
 722                                     Lisp_Object instantiator)
 723 {
 724   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
 725   GdkGC *gc;
 726   GdkWindow *d;
 727   GdkPixmap *pixmap;
 728
 729   if (!DEVICE_GTK_P (XDEVICE (device)))
 730     signal_simple_error ("Not a Gtk device", device);
 731
 732   d = GET_GTK_WIDGET_WINDOW (DEVICE_GTK_APP_SHELL (XDEVICE (device)));
 733
 734   if (!(dest_mask & IMAGE_COLOR_PIXMAP_MASK))
 735     incompatible_image_types (instantiator, dest_mask,
 736                               IMAGE_COLOR_PIXMAP_MASK);
 737
 738   pixmap = gdk_pixmap_new (d, gdk_image->width, gdk_image->height, gdk_image->depth);
 739   if (!pixmap)
 740     signal_simple_error ("Unable to create pixmap", instantiator);
 741
 742   gc = gdk_gc_new (pixmap);
 743   if (!gc)
 744     {
 745       gdk_pixmap_unref (pixmap);
 746       signal_simple_error ("Unable to create GC", instantiator);
 747     }
 748
 749   gdk_draw_image (GDK_DRAWABLE (pixmap), gc, gdk_image,
 750                   0, 0, 0, 0, gdk_image->width, gdk_image->height);
 751
 752   gdk_gc_destroy (gc);
 753
 754   gtk_initialize_pixmap_image_instance (ii, slices, IMAGE_COLOR_PIXMAP);
 755
 756   IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
 757     find_keyword_in_vector (instantiator, Q_file);
 758
 759   IMAGE_INSTANCE_GTK_PIXMAP (ii) = pixmap;
 760   IMAGE_INSTANCE_GTK_MASK (ii) = 0;
 761   IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = gdk_image->width;
 762   IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = gdk_image->height;
 763   IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = gdk_image->depth;
 764   IMAGE_INSTANCE_GTK_COLORMAP (ii) = cmap;
 765   IMAGE_INSTANCE_GTK_PIXELS (ii) = pixels;
 766   IMAGE_INSTANCE_GTK_NPIXELS (ii) = npixels;
 767 }
 768
 769 #if 0
 770 void init_image_instance_from_gdk_pixmap (struct Lisp_Image_Instance *ii,
 771                                           struct device *device,
 772                                           GdkPixmap *gdk_pixmap,
 773                                           int dest_mask,
 774                                           Lisp_Object instantiator)
 775 {
 776   GdkWindow *d;
 777   gint width, height, depth;
 778
 779   if (!DEVICE_GTK_P (device))
 780     abort ();
 781
 782   IMAGE_INSTANCE_DEVICE (ii) = device;
 783   IMAGE_INSTANCE_TYPE (ii) = IMAGE_COLOR_PIXMAP;
 784
 785   d = GET_GTK_WIDGET_WINDOW (DEVICE_GTK_APP_SHELL (device));
 786
 787   if (!(dest_mask & IMAGE_COLOR_PIXMAP_MASK))
 788     incompatible_image_types (instantiator, dest_mask,
 789                               IMAGE_COLOR_PIXMAP_MASK);
 790
 791   gtk_initialize_pixmap_image_instance (ii, IMAGE_COLOR_PIXMAP);
 792
 793   gdk_window_get_geometry (gdk_pixmap, NULL, NULL, &width, &height, &depth);
 794
 795   IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = Qnil;
 796   IMAGE_INSTANCE_GTK_PIXMAP (ii) = gdk_pixmap;
 797   IMAGE_INSTANCE_GTK_MASK (ii) = 0;
 798   IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = width;
 799   IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = height;
 800   IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = depth;
 801   IMAGE_INSTANCE_GTK_COLORMAP (ii) = gdk_window_get_colormap (gdk_pixmap);
 802   IMAGE_INSTANCE_GTK_PIXELS (ii) = 0;
 803   IMAGE_INSTANCE_GTK_NPIXELS (ii) = 0;
 804 }
 805 #endif
 806
 807 static void
 808 image_instance_add_gdk_image (Lisp_Image_Instance *ii,
 809                               GdkImage *gdk_image,
 810                               int slice,
 811                               Lisp_Object instantiator)
 812 {
 813   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
 814   GdkWindow *d;
 815   GdkPixmap *pixmap;
 816   GdkGC *gc;
 817
 818   d = GET_GTK_WIDGET_WINDOW (DEVICE_GTK_APP_SHELL (XDEVICE (device)));
 819
 820   pixmap = gdk_pixmap_new (d, gdk_image->width, gdk_image->height, gdk_image->depth);
 821
 822   if (!pixmap)
 823     signal_simple_error ("Unable to create pixmap", instantiator);
 824
 825   gc = gdk_gc_new (pixmap);
 826
 827   if (!gc)
 828     {
 829       gdk_pixmap_unref (pixmap);
 830       signal_simple_error ("Unable to create GC", instantiator);
 831     }
 832
 833   gdk_draw_image (GDK_DRAWABLE (pixmap), gc, gdk_image, 0, 0, 0, 0,
 834                   gdk_image->width, gdk_image->height);
 835
 836   gdk_gc_destroy (gc);
 837
 838   IMAGE_INSTANCE_GTK_PIXMAP_SLICE (ii, slice) = pixmap;
 839 }
 840
 841 static void
 842 gtk_init_image_instance_from_eimage (struct Lisp_Image_Instance *ii,
 843                                      int width, int height,
 844                                      int slices,
 845                                      unsigned char *eimage,
 846                                      int dest_mask,
 847                                      Lisp_Object instantiator,
 848                                      Lisp_Object domain)
 849 {
 850   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
 851   GdkColormap *cmap = DEVICE_GTK_COLORMAP (XDEVICE(device));
 852   unsigned long *pixtbl = NULL;
 853   int npixels = 0;
 854   int slice;
 855   GdkImage* gdk_image;
 856
 857
 858   for (slice = 0; slice < slices; slice++)
 859     {
 860       gdk_image = convert_EImage_to_GDKImage (device, width, height, eimage,
 861                                               &pixtbl, &npixels);
 862       if (!gdk_image)
 863         {
 864           if (pixtbl) xfree (pixtbl);
 865           signal_image_error("EImage to GdkImage conversion failed", instantiator);
 866         }
 867
 868       if (slice == 0)
 869         /* Now create the pixmap and set up the image instance */
 870         init_image_instance_from_gdk_image (ii, gdk_image, dest_mask,
 871                                             cmap, pixtbl, npixels, slices,
 872                                             instantiator);
 873       else
 874         image_instance_add_gdk_image (ii, gdk_image, slice, instantiator);
 875
 876       if (gdk_image)
 877         {
 878           gdk_image_destroy (gdk_image);
 879         }
 880       gdk_image = 0;
 881     }
 882 }
 883
 884 /* Given inline data for a mono pixmap, create and return the
 885    corresponding X object. */
 886
 887 static GdkPixmap *
 888 pixmap_from_xbm_inline (Lisp_Object device, int width, int height,
 889                         /* Note that data is in ext-format! */
 890                         CONST Extbyte *bits)
 891 {
 892     return (gdk_bitmap_create_from_data (GET_GTK_WIDGET_WINDOW (DEVICE_GTK_APP_SHELL (XDEVICE (device))),
 893                                          (char *) bits, width, height));
 894 }
 895
 896 /* Given inline data for a mono pixmap, initialize the given
 897    image instance accordingly. */
 898
 899 static void
 900 init_image_instance_from_xbm_inline (struct Lisp_Image_Instance *ii,
 901                                      int width, int height,
 902                                      /* Note that data is in ext-format! */
 903                                      CONST char *bits,
 904                                      Lisp_Object instantiator,
 905                                      Lisp_Object pointer_fg,
 906                                      Lisp_Object pointer_bg,
 907                                      int dest_mask,
 908                                      GdkPixmap *mask,
 909                                      Lisp_Object mask_filename)
 910 {
 911   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
 912   Lisp_Object foreground = find_keyword_in_vector (instantiator, Q_foreground);
 913   Lisp_Object background = find_keyword_in_vector (instantiator, Q_background);
 914   GdkColor fg;
 915   GdkColor bg;
 916   enum image_instance_type type;
 917   GdkWindow *draw = GET_GTK_WIDGET_WINDOW (DEVICE_GTK_APP_SHELL (XDEVICE (device)));
 918   GdkColormap *cmap = DEVICE_GTK_COLORMAP (XDEVICE(device));
 919   GdkColor black;
 920   GdkColor white;
 921
 922   gdk_color_black(cmap, &black);
 923   gdk_color_white(cmap, &white);
 924
 925   if (!DEVICE_GTK_P (XDEVICE (device)))
 926     signal_simple_error ("Not a Gtk device", device);
 927
 928   if ((dest_mask & IMAGE_MONO_PIXMAP_MASK) &&
 929       (dest_mask & IMAGE_COLOR_PIXMAP_MASK))
 930     {
 931       if (!NILP (foreground) || !NILP (background))
 932         type = IMAGE_COLOR_PIXMAP;
 933       else
 934         type = IMAGE_MONO_PIXMAP;
 935     }
 936   else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
 937     type = IMAGE_MONO_PIXMAP;
 938   else if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
 939     type = IMAGE_COLOR_PIXMAP;
 940   else if (dest_mask & IMAGE_POINTER_MASK)
 941     type = IMAGE_POINTER;
 942   else
 943     incompatible_image_types (instantiator, dest_mask,
 944                               IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
 945                               | IMAGE_POINTER_MASK);
 946
 947   gtk_initialize_pixmap_image_instance (ii, 1, type);
 948   IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = width;
 949   IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = height;
 950   IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
 951     find_keyword_in_vector (instantiator, Q_file);
 952
 953   switch (type)
 954     {
 955     case IMAGE_MONO_PIXMAP:
 956       {
 957         IMAGE_INSTANCE_GTK_PIXMAP (ii) =
 958           pixmap_from_xbm_inline (device, width, height, (Extbyte *) bits);
 959       }
 960       break;
 961
 962     case IMAGE_COLOR_PIXMAP:
 963       {
 964         gint d = DEVICE_GTK_DEPTH (XDEVICE(device));
 965
 966         if (!NILP (foreground) && !COLOR_INSTANCEP (foreground))
 967           foreground =
 968             Fmake_color_instance (foreground, device,
 969                                   encode_error_behavior_flag (ERROR_ME));
 970
 971         if (COLOR_INSTANCEP (foreground))
 972           fg = * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (foreground));
 973
 974         if (!NILP (background) && !COLOR_INSTANCEP (background))
 975           background =
 976             Fmake_color_instance (background, device,
 977                                   encode_error_behavior_flag (ERROR_ME));
 978
 979         if (COLOR_INSTANCEP (background))
 980           bg = * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (background));
 981
 982         /* We used to duplicate the pixels using XAllocColor(), to protect
 983            against their getting freed.  Just as easy to just store the
 984            color instances here and GC-protect them, so this doesn't
 985            happen. */
 986         IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
 987         IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
 988         IMAGE_INSTANCE_GTK_PIXMAP (ii) =
 989             gdk_pixmap_create_from_data (draw, (char *) bits, width, height, d, &fg, &bg);
 990         IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = d;
 991       }
 992       break;
 993
 994     case IMAGE_POINTER:
 995     {
 996         GdkColor fg_color, bg_color;
 997         GdkPixmap *source;
 998
 999         check_pointer_sizes (width, height, instantiator);
1000
1001         source = gdk_pixmap_create_from_data (draw, (char *) bits, width, height, 1, &black, &white);
1002
1003         if (NILP (foreground))
1004           foreground = pointer_fg;
1005         if (NILP (background))
1006           background = pointer_bg;
1007         generate_cursor_fg_bg (device, &foreground, &background,
1008                                &fg_color, &bg_color);
1009
1010         IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
1011         IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
1012         IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) =
1013           find_keyword_in_vector (instantiator, Q_hotspot_x);
1014         IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) =
1015           find_keyword_in_vector (instantiator, Q_hotspot_y);
1016         IMAGE_INSTANCE_GTK_CURSOR (ii) =
1017             gdk_cursor_new_from_pixmap (source, mask, &fg_color, &bg_color,
1018                                         !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ?
1019                                         XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) : 0,
1020                                         !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) ?
1021                                         XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) : 0);
1022       }
1023       break;
1024
1025     default:
1026       abort ();
1027     }
1028 }
1029
1030 static void
1031 xbm_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator,
1032                    Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1033                    int dest_mask, int width, int height,
1034                    /* Note that data is in ext-format! */
1035                    CONST char *bits)
1036 {
1037   Lisp_Object mask_data = find_keyword_in_vector (instantiator, Q_mask_data);
1038   Lisp_Object mask_file = find_keyword_in_vector (instantiator, Q_mask_file);
1039   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1040   GdkPixmap *mask = 0;
1041   CONST char *gcc_may_you_rot_in_hell;
1042
1043   if (!NILP (mask_data))
1044     {
1045       TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (XCDR (XCDR (mask_data))),
1046                           C_STRING_ALLOCA, gcc_may_you_rot_in_hell,
1047                           Qfile_name);
1048       mask =
1049         pixmap_from_xbm_inline (IMAGE_INSTANCE_DEVICE (ii),
1050                                 XINT (XCAR (mask_data)),
1051                                 XINT (XCAR (XCDR (mask_data))),
1052                                 (CONST unsigned char *)
1053                                 gcc_may_you_rot_in_hell);
1054     }
1055
1056   init_image_instance_from_xbm_inline (ii, width, height, bits,
1057                                        instantiator, pointer_fg, pointer_bg,
1058                                        dest_mask, mask, mask_file);
1059 }
1060
1061 /* Instantiate method for XBM's. */
1062
1063 static void
1064 gtk_xbm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1065                      Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1066                      int dest_mask, Lisp_Object domain)
1067 {
1068   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1069   CONST char *gcc_go_home;
1070
1071   assert (!NILP (data));
1072
1073   TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (XCDR (XCDR (data))),
1074                       C_STRING_ALLOCA, gcc_go_home,
1075                       Qbinary);
1076
1077   xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1078                      pointer_bg, dest_mask, XINT (XCAR (data)),
1079                      XINT (XCAR (XCDR (data))), gcc_go_home);
1080 }
1081
1082 \f
1083 #ifdef HAVE_XPM
1084 /**********************************************************************
1085  *                             XPM                                    *
1086  **********************************************************************/
1087 static void
1088 write_lisp_string_to_temp_file (Lisp_Object string, char *filename_out)
1089 {
1090   Lisp_Object instream, outstream;
1091   Lstream *istr, *ostr;
1092   char tempbuf[1024]; /* some random amount */
1093   int fubar = 0;
1094   FILE *tmpfil;
1095   static Extbyte_dynarr *conversion_out_dynarr;
1096   Bytecount bstart, bend;
1097   struct gcpro gcpro1, gcpro2;
1098 #ifdef FILE_CODING
1099   Lisp_Object conv_out_stream;
1100   Lstream *costr;
1101   struct gcpro gcpro3;
1102 #endif
1103
1104   /* This function can GC */
1105   if (!conversion_out_dynarr)
1106     conversion_out_dynarr = Dynarr_new (Extbyte);
1107   else
1108     Dynarr_reset (conversion_out_dynarr);
1109
1110   /* Create the temporary file ... */
1111   sprintf (filename_out, "/tmp/emacs%d.XXXXXX", (int) getpid ());
1112   mktemp (filename_out);
1113   tmpfil = fopen (filename_out, "w");
1114   if (!tmpfil)
1115     {
1116       if (tmpfil)
1117         {
1118           int old_errno = errno;
1119           fclose (tmpfil);
1120           unlink (filename_out);
1121           errno = old_errno;
1122         }
1123       report_file_error ("Creating temp file",
1124                          list1 (build_string (filename_out)));
1125     }
1126
1127   CHECK_STRING (string);
1128   get_string_range_byte (string, Qnil, Qnil, &bstart, &bend,
1129                          GB_HISTORICAL_STRING_BEHAVIOR);
1130   instream = make_lisp_string_input_stream (string, bstart, bend);
1131   istr = XLSTREAM (instream);
1132   /* setup the out stream */
1133   outstream = make_dynarr_output_stream((unsigned_char_dynarr *)conversion_out_dynarr);
1134   ostr = XLSTREAM (outstream);
1135 #ifdef FILE_CODING
1136   /* setup the conversion stream */
1137   conv_out_stream = make_encoding_output_stream (ostr, Fget_coding_system(Qbinary));
1138   costr = XLSTREAM (conv_out_stream);
1139   GCPRO3 (instream, outstream, conv_out_stream);
1140 #else
1141   GCPRO2 (instream, outstream);
1142 #endif
1143
1144   /* Get the data while doing the conversion */
1145   while (1)
1146     {
1147       int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
1148       if (!size_in_bytes)
1149         break;
1150       /* It does seem the flushes are necessary... */
1151 #ifdef FILE_CODING
1152       Lstream_write (costr, tempbuf, size_in_bytes);
1153       Lstream_flush (costr);
1154 #else
1155       Lstream_write (ostr, tempbuf, size_in_bytes);
1156 #endif
1157       Lstream_flush (ostr);
1158       if (fwrite ((unsigned char *)Dynarr_atp(conversion_out_dynarr, 0),
1159                   Dynarr_length(conversion_out_dynarr), 1, tmpfil) != 1)
1160         {
1161           fubar = 1;
1162           break;
1163         }
1164       /* reset the dynarr */
1165       Lstream_rewind(ostr);
1166     }
1167
1168   if (fclose (tmpfil) != 0)
1169     fubar = 1;
1170   Lstream_close (istr);
1171 #ifdef FILE_CODING
1172   Lstream_close (costr);
1173 #endif
1174   Lstream_close (ostr);
1175
1176   UNGCPRO;
1177   Lstream_delete (istr);
1178   Lstream_delete (ostr);
1179 #ifdef FILE_CODING
1180   Lstream_delete (costr);
1181 #endif
1182
1183   if (fubar)
1184     report_file_error ("Writing temp file",
1185                        list1 (build_string (filename_out)));
1186 }
1187
1188 struct color_symbol
1189 {
1190   char*         name;
1191   GdkColor      color;
1192 };
1193
1194 static struct color_symbol*
1195 extract_xpm_color_names (Lisp_Object device,
1196                          Lisp_Object domain,
1197                          Lisp_Object color_symbol_alist,
1198                          int* nsymbols)
1199 {
1200   /* This function can GC */
1201   Lisp_Object rest;
1202   Lisp_Object results = Qnil;
1203   int i, j;
1204   struct color_symbol *colortbl;
1205   struct gcpro gcpro1, gcpro2;
1206
1207   GCPRO2 (results, device);
1208
1209   /* We built up results to be (("name" . #<color>) ...) so that if an
1210      error happens we don't lose any malloc()ed data, or more importantly,
1211      leave any pixels allocated in the server. */
1212   i = 0;
1213   LIST_LOOP (rest, color_symbol_alist)
1214     {
1215       Lisp_Object cons = XCAR (rest);
1216       Lisp_Object name = XCAR (cons);
1217       Lisp_Object value = XCDR (cons);
1218       if (NILP (value))
1219         continue;
1220       if (STRINGP (value))
1221         value =
1222           Fmake_color_instance
1223           (value, device, encode_error_behavior_flag (ERROR_ME_NOT));
1224       else
1225         {
1226           assert (COLOR_SPECIFIERP (value));
1227           value = Fspecifier_instance (value, domain, Qnil, Qnil);
1228         }
1229       if (NILP (value))
1230         continue;
1231       results = noseeum_cons (noseeum_cons (name, value), results);
1232       i++;
1233     }
1234   UNGCPRO;                      /* no more evaluation */
1235
1236   *nsymbols=i;
1237   if (i == 0) return 0;
1238
1239   colortbl = xnew_array_and_zero (struct color_symbol, i);
1240
1241   for (j=0; j<i; j++)
1242     {
1243       Lisp_Object cons = XCAR (results);
1244       colortbl[j].color =
1245         * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (XCDR (cons)));
1246
1247       colortbl[j].name = (char *) XSTRING_DATA (XCAR (cons));
1248       free_cons (XCONS (cons));
1249       cons = results;
1250       results = XCDR (results);
1251       free_cons (XCONS (cons));
1252     }
1253   return colortbl;
1254 }
1255
1256 static void
1257 gtk_xpm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1258                      Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1259                      int dest_mask, Lisp_Object domain)
1260 {
1261   /* This function can GC */
1262   char temp_file_name[1024];
1263   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1264   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1265   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1266   GdkColormap *cmap;
1267   int depth;
1268   GdkVisual *visual;
1269   GdkPixmap *pixmap;
1270   GdkPixmap *mask = 0;
1271   GdkWindow *window = 0;
1272   int nsymbols = 0, i = 0;
1273   struct color_symbol *color_symbols = NULL;
1274   GdkColor *transparent_color = NULL;
1275   Lisp_Object color_symbol_alist = find_keyword_in_vector (instantiator,
1276                                                            Q_color_symbols);
1277   enum image_instance_type type;
1278   int force_mono;
1279   unsigned int w, h;
1280
1281   if (!DEVICE_GTK_P (XDEVICE (device)))
1282     signal_simple_error ("Not a Gtk device", device);
1283
1284   if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
1285     type = IMAGE_COLOR_PIXMAP;
1286   else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
1287     type = IMAGE_MONO_PIXMAP;
1288   else if (dest_mask & IMAGE_POINTER_MASK)
1289     type = IMAGE_POINTER;
1290   else
1291     incompatible_image_types (instantiator, dest_mask,
1292                               IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
1293                               | IMAGE_POINTER_MASK);
1294   force_mono = (type != IMAGE_COLOR_PIXMAP);
1295
1296   window = GET_GTK_WIDGET_WINDOW (DEVICE_GTK_APP_SHELL (XDEVICE (device)));
1297   cmap = DEVICE_GTK_COLORMAP (XDEVICE (device));
1298   depth = DEVICE_GTK_DEPTH (XDEVICE (device));
1299   visual = DEVICE_GTK_VISUAL (XDEVICE (device));
1300
1301   gtk_initialize_pixmap_image_instance (ii, 1, type);
1302
1303   assert (!NILP (data));
1304
1305   /* Need to get the transparent color here */
1306   color_symbols = extract_xpm_color_names (device, domain, color_symbol_alist, &nsymbols);
1307   for (i = 0; i < nsymbols; i++)
1308     {
1309       if (!strcasecmp ("BgColor", color_symbols[i].name) ||
1310           !strcasecmp ("None", color_symbols[i].name))
1311         {
1312           transparent_color = &color_symbols[i].color;
1313         }
1314     }
1315
1316   write_lisp_string_to_temp_file (data, temp_file_name);
1317   pixmap = gdk_pixmap_create_from_xpm (window, &mask, transparent_color, temp_file_name);
1318   unlink (temp_file_name);
1319
1320   if (color_symbols) xfree (color_symbols);
1321
1322   if (!pixmap)
1323   {
1324     signal_image_error ("Error reading pixmap", data);
1325   }
1326
1327   gdk_window_get_geometry (pixmap, NULL, NULL, &w, &h, &depth);
1328
1329   IMAGE_INSTANCE_GTK_PIXMAP (ii) = pixmap;
1330   IMAGE_INSTANCE_GTK_MASK (ii) = mask;
1331   IMAGE_INSTANCE_GTK_COLORMAP (ii) = cmap;
1332   IMAGE_INSTANCE_GTK_PIXELS (ii) = 0;
1333   IMAGE_INSTANCE_GTK_NPIXELS (ii) = 0;
1334   IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = w;
1335   IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = h;
1336   IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
1337     find_keyword_in_vector (instantiator, Q_file);
1338
1339   switch (type)
1340     {
1341     case IMAGE_MONO_PIXMAP:
1342       break;
1343
1344     case IMAGE_COLOR_PIXMAP:
1345       {
1346         IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = depth;
1347       }
1348       break;
1349
1350     case IMAGE_POINTER:
1351       {
1352         GdkColor fg, bg;
1353         unsigned int xhot, yhot;
1354
1355         /* #### Gtk does not give us access to the hotspots of a pixmap */
1356         xhot = yhot = 1;
1357         XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii), xhot);
1358         XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii), yhot);
1359
1360         check_pointer_sizes (w, h, instantiator);
1361
1362         /* If the loaded pixmap has colors allocated (meaning it came from an
1363            XPM file), then use those as the default colors for the cursor we
1364            create.  Otherwise, default to pointer_fg and pointer_bg.
1365         */
1366         if (depth > 1)
1367           {
1368             warn_when_safe (Qunimplemented, Qnotice,
1369                             "GTK does not support XPM cursors...\n");
1370             IMAGE_INSTANCE_GTK_CURSOR (ii) = gdk_cursor_new (GDK_COFFEE_MUG);
1371           }
1372         else
1373           {
1374             generate_cursor_fg_bg (device, &pointer_fg, &pointer_bg,
1375                                    &fg, &bg);
1376             IMAGE_INSTANCE_PIXMAP_FG (ii) = pointer_fg;
1377             IMAGE_INSTANCE_PIXMAP_BG (ii) = pointer_bg;
1378             IMAGE_INSTANCE_GTK_CURSOR (ii) = gdk_cursor_new_from_pixmap (pixmap, mask, &fg, &bg, xhot, yhot);
1379           }
1380       }
1381
1382       break;
1383
1384     default:
1385       abort ();
1386     }
1387 }
1388 #endif /* HAVE_XPM */
1389
1390 \f
1391 #ifdef HAVE_XFACE
1392
1393 /**********************************************************************
1394  *                             X-Face                                 *
1395  **********************************************************************/
1396 #if defined(EXTERN)
1397 /* This is about to get redefined! */
1398 #undef EXTERN
1399 #endif
1400 /* We have to define SYSV32 so that compface.h includes string.h
1401    instead of strings.h. */
1402 #define SYSV32
1403 #ifdef __cplusplus
1404 extern "C" {
1405 #endif
1406 #include <compface.h>
1407 #ifdef __cplusplus
1408 }
1409 #endif
1410 /* JMP_BUF cannot be used here because if it doesn't get defined
1411    to jmp_buf we end up with a conflicting type error with the
1412    definition in compface.h */
1413 extern jmp_buf comp_env;
1414 #undef SYSV32
1415
1416 static void
1417 gtk_xface_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1418                    Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1419                    int dest_mask, Lisp_Object domain)
1420 {
1421   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1422   int i, stattis;
1423   char *p, *bits, *bp;
1424   CONST char * volatile emsg = 0;
1425   CONST char * volatile dstring;
1426
1427   assert (!NILP (data));
1428
1429   LISP_STRING_TO_EXTERNAL (data, dstring, Qbinary);
1430
1431   if ((p = strchr (dstring, ':')))
1432     {
1433       dstring = p + 1;
1434     }
1435
1436   /* Must use setjmp not SETJMP because we used jmp_buf above not JMP_BUF */
1437   if (!(stattis = setjmp (comp_env)))
1438     {
1439       UnCompAll ((char *) dstring);
1440       UnGenFace ();
1441     }
1442
1443   switch (stattis)
1444     {
1445     case -2:
1446       emsg = "uncompface: internal error";
1447       break;
1448     case -1:
1449       emsg = "uncompface: insufficient or invalid data";
1450       break;
1451     case 1:
1452       emsg = "uncompface: excess data ignored";
1453       break;
1454     }
1455
1456   if (emsg)
1457     signal_simple_error_2 (emsg, data, Qimage);
1458
1459   bp = bits = (char *) alloca (PIXELS / 8);
1460
1461   /* the compface library exports char F[], which uses a single byte per
1462      pixel to represent a 48x48 bitmap.  Yuck. */
1463   for (i = 0, p = F; i < (PIXELS / 8); ++i)
1464     {
1465       int n, b;
1466       /* reverse the bit order of each byte... */
1467       for (b = n = 0; b < 8; ++b)
1468         {
1469           n |= ((*p++) << b);
1470         }
1471       *bp++ = (char) n;
1472     }
1473
1474   xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1475                      pointer_bg, dest_mask, 48, 48, bits);
1476 }
1477
1478 #endif /* HAVE_XFACE */
1479
1480 /**********************************************************************
1481  *                             RESOURCES                              *
1482  **********************************************************************/
1483
1484 static void
1485 gtk_resource_validate (Lisp_Object instantiator)
1486 {
1487   if ((NILP (find_keyword_in_vector (instantiator, Q_file))
1488        &&
1489        NILP (find_keyword_in_vector (instantiator, Q_resource_id)))
1490       ||
1491       NILP (find_keyword_in_vector (instantiator, Q_resource_type)))
1492     signal_simple_error ("Must supply :file, :resource-id and :resource-type",
1493                          instantiator);
1494 }
1495
1496 static Lisp_Object
1497 gtk_resource_normalize (Lisp_Object inst, Lisp_Object console_type, Lisp_Object dest_mask)
1498 {
1499   /* This function can call lisp */
1500   Lisp_Object file = Qnil;
1501   struct gcpro gcpro1, gcpro2;
1502   Lisp_Object alist = Qnil;
1503
1504   GCPRO2 (file, alist);
1505
1506   file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
1507                                              console_type);
1508
1509   if (CONSP (file)) /* failure locating filename */
1510     signal_double_file_error ("Opening pixmap file",
1511                               "no such file or directory",
1512                               Fcar (file));
1513
1514   if (NILP (file)) /* no conversion necessary */
1515     RETURN_UNGCPRO (inst);
1516
1517   alist = tagged_vector_to_alist (inst);
1518
1519   {
1520     alist = remassq_no_quit (Q_file, alist);
1521     alist = Fcons (Fcons (Q_file, file), alist);
1522   }
1523
1524   {
1525     Lisp_Object result = alist_to_tagged_vector (Qgtk_resource, alist);
1526     free_alist (alist);
1527     RETURN_UNGCPRO (result);
1528   }
1529 }
1530
1531 static int
1532 gtk_resource_possible_dest_types (void)
1533 {
1534   return IMAGE_POINTER_MASK | IMAGE_COLOR_PIXMAP_MASK;
1535 }
1536
1537 extern guint symbol_to_enum (Lisp_Object, GtkType);
1538
1539 static guint resource_name_to_resource (Lisp_Object name, int type)
1540 {
1541   if (type == IMAGE_POINTER)
1542     return (symbol_to_enum (name, GTK_TYPE_GDK_CURSOR_TYPE));
1543   else
1544     return (0);
1545 }
1546
1547 static int
1548 resource_symbol_to_type (Lisp_Object data)
1549 {
1550   if (EQ (data, Qcursor))
1551     return IMAGE_POINTER;
1552 #if 0
1553   else if (EQ (data, Qicon))
1554     return IMAGE_ICON;
1555   else if (EQ (data, Qbitmap))
1556     return IMAGE_BITMAP;
1557 #endif
1558   else
1559     return 0;
1560 }
1561
1562 static void
1563 gtk_resource_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1564                           Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1565                           int dest_mask, Lisp_Object domain)
1566 {
1567   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1568   GdkCursor *c = NULL;
1569   unsigned int type = 0;
1570   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1571   Lisp_Object resource_type = find_keyword_in_vector (instantiator, Q_resource_type);
1572   Lisp_Object resource_id = find_keyword_in_vector (instantiator, Q_resource_id);
1573
1574   if (!DEVICE_GTK_P (XDEVICE (device)))
1575     signal_simple_error ("Not a GTK device", device);
1576
1577   type = resource_symbol_to_type (resource_type);
1578
1579 #if 0
1580   if (dest_mask & IMAGE_POINTER_MASK && type == IMAGE_POINTER_MASK)
1581     iitype = IMAGE_POINTER;
1582   else if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
1583     iitype = IMAGE_COLOR_PIXMAP;
1584   else
1585     incompatible_image_types (instantiator, dest_mask,
1586                               IMAGE_COLOR_PIXMAP_MASK | IMAGE_POINTER_MASK);
1587 #endif
1588
1589   /* mess with the keyword info we were provided with */
1590   gtk_initialize_pixmap_image_instance (ii, 1, type);
1591   c = gdk_cursor_new (resource_name_to_resource (resource_id, type));
1592   IMAGE_INSTANCE_GTK_CURSOR (ii) = c;
1593   IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = resource_id;
1594   IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = 10;
1595   IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = 10;
1596   IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = 1;
1597 }
1598
1599 static void
1600 check_valid_resource_symbol (Lisp_Object data)
1601 {
1602   CHECK_SYMBOL (data);
1603   if (!resource_symbol_to_type (data))
1604     signal_simple_error ("invalid resource type", data);
1605 }
1606
1607 static void
1608 check_valid_resource_id (Lisp_Object data)
1609 {
1610   if (!resource_name_to_resource (data, IMAGE_POINTER)
1611       &&
1612       !resource_name_to_resource (data, IMAGE_COLOR_PIXMAP)
1613 #if 0
1614       &&
1615       !resource_name_to_resource (data, IMAGE_BITMAP)
1616 #endif
1617       )
1618     signal_simple_error ("invalid resource identifier", data);
1619 }
1620
1621 #if 0
1622 void
1623 check_valid_string_or_int (Lisp_Object data)
1624 {
1625   if (!INTP (data))
1626     CHECK_STRING (data);
1627   else
1628     CHECK_INT (data);
1629 }
1630 #endif
1631
1632 \f
1633 /**********************************************************************
1634  *                       Autodetect                                      *
1635  **********************************************************************/
1636
1637 static void
1638 autodetect_validate (Lisp_Object instantiator)
1639 {
1640   data_must_be_present (instantiator);
1641 }
1642
1643 static Lisp_Object
1644 autodetect_normalize (Lisp_Object instantiator,
1645                       Lisp_Object console_type,
1646                       Lisp_Object dest_mask)
1647 {
1648   Lisp_Object file = find_keyword_in_vector (instantiator, Q_data);
1649   Lisp_Object filename = Qnil;
1650   Lisp_Object data = Qnil;
1651   struct gcpro gcpro1, gcpro2, gcpro3;
1652   Lisp_Object alist = Qnil;
1653
1654   GCPRO3 (filename, data, alist);
1655
1656   if (NILP (file)) /* no conversion necessary */
1657     RETURN_UNGCPRO (instantiator);
1658
1659   alist = tagged_vector_to_alist (instantiator);
1660
1661   filename = locate_pixmap_file (file);
1662   if (!NILP (filename))
1663     {
1664       int xhot, yhot;
1665       /* #### Apparently some versions of XpmReadFileToData, which is
1666          called by pixmap_to_lisp_data, don't return an error value
1667          if the given file is not a valid XPM file.  Instead, they
1668          just seg fault.  It is definitely caused by passing a
1669          bitmap.  To try and avoid this we check for bitmaps first.  */
1670
1671       data = bitmap_to_lisp_data (filename, &xhot, &yhot, 1);
1672
1673       if (!EQ (data, Qt))
1674         {
1675           alist = remassq_no_quit (Q_data, alist);
1676           alist = Fcons (Fcons (Q_file, filename),
1677                          Fcons (Fcons (Q_data, data), alist));
1678           if (xhot != -1)
1679             alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
1680                            alist);
1681           if (yhot != -1)
1682             alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
1683                            alist);
1684
1685           alist = xbm_mask_file_munging (alist, filename, Qnil, console_type);
1686
1687           {
1688             Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
1689             free_alist (alist);
1690             RETURN_UNGCPRO (result);
1691           }
1692         }
1693
1694 #ifdef HAVE_XPM
1695       data = pixmap_to_lisp_data (filename, 1);
1696
1697       if (!EQ (data, Qt))
1698         {
1699           alist = remassq_no_quit (Q_data, alist);
1700           alist = Fcons (Fcons (Q_file, filename),
1701                          Fcons (Fcons (Q_data, data), alist));
1702           alist = Fcons (Fcons (Q_color_symbols,
1703                                 evaluate_xpm_color_symbols ()),
1704                          alist);
1705           {
1706             Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
1707             free_alist (alist);
1708             RETURN_UNGCPRO (result);
1709           }
1710         }
1711 #endif
1712     }
1713
1714   /* If we couldn't convert it, just put it back as it is.
1715      We might try to further frob it later as a cursor-font
1716      specification. (We can't do that now because we don't know
1717      what dest-types it's going to be instantiated into.) */
1718   {
1719     Lisp_Object result = alist_to_tagged_vector (Qautodetect, alist);
1720     free_alist (alist);
1721     RETURN_UNGCPRO (result);
1722   }
1723 }
1724
1725 static int
1726 autodetect_possible_dest_types (void)
1727 {
1728   return
1729     IMAGE_MONO_PIXMAP_MASK  |
1730     IMAGE_COLOR_PIXMAP_MASK |
1731     IMAGE_POINTER_MASK      |
1732     IMAGE_TEXT_MASK;
1733 }
1734
1735 static void
1736 autodetect_instantiate (Lisp_Object image_instance,
1737                                   Lisp_Object instantiator,
1738                                   Lisp_Object pointer_fg,
1739                                   Lisp_Object pointer_bg,
1740                                   int dest_mask, Lisp_Object domain)
1741 {
1742   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1743   struct gcpro gcpro1, gcpro2, gcpro3;
1744   Lisp_Object alist = Qnil;
1745   Lisp_Object result = Qnil;
1746   int is_cursor_font = 0;
1747
1748   GCPRO3 (data, alist, result);
1749
1750   alist = tagged_vector_to_alist (instantiator);
1751   if (dest_mask & IMAGE_POINTER_MASK)
1752     {
1753       CONST char *name_ext;
1754
1755       TO_EXTERNAL_FORMAT (LISP_STRING, data,
1756                           C_STRING_ALLOCA, name_ext,
1757                           Qfile_name);
1758
1759       if (cursor_name_to_index (name_ext) != -1)
1760         {
1761           result = alist_to_tagged_vector (Qcursor_font, alist);
1762           is_cursor_font = 1;
1763         }
1764     }
1765
1766   if (!is_cursor_font)
1767     result = alist_to_tagged_vector (Qstring, alist);
1768   free_alist (alist);
1769
1770   if (is_cursor_font)
1771     cursor_font_instantiate (image_instance, result, pointer_fg,
1772                              pointer_bg, dest_mask, domain);
1773   else
1774     string_instantiate (image_instance, result, pointer_fg,
1775                         pointer_bg, dest_mask, domain);
1776
1777   UNGCPRO;
1778 }
1779
1780 \f
1781 /**********************************************************************
1782  *                              Font                                  *
1783  **********************************************************************/
1784
1785 static void
1786 font_validate (Lisp_Object instantiator)
1787 {
1788   data_must_be_present (instantiator);
1789 }
1790
1791 static int
1792 font_possible_dest_types (void)
1793 {
1794   return IMAGE_POINTER_MASK;
1795 }
1796
1797 static void
1798 font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1799                   Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1800                   int dest_mask, Lisp_Object domain)
1801 {
1802   /* This function can GC */
1803   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1804   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1805   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1806   GdkColor fg, bg;
1807   GdkFont *source, *mask;
1808   char source_name[MAXPATHLEN], mask_name[MAXPATHLEN], dummy;
1809   int source_char, mask_char;
1810   int count;
1811   Lisp_Object foreground, background;
1812
1813   if (!DEVICE_GTK_P (XDEVICE (device)))
1814     signal_simple_error ("Not a Gtk device", device);
1815
1816   if (!STRINGP (data) ||
1817       strncmp ("FONT ", (char *) XSTRING_DATA (data), 5))
1818     signal_simple_error ("Invalid font-glyph instantiator",
1819                          instantiator);
1820
1821   if (!(dest_mask & IMAGE_POINTER_MASK))
1822     incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
1823
1824   foreground = find_keyword_in_vector (instantiator, Q_foreground);
1825   if (NILP (foreground))
1826     foreground = pointer_fg;
1827   background = find_keyword_in_vector (instantiator, Q_background);
1828   if (NILP (background))
1829     background = pointer_bg;
1830
1831   generate_cursor_fg_bg (device, &foreground, &background, &fg, &bg);
1832
1833   count = sscanf ((char *) XSTRING_DATA (data),
1834                   "FONT %s %d %s %d %c",
1835                   source_name, &source_char,
1836                   mask_name, &mask_char, &dummy);
1837   /* Allow "%s %d %d" as well... */
1838   if (count == 3 && (1 == sscanf (mask_name, "%d %c", &mask_char, &dummy)))
1839     count = 4, mask_name[0] = 0;
1840
1841   if (count != 2 && count != 4)
1842     signal_simple_error ("invalid cursor specification", data);
1843   source = gdk_font_load (source_name);
1844   if (! source)
1845     signal_simple_error_2 ("couldn't load font",
1846                            build_string (source_name),
1847                            data);
1848   if (count == 2)
1849     mask = 0;
1850   else if (!mask_name[0])
1851     mask = source;
1852   else
1853     {
1854       mask = gdk_font_load (mask_name);
1855       if (!mask)
1856         /* continuable */
1857         Fsignal (Qerror, list3 (build_string ("couldn't load font"),
1858                                 build_string (mask_name), data));
1859     }
1860   if (!mask)
1861     mask_char = 0;
1862
1863   /* #### call XQueryTextExtents() and check_pointer_sizes() here. */
1864
1865   gtk_initialize_pixmap_image_instance (ii, 1, IMAGE_POINTER);
1866
1867   IMAGE_INSTANCE_GTK_CURSOR (ii) = NULL;
1868
1869 #if 0
1870   /* #### BILL!!! There is no way to call this function from Gdk */
1871     XCreateGlyphCursor (dpy, source, mask, source_char, mask_char,
1872                         &fg, &bg);
1873 #endif
1874   XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
1875   XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
1876
1877   gdk_font_unref (source);
1878   if (mask && mask != source) gdk_font_unref (mask);
1879 }
1880
1881 \f
1882 /**********************************************************************
1883  *                           Cursor-Font                              *
1884  **********************************************************************/
1885
1886 static void
1887 cursor_font_validate (Lisp_Object instantiator)
1888 {
1889   data_must_be_present (instantiator);
1890 }
1891
1892 static int
1893 cursor_font_possible_dest_types (void)
1894 {
1895   return IMAGE_POINTER_MASK;
1896 }
1897
1898 static char *__downcase (const char *name)
1899 {
1900     char *converted = strdup(name);
1901     char *work = converted;
1902
1903     while (*work)
1904     {
1905         *work = tolower(*work);
1906         work++;
1907     }
1908     return(converted);
1909 }
1910
1911 /* This is basically the equivalent of XmuCursorNameToIndex */
1912 static gint
1913 cursor_name_to_index (const char *name)
1914 {
1915     int i;
1916     static char *the_gdk_cursors[GDK_NUM_GLYPHS];
1917
1918     if (!the_gdk_cursors[GDK_BASED_ARROW_UP])
1919     {
1920         /* Need to initialize the array */
1921         /* Supposedly since this array is static it should be
1922            initialized to NULLs for us, but I'm very paranoid. */
1923         for (i = 0; i < GDK_NUM_GLYPHS; i++)
1924         {
1925             the_gdk_cursors[i] = NULL;
1926         }
1927
1928 #define FROB_CURSOR(x) the_gdk_cursors[GDK_##x] = __downcase(#x)
1929         FROB_CURSOR(ARROW);                     FROB_CURSOR(BASED_ARROW_DOWN);
1930         FROB_CURSOR(BASED_ARROW_UP);            FROB_CURSOR(BOAT);
1931         FROB_CURSOR(BOGOSITY);                  FROB_CURSOR(BOTTOM_LEFT_CORNER);
1932         FROB_CURSOR(BOTTOM_RIGHT_CORNER);       FROB_CURSOR(BOTTOM_SIDE);
1933         FROB_CURSOR(BOTTOM_TEE);                FROB_CURSOR(BOX_SPIRAL);
1934         FROB_CURSOR(CENTER_PTR);                FROB_CURSOR(CIRCLE);
1935         FROB_CURSOR(CLOCK);                     FROB_CURSOR(COFFEE_MUG);
1936         FROB_CURSOR(CROSS);                     FROB_CURSOR(CROSS_REVERSE);
1937         FROB_CURSOR(CROSSHAIR);                 FROB_CURSOR(DIAMOND_CROSS);
1938         FROB_CURSOR(DOT);                       FROB_CURSOR(DOTBOX);
1939         FROB_CURSOR(DOUBLE_ARROW);              FROB_CURSOR(DRAFT_LARGE);
1940         FROB_CURSOR(DRAFT_SMALL);               FROB_CURSOR(DRAPED_BOX);
1941         FROB_CURSOR(EXCHANGE);                  FROB_CURSOR(FLEUR);
1942         FROB_CURSOR(GOBBLER);                   FROB_CURSOR(GUMBY);
1943         FROB_CURSOR(HAND1);                     FROB_CURSOR(HAND2);
1944         FROB_CURSOR(HEART);                     FROB_CURSOR(ICON);
1945         FROB_CURSOR(IRON_CROSS);                FROB_CURSOR(LEFT_PTR);
1946         FROB_CURSOR(LEFT_SIDE);                 FROB_CURSOR(LEFT_TEE);
1947         FROB_CURSOR(LEFTBUTTON);                FROB_CURSOR(LL_ANGLE);
1948         FROB_CURSOR(LR_ANGLE);                  FROB_CURSOR(MAN);
1949         FROB_CURSOR(MIDDLEBUTTON);              FROB_CURSOR(MOUSE);
1950         FROB_CURSOR(PENCIL);                    FROB_CURSOR(PIRATE);
1951         FROB_CURSOR(PLUS);                      FROB_CURSOR(QUESTION_ARROW);
1952         FROB_CURSOR(RIGHT_PTR);                 FROB_CURSOR(RIGHT_SIDE);
1953         FROB_CURSOR(RIGHT_TEE);                 FROB_CURSOR(RIGHTBUTTON);
1954         FROB_CURSOR(RTL_LOGO);                  FROB_CURSOR(SAILBOAT);
1955         FROB_CURSOR(SB_DOWN_ARROW);             FROB_CURSOR(SB_H_DOUBLE_ARROW);
1956         FROB_CURSOR(SB_LEFT_ARROW);             FROB_CURSOR(SB_RIGHT_ARROW);
1957         FROB_CURSOR(SB_UP_ARROW);               FROB_CURSOR(SB_V_DOUBLE_ARROW);
1958         FROB_CURSOR(SHUTTLE);                   FROB_CURSOR(SIZING);
1959         FROB_CURSOR(SPIDER);                    FROB_CURSOR(SPRAYCAN);
1960         FROB_CURSOR(STAR);                      FROB_CURSOR(TARGET);
1961         FROB_CURSOR(TCROSS);                    FROB_CURSOR(TOP_LEFT_ARROW);
1962         FROB_CURSOR(TOP_LEFT_CORNER);           FROB_CURSOR(TOP_RIGHT_CORNER);
1963         FROB_CURSOR(TOP_SIDE);                  FROB_CURSOR(TOP_TEE);
1964         FROB_CURSOR(TREK);                      FROB_CURSOR(UL_ANGLE);
1965         FROB_CURSOR(UMBRELLA);                  FROB_CURSOR(UR_ANGLE);
1966         FROB_CURSOR(WATCH);                     FROB_CURSOR(XTERM);
1967         FROB_CURSOR(X_CURSOR);
1968 #undef FROB_CURSOR
1969     }
1970
1971     for (i = 0; i < GDK_NUM_GLYPHS; i++)
1972     {
1973         if (!the_gdk_cursors[i]) continue;
1974         if (!strcmp (the_gdk_cursors[i], name))
1975         {
1976             return (i);
1977         }
1978     }
1979     return(-1);
1980 }
1981
1982 static void
1983 cursor_font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1984                          Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1985                          int dest_mask, Lisp_Object domain)
1986 {
1987   /* This function can GC */
1988   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1989   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1990   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1991   int i;
1992   CONST char *name_ext;
1993   Lisp_Object foreground, background;
1994
1995   if (!DEVICE_GTK_P (XDEVICE (device)))
1996     signal_simple_error ("Not a Gtk device", device);
1997
1998   if (!(dest_mask & IMAGE_POINTER_MASK))
1999     incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
2000
2001   TO_EXTERNAL_FORMAT (LISP_STRING, data,
2002                       C_STRING_ALLOCA, name_ext,
2003                       Qfile_name);
2004
2005   if ((i = cursor_name_to_index (name_ext)) == -1)
2006     signal_simple_error ("Unrecognized cursor-font name", data);
2007
2008   gtk_initialize_pixmap_image_instance (ii, 1, IMAGE_POINTER);
2009   IMAGE_INSTANCE_GTK_CURSOR (ii) = gdk_cursor_new (i);
2010   foreground = find_keyword_in_vector (instantiator, Q_foreground);
2011   if (NILP (foreground))
2012     foreground = pointer_fg;
2013   background = find_keyword_in_vector (instantiator, Q_background);
2014   if (NILP (background))
2015     background = pointer_bg;
2016   maybe_recolor_cursor (image_instance, foreground, background);
2017 }
2018
2019 static int
2020 gtk_colorize_image_instance (Lisp_Object image_instance,
2021                              Lisp_Object foreground, Lisp_Object background);
2022
2023 \f
2024 /************************************************************************/
2025 /*                      subwindow and widget support                      */
2026 /************************************************************************/
2027
2028 /* unmap the image if it is a widget. This is used by redisplay via
2029    redisplay_unmap_subwindows */
2030 static void
2031 gtk_unmap_subwindow (Lisp_Image_Instance *p)
2032 {
2033   if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
2034     {
2035       /* We don't support subwindows, but we do support widgets... */
2036       abort ();
2037     }
2038   else                          /* must be a widget */
2039     {
2040       /* Since we are being unmapped we want the enclosing frame to
2041          get focus. The losing with simple scrolling but is the safest
2042          thing to do. */
2043       if (IMAGE_INSTANCE_GTK_CLIPWIDGET (p))
2044         gtk_widget_unmap (IMAGE_INSTANCE_GTK_CLIPWIDGET (p));
2045     }
2046 }
2047
2048 /* map the subwindow. This is used by redisplay via
2049    redisplay_output_subwindow */
2050 static void
2051 gtk_map_subwindow (Lisp_Image_Instance *p, int x, int y,
2052                  struct display_glyph_area* dga)
2053 {
2054   assert (dga->width > 0 && dga->height > 0);
2055
2056   if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
2057     {
2058       /* No subwindow support... */
2059       abort ();
2060     }
2061   else                          /* must be a widget */
2062     {
2063       struct frame *f = XFRAME (IMAGE_INSTANCE_FRAME (p));
2064       GtkWidget *wid = IMAGE_INSTANCE_GTK_CLIPWIDGET (p);
2065       GtkAllocation a;
2066
2067       if (!wid) return;
2068
2069       a.x = x + IMAGE_INSTANCE_GTK_WIDGET_XOFFSET (p);
2070       a.y = y + IMAGE_INSTANCE_GTK_WIDGET_YOFFSET (p);
2071       a.width = dga->width;
2072       a.height = dga->height;
2073
2074       if ((a.width  != wid->allocation.width)  ||
2075           (a.height != wid->allocation.height))
2076         {
2077           gtk_widget_size_allocate (IMAGE_INSTANCE_GTK_CLIPWIDGET (p), &a);
2078         }
2079
2080       /* #### FIXME DAMMIT */
2081       if ((wid->allocation.x != -dga->xoffset) ||
2082           (wid->allocation.y != -dga->yoffset))
2083         {
2084           guint32 old_flags = GTK_WIDGET_FLAGS (FRAME_GTK_TEXT_WIDGET (f));
2085
2086           /* Fucking GtkFixed widget queues a resize when you add a widget.
2087           ** But only if it is visible.
2088           ** losers.
2089           */
2090           GTK_WIDGET_FLAGS(FRAME_GTK_TEXT_WIDGET (f)) &= ~GTK_VISIBLE;
2091           if (IMAGE_INSTANCE_GTK_ALREADY_PUT(p))
2092             {
2093               gtk_fixed_move (GTK_FIXED (FRAME_GTK_TEXT_WIDGET (f)),
2094                               wid,
2095                               -dga->xoffset, -dga->yoffset);
2096             }
2097           else
2098             {
2099               IMAGE_INSTANCE_GTK_ALREADY_PUT(p) = TRUE;
2100               gtk_fixed_put (GTK_FIXED (FRAME_GTK_TEXT_WIDGET (f)),
2101                              wid,
2102                              -dga->xoffset, -dga->yoffset);
2103             }
2104           GTK_WIDGET_FLAGS(FRAME_GTK_TEXT_WIDGET (f)) = old_flags;
2105         }
2106
2107       if (!IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (p))
2108         {
2109           gtk_widget_map (wid);
2110         }
2111
2112       gtk_widget_draw (wid, NULL);
2113     }
2114 }
2115
2116 /* when you click on a widget you may activate another widget this
2117    needs to be checked and all appropriate widgets updated */
2118 static void
2119 gtk_redisplay_subwindow (Lisp_Image_Instance *p)
2120 {
2121   /* Update the subwindow size if necessary. */
2122   if (IMAGE_INSTANCE_SIZE_CHANGED (p))
2123     {
2124 #if 0
2125       XResizeWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2126                      IMAGE_INSTANCE_X_SUBWINDOW_ID (p),
2127                      IMAGE_INSTANCE_WIDTH (p),
2128                      IMAGE_INSTANCE_HEIGHT (p));
2129 #endif
2130     }
2131 }
2132
2133 /* Update all attributes that have changed. */
2134 static void
2135 gtk_redisplay_widget (Lisp_Image_Instance *p)
2136 {
2137   /* This function can GC if IN_REDISPLAY is false. */
2138
2139   if (!IMAGE_INSTANCE_GTK_CLIPWIDGET (p))
2140     return;
2141
2142 #ifdef HAVE_WIDGETS
2143   /* First get the items if they have changed since this is a
2144      structural change. As such it will nuke all added values so we
2145      need to update most other things after the items have changed.*/
2146   gtk_widget_show_all (IMAGE_INSTANCE_GTK_CLIPWIDGET (p));
2147   if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (p))
2148     {
2149       Lisp_Object image_instance;
2150
2151       XSETIMAGE_INSTANCE (image_instance, p);
2152
2153       /* Need to update GtkArgs that might have changed... */
2154       /* #### FIXME!!! */
2155     }
2156   else
2157     {
2158       /* #### FIXME!!! */
2159       /* No items changed, so do nothing, right? */
2160     }
2161
2162   /* Possibly update the colors and font */
2163   if (IMAGE_INSTANCE_WIDGET_FACE_CHANGED (p)
2164       ||
2165       /* #### This is not sufficient because it will not cope with widgets
2166          that are not currently visible. Once redisplay has done the
2167          visible ones it will clear this flag so that when new ones
2168          become visible they will not be updated. */
2169       XFRAME (IMAGE_INSTANCE_FRAME (p))->faces_changed
2170       ||
2171       XFRAME (IMAGE_INSTANCE_FRAME (p))->frame_changed
2172       ||
2173       IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (p))
2174     {
2175       /* #### Write this function BILL! */
2176       update_widget_face (NULL, p, IMAGE_INSTANCE_FRAME (p));
2177     }
2178
2179   /* Possibly update the text. */
2180   if (IMAGE_INSTANCE_TEXT_CHANGED (p))
2181     {
2182       char* str;
2183       Lisp_Object val = IMAGE_INSTANCE_WIDGET_TEXT (p);
2184       LISP_STRING_TO_EXTERNAL (val, str, Qnative);
2185
2186       /* #### Need to special case each type of GtkWidget here! */
2187     }
2188
2189   /* Possibly update the size. */
2190   if (IMAGE_INSTANCE_SIZE_CHANGED (p)
2191       ||
2192       IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (p)
2193       ||
2194       IMAGE_INSTANCE_TEXT_CHANGED (p))
2195     {
2196       assert (IMAGE_INSTANCE_GTK_WIDGET_ID (p) &&
2197               IMAGE_INSTANCE_GTK_CLIPWIDGET (p)) ;
2198
2199       /* #### Resize the widget! */
2200       /* gtk_widget_size_allocate () */
2201     }
2202
2203   /* Adjust offsets within the frame. */
2204   if (XFRAME (IMAGE_INSTANCE_FRAME (p))->size_changed)
2205     {
2206       /* I don't think we need to do anything for Gtk here... */
2207     }
2208
2209   /* now modify the widget */
2210 #endif
2211 }
2212
2213 /* instantiate and gtk type subwindow */
2214 static void
2215 gtk_subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2216                            Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2217                            int dest_mask, Lisp_Object domain)
2218 {
2219   /* This function can GC */
2220   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2221   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
2222   Lisp_Object frame = DOMAIN_FRAME (domain);
2223
2224   if (!DEVICE_GTK_P (XDEVICE (device)))
2225     signal_simple_error ("Not a GTK device", device);
2226
2227   IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW;
2228
2229   ii->data = xnew_and_zero (struct gtk_subwindow_data);
2230
2231   /* Create a window for clipping */
2232   IMAGE_INSTANCE_GTK_CLIPWINDOW (ii) = NULL;
2233
2234   /* Now put the subwindow inside the clip window. */
2235   IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void *) NULL;
2236 }
2237
2238 #ifdef HAVE_WIDGETS
2239 \f
2240 /************************************************************************/
2241 /*                            widgets                            */
2242 /************************************************************************/
2243 static void
2244 update_widget_face (GtkWidget *w, Lisp_Image_Instance *ii,
2245                     Lisp_Object domain)
2246 {
2247   if (0)
2248     {
2249       GtkStyle *style = gtk_widget_get_style (w);
2250       Lisp_Object pixel = Qnil;
2251       GdkColor *fcolor, *bcolor;
2252
2253       style = gtk_style_copy (style);
2254
2255       /* Update the foreground. */
2256       pixel = FACE_FOREGROUND (IMAGE_INSTANCE_WIDGET_FACE (ii), domain);
2257       fcolor = COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (pixel));
2258
2259       /* Update the background. */
2260       pixel = FACE_BACKGROUND (IMAGE_INSTANCE_WIDGET_FACE (ii), domain);
2261       bcolor = COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (pixel));
2262
2263       /* Update the font */
2264       /* #### FIXME!!! Need to copy the widgets style, dick with it, and
2265       ** set the widgets style to the new style...
2266       */
2267       gtk_widget_set_style (w, style);
2268
2269       /* #### Megahack - but its just getting too complicated to do this
2270          in the right place. */
2271 #if 0
2272       if (EQ (IMAGE_INSTANCE_WIDGET_TYPE (ii), Qtab_control))
2273         update_tab_widget_face (wv, ii, domain);
2274 #endif
2275     }
2276 }
2277
2278 #if 0
2279 static void
2280 update_tab_widget_face (GtkWidget *w, Lisp_Image_Instance *ii,
2281                         Lisp_Object domain)
2282 {
2283   if (wv->contents)
2284     {
2285       widget_value* val = wv->contents, *cur;
2286
2287       /* Give each child label the correct foreground color. */
2288       Lisp_Object pixel = FACE_FOREGROUND
2289         (IMAGE_INSTANCE_WIDGET_FACE (ii),
2290          domain);
2291       XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2292       lw_add_widget_value_arg (val, XtNtabForeground, fcolor.pixel);
2293       wv->change = VISIBLE_CHANGE;
2294       val->change = VISIBLE_CHANGE;
2295
2296       for (cur = val->next; cur; cur = cur->next)
2297         {
2298           cur->change = VISIBLE_CHANGE;
2299           if (cur->value)
2300             {
2301               lw_copy_widget_value_args (val, cur);
2302             }
2303         }
2304     }
2305 }
2306 #endif
2307
2308 static Lisp_Object
2309 gtk_widget_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator,
2310                           Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2311                           Lisp_Object domain)
2312 {
2313   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2314   Lisp_Object widget = Qnil;
2315   char *nm = NULL;
2316   GtkWidget *w = NULL;
2317   struct gcpro gcpro1;
2318
2319   IMAGE_INSTANCE_TYPE (ii) = IMAGE_WIDGET;
2320
2321   if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
2322     {
2323       LISP_STRING_TO_EXTERNAL (IMAGE_INSTANCE_WIDGET_TEXT (ii), nm, Qnative);
2324     }
2325
2326   ii->data = xnew_and_zero (struct gtk_subwindow_data);
2327
2328   /* Create a clipping widget */
2329   IMAGE_INSTANCE_GTK_CLIPWIDGET (ii) = NULL;
2330   IMAGE_INSTANCE_GTK_ALREADY_PUT(ii) = FALSE;
2331
2332   /* Create the actual widget */
2333   GCPRO1 (widget);
2334   widget = call5 (Qgtk_widget_instantiate_internal,
2335                   image_instance, instantiator,
2336                   pointer_fg, pointer_bg,
2337                   domain);
2338
2339   if (!NILP (widget))
2340     {
2341       CHECK_GTK_OBJECT (widget);
2342       w = GTK_WIDGET (XGTK_OBJECT (widget)->object);
2343     }
2344   else
2345     {
2346       stderr_out ("Lisp-level creation of widget failed... falling back\n");
2347       w = gtk_label_new ("Widget Creation Failed...");
2348     }
2349
2350   UNGCPRO;
2351
2352   IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void *) w;
2353
2354   /* #### HACK!!!!  We should make this do the right thing if we
2355   ** really need a clip widget!
2356   */
2357   IMAGE_INSTANCE_GTK_CLIPWIDGET (ii) = w;
2358
2359   return (Qt);
2360 }
2361
2362 static void
2363 gtk_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 {
2367   call_with_suspended_errors ((lisp_fn_t) gtk_widget_instantiate_1,
2368                               Qnil, Qimage,
2369                               ERROR_ME_WARN, 5,
2370                               image_instance, instantiator,
2371                               pointer_fg,
2372                               pointer_bg,
2373                               domain);
2374 }
2375
2376 /* get properties of a control */
2377 static Lisp_Object
2378 gtk_widget_property (Lisp_Object image_instance, Lisp_Object prop)
2379 {
2380   /* Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); */
2381
2382   /* get the text from a control */
2383   if (EQ (prop, Q_text))
2384     {
2385       return Qnil;
2386     }
2387   return Qunbound;
2388 }
2389
2390 #define FAKE_GTK_WIDGET_INSTANTIATOR(x)                                 \
2391 static void                                                             \
2392 gtk_##x##_instantiate (Lisp_Object image_instance,                      \
2393    Lisp_Object instantiator,                                            \
2394    Lisp_Object pointer_fg,                                              \
2395    Lisp_Object pointer_bg,                                              \
2396    int dest_mask, Lisp_Object domain)                                   \
2397 {                                                                       \
2398   gtk_widget_instantiate (image_instance, instantiator, pointer_fg,     \
2399                           pointer_bg, dest_mask, domain);               \
2400 }
2401
2402 FAKE_GTK_WIDGET_INSTANTIATOR(native_layout);
2403 FAKE_GTK_WIDGET_INSTANTIATOR(button);
2404 FAKE_GTK_WIDGET_INSTANTIATOR(progress_gauge);
2405 FAKE_GTK_WIDGET_INSTANTIATOR(edit_field);
2406 FAKE_GTK_WIDGET_INSTANTIATOR(combo_box);
2407 FAKE_GTK_WIDGET_INSTANTIATOR(tab_control);
2408 FAKE_GTK_WIDGET_INSTANTIATOR(label);
2409
2410 /* Update a button's clicked state. */
2411 static void
2412 gtk_button_redisplay (Lisp_Object image_instance)
2413 {
2414   /* This function can GC if IN_REDISPLAY is false. */
2415   Lisp_Image_Instance *p = XIMAGE_INSTANCE (image_instance);
2416   GtkWidget *w = IMAGE_INSTANCE_GTK_CLIPWIDGET (p);
2417
2418   if (GTK_WIDGET_TYPE (w) == gtk_button_get_type ())
2419     {
2420     }
2421   else if (GTK_WIDGET_TYPE (w) == gtk_check_button_get_type ())
2422     {
2423     }
2424   else if (GTK_WIDGET_TYPE (w) == gtk_radio_button_get_type ())
2425     {
2426     }
2427   else
2428     {
2429       /* Unknown button type... */
2430       abort();
2431     }
2432 }
2433
2434 /* get properties of a button */
2435 static Lisp_Object
2436 gtk_button_property (Lisp_Object image_instance, Lisp_Object prop)
2437 {
2438   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2439
2440   /* check the state of a button */
2441   if (EQ (prop, Q_selected))
2442     {
2443       if (GTK_WIDGET_HAS_FOCUS (IMAGE_INSTANCE_SUBWINDOW_ID (ii)))
2444         return Qt;
2445       else
2446         return Qnil;
2447     }
2448   return Qunbound;
2449 }
2450
2451 /* set the properties of a progress gauge */
2452 static void
2453 gtk_progress_gauge_redisplay (Lisp_Object image_instance)
2454 {
2455   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2456
2457   if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii))
2458     {
2459       gfloat f;
2460       Lisp_Object val;
2461
2462       val = XGUI_ITEM (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))->value;
2463       f = XFLOATINT (val);
2464
2465       gtk_progress_set_value (GTK_PROGRESS (IMAGE_INSTANCE_SUBWINDOW_ID (ii)),
2466                               f);
2467     }
2468 }
2469
2470 /* Set the properties of a tab control */
2471 static void
2472 gtk_tab_control_redisplay (Lisp_Object image_instance)
2473 {
2474   /* #### Convert this to GTK baby! */
2475   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2476
2477   if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) ||
2478       IMAGE_INSTANCE_WIDGET_ACTION_OCCURRED (ii))
2479     {
2480       /* If only the order has changed then simply select the first
2481          one of the pending set. This stops horrendous rebuilding -
2482          and hence flicker - of the tabs each time you click on
2483          one. */
2484       if (tab_control_order_only_changed (image_instance))
2485         {
2486           Lisp_Object rest, selected =
2487             gui_item_list_find_selected
2488             (NILP (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii)) ?
2489              XCDR (IMAGE_INSTANCE_WIDGET_ITEMS (ii)) :
2490              XCDR (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii)));
2491
2492           LIST_LOOP (rest, XCDR (IMAGE_INSTANCE_WIDGET_ITEMS (ii)))
2493             {
2494               if (gui_item_equal_sans_selected (XCAR (rest), selected, 0))
2495                 {
2496                   Lisp_Object old_selected =gui_item_list_find_selected
2497                     (XCDR (IMAGE_INSTANCE_WIDGET_ITEMS (ii)));
2498
2499                   /* Need to focus on the widget... */
2500                   stderr_out ("Hey, change the tab-focus you boob...\n");
2501
2502                   /* Pick up the new selected item. */
2503                   XGUI_ITEM (old_selected)->selected =
2504                     XGUI_ITEM (XCAR (rest))->selected;
2505                   XGUI_ITEM (XCAR (rest))->selected =
2506                     XGUI_ITEM (selected)->selected;
2507                   /* We're not actually changing the items anymore. */
2508                   IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) = 0;
2509                   IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii) = Qnil;
2510                   break;
2511                 }
2512             }
2513         }
2514       else
2515         {
2516           /* More than just the order has changed... let's get busy! */
2517           GtkNotebook *nb = GTK_NOTEBOOK (IMAGE_INSTANCE_GTK_CLIPWIDGET (ii));
2518           guint num_pages = g_list_length (nb->children);
2519           Lisp_Object rest;
2520
2521           if (num_pages >= 0)
2522             {
2523               int i;
2524               for (i = num_pages; i >= 0; --i)
2525                 {
2526                   gtk_notebook_remove_page (nb, i);
2527                 }
2528             }
2529
2530           LIST_LOOP (rest, XCDR (IMAGE_INSTANCE_WIDGET_ITEMS (ii)))
2531             {
2532               Lisp_Gui_Item *pgui = XGUI_ITEM (XCAR (rest));
2533               char *c_name = NULL;
2534
2535               if (!STRINGP (pgui->name))
2536                 pgui->name = Feval (pgui->name);
2537
2538               CHECK_STRING (pgui->name);
2539
2540               TO_EXTERNAL_FORMAT (LISP_STRING, pgui->name,
2541                                   C_STRING_ALLOCA, c_name,
2542                                   Qctext);
2543
2544               gtk_notebook_append_page (nb,
2545                                         gtk_vbox_new (FALSE, 3),
2546                                         gtk_label_new (c_name));
2547             }
2548
2549           /* Show all the new widgets we just added... */
2550           gtk_widget_show_all (GTK_WIDGET (nb));
2551         }
2552     }
2553
2554   /* Possibly update the face. */
2555 #if 0
2556   if (IMAGE_INSTANCE_WIDGET_FACE_CHANGED (ii)
2557       ||
2558       XFRAME (IMAGE_INSTANCE_FRAME (ii))->faces_changed
2559       ||
2560       IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii))
2561     {
2562       update_tab_widget_face (wv, ii,
2563                               IMAGE_INSTANCE_FRAME (ii));
2564     }
2565 #endif
2566 }
2567 #endif /* HAVE_WIDGETS */
2568
2569 \f
2570 /************************************************************************/
2571 /*                            initialization                            */
2572 /************************************************************************/
2573 void
2574 syms_of_glyphs_gtk (void)
2575 {
2576   defkeyword (&Q_resource_id, ":resource-id");
2577   defkeyword (&Q_resource_type, ":resource-type");
2578 #ifdef HAVE_WIDGETS
2579   defsymbol (&Qgtk_widget_instantiate_internal, "gtk-widget-instantiate-internal");
2580   defsymbol (&Qgtk_widget_property_internal, "gtk-widget-property-internal");
2581   defsymbol (&Qgtk_widget_redisplay_internal, "gtk-widget-redisplay-internal");
2582   defsymbol (&Qgtk_widget_set_style, "gtk-widget-set-style");
2583 #endif
2584 }
2585
2586 void
2587 console_type_create_glyphs_gtk (void)
2588 {
2589   /* image methods */
2590   CONSOLE_HAS_METHOD (gtk, print_image_instance);
2591   CONSOLE_HAS_METHOD (gtk, finalize_image_instance);
2592   CONSOLE_HAS_METHOD (gtk, image_instance_equal);
2593   CONSOLE_HAS_METHOD (gtk, image_instance_hash);
2594   CONSOLE_HAS_METHOD (gtk, colorize_image_instance);
2595   CONSOLE_HAS_METHOD (gtk, init_image_instance_from_eimage);
2596   CONSOLE_HAS_METHOD (gtk, locate_pixmap_file);
2597   CONSOLE_HAS_METHOD (gtk, unmap_subwindow);
2598   CONSOLE_HAS_METHOD (gtk, map_subwindow);
2599   CONSOLE_HAS_METHOD (gtk, redisplay_widget);
2600   CONSOLE_HAS_METHOD (gtk, redisplay_subwindow);
2601 }
2602
2603 void
2604 image_instantiator_format_create_glyphs_gtk (void)
2605 {
2606   IIFORMAT_VALID_CONSOLE (gtk, nothing);
2607   IIFORMAT_VALID_CONSOLE (gtk, string);
2608 #ifdef HAVE_WIDGETS
2609   IIFORMAT_VALID_CONSOLE (gtk, layout);
2610 #endif
2611   IIFORMAT_VALID_CONSOLE (gtk, formatted_string);
2612   IIFORMAT_VALID_CONSOLE (gtk, inherit);
2613 #ifdef HAVE_XPM
2614   INITIALIZE_DEVICE_IIFORMAT (gtk, xpm);
2615   IIFORMAT_HAS_DEVMETHOD (gtk, xpm, instantiate);
2616 #endif
2617 #ifdef HAVE_JPEG
2618   IIFORMAT_VALID_CONSOLE (gtk, jpeg);
2619 #endif
2620 #ifdef HAVE_TIFF
2621   IIFORMAT_VALID_CONSOLE (gtk, tiff);
2622 #endif
2623 #ifdef HAVE_PNG
2624   IIFORMAT_VALID_CONSOLE (gtk, png);
2625 #endif
2626 #ifdef HAVE_GIF
2627   IIFORMAT_VALID_CONSOLE (gtk, gif);
2628 #endif
2629
2630   INITIALIZE_DEVICE_IIFORMAT (gtk, subwindow);
2631   IIFORMAT_HAS_DEVMETHOD (gtk, subwindow, instantiate);
2632
2633 #ifdef HAVE_WIDGETS
2634   /* layout widget */
2635   INITIALIZE_DEVICE_IIFORMAT (gtk, native_layout);
2636   IIFORMAT_HAS_DEVMETHOD (gtk, native_layout, instantiate);
2637
2638   /* button widget */
2639   INITIALIZE_DEVICE_IIFORMAT (gtk, button);
2640   IIFORMAT_HAS_DEVMETHOD (gtk, button, property);
2641   IIFORMAT_HAS_DEVMETHOD (gtk, button, instantiate);
2642   IIFORMAT_HAS_DEVMETHOD (gtk, button, redisplay);
2643   /* general widget methods. */
2644   INITIALIZE_DEVICE_IIFORMAT (gtk, widget);
2645   IIFORMAT_HAS_DEVMETHOD (gtk, widget, property);
2646
2647   /* progress gauge */
2648   INITIALIZE_DEVICE_IIFORMAT (gtk, progress_gauge);
2649   IIFORMAT_HAS_DEVMETHOD (gtk, progress_gauge, redisplay);
2650   IIFORMAT_HAS_DEVMETHOD (gtk, progress_gauge, instantiate);
2651   /* text field */
2652   INITIALIZE_DEVICE_IIFORMAT (gtk, edit_field);
2653   IIFORMAT_HAS_DEVMETHOD (gtk, edit_field, instantiate);
2654   INITIALIZE_DEVICE_IIFORMAT (gtk, combo_box);
2655   IIFORMAT_HAS_DEVMETHOD (gtk, combo_box, instantiate);
2656   IIFORMAT_HAS_SHARED_DEVMETHOD (gtk, combo_box, redisplay, tab_control);
2657   /* tab control widget */
2658   INITIALIZE_DEVICE_IIFORMAT (gtk, tab_control);
2659   IIFORMAT_HAS_DEVMETHOD (gtk, tab_control, instantiate);
2660   IIFORMAT_HAS_DEVMETHOD (gtk, tab_control, redisplay);
2661   /* label */
2662   INITIALIZE_DEVICE_IIFORMAT (gtk, label);
2663   IIFORMAT_HAS_DEVMETHOD (gtk, label, instantiate);
2664 #endif
2665
2666   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (cursor_font, "cursor-font");
2667   IIFORMAT_VALID_CONSOLE (gtk, cursor_font);
2668
2669   IIFORMAT_HAS_METHOD (cursor_font, validate);
2670   IIFORMAT_HAS_METHOD (cursor_font, possible_dest_types);
2671   IIFORMAT_HAS_METHOD (cursor_font, instantiate);
2672
2673   IIFORMAT_VALID_KEYWORD (cursor_font, Q_data, check_valid_string);
2674   IIFORMAT_VALID_KEYWORD (cursor_font, Q_foreground, check_valid_string);
2675   IIFORMAT_VALID_KEYWORD (cursor_font, Q_background, check_valid_string);
2676
2677   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (font, "font");
2678   IIFORMAT_VALID_CONSOLE (gtk, font);
2679
2680   IIFORMAT_HAS_METHOD (font, validate);
2681   IIFORMAT_HAS_METHOD (font, possible_dest_types);
2682   IIFORMAT_HAS_METHOD (font, instantiate);
2683
2684   IIFORMAT_VALID_KEYWORD (font, Q_data, check_valid_string);
2685   IIFORMAT_VALID_KEYWORD (font, Q_foreground, check_valid_string);
2686   IIFORMAT_VALID_KEYWORD (font, Q_background, check_valid_string);
2687
2688 #ifdef HAVE_XPM
2689   INITIALIZE_DEVICE_IIFORMAT (gtk, xpm);
2690   IIFORMAT_HAS_DEVMETHOD (gtk, xpm, instantiate);
2691 #endif
2692
2693 #ifdef HAVE_XFACE
2694   INITIALIZE_DEVICE_IIFORMAT (gtk, xface);
2695   IIFORMAT_HAS_DEVMETHOD (gtk, xface, instantiate);
2696 #endif
2697
2698   INITIALIZE_DEVICE_IIFORMAT (gtk, xbm);
2699   IIFORMAT_HAS_DEVMETHOD (gtk, xbm, instantiate);
2700   IIFORMAT_VALID_CONSOLE (gtk, xbm);
2701
2702   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (gtk_resource, "gtk-resource");
2703   IIFORMAT_VALID_CONSOLE (gtk, gtk_resource);
2704
2705   IIFORMAT_HAS_METHOD (gtk_resource, validate);
2706   IIFORMAT_HAS_METHOD (gtk_resource, normalize);
2707   IIFORMAT_HAS_METHOD (gtk_resource, possible_dest_types);
2708   IIFORMAT_HAS_METHOD (gtk_resource, instantiate);
2709
2710   IIFORMAT_VALID_KEYWORD (gtk_resource, Q_resource_type, check_valid_resource_symbol);
2711   IIFORMAT_VALID_KEYWORD (gtk_resource, Q_resource_id, check_valid_resource_id);
2712   IIFORMAT_VALID_KEYWORD (gtk_resource, Q_file, check_valid_string);
2713
2714   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (autodetect, "autodetect");
2715   IIFORMAT_VALID_CONSOLE (gtk, autodetect);
2716
2717   IIFORMAT_HAS_METHOD (autodetect, validate);
2718   IIFORMAT_HAS_METHOD (autodetect, normalize);
2719   IIFORMAT_HAS_METHOD (autodetect, possible_dest_types);
2720   IIFORMAT_HAS_METHOD (autodetect, instantiate);
2721
2722   IIFORMAT_VALID_KEYWORD (autodetect, Q_data, check_valid_string);
2723 }
2724
2725 void
2726 vars_of_glyphs_gtk (void)
2727 {
2728 #ifdef HAVE_XFACE
2729   Fprovide (Qxface);
2730 #endif
2731
2732   DEFVAR_LISP ("gtk-bitmap-file-path", &Vgtk_bitmap_file_path /*
2733 A list of the directories in which X bitmap files may be found.
2734 If nil, this is initialized from the "*bitmapFilePath" resource.
2735 This is used by the `make-image-instance' function (however, note that if
2736 the environment variable XBMLANGPATH is set, it is consulted first).
2737 */ );
2738   Vgtk_bitmap_file_path = Qnil;
2739 }
2740
2741 void
2742 complex_vars_of_glyphs_gtk (void)
2743 {
2744 #define BUILD_GLYPH_INST(variable, name)                        \
2745   Fadd_spec_to_specifier                                        \
2746     (GLYPH_IMAGE (XGLYPH (variable)),                           \
2747      vector3 (Qxbm, Q_data,                                     \
2748               list3 (make_int (name##_width),                   \
2749                      make_int (name##_height),                  \
2750                      make_ext_string (name##_bits,              \
2751                                       sizeof (name##_bits),     \
2752                                       Qbinary))),               \
2753      Qglobal, Qgtk, Qnil)
2754
2755   BUILD_GLYPH_INST (Vtruncation_glyph, truncator);
2756   BUILD_GLYPH_INST (Vcontinuation_glyph, continuer);
2757   BUILD_GLYPH_INST (Vxemacs_logo, xemacs);
2758   BUILD_GLYPH_INST (Vhscroll_glyph, hscroll);
2759
2760 #undef BUILD_GLYPH_INST
2761 }
2762
2763 \f
2764 /* Ripped off from glyphs-msw.c */
2765 /*
2766  * The data returned by the following routine is always in left-most byte
2767  * first and left-most bit first.  If it doesn't return BitmapSuccess then
2768  * its arguments won't have been touched.  This routine should look as much
2769  * like the Xlib routine XReadBitmapfile as possible.
2770  */
2771 #define MAX_SIZE 1024
2772
2773 /* shared data for the image read/parse logic */
2774 static short hexTable[256];             /* conversion value */
2775 static int initialized = FALSE; /* easier to fill in at run time */
2776
2777 /*
2778  *      Table index for the hex values. Initialized once, first time.
2779  *      Used for translation value or delimiter significance lookup.
2780  */
2781 static void initHexTable()
2782 {
2783     /*
2784      * We build the table at run time for several reasons:
2785      *
2786      *     1.  portable to non-ASCII machines.
2787      *     2.  still reentrant since we set the init flag after setting table.
2788      *     3.  easier to extend.
2789      *     4.  less prone to bugs.
2790      */
2791     hexTable['0'] = 0;  hexTable['1'] = 1;
2792     hexTable['2'] = 2;  hexTable['3'] = 3;
2793     hexTable['4'] = 4;  hexTable['5'] = 5;
2794     hexTable['6'] = 6;  hexTable['7'] = 7;
2795     hexTable['8'] = 8;  hexTable['9'] = 9;
2796     hexTable['A'] = 10; hexTable['B'] = 11;
2797     hexTable['C'] = 12; hexTable['D'] = 13;
2798     hexTable['E'] = 14; hexTable['F'] = 15;
2799     hexTable['a'] = 10; hexTable['b'] = 11;
2800     hexTable['c'] = 12; hexTable['d'] = 13;
2801     hexTable['e'] = 14; hexTable['f'] = 15;
2802
2803     /* delimiters of significance are flagged w/ negative value */
2804     hexTable[' '] = -1; hexTable[','] = -1;
2805     hexTable['}'] = -1; hexTable['\n'] = -1;
2806     hexTable['\t'] = -1;
2807
2808     initialized = TRUE;
2809 }
2810
2811 /*
2812  *      read next hex value in the input stream, return -1 if EOF
2813  */
2814 static int NextInt ( FILE *fstream )
2815 {
2816     int ch;
2817     int value = 0;
2818     int gotone = 0;
2819     int done = 0;
2820
2821     /* loop, accumulate hex value until find delimiter  */
2822     /* skip any initial delimiters found in read stream */
2823
2824     while (!done) {
2825         ch = getc(fstream);
2826         if (ch == EOF) {
2827             value       = -1;
2828             done++;
2829         } else {
2830             /* trim high bits, check type and accumulate */
2831             ch &= 0xff;
2832             if (isascii(ch) && isxdigit(ch)) {
2833                 value = (value << 4) + hexTable[ch];
2834                 gotone++;
2835             } else if ((hexTable[ch]) < 0 && gotone)
2836               done++;
2837         }
2838     }
2839     return value;
2840 }
2841
2842 int read_bitmap_data (fstream, width, height, datap, x_hot, y_hot)
2843     FILE *fstream;                      /* handle on file  */
2844     unsigned int *width, *height;       /* RETURNED */
2845     unsigned char **datap;              /* RETURNED */
2846     int *x_hot, *y_hot;                 /* RETURNED */
2847 {
2848     unsigned char *data = NULL;         /* working variable */
2849     char line[MAX_SIZE];                /* input line from file */
2850     int size;                           /* number of bytes of data */
2851     char name_and_type[MAX_SIZE];       /* an input line */
2852     char *type;                         /* for parsing */
2853     int value;                          /* from an input line */
2854     int version10p;                     /* boolean, old format */
2855     int padding;                        /* to handle alignment */
2856     int bytes_per_line;                 /* per scanline of data */
2857     unsigned int ww = 0;                /* width */
2858     unsigned int hh = 0;                /* height */
2859     int hx = -1;                        /* x hotspot */
2860     int hy = -1;                        /* y hotspot */
2861
2862 #define Xmalloc(size) malloc(size)
2863
2864     /* first time initialization */
2865     if (initialized == FALSE) initHexTable();
2866
2867     /* error cleanup and return macro   */
2868 #define RETURN(code) { if (data) free (data); return code; }
2869
2870     while (fgets(line, MAX_SIZE, fstream)) {
2871         if (strlen(line) == MAX_SIZE-1) {
2872             RETURN (BitmapFileInvalid);
2873         }
2874         if (sscanf(line,"#define %s %d",name_and_type,&value) == 2) {
2875             if (!(type = strrchr(name_and_type, '_')))
2876                 type = name_and_type;
2877             else
2878                 type++;
2879
2880             if (!strcmp("width", type))
2881                 ww = (unsigned int) value;
2882             if (!strcmp("height", type))
2883                 hh = (unsigned int) value;
2884             if (!strcmp("hot", type)) {
2885                 if (type-- == name_and_type || type-- == name_and_type)
2886                     continue;
2887                 if (!strcmp("x_hot", type))
2888                     hx = value;
2889                 if (!strcmp("y_hot", type))
2890                     hy = value;
2891             }
2892             continue;
2893         }
2894
2895         if (sscanf(line, "static short %s = {", name_and_type) == 1)
2896             version10p = 1;
2897         else if (sscanf(line,"static unsigned char %s = {",name_and_type) == 1)
2898             version10p = 0;
2899         else if (sscanf(line, "static char %s = {", name_and_type) == 1)
2900             version10p = 0;
2901         else
2902             continue;
2903
2904         if (!(type = strrchr(name_and_type, '_')))
2905             type = name_and_type;
2906         else
2907             type++;
2908
2909         if (strcmp("bits[]", type))
2910             continue;
2911
2912         if (!ww || !hh)
2913             RETURN (BitmapFileInvalid);
2914
2915         if ((ww % 16) && ((ww % 16) < 9) && version10p)
2916             padding = 1;
2917         else
2918             padding = 0;
2919
2920         bytes_per_line = (ww+7)/8 + padding;
2921
2922         size = bytes_per_line * hh;
2923         data = (unsigned char *) Xmalloc ((unsigned int) size);
2924         if (!data)
2925             RETURN (BitmapNoMemory);
2926
2927         if (version10p) {
2928             unsigned char *ptr;
2929             int bytes;
2930
2931             for (bytes=0, ptr=data; bytes<size; (bytes += 2)) {
2932                 if ((value = NextInt(fstream)) < 0)
2933                     RETURN (BitmapFileInvalid);
2934                 *(ptr++) = value;
2935                 if (!padding || ((bytes+2) % bytes_per_line))
2936                     *(ptr++) = value >> 8;
2937             }
2938         } else {
2939             unsigned char *ptr;
2940             int bytes;
2941
2942             for (bytes=0, ptr=data; bytes<size; bytes++, ptr++) {
2943                 if ((value = NextInt(fstream)) < 0)
2944                     RETURN (BitmapFileInvalid);
2945                 *ptr=value;
2946             }
2947         }
2948         break;
2949     }                                   /* end while */
2950
2951     if (data == NULL) {
2952         RETURN (BitmapFileInvalid);
2953     }
2954
2955     *datap = data;
2956     data = NULL;
2957     *width = ww;
2958     *height = hh;
2959     if (x_hot) *x_hot = hx;
2960     if (y_hot) *y_hot = hy;
2961
2962     RETURN (BitmapSuccess);
2963 }
2964
2965
2966 int read_bitmap_data_from_file (CONST char *filename, unsigned int *width,
2967                                 unsigned int *height, unsigned char **datap,
2968                                 int *x_hot, int *y_hot)
2969 {
2970     FILE *fstream;
2971     int rval;
2972
2973     if ((fstream = fopen (filename, "r")) == NULL) {
2974         return BitmapOpenFailed;
2975     }
2976     rval = read_bitmap_data (fstream, width, height, datap, x_hot, y_hot);
2977     fclose (fstream);
2978     return rval;
2979 }
2980
2981 /* X specific crap */
2982 #include <gdk/gdkx.h>
2983 /* #### Should remove all this X specific stuff when GTK/GDK matures a
2984    bit more and provides an abstraction for it. */
2985 static int
2986 gtk_colorize_image_instance (Lisp_Object image_instance,
2987                              Lisp_Object foreground, Lisp_Object background)
2988 {
2989   struct Lisp_Image_Instance *p;
2990
2991   p = XIMAGE_INSTANCE (image_instance);
2992
2993   switch (IMAGE_INSTANCE_TYPE (p))
2994     {
2995     case IMAGE_MONO_PIXMAP:
2996       IMAGE_INSTANCE_TYPE (p) = IMAGE_COLOR_PIXMAP;
2997       /* Make sure there aren't two pointers to the same mask, causing
2998          it to get freed twice. */
2999       IMAGE_INSTANCE_GTK_MASK (p) = 0;
3000       break;
3001
3002     default:
3003       return 0;
3004     }
3005
3006   {
3007     GdkWindow *draw = GET_GTK_WIDGET_WINDOW (DEVICE_GTK_APP_SHELL (XDEVICE (IMAGE_INSTANCE_DEVICE (p))));
3008     GdkPixmap *new_pxmp = gdk_pixmap_new (draw,
3009                                           IMAGE_INSTANCE_PIXMAP_WIDTH (p),
3010                                           IMAGE_INSTANCE_PIXMAP_HEIGHT (p),
3011                                           DEVICE_GTK_DEPTH (XDEVICE (IMAGE_INSTANCE_DEVICE (p))));
3012     GdkGCValues gcv;
3013     GdkGC *gc;
3014
3015     gcv.foreground = * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (foreground));
3016     gcv.background = * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (background));
3017     gc = gdk_gc_new_with_values (new_pxmp, &gcv, GDK_GC_BACKGROUND | GDK_GC_FOREGROUND);
3018
3019     XCopyPlane (GDK_WINDOW_XDISPLAY (draw),
3020                 GDK_WINDOW_XWINDOW (IMAGE_INSTANCE_GTK_PIXMAP (p)),
3021                 GDK_WINDOW_XWINDOW (new_pxmp),
3022                 GDK_GC_XGC (gc), 0, 0,
3023                 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
3024                 IMAGE_INSTANCE_PIXMAP_HEIGHT (p),
3025                 0, 0, 1);
3026
3027     gdk_gc_destroy (gc);
3028     IMAGE_INSTANCE_GTK_PIXMAP (p) = new_pxmp;
3029     IMAGE_INSTANCE_PIXMAP_DEPTH (p) = DEVICE_GTK_DEPTH (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
3030     IMAGE_INSTANCE_PIXMAP_FG (p) = foreground;
3031     IMAGE_INSTANCE_PIXMAP_BG (p) = background;
3032     return 1;
3033   }
3034 }
3035