comparison src/glyphs-x.c @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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
39 TODO:
40 TIFF Support
41 Loadable module support for images
42 Convert images.el to C and stick it in here?
43 */
44
45 #include <config.h>
46 #include "lisp.h"
47
48 #include "console-x.h"
49 #include "glyphs-x.h"
50 #include "objects-x.h"
51 #include "xmu.h"
52
53 #include "buffer.h"
54 #include "frame.h"
55 #include "insdel.h"
56 #include "opaque.h"
57
58 #include "sysfile.h"
59
60 #include <setjmp.h>
61
62 #define LISP_DEVICE_TO_X_SCREEN(dev) \
63 XDefaultScreenOfDisplay (DEVICE_X_DISPLAY (XDEVICE (dev)))
64
65 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xbm);
66 Lisp_Object Qxbm;
67
68 Lisp_Object Q_mask_file, Q_mask_data, Q_hotspot_x, Q_hotspot_y;
69 Lisp_Object Q_foreground, Q_background;
70
71 #ifdef HAVE_XPM
72 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xpm);
73 Lisp_Object Qxpm;
74 Lisp_Object Q_color_symbols;
75 #endif
76
77 #ifdef HAVE_XFACE
78 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xface);
79 Lisp_Object Qxface;
80 #endif
81
82 #ifdef HAVE_JPEG
83 DEFINE_IMAGE_INSTANTIATOR_FORMAT (jpeg);
84 Lisp_Object Qjpeg;
85 #endif
86
87 #ifdef HAVE_PNG
88 DEFINE_IMAGE_INSTANTIATOR_FORMAT (png);
89 Lisp_Object Qpng;
90 #endif
91
92 #ifdef HAVE_TIFF
93 DEFINE_IMAGE_INSTANTIATOR_FORMAT (tiff);
94 Lisp_Object Qtiff;
95 #endif
96
97 #ifdef HAVE_GIF
98 DEFINE_IMAGE_INSTANTIATOR_FORMAT (gif);
99 Lisp_Object Qgif;
100 #endif
101
102 DEFINE_IMAGE_INSTANTIATOR_FORMAT (cursor_font);
103 Lisp_Object Qcursor_font;
104
105 DEFINE_IMAGE_INSTANTIATOR_FORMAT (font);
106
107 DEFINE_IMAGE_INSTANTIATOR_FORMAT (autodetect);
108
109 static void cursor_font_instantiate (Lisp_Object image_instance,
110 Lisp_Object instantiator,
111 Lisp_Object pointer_fg,
112 Lisp_Object pointer_bg,
113 int dest_mask);
114
115 #include "bitmaps.h"
116
117
118 /************************************************************************/
119 /* image instance methods */
120 /************************************************************************/
121
122 static void
123 x_print_image_instance (struct Lisp_Image_Instance *p,
124 Lisp_Object printcharfun,
125 int escapeflag)
126 {
127 char buf[100];
128
129 switch (IMAGE_INSTANCE_TYPE (p))
130 {
131 case IMAGE_MONO_PIXMAP:
132 case IMAGE_COLOR_PIXMAP:
133 case IMAGE_POINTER:
134 sprintf (buf, " (0x%lx", (unsigned long) IMAGE_INSTANCE_X_PIXMAP (p));
135 write_c_string (buf, printcharfun);
136 if (IMAGE_INSTANCE_X_MASK (p))
137 {
138 sprintf (buf, "/0x%lx", (unsigned long) IMAGE_INSTANCE_X_MASK (p));
139 write_c_string (buf, printcharfun);
140 }
141 write_c_string (")", printcharfun);
142 break;
143 case IMAGE_SUBWINDOW:
144 /* #### implement me */
145 default:
146 break;
147 }
148 }
149
150 static void
151 x_finalize_image_instance (struct Lisp_Image_Instance *p)
152 {
153 if (!p->data)
154 return;
155
156 if (DEVICE_LIVE_P (XDEVICE (p->device)))
157 {
158 Screen *scr = LISP_DEVICE_TO_X_SCREEN (IMAGE_INSTANCE_DEVICE (p));
159
160 if (IMAGE_INSTANCE_X_PIXMAP (p))
161 XFreePixmap (DisplayOfScreen (scr), IMAGE_INSTANCE_X_PIXMAP (p));
162 if (IMAGE_INSTANCE_X_MASK (p) &&
163 IMAGE_INSTANCE_X_MASK (p) != IMAGE_INSTANCE_X_PIXMAP (p))
164 XFreePixmap (DisplayOfScreen (scr), IMAGE_INSTANCE_X_MASK (p));
165 IMAGE_INSTANCE_X_PIXMAP (p) = 0;
166 IMAGE_INSTANCE_X_MASK (p) = 0;
167
168 if (IMAGE_INSTANCE_X_CURSOR (p))
169 {
170 XFreeCursor (DisplayOfScreen (scr), IMAGE_INSTANCE_X_CURSOR (p));
171 IMAGE_INSTANCE_X_CURSOR (p) = 0;
172 }
173
174 if (IMAGE_INSTANCE_X_NPIXELS (p) != 0)
175 {
176 XFreeColors (DisplayOfScreen (scr),
177 DefaultColormapOfScreen (scr),
178 IMAGE_INSTANCE_X_PIXELS (p),
179 IMAGE_INSTANCE_X_NPIXELS (p), 0);
180 IMAGE_INSTANCE_X_NPIXELS (p) = 0;
181 }
182 }
183 if (IMAGE_INSTANCE_X_PIXELS (p))
184 {
185 xfree (IMAGE_INSTANCE_X_PIXELS (p));
186 IMAGE_INSTANCE_X_PIXELS (p) = 0;
187 }
188
189 xfree (p->data);
190 p->data = 0;
191 }
192
193 static int
194 x_image_instance_equal (struct Lisp_Image_Instance *p1,
195 struct Lisp_Image_Instance *p2, int depth)
196 {
197 switch (IMAGE_INSTANCE_TYPE (p1))
198 {
199 case IMAGE_MONO_PIXMAP:
200 case IMAGE_COLOR_PIXMAP:
201 case IMAGE_POINTER:
202 if (IMAGE_INSTANCE_X_NPIXELS (p1) != IMAGE_INSTANCE_X_NPIXELS (p2))
203 return 0;
204 break;
205 case IMAGE_SUBWINDOW:
206 /* #### implement me */
207 break;
208 default:
209 break;
210 }
211
212 return 1;
213 }
214
215 static unsigned long
216 x_image_instance_hash (struct Lisp_Image_Instance *p, int depth)
217 {
218 switch (IMAGE_INSTANCE_TYPE (p))
219 {
220 case IMAGE_MONO_PIXMAP:
221 case IMAGE_COLOR_PIXMAP:
222 case IMAGE_POINTER:
223 return IMAGE_INSTANCE_X_NPIXELS (p);
224 case IMAGE_SUBWINDOW:
225 /* #### implement me */
226 return 0;
227 default:
228 return 0;
229 }
230 }
231
232 /* Set all the slots in an image instance structure to reasonable
233 default values. This is used somewhere within an instantiate
234 method. It is assumed that the device slot within the image
235 instance is already set -- this is the case when instantiate
236 methods are called. */
237
238 static void
239 x_initialize_pixmap_image_instance (struct Lisp_Image_Instance *ii,
240 enum image_instance_type type)
241 {
242 ii->data = malloc_type_and_zero (struct x_image_instance_data);
243 IMAGE_INSTANCE_TYPE (ii) = type;
244 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = Qnil;
245 IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (ii) = Qnil;
246 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) = Qnil;
247 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) = Qnil;
248 IMAGE_INSTANCE_PIXMAP_FG (ii) = Qnil;
249 IMAGE_INSTANCE_PIXMAP_BG (ii) = Qnil;
250 }
251
252
253 /************************************************************************/
254 /* pixmap file functions */
255 /************************************************************************/
256
257 /* Where bitmaps are; initialized from resource database */
258 Lisp_Object Vx_bitmap_file_path;
259
260 #ifndef BITMAPDIR
261 #define BITMAPDIR "/usr/include/X11/bitmaps"
262 #endif
263
264 #define USE_XBMLANGPATH
265
266 /* Given a pixmap filename, look through all of the "standard" places
267 where the file might be located. Return a full pathname if found;
268 otherwise, return Qnil. */
269
270 static Lisp_Object
271 locate_pixmap_file (Lisp_Object name)
272 {
273 /* This function can GC if IN_REDISPLAY is false */
274 Display *display;
275
276 /* Check non-absolute pathnames with a directory component relative to
277 the search path; that's the way Xt does it. */
278 /* #### Unix-specific */
279 if (string_byte (XSTRING (name), 0) == '/' ||
280 (string_byte (XSTRING (name), 0) == '.' &&
281 (string_byte (XSTRING (name), 1) == '/' ||
282 (string_byte (XSTRING (name), 1) == '.' &&
283 (string_byte (XSTRING (name), 2) == '/')))))
284 {
285 if (!NILP (Ffile_readable_p (name)))
286 return name;
287 else
288 return Qnil;
289 }
290
291 if (NILP (Vdefault_x_device))
292 /* This may occur during intialization. */
293 return Qnil;
294 else
295 /* We only check the bitmapFilePath resource on the original X device. */
296 display = DEVICE_X_DISPLAY (XDEVICE (Vdefault_x_device));
297
298 #ifdef USE_XBMLANGPATH
299 {
300 char *path = egetenv ("XBMLANGPATH");
301 SubstitutionRec subs[1];
302 subs[0].match = 'B';
303 subs[0].substitution = (char *) string_data (XSTRING (name));
304 /* #### Motif uses a big hairy default if $XBMLANGPATH isn't set.
305 We don't. If you want it used, set it. */
306 if (path &&
307 (path = XtResolvePathname (display, "bitmaps", 0, 0, path,
308 subs, XtNumber (subs), 0)))
309 {
310 name = build_string (path);
311 XtFree (path);
312 return (name);
313 }
314 }
315 #endif
316
317 if (NILP (Vx_bitmap_file_path))
318 {
319 char *type = 0;
320 XrmValue value;
321 if (XrmGetResource (XtDatabase (display),
322 "bitmapFilePath", "BitmapFilePath", &type, &value)
323 && !strcmp (type, "String"))
324 Vx_bitmap_file_path = decode_env_path (0, (char *) value.addr);
325 Vx_bitmap_file_path = nconc2 (Vx_bitmap_file_path,
326 (list1 (build_string (BITMAPDIR))));
327 }
328
329 {
330 Lisp_Object found;
331 if (locate_file (Vx_bitmap_file_path, name, "", &found, R_OK) < 0)
332 {
333 Lisp_Object temp = list1 (Vdata_directory);
334 struct gcpro gcpro1;
335
336 GCPRO1 (temp);
337 locate_file (temp, name, "", &found, R_OK);
338 UNGCPRO;
339 }
340
341 return found;
342 }
343 }
344
345 /* If INSTANTIATOR refers to inline data, return Qnil.
346 If INSTANTIATOR refers to data in a file, return the full filename
347 if it exists; otherwise, return a cons of (filename).
348
349 FILE_KEYWORD and DATA_KEYWORD are symbols specifying the
350 keywords used to look up the file and inline data,
351 respectively, in the instantiator. Normally these would
352 be Q_file and Q_data, but might be different for mask data. */
353
354 static Lisp_Object
355 potential_pixmap_file_instantiator (Lisp_Object instantiator,
356 Lisp_Object file_keyword,
357 Lisp_Object data_keyword)
358 {
359 Lisp_Object file;
360 Lisp_Object data;
361
362 assert (VECTORP (instantiator));
363
364 data = find_keyword_in_vector (instantiator, data_keyword);
365 file = find_keyword_in_vector (instantiator, file_keyword);
366
367 if (!NILP (file) && NILP (data))
368 {
369 Lisp_Object retval = locate_pixmap_file (file);
370 if (!NILP (retval))
371 return retval;
372 else
373 return Fcons (file, Qnil); /* should have been file */
374 }
375
376 return Qnil;
377 }
378
379
380 static Lisp_Object
381 simple_image_type_normalize (Lisp_Object inst, Lisp_Object console_type,
382 Lisp_Object image_type_tag)
383 {
384 Lisp_Object file = Qnil;
385 struct gcpro gcpro1, gcpro2;
386 Lisp_Object alist = Qnil;
387
388 GCPRO2 (file, alist);
389
390 /* Now, convert any file data into inline data. At the end of this,
391 `data' will contain the inline data (if any) or Qnil, and `file'
392 will contain the name this data was derived from (if known) or
393 Qnil.
394
395 Note that if we cannot generate any regular inline data, we
396 skip out. */
397
398 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data);
399
400 if (CONSP (file)) /* failure locating filename */
401 signal_double_file_error ("Opening pixmap file",
402 "no such file or directory",
403 Fcar (file));
404
405 if (NILP (file)) /* no conversion necessary */
406 RETURN_UNGCPRO (inst);
407
408 alist = tagged_vector_to_alist (inst);
409
410 {
411 Lisp_Object data = make_string_from_file (file);
412 alist = remassq_no_quit (Q_file, alist);
413 /* there can't be a :data at this point. */
414 alist = Fcons (Fcons (Q_file, file),
415 Fcons (Fcons (Q_data, data), alist));
416 }
417
418 {
419 Lisp_Object result = alist_to_tagged_vector (image_type_tag, alist);
420 free_alist (alist);
421 RETURN_UNGCPRO (result);
422 }
423 }
424
425 static void
426 write_lisp_string_to_temp_file (Lisp_Object string, char *filename_out)
427 {
428 Extbyte *bytes;
429 Extcount len;
430 FILE *stream;
431
432 /* #### This is a definite problem under Mule due to the amount of
433 stack data it might allocate. Need to be able to convert and
434 write out to a file. */
435 GET_STRING_BINARY_DATA_ALLOCA (string, bytes, len);
436
437 /* Write out to a temporary file ... */
438 sprintf (filename_out, "/tmp/emacs%d.XXXXXX", (int) getpid ());
439 mktemp (filename_out);
440 stream = fopen (filename_out, "w");
441 if (!stream)
442 {
443 temp_file_error:
444 if (stream)
445 {
446 int old_errno = errno;
447 fclose (stream);
448 unlink (filename_out);
449 errno = old_errno;
450 }
451 report_file_error ("Creating temp file",
452 list1 (build_string (filename_out)));
453 }
454
455 if (fwrite (bytes, len, 1, stream) != 1)
456 goto temp_file_error;
457
458 if (fclose (stream) != 0)
459 {
460 stream = 0;
461 goto temp_file_error;
462 }
463 }
464
465
466 /************************************************************************/
467 /* cursor functions */
468 /************************************************************************/
469
470 /* Check that this server supports cursors of size WIDTH * HEIGHT. If
471 not, signal an error. INSTANTIATOR is only used in the error
472 message. */
473
474 static void
475 check_pointer_sizes (Screen *xs, unsigned int width, unsigned int height,
476 Lisp_Object instantiator)
477 {
478 unsigned int best_width, best_height;
479 if (! XQueryBestCursor (DisplayOfScreen (xs), RootWindowOfScreen (xs),
480 width, height, &best_width, &best_height))
481 /* this means that an X error of some sort occurred (we trap
482 these so they're not fatal). */
483 signal_simple_error ("XQueryBestCursor() failed?", instantiator);
484
485 if (width > best_width || height > best_height)
486 error_with_frob (instantiator,
487 "pointer too large (%dx%d): "
488 "server requires %dx%d or smaller",
489 width, height, best_width, best_height);
490 }
491
492
493 static void
494 generate_cursor_fg_bg (Lisp_Object device, Lisp_Object *foreground,
495 Lisp_Object *background, XColor *xfg, XColor *xbg)
496 {
497 if (!NILP (*foreground) && !COLOR_INSTANCEP (*foreground))
498 *foreground =
499 Fmake_color_instance (*foreground, device,
500 encode_error_behavior_flag (ERROR_ME));
501 if (COLOR_INSTANCEP (*foreground))
502 *xfg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (*foreground));
503 else
504 {
505 xfg->pixel = 0;
506 xfg->red = xfg->green = xfg->blue = 0;
507 }
508
509 if (!NILP (*background) && !COLOR_INSTANCEP (*background))
510 *background =
511 Fmake_color_instance (*background, device,
512 encode_error_behavior_flag (ERROR_ME));
513 if (COLOR_INSTANCEP (*background))
514 *xbg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (*background));
515 else
516 {
517 xbg->pixel = 0;
518 xbg->red = xbg->green = xbg->blue = ~0;
519 }
520 }
521
522 static void
523 maybe_recolor_cursor (Lisp_Object image_instance, Lisp_Object foreground,
524 Lisp_Object background)
525 {
526 Lisp_Object device = XIMAGE_INSTANCE_DEVICE (image_instance);
527 XColor xfg, xbg;
528
529 generate_cursor_fg_bg (device, &foreground, &background, &xfg, &xbg);
530 if (!NILP (foreground) || !NILP (background))
531 {
532 XRecolorCursor (DEVICE_X_DISPLAY (XDEVICE (device)),
533 XIMAGE_INSTANCE_X_CURSOR (image_instance),
534 &xfg, &xbg);
535 XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
536 XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
537 }
538 }
539
540
541 /************************************************************************/
542 /* color pixmap functions */
543 /************************************************************************/
544
545 /* Initialize an image instance from an XImage.
546
547 DEST_MASK specifies the mask of allowed image types.
548
549 PIXELS and NPIXELS specify an array of pixels that are used in
550 the image. These need to be kept around for the duration of the
551 image. When the image instance is freed, XFreeColors() will
552 automatically be called on all the pixels specified here; thus,
553 you should have allocated the pixels yourself using XAllocColor()
554 or the like. The array passed in is used directly without
555 being copied, so it should be heap data created with xmalloc().
556 It will be freed using xfree() when the image instance is
557 destroyed.
558
559 If this fails, signal an error. INSTANTIATOR is only used
560 in the error message.
561
562 #### This should be able to handle conversion into `pointer'.
563 Use the same code as for `xpm'. */
564
565 static void
566 init_image_instance_from_x_image (struct Lisp_Image_Instance *ii,
567 XImage *ximage,
568 int dest_mask,
569 unsigned long *pixels,
570 int npixels,
571 Lisp_Object instantiator)
572 {
573 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
574 Display *dpy;
575 Screen *xs;
576 GC gc;
577 Drawable d;
578 Pixmap pixmap;
579
580 if (!DEVICE_X_P (XDEVICE (device)))
581 signal_simple_error ("Not an X device", device);
582
583 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
584 xs = DefaultScreenOfDisplay (dpy);
585 d = RootWindowOfScreen (xs);
586
587 if (!(dest_mask & IMAGE_COLOR_PIXMAP_MASK))
588 incompatible_image_types (instantiator, dest_mask,
589 IMAGE_COLOR_PIXMAP_MASK);
590
591 pixmap = XCreatePixmap (dpy, d, ximage->width,
592 ximage->height, ximage->depth);
593 if (!pixmap)
594 signal_simple_error ("Unable to create pixmap", instantiator);
595
596 gc = XCreateGC (dpy, pixmap, 0, NULL);
597 if (!gc)
598 {
599 XFreePixmap (dpy, pixmap);
600 signal_simple_error ("Unable to create GC", instantiator);
601 }
602
603 XPutImage (dpy, pixmap, gc, ximage, 0, 0, 0, 0,
604 ximage->width, ximage->height);
605
606 XFreeGC (dpy, gc);
607
608 x_initialize_pixmap_image_instance (ii, IMAGE_COLOR_PIXMAP);
609
610 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
611 find_keyword_in_vector (instantiator, Q_file);
612
613 IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
614 IMAGE_INSTANCE_X_MASK (ii) = 0;
615 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = ximage->width;
616 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = ximage->height;
617 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = ximage->depth;
618 IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
619 IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
620 }
621
622
623 /**********************************************************************
624 * XBM *
625 **********************************************************************/
626
627 /* Check if DATA represents a valid inline XBM spec (i.e. a list
628 of (width height bits), with checking done on the dimensions).
629 If not, signal an error. */
630
631 static void
632 check_valid_xbm_inline (Lisp_Object data)
633 {
634 Lisp_Object width, height, bits;
635
636 CHECK_CONS (data);
637 if (!CONSP (XCDR (data)) || !CONSP (XCDR (XCDR (data))) ||
638 !NILP (XCDR (XCDR (XCDR (data)))))
639 signal_simple_error ("Must be list of 3 elements", data);
640
641 width = XCAR (data);
642 height = XCAR (XCDR (data));
643 bits = XCAR (XCDR (XCDR (data)));
644
645 if (!INTP (width) || !INTP (height) || !STRINGP (bits))
646 signal_simple_error ("Must be (width height bits)",
647 vector3 (width, height, bits));
648
649 if (XINT (width) <= 0)
650 signal_simple_error ("Width must be > 0", width);
651
652 if (XINT (height) <= 0)
653 signal_simple_error ("Height must be > 0", height);
654
655 if (((unsigned) (XINT (width) * XINT (height)) / 8)
656 > string_char_length (XSTRING (bits)))
657 signal_simple_error ("data is too short for W and H",
658 vector3 (width, height, bits));
659 }
660
661 /* Validate method for XBM's. */
662
663 static void
664 xbm_validate (Lisp_Object instantiator)
665 {
666 file_or_data_must_be_present (instantiator);
667 }
668
669 /* Given a filename that is supposed to contain XBM data, return
670 the inline representation of it as (width height bits). Return
671 the hotspot through XHOT and YHOT, if those pointers are not 0.
672 If there is no hotspot, XHOT and YHOT will contain -1.
673
674 If the function fails:
675
676 -- if OK_IF_DATA_INVALID is set and the data was invalid,
677 return Qt.
678 -- maybe return an error, or return Qnil.
679 */
680
681
682 static Lisp_Object
683 bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot,
684 int ok_if_data_invalid)
685 {
686 unsigned int w, h;
687 Extbyte *data;
688 int result;
689 CONST char *filename_ext;
690
691 GET_C_STRING_FILENAME_DATA_ALLOCA (name, filename_ext);
692 result = XmuReadBitmapDataFromFile (filename_ext, &w, &h, &data, xhot, yhot);
693
694 if (result == BitmapSuccess)
695 {
696 Lisp_Object retval;
697 int len = (w + 7) / 8 * h;
698
699 retval = list3 (make_int (w), make_int (h),
700 make_ext_string (data, len, FORMAT_BINARY));
701 XFree ((char *) data);
702 return retval;
703 }
704
705 switch (result)
706 {
707 case BitmapOpenFailed:
708 {
709 /* should never happen */
710 signal_double_file_error ("Opening bitmap file",
711 "no such file or directory",
712 name);
713 }
714 case BitmapFileInvalid:
715 {
716 if (ok_if_data_invalid)
717 return Qt;
718 signal_double_file_error ("Reading bitmap file",
719 "invalid data in file",
720 name);
721 }
722 case BitmapNoMemory:
723 {
724 signal_double_file_error ("Reading bitmap file",
725 "out of memory",
726 name);
727 }
728 default:
729 {
730 signal_double_file_error_2 ("Reading bitmap file",
731 "unknown error code",
732 make_int (result), name);
733 }
734 }
735
736 return Qnil; /* not reached */
737 }
738
739 static Lisp_Object
740 xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file,
741 Lisp_Object mask_file)
742 {
743 /* This is unclean but it's fairly standard -- a number of the
744 bitmaps in /usr/include/X11/bitmaps use it -- so we support
745 it. */
746 if (NILP (mask_file)
747 /* don't override explicitly specified mask data. */
748 && NILP (assq_no_quit (Q_mask_data, alist))
749 && !NILP (file))
750 {
751 mask_file =
752 locate_pixmap_file (concat2 (file, build_string ("Mask")));
753 if (NILP (mask_file))
754 mask_file =
755 locate_pixmap_file (concat2 (file, build_string ("msk")));
756 }
757
758 if (!NILP (mask_file))
759 {
760 Lisp_Object mask_data =
761 bitmap_to_lisp_data (mask_file, 0, 0, 0);
762 alist = remassq_no_quit (Q_mask_file, alist);
763 /* there can't be a :mask-data at this point. */
764 alist = Fcons (Fcons (Q_mask_file, mask_file),
765 Fcons (Fcons (Q_mask_data, mask_data), alist));
766 }
767
768 return alist;
769 }
770
771 /* Normalize method for XBM's. */
772
773 static Lisp_Object
774 xbm_normalize (Lisp_Object inst, Lisp_Object console_type)
775 {
776 Lisp_Object file = Qnil, mask_file = Qnil;
777 struct gcpro gcpro1, gcpro2, gcpro3;
778 Lisp_Object alist = Qnil;
779
780 GCPRO3 (file, mask_file, alist);
781
782 /* Now, convert any file data into inline data for both the regular
783 data and the mask data. At the end of this, `data' will contain
784 the inline data (if any) or Qnil, and `file' will contain
785 the name this data was derived from (if known) or Qnil.
786 Likewise for `mask_file' and `mask_data'.
787
788 Note that if we cannot generate any regular inline data, we
789 skip out. */
790
791 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data);
792 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
793 Q_mask_data);
794
795 if (CONSP (file)) /* failure locating filename */
796 signal_double_file_error ("Opening bitmap file",
797 "no such file or directory",
798 Fcar (file));
799
800 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
801 RETURN_UNGCPRO (inst);
802
803 alist = tagged_vector_to_alist (inst);
804
805 if (!NILP (file))
806 {
807 int xhot, yhot;
808 Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, 0);
809 alist = remassq_no_quit (Q_file, alist);
810 /* there can't be a :data at this point. */
811 alist = Fcons (Fcons (Q_file, file),
812 Fcons (Fcons (Q_data, data), alist));
813
814 if (xhot != -1 && NILP (assq_no_quit (Q_hotspot_x, alist)))
815 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
816 alist);
817 if (yhot != -1 && NILP (assq_no_quit (Q_hotspot_y, alist)))
818 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
819 alist);
820 }
821
822 alist = xbm_mask_file_munging (alist, file, mask_file);
823
824 {
825 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
826 free_alist (alist);
827 RETURN_UNGCPRO (result);
828 }
829 }
830
831 /* Given inline data for a mono pixmap, create and return the
832 corresponding X object. */
833
834 static Pixmap
835 pixmap_from_xbm_inline (Lisp_Object device, int width, int height,
836 /* Note that data is in ext-format! */
837 CONST Extbyte *bits)
838 {
839 Screen *screen = LISP_DEVICE_TO_X_SCREEN (device);
840 return XCreatePixmapFromBitmapData (DisplayOfScreen (screen),
841 RootWindowOfScreen (screen),
842 (char *) bits, width, height,
843 1, 0, 1);
844 }
845
846 /* Given inline data for a mono pixmap, initialize the given
847 image instance accordingly. */
848
849 static void
850 init_image_instance_from_xbm_inline (struct Lisp_Image_Instance *ii,
851 int width, int height,
852 /* Note that data is in ext-format! */
853 CONST char *bits,
854 Lisp_Object instantiator,
855 Lisp_Object pointer_fg,
856 Lisp_Object pointer_bg,
857 int dest_mask,
858 Pixmap mask,
859 Lisp_Object mask_filename)
860 {
861 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
862 Lisp_Object foreground = find_keyword_in_vector (instantiator, Q_foreground);
863 Lisp_Object background = find_keyword_in_vector (instantiator, Q_background);
864 Display *dpy;
865 Screen *scr;
866 enum image_instance_type type;
867
868 if (!DEVICE_X_P (XDEVICE (device)))
869 signal_simple_error ("Not an X device", device);
870
871 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
872 scr = DefaultScreenOfDisplay (dpy);
873
874 if ((dest_mask & IMAGE_MONO_PIXMAP_MASK) &&
875 (dest_mask & IMAGE_COLOR_PIXMAP_MASK))
876 {
877 if (!NILP (foreground) || !NILP (background))
878 type = IMAGE_COLOR_PIXMAP;
879 else
880 type = IMAGE_MONO_PIXMAP;
881 }
882 else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
883 type = IMAGE_MONO_PIXMAP;
884 else if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
885 type = IMAGE_COLOR_PIXMAP;
886 else if (dest_mask & IMAGE_POINTER_MASK)
887 type = IMAGE_POINTER;
888 else
889 incompatible_image_types (instantiator, dest_mask,
890 IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
891 | IMAGE_POINTER_MASK);
892
893 x_initialize_pixmap_image_instance (ii, type);
894 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = width;
895 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = height;
896 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
897 find_keyword_in_vector (instantiator, Q_file);
898
899 switch (type)
900 {
901 case IMAGE_MONO_PIXMAP:
902 {
903 IMAGE_INSTANCE_X_PIXMAP (ii) =
904 pixmap_from_xbm_inline (device, width, height, (Extbyte *) bits);
905 }
906 break;
907
908 case IMAGE_COLOR_PIXMAP:
909 {
910 Dimension d = DefaultDepthOfScreen (scr);
911 unsigned long fg = BlackPixelOfScreen (scr);
912 unsigned long bg = WhitePixelOfScreen (scr);
913
914 if (!NILP (foreground) && !COLOR_INSTANCEP (foreground))
915 foreground =
916 Fmake_color_instance (foreground, device,
917 encode_error_behavior_flag (ERROR_ME));
918
919 if (COLOR_INSTANCEP (foreground))
920 fg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground)).pixel;
921
922 if (!NILP (background) && !COLOR_INSTANCEP (background))
923 background =
924 Fmake_color_instance (background, device,
925 encode_error_behavior_flag (ERROR_ME));
926
927 if (COLOR_INSTANCEP (background))
928 bg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background)).pixel;
929
930 /* We used to duplicate the pixels using XAllocColor(), to protect
931 against their getting freed. Just as easy to just store the
932 color instances here and GC-protect them, so this doesn't
933 happen. */
934 IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
935 IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
936 IMAGE_INSTANCE_X_PIXMAP (ii) =
937 XCreatePixmapFromBitmapData (DisplayOfScreen (scr),
938 RootWindowOfScreen (scr),
939 (char *) bits, width, height,
940 fg, bg, d);
941 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = d;
942 }
943 break;
944
945 case IMAGE_POINTER:
946 {
947 XColor fg_color, bg_color;
948 Pixmap source;
949
950 check_pointer_sizes (scr, width, height, instantiator);
951
952 source =
953 XCreatePixmapFromBitmapData (DisplayOfScreen (scr),
954 RootWindowOfScreen (scr),
955 (char *) bits, width, height,
956 1, 0, 1);
957
958 if (NILP (foreground))
959 foreground = pointer_fg;
960 if (NILP (background))
961 background = pointer_bg;
962 generate_cursor_fg_bg (device, &foreground, &background,
963 &fg_color, &bg_color);
964
965 IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
966 IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
967 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) =
968 find_keyword_in_vector (instantiator, Q_hotspot_x);
969 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) =
970 find_keyword_in_vector (instantiator, Q_hotspot_y);
971 IMAGE_INSTANCE_X_CURSOR (ii) =
972 XCreatePixmapCursor
973 (dpy, source, mask, &fg_color, &bg_color,
974 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ?
975 XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) : 0,
976 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) ?
977 XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) : 0);
978 }
979 break;
980
981 default:
982 abort ();
983 }
984 }
985
986 static int
987 xbm_possible_dest_types ()
988 {
989 return IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK |
990 IMAGE_POINTER_MASK;
991 }
992
993 static void
994 xbm_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator,
995 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
996 int dest_mask, int width, int height,
997 /* Note that data is in ext-format! */
998 CONST char *bits)
999 {
1000 Lisp_Object mask_data = find_keyword_in_vector (instantiator, Q_mask_data);
1001 Lisp_Object mask_file = find_keyword_in_vector (instantiator, Q_mask_file);
1002 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1003 Pixmap mask = 0;
1004 CONST char *gcc_may_you_rot_in_hell;
1005
1006 if (!NILP (mask_data))
1007 {
1008 GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (mask_data))),
1009 gcc_may_you_rot_in_hell);
1010 mask =
1011 pixmap_from_xbm_inline (IMAGE_INSTANCE_DEVICE (ii),
1012 XINT (XCAR (mask_data)),
1013 XINT (XCAR (XCDR (mask_data))),
1014 (CONST unsigned char *)
1015 gcc_may_you_rot_in_hell);
1016 }
1017
1018 init_image_instance_from_xbm_inline (ii, width, height, bits,
1019 instantiator, pointer_fg, pointer_bg,
1020 dest_mask, mask, mask_file);
1021 }
1022
1023 /* Instantiate method for XBM's. */
1024
1025 static void
1026 xbm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1027 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1028 int dest_mask)
1029 {
1030 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1031 CONST char *gcc_go_home;
1032
1033 assert (!NILP (data));
1034
1035 GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (data))),
1036 gcc_go_home);
1037
1038 xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1039 pointer_bg, dest_mask, XINT (XCAR (data)),
1040 XINT (XCAR (XCDR (data))), gcc_go_home);
1041 }
1042
1043
1044 #ifdef HAVE_JPEG
1045
1046 /**********************************************************************
1047 * JPEG *
1048 **********************************************************************/
1049
1050 #include "jpeglib.h"
1051 #include "jerror.h"
1052
1053 static void
1054 jpeg_validate (Lisp_Object instantiator)
1055 {
1056 file_or_data_must_be_present (instantiator);
1057 }
1058
1059 static Lisp_Object
1060 jpeg_normalize (Lisp_Object inst, Lisp_Object console_type)
1061 {
1062 return simple_image_type_normalize (inst, console_type, Qjpeg);
1063 }
1064
1065 static int
1066 jpeg_possible_dest_types ()
1067 {
1068 return IMAGE_COLOR_PIXMAP_MASK;
1069 }
1070
1071 /* To survive the otherwise baffling complexity of making sure
1072 everything gets cleaned up in the presence of an error, we
1073 use an unwind_protect(). */
1074
1075 struct jpeg_unwind_data
1076 {
1077 Display *dpy;
1078 /* Stream that we need to close */
1079 FILE *instream;
1080 /* Object that holds state info for JPEG decoding */
1081 struct jpeg_decompress_struct *cinfo_ptr;
1082 /* Pixels to keep around while the image is active */
1083 unsigned long *pixels;
1084 int npixels;
1085 /* Client-side image structure */
1086 XImage *ximage;
1087 /* Tempfile to remove */
1088 char tempfile[50];
1089 int tempfile_needs_to_be_removed;
1090 };
1091
1092 static Lisp_Object
1093 jpeg_instantiate_unwind (Lisp_Object unwind_obj)
1094 {
1095 struct jpeg_unwind_data *data =
1096 (struct jpeg_unwind_data *) get_opaque_ptr (unwind_obj);
1097
1098 free_opaque_ptr (unwind_obj);
1099 if (data->cinfo_ptr)
1100 jpeg_destroy_decompress (data->cinfo_ptr);
1101
1102 if (data->instream)
1103 fclose (data->instream);
1104
1105 if (data->tempfile_needs_to_be_removed)
1106 unlink (data->tempfile);
1107
1108 if (data->npixels > 0)
1109 {
1110 Screen *scr = DefaultScreenOfDisplay (data->dpy);
1111 Colormap cmap = DefaultColormapOfScreen (scr);
1112 XFreeColors (data->dpy, cmap, data->pixels, data->npixels, 0L);
1113 xfree (data->pixels);
1114 }
1115
1116 if (data->ximage)
1117 {
1118 if (data->ximage->data)
1119 {
1120 xfree (data->ximage->data);
1121 data->ximage->data = 0;
1122 }
1123 XDestroyImage (data->ximage);
1124 }
1125
1126 return Qnil;
1127 }
1128
1129 /*
1130 * ERROR HANDLING:
1131 *
1132 * The JPEG library's standard error handler (jerror.c) is divided into
1133 * several "methods" which you can override individually. This lets you
1134 * adjust the behavior without duplicating a lot of code, which you might
1135 * have to update with each future release.
1136 *
1137 * Our example here shows how to override the "error_exit" method so that
1138 * control is returned to the library's caller when a fatal error occurs,
1139 * rather than calling exit() as the standard error_exit method does.
1140 *
1141 * We use C's setjmp/longjmp facility to return control. This means that the
1142 * routine which calls the JPEG library must first execute a setjmp() call to
1143 * establish the return point. We want the replacement error_exit to do a
1144 * longjmp(). But we need to make the setjmp buffer accessible to the
1145 * error_exit routine. To do this, we make a private extension of the
1146 * standard JPEG error handler object. (If we were using C++, we'd say we
1147 * were making a subclass of the regular error handler.)
1148 *
1149 * Here's the extended error handler struct:
1150 */
1151
1152 struct my_jpeg_error_mgr
1153 {
1154 struct jpeg_error_mgr pub; /* "public" fields */
1155 jmp_buf setjmp_buffer; /* for return to caller */
1156 };
1157
1158 #if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61)
1159 METHODDEF(void)
1160 #else
1161 METHODDEF void
1162 #endif
1163 our_init_source (j_decompress_ptr cinfo) {
1164 }
1165
1166 #if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61)
1167 METHODDEF(boolean)
1168 #else
1169 METHODDEF boolean
1170 #endif
1171 our_fill_input_buffer (j_decompress_ptr cinfo) {
1172 ERREXIT(cinfo,JERR_INPUT_EOF);
1173 return FALSE;
1174 }
1175
1176 #if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61)
1177 METHODDEF(void)
1178 #else
1179 METHODDEF void
1180 #endif
1181 our_skip_input_data (j_decompress_ptr cinfo, long num_bytes) {
1182 }
1183
1184 #if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61)
1185 METHODDEF(void)
1186 #else
1187 METHODDEF void
1188 #endif
1189 our_term_source (j_decompress_ptr cinfo) {
1190 }
1191
1192 typedef struct {
1193 struct jpeg_source_mgr pub;
1194 } our_jpeg_source_mgr;
1195
1196 static void jpeg_memory_src (j_decompress_ptr cinfo, JOCTET *data,
1197 unsigned int len)
1198 {
1199 struct jpeg_source_mgr *src = NULL;
1200
1201 if (cinfo->src == NULL) { /* first time for this JPEG object? */
1202 cinfo->src = (struct jpeg_source_mgr *)
1203 (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,
1204 sizeof(our_jpeg_source_mgr));
1205 src = (struct jpeg_source_mgr *) cinfo->src;
1206 src->next_input_byte = data;
1207 }
1208 src = (struct jpeg_source_mgr *) cinfo->src;
1209 src->init_source = our_init_source;
1210 src->fill_input_buffer = our_fill_input_buffer;
1211 src->skip_input_data = our_skip_input_data;
1212 src->resync_to_restart = jpeg_resync_to_restart; /* use default method */
1213 src->term_source = our_term_source;
1214 src->bytes_in_buffer = len;
1215 src->next_input_byte = data;
1216 }
1217
1218 #if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61)
1219 METHODDEF(void)
1220 #else
1221 METHODDEF void
1222 #endif
1223 my_jpeg_error_exit (j_common_ptr cinfo)
1224 {
1225 /* cinfo->err really points to a my_error_mgr struct, so coerce pointer */
1226 struct my_jpeg_error_mgr *myerr = (struct my_jpeg_error_mgr *) cinfo->err;
1227
1228 /* Return control to the setjmp point */
1229 longjmp (myerr->setjmp_buffer, 1);
1230 }
1231
1232 /* The code in this routine is based on example.c from the JPEG library
1233 source code and from gif_instantiate() */
1234 static void
1235 jpeg_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1236 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1237 int dest_mask)
1238 {
1239 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1240 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1241 Display *dpy;
1242 Screen *scr;
1243 /* It is OK for the unwind data to be local to this function,
1244 because the unwind-protect is always executed when this
1245 stack frame is still valid. */
1246 struct jpeg_unwind_data unwind;
1247 int speccount = specpdl_depth ();
1248
1249 /* This struct contains the JPEG decompression parameters and pointers to
1250 * working space (which is allocated as needed by the JPEG library).
1251 */
1252 struct jpeg_decompress_struct cinfo;
1253 /* We use our private extension JPEG error handler.
1254 * Note that this struct must live as long as the main JPEG parameter
1255 * struct, to avoid dangling-pointer problems.
1256 */
1257 struct my_jpeg_error_mgr jerr;
1258
1259 if (!DEVICE_X_P (XDEVICE (device)))
1260 signal_simple_error ("Not an X device", device);
1261
1262 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1263 scr = DefaultScreenOfDisplay (dpy);
1264
1265 /* Step -1: First record our unwind-protect, which will clean up after
1266 any exit, normal or not */
1267
1268 memset (&unwind, 0, sizeof (unwind));
1269 unwind.dpy = dpy;
1270 record_unwind_protect (jpeg_instantiate_unwind, make_opaque_ptr (&unwind));
1271
1272 #ifdef USE_TEMP_FILES_FOR_IMAGES
1273 /* Step 0: Write out to a temp file.
1274
1275 The JPEG routines require you to read from a file unless
1276 you provide your own special input handlers, which I don't
1277 feel like doing. */
1278 {
1279 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1280
1281 assert (!NILP (data));
1282
1283 write_lisp_string_to_temp_file (data, unwind.tempfile);
1284 unwind.tempfile_needs_to_be_removed = 1;
1285
1286 /* VERY IMPORTANT: use "b" option to fopen() if you are on a machine that
1287 * requires it in order to read binary files.
1288 */
1289
1290 if ((unwind.instream = fopen (unwind.tempfile, "r")) == NULL)
1291 report_file_error ("Opening JPEG temp file",
1292 list1 (build_string (unwind.tempfile)));
1293 }
1294 #endif
1295
1296 /* Step 1: allocate and initialize JPEG decompression object */
1297
1298 /* We set up the normal JPEG error routines, then override error_exit. */
1299 cinfo.err = jpeg_std_error (&jerr.pub);
1300 jerr.pub.error_exit = my_jpeg_error_exit;
1301
1302 /* Establish the setjmp return context for my_error_exit to use. */
1303 if (setjmp (jerr.setjmp_buffer))
1304 {
1305 /* If we get here, the JPEG code has signaled an error.
1306 * We need to clean up the JPEG object, close the input file, and return.
1307 */
1308
1309 {
1310 Lisp_Object errstring;
1311 char buffer[JMSG_LENGTH_MAX];
1312
1313 /* Create the message */
1314 (*cinfo.err->format_message) ((j_common_ptr) &cinfo, buffer);
1315 errstring = build_string (buffer);
1316
1317 signal_simple_error_2 ("JPEG decoding error",
1318 errstring, instantiator);
1319 }
1320 }
1321
1322 /* Now we can initialize the JPEG decompression object. */
1323 jpeg_create_decompress (&cinfo);
1324 unwind.cinfo_ptr = &cinfo;
1325
1326 /* Step 2: specify data source (eg, a file) */
1327
1328 #ifdef USE_FILEIO_FOR_IMAGES
1329 jpeg_stdio_src (&cinfo, unwind.instream);
1330 #else
1331 {
1332 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1333 Extbyte *bytes;
1334 Extcount len;
1335
1336 /* #### This is a definite problem under Mule due to the amount of
1337 stack data it might allocate. Need to be able to convert and
1338 write out to a file. */
1339 GET_STRING_BINARY_DATA_ALLOCA (data, bytes, len);
1340 jpeg_memory_src (&cinfo, bytes, len);
1341 }
1342 #endif
1343
1344 /* Step 3: read file parameters with jpeg_read_header() */
1345
1346 (void) jpeg_read_header (&cinfo, TRUE);
1347 /* We can ignore the return value from jpeg_read_header since
1348 * (a) suspension is not possible with the stdio data source, and
1349 * (b) we passed TRUE to reject a tables-only JPEG file as an error.
1350 * See libjpeg.doc for more info.
1351 */
1352
1353 /* Step 4: set parameters for decompression. */
1354
1355 /* We request that the JPEG file be automatically quantized into
1356 8-bit color in case it's not already (many JPEGs are stored in
1357 24-bit color). "Two-pass quantize" means that the colormap
1358 is determined on-the-fly for this particular image rather than
1359 quantizing to a supplied colormap. We can get away with this
1360 because we then use allocate_nearest_color().
1361
1362 #### Note of course that this is not the most color-effective
1363 way of doing things -- we could quantize an image that has
1364 lots of very similar colors, and eat up the colormap with these
1365 (useless to other images) colors. Unfortunately I don't think
1366 there's any "general" way of maximizing the overall image
1367 quality of lots of images, given that we don't know the
1368 colors of the images until we come across each one. Best we
1369 could do would be various sorts of heuristics, which I don't
1370 feel like dealing with now. A better scheme would be the
1371 way things are done under MS Windows, where the colormap is
1372 dynamically adjusted for various applications; but that kind
1373 of thing would have to be provided by X, which it isn't. */
1374
1375 cinfo.quantize_colors = TRUE;
1376 cinfo.two_pass_quantize = TRUE;
1377 cinfo.colormap = NULL;
1378
1379 /* Step 5: Start decompressor */
1380
1381 (void) jpeg_start_decompress (&cinfo);
1382 /* We can ignore the return value since suspension is not possible
1383 * with the stdio data source.
1384 */
1385
1386 /* At this point we know the size of the image and the colormap. */
1387
1388 /* Step 5.33: Allocate the colors */
1389 {
1390 int i;
1391
1392 /* Just in case the image contains out-of-range pixels, we go
1393 ahead and allocate space for all of them. */
1394 unwind.pixels = (unsigned long *) xmalloc (256 * sizeof (unsigned long));
1395 unwind.npixels = cinfo.actual_number_of_colors;
1396
1397 for (i = 0; i < 256; i++)
1398 unwind.pixels[i] = 0; /* Use a reasonable color for out of range. */
1399
1400 /* Allocate pixels for the various colors. */
1401 for (i = 0; i < unwind.npixels; i++)
1402 {
1403 XColor color;
1404 int ri, gi, bi;
1405
1406 ri = 0;
1407 gi = cinfo.out_color_components > 1 ? 1 : 0;
1408 bi = cinfo.out_color_components > 2 ? 2 : 0;
1409
1410 /* Ok... apparently, an entry of cinfo.colormap can be NULL if
1411 there are no bits of that color in the image. How incredibly
1412 gross. Wouldn't it be nice to have exceptions!? */
1413 color.red = cinfo.colormap[ri] ? cinfo.colormap[ri][i] << 8 : 0;
1414 color.green = cinfo.colormap[gi] ? cinfo.colormap[gi][i] << 8 : 0;
1415 color.blue = cinfo.colormap[bi] ? cinfo.colormap[bi][i] << 8 : 0;
1416 color.flags = DoRed | DoGreen | DoBlue;
1417
1418 allocate_nearest_color (dpy, DefaultColormapOfScreen (scr), &color);
1419 unwind.pixels[i] = color.pixel;
1420 }
1421 }
1422
1423 /* Step 5.66: Create the image */
1424 {
1425 int height = cinfo.output_height;
1426 int width = cinfo.output_width;
1427 int depth;
1428 int bitmap_pad;
1429
1430 depth = DefaultDepthOfScreen (scr);
1431
1432 /* first get bitmap_pad (from XPM) */
1433 if (depth > 16)
1434 bitmap_pad = 32;
1435 else if (depth > 8)
1436 bitmap_pad = 16;
1437 else
1438 bitmap_pad = 8;
1439
1440 unwind.ximage = XCreateImage (dpy, DefaultVisualOfScreen (scr),
1441 depth, ZPixmap, 0, 0, width, height,
1442 bitmap_pad, 0);
1443
1444 if (!unwind.ximage)
1445 signal_simple_error ("Unable to create X image struct", instantiator);
1446
1447 /* now that bytes_per_line must have been set properly alloc data */
1448 unwind.ximage->data =
1449 (char *) xmalloc (unwind.ximage->bytes_per_line * height);
1450 }
1451
1452 /* Step 6: Read in the data and put into image */
1453 {
1454 JSAMPARRAY row_buffer; /* Output row buffer */
1455 int row_stride; /* physical row width in output buffer */
1456
1457 /* We may need to do some setup of our own at this point before reading
1458 * the data. After jpeg_start_decompress() we have the correct scaled
1459 * output image dimensions available, as well as the output colormap
1460 * if we asked for color quantization.
1461 * In this example, we need to make an output work buffer of the right size.
1462 */
1463 /* JSAMPLEs per row in output buffer.
1464 Since we asked for quantized output, cinfo.output_components
1465 will always be 1. */
1466 row_stride = cinfo.output_width * cinfo.output_components;
1467 /* Make a one-row-high sample array that will go away when done
1468 with image */
1469 row_buffer = ((*cinfo.mem->alloc_sarray)
1470 ((j_common_ptr) &cinfo, JPOOL_IMAGE, row_stride, 1));
1471
1472 /* Here we use the library's state variable cinfo.output_scanline as the
1473 * loop counter, so that we don't have to keep track ourselves.
1474 */
1475 while (cinfo.output_scanline < cinfo.output_height)
1476 {
1477 int i;
1478 int scanline = cinfo.output_scanline;
1479
1480 /* jpeg_read_scanlines expects an array of pointers to scanlines.
1481 * Here the array is only one element long, but you could ask for
1482 * more than one scanline at a time if that's more convenient.
1483 */
1484 (void) jpeg_read_scanlines (&cinfo, row_buffer, 1);
1485
1486 for (i = 0; i < cinfo.output_width; i++)
1487 XPutPixel (unwind.ximage, i, scanline,
1488 /* Let's make sure we avoid getting bit like
1489 what happened for GIF's. It's probably the
1490 case that JSAMPLE's are unsigned chars as
1491 opposed to chars, but you never know.
1492
1493 (They could even be shorts if the library
1494 was compiled with 12-bit samples -- ####
1495 We should deal with this possibility) */
1496 unwind.pixels[(unsigned char) row_buffer[0][i]]);
1497 }
1498 }
1499
1500 /* Step 6.5: Create the pixmap and set up the image instance */
1501 init_image_instance_from_x_image (ii, unwind.ximage, dest_mask,
1502 unwind.pixels, unwind.npixels,
1503 instantiator);
1504
1505 /* Step 7: Finish decompression */
1506
1507 (void) jpeg_finish_decompress (&cinfo);
1508 /* We can ignore the return value since suspension is not possible
1509 * with the stdio data source.
1510 */
1511
1512 /* And we're done!
1513
1514 Now that we've succeeded, we don't want the pixels
1515 freed right now. They're kept around in the image instance
1516 structure until it's destroyed. */
1517 unwind.npixels = 0;
1518
1519 /* This will clean up everything else. */
1520 unbind_to (speccount, Qnil);
1521 }
1522
1523 #endif /* HAVE_JPEG */
1524
1525
1526 #ifdef HAVE_GIF
1527
1528 /**********************************************************************
1529 * GIF *
1530 **********************************************************************/
1531
1532 #include "gif_lib.h" /* This is in our own source tree */
1533
1534 static void
1535 gif_validate (Lisp_Object instantiator)
1536 {
1537 file_or_data_must_be_present (instantiator);
1538 }
1539
1540 static Lisp_Object
1541 gif_normalize (Lisp_Object inst, Lisp_Object console_type)
1542 {
1543 return simple_image_type_normalize (inst, console_type, Qgif);
1544 }
1545
1546 static int
1547 gif_possible_dest_types ()
1548 {
1549 return IMAGE_COLOR_PIXMAP_MASK;
1550 }
1551
1552 /* To survive the otherwise baffling complexity of making sure
1553 everything gets cleaned up in the presence of an error, we
1554 use an unwind_protect(). */
1555
1556 struct gif_unwind_data
1557 {
1558 Display *dpy;
1559 /* Object that holds the decoded data from a GIF file */
1560 GifFileType *giffile;
1561 /* Pixels to keep around while the image is active */
1562 unsigned long *pixels;
1563 int npixels;
1564 /* Client-side image structure */
1565 XImage *ximage;
1566 /* Tempfile to remove */
1567 char tempfile[50];
1568 int tempfile_needs_to_be_removed;
1569 };
1570
1571 static Lisp_Object
1572 gif_instantiate_unwind (Lisp_Object unwind_obj)
1573 {
1574 struct gif_unwind_data *data =
1575 (struct gif_unwind_data *) get_opaque_ptr (unwind_obj);
1576
1577 free_opaque_ptr (unwind_obj);
1578 if (data->giffile)
1579 DGifCloseFile (data->giffile);
1580 if (data->tempfile_needs_to_be_removed)
1581 unlink (data->tempfile);
1582 if (data->npixels > 0)
1583 {
1584 Screen *scr = DefaultScreenOfDisplay (data->dpy);
1585 Colormap cmap = DefaultColormapOfScreen (scr);
1586 XFreeColors (data->dpy, cmap, data->pixels, data->npixels, 0L);
1587 xfree (data->pixels);
1588 }
1589 if (data->ximage)
1590 {
1591 if (data->ximage->data)
1592 {
1593 xfree (data->ximage->data);
1594 data->ximage->data = 0;
1595 }
1596 XDestroyImage (data->ximage);
1597 }
1598
1599 return Qnil;
1600 }
1601
1602 /* We provide our own version of DGifSlurp() because the standardly
1603 provided one doesn't handle interlaced GIFs. This is based on
1604 code in gif2x11.c. */
1605
1606 /* Return value is GIF_ERROR, GIF_OK, or -1.
1607 #### We are using "forbidden" knowledge that neither of these
1608 constants is -1. */
1609
1610 static int
1611 our_own_dgif_slurp_from_gif2x11_c (GifFileType *GifFile)
1612 {
1613 int i, j, Row, Col, Width, Height;
1614 int ExtCode, Count;
1615 GifRecordType RecordType;
1616 GifByteType *Extension;
1617 SavedImage *sp = NULL;
1618 static int InterlacedOffset[] = { 0, 4, 2, 1 };
1619 static int InterlacedJumps[] = { 8, 8, 4, 2 };
1620
1621 GifPixelType *ScreenBuffer =
1622 (GifPixelType *) xmalloc (GifFile->SHeight * GifFile->SWidth *
1623 sizeof (GifPixelType));
1624 GifFile->SavedImages = (SavedImage *) xmalloc (sizeof(SavedImage));
1625
1626 for (i = 0; i < GifFile->SHeight * GifFile->SWidth; i++)
1627 ScreenBuffer[i] = GifFile->SBackGroundColor;
1628
1629 /* Scan the content of the GIF file and load the image(s) in: */
1630 do
1631 {
1632 if (DGifGetRecordType (GifFile, &RecordType) == GIF_ERROR)
1633 return GIF_ERROR;
1634
1635 switch (RecordType)
1636 {
1637 case IMAGE_DESC_RECORD_TYPE:
1638 if (DGifGetImageDesc (GifFile) == GIF_ERROR)
1639 return GIF_ERROR;
1640
1641 sp = &GifFile->SavedImages[GifFile->ImageCount-1];
1642 Row = GifFile->Image.Top; /* Image Position relative to Screen. */
1643 Col = GifFile->Image.Left;
1644 Width = GifFile->Image.Width;
1645 Height = GifFile->Image.Height;
1646 if (GifFile->Image.Left + GifFile->Image.Width > GifFile->SWidth ||
1647 GifFile->Image.Top + GifFile->Image.Height > GifFile->SHeight)
1648 return -1;
1649
1650 sp->RasterBits = (GifPixelType*) xmalloc(Width * Height *
1651 sizeof (GifPixelType));
1652
1653 if (GifFile->Image.Interlace)
1654 {
1655 /* Need to perform 4 passes on the images: */
1656 for (Count = i = 0; i < 4; i++)
1657 for (j = Row + InterlacedOffset[i]; j < Row + Height;
1658 j += InterlacedJumps[i])
1659 {
1660 if (DGifGetLine (GifFile, &sp->RasterBits[j * Width + Col],
1661 Width) == GIF_ERROR)
1662 return GIF_ERROR;
1663 }
1664 }
1665 else
1666 {
1667 for (i = 0; i < Height; i++)
1668 {
1669 if (DGifGetLine (GifFile,
1670 &sp->RasterBits[(Row++) * Width + Col],
1671 Width) == GIF_ERROR)
1672 return GIF_ERROR;
1673 }
1674 }
1675 break;
1676
1677 case EXTENSION_RECORD_TYPE:
1678 /* Skip any extension blocks in file: */
1679 if (DGifGetExtension (GifFile, &ExtCode, &Extension) == GIF_ERROR)
1680 return GIF_ERROR;
1681
1682 while (Extension != NULL)
1683 {
1684 if (DGifGetExtensionNext (GifFile, &Extension) == GIF_ERROR)
1685 return GIF_ERROR;
1686 }
1687 break;
1688
1689 case TERMINATE_RECORD_TYPE:
1690 break;
1691
1692 default: /* Should be traps by DGifGetRecordType. */
1693 break;
1694 }
1695 }
1696 while (RecordType != TERMINATE_RECORD_TYPE);
1697
1698 return GIF_OK;
1699 }
1700
1701 static void
1702 gif_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1703 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1704 int dest_mask)
1705 {
1706 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1707 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1708 Display *dpy;
1709 Screen *scr;
1710 /* It is OK for the unwind data to be local to this function,
1711 because the unwind-protect is always executed when this
1712 stack frame is still valid. */
1713 struct gif_unwind_data unwind;
1714 int speccount = specpdl_depth ();
1715
1716 if (!DEVICE_X_P (XDEVICE (device)))
1717 signal_simple_error ("Not an X device", device);
1718
1719 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1720 scr = DefaultScreenOfDisplay (dpy);
1721
1722 memset (&unwind, 0, sizeof (unwind));
1723 unwind.dpy = dpy;
1724 record_unwind_protect (gif_instantiate_unwind, make_opaque_ptr (&unwind));
1725
1726 /* 1. Now decode the data. */
1727
1728 /* #### The GIF routines currently require that you read from a file,
1729 so write out to a temp file. We should change this. */
1730 {
1731 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1732
1733 assert (!NILP (data));
1734
1735 write_lisp_string_to_temp_file (data, unwind.tempfile);
1736 unwind.tempfile_needs_to_be_removed = 1;
1737
1738 /* Then slurp the image into memory, decoding along the way.
1739 The result is the image in a simple one-byte-per-pixel
1740 format (#### the GIF routines only support 8-bit GIFs,
1741 it appears). */
1742 unwind.giffile = DGifOpenFileName (unwind.tempfile);
1743 if (unwind.giffile == NULL)
1744 {
1745 gif_decode_error:
1746 signal_simple_error ("Unable to decode GIF",
1747 build_string (EmacsPrintGifError ()));
1748 }
1749 #if 1
1750 if (our_own_dgif_slurp_from_gif2x11_c(unwind.giffile) != GIF_OK)
1751 #else
1752 /* DGifSlurp() doesn't handle interlaced files. */
1753 if (DGifSlurp (unwind.giffile) != GIF_OK)
1754 #endif
1755 goto gif_decode_error;
1756 }
1757
1758 /* 2. Now allocate the colors for the image. */
1759 {
1760 int i;
1761 ColorMapObject *cmap = unwind.giffile->SColorMap;
1762 /* Just in case the image contains out-of-range pixels, we go
1763 ahead and allocate space for all of them. */
1764 unwind.pixels = (unsigned long *) xmalloc (256 * sizeof (unsigned long));
1765 unwind.npixels = cmap->ColorCount;
1766
1767 for (i = 0; i < 256; i++)
1768 unwind.pixels[i] = 0; /* Use a reasonable color for out of range. */
1769
1770 /* Allocate pixels for the various colors. */
1771 for (i = 0; i < cmap->ColorCount; i++)
1772 {
1773 XColor color;
1774
1775 color.red = cmap->Colors[i].Red << 8;
1776 color.green = cmap->Colors[i].Green << 8;
1777 color.blue = cmap->Colors[i].Blue << 8;
1778 color.flags = DoRed | DoGreen | DoBlue;
1779
1780 allocate_nearest_color (dpy, DefaultColormapOfScreen (scr), &color);
1781 unwind.pixels[i] = color.pixel;
1782 }
1783 }
1784
1785 /* 3. Now create the image */
1786 {
1787 int height = unwind.giffile->SHeight;
1788 int width = unwind.giffile->SWidth;
1789 int depth;
1790 int bitmap_pad;
1791 int i, j;
1792
1793 depth = DefaultDepthOfScreen (scr);
1794
1795 /* first get bitmap_pad (from XPM) */
1796 if (depth > 16)
1797 bitmap_pad = 32;
1798 else if (depth > 8)
1799 bitmap_pad = 16;
1800 else
1801 bitmap_pad = 8;
1802
1803 unwind.ximage = XCreateImage (dpy, DefaultVisualOfScreen (scr),
1804 depth, ZPixmap, 0, 0, width, height,
1805 bitmap_pad, 0);
1806
1807 if (!unwind.ximage)
1808 signal_simple_error ("Unable to create X image struct", instantiator);
1809
1810 /* now that bytes_per_line must have been set properly alloc data */
1811 unwind.ximage->data =
1812 (char *) xmalloc (unwind.ximage->bytes_per_line * height);
1813
1814 /* write the data --
1815 #### XPutPixel() is a client-side-only function but could
1816 still be slow. Another possibility is to just convert to
1817 XPM format and use the Xpm routines, which optimize this
1818 stuff; but it's doubtful that this will be faster in the
1819 long run, what with all the XPM overhead. If this proves
1820 to be a bottleneck here, maybe we should just copy the
1821 optimization routines from XPM (they're in turn mostly
1822 copied from the Xlib source code). */
1823
1824 for (i = 0; i < height; i++)
1825 for (j = 0; j < width; j++)
1826 XPutPixel (unwind.ximage, j, i,
1827 unwind.pixels[(unsigned char)
1828 /* incorrect signed declaration
1829 of RasterBits[] */
1830 (unwind.giffile->SavedImages->
1831 RasterBits[i * width + j])]);
1832 }
1833
1834 /* 4. Now create the pixmap and set up the image instance */
1835 init_image_instance_from_x_image (ii, unwind.ximage, dest_mask,
1836 unwind.pixels, unwind.npixels,
1837 instantiator);
1838 /* Now that we've succeeded, we don't want the pixels
1839 freed right now. They're kept around in the image instance
1840 structure until it's destroyed. */
1841 unwind.npixels = 0;
1842 unbind_to (speccount, Qnil);
1843 }
1844
1845 #endif /* HAVE_GIF */
1846
1847
1848 #ifdef HAVE_PNG
1849
1850 #include <png.h>
1851
1852 /**********************************************************************
1853 * PNG *
1854 **********************************************************************/
1855 static void
1856 png_validate (Lisp_Object instantiator)
1857 {
1858 file_or_data_must_be_present (instantiator);
1859 }
1860
1861 static Lisp_Object
1862 png_normalize (Lisp_Object inst, Lisp_Object console_type)
1863 {
1864 return simple_image_type_normalize (inst, console_type, Qpng);
1865 }
1866
1867 static int
1868 png_possible_dest_types ()
1869 {
1870 return IMAGE_COLOR_PIXMAP_MASK;
1871 }
1872
1873 #if !defined (USE_TEMP_FILES_FOR_IMAGES) && (PNG_LIBPNG_VER >= 87)
1874 struct png_memory_storage
1875 {
1876 Extbyte *bytes; /* The data */
1877 Extcount len; /* How big is it? */
1878 int index; /* Where are we? */
1879 };
1880
1881 static void png_read_from_memory(png_structp png_ptr, png_bytep data,
1882 png_uint_32 length)
1883 {
1884 png_uint_32 check;
1885 struct png_memory_storage *tbr =
1886 (struct png_memory_storage *) png_get_io_ptr (png_ptr);
1887
1888 if (length > (tbr->len - tbr->index))
1889 png_error(png_ptr, "Read Error");
1890 memcpy(data,tbr->bytes + tbr->index,length);
1891 tbr->index = tbr->index + length;
1892 }
1893 #endif /* !USE_TEMP_FILES_FOR_IMAGESS || PNG_LIBPNG_VER >= 87 */
1894
1895 struct png_unwind_data
1896 {
1897 Display *dpy;
1898 FILE *instream;
1899 png_struct *png_ptr;
1900 png_info *info_ptr;
1901 unsigned long *pixels;
1902 int npixels;
1903 XImage *ximage;
1904 char tempfile[50];
1905 int tempfile_needs_to_be_removed;
1906 };
1907
1908 static Lisp_Object
1909 png_instantiate_unwind (Lisp_Object unwind_obj)
1910 {
1911 struct png_unwind_data *data =
1912 (struct png_unwind_data *) get_opaque_ptr (unwind_obj);
1913
1914 free_opaque_ptr (unwind_obj);
1915 if (data->png_ptr)
1916 png_read_destroy (data->png_ptr, data->info_ptr, (png_info *) NULL);
1917 if (data->instream)
1918 fclose (data->instream);
1919 if (data->tempfile_needs_to_be_removed)
1920 unlink (data->tempfile);
1921 if (data->npixels > 0)
1922 {
1923 Screen *scr = DefaultScreenOfDisplay (data->dpy);
1924 Colormap cmap = DefaultColormapOfScreen (scr);
1925 XFreeColors (data->dpy, cmap, data->pixels, data->npixels, 0L);
1926 xfree (data->pixels);
1927 }
1928
1929 if (data->ximage)
1930 {
1931 if (data->ximage->data)
1932 {
1933 xfree (data->ximage->data);
1934 data->ximage->data = 0;
1935 }
1936 XDestroyImage (data->ximage);
1937 }
1938
1939 return Qnil;
1940 }
1941
1942 #define get_png_val(p) _get_png_val (&(p), info_ptr.bit_depth)
1943 png_uint_16
1944 _get_png_val (png_byte **pp, int bit_depth)
1945 {
1946 png_uint_16 c = 0;
1947
1948 if (bit_depth == 16) {
1949 c = (*((*pp)++)) << 8;
1950 }
1951 c |= (*((*pp)++));
1952
1953 return c;
1954 }
1955
1956 static void
1957 png_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1958 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1959 int dest_mask)
1960 {
1961 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1962 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1963 Display *dpy;
1964 Screen *scr;
1965 struct png_unwind_data unwind;
1966 int speccount = specpdl_depth ();
1967
1968 /* PNG variables */
1969 png_struct *png_ptr;
1970 png_info *info_ptr;
1971
1972 if (!DEVICE_X_P (XDEVICE (device)))
1973 signal_simple_error ("Not an X device", device);
1974
1975 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1976 scr = DefaultScreenOfDisplay (dpy);
1977
1978 png_ptr = (png_struct *) xmalloc (sizeof (png_struct));
1979 info_ptr = (png_info *) xmalloc (sizeof (png_info));
1980
1981 memset (&unwind, 0, sizeof (unwind));
1982 unwind.png_ptr = png_ptr;
1983 unwind.info_ptr = info_ptr;
1984 unwind.dpy = dpy;
1985
1986 record_unwind_protect (png_instantiate_unwind, make_opaque_ptr (&unwind));
1987
1988 /* This code is a mixture of stuff from Ben's GIF/JPEG stuff from
1989 this file, example.c from the libpng 0.81 distribution, and the
1990 pngtopnm sources. -WMP-
1991 */
1992 #if defined (USE_TEMP_FILES_FOR_IMAGES) || (PNG_LIBPNG_VER < 87)
1993 /* Write out to a temp file - we really should take the time to
1994 write appropriate memory bound IO stuff, but I am just trying
1995 to get the stupid thing working right now.
1996 */
1997 {
1998 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1999
2000 assert (!NILP (data));
2001
2002 write_lisp_string_to_temp_file (data, unwind.tempfile);
2003 unwind.tempfile_needs_to_be_removed = 1;
2004
2005 if ((unwind.instream = fopen (unwind.tempfile, "rb")) == NULL)
2006 report_file_error ("Opening PNG temp file",
2007 list1 (build_string (unwind.tempfile)));
2008 }
2009 #else
2010 /* Nothing */
2011 #endif
2012
2013 /* Set the jmp_buf reurn context for png_error ... if this returns !0, then
2014 we ran into a problem somewhere, and need to clean up after ourselves. */
2015 if (setjmp (png_ptr->jmpbuf))
2016 {
2017 /* Am I doing enough here? I think so, since most things happen
2018 in png_unwind */
2019 png_read_destroy (png_ptr, info_ptr, (png_info *) NULL);
2020 signal_simple_error ("Error decoding PNG", instantiator);
2021 }
2022
2023 /* Initialize all PNG structures */
2024 png_info_init (info_ptr);
2025 png_read_init (png_ptr);
2026
2027 /* Initialize the IO layer and read in header information */
2028 #if defined (USE_TEMP_FILES_FOR_IMAGES) || (PNG_LIBPNG_VER < 87)
2029 png_init_io (png_ptr, unwind.instream);
2030 #else
2031 {
2032 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
2033 Extbyte *bytes;
2034 Extcount len;
2035 struct png_memory_storage tbr; /* Data to be read */
2036
2037 assert (!NILP (data));
2038
2039 /* #### This is a definite problem under Mule due to the amount of
2040 stack data it might allocate. Need to be able to convert and
2041 write out to a file. */
2042 GET_STRING_BINARY_DATA_ALLOCA (data, bytes, len);
2043 tbr.bytes = bytes;
2044 tbr.len = len;
2045 tbr.index = 0;
2046 png_set_read_fn(png_ptr,(void *) &tbr, png_read_from_memory);
2047 }
2048 #endif
2049
2050 png_read_info (png_ptr, info_ptr);
2051
2052 /* set up the transformations you want. Note that these are
2053 all optional. Only call them if you want them */
2054 /* tell libpng to strip 16 bit depth files down to 8 bits */
2055 if (info_ptr->bit_depth == 16)
2056 png_set_strip_16 (png_ptr);
2057 if (info_ptr->bit_depth < 8)
2058 png_set_packing (png_ptr);
2059 /* ##### Perhaps some way to specify the screen gamma should be in here? */
2060
2061 {
2062 int height = info_ptr->height;
2063 int width = info_ptr->width;
2064 int depth = info_ptr->bit_depth;
2065 int linesize = max (info_ptr->bit_depth >> 3, 1) * width;
2066 int bitmap_pad;
2067 int y;
2068 XColor color;
2069 png_byte *png_pixels;
2070 png_byte **row_pointers;
2071 png_color static_color_cube[216];
2072
2073 /* Wow, allocate all the memory. Truly, exciting. */
2074 unwind.pixels = (unsigned long *) xmalloc (256 * sizeof (unsigned long));
2075 png_pixels = (png_byte *) xmalloc (linesize * height * sizeof (png_byte*));
2076 row_pointers = (png_byte **) xmalloc (height * sizeof (png_byte *));
2077
2078 for (y = 0; y < 256; y++)
2079 unwind.pixels[y] = 0;
2080 for (y = 0; y < height; y++)
2081 row_pointers[y] = png_pixels + (linesize * y);
2082
2083 /* #### This is where we should handle transparency, but I am unsure of
2084 how exactly to get that information right now, in a safe manner. */
2085 #if 0
2086 {
2087 png_color_16 current_background;
2088
2089 /* Some appropriate magic should go here to get the current
2090 buffers (device?) background color and convert it to a
2091 png_color_16 struct */
2092 if (info_ptr->valid & PNG_INFO_bKGD)
2093 png_set_background (png_ptr, &(info_ptr->background), PNG_GAMMA_FILE,
2094 1, 1.0);
2095 else
2096 png_set_background (png_ptr, &current_background, PNG_GAMMA_SCREEN,
2097 0, 1.0);
2098 }
2099 #endif
2100
2101 if ((info_ptr->color_type == PNG_COLOR_TYPE_RGB) ||
2102 (info_ptr->color_type == PNG_COLOR_TYPE_RGB_ALPHA))
2103 {
2104 if (!(info_ptr->valid & PNG_INFO_PLTE))
2105 {
2106 for (y = 0; y < 216; y++)
2107 {
2108 static_color_cube[y].red = (y % 6) * 255.0 / 5;
2109 static_color_cube[y].green = ((y / 6) % 6) * 255.0 / 5;
2110 static_color_cube[y].blue = (y / 36) * 255.0 / 5;
2111 }
2112 png_set_dither (png_ptr, static_color_cube, 216, 216, NULL, 1);
2113 }
2114 else
2115 {
2116 png_set_dither (png_ptr, info_ptr->palette, info_ptr->num_palette,
2117 info_ptr->num_palette, info_ptr->hist, 1);
2118 }
2119 }
2120
2121 png_read_image (png_ptr, row_pointers);
2122 png_read_end (png_ptr, info_ptr);
2123
2124 /* Ok, now we go and allocate all the colors */
2125 if (info_ptr->valid & PNG_INFO_PLTE)
2126 {
2127 unwind.npixels = info_ptr->num_palette;
2128 for (y = 0; y < unwind.npixels; y++)
2129 {
2130 color.red = info_ptr->palette[y].red << 8;
2131 color.green = info_ptr->palette[y].green << 8;
2132 color.blue = info_ptr->palette[y].blue << 8;
2133 color.flags = DoRed | DoGreen | DoBlue;
2134 allocate_nearest_color (dpy, DefaultColormapOfScreen (scr),
2135 &color);
2136 unwind.pixels[y] = color.pixel;
2137 }
2138 }
2139 else
2140 {
2141 unwind.npixels = 216;
2142 for (y = 0; y < 216; y++)
2143 {
2144 color.red = static_color_cube[y].red << 8;
2145 color.green = static_color_cube[y].green << 8;
2146 color.blue = static_color_cube[y].blue << 8;
2147 color.flags = DoRed|DoGreen|DoBlue;
2148 allocate_nearest_color (dpy, DefaultColormapOfScreen (scr),
2149 &color);
2150 unwind.pixels[y] = color.pixel;
2151 }
2152 }
2153
2154 #ifdef PNG_SHOW_COMMENTS
2155 /* ####
2156 * I turn this off by default now, because the !%^@#!% comments
2157 * show up every time the image is instantiated, which can get
2158 * really really annoying. There should be some way to pass this
2159 * type of data down into the glyph code, where you can get to it
2160 * from lisp anyway. - WMP
2161 */
2162 {
2163 int i;
2164
2165 for (i = 0 ; i < info_ptr->num_text ; i++)
2166 {
2167 /* How paranoid do I have to be about no trailing NULLs, and
2168 using (int)info_ptr->text[i].text_length, and strncpy and a temp
2169 string somewhere? */
2170
2171 warn_when_safe (Qpng, Qinfo, "%s - %s",
2172 info_ptr->text[i].key,
2173 info_ptr->text[i].text);
2174 }
2175 }
2176 #endif
2177
2178 /* Now create the image */
2179
2180 depth = DefaultDepthOfScreen (scr);
2181
2182 /* first get bitmap_pad (from XPM) */
2183 if (depth > 16)
2184 bitmap_pad = 32;
2185 else if (depth > 8)
2186 bitmap_pad = 16;
2187 else
2188 bitmap_pad = 8;
2189
2190 unwind.ximage = XCreateImage (dpy, DefaultVisualOfScreen (scr),
2191 depth, ZPixmap, 0, 0, width, height,
2192 bitmap_pad, 0);
2193
2194 if (!unwind.ximage)
2195 signal_simple_error ("Unable to create X image struct",
2196 instantiator);
2197
2198 /* now that bytes_per_line must have been set properly alloc data */
2199 unwind.ximage->data = (char *) xmalloc (unwind.ximage->bytes_per_line *
2200 height);
2201
2202 {
2203 int i, j;
2204 for (i = 0; i < height; i++)
2205 for (j = 0; j < width; j++)
2206 XPutPixel (unwind.ximage, j, i,
2207 unwind.pixels[png_pixels[i * width + j]]);
2208 }
2209
2210 xfree (row_pointers);
2211 xfree (png_pixels);
2212 }
2213
2214 init_image_instance_from_x_image (ii, unwind.ximage, dest_mask,
2215 unwind.pixels, unwind.npixels,
2216 instantiator);
2217
2218 /* This will clean up everything else. */
2219 unwind.npixels = 0;
2220 unbind_to (speccount, Qnil);
2221 }
2222
2223 #endif /* HAVE_PNG */
2224
2225
2226 #ifdef HAVE_TIFF
2227
2228 /**********************************************************************
2229 * TIFF *
2230 **********************************************************************/
2231 static void
2232 tiff_validate (Lisp_Object instantiator)
2233 {
2234 file_or_data_must_be_present (instantiator);
2235 }
2236
2237 static Lisp_Object
2238 tiff_normalize (Lisp_Object inst, Lisp_Object console_type)
2239 {
2240 signal_simple_error ("No TIFF support yet", inst);
2241 return Qnil;
2242 }
2243
2244 static int
2245 tiff_possible_dest_types ()
2246 {
2247 return IMAGE_COLOR_PIXMAP_MASK;
2248 }
2249
2250 static void
2251 tiff_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2252 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2253 int dest_mask)
2254 {
2255 abort ();
2256 }
2257
2258 #endif /* HAVE_TIFF */
2259
2260
2261 #ifdef HAVE_XPM
2262
2263 /**********************************************************************
2264 * XPM *
2265 **********************************************************************/
2266
2267 static void
2268 check_valid_xpm_color_symbols (Lisp_Object data)
2269 {
2270 Lisp_Object rest;
2271
2272 for (rest = data; !NILP (rest); rest = XCDR (rest))
2273 {
2274 if (!CONSP (rest) ||
2275 !CONSP (XCAR (rest)) ||
2276 !STRINGP (XCAR (XCAR (rest))) ||
2277 (!STRINGP (XCDR (XCAR (rest))) &&
2278 !COLOR_SPECIFIERP (XCDR (XCAR (rest)))))
2279 signal_simple_error ("Invalid color symbol alist", data);
2280 }
2281 }
2282
2283 static void
2284 xpm_validate (Lisp_Object instantiator)
2285 {
2286 file_or_data_must_be_present (instantiator);
2287 }
2288
2289 static Lisp_Object
2290 pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid)
2291 {
2292 char **data;
2293 int result;
2294
2295 result = XpmReadFileToData ((char *) string_data (XSTRING (name)), &data);
2296
2297 if (result == XpmSuccess)
2298 {
2299 Lisp_Object retval = Qnil;
2300 struct buffer *old_buffer = current_buffer;
2301 Lisp_Object temp_buffer =
2302 Fget_buffer_create (build_string (" *pixmap conversion*"));
2303 int elt;
2304 int height, width, ncolors;
2305 struct gcpro gcpro1, gcpro2, gcpro3;
2306 int speccount = specpdl_depth ();
2307
2308 GCPRO3 (name, retval, temp_buffer);
2309
2310 specbind (Qinhibit_quit, Qt);
2311 set_buffer_internal (XBUFFER (temp_buffer));
2312 Ferase_buffer (Fcurrent_buffer ());
2313
2314 buffer_insert_c_string (current_buffer, "/* XPM */\r");
2315 buffer_insert_c_string (current_buffer, "static char *pixmap[] = {\r");
2316
2317 sscanf (data[0], "%d %d %d", &height, &width, &ncolors);
2318 for (elt = 0; elt <= width + ncolors; elt++)
2319 {
2320 buffer_insert_c_string (current_buffer, "\"");
2321 buffer_insert_c_string (current_buffer, data[elt]);
2322
2323 if (elt < width + ncolors)
2324 buffer_insert_c_string (current_buffer, "\",\r");
2325 else
2326 buffer_insert_c_string (current_buffer, "\"};\r");
2327 }
2328
2329 retval = Fbuffer_substring (Qnil, Qnil, Fcurrent_buffer ());
2330 XpmFree (data);
2331
2332 set_buffer_internal (old_buffer);
2333 unbind_to (speccount, Qnil);
2334
2335 RETURN_UNGCPRO (retval);
2336 }
2337
2338 switch (result)
2339 {
2340 case XpmFileInvalid:
2341 {
2342 if (ok_if_data_invalid)
2343 return Qt;
2344 signal_simple_error ("invalid XPM data in file", name);
2345 }
2346 case XpmNoMemory:
2347 {
2348 signal_double_file_error ("Reading pixmap file",
2349 "out of memory", name);
2350 }
2351 case XpmOpenFailed:
2352 {
2353 /* should never happen? */
2354 signal_double_file_error ("Opening pixmap file",
2355 "no such file or directory", name);
2356 }
2357 default:
2358 {
2359 signal_double_file_error_2 ("Parsing pixmap file",
2360 "unknown error code",
2361 make_int (result), name);
2362 break;
2363 }
2364 }
2365
2366 return Qnil; /* not reached */
2367 }
2368
2369 Lisp_Object Vxpm_color_symbols;
2370
2371 static Lisp_Object
2372 evaluate_xpm_color_symbols (void)
2373 {
2374 Lisp_Object rest, results = Qnil;
2375 struct gcpro gcpro1, gcpro2;
2376
2377 GCPRO2 (rest, results);
2378 for (rest = Vxpm_color_symbols; !NILP (rest); rest = XCDR (rest))
2379 {
2380 Lisp_Object name, value, cons;
2381
2382 CHECK_CONS (rest);
2383 cons = XCAR (rest);
2384 CHECK_CONS (cons);
2385 name = XCAR (cons);
2386 CHECK_STRING (name);
2387 value = XCDR (cons);
2388 CHECK_CONS (value);
2389 value = XCAR (value);
2390 value = Feval (value);
2391 if (NILP (value))
2392 continue;
2393 if (!STRINGP (value) && !COLOR_SPECIFIERP (value))
2394 signal_simple_error
2395 ("Result from xpm-color-symbols eval must be nil, string, or color",
2396 value);
2397 results = Fcons (Fcons (name, value), results);
2398 }
2399 UNGCPRO; /* no more evaluation */
2400 return results;
2401 }
2402
2403 static Lisp_Object
2404 xpm_normalize (Lisp_Object inst, Lisp_Object console_type)
2405 {
2406 Lisp_Object file = Qnil;
2407 Lisp_Object color_symbols;
2408 struct gcpro gcpro1, gcpro2;
2409 Lisp_Object alist = Qnil;
2410
2411 GCPRO2 (file, alist);
2412
2413 /* Now, convert any file data into inline data. At the end of this,
2414 `data' will contain the inline data (if any) or Qnil, and
2415 `file' will contain the name this data was derived from (if
2416 known) or Qnil.
2417
2418 Note that if we cannot generate any regular inline data, we
2419 skip out. */
2420
2421 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data);
2422
2423 if (CONSP (file)) /* failure locating filename */
2424 signal_double_file_error ("Opening pixmap file",
2425 "no such file or directory",
2426 Fcar (file));
2427
2428 color_symbols = find_keyword_in_vector_or_given (inst, Q_color_symbols,
2429 Qunbound);
2430
2431 if (NILP (file) && !UNBOUNDP (color_symbols))
2432 /* no conversion necessary */
2433 RETURN_UNGCPRO (inst);
2434
2435 alist = tagged_vector_to_alist (inst);
2436
2437 if (!NILP (file))
2438 {
2439 Lisp_Object data = pixmap_to_lisp_data (file, 0);
2440 alist = remassq_no_quit (Q_file, alist);
2441 /* there can't be a :data at this point. */
2442 alist = Fcons (Fcons (Q_file, file),
2443 Fcons (Fcons (Q_data, data), alist));
2444 }
2445
2446 if (UNBOUNDP (color_symbols))
2447 {
2448 color_symbols = evaluate_xpm_color_symbols ();
2449 alist = Fcons (Fcons (Q_color_symbols, color_symbols),
2450 alist);
2451 }
2452
2453 {
2454 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
2455 free_alist (alist);
2456 RETURN_UNGCPRO (result);
2457 }
2458 }
2459
2460 static int
2461 xpm_possible_dest_types ()
2462 {
2463 return IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK |
2464 IMAGE_POINTER_MASK;
2465 }
2466
2467 /* xpm 3.2g and better has XpmCreatePixmapFromBuffer()...
2468 There was no version number in xpm.h before 3.3, but this should do.
2469 */
2470 #if (XpmVersion >= 3) || defined(XpmExactColors)
2471 # define XPM_DOES_BUFFERS
2472 #endif
2473
2474 #ifndef XPM_DOES_BUFFERS
2475 Your version of XPM is too old. You cannot compile with it.
2476 Upgrade to version 3.2g or better or compile with --with-xpm=no.
2477 #endif /* !XPM_DOES_BUFFERS */
2478
2479 static XpmColorSymbol *
2480 extract_xpm_color_names (XpmAttributes *xpmattrs, Lisp_Object device,
2481 Lisp_Object color_symbol_alist)
2482 {
2483 /* This function can GC */
2484 Screen *xs = LISP_DEVICE_TO_X_SCREEN (device);
2485 Display *dpy = DisplayOfScreen (xs);
2486 Colormap cmap = DefaultColormapOfScreen (xs);
2487 XColor color;
2488 Lisp_Object rest;
2489 Lisp_Object results = Qnil;
2490 int i;
2491 XpmColorSymbol *symbols;
2492 struct gcpro gcpro1, gcpro2;
2493
2494 GCPRO2 (results, device);
2495
2496 /* We built up results to be (("name" . #<color>) ...) so that if an
2497 error happens we don't lose any malloc()ed data, or more importantly,
2498 leave any pixels allocated in the server. */
2499 i = 0;
2500 LIST_LOOP (rest, color_symbol_alist)
2501 {
2502 Lisp_Object cons = XCAR (rest);
2503 Lisp_Object name = XCAR (cons);
2504 Lisp_Object value = XCDR (cons);
2505 if (NILP (value))
2506 continue;
2507 if (STRINGP (value))
2508 value =
2509 Fmake_color_instance
2510 (value, device, encode_error_behavior_flag (ERROR_ME_NOT));
2511 else
2512 {
2513 assert (COLOR_SPECIFIERP (value));
2514 value = Fspecifier_instance (value, device, Qnil, Qnil);
2515 }
2516 if (NILP (value))
2517 continue;
2518 results = noseeum_cons (noseeum_cons (name, value), results);
2519 i++;
2520 }
2521 UNGCPRO; /* no more evaluation */
2522
2523 if (i == 0) return 0;
2524
2525 symbols = (XpmColorSymbol *) xmalloc (i * sizeof (XpmColorSymbol));
2526 xpmattrs->valuemask |= XpmColorSymbols;
2527 xpmattrs->colorsymbols = symbols;
2528 xpmattrs->numsymbols = i;
2529
2530 while (--i >= 0)
2531 {
2532 Lisp_Object cons = XCAR (results);
2533 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (XCDR (cons)));
2534 /* Duplicate the pixel value so that we still have a lock on it if
2535 the pixel we were passed is later freed. */
2536 if (! XAllocColor (dpy, cmap, &color))
2537 abort (); /* it must be allocable since we're just duplicating it */
2538
2539 symbols [i].name = (char *) string_data (XSTRING (XCAR (cons)));
2540 symbols [i].pixel = color.pixel;
2541 symbols [i].value = 0;
2542 free_cons (XCONS (cons));
2543 cons = results;
2544 results = XCDR (results);
2545 free_cons (XCONS (cons));
2546 }
2547 return symbols;
2548 }
2549
2550 static void
2551 xpm_free (XpmAttributes *xpmattrs)
2552 {
2553 /* Could conceivably lose if XpmXXX returned an error without first
2554 initializing this structure, if we didn't know that initializing it
2555 to all zeros was ok (and also that it's ok to call XpmFreeAttributes()
2556 multiple times, since it zeros slots as it frees them...) */
2557 XpmFreeAttributes (xpmattrs);
2558 }
2559
2560 static void
2561 xpm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2562 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2563 int dest_mask)
2564 {
2565 /* This function can GC */
2566 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2567 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
2568 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
2569 Display *dpy;
2570 Screen *xs;
2571 Pixmap pixmap;
2572 Pixmap mask = 0;
2573 XpmAttributes xpmattrs;
2574 int result;
2575 XpmColorSymbol *color_symbols;
2576 Lisp_Object color_symbol_alist = find_keyword_in_vector (instantiator,
2577 Q_color_symbols);
2578 enum image_instance_type type;
2579 int force_mono;
2580 unsigned int w, h;
2581
2582 if (!DEVICE_X_P (XDEVICE (device)))
2583 signal_simple_error ("Not an X device", device);
2584
2585 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2586 xs = DefaultScreenOfDisplay (dpy);
2587
2588 if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
2589 type = IMAGE_COLOR_PIXMAP;
2590 else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
2591 type = IMAGE_MONO_PIXMAP;
2592 else if (dest_mask & IMAGE_POINTER_MASK)
2593 type = IMAGE_POINTER;
2594 else
2595 incompatible_image_types (instantiator, dest_mask,
2596 IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
2597 | IMAGE_POINTER_MASK);
2598 force_mono = (type != IMAGE_COLOR_PIXMAP);
2599
2600 x_initialize_pixmap_image_instance (ii, type);
2601
2602 assert (!NILP (data));
2603
2604 retry:
2605
2606 memset (&xpmattrs, 0, sizeof (xpmattrs)); /* want XpmInitAttributes() */
2607 xpmattrs.valuemask = XpmReturnPixels;
2608 if (force_mono)
2609 {
2610 /* Without this, we get a 1-bit version of the color image, which
2611 isn't quite right. With this, we get the mono image, which might
2612 be very different looking. */
2613 xpmattrs.valuemask |= XpmColorKey;
2614 xpmattrs.color_key = XPM_MONO;
2615 xpmattrs.depth = 1;
2616 xpmattrs.valuemask |= XpmDepth;
2617 }
2618 else
2619 {
2620 xpmattrs.closeness = 65535;
2621 xpmattrs.valuemask |= XpmCloseness;
2622 }
2623
2624 color_symbols = extract_xpm_color_names (&xpmattrs, device,
2625 color_symbol_alist);
2626
2627 result = XpmCreatePixmapFromBuffer (dpy,
2628 RootWindowOfScreen (xs),
2629 (char *) string_data (XSTRING (data)),
2630 &pixmap, &mask, &xpmattrs);
2631
2632 if (color_symbols)
2633 {
2634 xfree (color_symbols);
2635 xpmattrs.colorsymbols = 0; /* in case XpmFreeAttr is too smart... */
2636 xpmattrs.numsymbols = 0;
2637 }
2638
2639 switch (result)
2640 {
2641 case XpmSuccess:
2642 break;
2643 case XpmFileInvalid:
2644 {
2645 xpm_free (&xpmattrs);
2646 signal_simple_error ("invalid XPM data", data);
2647 }
2648 case XpmColorFailed:
2649 case XpmColorError:
2650 {
2651 xpm_free (&xpmattrs);
2652 if (force_mono)
2653 {
2654 /* second time; blow out. */
2655 signal_double_file_error ("Reading pixmap data",
2656 "color allocation failed",
2657 data);
2658 }
2659 else
2660 {
2661 if (! (dest_mask & IMAGE_MONO_PIXMAP_MASK))
2662 {
2663 /* second time; blow out. */
2664 signal_double_file_error ("Reading pixmap data",
2665 "color allocation failed",
2666 data);
2667 }
2668 force_mono = 1;
2669 IMAGE_INSTANCE_TYPE (ii) = IMAGE_MONO_PIXMAP;
2670 goto retry;
2671 }
2672 }
2673 case XpmNoMemory:
2674 {
2675 xpm_free (&xpmattrs);
2676 signal_double_file_error ("Parsing pixmap data",
2677 "out of memory", data);
2678 }
2679 default:
2680 {
2681 xpm_free (&xpmattrs);
2682 signal_double_file_error_2 ("Parsing pixmap data",
2683 "unknown error code",
2684 make_int (result), data);
2685 }
2686 }
2687
2688 w = xpmattrs.width;
2689 h = xpmattrs.height;
2690
2691 {
2692 int npixels = xpmattrs.npixels;
2693 Pixel *pixels = 0;
2694
2695 if (npixels != 0)
2696 {
2697 pixels = xmalloc (npixels * sizeof (Pixel));
2698 memcpy (pixels, xpmattrs.pixels, npixels * sizeof (Pixel));
2699 }
2700 else
2701 pixels = 0;
2702
2703 IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
2704 IMAGE_INSTANCE_X_MASK (ii) = mask;
2705 IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
2706 IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
2707 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = w;
2708 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = h;
2709 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
2710 find_keyword_in_vector (instantiator, Q_file);
2711 }
2712
2713 switch (type)
2714 {
2715 case IMAGE_MONO_PIXMAP:
2716 break;
2717
2718 case IMAGE_COLOR_PIXMAP:
2719 {
2720 /* XpmReadFileToPixmap() doesn't return the depth (bogus!) so
2721 we need to get it ourself. (No, xpmattrs.depth is not it;
2722 that's an input slot, not output.) We could just assume
2723 that it has the same depth as the root window, but some
2724 devices allow more than one depth, so that isn't
2725 necessarily correct (I guess?) */
2726 Window root;
2727 int x, y;
2728 unsigned int w2, h2, bw;
2729
2730 unsigned int d;
2731
2732 if (!XGetGeometry (dpy, pixmap, &root, &x, &y, &w2, &h2, &bw, &d))
2733 abort ();
2734 if (w != w2 || h != h2)
2735 abort ();
2736
2737 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = d;
2738 }
2739 break;
2740
2741 case IMAGE_POINTER:
2742 {
2743 int npixels = xpmattrs.npixels;
2744 Pixel *pixels = xpmattrs.pixels;
2745 XColor fg, bg;
2746 int i;
2747 int xhot = 0, yhot = 0;
2748
2749 if (xpmattrs.valuemask & XpmHotspot)
2750 {
2751 xhot = xpmattrs.x_hotspot;
2752 XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii), xpmattrs.x_hotspot);
2753 }
2754 if (xpmattrs.valuemask & XpmHotspot)
2755 {
2756 yhot = xpmattrs.y_hotspot;
2757 XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii), xpmattrs.y_hotspot);
2758 }
2759 check_pointer_sizes (xs, w, h, instantiator);
2760
2761 /* If the loaded pixmap has colors allocated (meaning it came from an
2762 XPM file), then use those as the default colors for the cursor we
2763 create. Otherwise, default to pointer_fg and pointer_bg.
2764 */
2765 if (npixels >= 2)
2766 {
2767 /* With an XBM file, it's obvious which bit is foreground
2768 and which is background, or rather, it's implicit: in
2769 an XBM file, a 1 bit is foreground, and a 0 bit is
2770 background.
2771
2772 XCreatePixmapCursor() assumes this property of the
2773 pixmap it is called with as well; the `foreground'
2774 color argument is used for the 1 bits.
2775
2776 With an XPM file, it's tricker, since the elements of
2777 the pixmap don't represent FG and BG, but are actual
2778 pixel values. So we need to figure out which of those
2779 pixels is the foreground color and which is the
2780 background. We do it by comparing RGB and assuming
2781 that the darker color is the foreground. This works
2782 with the result of xbmtopbm|ppmtoxpm, at least.
2783
2784 It might be nice if there was some way to tag the
2785 colors in the XPM file with whether they are the
2786 foreground - perhaps with logical color names somehow?
2787
2788 Once we have decided which color is the foreground, we
2789 need to ensure that that color corresponds to a `1' bit
2790 in the Pixmap. The XPM library wrote into the (1-bit)
2791 pixmap with XPutPixel, which will ignore all but the
2792 least significant bit.
2793
2794 This means that a 1 bit in the image corresponds to
2795 `fg' only if `fg.pixel' is odd.
2796
2797 (This also means that the image will be all the same
2798 color if both `fg' and `bg' are odd or even, but we can
2799 safely assume that that won't happen if the XPM file is
2800 sensible I think.)
2801
2802 The desired result is that the image use `1' to
2803 represent the foreground color, and `0' to represent
2804 the background color. So, we may need to invert the
2805 image to accomplish this; we invert if fg is
2806 odd. (Remember that WhitePixel and BlackPixel are not
2807 necessarily 1 and 0 respectively, though I think it
2808 might be safe to assume that one of them is always 1
2809 and the other is always 0. We also pretty much need to
2810 assume that one is even and the other is odd.)
2811 */
2812
2813 fg.pixel = pixels[0]; /* pick a pixel at random. */
2814 bg.pixel = fg.pixel;
2815 for (i = 1; i < npixels; i++) /* Look for an "other" pixel value.*/
2816 {
2817 bg.pixel = pixels[i];
2818 if (fg.pixel != bg.pixel)
2819 break;
2820 }
2821
2822 /* If (fg.pixel == bg.pixel) then probably something has
2823 gone wrong, but I don't think signalling an error would
2824 be appropriate. */
2825
2826 XQueryColor (dpy, DefaultColormapOfScreen (xs), &fg);
2827 XQueryColor (dpy, DefaultColormapOfScreen (xs), &bg);
2828
2829 /* If the foreground is lighter than the background, swap them.
2830 (This occurs semi-randomly, depending on the ordering of the
2831 color list in the XPM file.)
2832 */
2833 {
2834 unsigned short fg_total = ((fg.red / 3) + (fg.green / 3)
2835 + (fg.blue / 3));
2836 unsigned short bg_total = ((bg.red / 3) + (bg.green / 3)
2837 + (bg.blue / 3));
2838 if (fg_total > bg_total)
2839 {
2840 XColor swap;
2841 swap = fg;
2842 fg = bg;
2843 bg = swap;
2844 }
2845 }
2846
2847 /* If the fg pixel corresponds to a `0' in the bitmap, invert it.
2848 (This occurs (only?) on servers with Black=0, White=1.)
2849 */
2850 if ((fg.pixel & 1) == 0)
2851 {
2852 XGCValues gcv;
2853 GC gc;
2854 gcv.function = GXxor;
2855 gcv.foreground = 1;
2856 gc = XCreateGC (dpy, pixmap, (GCFunction | GCForeground),
2857 &gcv);
2858 XFillRectangle (dpy, pixmap, gc, 0, 0, w, h);
2859 XFreeGC (dpy, gc);
2860 }
2861 }
2862 else
2863 {
2864 generate_cursor_fg_bg (device, &pointer_fg, &pointer_bg,
2865 &fg, &bg);
2866 IMAGE_INSTANCE_PIXMAP_FG (ii) = pointer_fg;
2867 IMAGE_INSTANCE_PIXMAP_BG (ii) = pointer_bg;
2868 }
2869
2870 IMAGE_INSTANCE_X_CURSOR (ii) =
2871 XCreatePixmapCursor
2872 (dpy, pixmap, mask, &fg, &bg, xhot, yhot);
2873 }
2874
2875 break;
2876
2877 default:
2878 abort ();
2879 }
2880
2881 xpm_free (&xpmattrs); /* after we've read pixels and hotspot */
2882 }
2883
2884 #endif /* HAVE_XPM */
2885
2886
2887 #ifdef HAVE_XFACE
2888
2889 /**********************************************************************
2890 * X-Face *
2891 **********************************************************************/
2892
2893 static void
2894 xface_validate (Lisp_Object instantiator)
2895 {
2896 file_or_data_must_be_present (instantiator);
2897 }
2898
2899 static Lisp_Object
2900 xface_normalize (Lisp_Object inst, Lisp_Object console_type)
2901 {
2902 Lisp_Object file = Qnil, mask_file = Qnil;
2903 struct gcpro gcpro1, gcpro2, gcpro3;
2904 Lisp_Object alist = Qnil;
2905
2906 GCPRO3 (file, mask_file, alist);
2907
2908 /* Now, convert any file data into inline data for both the regular
2909 data and the mask data. At the end of this, `data' will contain
2910 the inline data (if any) or Qnil, and `file' will contain
2911 the name this data was derived from (if known) or Qnil.
2912 Likewise for `mask_file' and `mask_data'.
2913
2914 Note that if we cannot generate any regular inline data, we
2915 skip out. */
2916
2917 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data);
2918 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
2919 Q_mask_data);
2920
2921 if (CONSP (file)) /* failure locating filename */
2922 signal_double_file_error ("Opening bitmap file",
2923 "no such file or directory",
2924 Fcar (file));
2925
2926 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
2927 RETURN_UNGCPRO (inst);
2928
2929 alist = tagged_vector_to_alist (inst);
2930
2931 {
2932 Lisp_Object data = make_string_from_file (file);
2933 alist = remassq_no_quit (Q_file, alist);
2934 /* there can't be a :data at this point. */
2935 alist = Fcons (Fcons (Q_file, file),
2936 Fcons (Fcons (Q_data, data), alist));
2937 }
2938
2939 alist = xbm_mask_file_munging (alist, file, mask_file);
2940
2941 {
2942 Lisp_Object result = alist_to_tagged_vector (Qxface, alist);
2943 free_alist (alist);
2944 RETURN_UNGCPRO (result);
2945 }
2946 }
2947
2948 static int
2949 xface_possible_dest_types ()
2950 {
2951 return IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK |
2952 IMAGE_POINTER_MASK;
2953 }
2954
2955 #if defined(EXTERN)
2956 /* This is about to get redefined! */
2957 #undef EXTERN
2958 #endif
2959 /* We have to define SYSV32 so that compface.h includes string.h
2960 instead of strings.h. */
2961 #define SYSV32
2962 #include <compface.h>
2963 /* JMP_BUF cannot be used here because if it doesn't get defined
2964 to jmp_buf we end up with a conflicting type error with the
2965 definition in compface.h */
2966 extern jmp_buf comp_env;
2967 #undef SYSV32
2968
2969 static void
2970 xface_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2971 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2972 int dest_mask)
2973 {
2974 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
2975 int i, stattis;
2976 char *p, *bits, *bp;
2977 CONST char *emsg = 0;
2978 CONST char *dstring;
2979
2980 assert (!NILP (data));
2981
2982 GET_C_STRING_BINARY_DATA_ALLOCA (data, dstring);
2983
2984 if ((p = strchr (dstring, ':')))
2985 {
2986 dstring = p + 1;
2987 }
2988
2989 /* Must use setjmp not SETJMP because we used jmp_buf above not JMP_BUF */
2990 if (!(stattis = setjmp (comp_env)))
2991 {
2992 UnCompAll ((char *) dstring);
2993 UnGenFace ();
2994 }
2995
2996 switch (stattis)
2997 {
2998 case -2:
2999 emsg = "uncompface: internal error";
3000 break;
3001 case -1:
3002 emsg = "uncompface: insufficient or invalid data";
3003 break;
3004 case 1:
3005 emsg = "uncompface: excess data ignored";
3006 break;
3007 }
3008
3009 if (emsg)
3010 signal_simple_error_2 (emsg, data, Qimage);
3011
3012 bp = bits = (char *) alloca (PIXELS / 8);
3013
3014 /* the compface library exports char F[], which uses a single byte per
3015 pixel to represent a 48x48 bitmap. Yuck. */
3016 for (i = 0, p = F; i < (PIXELS / 8); ++i)
3017 {
3018 int n, b;
3019 /* reverse the bit order of each byte... */
3020 for (b = n = 0; b < 8; ++b)
3021 {
3022 n |= ((*p++) << b);
3023 }
3024 *bp++ = (char) n;
3025 }
3026
3027 xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
3028 pointer_bg, dest_mask, 48, 48, bits);
3029 }
3030
3031 #endif /* HAVE_XFACE */
3032
3033
3034 /**********************************************************************
3035 * Autodetect *
3036 **********************************************************************/
3037
3038 static void
3039 autodetect_validate (Lisp_Object instantiator)
3040 {
3041 data_must_be_present (instantiator);
3042 }
3043
3044 static Lisp_Object
3045 autodetect_normalize (Lisp_Object instantiator, Lisp_Object console_type)
3046 {
3047 Lisp_Object file = find_keyword_in_vector (instantiator, Q_data);
3048 Lisp_Object filename = Qnil;
3049 Lisp_Object data = Qnil;
3050 struct gcpro gcpro1, gcpro2, gcpro3;
3051 Lisp_Object alist = Qnil;
3052
3053 GCPRO3 (filename, data, alist);
3054
3055 if (NILP (file)) /* no conversion necessary */
3056 RETURN_UNGCPRO (instantiator);
3057
3058 alist = tagged_vector_to_alist (instantiator);
3059
3060 filename = locate_pixmap_file (file);
3061 if (!NILP (filename))
3062 {
3063 int xhot, yhot;
3064 /* #### Apparently some versions of XpmReadFileToData, which is
3065 called by pixmap_to_lisp_data, don't return an error value
3066 if the given file is not a valid XPM file. Instead, they
3067 just seg fault. It is definitely caused by passing a
3068 bitmap. To try and avoid this we check for bitmaps first. */
3069
3070 data = bitmap_to_lisp_data (filename, &xhot, &yhot, 1);
3071
3072 if (!EQ (data, Qt))
3073 {
3074 alist = remassq_no_quit (Q_data, alist);
3075 alist = Fcons (Fcons (Q_file, filename),
3076 Fcons (Fcons (Q_data, data), alist));
3077 if (xhot != -1)
3078 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
3079 alist);
3080 if (yhot != -1)
3081 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
3082 alist);
3083
3084 alist = xbm_mask_file_munging (alist, filename, Qnil);
3085
3086 {
3087 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
3088 free_alist (alist);
3089 RETURN_UNGCPRO (result);
3090 }
3091 }
3092
3093 #ifdef HAVE_XPM
3094 data = pixmap_to_lisp_data (filename, 1);
3095
3096 if (!EQ (data, Qt))
3097 {
3098 alist = remassq_no_quit (Q_data, alist);
3099 alist = Fcons (Fcons (Q_file, filename),
3100 Fcons (Fcons (Q_data, data), alist));
3101 alist = Fcons (Fcons (Q_color_symbols,
3102 evaluate_xpm_color_symbols ()),
3103 alist);
3104 {
3105 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
3106 free_alist (alist);
3107 RETURN_UNGCPRO (result);
3108 }
3109 }
3110 #endif
3111 }
3112
3113 /* If we couldn't convert it, just put it back as it is.
3114 We might try to further frob it later as a cursor-font
3115 specification. (We can't do that now because we don't know
3116 what dest-types it's going to be instantiated into.) */
3117 {
3118 Lisp_Object result = alist_to_tagged_vector (Qautodetect, alist);
3119 free_alist (alist);
3120 RETURN_UNGCPRO (result);
3121 }
3122 }
3123
3124 static int
3125 autodetect_possible_dest_types ()
3126 {
3127 return IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK |
3128 IMAGE_POINTER_MASK | IMAGE_TEXT_MASK;
3129 }
3130
3131 static void
3132 autodetect_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
3133 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
3134 int dest_mask)
3135 {
3136 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
3137 struct gcpro gcpro1, gcpro2, gcpro3;
3138 Lisp_Object alist = Qnil;
3139 Lisp_Object result = Qnil;
3140 int is_cursor_font = 0;
3141
3142 GCPRO3 (data, alist, result);
3143
3144 alist = tagged_vector_to_alist (instantiator);
3145 if (dest_mask & IMAGE_POINTER_MASK)
3146 {
3147 CONST char *name_ext;
3148 GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext);
3149 if (XmuCursorNameToIndex (name_ext) != -1)
3150 {
3151 result = alist_to_tagged_vector (Qcursor_font, alist);
3152 is_cursor_font = 1;
3153 }
3154 }
3155
3156 if (!is_cursor_font)
3157 result = alist_to_tagged_vector (Qstring, alist);
3158 free_alist (alist);
3159
3160 if (is_cursor_font)
3161 cursor_font_instantiate (image_instance, result, pointer_fg,
3162 pointer_bg, dest_mask);
3163 else
3164 string_instantiate (image_instance, result, pointer_fg,
3165 pointer_bg, dest_mask);
3166
3167 UNGCPRO;
3168 }
3169
3170
3171 /**********************************************************************
3172 * Font *
3173 **********************************************************************/
3174
3175 static void
3176 font_validate (Lisp_Object instantiator)
3177 {
3178 data_must_be_present (instantiator);
3179 }
3180
3181 /* XmuCvtStringToCursor is bogus in the following ways:
3182
3183 - When it can't convert the given string to a real cursor, it will
3184 sometimes return a "success" value, after triggering a BadPixmap
3185 error. It then gives you a cursor that will itself generate BadCursor
3186 errors. So we install this error handler to catch/notice the X error
3187 and take that as meaning "couldn't convert."
3188
3189 - When you tell it to find a cursor file that doesn't exist, it prints
3190 an error message on stderr. You can't make it not do that.
3191
3192 - Also, using Xmu means we can't properly hack Lisp_Image_Instance
3193 objects, or XPM files, or $XBMLANGPATH.
3194 */
3195
3196 /* Duplicate the behavior of XmuCvtStringToCursor() to bypass its bogusness. */
3197
3198 static int XLoadFont_got_error;
3199
3200 static int
3201 XLoadFont_error_handler (Display *dpy, XErrorEvent *xerror)
3202 {
3203 XLoadFont_got_error = 1;
3204 return 0;
3205 }
3206
3207 static Font
3208 safe_XLoadFont (Display *dpy, char *name)
3209 {
3210 Font font;
3211 int (*old_handler) (Display *, XErrorEvent *);
3212 XLoadFont_got_error = 0;
3213 XSync (dpy, 0);
3214 old_handler = XSetErrorHandler (XLoadFont_error_handler);
3215 font = XLoadFont (dpy, name);
3216 XSync (dpy, 0);
3217 XSetErrorHandler (old_handler);
3218 if (XLoadFont_got_error) return 0;
3219 return font;
3220 }
3221
3222 static int
3223 font_possible_dest_types ()
3224 {
3225 return IMAGE_POINTER_MASK;
3226 }
3227
3228 static void
3229 font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
3230 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
3231 int dest_mask)
3232 {
3233 /* This function can GC */
3234 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
3235 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
3236 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
3237 Display *dpy;
3238 XColor fg, bg;
3239 Font source, mask;
3240 char source_name[MAXPATHLEN], mask_name[MAXPATHLEN], dummy;
3241 int source_char, mask_char;
3242 int count;
3243 Lisp_Object foreground, background;
3244
3245 if (!DEVICE_X_P (XDEVICE (device)))
3246 signal_simple_error ("Not an X device", device);
3247
3248 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
3249
3250 if (!STRINGP (data) ||
3251 strncmp ("FONT ", (char *) string_data (XSTRING (data)), 5))
3252 signal_simple_error ("Invalid font-glyph instantiator",
3253 instantiator);
3254
3255 if (!(dest_mask & IMAGE_POINTER_MASK))
3256 incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
3257
3258 foreground = find_keyword_in_vector (instantiator, Q_foreground);
3259 if (NILP (foreground))
3260 foreground = pointer_fg;
3261 background = find_keyword_in_vector (instantiator, Q_background);
3262 if (NILP (background))
3263 background = pointer_bg;
3264
3265 generate_cursor_fg_bg (device, &foreground, &background, &fg, &bg);
3266
3267 count = sscanf ((char *) string_data (XSTRING (data)),
3268 "FONT %s %d %s %d %c",
3269 source_name, &source_char,
3270 mask_name, &mask_char, &dummy);
3271 /* Allow "%s %d %d" as well... */
3272 if (count == 3 && (1 == sscanf (mask_name, "%d %c", &mask_char, &dummy)))
3273 count = 4, mask_name[0] = 0;
3274
3275 if (count != 2 && count != 4)
3276 signal_simple_error ("invalid cursor specification", data);
3277 source = safe_XLoadFont (dpy, source_name);
3278 if (! source)
3279 signal_simple_error_2 ("couldn't load font",
3280 build_string (source_name),
3281 data);
3282 if (count == 2)
3283 mask = 0;
3284 else if (!mask_name[0])
3285 mask = source;
3286 else
3287 {
3288 mask = safe_XLoadFont (dpy, mask_name);
3289 if (!mask)
3290 /* continuable */
3291 Fsignal (Qerror, list3 (build_string ("couldn't load font"),
3292 build_string (mask_name), data));
3293 }
3294 if (!mask)
3295 mask_char = 0;
3296
3297 /* #### call XQueryTextExtents() and check_pointer_sizes() here. */
3298
3299 x_initialize_pixmap_image_instance (ii, IMAGE_POINTER);
3300 IMAGE_INSTANCE_X_CURSOR (ii) =
3301 XCreateGlyphCursor (dpy, source, mask, source_char, mask_char,
3302 &fg, &bg);
3303 XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
3304 XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
3305 XUnloadFont (dpy, source);
3306 if (mask && mask != source) XUnloadFont (dpy, mask);
3307 }
3308
3309
3310 /**********************************************************************
3311 * Cursor-Font *
3312 **********************************************************************/
3313
3314 static void
3315 cursor_font_validate (Lisp_Object instantiator)
3316 {
3317 data_must_be_present (instantiator);
3318 }
3319
3320 static int
3321 cursor_font_possible_dest_types ()
3322 {
3323 return IMAGE_POINTER_MASK;
3324 }
3325
3326 static void
3327 cursor_font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
3328 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
3329 int dest_mask)
3330 {
3331 /* This function can GC */
3332 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
3333 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
3334 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
3335 Display *dpy;
3336 int i;
3337 CONST char *name_ext;
3338 Lisp_Object foreground, background;
3339
3340 if (!DEVICE_X_P (XDEVICE (device)))
3341 signal_simple_error ("Not an X device", device);
3342
3343 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
3344
3345 if (!(dest_mask & IMAGE_POINTER_MASK))
3346 incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
3347
3348 GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext);
3349 if ((i = XmuCursorNameToIndex (name_ext)) == -1)
3350 signal_simple_error ("Unrecognized cursor-font name", data);
3351
3352 x_initialize_pixmap_image_instance (ii, IMAGE_POINTER);
3353 IMAGE_INSTANCE_X_CURSOR (ii) = XCreateFontCursor (dpy, i);
3354 foreground = find_keyword_in_vector (instantiator, Q_foreground);
3355 if (NILP (foreground))
3356 foreground = pointer_fg;
3357 background = find_keyword_in_vector (instantiator, Q_background);
3358 if (NILP (background))
3359 background = pointer_bg;
3360 maybe_recolor_cursor (image_instance, foreground, background);
3361 }
3362
3363 static int
3364 x_colorize_image_instance (Lisp_Object image_instance,
3365 Lisp_Object foreground, Lisp_Object background)
3366 {
3367 struct Lisp_Image_Instance *p;
3368
3369 p = XIMAGE_INSTANCE (image_instance);
3370
3371 switch (IMAGE_INSTANCE_TYPE (p))
3372 {
3373 case IMAGE_MONO_PIXMAP:
3374 IMAGE_INSTANCE_TYPE (p) = IMAGE_COLOR_PIXMAP;
3375 /* Make sure there aren't two pointers to the same mask, causing
3376 it to get freed twice. */
3377 IMAGE_INSTANCE_X_MASK (p) = 0;
3378 break;
3379
3380 default:
3381 return 0;
3382 }
3383
3384 {
3385 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
3386 Screen *scr = DefaultScreenOfDisplay (dpy);
3387 Dimension d = DefaultDepthOfScreen (scr);
3388 Pixmap new = XCreatePixmap (dpy, RootWindowOfScreen (scr),
3389 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
3390 IMAGE_INSTANCE_PIXMAP_HEIGHT (p), d);
3391 XColor color;
3392 XGCValues gcv;
3393 GC gc;
3394 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground));
3395 gcv.foreground = color.pixel;
3396 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background));
3397 gcv.background = color.pixel;
3398 gc = XCreateGC (dpy, new, GCBackground|GCForeground, &gcv);
3399 XCopyPlane (dpy, IMAGE_INSTANCE_X_PIXMAP (p), new, gc, 0, 0,
3400 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
3401 IMAGE_INSTANCE_PIXMAP_HEIGHT (p),
3402 0, 0, 1);
3403 XFreeGC (dpy, gc);
3404 IMAGE_INSTANCE_X_PIXMAP (p) = new;
3405 IMAGE_INSTANCE_PIXMAP_DEPTH (p) = d;
3406 IMAGE_INSTANCE_PIXMAP_FG (p) = foreground;
3407 IMAGE_INSTANCE_PIXMAP_BG (p) = background;
3408 return 1;
3409 }
3410 }
3411
3412
3413 /************************************************************************/
3414 /* subwindows */
3415 /************************************************************************/
3416
3417 Lisp_Object Qsubwindowp;
3418 static Lisp_Object mark_subwindow (Lisp_Object, void (*) (Lisp_Object));
3419 static void print_subwindow (Lisp_Object, Lisp_Object, int);
3420 static void finalize_subwindow (void *, int);
3421 static int subwindow_equal (Lisp_Object o1, Lisp_Object o2, int depth);
3422 static unsigned long subwindow_hash (Lisp_Object obj, int depth);
3423 DEFINE_LRECORD_IMPLEMENTATION ("subwindow", subwindow,
3424 mark_subwindow, print_subwindow,
3425 finalize_subwindow, subwindow_equal,
3426 subwindow_hash, struct Lisp_Subwindow);
3427
3428 static Lisp_Object
3429 mark_subwindow (Lisp_Object obj, void (*markobj) (Lisp_Object))
3430 {
3431 struct Lisp_Subwindow *sw = XSUBWINDOW (obj);
3432 return sw->frame;
3433 }
3434
3435 static void
3436 print_subwindow (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3437 {
3438 char buf[100];
3439 struct Lisp_Subwindow *sw = XSUBWINDOW (obj);
3440 struct frame *frm = XFRAME (sw->frame);
3441
3442 if (print_readably)
3443 error ("printing unreadable object #<subwindow 0x%x>",
3444 sw->header.uid);
3445
3446 write_c_string ("#<subwindow", printcharfun);
3447 sprintf (buf, " %dx%d", sw->width, sw->height);
3448 write_c_string (buf, printcharfun);
3449
3450 /* This is stolen from frame.c. Subwindows are strange in that they
3451 are specific to a particular frame so we want to print in their
3452 description what that frame is. */
3453
3454 write_c_string (" on #<", printcharfun);
3455 if (!FRAME_LIVE_P (frm))
3456 write_c_string ("dead", printcharfun);
3457 else if (FRAME_TTY_P (frm))
3458 write_c_string ("tty", printcharfun);
3459 else if (FRAME_X_P (frm))
3460 write_c_string ("x", printcharfun);
3461 else
3462 write_c_string ("UNKNOWN", printcharfun);
3463 write_c_string ("-frame ", printcharfun);
3464 print_internal (frm->name, printcharfun, 1);
3465 sprintf (buf, " 0x%x>", frm->header.uid);
3466 write_c_string (buf, printcharfun);
3467
3468 sprintf (buf, ") 0x%x>", sw->header.uid);
3469 write_c_string (buf, printcharfun);
3470 }
3471
3472 static void
3473 finalize_subwindow (void *header, int for_disksave)
3474 {
3475 struct Lisp_Subwindow *sw = (struct Lisp_Subwindow *) header;
3476 if (for_disksave) finalose (sw);
3477 if (sw->subwindow)
3478 {
3479 XDestroyWindow (DisplayOfScreen (sw->xscreen), sw->subwindow);
3480 sw->subwindow = 0;
3481 }
3482 }
3483
3484 /* subwindows are equal iff they have the same window XID */
3485 static int
3486 subwindow_equal (Lisp_Object o1, Lisp_Object o2, int depth)
3487 {
3488 return (XSUBWINDOW (o1)->subwindow == XSUBWINDOW (o2)->subwindow);
3489 }
3490
3491 static unsigned long
3492 subwindow_hash (Lisp_Object obj, int depth)
3493 {
3494 return XSUBWINDOW (obj)->subwindow;
3495 }
3496
3497 /* #### PROBLEM: The display routines assume that the glyph is only
3498 being displayed in one buffer. If it is in two different buffers
3499 which are both being displayed simultaneously you will lose big time.
3500 This can be dealt with in the new redisplay. */
3501
3502 /* #### These are completely un-re-implemented in 19.14. Get it done
3503 for 19.15. */
3504
3505 DEFUN ("make-subwindow", Fmake_subwindow, Smake_subwindow,
3506 0, 3, 0 /*
3507 Creates a new `subwindow' object of size WIDTH x HEIGHT.
3508 The default is a window of size 1x1, which is also the minimum allowed
3509 window size. Subwindows are per-frame. A buffer being shown in two
3510 different frames will only display a subwindow glyph in the frame in
3511 which it was actually created. If two windows on the same frame are
3512 displaying the buffer then the most recently used window will actually
3513 display the window. If the frame is not specified, the selected frame
3514 is used.
3515
3516 Subwindows are not currently implemented.
3517 */ )
3518 (width, height, frame)
3519 Lisp_Object width, height, frame;
3520 {
3521 Display *dpy;
3522 Screen *xs;
3523 Window pw;
3524 struct frame *f;
3525 unsigned int iw, ih;
3526 XSetWindowAttributes xswa;
3527 Mask valueMask = 0;
3528
3529 error ("subwindows are not functional in 19.14; they will be in 19.15");
3530
3531 f = decode_x_frame (frame);
3532
3533 xs = LISP_DEVICE_TO_X_SCREEN (FRAME_DEVICE (f));
3534 dpy = DisplayOfScreen (xs);
3535 pw = XtWindow (FRAME_X_TEXT_WIDGET (f));
3536
3537 if (NILP (width))
3538 iw = 1;
3539 else
3540 {
3541 CHECK_INT (width);
3542 iw = XINT (width);
3543 if (iw < 1) iw = 1;
3544 }
3545 if (NILP (height))
3546 ih = 1;
3547 else
3548 {
3549 CHECK_INT (height);
3550 ih = XINT (height);
3551 if (ih < 1) ih = 1;
3552 }
3553
3554 {
3555 struct Lisp_Subwindow *sw = alloc_lcrecord (sizeof (struct Lisp_Subwindow),
3556 lrecord_subwindow);
3557 Lisp_Object val;
3558 sw->frame = frame;
3559 sw->xscreen = xs;
3560 sw->parent_window = pw;
3561 sw->height = ih;
3562 sw->width = iw;
3563
3564 xswa.backing_store = Always;
3565 valueMask |= CWBackingStore;
3566
3567 xswa.colormap = DefaultColormapOfScreen (xs);
3568 valueMask |= CWColormap;
3569
3570 sw->subwindow = XCreateWindow (dpy, pw, 0, 0, iw, ih, 0, CopyFromParent,
3571 InputOutput, CopyFromParent, valueMask,
3572 &xswa);
3573
3574 XSETSUBWINDOW (val, sw);
3575 return val;
3576 }
3577 }
3578
3579 /* #### Should this function exist? */
3580 DEFUN ("change-subwindow-property", Fchange_subwindow_property,
3581 Schange_subwindow_property, 3, 3, 0 /*
3582 For the given SUBWINDOW, set PROPERTY to DATA, which is a string.
3583 Subwindows are not currently implemented.
3584 */ )
3585 (subwindow, property, data)
3586 Lisp_Object subwindow, property, data;
3587 {
3588 Atom property_atom;
3589 struct Lisp_Subwindow *sw;
3590 Display *dpy;
3591
3592 CHECK_SUBWINDOW (subwindow);
3593 CHECK_STRING (property);
3594 CHECK_STRING (data);
3595
3596 sw = XSUBWINDOW (subwindow);
3597 dpy = DisplayOfScreen (LISP_DEVICE_TO_X_SCREEN
3598 (FRAME_DEVICE (XFRAME (sw->frame))));
3599
3600 property_atom = XInternAtom (dpy, (char *) string_data (XSTRING (property)),
3601 False);
3602 XChangeProperty (dpy, sw->subwindow, property_atom, XA_STRING, 8,
3603 PropModeReplace, string_data (XSTRING (data)),
3604 string_length (XSTRING (data)));
3605
3606 return (property);
3607 }
3608
3609 DEFUN ("subwindowp", Fsubwindowp, Ssubwindowp, 1, 1, 0 /*
3610 Return non-nil if OBJECT is a subwindow.
3611 Subwindows are not currently implemented.
3612 */ )
3613 (object)
3614 Lisp_Object object;
3615 {
3616 return (SUBWINDOWP (object) ? Qt : Qnil);
3617 }
3618
3619 DEFUN ("subwindow-width", Fsubwindow_width, Ssubwindow_width,
3620 1, 1, 0 /*
3621 Width of SUBWINDOW.
3622 Subwindows are not currently implemented.
3623 */ )
3624 (subwindow)
3625 Lisp_Object subwindow;
3626 {
3627 CHECK_SUBWINDOW (subwindow);
3628 return (make_int (XSUBWINDOW (subwindow)->width));
3629 }
3630
3631 DEFUN ("subwindow-height", Fsubwindow_height, Ssubwindow_height,
3632 1, 1, 0 /*
3633 Height of SUBWINDOW.
3634 Subwindows are not currently implemented.
3635 */ )
3636 (subwindow)
3637 Lisp_Object subwindow;
3638 {
3639 CHECK_SUBWINDOW (subwindow);
3640 return (make_int (XSUBWINDOW (subwindow)->height));
3641 }
3642
3643 DEFUN ("subwindow-xid", Fsubwindow_xid, Ssubwindow_xid, 1, 1, 0 /*
3644 Return the xid of SUBWINDOW as a number.
3645 Subwindows are not currently implemented.
3646 */ )
3647 (subwindow)
3648 Lisp_Object subwindow;
3649 {
3650 CHECK_SUBWINDOW (subwindow);
3651 return (make_int (XSUBWINDOW (subwindow)->subwindow));
3652 }
3653
3654 DEFUN ("resize-subwindow", Fresize_subwindow, Sresize_subwindow,
3655 1, 3, 0 /*
3656 Resize SUBWINDOW to WIDTH x HEIGHT.
3657 If a value is nil that parameter is not changed.
3658 Subwindows are not currently implemented.
3659 */ )
3660 (subwindow, width, height)
3661 Lisp_Object subwindow, width, height;
3662 {
3663 int neww, newh;
3664 struct Lisp_Subwindow *sw;
3665
3666 CHECK_SUBWINDOW (subwindow);
3667 sw = XSUBWINDOW (subwindow);
3668
3669 if (NILP (width))
3670 neww = sw->width;
3671 else
3672 neww = XINT (width);
3673
3674 if (NILP (height))
3675 newh = sw->height;
3676 else
3677 newh = XINT (height);
3678
3679 XResizeWindow (DisplayOfScreen (sw->xscreen), sw->subwindow, neww, newh);
3680
3681 sw->height = newh;
3682 sw->width = neww;
3683
3684 return subwindow;
3685 }
3686
3687 DEFUN ("force-subwindow-map", Fforce_subwindow_map,
3688 Sforce_subwindow_map, 1, 1, 0 /*
3689 Generate a Map event for SUBWINDOW.
3690 Subwindows are not currently implemented.
3691 */ )
3692 (subwindow)
3693 Lisp_Object subwindow;
3694 {
3695 CHECK_SUBWINDOW (subwindow);
3696
3697 XMapWindow (DisplayOfScreen (XSUBWINDOW (subwindow)->xscreen),
3698 XSUBWINDOW (subwindow)->subwindow);
3699
3700 return subwindow;
3701 }
3702
3703
3704 /************************************************************************/
3705 /* initialization */
3706 /************************************************************************/
3707
3708 void
3709 syms_of_glyphs_x (void)
3710 {
3711 defsymbol (&Qsubwindowp, "subwindowp");
3712
3713 defsubr (&Smake_subwindow);
3714 defsubr (&Schange_subwindow_property);
3715 defsubr (&Ssubwindowp);
3716 defsubr (&Ssubwindow_width);
3717 defsubr (&Ssubwindow_height);
3718 defsubr (&Ssubwindow_xid);
3719 defsubr (&Sresize_subwindow);
3720 defsubr (&Sforce_subwindow_map);
3721
3722 defkeyword (&Q_mask_file, ":mask-file");
3723 defkeyword (&Q_mask_data, ":mask-data");
3724 defkeyword (&Q_hotspot_x, ":hotspot-x");
3725 defkeyword (&Q_hotspot_y, ":hotspot-y");
3726 defkeyword (&Q_foreground, ":foreground");
3727 defkeyword (&Q_background, ":background");
3728
3729 #ifdef HAVE_XPM
3730 defkeyword (&Q_color_symbols, ":color-symbols");
3731 #endif
3732 }
3733
3734 void
3735 console_type_create_glyphs_x (void)
3736 {
3737 /* image methods */
3738
3739 CONSOLE_HAS_METHOD (x, print_image_instance);
3740 CONSOLE_HAS_METHOD (x, finalize_image_instance);
3741 CONSOLE_HAS_METHOD (x, image_instance_equal);
3742 CONSOLE_HAS_METHOD (x, image_instance_hash);
3743 CONSOLE_HAS_METHOD (x, colorize_image_instance);
3744 }
3745
3746 void
3747 image_instantiator_format_create_glyphs_x (void)
3748 {
3749 /* image-instantiator types */
3750
3751 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm");
3752
3753 IIFORMAT_HAS_METHOD (xbm, validate);
3754 IIFORMAT_HAS_METHOD (xbm, normalize);
3755 IIFORMAT_HAS_METHOD (xbm, possible_dest_types);
3756 IIFORMAT_HAS_METHOD (xbm, instantiate);
3757
3758 IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline);
3759 IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string);
3760 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_data, check_valid_xbm_inline);
3761 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_file, check_valid_string);
3762 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_x, check_valid_int);
3763 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_y, check_valid_int);
3764 IIFORMAT_VALID_KEYWORD (xbm, Q_foreground, check_valid_string);
3765 IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string);
3766
3767 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (cursor_font, "cursor-font");
3768
3769 IIFORMAT_HAS_METHOD (cursor_font, validate);
3770 IIFORMAT_HAS_METHOD (cursor_font, possible_dest_types);
3771 IIFORMAT_HAS_METHOD (cursor_font, instantiate);
3772
3773 IIFORMAT_VALID_KEYWORD (cursor_font, Q_data, check_valid_string);
3774 IIFORMAT_VALID_KEYWORD (cursor_font, Q_foreground, check_valid_string);
3775 IIFORMAT_VALID_KEYWORD (cursor_font, Q_background, check_valid_string);
3776
3777 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (font, "font");
3778
3779 IIFORMAT_HAS_METHOD (font, validate);
3780 IIFORMAT_HAS_METHOD (font, possible_dest_types);
3781 IIFORMAT_HAS_METHOD (font, instantiate);
3782
3783 IIFORMAT_VALID_KEYWORD (font, Q_data, check_valid_string);
3784 IIFORMAT_VALID_KEYWORD (font, Q_foreground, check_valid_string);
3785 IIFORMAT_VALID_KEYWORD (font, Q_background, check_valid_string);
3786
3787 #ifdef HAVE_JPEG
3788 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (jpeg, "jpeg");
3789
3790 IIFORMAT_HAS_METHOD (jpeg, validate);
3791 IIFORMAT_HAS_METHOD (jpeg, normalize);
3792 IIFORMAT_HAS_METHOD (jpeg, possible_dest_types);
3793 IIFORMAT_HAS_METHOD (jpeg, instantiate);
3794
3795 IIFORMAT_VALID_KEYWORD (jpeg, Q_data, check_valid_string);
3796 IIFORMAT_VALID_KEYWORD (jpeg, Q_file, check_valid_string);
3797 #endif
3798
3799 #ifdef HAVE_GIF
3800 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (gif, "gif");
3801
3802 IIFORMAT_HAS_METHOD (gif, validate);
3803 IIFORMAT_HAS_METHOD (gif, normalize);
3804 IIFORMAT_HAS_METHOD (gif, possible_dest_types);
3805 IIFORMAT_HAS_METHOD (gif, instantiate);
3806
3807 IIFORMAT_VALID_KEYWORD (gif, Q_data, check_valid_string);
3808 IIFORMAT_VALID_KEYWORD (gif, Q_file, check_valid_string);
3809 #endif
3810
3811 #ifdef HAVE_PNG
3812 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (png, "png");
3813
3814 IIFORMAT_HAS_METHOD (png, validate);
3815 IIFORMAT_HAS_METHOD (png, normalize);
3816 IIFORMAT_HAS_METHOD (png, possible_dest_types);
3817 IIFORMAT_HAS_METHOD (png, instantiate);
3818
3819 IIFORMAT_VALID_KEYWORD (png, Q_data, check_valid_string);
3820 IIFORMAT_VALID_KEYWORD (png, Q_file, check_valid_string);
3821 #endif
3822
3823 #ifdef HAVE_TIFF
3824 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (tiff, "tiff");
3825
3826 IIFORMAT_HAS_METHOD (tiff, validate);
3827 IIFORMAT_HAS_METHOD (tiff, normalize);
3828 IIFORMAT_HAS_METHOD (tiff, possible_dest_types);
3829 IIFORMAT_HAS_METHOD (tiff, instantiate);
3830
3831 IIFORMAT_VALID_KEYWORD (tiff, Q_data, check_valid_string);
3832 IIFORMAT_VALID_KEYWORD (tiff, Q_file, check_valid_string);
3833 #endif
3834
3835 #ifdef HAVE_XPM
3836 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xpm, "xpm");
3837
3838 IIFORMAT_HAS_METHOD (xpm, validate);
3839 IIFORMAT_HAS_METHOD (xpm, normalize);
3840 IIFORMAT_HAS_METHOD (xpm, possible_dest_types);
3841 IIFORMAT_HAS_METHOD (xpm, instantiate);
3842
3843 IIFORMAT_VALID_KEYWORD (xpm, Q_data, check_valid_string);
3844 IIFORMAT_VALID_KEYWORD (xpm, Q_file, check_valid_string);
3845 IIFORMAT_VALID_KEYWORD (xpm, Q_color_symbols, check_valid_xpm_color_symbols);
3846 #endif
3847
3848 #ifdef HAVE_XFACE
3849 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xface, "xface");
3850
3851 IIFORMAT_HAS_METHOD (xface, validate);
3852 IIFORMAT_HAS_METHOD (xface, normalize);
3853 IIFORMAT_HAS_METHOD (xface, possible_dest_types);
3854 IIFORMAT_HAS_METHOD (xface, instantiate);
3855
3856 IIFORMAT_VALID_KEYWORD (xface, Q_data, check_valid_string);
3857 IIFORMAT_VALID_KEYWORD (xface, Q_file, check_valid_string);
3858 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_x, check_valid_int);
3859 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_y, check_valid_int);
3860 IIFORMAT_VALID_KEYWORD (xface, Q_foreground, check_valid_string);
3861 IIFORMAT_VALID_KEYWORD (xface, Q_background, check_valid_string);
3862 #endif
3863
3864 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (autodetect, "autodetect");
3865
3866 IIFORMAT_HAS_METHOD (autodetect, validate);
3867 IIFORMAT_HAS_METHOD (autodetect, normalize);
3868 IIFORMAT_HAS_METHOD (autodetect, possible_dest_types);
3869 IIFORMAT_HAS_METHOD (autodetect, instantiate);
3870
3871 IIFORMAT_VALID_KEYWORD (autodetect, Q_data, check_valid_string);
3872 }
3873
3874 void
3875 vars_of_glyphs_x (void)
3876 {
3877 #ifdef HAVE_JPEG
3878 Fprovide (Qjpeg);
3879 #endif
3880
3881 #ifdef HAVE_GIF
3882 Fprovide (Qgif);
3883 #endif
3884
3885 #ifdef HAVE_PNG
3886 Fprovide (Qpng);
3887 #endif
3888
3889 #ifdef HAVE_TIFF
3890 Fprovide (Qtiff);
3891 #endif
3892
3893 #ifdef HAVE_XPM
3894 Fprovide (Qxpm);
3895
3896 DEFVAR_LISP ("xpm-color-symbols", &Vxpm_color_symbols /*
3897 Definitions of logical color-names used when reading XPM files.
3898 Elements of this list should be of the form (COLOR-NAME FORM-TO-EVALUATE).
3899 The COLOR-NAME should be a string, which is the name of the color to define;
3900 the FORM should evaluate to a `color' specifier object, or a string to be
3901 passed to `make-color-instance'. If a loaded XPM file references a symbolic
3902 color called COLOR-NAME, it will display as the computed color instead.
3903
3904 The default value of this variable defines the logical color names
3905 \"foreground\" and \"background\" to be the colors of the `default' face.
3906 */ );
3907 Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */
3908 #endif
3909
3910 #ifdef HAVE_XFACE
3911 Fprovide (Qxface);
3912 #endif
3913
3914 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path /*
3915 A list of the directories in which X bitmap files may be found.
3916 If nil, this is initialized from the \"*bitmapFilePath\" resource.
3917 This is used by the `make-image-instance' function (however, note that if
3918 the environment variable XBMLANGPATH is set, it is consulted first).
3919 */ );
3920 Vx_bitmap_file_path = Qnil;
3921 }
3922
3923 void
3924 complex_vars_of_glyphs_x (void)
3925 {
3926 #define BUILD_GLYPH_INST(variable, name) \
3927 Fadd_spec_to_specifier \
3928 (GLYPH_IMAGE (XGLYPH (variable)), \
3929 vector3 (Qxbm, Q_data, \
3930 list3 (make_int (name##_width), \
3931 make_int (name##_height), \
3932 make_ext_string (name##_bits, \
3933 sizeof (name##_bits), \
3934 FORMAT_BINARY))), \
3935 Qglobal, Qx, Qnil)
3936
3937 BUILD_GLYPH_INST (Vtruncation_glyph, truncator);
3938 BUILD_GLYPH_INST (Vcontinuation_glyph, continuer);
3939 BUILD_GLYPH_INST (Vxemacs_logo, xemacs);
3940
3941 #undef BUILD_GLYPH_INST
3942 }