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