cgit.sxemacs.org Git - sxemacs/blob - src/ui/glyphs-eimage.c

   1 /* EImage-specific Lisp objects.
   2    Copyright (C) 1993, 1994, 1998 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 SXEmacs
   9
  10 SXEmacs is free software: you can redistribute it and/or modify
  11 it under the terms of the GNU General Public License as published by
  12 the Free Software Foundation, either version 3 of the License, or
  13 (at your option) any later version.
  14
  15 SXEmacs is distributed in the hope that it will be useful,
  16 but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 GNU General Public License for more details.
  19
  20 You should have received a copy of the GNU General Public License
  21 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
  22
  23
  24 /* Synched up with: Not in FSF. */
  25
  26 /* Original author: Jamie Zawinski for 19.8
  27    font-truename stuff added by Jamie Zawinski for 19.10
  28    subwindow support added by Chuck Thompson
  29    additional XPM support added by Chuck Thompson
  30    initial X-Face support added by Stig
  31    rewritten/restructured by Ben Wing for 19.12/19.13
  32    GIF/JPEG support added by Ben Wing for 19.14
  33    PNG support added by Bill Perry for 19.14
  34    Improved GIF/JPEG support added by Bill Perry for 19.14
  35    Cleanup/simplification of error handling by Ben Wing for 19.14
  36    Pointer/icon overhaul, more restructuring by Ben Wing for 19.14
  37    GIF support changed to external Gifreader lib by Jareth Hein for 21.0
  38    Many changes for color work and optimizations by Jareth Hein for 21.0
  39    Switch of GIF/JPEG/PNG to new EImage intermediate code by Jareth Hein for 21.0
  40    TIFF code by Jareth Hein for 21.0
  41    Generalization for ms-windows by Andy Piper for 21.0
  42    TODO:
  43    Convert images.el to C and stick it in here?
  44  */
  45
  46 #include <config.h>
  47 #include "lisp.h"
  48 #include "lstream.h"
  49 #include "console.h"
  50 #include "device.h"
  51 #include "faces.h"
  52 #include "glyphs.h"
  53 #include "objects.h"
  54
  55 #include "buffer.h"
  56 #include "frame.h"
  57 #include "opaque.h"
  58 #include "window.h"
  59
  60 #include "sysfile.h"
  61
  62 #if defined WITH_PNG && defined HAVE_PNG
  63 # ifdef __cplusplus
  64 extern "C" {
  65 # endif
  66 # include <png.h>
  67 # ifdef __cplusplus
  68 }
  69 # endif
  70 #else  /* !PNG */
  71 # include <setjmp.h>
  72 #endif  /* PNG */
  73 #ifdef FILE_CODING
  74 #include "mule/file-coding.h"
  75 #endif
  76
  77 #ifdef HAVE_FFI
  78 #include "effi.h"
  79 #endif  /* HAVE_FFI */
  80
  81 #ifdef HAVE_TIFF
  82 DEFINE_IMAGE_INSTANTIATOR_FORMAT(tiff);
  83 Lisp_Object Qtiff;
  84 #endif
  85
  86 #ifdef HAVE_JPEG
  87 DEFINE_IMAGE_INSTANTIATOR_FORMAT(jpeg);
  88 Lisp_Object Qjpeg;
  89 #endif
  90
  91 #ifdef HAVE_GIF
  92 DEFINE_IMAGE_INSTANTIATOR_FORMAT(gif);
  93 Lisp_Object Qgif;
  94 #endif
  95
  96 #if defined WITH_PNG && defined HAVE_PNG
  97 DEFINE_IMAGE_INSTANTIATOR_FORMAT(png);
  98 Lisp_Object Qpng;
  99 #endif  /* PNG */
 100
 101 #if 1
 102 DEFINE_IMAGE_INSTANTIATOR_FORMAT(rawrgb);
 103 Lisp_Object Qrawrgb;
 104
 105 DEFINE_IMAGE_INSTANTIATOR_FORMAT(rawrgba);
 106 Lisp_Object Qrawrgba;
 107 #endif
 108 \f
 109 #ifdef HAVE_JPEG
 110
 111 /**********************************************************************
 112  *                             JPEG                                   *
 113  **********************************************************************/
 114
 115 #ifdef __cplusplus
 116 extern "C" {
 117 #endif
 118 #include <jpeglib.h>
 119 #include <jerror.h>
 120 #ifdef __cplusplus
 121 }
 122 #endif
 123 /*#define USE_TEMP_FILES_FOR_JPEG_IMAGES 1*/
 124     static void jpeg_validate(Lisp_Object instantiator)
 125 {
 126         file_or_data_must_be_present(instantiator);
 127 }
 128
 129 static Lisp_Object
 130 jpeg_normalize(Lisp_Object inst, Lisp_Object console_type,
 131                Lisp_Object dest_mask)
 132 {
 133         return simple_image_type_normalize(inst, console_type, Qjpeg);
 134 }
 135
 136 static int jpeg_possible_dest_types(void)
 137 {
 138         return IMAGE_COLOR_PIXMAP_MASK;
 139 }
 140
 141 /* To survive the otherwise baffling complexity of making sure
 142    everything gets cleaned up in the presence of an error, we
 143    use an unwind_protect(). */
 144
 145 struct jpeg_unwind_data {
 146         /* Stream that we need to close */
 147         FILE *instream;
 148         /* Object that holds state info for JPEG decoding */
 149         struct jpeg_decompress_struct *cinfo_ptr;
 150         /* EImage data */
 151         unsigned char *eimage;
 152 };
 153
 154 static Lisp_Object jpeg_instantiate_unwind(Lisp_Object unwind_obj)
 155 {
 156         struct jpeg_unwind_data *data =
 157             (struct jpeg_unwind_data *)get_opaque_ptr(unwind_obj);
 158
 159         free_opaque_ptr(unwind_obj);
 160         if (data->cinfo_ptr)
 161                 jpeg_destroy_decompress(data->cinfo_ptr);
 162
 163         if (data->instream)
 164                 fclose(data->instream);
 165
 166         if (data->eimage)
 167                 xfree(data->eimage);
 168
 169         return Qnil;
 170 }
 171
 172 /*
 173  * ERROR HANDLING:
 174  *
 175  * The JPEG library's standard error handler (jerror.c) is divided into
 176  * several "methods" which you can override individually.  This lets you
 177  * adjust the behavior without duplicating a lot of code, which you might
 178  * have to update with each future release.
 179  *
 180  * Our example here shows how to override the "error_exit" method so that
 181  * control is returned to the library's caller when a fatal error occurs,
 182  * rather than calling exit() as the standard error_exit method does.
 183  *
 184  * We use C's setjmp/longjmp facility to return control.  This means that the
 185  * routine which calls the JPEG library must first execute a setjmp() call to
 186  * establish the return point.  We want the replacement error_exit to do a
 187  * longjmp().  But we need to make the setjmp buffer accessible to the
 188  * error_exit routine.  To do this, we make a private extension of the
 189  * standard JPEG error handler object.  (If we were using C++, we'd say we
 190  * were making a subclass of the regular error handler.)
 191  *
 192  * Here's the extended error handler struct:
 193  */
 194
 195 struct my_jpeg_error_mgr {
 196         struct jpeg_error_mgr pub;      /* "public" fields */
 197         jmp_buf setjmp_buffer;  /* for return to caller */
 198 };
 199
 200 #if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61)
 201 METHODDEF(void)
 202 #else
 203 METHODDEF void
 204 #endif
 205 our_init_source(j_decompress_ptr cinfo)
 206 {
 207 }
 208
 209 #if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61)
 210 METHODDEF(boolean)
 211 #else
 212 METHODDEF boolean
 213 #endif
 214 our_fill_input_buffer(j_decompress_ptr cinfo)
 215 {
 216         /* Insert a fake EOI marker */
 217         struct jpeg_source_mgr *src = cinfo->src;
 218         static JOCTET buffer[2];
 219
 220         buffer[0] = (JOCTET) 0xFF;
 221         buffer[1] = (JOCTET) JPEG_EOI;
 222
 223         src->next_input_byte = buffer;
 224         src->bytes_in_buffer = 2;
 225         return TRUE;
 226 }
 227
 228 #if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61)
 229 METHODDEF(void)
 230 #else
 231 METHODDEF void
 232 #endif
 233 our_skip_input_data(j_decompress_ptr cinfo, long num_bytes)
 234 {
 235         struct jpeg_source_mgr *src = NULL;
 236
 237         src = (struct jpeg_source_mgr *)cinfo->src;
 238
 239         if (!src) {
 240                 return;
 241         } else if (num_bytes > (long)src->bytes_in_buffer) {
 242                 ERREXIT(cinfo, JERR_INPUT_EOF);
 243          /*NOTREACHED*/}
 244
 245         src->bytes_in_buffer -= num_bytes;
 246         src->next_input_byte += num_bytes;
 247 }
 248
 249 #if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61)
 250 METHODDEF(void)
 251 #else
 252 METHODDEF void
 253 #endif
 254 our_term_source(j_decompress_ptr cinfo)
 255 {
 256 }
 257
 258 typedef struct {
 259         struct jpeg_source_mgr pub;
 260 } our_jpeg_source_mgr;
 261
 262 static void
 263 jpeg_memory_src(j_decompress_ptr cinfo, const JOCTET *data, size_t len)
 264 {
 265         struct jpeg_source_mgr *src;
 266
 267         if (cinfo->src == NULL) {       /* first time for this JPEG object? */
 268                 cinfo->src = (struct jpeg_source_mgr *)
 269                     (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo,
 270                                                 JPOOL_PERMANENT,
 271                                                 sizeof(our_jpeg_source_mgr));
 272                 src = (struct jpeg_source_mgr *)cinfo->src;
 273                 src->next_input_byte = data;
 274         }
 275         src = (struct jpeg_source_mgr *)cinfo->src;
 276         src->init_source = our_init_source;
 277         src->fill_input_buffer = our_fill_input_buffer;
 278         src->skip_input_data = our_skip_input_data;
 279         /* use default method */
 280         src->resync_to_restart = jpeg_resync_to_restart;
 281         src->term_source = our_term_source;
 282         src->bytes_in_buffer = len;
 283         src->next_input_byte = data;
 284         return;
 285 }
 286
 287 #if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61)
 288 METHODDEF(void)
 289 #else
 290 METHODDEF void
 291 #endif
 292 my_jpeg_error_exit(j_common_ptr cinfo)
 293 {
 294         /* cinfo->err really points to a my_error_mgr struct, so coerce pointer */
 295         struct my_jpeg_error_mgr *myerr =
 296             (struct my_jpeg_error_mgr *)cinfo->err;
 297
 298         /* Return control to the setjmp point */
 299         longjmp(myerr->setjmp_buffer, 1);
 300 }
 301
 302 #if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61)
 303 METHODDEF(void)
 304 #else
 305 METHODDEF void
 306 #endif
 307 my_jpeg_output_message(j_common_ptr cinfo)
 308 {
 309         char buffer[JMSG_LENGTH_MAX];
 310
 311         /* Create the message */
 312         (*cinfo->err->format_message) (cinfo, buffer);
 313         warn_when_safe(Qjpeg, Qinfo, "%s", buffer);
 314 }
 315
 316 /* The code in this routine is based on example.c from the JPEG library
 317    source code and from gif_instantiate() */
 318 static void
 319 jpeg_instantiate(Lisp_Object image_instance, Lisp_Object instantiator,
 320                  Lisp_Object pointer_fg, Lisp_Object pointer_bg,
 321                  int dest_mask, Lisp_Object domain)
 322 {
 323         Lisp_Image_Instance *ii = XIMAGE_INSTANCE(image_instance);
 324         /* It is OK for the unwind data to be local to this function,
 325            because the unwind-protect is always executed when this
 326            stack frame is still valid. */
 327         struct jpeg_unwind_data unwind;
 328         int speccount = specpdl_depth();
 329
 330         /* This struct contains the JPEG decompression parameters and pointers to
 331          * working space (which is allocated as needed by the JPEG library).
 332          */
 333         struct jpeg_decompress_struct cinfo;
 334         /* We use our private extension JPEG error handler.
 335          * Note that this struct must live as long as the main JPEG parameter
 336          * struct, to avoid dangling-pointer problems.
 337          */
 338         struct my_jpeg_error_mgr jerr;
 339
 340         /* Step -1: First record our unwind-protect, which will clean up after
 341            any exit, normal or not */
 342
 343         xzero(unwind);
 344         record_unwind_protect(jpeg_instantiate_unwind,
 345                               make_opaque_ptr(&unwind));
 346
 347         /* Step 1: allocate and initialize JPEG decompression object */
 348
 349         /* We set up the normal JPEG error routines, then override error_exit. */
 350         cinfo.err = jpeg_std_error(&jerr.pub);
 351         jerr.pub.error_exit = my_jpeg_error_exit;
 352         jerr.pub.output_message = my_jpeg_output_message;
 353
 354         /* Establish the setjmp return context for my_error_exit to use. */
 355         if (setjmp(jerr.setjmp_buffer)) {
 356                 /* If we get here, the JPEG code has signaled an error.
 357                  * We need to clean up the JPEG object, close the input file, and return.
 358                  */
 359
 360                 {
 361                         Lisp_Object errstring;
 362                         char buffer[JMSG_LENGTH_MAX];
 363
 364                         /* Create the message */
 365                         (*cinfo.err->format_message) ((j_common_ptr) & cinfo,
 366                                                       buffer);
 367                         errstring = build_string(buffer);
 368
 369                         signal_image_error_2("JPEG decoding error",
 370                                              errstring, instantiator);
 371                 }
 372         }
 373
 374         /* Now we can initialize the JPEG decompression object. */
 375         jpeg_create_decompress(&cinfo);
 376         unwind.cinfo_ptr = &cinfo;
 377
 378         /* Step 2: specify data source (eg, a file) */
 379
 380         {
 381                 Lisp_Object data = find_keyword_in_vector(instantiator, Q_data);
 382                 const Extbyte *bytes = NULL;
 383                 Extcount len;
 384
 385 #ifdef HAVE_FFI
 386                 if (EFFIOP(data)) {
 387                         bytes = XEFFIO(data)->fostorage;
 388                         len = XEFFIO(data)->storage_size;
 389                 } else
 390 #endif  /* HAVE_FFI */
 391                 /* #### This is a definite problem under Mule due to the amount of
 392                    stack data it might allocate.  Need to be able to convert and
 393                    write out to a file. */
 394                 TO_EXTERNAL_FORMAT(LISP_STRING, data, ALLOCA, (bytes, len),
 395                                    Qbinary);
 396                 if ( bytes != NULL ) {
 397                         jpeg_memory_src(&cinfo, (const JOCTET*)bytes, len);
 398                 } else {
 399                         signal_image_error
 400                             ("Unable to transcode image source",
 401                              instantiator);
 402                 }
 403         }
 404
 405         /* Step 3: read file parameters with jpeg_read_header() */
 406
 407         jpeg_read_header(&cinfo, TRUE);
 408         /* We can ignore the return value from jpeg_read_header since
 409          *   (a) suspension is not possible with the stdio data source, and
 410          *   (b) we passed TRUE to reject a tables-only JPEG file as an error.
 411          * See libjpeg.doc for more info.
 412          */
 413
 414         {
 415                 int jpeg_gray = 0;      /* if we're dealing with a grayscale */
 416                 /* Step 4: set parameters for decompression.   */
 417
 418                 /* Now that we're using EImages, send all data as 24bit color.
 419                    The backend routine will take care of any necessary reductions.
 420                    We do have to handle the grayscale case ourselves, however. */
 421                 if (cinfo.jpeg_color_space == JCS_GRAYSCALE) {
 422                         cinfo.out_color_space = JCS_GRAYSCALE;
 423                         jpeg_gray = 1;
 424                 } else {
 425                         /* we're relying on the jpeg driver to do any other conversions,
 426                            or signal an error if the conversion isn't supported. */
 427                         cinfo.out_color_space = JCS_RGB;
 428                 }
 429
 430                 /* Step 5: Start decompressor */
 431                 jpeg_start_decompress(&cinfo);
 432
 433                 /* Step 6: Read in the data and put into EImage format (8bit RGB
 434                  * triples) */
 435                 unwind.eimage = xmalloc_atomic(cinfo.output_width *
 436                                                cinfo.output_height * 3);
 437                 if (!unwind.eimage) {
 438                         signal_image_error
 439                             ("Unable to allocate enough memory for image",
 440                              instantiator);
 441                 }
 442
 443                 {
 444                         JSAMPARRAY row_buffer;  /* Output row buffer */
 445                         JSAMPLE *jp;
 446                         int row_stride; /* physical row width in output buffer */
 447                         unsigned char *op = unwind.eimage;
 448
 449                         /* We may need to do some setup of our own at this point
 450                          * before reading the data.  After
 451                          * jpeg_start_decompress() we have the correct scaled
 452                          * output image dimensions available
 453                          * We need to make an output work buffer of the right
 454                          * size. */
 455                         /* JSAMPLEs per row in output buffer. */
 456                         row_stride = cinfo.output_width *
 457                                 cinfo.output_components;
 458                         /* Make a one-row-high sample array that will go away
 459                          * when done with image */
 460                         row_buffer = ((*cinfo.mem->alloc_sarray)
 461                                       ((j_common_ptr) & cinfo, JPOOL_IMAGE,
 462                                        row_stride, 1));
 463
 464                         /* Here we use the library's state variable
 465                          * cinfo.output_scanline as the loop counter, so that
 466                          * we don't have to keep track ourselves. */
 467                         while (cinfo.output_scanline < cinfo.output_height) {
 468                                 unsigned int i;
 469
 470                                 /* jpeg_read_scanlines expects an array of
 471                                  * pointers to scanlines.
 472                                  * Here the array is only one element long,
 473                                  * but you could ask for more than one
 474                                  * scanline at a time if that's more
 475                                  * convenient. */
 476                                 (void)jpeg_read_scanlines(&cinfo, row_buffer,
 477                                                           1);
 478                                 jp = row_buffer[0];
 479                                 for (i = 0; i < cinfo.output_width; i++) {
 480                                         int clr;
 481                                         if (jpeg_gray) {
 482                                                 unsigned char val;
 483 #if (BITS_IN_JSAMPLE == 8)
 484                                                 val = (unsigned char)*jp++;
 485 #else                           /* other option is 12 */
 486                                                 val =
 487                                                     (unsigned char)(*jp++ >> 4);
 488 #endif
 489                                                 /* copy the same value
 490                                                  * into RGB */
 491                                                 for (clr = 0; clr < 3; clr++) {
 492                                                         *op++ = val;
 493                                                 }
 494                                         } else {
 495                                                 for (clr = 0; clr < 3; clr++) {
 496 #if (BITS_IN_JSAMPLE == 8)
 497                                                         *op++ = (unsigned char)
 498                                                                 *jp++;
 499 #else  /* other option is 12 */
 500                                                         *op++ = (unsigned char)
 501                                                                 (*jp++ >> 4);
 502 #endif
 503                                                 }
 504                                         }
 505                                 }
 506                         }
 507                 }
 508         }
 509
 510         /* Step 6.5: Create the pixmap and set up the image instance */
 511         /* now instantiate */
 512         MAYBE_DEVMETH(DOMAIN_XDEVICE(ii->domain),
 513                       init_image_instance_from_eimage,
 514                       (ii, cinfo.output_width, cinfo.output_height, 1,
 515                        unwind.eimage, dest_mask, instantiator, domain));
 516
 517         /* Step 7: Finish decompression */
 518
 519         jpeg_finish_decompress(&cinfo);
 520         /* We can ignore the return value since suspension is not possible
 521          * with the stdio data source.
 522          */
 523
 524         /* And we're done! */
 525         /* This will clean up everything else. */
 526         unbind_to(speccount, Qnil);
 527 }
 528
 529 #endif                          /* HAVE_JPEG */
 530 \f
 531 #ifdef HAVE_GIF
 532 /**********************************************************************
 533  *                               GIF                                  *
 534  **********************************************************************/
 535
 536 #include "gifrlib.h"
 537
 538 static void gif_validate(Lisp_Object instantiator)
 539 {
 540         file_or_data_must_be_present(instantiator);
 541 }
 542
 543 static Lisp_Object
 544 gif_normalize(Lisp_Object inst, Lisp_Object console_type, Lisp_Object dest_mask)
 545 {
 546         return simple_image_type_normalize(inst, console_type, Qgif);
 547 }
 548
 549 static int gif_possible_dest_types(void)
 550 {
 551         return IMAGE_COLOR_PIXMAP_MASK;
 552 }
 553
 554 /* To survive the otherwise baffling complexity of making sure
 555    everything gets cleaned up in the presence of an error, we
 556    use an unwind_protect(). */
 557
 558 struct gif_unwind_data {
 559         unsigned char *eimage;
 560         /* Object that holds the decoded data from a GIF file */
 561         GifFileType *giffile;
 562 };
 563
 564 static Lisp_Object gif_instantiate_unwind(Lisp_Object unwind_obj)
 565 {
 566         struct gif_unwind_data *data =
 567             (struct gif_unwind_data *)get_opaque_ptr(unwind_obj);
 568
 569         free_opaque_ptr(unwind_obj);
 570         if (data->giffile) {
 571                 DGifCloseFile(data->giffile);
 572                 GifFree(data->giffile);
 573         }
 574         if (data->eimage)
 575                 xfree(data->eimage);
 576
 577         return Qnil;
 578 }
 579
 580 typedef struct gif_memory_storage {
 581         Extbyte *bytes;         /* The data       */
 582         Extcount len;           /* How big is it? */
 583         int index;              /* Where are we?  */
 584 } gif_memory_storage;
 585
 586 static size_t gif_read_from_memory(GifByteType * buf, size_t size, VoidPtr data)
 587 {
 588         gif_memory_storage *mem = (gif_memory_storage *) data;
 589
 590         if ((ssize_t) size > (mem->len - mem->index))
 591                 return (size_t) - 1;
 592         memcpy(buf, mem->bytes + mem->index, size);
 593         mem->index = mem->index + size;
 594         return size;
 595 }
 596
 597 static int gif_memory_close(VoidPtr data)
 598 {
 599         return 0;
 600 }
 601
 602 struct gif_error_struct {
 603         const char *err_str;    /* return the error string */
 604         jmp_buf setjmp_buffer;  /* for return to caller */
 605 };
 606
 607 static void gif_error_func(const char *err_str, VoidPtr error_ptr)
 608 {
 609         struct gif_error_struct *error_data =
 610             (struct gif_error_struct *)error_ptr;
 611
 612         /* return to setjmp point */
 613         error_data->err_str = err_str;
 614         longjmp(error_data->setjmp_buffer, 1);
 615 }
 616
 617 static void
 618 gif_instantiate(Lisp_Object image_instance, Lisp_Object instantiator,
 619                 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
 620                 int dest_mask, Lisp_Object domain)
 621 {
 622         Lisp_Image_Instance *ii = XIMAGE_INSTANCE(image_instance);
 623         /* It is OK for the unwind data to be local to this function,
 624            because the unwind-protect is always executed when this
 625            stack frame is still valid. */
 626         struct gif_unwind_data unwind;
 627         int speccount = specpdl_depth();
 628         gif_memory_storage mem_struct;
 629         struct gif_error_struct gif_err;
 630         Extbyte *bytes = NULL;
 631         Extcount len;
 632         int height = 0;
 633         int width = 0;
 634
 635         xzero(unwind);
 636         record_unwind_protect(gif_instantiate_unwind, make_opaque_ptr(&unwind));
 637
 638         /* 1. Now decode the data. */
 639
 640         {
 641                 Lisp_Object data = find_keyword_in_vector(instantiator, Q_data);
 642
 643                 assert(!NILP(data));
 644
 645                 if (!(unwind.giffile = GifSetup()))
 646                         signal_image_error
 647                             ("Insufficient memory to instantiate GIF image",
 648                              instantiator);
 649
 650                 /* set up error facilities */
 651                 if (setjmp(gif_err.setjmp_buffer)) {
 652                         /* An error was signaled. No clean up is needed, as unwind handles that
 653                            for us.  Just pass the error along. */
 654                         Lisp_Object errstring;
 655                         errstring = build_string(gif_err.err_str);
 656                         signal_image_error_2("GIF decoding error", errstring,
 657                                              instantiator);
 658                 }
 659                 GifSetErrorFunc(unwind.giffile, (Gif_error_func) gif_error_func,
 660                                 (VoidPtr) & gif_err);
 661
 662 #ifdef HAVE_FFI
 663                 if (EFFIOP(data)) {
 664                         bytes = XEFFIO(data)->fostorage;
 665                         len = XEFFIO(data)->storage_size;
 666                 } else
 667 #endif  /* HAVE_FFI */
 668                 TO_EXTERNAL_FORMAT(LISP_STRING, data, ALLOCA, (bytes, len),
 669                                    Qbinary);
 670                 if ( bytes == NULL ) {
 671                         signal_image_error
 672                                 ("Error reading GIF data",
 673                                  instantiator);
 674                 } else {
 675                         mem_struct.bytes = bytes;
 676                         mem_struct.len = len;
 677                         mem_struct.index = 0;
 678                         GifSetReadFunc(unwind.giffile, gif_read_from_memory,
 679                                        (VoidPtr) & mem_struct);
 680                         GifSetCloseFunc(unwind.giffile, gif_memory_close,
 681                                         (VoidPtr) & mem_struct);
 682                         DGifInitRead(unwind.giffile);
 683
 684                         /* Then slurp the image into memory, decoding
 685                            along the way.  The result is the image in
 686                            a simple one-byte-per-pixel format (####
 687                            the GIF routines only support 8-bit GIFs,
 688                            it appears). */
 689                         DGifSlurp(unwind.giffile);
 690                 }
 691         }
 692
 693         /* 3. Now create the EImage(s) */
 694         {
 695                 ColorMapObject *cmo = unwind.giffile->SColorMap;
 696                 int i, j, row, pass, interlace, slice;
 697                 unsigned char *eip;
 698                 /* interlaced gifs have rows in this order:
 699                    0, 8, 16, ..., 4, 12, 20, ..., 2, 6, 10, ..., 1, 3, 5, ...  */
 700                 static int InterlacedOffset[] = { 0, 4, 2, 1 };
 701                 static int InterlacedJumps[] = { 8, 8, 4, 2 };
 702
 703                 height = unwind.giffile->SHeight;
 704                 width = unwind.giffile->SWidth;
 705                 unwind.eimage = xmalloc_atomic(width * height * 3 *
 706                                                unwind.giffile->ImageCount);
 707                 if (!unwind.eimage) {
 708                         signal_image_error
 709                             ("Unable to allocate enough memory for image",
 710                              instantiator);
 711                 }
 712
 713                 /* write the data in EImage format (8bit RGB triples) */
 714                 for (slice = 0; slice < unwind.giffile->ImageCount; slice++) {
 715                         /* We check here that the current image covers the full
 716                          * "screen" size. */
 717                         if (unwind.giffile->SavedImages[slice].ImageDesc.
 718                             Height != height
 719                             || unwind.giffile->SavedImages[slice].ImageDesc.
 720                             Width != width
 721                             || unwind.giffile->SavedImages[slice].ImageDesc.
 722                             Left != 0
 723                             || unwind.giffile->SavedImages[slice].ImageDesc.
 724                             Top != 0)
 725                                 signal_image_error
 726                                     ("Image in GIF file is not full size",
 727                                      instantiator);
 728
 729                         interlace =
 730                             unwind.giffile->SavedImages[slice].ImageDesc.
 731                             Interlace;
 732                         pass = 0;
 733                         row = interlace ? InterlacedOffset[pass] : 0;
 734                         eip = unwind.eimage + (width * height * 3 * slice);
 735                         for (i = 0; i < height; i++) {
 736                                 if (interlace)
 737                                         if (row >= height) {
 738                                                 row = InterlacedOffset[++pass];
 739                                                 while (row >= height)
 740                                                         row =
 741                                                             InterlacedOffset
 742                                                             [++pass];
 743                                         }
 744                                 eip =
 745                                     unwind.eimage +
 746                                     (width * height * 3 * slice) +
 747                                     (row * width * 3);
 748                                 for (j = 0; j < width; j++) {
 749                                         unsigned char pixel =
 750                                             unwind.giffile->SavedImages[slice].
 751                                             RasterBits[(i * width) + j];
 752                                         *eip++ = cmo->Colors[pixel].Red;
 753                                         *eip++ = cmo->Colors[pixel].Green;
 754                                         *eip++ = cmo->Colors[pixel].Blue;
 755                                 }
 756                                 row += interlace ? InterlacedJumps[pass] : 1;
 757                         }
 758                 }
 759
 760                 /* now instantiate */
 761                 MAYBE_DEVMETH(DOMAIN_XDEVICE(ii->domain),
 762                               init_image_instance_from_eimage,
 763                               (ii, width, height, unwind.giffile->ImageCount,
 764                                unwind.eimage, dest_mask, instantiator, domain));
 765         }
 766
 767         /* We read the gif successfully. If we have more than one slice then
 768            animate the gif. */
 769         if (unwind.giffile->ImageCount > 1) {
 770                 /* See if there is a timeout value. In theory there could be one
 771                    for every image - but that makes the implementation way to
 772                    complicated for now so we just take the first. */
 773                 unsigned short timeout = 0;
 774                 Lisp_Object tid;
 775
 776                 if (unwind.giffile->SavedImages[0].Function ==
 777                     GRAPHICS_EXT_FUNC_CODE
 778                     && unwind.giffile->SavedImages[0].ExtensionBlockCount) {
 779                         timeout = (unsigned short)
 780                             ((unwind.giffile->SavedImages[0].ExtensionBlocks[0].
 781                               Bytes[2] << 8) +
 782                              unwind.giffile->SavedImages[0].ExtensionBlocks[0].
 783                              Bytes[1]) * 10;
 784                 }
 785
 786                 /* Too short a timeout will crucify us performance-wise. */
 787                 tid =
 788                     add_glyph_animated_timeout(timeout > 10 ? timeout : 10,
 789                                                image_instance);
 790
 791                 if (!NILP(tid))
 792                         IMAGE_INSTANCE_PIXMAP_TIMEOUT(ii) = XINT(tid);
 793         }
 794
 795         unbind_to(speccount, Qnil);
 796 }
 797
 798 #endif                          /* HAVE_GIF */
 799 \f
 800 #if defined WITH_PNG && defined HAVE_PNG
 801
 802 /**********************************************************************
 803  *                             PNG                                    *
 804  **********************************************************************/
 805 static void png_validate(Lisp_Object instantiator)
 806 {
 807         file_or_data_must_be_present(instantiator);
 808 }
 809
 810 static Lisp_Object
 811 png_normalize(Lisp_Object inst, Lisp_Object console_type, Lisp_Object dest_mask)
 812 {
 813         return simple_image_type_normalize(inst, console_type, Qpng);
 814 }
 815
 816 static int png_possible_dest_types(void)
 817 {
 818         return IMAGE_COLOR_PIXMAP_MASK;
 819 }
 820
 821 struct png_memory_storage {
 822         const Extbyte *bytes;   /* The data       */
 823         Extcount len;           /* How big is it? */
 824         int index;              /* Where are we?  */
 825 };
 826
 827 static void
 828 png_read_from_memory(png_structp png_ptr, png_bytep data, png_size_t length)
 829 {
 830         struct png_memory_storage *tbr =
 831             (struct png_memory_storage *)png_get_io_ptr(png_ptr);
 832
 833         if ((ssize_t) length > (tbr->len - tbr->index))
 834                 png_error(png_ptr, (png_const_charp) "Read Error");
 835         memcpy(data, tbr->bytes + tbr->index, length);
 836         tbr->index = tbr->index + length;
 837 }
 838
 839 struct png_error_struct {
 840         const char *err_str;
 841         jmp_buf setjmp_buffer;  /* for return to caller */
 842 };
 843
 844 /* jh 98/03/12 - #### AARRRGH! libpng includes jmp_buf inside its own
 845    structure, and there are cases where the size can be different from
 846    between inside the library, and inside the code!  To do an end run
 847    around this, use our own error functions, and don't rely on things
 848    passed in the png_ptr to them.  This is an ugly hack and must
 849    go away when the lisp engine is threaded! */
 850 static struct png_error_struct png_err_stct;
 851
 852 static void png_error_func(png_structp png_ptr, png_const_charp msg)
 853 {
 854         png_err_stct.err_str = msg;
 855         longjmp(png_err_stct.setjmp_buffer, 1);
 856 }
 857
 858 static void png_warning_func(png_structp png_ptr, png_const_charp msg)
 859 {
 860         warn_when_safe(Qpng, Qinfo, "%s", msg);
 861 }
 862
 863 struct png_unwind_data {
 864         FILE *instream;
 865         unsigned char *eimage;
 866         png_structp png_ptr;
 867         png_infop info_ptr;
 868 };
 869
 870 static Lisp_Object png_instantiate_unwind(Lisp_Object unwind_obj)
 871 {
 872         struct png_unwind_data *data =
 873             (struct png_unwind_data *)get_opaque_ptr(unwind_obj);
 874
 875         free_opaque_ptr(unwind_obj);
 876         if (data->png_ptr)
 877                 png_destroy_read_struct(&(data->png_ptr), &(data->info_ptr),
 878                                         (png_infopp) NULL);
 879         if (data->instream)
 880                 fclose(data->instream);
 881
 882         if (data->eimage)
 883                 xfree(data->eimage);
 884
 885         return Qnil;
 886 }
 887
 888 static void
 889 png_instantiate(Lisp_Object image_instance, Lisp_Object instantiator,
 890                 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
 891                 int dest_mask, Lisp_Object domain)
 892 {
 893         Lisp_Image_Instance *ii = XIMAGE_INSTANCE(image_instance);
 894         struct png_unwind_data unwind;
 895         int speccount = specpdl_depth();
 896         struct png_memory_storage tbr;  /* Data to be read */
 897
 898         /* PNG variables */
 899         png_structp png_ptr;
 900         png_infop info_ptr;
 901         png_uint_32 height, width;
 902         int bit_depth, color_type, interlace_type;
 903
 904         /* Initialize all PNG structures */
 905         png_ptr =
 906             png_create_read_struct(PNG_LIBPNG_VER_STRING, (png_voidp *)&png_err_stct,
 907                                    png_error_func, png_warning_func);
 908         if (!png_ptr)
 909                 signal_image_error("Error obtaining memory for png_read",
 910                                    instantiator);
 911         info_ptr = png_create_info_struct(png_ptr);
 912         if (!info_ptr) {
 913                 png_destroy_read_struct(&png_ptr, (png_infopp) NULL,
 914                                         (png_infopp) NULL);
 915                 signal_image_error("Error obtaining memory for png_read",
 916                                    instantiator);
 917         }
 918
 919         tbr.bytes = NULL;
 920         xzero(unwind);
 921         unwind.png_ptr = png_ptr;
 922         unwind.info_ptr = info_ptr;
 923
 924         record_unwind_protect(png_instantiate_unwind, make_opaque_ptr(&unwind));
 925
 926         /* This code is a mixture of stuff from Ben's GIF/JPEG stuff from
 927            this file, example.c from the libpng 0.81 distribution, and the
 928            pngtopnm sources. -WMP-
 929          */
 930         /* It has been further modified to handle the API changes for 0.96,
 931            and is no longer usable for previous versions. jh
 932          */
 933         /* It has been further modified to handle libpng 1.5.x --SY */
 934
 935         /* Set the jmp_buf return context for png_error ... if this returns !0, then
 936            we ran into a problem somewhere, and need to clean up after ourselves. */
 937         if (setjmp(png_err_stct.setjmp_buffer)) {
 938                 /* Something blew up: just display the error (cleanup
 939                  * happens in the unwind) */
 940                 signal_image_error_2("Error decoding PNG",
 941                                      build_string(png_err_stct.err_str),
 942                                      instantiator);
 943         }
 944
 945         /* Initialize the IO layer and read in header information */
 946         {
 947                 Lisp_Object data = find_keyword_in_vector(instantiator, Q_data);
 948                 const Extbyte *bytes = NULL;
 949                 Extcount len;
 950
 951                 assert(!NILP(data));
 952
 953 #ifdef HAVE_FFI
 954                 if (EFFIOP(data)) {
 955                         bytes = XEFFIO(data)->fostorage;
 956                         len = XEFFIO(data)->storage_size;
 957                 } else
 958 #endif  /* HAVE_FFI */
 959                 /* #### This is a definite problem under Mule due to the amount of
 960                    stack data it might allocate.  Need to think about using Lstreams */
 961                 TO_EXTERNAL_FORMAT(LISP_STRING, data, ALLOCA, (bytes, len),
 962                                    Qbinary);
 963                 if ( bytes != NULL ) {
 964                         tbr.bytes = bytes;
 965                         tbr.len = len;
 966                         tbr.index = 0;
 967                         png_set_read_fn(png_ptr, (void *)&tbr, png_read_from_memory);
 968                 } else {
 969                         signal_image_error("Error reading PNG data", instantiator);
 970                 }
 971         }
 972
 973         png_read_info(png_ptr, info_ptr);
 974         png_get_IHDR(png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
 975                      &interlace_type, NULL, NULL);
 976
 977         {
 978                 png_uint_32 y;
 979                 int pass;
 980                 int passes = 0;
 981                 png_bytep row_pointers[height];
 982
 983                 /* Wow, allocate all the memory.  Truly, exciting. */
 984                 unwind.eimage = xmalloc_atomic(width * height * 3);
 985                 /* libpng expects that the image buffer passed in contains a
 986                    picture to draw on top of if the png has any transparencies.
 987                    This could be a good place to pass that in... */
 988                 for (y = 0; y < height; y++) {
 989                         row_pointers[y] = NULL;
 990                 }
 991
 992                 for (y = 0; y < height; y++) {
 993                         row_pointers[y] = unwind.eimage + (width * 3 * y);
 994                 }
 995
 996                 {
 997                         /* if the png specifies a background chunk, go ahead and
 998                          * use it, else use what we can get
 999                          * from the default face. */
1000                         png_color_16 my_background, *image_background;
1001                         Lisp_Object bkgd = Qnil;
1002
1003                         my_background.red = 0x7fff;
1004                         my_background.green = 0x7fff;
1005                         my_background.blue = 0x7fff;
1006                         bkgd = FACE_BACKGROUND(Vdefault_face, domain);
1007                         if (!COLOR_INSTANCEP(bkgd)) {
1008                                 warn_when_safe(Qpng, Qinfo,
1009                                                "Couldn't get background color!");
1010                         } else {
1011                                 Lisp_Color_Instance *c;
1012                                 Lisp_Object rgblist;
1013
1014                                 c = XCOLOR_INSTANCE(bkgd);
1015                                 rgblist = MAYBE_LISP_DEVMETH(XDEVICE(c->device),
1016                                                              color_instance_rgb_components,
1017                                                              (c));
1018                                 my_background.red =
1019                                     (unsigned short)XINT(XCAR(rgblist));
1020                                 my_background.green =
1021                                     (unsigned short)XINT(XCAR(XCDR(rgblist)));
1022                                 my_background.blue =
1023                                     (unsigned short)
1024                                     XINT(XCAR(XCDR(XCDR(rgblist))));
1025                         }
1026
1027                         if (png_get_bKGD(png_ptr, info_ptr, &image_background))
1028                                 png_set_background(png_ptr, image_background,
1029                                                    PNG_BACKGROUND_GAMMA_FILE, 1,
1030                                                    1.0);
1031                         else
1032                                 png_set_background(png_ptr, &my_background,
1033                                                    PNG_BACKGROUND_GAMMA_SCREEN,
1034                                                    0, 1.0);
1035                 }
1036
1037                 /* Now that we're using EImage, ask for 8bit RGB triples for any type
1038                    of image */
1039
1040                 /* tell libpng to strip 16 bit depth files down to 8 bits */
1041                 if (bit_depth == 16)
1042                         png_set_strip_16(png_ptr);
1043                 /* if the image is < 8 bits, pad it out */
1044                 if (bit_depth < 8) {
1045                         if (color_type == PNG_COLOR_TYPE_GRAY)
1046                                 png_set_expand_gray_1_2_4_to_8(png_ptr);
1047                         else
1048                                 png_set_packing(png_ptr);
1049                 }
1050                 /* convert palette images to full RGB */
1051                 if (color_type == PNG_COLOR_TYPE_PALETTE)
1052                         png_set_palette_to_rgb(png_ptr);
1053                 /* send grayscale images to RGB too */
1054                 if (color_type == PNG_COLOR_TYPE_GRAY ||
1055                     color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
1056                         png_set_gray_to_rgb(png_ptr);
1057                 /*
1058                  * Expand paletted or RGB images with transparency to
1059                  * full alpha channels so the data will be available
1060                  * as RGBA quartets.  We don't actually take advantage
1061                  * of this yet, but it's not going to hurt, and you
1062                  * never know... one of these days... --SY.
1063                  */
1064                 if (png_get_valid(png_ptr, info_ptr, PNG_INFO_tRNS))
1065                         png_set_tRNS_to_alpha(png_ptr);
1066                 /* Turn on interlace handling */
1067                 if (interlace_type == PNG_INTERLACE_ADAM7)
1068                         passes = png_set_interlace_handling(png_ptr);
1069
1070                 /* Update the data */
1071                 png_read_update_info(png_ptr, info_ptr);
1072
1073                 /* read in the image row by row if interlaced, */
1074                 if (interlace_type == PNG_INTERLACE_ADAM7) {
1075                         for (pass = 0; pass < passes; pass++) {
1076                                 for (y = 0; y < height; y++) {
1077                                         png_read_rows(png_ptr,
1078                                                       &row_pointers[y],
1079                                                       NULL, 1);
1080                                 }
1081                         }
1082                 } else { /* the whole thing in 1 hit for non-interlaced */
1083                         png_read_image(png_ptr, row_pointers);
1084                 }
1085                 png_read_end(png_ptr, info_ptr);
1086         }
1087
1088         /* now instantiate */
1089         MAYBE_DEVMETH(DOMAIN_XDEVICE(ii->domain),
1090                       init_image_instance_from_eimage,
1091                       (ii, width, height, 1, unwind.eimage, dest_mask,
1092                        instantiator, domain));
1093
1094         /* This will clean up everything else. */
1095         unbind_to(speccount, Qnil);
1096 }
1097
1098 #endif                          /* HAVE_PNG */
1099 \f
1100 #ifdef HAVE_TIFF
1101 #include "tiffio.h"
1102
1103 /**********************************************************************
1104  *                             TIFF                                   *
1105  **********************************************************************/
1106 static void tiff_validate(Lisp_Object instantiator)
1107 {
1108         file_or_data_must_be_present(instantiator);
1109 }
1110
1111 static Lisp_Object
1112 tiff_normalize(Lisp_Object inst, Lisp_Object console_type,
1113                Lisp_Object dest_mask)
1114 {
1115         return simple_image_type_normalize(inst, console_type, Qtiff);
1116 }
1117
1118 static int tiff_possible_dest_types(void)
1119 {
1120         return IMAGE_COLOR_PIXMAP_MASK;
1121 }
1122
1123 struct tiff_unwind_data {
1124         unsigned char *eimage;
1125         /* Object that holds the decoded data from a TIFF file */
1126         TIFF *tiff;
1127 };
1128
1129 static Lisp_Object tiff_instantiate_unwind(Lisp_Object unwind_obj)
1130 {
1131         struct tiff_unwind_data *data =
1132             (struct tiff_unwind_data *)get_opaque_ptr(unwind_obj);
1133
1134         free_opaque_ptr(unwind_obj);
1135         if (data->tiff) {
1136                 TIFFClose(data->tiff);
1137         }
1138         if (data->eimage)
1139                 xfree(data->eimage);
1140
1141         return Qnil;
1142 }
1143
1144 typedef struct tiff_memory_storage {
1145         Extbyte *bytes;         /* The data       */
1146         Extcount len;           /* How big is it? */
1147         int index;              /* Where are we?  */
1148 } tiff_memory_storage;
1149
1150 static size_t tiff_memory_read(thandle_t data, tdata_t buf, tsize_t size)
1151 {
1152         tiff_memory_storage *mem = (tiff_memory_storage *) data;
1153
1154         if (size > (mem->len - mem->index))
1155                 return (size_t) - 1;
1156         memcpy(buf, mem->bytes + mem->index, size);
1157         mem->index = mem->index + size;
1158         return size;
1159 }
1160
1161 static size_t tiff_memory_write(thandle_t data, tdata_t buf, tsize_t size)
1162 {
1163         abort();
1164         return 0;               /* Shut up warnings. */
1165 }
1166
1167 static toff_t tiff_memory_seek(thandle_t data, toff_t off, int whence)
1168 {
1169         tiff_memory_storage *mem = (tiff_memory_storage *) data;
1170         int newidx;
1171         switch (whence) {
1172         case SEEK_SET:
1173                 newidx = off;
1174                 break;
1175         case SEEK_END:
1176                 newidx = mem->len + off;
1177                 break;
1178         case SEEK_CUR:
1179                 newidx = mem->index + off;
1180                 break;
1181         default:
1182                 fprintf(stderr, "Eh? invalid seek mode in tiff_memory_seek\n");
1183                 return (toff_t) - 1;
1184         }
1185
1186         if ((newidx > mem->len) || (newidx < 0))
1187                 return (toff_t) - 1;
1188
1189         mem->index = newidx;
1190         return newidx;
1191 }
1192
1193 static int tiff_memory_close(thandle_t data)
1194 {
1195         return 0;
1196 }
1197
1198 static int tiff_map_noop(thandle_t data, tdata_t * pbase, toff_t * psize)
1199 {
1200         return 0;
1201 }
1202
1203 static void tiff_unmap_noop(thandle_t data, tdata_t pbase, toff_t psize)
1204 {
1205         return;
1206 }
1207
1208 static toff_t tiff_memory_size(thandle_t data)
1209 {
1210         tiff_memory_storage *mem = (tiff_memory_storage *) data;
1211         return mem->len;
1212 }
1213
1214 struct tiff_error_struct {
1215         char err_str[256];
1216         jmp_buf setjmp_buffer;  /* for return to caller */
1217 };
1218
1219 /* jh 98/03/12 - ###This struct for passing data to the error functions
1220    is an ugly hack caused by the fact that libtiff (as of v3.4) doesn't
1221    have any place to store error func data.  This should be rectified
1222    before SXEmacs gets threads! */
1223 static struct tiff_error_struct tiff_err_data;
1224
1225 static void tiff_error_func(const char *module, const char *fmt, ...)
1226 {
1227         int n;
1228         va_list vargs;
1229
1230         va_start(vargs, fmt);
1231
1232         n = vsnprintf(tiff_err_data.err_str, sizeof(tiff_err_data.err_str), fmt, vargs);
1233         assert(n>=0 && (size_t)n <  sizeof(tiff_err_data.err_str));
1234
1235         va_end(vargs);
1236         /* return to setjmp point */
1237         longjmp(tiff_err_data.setjmp_buffer, 1);
1238 }
1239
1240 static void tiff_warning_func(const char *module, const char *fmt, ...)
1241 {
1242         va_list vargs;
1243         char warn_str[256];
1244         int n;
1245
1246         va_start(vargs, fmt);
1247
1248         n = vsnprintf(warn_str, sizeof(warn_str), fmt, vargs);
1249         assert(n>=0 && (size_t)n < sizeof(warn_str));
1250         va_end(vargs);
1251         warn_when_safe(Qtiff, Qinfo, "%s - %s", module, warn_str);
1252 }
1253
1254 static void
1255 tiff_instantiate(Lisp_Object image_instance, Lisp_Object instantiator,
1256                  Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1257                  int dest_mask, Lisp_Object domain)
1258 {
1259         Lisp_Image_Instance *ii = XIMAGE_INSTANCE(image_instance);
1260         tiff_memory_storage mem_struct;
1261         /* It is OK for the unwind data to be local to this function,
1262            because the unwind-protect is always executed when this
1263            stack frame is still valid. */
1264         struct tiff_unwind_data unwind;
1265         int speccount = specpdl_depth();
1266         uint32 width, height;
1267
1268         xzero(unwind);
1269         record_unwind_protect(tiff_instantiate_unwind,
1270                               make_opaque_ptr(&unwind));
1271
1272         /* set up error facilities */
1273         if (setjmp(tiff_err_data.setjmp_buffer)) {
1274                 /* An error was signaled. No clean up is needed, as unwind handles that
1275                    for us.  Just pass the error along. */
1276                 signal_image_error_2("TIFF decoding error",
1277                                      build_string(tiff_err_data.err_str),
1278                                      instantiator);
1279         }
1280         TIFFSetErrorHandler((TIFFErrorHandler) tiff_error_func);
1281         TIFFSetWarningHandler((TIFFErrorHandler) tiff_warning_func);
1282         {
1283                 Lisp_Object data = find_keyword_in_vector(instantiator, Q_data);
1284                 Extbyte *bytes = NULL;
1285                 Extcount len;
1286
1287                 uint32 *raster;
1288                 unsigned char *ep;
1289
1290                 assert(!NILP(data));
1291
1292 #ifdef HAVE_FFI
1293                 if (EFFIOP(data)) {
1294                         bytes = XEFFIO(data)->fostorage;
1295                         len = XEFFIO(data)->storage_size;
1296                 } else
1297 #endif  /* HAVE_FFI */
1298                 /* #### This is a definite problem under Mule due to the amount of
1299                    stack data it might allocate.  Think about Lstreams... */
1300                 TO_EXTERNAL_FORMAT(LISP_STRING, data,
1301                                    ALLOCA, (bytes, len), Qbinary);
1302                 if ( bytes == NULL ) {
1303                         signal_image_error
1304                                 ("Unable to encode filename", instantiator);
1305                 }else {
1306                         mem_struct.bytes = bytes;
1307                         mem_struct.len = len;
1308                         mem_struct.index = 0;
1309
1310                         unwind.tiff =
1311                                 TIFFClientOpen("memfile", "r", (thandle_t) & mem_struct,
1312                                                (TIFFReadWriteProc) tiff_memory_read,
1313                                                (TIFFReadWriteProc) tiff_memory_write,
1314                                                tiff_memory_seek, tiff_memory_close,
1315                                                tiff_memory_size, tiff_map_noop,
1316                                                tiff_unmap_noop);
1317                         if (!unwind.tiff)
1318                                 signal_image_error
1319                                         ("Insufficient memory to instantiate TIFF image",
1320                                          instantiator);
1321
1322                         TIFFGetField(unwind.tiff, TIFFTAG_IMAGEWIDTH, &width);
1323                         TIFFGetField(unwind.tiff, TIFFTAG_IMAGELENGTH, &height);
1324                         unwind.eimage = xmalloc_atomic(width * height * 3);
1325
1326                         /* #### This is little more than proof-of-concept/function testing.
1327                            It needs to be reimplemented via scanline reads for both memory
1328                            compactness. */
1329                         raster =
1330                                 (uint32 *) _TIFFmalloc(width * height * sizeof(uint32));
1331                         if (raster != NULL) {
1332                                 int i, j;
1333                                 uint32 *rp;
1334                                 ep = unwind.eimage;
1335                                 rp = raster;
1336                                 if (TIFFReadRGBAImage
1337                                     (unwind.tiff, width, height, raster, 0)) {
1338                                         for (i = height - 1; i >= 0; i--) {
1339                                                 /* This is to get
1340                                                    around weirdness in
1341                                                    the libtiff library
1342                                                    where properly made
1343                                                    TIFFs will come out
1344                                                    upside down.
1345                                                    libtiff bug or
1346                                                    jhod-brainlock? */
1347                                                 rp = raster + (i * width);
1348                                                 for (j = 0; (uint32) j < width; j++) {
1349                                                         *ep++ =
1350                                                                 (unsigned char)
1351                                                                 TIFFGetR(*rp);
1352                                                         *ep++ =
1353                                                                 (unsigned char)
1354                                                                 TIFFGetG(*rp);
1355                                                         *ep++ =
1356                                                                 (unsigned char)
1357                                                                 TIFFGetB(*rp);
1358                                                         rp++;
1359                                                 }
1360                                         }
1361                                 }
1362                                 _TIFFfree(raster);
1363                         } else
1364                                 signal_image_error
1365                                         ("Unable to allocate memory for TIFFReadRGBA",
1366                                          instantiator);
1367
1368                 }
1369
1370                 /* now instantiate */
1371                 MAYBE_DEVMETH(DOMAIN_XDEVICE(ii->domain),
1372                               init_image_instance_from_eimage,
1373                               (ii, width, height, 1, unwind.eimage, dest_mask,
1374                                instantiator, domain));
1375         }
1376         unbind_to(speccount, Qnil);
1377 }
1378
1379 #endif                          /* HAVE_TIFF */
1380
1381 #if 1
1382 /**********************************************************************
1383  *                             RawRGB(A)                              *
1384  **********************************************************************/
1385 static void rawrgb_validate(Lisp_Object instantiator)
1386 {
1387         data_must_be_present(instantiator);
1388         if (NILP(find_keyword_in_vector(instantiator, Q_pixel_width)))
1389                 signal_simple_error("Must supply :pixel-width",
1390                         instantiator);
1391         if (NILP(find_keyword_in_vector(instantiator, Q_pixel_height)))
1392                 signal_simple_error("Must supply :pixel-height",
1393                         instantiator);
1394 }
1395 static void rawrgba_validate(Lisp_Object instantiator)
1396 {
1397         file_or_data_must_be_present(instantiator);
1398         if (NILP(find_keyword_in_vector(instantiator, Q_pixel_width)))
1399                 signal_simple_error("Must supply :pixel-width",
1400                         instantiator);
1401         if (NILP(find_keyword_in_vector(instantiator, Q_pixel_height)))
1402                 signal_simple_error("Must supply :pixel-height",
1403                         instantiator);
1404 }
1405
1406 static Lisp_Object
1407 rawrgb_normalize(Lisp_Object inst, Lisp_Object console_type,
1408                  Lisp_Object dest_mask)
1409 {
1410         return simple_image_type_normalize(inst, console_type, Qrawrgb);
1411 }
1412 static Lisp_Object
1413 rawrgba_normalize(Lisp_Object inst, Lisp_Object console_type,
1414                   Lisp_Object dest_mask)
1415 {
1416         return simple_image_type_normalize(inst, console_type, Qrawrgba);
1417 }
1418
1419 static int rawrgb_possible_dest_types(void)
1420 {
1421         return IMAGE_COLOR_PIXMAP_MASK;
1422 }
1423 static int rawrgba_possible_dest_types(void)
1424 {
1425         return IMAGE_COLOR_PIXMAP_MASK;
1426 }
1427
1428 struct rawrgb_unwind_data {
1429         unsigned char *eimage;
1430 };
1431 struct rawrgba_unwind_data {
1432         unsigned char *eimage;
1433 };
1434
1435 static Lisp_Object rawrgb_instantiate_unwind(Lisp_Object unwind_obj)
1436 {
1437         struct rawrgb_unwind_data *data =
1438           (struct rawrgb_unwind_data *)get_opaque_ptr(unwind_obj);
1439
1440         free_opaque_ptr(unwind_obj);
1441         if (data->eimage)
1442                 xfree(data->eimage);
1443
1444         return Qnil;
1445 }
1446 static Lisp_Object rawrgba_instantiate_unwind(Lisp_Object unwind_obj)
1447 {
1448         struct rawrgba_unwind_data *data =
1449           (struct rawrgba_unwind_data *)get_opaque_ptr(unwind_obj);
1450
1451         free_opaque_ptr(unwind_obj);
1452         if (data->eimage)
1453                 xfree(data->eimage);
1454
1455         return Qnil;
1456 }
1457
1458 typedef struct rawrgb_memory_storage {
1459         Extbyte *bytes;         /* The data       */
1460         Extcount len;           /* How big is it? */
1461         int index;              /* Where are we?  */
1462 } rawrgb_memory_storage;
1463 typedef struct rawrgba_memory_storage {
1464         Extbyte *bytes;         /* The data       */
1465         Extcount len;           /* How big is it? */
1466         int index;              /* Where are we?  */
1467 } rawrgba_memory_storage;
1468
1469 #if 0
1470 static size_t rawrgb_memory_read(thandle_t data, tdata_t buf, tsize_t size)
1471 {
1472         rawrgb_memory_storage *mem = (rawrgb_memory_storage *)data;
1473
1474         if (size > (mem->len - mem->index))
1475                 return (size_t) - 1;
1476         memcpy(buf, mem->bytes + mem->index, size);
1477         mem->index = mem->index + size;
1478         return size;
1479 }
1480 static size_t rawrgba_memory_read(thandle_t data, tdata_t buf, tsize_t size)
1481 {
1482         rawrgba_memory_storage *mem = (rawrgba_memory_storage *)data;
1483
1484         if (size > (mem->len - mem->index))
1485                 return (size_t) - 1;
1486         memcpy(buf, mem->bytes + mem->index, size);
1487         mem->index = mem->index + size;
1488         return size;
1489 }
1490
1491 static size_t rawrgb_memory_write(thandle_t data, tdata_t buf, tsize_t size)
1492 {
1493         abort();
1494         return 0;               /* Shut up warnings. */
1495 }
1496 static size_t rawrgba_memory_write(thandle_t data, tdata_t buf, tsize_t size)
1497 {
1498         abort();
1499         return 0;               /* Shut up warnings. */
1500 }
1501
1502 static toff_t rawrgb_memory_seek(thandle_t data, toff_t off, int whence)
1503 {
1504         rawrgb_memory_storage *mem = (rawrgb_memory_storage *)data;
1505         int newidx;
1506         switch (whence) {
1507         case SEEK_SET:
1508                 newidx = off;
1509                 break;
1510         case SEEK_END:
1511                 newidx = mem->len + off;
1512                 break;
1513         case SEEK_CUR:
1514                 newidx = mem->index + off;
1515                 break;
1516         default:
1517                 fprintf(stderr,
1518                         "Eh? invalid seek mode in rawrgb_memory_seek\n");
1519                 return (toff_t) - 1;
1520         }
1521
1522         if ((newidx > mem->len) || (newidx < 0))
1523                 return (toff_t) - 1;
1524
1525         mem->index = newidx;
1526         return newidx;
1527 }
1528 static toff_t rawrgba_memory_seek(thandle_t data, toff_t off, int whence)
1529 {
1530         rawrgba_memory_storage *mem = (rawrgba_memory_storage *)data;
1531         int newidx;
1532         switch (whence) {
1533         case SEEK_SET:
1534                 newidx = off;
1535                 break;
1536         case SEEK_END:
1537                 newidx = mem->len + off;
1538                 break;
1539         case SEEK_CUR:
1540                 newidx = mem->index + off;
1541                 break;
1542         default:
1543                 fprintf(stderr,
1544                         "Eh? invalid seek mode in rawrgba_memory_seek\n");
1545                 return (toff_t) - 1;
1546         }
1547
1548         if ((newidx > mem->len) || (newidx < 0))
1549                 return (toff_t) - 1;
1550
1551         mem->index = newidx;
1552         return newidx;
1553 }
1554
1555 static int rawrgb_memory_close(thandle_t data)
1556 {
1557         return 0;
1558 }
1559 static int rawrgba_memory_close(thandle_t data)
1560 {
1561         return 0;
1562 }
1563
1564 static int rawrgb_map_noop(thandle_t data, tdata_t * pbase, toff_t * psize)
1565 {
1566         return 0;
1567 }
1568 static int rawrgba_map_noop(thandle_t data, tdata_t * pbase, toff_t * psize)
1569 {
1570         return 0;
1571 }
1572
1573 static void rawrgb_unmap_noop(thandle_t data, tdata_t pbase, toff_t psize)
1574 {
1575         return;
1576 }
1577 static void rawrgba_unmap_noop(thandle_t data, tdata_t pbase, toff_t psize)
1578 {
1579         return;
1580 }
1581
1582 static toff_t rawrgb_memory_size(thandle_t data)
1583 {
1584         rawrgb_memory_storage *mem = (rawrgb_memory_storage *) data;
1585         return mem->len;
1586 }
1587 static toff_t rawrgba_memory_size(thandle_t data)
1588 {
1589         rawrgba_memory_storage *mem = (rawrgba_memory_storage *) data;
1590         return mem->len;
1591 }
1592 #endif  /* 0 */
1593
1594 static void
1595 rawrgb_instantiate(Lisp_Object image_instance, Lisp_Object instantiator,
1596                    Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1597                    int dest_mask, Lisp_Object domain)
1598 {
1599         Lisp_Image_Instance *ii = XIMAGE_INSTANCE(image_instance);
1600         rawrgb_memory_storage mem_struct;
1601         /* It is OK for the unwind data to be local to this function,
1602            because the unwind-protect is always executed when this
1603            stack frame is still valid. */
1604         struct rawrgb_unwind_data unwind;
1605         int speccount = specpdl_depth();
1606         unsigned long width = 0, height = 0;
1607         mem_struct.bytes = NULL;
1608
1609         xzero(unwind);
1610         record_unwind_protect(rawrgb_instantiate_unwind,
1611                               make_opaque_ptr(&unwind));
1612
1613         {
1614                 Lisp_Object data = find_keyword_in_vector(instantiator, Q_data);
1615                 Lisp_Object rows = find_keyword_in_vector(instantiator,
1616                                                           Q_pixel_height);
1617                 Lisp_Object cols = find_keyword_in_vector(instantiator,
1618                                                           Q_pixel_width);
1619                 Extbyte *bytes = NULL;
1620                 Extcount len;
1621
1622                 unsigned char *ep;
1623                 unsigned char *dp;
1624
1625                 assert(!NILP(data));
1626
1627 #ifdef HAVE_FFI
1628                 if (EFFIOP(data)) {
1629                         bytes = XEFFIO(data)->fostorage;
1630                         len = XEFFIO(data)->storage_size;
1631                 } else
1632 #endif  /* HAVE_FFI */
1633                 TO_EXTERNAL_FORMAT(LISP_STRING, data,
1634                                    ALLOCA, (bytes, len), Qbinary);
1635                 if ( bytes != NULL ) {
1636                         mem_struct.bytes = bytes;
1637                         mem_struct.len = len;
1638                         mem_struct.index = 0;
1639
1640                         width = XINT(cols);
1641                         height = XINT(rows);
1642
1643                         unwind.eimage = xmalloc_atomic(len);
1644                         ep = unwind.eimage;
1645                         dp = (unsigned char*)bytes;
1646                         for ( ; dp < (unsigned char*)bytes+len; ep++, dp++)
1647                                 *ep = *dp;
1648                 }
1649         }
1650
1651         if ( mem_struct.bytes != NULL ) {
1652                 /* now instantiate */
1653                 MAYBE_DEVMETH(DOMAIN_XDEVICE(ii->domain),
1654                               init_image_instance_from_eimage,
1655                               (ii, width, height, 1, unwind.eimage, dest_mask,
1656                                instantiator, domain));
1657         }
1658         unbind_to(speccount, Qnil);
1659 }
1660 static void
1661 rawrgba_instantiate(Lisp_Object image_instance, Lisp_Object instantiator,
1662                     Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1663                     int dest_mask, Lisp_Object domain)
1664 {
1665         Lisp_Image_Instance *ii = XIMAGE_INSTANCE(image_instance);
1666         rawrgba_memory_storage mem_struct;
1667         /* It is OK for the unwind data to be local to this function,
1668            because the unwind-protect is always executed when this
1669            stack frame is still valid. */
1670         struct rawrgba_unwind_data unwind;
1671         int speccount = specpdl_depth();
1672         unsigned long width = 0, height = 0;
1673
1674         mem_struct.bytes = 0;
1675         xzero(unwind);
1676         record_unwind_protect(rawrgba_instantiate_unwind,
1677                               make_opaque_ptr(&unwind));
1678
1679         {
1680                 Lisp_Object data = find_keyword_in_vector(instantiator, Q_data);
1681                 Lisp_Object rows = find_keyword_in_vector(instantiator,
1682                                                           Q_pixel_height);
1683                 Lisp_Object cols = find_keyword_in_vector(instantiator,
1684                                                           Q_pixel_width);
1685                 Extbyte *bytes = NULL;
1686                 Extcount len;
1687
1688                 unsigned char *ep;
1689                 unsigned char *dp;
1690
1691                 assert(!NILP(data));
1692
1693 #ifdef HAVE_FFI
1694                 if (EFFIOP(data)) {
1695                         bytes = XEFFIO(data)->fostorage;
1696                         len = XEFFIO(data)->storage_size;
1697                 } else
1698 #endif  /* HAVE_FFI */
1699                 TO_EXTERNAL_FORMAT(LISP_STRING, data,
1700                                    ALLOCA, (bytes, len), Qbinary);
1701                 if (bytes != NULL ) {
1702                         mem_struct.bytes = bytes;
1703                         mem_struct.len = len;
1704                         mem_struct.index = 0;
1705
1706                         width = XINT(cols);
1707                         height = XINT(rows);
1708
1709                         unwind.eimage = xmalloc_atomic(len);
1710                         for (ep = unwind.eimage, dp = (unsigned char*)bytes;
1711                              dp < (unsigned char*)bytes+len; ep++, dp++) {
1712                                 *ep = *dp;
1713                         }
1714                 }
1715         }
1716
1717         if ( mem_struct.bytes !=  NULL) {
1718                 /* now instantiate */
1719                 MAYBE_DEVMETH(DOMAIN_XDEVICE(ii->domain),
1720                               init_image_instance_from_eimage,
1721                               (ii, width, height, 1, unwind.eimage, dest_mask,
1722                                instantiator, domain));
1723         }
1724         unbind_to(speccount, Qnil);
1725 }
1726 #endif  /* 1 */
1727 \f
1728 /************************************************************************/
1729 /*                            initialization                            */
1730 /************************************************************************/
1731
1732 void syms_of_glyphs_eimage(void)
1733 {
1734 }
1735
1736 static void check_valid_ffio_or_string(Lisp_Object data)
1737 {
1738 #ifdef HAVE_FFI
1739         if (!EFFIOP(data) && !STRINGP(data))
1740                 dead_wrong_type_argument(Qstringp, data);
1741 #else
1742         CHECK_STRING(data);
1743 #endif  /* HAVE_FFI */
1744 }
1745
1746 void image_instantiator_format_create_glyphs_eimage(void)
1747 {
1748         /* image-instantiator types */
1749 #ifdef HAVE_JPEG
1750         INITIALIZE_IMAGE_INSTANTIATOR_FORMAT(jpeg, "jpeg");
1751
1752         IIFORMAT_HAS_METHOD(jpeg, validate);
1753         IIFORMAT_HAS_METHOD(jpeg, normalize);
1754         IIFORMAT_HAS_METHOD(jpeg, possible_dest_types);
1755         IIFORMAT_HAS_METHOD(jpeg, instantiate);
1756
1757         IIFORMAT_VALID_KEYWORD(jpeg, Q_data, check_valid_ffio_or_string);
1758         IIFORMAT_VALID_KEYWORD(jpeg, Q_file, check_valid_string);
1759 #endif
1760
1761 #ifdef HAVE_GIF
1762         INITIALIZE_IMAGE_INSTANTIATOR_FORMAT(gif, "gif");
1763
1764         IIFORMAT_HAS_METHOD(gif, validate);
1765         IIFORMAT_HAS_METHOD(gif, normalize);
1766         IIFORMAT_HAS_METHOD(gif, possible_dest_types);
1767         IIFORMAT_HAS_METHOD(gif, instantiate);
1768
1769         IIFORMAT_VALID_KEYWORD(gif, Q_data, check_valid_ffio_or_string);
1770         IIFORMAT_VALID_KEYWORD(gif, Q_file, check_valid_string);
1771 #endif
1772
1773 #if defined WITH_PNG && defined HAVE_PNG
1774         INITIALIZE_IMAGE_INSTANTIATOR_FORMAT(png, "png");
1775
1776         IIFORMAT_HAS_METHOD(png, validate);
1777         IIFORMAT_HAS_METHOD(png, normalize);
1778         IIFORMAT_HAS_METHOD(png, possible_dest_types);
1779         IIFORMAT_HAS_METHOD(png, instantiate);
1780
1781         IIFORMAT_VALID_KEYWORD(png, Q_data, check_valid_ffio_or_string);
1782         IIFORMAT_VALID_KEYWORD(png, Q_file, check_valid_string);
1783 #endif  /* PNG */
1784
1785 #ifdef HAVE_TIFF
1786         INITIALIZE_IMAGE_INSTANTIATOR_FORMAT(tiff, "tiff");
1787
1788         IIFORMAT_HAS_METHOD(tiff, validate);
1789         IIFORMAT_HAS_METHOD(tiff, normalize);
1790         IIFORMAT_HAS_METHOD(tiff, possible_dest_types);
1791         IIFORMAT_HAS_METHOD(tiff, instantiate);
1792
1793         IIFORMAT_VALID_KEYWORD(tiff, Q_data, check_valid_ffio_or_string);
1794         IIFORMAT_VALID_KEYWORD(tiff, Q_file, check_valid_string);
1795 #endif
1796
1797 #if 1
1798         INITIALIZE_IMAGE_INSTANTIATOR_FORMAT(rawrgb, "rawrgb");
1799         INITIALIZE_IMAGE_INSTANTIATOR_FORMAT(rawrgba, "rawrgba");
1800
1801         IIFORMAT_HAS_METHOD(rawrgb, validate);
1802         IIFORMAT_HAS_METHOD(rawrgb, normalize);
1803         IIFORMAT_HAS_METHOD(rawrgb, possible_dest_types);
1804         IIFORMAT_HAS_METHOD(rawrgb, instantiate);
1805
1806         IIFORMAT_HAS_METHOD(rawrgba, validate);
1807         IIFORMAT_HAS_METHOD(rawrgba, normalize);
1808         IIFORMAT_HAS_METHOD(rawrgba, possible_dest_types);
1809         IIFORMAT_HAS_METHOD(rawrgba, instantiate);
1810
1811         IIFORMAT_VALID_KEYWORD(rawrgb, Q_data, check_valid_ffio_or_string);
1812         IIFORMAT_VALID_KEYWORD(rawrgb, Q_pixel_width, check_valid_int);
1813         IIFORMAT_VALID_KEYWORD(rawrgb, Q_pixel_height, check_valid_int);
1814
1815         IIFORMAT_VALID_KEYWORD(rawrgba, Q_data, check_valid_ffio_or_string);
1816         IIFORMAT_VALID_KEYWORD(rawrgba, Q_pixel_width, check_valid_int);
1817         IIFORMAT_VALID_KEYWORD(rawrgba, Q_pixel_height, check_valid_int);
1818 #endif
1819 }
1820
1821 void vars_of_glyphs_eimage(void)
1822 {
1823 #ifdef HAVE_JPEG
1824         Fprovide(Qjpeg);
1825 #endif
1826
1827 #ifdef HAVE_GIF
1828         Fprovide(Qgif);
1829 #endif
1830
1831 #if defined WITH_PNG && defined HAVE_PNG
1832         Fprovide(Qpng);
1833 #endif  /* PNG */
1834
1835 #ifdef HAVE_TIFF
1836         Fprovide(Qtiff);
1837 #endif
1838
1839 #if 1
1840         Fprovide(Qrawrgb);
1841         Fprovide(Qrawrgba);
1842 #endif
1843 }