comparison src/glyphs-x.c @ 428:3ecd8885ac67 r21-2-22

Import from CVS: tag r21-2-22
author cvs
date Mon, 13 Aug 2007 11:28:15 +0200
parents
children a5df635868b2
comparison
equal deleted inserted replaced
427:0a0253eac470 428:3ecd8885ac67
1 /* X-specific Lisp objects.
2 Copyright (C) 1993, 1994 Free Software Foundation, Inc.
3 Copyright (C) 1995 Board of Trustees, University of Illinois.
4 Copyright (C) 1995 Tinker Systems
5 Copyright (C) 1995, 1996 Ben Wing
6 Copyright (C) 1995 Sun Microsystems
7 Copyright (C) 1999 Andy Piper
8
9 This file is part of XEmacs.
10
11 XEmacs is free software; you can redistribute it and/or modify it
12 under the terms of the GNU General Public License as published by the
13 Free Software Foundation; either version 2, or (at your option) any
14 later version.
15
16 XEmacs is distributed in the hope that it will be useful, but WITHOUT
17 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
18 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
19 for more details.
20
21 You should have received a copy of the GNU General Public License
22 along with XEmacs; see the file COPYING. If not, write to
23 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 Boston, MA 02111-1307, USA. */
25
26 /* Synched up with: Not in FSF. */
27
28 /* Original author: Jamie Zawinski for 19.8
29 font-truename stuff added by Jamie Zawinski for 19.10
30 subwindow support added by Chuck Thompson
31 additional XPM support added by Chuck Thompson
32 initial X-Face support added by Stig
33 rewritten/restructured by Ben Wing for 19.12/19.13
34 GIF/JPEG support added by Ben Wing for 19.14
35 PNG support added by Bill Perry for 19.14
36 Improved GIF/JPEG support added by Bill Perry for 19.14
37 Cleanup/simplification of error handling by Ben Wing for 19.14
38 Pointer/icon overhaul, more restructuring by Ben Wing for 19.14
39 GIF support changed to external GIFlib 3.1 by Jareth Hein for 21.0
40 Many changes for color work and optimizations by Jareth Hein for 21.0
41 Switch of GIF/JPEG/PNG to new EImage intermediate code by Jareth Hein for 21.0
42 TIFF code by Jareth Hein for 21.0
43 GIF/JPEG/PNG/TIFF code moved to new glyph-eimage.c by Andy Piper for 21.0
44 Subwindow and Widget support by Andy Piper for 21.2
45
46 TODO:
47 Convert images.el to C and stick it in here?
48 */
49
50 #include <config.h>
51 #include "lisp.h"
52 #include "lstream.h"
53 #include "console-x.h"
54 #include "glyphs-x.h"
55 #include "objects-x.h"
56 #ifdef HAVE_WIDGETS
57 #include "gui-x.h"
58 #endif
59 #include "xmu.h"
60
61 #include "buffer.h"
62 #include "window.h"
63 #include "frame.h"
64 #include "insdel.h"
65 #include "opaque.h"
66 #include "gui.h"
67 #include "faces.h"
68
69 #include "imgproc.h"
70
71 #include "sysfile.h"
72
73 #include <setjmp.h>
74
75 #ifdef FILE_CODING
76 #include "file-coding.h"
77 #endif
78
79 #ifdef LWLIB_WIDGETS_MOTIF
80 #include <Xm/Xm.h>
81 #endif
82 #include <X11/IntrinsicP.h>
83
84 #if INTBITS == 32
85 # define FOUR_BYTE_TYPE unsigned int
86 #elif LONGBITS == 32
87 # define FOUR_BYTE_TYPE unsigned long
88 #elif SHORTBITS == 32
89 # define FOUR_BYTE_TYPE unsigned short
90 #else
91 #error What kind of strange-ass system are we running on?
92 #endif
93
94 #define LISP_DEVICE_TO_X_SCREEN(dev) XDefaultScreenOfDisplay (DEVICE_X_DISPLAY (XDEVICE (dev)))
95
96 DECLARE_IMAGE_INSTANTIATOR_FORMAT (nothing);
97 DECLARE_IMAGE_INSTANTIATOR_FORMAT (string);
98 DECLARE_IMAGE_INSTANTIATOR_FORMAT (formatted_string);
99 DECLARE_IMAGE_INSTANTIATOR_FORMAT (inherit);
100 DECLARE_IMAGE_INSTANTIATOR_FORMAT (layout);
101 #ifdef HAVE_JPEG
102 DECLARE_IMAGE_INSTANTIATOR_FORMAT (jpeg);
103 #endif
104 #ifdef HAVE_TIFF
105 DECLARE_IMAGE_INSTANTIATOR_FORMAT (tiff);
106 #endif
107 #ifdef HAVE_PNG
108 DECLARE_IMAGE_INSTANTIATOR_FORMAT (png);
109 #endif
110 #ifdef HAVE_GIF
111 DECLARE_IMAGE_INSTANTIATOR_FORMAT (gif);
112 #endif
113 #ifdef HAVE_XPM
114 DEFINE_DEVICE_IIFORMAT (x, xpm);
115 #endif
116 DEFINE_DEVICE_IIFORMAT (x, xbm);
117 DEFINE_DEVICE_IIFORMAT (x, subwindow);
118 #ifdef HAVE_XFACE
119 DEFINE_DEVICE_IIFORMAT (x, xface);
120 #endif
121
122 DEFINE_IMAGE_INSTANTIATOR_FORMAT (cursor_font);
123 Lisp_Object Qcursor_font;
124
125 DEFINE_IMAGE_INSTANTIATOR_FORMAT (font);
126
127 DEFINE_IMAGE_INSTANTIATOR_FORMAT (autodetect);
128
129 #ifdef HAVE_WIDGETS
130 DEFINE_DEVICE_IIFORMAT (x, widget);
131 DEFINE_DEVICE_IIFORMAT (x, button);
132 DEFINE_DEVICE_IIFORMAT (x, progress_gauge);
133 DEFINE_DEVICE_IIFORMAT (x, edit_field);
134 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
135 DEFINE_DEVICE_IIFORMAT (x, combo_box);
136 #endif
137 DEFINE_DEVICE_IIFORMAT (x, tab_control);
138 DEFINE_DEVICE_IIFORMAT (x, label);
139 #endif
140
141 static void cursor_font_instantiate (Lisp_Object image_instance,
142 Lisp_Object instantiator,
143 Lisp_Object pointer_fg,
144 Lisp_Object pointer_bg,
145 int dest_mask,
146 Lisp_Object domain);
147
148 #ifdef HAVE_WIDGETS
149 static void
150 update_widget_face (struct Lisp_Image_Instance* ii, Lisp_Object domain);
151 #endif
152
153 #include "bitmaps.h"
154
155
156 /************************************************************************/
157 /* image instance methods */
158 /************************************************************************/
159
160 /************************************************************************/
161 /* convert from a series of RGB triples to an XImage formated for the */
162 /* proper display */
163 /************************************************************************/
164 static XImage *
165 convert_EImage_to_XImage (Lisp_Object device, int width, int height,
166 unsigned char *pic, unsigned long **pixtbl,
167 int *npixels)
168 {
169 Display *dpy;
170 Colormap cmap;
171 Visual *vis;
172 XImage *outimg;
173 int depth, bitmap_pad, bits_per_pixel, byte_cnt, i, j;
174 int rd,gr,bl,q;
175 unsigned char *data, *ip, *dp;
176 quant_table *qtable = 0;
177 union {
178 FOUR_BYTE_TYPE val;
179 char cp[4];
180 } conv;
181
182 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
183 cmap = DEVICE_X_COLORMAP (XDEVICE(device));
184 vis = DEVICE_X_VISUAL (XDEVICE(device));
185 depth = DEVICE_X_DEPTH(XDEVICE(device));
186
187 if (vis->class == PseudoColor)
188 {
189 /* Quantize the image and get a histogram while we're at it.
190 Do this first to save memory */
191 qtable = build_EImage_quantable(pic, width, height, 256);
192 if (qtable == NULL) return NULL;
193 }
194
195 bitmap_pad = ((depth > 16) ? 32 :
196 (depth > 8) ? 16 :
197 8);
198
199 outimg = XCreateImage (dpy, vis,
200 depth, ZPixmap, 0, 0, width, height,
201 bitmap_pad, 0);
202 if (!outimg) return NULL;
203
204 bits_per_pixel = outimg->bits_per_pixel;
205 byte_cnt = bits_per_pixel >> 3;
206
207 data = (unsigned char *) xmalloc (outimg->bytes_per_line * height);
208 if (!data)
209 {
210 XDestroyImage (outimg);
211 return NULL;
212 }
213 outimg->data = (char *) data;
214
215 if (vis->class == PseudoColor)
216 {
217 unsigned long pixarray[256];
218 int pixcount, n;
219 /* use our quantize table to allocate the colors */
220 pixcount = 32;
221 *pixtbl = xnew_array (unsigned long, pixcount);
222 *npixels = 0;
223
224 /* ### should implement a sort by popularity to assure proper allocation */
225 n = *npixels;
226 for (i = 0; i < qtable->num_active_colors; i++)
227 {
228 XColor color;
229 int res;
230
231 color.red = qtable->rm[i] ? qtable->rm[i] << 8 : 0;
232 color.green = qtable->gm[i] ? qtable->gm[i] << 8 : 0;
233 color.blue = qtable->bm[i] ? qtable->bm[i] << 8 : 0;
234 color.flags = DoRed | DoGreen | DoBlue;
235 res = allocate_nearest_color (dpy, cmap, vis, &color);
236 if (res > 0 && res < 3)
237 {
238 DO_REALLOC(*pixtbl, pixcount, n+1, unsigned long);
239 (*pixtbl)[n] = color.pixel;
240 n++;
241 }
242 pixarray[i] = color.pixel;
243 }
244 *npixels = n;
245 ip = pic;
246 for (i = 0; i < height; i++)
247 {
248 dp = data + (i * outimg->bytes_per_line);
249 for (j = 0; j < width; j++)
250 {
251 rd = *ip++;
252 gr = *ip++;
253 bl = *ip++;
254 conv.val = pixarray[QUANT_GET_COLOR(qtable,rd,gr,bl)];
255 #if WORDS_BIGENDIAN
256 if (outimg->byte_order == MSBFirst)
257 for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q];
258 else
259 for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q];
260 #else
261 if (outimg->byte_order == MSBFirst)
262 for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q];
263 else
264 for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q];
265 #endif
266 }
267 }
268 xfree(qtable);
269 } else {
270 unsigned long rshift,gshift,bshift,rbits,gbits,bbits,junk;
271 junk = vis->red_mask;
272 rshift = 0;
273 while ((junk & 0x1) == 0)
274 {
275 junk = junk >> 1;
276 rshift ++;
277 }
278 rbits = 0;
279 while (junk != 0)
280 {
281 junk = junk >> 1;
282 rbits++;
283 }
284 junk = vis->green_mask;
285 gshift = 0;
286 while ((junk & 0x1) == 0)
287 {
288 junk = junk >> 1;
289 gshift ++;
290 }
291 gbits = 0;
292 while (junk != 0)
293 {
294 junk = junk >> 1;
295 gbits++;
296 }
297 junk = vis->blue_mask;
298 bshift = 0;
299 while ((junk & 0x1) == 0)
300 {
301 junk = junk >> 1;
302 bshift ++;
303 }
304 bbits = 0;
305 while (junk != 0)
306 {
307 junk = junk >> 1;
308 bbits++;
309 }
310 ip = pic;
311 for (i = 0; i < height; i++)
312 {
313 dp = data + (i * outimg->bytes_per_line);
314 for (j = 0; j < width; j++)
315 {
316 if (rbits > 8)
317 rd = *ip++ << (rbits - 8);
318 else
319 rd = *ip++ >> (8 - rbits);
320 if (gbits > 8)
321 gr = *ip++ << (gbits - 8);
322 else
323 gr = *ip++ >> (8 - gbits);
324 if (bbits > 8)
325 bl = *ip++ << (bbits - 8);
326 else
327 bl = *ip++ >> (8 - bbits);
328
329 conv.val = (rd << rshift) | (gr << gshift) | (bl << bshift);
330 #if WORDS_BIGENDIAN
331 if (outimg->byte_order == MSBFirst)
332 for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q];
333 else
334 for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q];
335 #else
336 if (outimg->byte_order == MSBFirst)
337 for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q];
338 else
339 for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q];
340 #endif
341 }
342 }
343 }
344 return outimg;
345 }
346
347
348
349 static void
350 x_print_image_instance (struct Lisp_Image_Instance *p,
351 Lisp_Object printcharfun,
352 int escapeflag)
353 {
354 char buf[100];
355
356 switch (IMAGE_INSTANCE_TYPE (p))
357 {
358 case IMAGE_MONO_PIXMAP:
359 case IMAGE_COLOR_PIXMAP:
360 case IMAGE_POINTER:
361 sprintf (buf, " (0x%lx", (unsigned long) IMAGE_INSTANCE_X_PIXMAP (p));
362 write_c_string (buf, printcharfun);
363 if (IMAGE_INSTANCE_X_MASK (p))
364 {
365 sprintf (buf, "/0x%lx", (unsigned long) IMAGE_INSTANCE_X_MASK (p));
366 write_c_string (buf, printcharfun);
367 }
368 write_c_string (")", printcharfun);
369 break;
370 default:
371 break;
372 }
373 }
374
375 #ifdef DEBUG_WIDGETS
376 extern int debug_widget_instances;
377 #endif
378
379 static void
380 x_finalize_image_instance (struct Lisp_Image_Instance *p)
381 {
382 if (!p->data)
383 return;
384
385 if (DEVICE_LIVE_P (XDEVICE (p->device)))
386 {
387 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (p->device));
388
389 if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET)
390 {
391 if (IMAGE_INSTANCE_SUBWINDOW_ID (p))
392 {
393 #ifdef DEBUG_WIDGETS
394 debug_widget_instances--;
395 stderr_out ("widget destroyed, %d left\n", debug_widget_instances);
396 #endif
397 lw_destroy_widget (IMAGE_INSTANCE_X_WIDGET_ID (p));
398 lw_destroy_widget (IMAGE_INSTANCE_X_CLIPWIDGET (p));
399 IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0;
400 }
401 }
402 else if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
403 {
404 if (IMAGE_INSTANCE_SUBWINDOW_ID (p))
405 XDestroyWindow (dpy, IMAGE_INSTANCE_X_SUBWINDOW_ID (p));
406 IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0;
407 }
408 else
409 {
410 int i;
411 if (IMAGE_INSTANCE_PIXMAP_TIMEOUT (p))
412 disable_glyph_animated_timeout (IMAGE_INSTANCE_PIXMAP_TIMEOUT (p));
413
414 if (IMAGE_INSTANCE_X_MASK (p) &&
415 IMAGE_INSTANCE_X_MASK (p) != IMAGE_INSTANCE_X_PIXMAP (p))
416 XFreePixmap (dpy, IMAGE_INSTANCE_X_MASK (p));
417 IMAGE_INSTANCE_PIXMAP_MASK (p) = 0;
418
419 if (IMAGE_INSTANCE_X_PIXMAP_SLICES (p))
420 {
421 for (i = 0; i < IMAGE_INSTANCE_PIXMAP_MAXSLICE (p); i++)
422 if (IMAGE_INSTANCE_X_PIXMAP_SLICE (p,i))
423 {
424 XFreePixmap (dpy, IMAGE_INSTANCE_X_PIXMAP_SLICE (p,i));
425 IMAGE_INSTANCE_X_PIXMAP_SLICE (p, i) = 0;
426 }
427 xfree (IMAGE_INSTANCE_X_PIXMAP_SLICES (p));
428 IMAGE_INSTANCE_X_PIXMAP_SLICES (p) = 0;
429 }
430
431 if (IMAGE_INSTANCE_X_CURSOR (p))
432 {
433 XFreeCursor (dpy, IMAGE_INSTANCE_X_CURSOR (p));
434 IMAGE_INSTANCE_X_CURSOR (p) = 0;
435 }
436
437 if (IMAGE_INSTANCE_X_NPIXELS (p) != 0)
438 {
439 XFreeColors (dpy,
440 IMAGE_INSTANCE_X_COLORMAP (p),
441 IMAGE_INSTANCE_X_PIXELS (p),
442 IMAGE_INSTANCE_X_NPIXELS (p), 0);
443 IMAGE_INSTANCE_X_NPIXELS (p) = 0;
444 }
445 }
446 }
447 /* You can sometimes have pixels without a live device. I forget
448 why, but that's why we free them here if we have a pixmap type
449 image instance. It probably means that we might also get a memory
450 leak with widgets. */
451 if (IMAGE_INSTANCE_TYPE (p) != IMAGE_WIDGET
452 && IMAGE_INSTANCE_TYPE (p) != IMAGE_SUBWINDOW
453 && IMAGE_INSTANCE_X_PIXELS (p))
454 {
455 xfree (IMAGE_INSTANCE_X_PIXELS (p));
456 IMAGE_INSTANCE_X_PIXELS (p) = 0;
457 }
458
459 xfree (p->data);
460 p->data = 0;
461 }
462
463 static int
464 x_image_instance_equal (struct Lisp_Image_Instance *p1,
465 struct Lisp_Image_Instance *p2, int depth)
466 {
467 switch (IMAGE_INSTANCE_TYPE (p1))
468 {
469 case IMAGE_MONO_PIXMAP:
470 case IMAGE_COLOR_PIXMAP:
471 case IMAGE_POINTER:
472 if (IMAGE_INSTANCE_X_COLORMAP (p1) != IMAGE_INSTANCE_X_COLORMAP (p2) ||
473 IMAGE_INSTANCE_X_NPIXELS (p1) != IMAGE_INSTANCE_X_NPIXELS (p2))
474 return 0;
475 break;
476 default:
477 break;
478 }
479
480 return 1;
481 }
482
483 static unsigned long
484 x_image_instance_hash (struct Lisp_Image_Instance *p, int depth)
485 {
486 switch (IMAGE_INSTANCE_TYPE (p))
487 {
488 case IMAGE_MONO_PIXMAP:
489 case IMAGE_COLOR_PIXMAP:
490 case IMAGE_POINTER:
491 return IMAGE_INSTANCE_X_NPIXELS (p);
492 default:
493 return 0;
494 }
495 }
496
497 /* Set all the slots in an image instance structure to reasonable
498 default values. This is used somewhere within an instantiate
499 method. It is assumed that the device slot within the image
500 instance is already set -- this is the case when instantiate
501 methods are called. */
502
503 static void
504 x_initialize_pixmap_image_instance (struct Lisp_Image_Instance *ii,
505 int slices,
506 enum image_instance_type type)
507 {
508 ii->data = xnew_and_zero (struct x_image_instance_data);
509 IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) = slices;
510 IMAGE_INSTANCE_X_PIXMAP_SLICES (ii) =
511 xnew_array_and_zero (Pixmap, slices);
512 IMAGE_INSTANCE_TYPE (ii) = type;
513 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = Qnil;
514 IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (ii) = Qnil;
515 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) = Qnil;
516 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) = Qnil;
517 IMAGE_INSTANCE_PIXMAP_FG (ii) = Qnil;
518 IMAGE_INSTANCE_PIXMAP_BG (ii) = Qnil;
519 }
520
521
522 /************************************************************************/
523 /* pixmap file functions */
524 /************************************************************************/
525
526 /* Where bitmaps are; initialized from resource database */
527 Lisp_Object Vx_bitmap_file_path;
528
529 #ifndef BITMAPDIR
530 #define BITMAPDIR "/usr/include/X11/bitmaps"
531 #endif
532
533 #define USE_XBMLANGPATH
534
535 /* Given a pixmap filename, look through all of the "standard" places
536 where the file might be located. Return a full pathname if found;
537 otherwise, return Qnil. */
538
539 static Lisp_Object
540 x_locate_pixmap_file (Lisp_Object name)
541 {
542 /* This function can GC if IN_REDISPLAY is false */
543 Display *display;
544
545 /* Check non-absolute pathnames with a directory component relative to
546 the search path; that's the way Xt does it. */
547 /* #### Unix-specific */
548 if (XSTRING_BYTE (name, 0) == '/' ||
549 (XSTRING_BYTE (name, 0) == '.' &&
550 (XSTRING_BYTE (name, 1) == '/' ||
551 (XSTRING_BYTE (name, 1) == '.' &&
552 (XSTRING_BYTE (name, 2) == '/')))))
553 {
554 if (!NILP (Ffile_readable_p (name)))
555 return name;
556 else
557 return Qnil;
558 }
559
560 if (NILP (Vdefault_x_device))
561 /* This may occur during initialization. */
562 return Qnil;
563 else
564 /* We only check the bitmapFilePath resource on the original X device. */
565 display = DEVICE_X_DISPLAY (XDEVICE (Vdefault_x_device));
566
567 #ifdef USE_XBMLANGPATH
568 {
569 char *path = egetenv ("XBMLANGPATH");
570 SubstitutionRec subs[1];
571 subs[0].match = 'B';
572 subs[0].substitution = (char *) XSTRING_DATA (name);
573 /* #### Motif uses a big hairy default if $XBMLANGPATH isn't set.
574 We don't. If you want it used, set it. */
575 if (path &&
576 (path = XtResolvePathname (display, "bitmaps", 0, 0, path,
577 subs, XtNumber (subs), 0)))
578 {
579 name = build_string (path);
580 XtFree (path);
581 return (name);
582 }
583 }
584 #endif
585
586 if (NILP (Vx_bitmap_file_path))
587 {
588 char *type = 0;
589 XrmValue value;
590 if (XrmGetResource (XtDatabase (display),
591 "bitmapFilePath", "BitmapFilePath", &type, &value)
592 && !strcmp (type, "String"))
593 Vx_bitmap_file_path = decode_env_path (0, (char *) value.addr);
594 Vx_bitmap_file_path = nconc2 (Vx_bitmap_file_path,
595 (decode_path (BITMAPDIR)));
596 }
597
598 {
599 Lisp_Object found;
600 if (locate_file (Vx_bitmap_file_path, name, Qnil, &found, R_OK) < 0)
601 {
602 Lisp_Object temp = list1 (Vdata_directory);
603 struct gcpro gcpro1;
604
605 GCPRO1 (temp);
606 locate_file (temp, name, Qnil, &found, R_OK);
607 UNGCPRO;
608 }
609
610 return found;
611 }
612 }
613
614 static Lisp_Object
615 locate_pixmap_file (Lisp_Object name)
616 {
617 return x_locate_pixmap_file (name);
618 }
619
620 #if 0
621 static void
622 write_lisp_string_to_temp_file (Lisp_Object string, char *filename_out)
623 {
624 Lisp_Object instream, outstream;
625 Lstream *istr, *ostr;
626 char tempbuf[1024]; /* some random amount */
627 int fubar = 0;
628 FILE *tmpfil;
629 static Extbyte_dynarr *conversion_out_dynarr;
630 Bytecount bstart, bend;
631 struct gcpro gcpro1, gcpro2;
632 #ifdef FILE_CODING
633 Lisp_Object conv_out_stream;
634 Lstream *costr;
635 struct gcpro gcpro3;
636 #endif
637
638 /* This function can GC */
639 if (!conversion_out_dynarr)
640 conversion_out_dynarr = Dynarr_new (Extbyte);
641 else
642 Dynarr_reset (conversion_out_dynarr);
643
644 /* Create the temporary file ... */
645 sprintf (filename_out, "/tmp/emacs%d.XXXXXX", (int) getpid ());
646 mktemp (filename_out);
647 tmpfil = fopen (filename_out, "w");
648 if (!tmpfil)
649 {
650 if (tmpfil)
651 {
652 int old_errno = errno;
653 fclose (tmpfil);
654 unlink (filename_out);
655 errno = old_errno;
656 }
657 report_file_error ("Creating temp file",
658 list1 (build_string (filename_out)));
659 }
660
661 CHECK_STRING (string);
662 get_string_range_byte (string, Qnil, Qnil, &bstart, &bend,
663 GB_HISTORICAL_STRING_BEHAVIOR);
664 instream = make_lisp_string_input_stream (string, bstart, bend);
665 istr = XLSTREAM (instream);
666 /* setup the out stream */
667 outstream = make_dynarr_output_stream((unsigned_char_dynarr *)conversion_out_dynarr);
668 ostr = XLSTREAM (outstream);
669 #ifdef FILE_CODING
670 /* setup the conversion stream */
671 conv_out_stream = make_encoding_output_stream (ostr, Fget_coding_system(Qbinary));
672 costr = XLSTREAM (conv_out_stream);
673 GCPRO3 (instream, outstream, conv_out_stream);
674 #else
675 GCPRO2 (instream, outstream);
676 #endif
677
678 /* Get the data while doing the conversion */
679 while (1)
680 {
681 ssize_t size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
682 if (!size_in_bytes)
683 break;
684 /* It does seem the flushes are necessary... */
685 #ifdef FILE_CODING
686 Lstream_write (costr, tempbuf, size_in_bytes);
687 Lstream_flush (costr);
688 #else
689 Lstream_write (ostr, tempbuf, size_in_bytes);
690 #endif
691 Lstream_flush (ostr);
692 if (fwrite ((unsigned char *)Dynarr_atp(conversion_out_dynarr, 0),
693 Dynarr_length(conversion_out_dynarr), 1, tmpfil) != 1)
694 {
695 fubar = 1;
696 break;
697 }
698 /* reset the dynarr */
699 Lstream_rewind(ostr);
700 }
701
702 if (fclose (tmpfil) != 0)
703 fubar = 1;
704 Lstream_close (istr);
705 #ifdef FILE_CODING
706 Lstream_close (costr);
707 #endif
708 Lstream_close (ostr);
709
710 UNGCPRO;
711 Lstream_delete (istr);
712 Lstream_delete (ostr);
713 #ifdef FILE_CODING
714 Lstream_delete (costr);
715 #endif
716
717 if (fubar)
718 report_file_error ("Writing temp file",
719 list1 (build_string (filename_out)));
720 }
721 #endif /* 0 */
722
723
724 /************************************************************************/
725 /* cursor functions */
726 /************************************************************************/
727
728 /* Check that this server supports cursors of size WIDTH * HEIGHT. If
729 not, signal an error. INSTANTIATOR is only used in the error
730 message. */
731
732 static void
733 check_pointer_sizes (Screen *xs, unsigned int width, unsigned int height,
734 Lisp_Object instantiator)
735 {
736 unsigned int best_width, best_height;
737 if (! XQueryBestCursor (DisplayOfScreen (xs), RootWindowOfScreen (xs),
738 width, height, &best_width, &best_height))
739 /* this means that an X error of some sort occurred (we trap
740 these so they're not fatal). */
741 signal_simple_error ("XQueryBestCursor() failed?", instantiator);
742
743 if (width > best_width || height > best_height)
744 error_with_frob (instantiator,
745 "pointer too large (%dx%d): "
746 "server requires %dx%d or smaller",
747 width, height, best_width, best_height);
748 }
749
750
751 static void
752 generate_cursor_fg_bg (Lisp_Object device, Lisp_Object *foreground,
753 Lisp_Object *background, XColor *xfg, XColor *xbg)
754 {
755 if (!NILP (*foreground) && !COLOR_INSTANCEP (*foreground))
756 *foreground =
757 Fmake_color_instance (*foreground, device,
758 encode_error_behavior_flag (ERROR_ME));
759 if (COLOR_INSTANCEP (*foreground))
760 *xfg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (*foreground));
761 else
762 {
763 xfg->pixel = 0;
764 xfg->red = xfg->green = xfg->blue = 0;
765 }
766
767 if (!NILP (*background) && !COLOR_INSTANCEP (*background))
768 *background =
769 Fmake_color_instance (*background, device,
770 encode_error_behavior_flag (ERROR_ME));
771 if (COLOR_INSTANCEP (*background))
772 *xbg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (*background));
773 else
774 {
775 xbg->pixel = 0;
776 xbg->red = xbg->green = xbg->blue = ~0;
777 }
778 }
779
780 static void
781 maybe_recolor_cursor (Lisp_Object image_instance, Lisp_Object foreground,
782 Lisp_Object background)
783 {
784 Lisp_Object device = XIMAGE_INSTANCE_DEVICE (image_instance);
785 XColor xfg, xbg;
786
787 generate_cursor_fg_bg (device, &foreground, &background, &xfg, &xbg);
788 if (!NILP (foreground) || !NILP (background))
789 {
790 XRecolorCursor (DEVICE_X_DISPLAY (XDEVICE (device)),
791 XIMAGE_INSTANCE_X_CURSOR (image_instance),
792 &xfg, &xbg);
793 XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
794 XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
795 }
796 }
797
798
799 /************************************************************************/
800 /* color pixmap functions */
801 /************************************************************************/
802
803 /* Initialize an image instance from an XImage.
804
805 DEST_MASK specifies the mask of allowed image types.
806
807 PIXELS and NPIXELS specify an array of pixels that are used in
808 the image. These need to be kept around for the duration of the
809 image. When the image instance is freed, XFreeColors() will
810 automatically be called on all the pixels specified here; thus,
811 you should have allocated the pixels yourself using XAllocColor()
812 or the like. The array passed in is used directly without
813 being copied, so it should be heap data created with xmalloc().
814 It will be freed using xfree() when the image instance is
815 destroyed.
816
817 If this fails, signal an error. INSTANTIATOR is only used
818 in the error message.
819
820 #### This should be able to handle conversion into `pointer'.
821 Use the same code as for `xpm'. */
822
823 static void
824 init_image_instance_from_x_image (struct Lisp_Image_Instance *ii,
825 XImage *ximage,
826 int dest_mask,
827 Colormap cmap,
828 unsigned long *pixels,
829 int npixels,
830 int slices,
831 Lisp_Object instantiator)
832 {
833 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
834 Display *dpy;
835 GC gc;
836 Drawable d;
837 Pixmap pixmap;
838
839 if (!DEVICE_X_P (XDEVICE (device)))
840 signal_simple_error ("Not an X device", device);
841
842 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
843 d = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
844
845 if (!(dest_mask & IMAGE_COLOR_PIXMAP_MASK))
846 incompatible_image_types (instantiator, dest_mask,
847 IMAGE_COLOR_PIXMAP_MASK);
848
849 pixmap = XCreatePixmap (dpy, d, ximage->width,
850 ximage->height, ximage->depth);
851 if (!pixmap)
852 signal_simple_error ("Unable to create pixmap", instantiator);
853
854 gc = XCreateGC (dpy, pixmap, 0, NULL);
855 if (!gc)
856 {
857 XFreePixmap (dpy, pixmap);
858 signal_simple_error ("Unable to create GC", instantiator);
859 }
860
861 XPutImage (dpy, pixmap, gc, ximage, 0, 0, 0, 0,
862 ximage->width, ximage->height);
863
864 XFreeGC (dpy, gc);
865
866 x_initialize_pixmap_image_instance (ii, slices, IMAGE_COLOR_PIXMAP);
867
868 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
869 find_keyword_in_vector (instantiator, Q_file);
870
871 /* Fixup a set of pixmaps. */
872 IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
873
874 IMAGE_INSTANCE_PIXMAP_MASK (ii) = 0;
875 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = ximage->width;
876 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = ximage->height;
877 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = ximage->depth;
878 IMAGE_INSTANCE_X_COLORMAP (ii) = cmap;
879 IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
880 IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
881 }
882
883 static void
884 image_instance_add_x_image (struct Lisp_Image_Instance *ii,
885 XImage *ximage,
886 int slice,
887 Lisp_Object instantiator)
888 {
889 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
890 Display *dpy;
891 GC gc;
892 Drawable d;
893 Pixmap pixmap;
894
895 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
896 d = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
897
898 pixmap = XCreatePixmap (dpy, d, ximage->width,
899 ximage->height, ximage->depth);
900 if (!pixmap)
901 signal_simple_error ("Unable to create pixmap", instantiator);
902
903 gc = XCreateGC (dpy, pixmap, 0, NULL);
904 if (!gc)
905 {
906 XFreePixmap (dpy, pixmap);
907 signal_simple_error ("Unable to create GC", instantiator);
908 }
909
910 XPutImage (dpy, pixmap, gc, ximage, 0, 0, 0, 0,
911 ximage->width, ximage->height);
912
913 XFreeGC (dpy, gc);
914
915 IMAGE_INSTANCE_X_PIXMAP_SLICE (ii, slice) = pixmap;
916 }
917
918 static void
919 x_init_image_instance_from_eimage (struct Lisp_Image_Instance *ii,
920 int width, int height,
921 int slices,
922 unsigned char *eimage,
923 int dest_mask,
924 Lisp_Object instantiator,
925 Lisp_Object domain)
926 {
927 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
928 Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device));
929 unsigned long *pixtbl = NULL;
930 int npixels = 0;
931 int slice;
932 XImage* ximage;
933
934 for (slice = 0; slice < slices; slice++)
935 {
936 ximage = convert_EImage_to_XImage (device, width, height,
937 eimage + (width * height * 3 * slice),
938 &pixtbl, &npixels);
939 if (!ximage)
940 {
941 if (pixtbl) xfree (pixtbl);
942 signal_image_error("EImage to XImage conversion failed", instantiator);
943 }
944
945 /* Now create the pixmap and set up the image instance */
946 if (slice == 0)
947 init_image_instance_from_x_image (ii, ximage, dest_mask,
948 cmap, pixtbl, npixels, slices,
949 instantiator);
950 else
951 image_instance_add_x_image (ii, ximage, slice, instantiator);
952
953 if (ximage)
954 {
955 if (ximage->data)
956 {
957 xfree (ximage->data);
958 ximage->data = 0;
959 }
960 XDestroyImage (ximage);
961 ximage = 0;
962 }
963 }
964 }
965
966 int read_bitmap_data_from_file (CONST char *filename, unsigned int *width,
967 unsigned int *height, unsigned char **datap,
968 int *x_hot, int *y_hot)
969 {
970 return XmuReadBitmapDataFromFile (filename, width, height,
971 datap, x_hot, y_hot);
972 }
973
974 /* Given inline data for a mono pixmap, create and return the
975 corresponding X object. */
976
977 static Pixmap
978 pixmap_from_xbm_inline (Lisp_Object device, int width, int height,
979 /* Note that data is in ext-format! */
980 CONST Extbyte *bits)
981 {
982 return XCreatePixmapFromBitmapData (DEVICE_X_DISPLAY (XDEVICE(device)),
983 XtWindow (DEVICE_XT_APP_SHELL (XDEVICE (device))),
984 (char *) bits, width, height,
985 1, 0, 1);
986 }
987
988 /* Given inline data for a mono pixmap, initialize the given
989 image instance accordingly. */
990
991 static void
992 init_image_instance_from_xbm_inline (struct Lisp_Image_Instance *ii,
993 int width, int height,
994 /* Note that data is in ext-format! */
995 CONST char *bits,
996 Lisp_Object instantiator,
997 Lisp_Object pointer_fg,
998 Lisp_Object pointer_bg,
999 int dest_mask,
1000 Pixmap mask,
1001 Lisp_Object mask_filename)
1002 {
1003 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1004 Lisp_Object foreground = find_keyword_in_vector (instantiator, Q_foreground);
1005 Lisp_Object background = find_keyword_in_vector (instantiator, Q_background);
1006 Display *dpy;
1007 Screen *scr;
1008 Drawable draw;
1009 enum image_instance_type type;
1010
1011 if (!DEVICE_X_P (XDEVICE (device)))
1012 signal_simple_error ("Not an X device", device);
1013
1014 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1015 draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device)));
1016 scr = DefaultScreenOfDisplay (dpy);
1017
1018 if ((dest_mask & IMAGE_MONO_PIXMAP_MASK) &&
1019 (dest_mask & IMAGE_COLOR_PIXMAP_MASK))
1020 {
1021 if (!NILP (foreground) || !NILP (background))
1022 type = IMAGE_COLOR_PIXMAP;
1023 else
1024 type = IMAGE_MONO_PIXMAP;
1025 }
1026 else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
1027 type = IMAGE_MONO_PIXMAP;
1028 else if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
1029 type = IMAGE_COLOR_PIXMAP;
1030 else if (dest_mask & IMAGE_POINTER_MASK)
1031 type = IMAGE_POINTER;
1032 else
1033 incompatible_image_types (instantiator, dest_mask,
1034 IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
1035 | IMAGE_POINTER_MASK);
1036
1037 x_initialize_pixmap_image_instance (ii, 1, type);
1038 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = width;
1039 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = height;
1040 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
1041 find_keyword_in_vector (instantiator, Q_file);
1042
1043 switch (type)
1044 {
1045 case IMAGE_MONO_PIXMAP:
1046 {
1047 IMAGE_INSTANCE_X_PIXMAP (ii) =
1048 pixmap_from_xbm_inline (device, width, height, (Extbyte *) bits);
1049 }
1050 break;
1051
1052 case IMAGE_COLOR_PIXMAP:
1053 {
1054 Dimension d = DEVICE_X_DEPTH (XDEVICE(device));
1055 unsigned long fg = BlackPixelOfScreen (scr);
1056 unsigned long bg = WhitePixelOfScreen (scr);
1057
1058 if (!NILP (foreground) && !COLOR_INSTANCEP (foreground))
1059 foreground =
1060 Fmake_color_instance (foreground, device,
1061 encode_error_behavior_flag (ERROR_ME));
1062
1063 if (COLOR_INSTANCEP (foreground))
1064 fg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground)).pixel;
1065
1066 if (!NILP (background) && !COLOR_INSTANCEP (background))
1067 background =
1068 Fmake_color_instance (background, device,
1069 encode_error_behavior_flag (ERROR_ME));
1070
1071 if (COLOR_INSTANCEP (background))
1072 bg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background)).pixel;
1073
1074 /* We used to duplicate the pixels using XAllocColor(), to protect
1075 against their getting freed. Just as easy to just store the
1076 color instances here and GC-protect them, so this doesn't
1077 happen. */
1078 IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
1079 IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
1080 IMAGE_INSTANCE_X_PIXMAP (ii) =
1081 XCreatePixmapFromBitmapData (dpy, draw,
1082 (char *) bits, width, height,
1083 fg, bg, d);
1084 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = d;
1085 }
1086 break;
1087
1088 case IMAGE_POINTER:
1089 {
1090 XColor fg_color, bg_color;
1091 Pixmap source;
1092
1093 check_pointer_sizes (scr, width, height, instantiator);
1094
1095 source =
1096 XCreatePixmapFromBitmapData (dpy, draw,
1097 (char *) bits, width, height,
1098 1, 0, 1);
1099
1100 if (NILP (foreground))
1101 foreground = pointer_fg;
1102 if (NILP (background))
1103 background = pointer_bg;
1104 generate_cursor_fg_bg (device, &foreground, &background,
1105 &fg_color, &bg_color);
1106
1107 IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
1108 IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
1109 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) =
1110 find_keyword_in_vector (instantiator, Q_hotspot_x);
1111 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) =
1112 find_keyword_in_vector (instantiator, Q_hotspot_y);
1113 IMAGE_INSTANCE_X_CURSOR (ii) =
1114 XCreatePixmapCursor
1115 (dpy, source, mask, &fg_color, &bg_color,
1116 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ?
1117 XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) : 0,
1118 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) ?
1119 XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) : 0);
1120 }
1121 break;
1122
1123 default:
1124 abort ();
1125 }
1126 }
1127
1128 static void
1129 xbm_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator,
1130 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1131 int dest_mask, int width, int height,
1132 /* Note that data is in ext-format! */
1133 CONST char *bits)
1134 {
1135 Lisp_Object mask_data = find_keyword_in_vector (instantiator, Q_mask_data);
1136 Lisp_Object mask_file = find_keyword_in_vector (instantiator, Q_mask_file);
1137 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1138 Pixmap mask = 0;
1139 CONST char *gcc_may_you_rot_in_hell;
1140
1141 if (!NILP (mask_data))
1142 {
1143 GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (mask_data))),
1144 gcc_may_you_rot_in_hell);
1145 mask =
1146 pixmap_from_xbm_inline (IMAGE_INSTANCE_DEVICE (ii),
1147 XINT (XCAR (mask_data)),
1148 XINT (XCAR (XCDR (mask_data))),
1149 (CONST unsigned char *)
1150 gcc_may_you_rot_in_hell);
1151 }
1152
1153 init_image_instance_from_xbm_inline (ii, width, height, bits,
1154 instantiator, pointer_fg, pointer_bg,
1155 dest_mask, mask, mask_file);
1156 }
1157
1158 /* Instantiate method for XBM's. */
1159
1160 static void
1161 x_xbm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1162 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1163 int dest_mask, Lisp_Object domain)
1164 {
1165 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1166 CONST char *gcc_go_home;
1167
1168 assert (!NILP (data));
1169
1170 GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (data))),
1171 gcc_go_home);
1172
1173 xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1174 pointer_bg, dest_mask, XINT (XCAR (data)),
1175 XINT (XCAR (XCDR (data))), gcc_go_home);
1176 }
1177
1178
1179 #ifdef HAVE_XPM
1180
1181 /**********************************************************************
1182 * XPM *
1183 **********************************************************************/
1184 /* xpm 3.2g and better has XpmCreatePixmapFromBuffer()...
1185 There was no version number in xpm.h before 3.3, but this should do.
1186 */
1187 #if (XpmVersion >= 3) || defined(XpmExactColors)
1188 # define XPM_DOES_BUFFERS
1189 #endif
1190
1191 #ifndef XPM_DOES_BUFFERS
1192 Your version of XPM is too old. You cannot compile with it.
1193 Upgrade to version 3.2g or better or compile with --with-xpm=no.
1194 #endif /* !XPM_DOES_BUFFERS */
1195
1196 static XpmColorSymbol *
1197 extract_xpm_color_names (XpmAttributes *xpmattrs, Lisp_Object device,
1198 Lisp_Object domain,
1199 Lisp_Object color_symbol_alist)
1200 {
1201 /* This function can GC */
1202 Display *dpy = DEVICE_X_DISPLAY (XDEVICE(device));
1203 Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1204 XColor color;
1205 Lisp_Object rest;
1206 Lisp_Object results = Qnil;
1207 int i;
1208 XpmColorSymbol *symbols;
1209 struct gcpro gcpro1, gcpro2;
1210
1211 GCPRO2 (results, device);
1212
1213 /* We built up results to be (("name" . #<color>) ...) so that if an
1214 error happens we don't lose any malloc()ed data, or more importantly,
1215 leave any pixels allocated in the server. */
1216 i = 0;
1217 LIST_LOOP (rest, color_symbol_alist)
1218 {
1219 Lisp_Object cons = XCAR (rest);
1220 Lisp_Object name = XCAR (cons);
1221 Lisp_Object value = XCDR (cons);
1222 if (NILP (value))
1223 continue;
1224 if (STRINGP (value))
1225 value =
1226 Fmake_color_instance
1227 (value, device, encode_error_behavior_flag (ERROR_ME_NOT));
1228 else
1229 {
1230 assert (COLOR_SPECIFIERP (value));
1231 value = Fspecifier_instance (value, domain, Qnil, Qnil);
1232 }
1233 if (NILP (value))
1234 continue;
1235 results = noseeum_cons (noseeum_cons (name, value), results);
1236 i++;
1237 }
1238 UNGCPRO; /* no more evaluation */
1239
1240 if (i == 0) return 0;
1241
1242 symbols = xnew_array (XpmColorSymbol, i);
1243 xpmattrs->valuemask |= XpmColorSymbols;
1244 xpmattrs->colorsymbols = symbols;
1245 xpmattrs->numsymbols = i;
1246
1247 while (--i >= 0)
1248 {
1249 Lisp_Object cons = XCAR (results);
1250 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (XCDR (cons)));
1251 /* Duplicate the pixel value so that we still have a lock on it if
1252 the pixel we were passed is later freed. */
1253 if (! XAllocColor (dpy, cmap, &color))
1254 abort (); /* it must be allocable since we're just duplicating it */
1255
1256 symbols [i].name = (char *) XSTRING_DATA (XCAR (cons));
1257 symbols [i].pixel = color.pixel;
1258 symbols [i].value = 0;
1259 free_cons (XCONS (cons));
1260 cons = results;
1261 results = XCDR (results);
1262 free_cons (XCONS (cons));
1263 }
1264 return symbols;
1265 }
1266
1267 static void
1268 xpm_free (XpmAttributes *xpmattrs)
1269 {
1270 /* Could conceivably lose if XpmXXX returned an error without first
1271 initializing this structure, if we didn't know that initializing it
1272 to all zeros was ok (and also that it's ok to call XpmFreeAttributes()
1273 multiple times, since it zeros slots as it frees them...) */
1274 XpmFreeAttributes (xpmattrs);
1275 }
1276
1277 static void
1278 x_xpm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1279 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1280 int dest_mask, Lisp_Object domain)
1281 {
1282 /* This function can GC */
1283 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1284 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1285 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1286 Display *dpy;
1287 Screen *xs;
1288 Colormap cmap;
1289 int depth;
1290 Visual *visual;
1291 Pixmap pixmap;
1292 Pixmap mask = 0;
1293 XpmAttributes xpmattrs;
1294 int result;
1295 XpmColorSymbol *color_symbols;
1296 Lisp_Object color_symbol_alist = find_keyword_in_vector (instantiator,
1297 Q_color_symbols);
1298 enum image_instance_type type;
1299 int force_mono;
1300 unsigned int w, h;
1301
1302 if (!DEVICE_X_P (XDEVICE (device)))
1303 signal_simple_error ("Not an X device", device);
1304
1305 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1306 xs = DefaultScreenOfDisplay (dpy);
1307
1308 if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
1309 type = IMAGE_COLOR_PIXMAP;
1310 else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
1311 type = IMAGE_MONO_PIXMAP;
1312 else if (dest_mask & IMAGE_POINTER_MASK)
1313 type = IMAGE_POINTER;
1314 else
1315 incompatible_image_types (instantiator, dest_mask,
1316 IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
1317 | IMAGE_POINTER_MASK);
1318 force_mono = (type != IMAGE_COLOR_PIXMAP);
1319
1320 #if 1
1321 /* Although I haven't found it documented yet, it appears that pointers are
1322 always colored via the default window colormap... Sigh. */
1323 if (type == IMAGE_POINTER)
1324 {
1325 cmap = DefaultColormap(dpy, DefaultScreen(dpy));
1326 depth = DefaultDepthOfScreen (xs);
1327 visual = DefaultVisualOfScreen (xs);
1328 }
1329 else
1330 {
1331 cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1332 depth = DEVICE_X_DEPTH (XDEVICE(device));
1333 visual = DEVICE_X_VISUAL (XDEVICE(device));
1334 }
1335 #else
1336 cmap = DEVICE_X_COLORMAP (XDEVICE(device));
1337 depth = DEVICE_X_DEPTH (XDEVICE(device));
1338 visual = DEVICE_X_VISUAL (XDEVICE(device));
1339 #endif
1340
1341 x_initialize_pixmap_image_instance (ii, 1, type);
1342
1343 assert (!NILP (data));
1344
1345 retry:
1346
1347 xzero (xpmattrs); /* want XpmInitAttributes() */
1348 xpmattrs.valuemask = XpmReturnPixels;
1349 if (force_mono)
1350 {
1351 /* Without this, we get a 1-bit version of the color image, which
1352 isn't quite right. With this, we get the mono image, which might
1353 be very different looking. */
1354 xpmattrs.valuemask |= XpmColorKey;
1355 xpmattrs.color_key = XPM_MONO;
1356 xpmattrs.depth = 1;
1357 xpmattrs.valuemask |= XpmDepth;
1358 }
1359 else
1360 {
1361 xpmattrs.closeness = 65535;
1362 xpmattrs.valuemask |= XpmCloseness;
1363 xpmattrs.depth = depth;
1364 xpmattrs.valuemask |= XpmDepth;
1365 xpmattrs.visual = visual;
1366 xpmattrs.valuemask |= XpmVisual;
1367 xpmattrs.colormap = cmap;
1368 xpmattrs.valuemask |= XpmColormap;
1369 }
1370
1371 color_symbols = extract_xpm_color_names (&xpmattrs, device, domain,
1372 color_symbol_alist);
1373
1374 result = XpmCreatePixmapFromBuffer (dpy,
1375 XtWindow(DEVICE_XT_APP_SHELL (XDEVICE(device))),
1376 (char *) XSTRING_DATA (data),
1377 &pixmap, &mask, &xpmattrs);
1378
1379 if (color_symbols)
1380 {
1381 xfree (color_symbols);
1382 xpmattrs.colorsymbols = 0; /* in case XpmFreeAttr is too smart... */
1383 xpmattrs.numsymbols = 0;
1384 }
1385
1386 switch (result)
1387 {
1388 case XpmSuccess:
1389 break;
1390 case XpmFileInvalid:
1391 {
1392 xpm_free (&xpmattrs);
1393 signal_image_error ("invalid XPM data", data);
1394 }
1395 case XpmColorFailed:
1396 case XpmColorError:
1397 {
1398 xpm_free (&xpmattrs);
1399 if (force_mono)
1400 {
1401 /* second time; blow out. */
1402 signal_double_file_error ("Reading pixmap data",
1403 "color allocation failed",
1404 data);
1405 }
1406 else
1407 {
1408 if (! (dest_mask & IMAGE_MONO_PIXMAP_MASK))
1409 {
1410 /* second time; blow out. */
1411 signal_double_file_error ("Reading pixmap data",
1412 "color allocation failed",
1413 data);
1414 }
1415 force_mono = 1;
1416 IMAGE_INSTANCE_TYPE (ii) = IMAGE_MONO_PIXMAP;
1417 goto retry;
1418 }
1419 }
1420 case XpmNoMemory:
1421 {
1422 xpm_free (&xpmattrs);
1423 signal_double_file_error ("Parsing pixmap data",
1424 "out of memory", data);
1425 }
1426 default:
1427 {
1428 xpm_free (&xpmattrs);
1429 signal_double_file_error_2 ("Parsing pixmap data",
1430 "unknown error code",
1431 make_int (result), data);
1432 }
1433 }
1434
1435 w = xpmattrs.width;
1436 h = xpmattrs.height;
1437
1438 {
1439 int npixels = xpmattrs.npixels;
1440 Pixel *pixels;
1441
1442 if (npixels != 0)
1443 {
1444 pixels = xnew_array (Pixel, npixels);
1445 memcpy (pixels, xpmattrs.pixels, npixels * sizeof (Pixel));
1446 }
1447 else
1448 pixels = NULL;
1449
1450 IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
1451 IMAGE_INSTANCE_PIXMAP_MASK (ii) = (void*)mask;
1452 IMAGE_INSTANCE_X_COLORMAP (ii) = cmap;
1453 IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
1454 IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
1455 IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = w;
1456 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = h;
1457 IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
1458 find_keyword_in_vector (instantiator, Q_file);
1459 }
1460
1461 switch (type)
1462 {
1463 case IMAGE_MONO_PIXMAP:
1464 break;
1465
1466 case IMAGE_COLOR_PIXMAP:
1467 {
1468 IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = depth;
1469 }
1470 break;
1471
1472 case IMAGE_POINTER:
1473 {
1474 int npixels = xpmattrs.npixels;
1475 Pixel *pixels = xpmattrs.pixels;
1476 XColor fg, bg;
1477 int i;
1478 int xhot = 0, yhot = 0;
1479
1480 if (xpmattrs.valuemask & XpmHotspot)
1481 {
1482 xhot = xpmattrs.x_hotspot;
1483 XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii), xpmattrs.x_hotspot);
1484 }
1485 if (xpmattrs.valuemask & XpmHotspot)
1486 {
1487 yhot = xpmattrs.y_hotspot;
1488 XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii), xpmattrs.y_hotspot);
1489 }
1490 check_pointer_sizes (xs, w, h, instantiator);
1491
1492 /* If the loaded pixmap has colors allocated (meaning it came from an
1493 XPM file), then use those as the default colors for the cursor we
1494 create. Otherwise, default to pointer_fg and pointer_bg.
1495 */
1496 if (npixels >= 2)
1497 {
1498 /* With an XBM file, it's obvious which bit is foreground
1499 and which is background, or rather, it's implicit: in
1500 an XBM file, a 1 bit is foreground, and a 0 bit is
1501 background.
1502
1503 XCreatePixmapCursor() assumes this property of the
1504 pixmap it is called with as well; the `foreground'
1505 color argument is used for the 1 bits.
1506
1507 With an XPM file, it's tricker, since the elements of
1508 the pixmap don't represent FG and BG, but are actual
1509 pixel values. So we need to figure out which of those
1510 pixels is the foreground color and which is the
1511 background. We do it by comparing RGB and assuming
1512 that the darker color is the foreground. This works
1513 with the result of xbmtopbm|ppmtoxpm, at least.
1514
1515 It might be nice if there was some way to tag the
1516 colors in the XPM file with whether they are the
1517 foreground - perhaps with logical color names somehow?
1518
1519 Once we have decided which color is the foreground, we
1520 need to ensure that that color corresponds to a `1' bit
1521 in the Pixmap. The XPM library wrote into the (1-bit)
1522 pixmap with XPutPixel, which will ignore all but the
1523 least significant bit.
1524
1525 This means that a 1 bit in the image corresponds to
1526 `fg' only if `fg.pixel' is odd.
1527
1528 (This also means that the image will be all the same
1529 color if both `fg' and `bg' are odd or even, but we can
1530 safely assume that that won't happen if the XPM file is
1531 sensible I think.)
1532
1533 The desired result is that the image use `1' to
1534 represent the foreground color, and `0' to represent
1535 the background color. So, we may need to invert the
1536 image to accomplish this; we invert if fg is
1537 odd. (Remember that WhitePixel and BlackPixel are not
1538 necessarily 1 and 0 respectively, though I think it
1539 might be safe to assume that one of them is always 1
1540 and the other is always 0. We also pretty much need to
1541 assume that one is even and the other is odd.)
1542 */
1543
1544 fg.pixel = pixels[0]; /* pick a pixel at random. */
1545 bg.pixel = fg.pixel;
1546 for (i = 1; i < npixels; i++) /* Look for an "other" pixel value.*/
1547 {
1548 bg.pixel = pixels[i];
1549 if (fg.pixel != bg.pixel)
1550 break;
1551 }
1552
1553 /* If (fg.pixel == bg.pixel) then probably something has
1554 gone wrong, but I don't think signalling an error would
1555 be appropriate. */
1556
1557 XQueryColor (dpy, cmap, &fg);
1558 XQueryColor (dpy, cmap, &bg);
1559
1560 /* If the foreground is lighter than the background, swap them.
1561 (This occurs semi-randomly, depending on the ordering of the
1562 color list in the XPM file.)
1563 */
1564 {
1565 unsigned short fg_total = ((fg.red / 3) + (fg.green / 3)
1566 + (fg.blue / 3));
1567 unsigned short bg_total = ((bg.red / 3) + (bg.green / 3)
1568 + (bg.blue / 3));
1569 if (fg_total > bg_total)
1570 {
1571 XColor swap;
1572 swap = fg;
1573 fg = bg;
1574 bg = swap;
1575 }
1576 }
1577
1578 /* If the fg pixel corresponds to a `0' in the bitmap, invert it.
1579 (This occurs (only?) on servers with Black=0, White=1.)
1580 */
1581 if ((fg.pixel & 1) == 0)
1582 {
1583 XGCValues gcv;
1584 GC gc;
1585 gcv.function = GXxor;
1586 gcv.foreground = 1;
1587 gc = XCreateGC (dpy, pixmap, (GCFunction | GCForeground),
1588 &gcv);
1589 XFillRectangle (dpy, pixmap, gc, 0, 0, w, h);
1590 XFreeGC (dpy, gc);
1591 }
1592 }
1593 else
1594 {
1595 generate_cursor_fg_bg (device, &pointer_fg, &pointer_bg,
1596 &fg, &bg);
1597 IMAGE_INSTANCE_PIXMAP_FG (ii) = pointer_fg;
1598 IMAGE_INSTANCE_PIXMAP_BG (ii) = pointer_bg;
1599 }
1600
1601 IMAGE_INSTANCE_X_CURSOR (ii) =
1602 XCreatePixmapCursor
1603 (dpy, pixmap, mask, &fg, &bg, xhot, yhot);
1604 }
1605
1606 break;
1607
1608 default:
1609 abort ();
1610 }
1611
1612 xpm_free (&xpmattrs); /* after we've read pixels and hotspot */
1613 }
1614
1615 #endif /* HAVE_XPM */
1616
1617
1618 #ifdef HAVE_XFACE
1619
1620 /**********************************************************************
1621 * X-Face *
1622 **********************************************************************/
1623 #if defined(EXTERN)
1624 /* This is about to get redefined! */
1625 #undef EXTERN
1626 #endif
1627 /* We have to define SYSV32 so that compface.h includes string.h
1628 instead of strings.h. */
1629 #define SYSV32
1630 #ifdef __cplusplus
1631 extern "C" {
1632 #endif
1633 #include <compface.h>
1634 #ifdef __cplusplus
1635 }
1636 #endif
1637 /* JMP_BUF cannot be used here because if it doesn't get defined
1638 to jmp_buf we end up with a conflicting type error with the
1639 definition in compface.h */
1640 extern jmp_buf comp_env;
1641 #undef SYSV32
1642
1643 static void
1644 x_xface_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1645 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1646 int dest_mask, Lisp_Object domain)
1647 {
1648 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1649 int i, stattis;
1650 char *p, *bits, *bp;
1651 CONST char * volatile emsg = 0;
1652 CONST char * volatile dstring;
1653
1654 assert (!NILP (data));
1655
1656 GET_C_STRING_BINARY_DATA_ALLOCA (data, dstring);
1657
1658 if ((p = strchr (dstring, ':')))
1659 {
1660 dstring = p + 1;
1661 }
1662
1663 /* Must use setjmp not SETJMP because we used jmp_buf above not JMP_BUF */
1664 if (!(stattis = setjmp (comp_env)))
1665 {
1666 UnCompAll ((char *) dstring);
1667 UnGenFace ();
1668 }
1669
1670 switch (stattis)
1671 {
1672 case -2:
1673 emsg = "uncompface: internal error";
1674 break;
1675 case -1:
1676 emsg = "uncompface: insufficient or invalid data";
1677 break;
1678 case 1:
1679 emsg = "uncompface: excess data ignored";
1680 break;
1681 }
1682
1683 if (emsg)
1684 signal_simple_error_2 (emsg, data, Qimage);
1685
1686 bp = bits = (char *) alloca (PIXELS / 8);
1687
1688 /* the compface library exports char F[], which uses a single byte per
1689 pixel to represent a 48x48 bitmap. Yuck. */
1690 for (i = 0, p = F; i < (PIXELS / 8); ++i)
1691 {
1692 int n, b;
1693 /* reverse the bit order of each byte... */
1694 for (b = n = 0; b < 8; ++b)
1695 {
1696 n |= ((*p++) << b);
1697 }
1698 *bp++ = (char) n;
1699 }
1700
1701 xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
1702 pointer_bg, dest_mask, 48, 48, bits);
1703 }
1704
1705 #endif /* HAVE_XFACE */
1706
1707
1708 /**********************************************************************
1709 * Autodetect *
1710 **********************************************************************/
1711
1712 static void
1713 autodetect_validate (Lisp_Object instantiator)
1714 {
1715 data_must_be_present (instantiator);
1716 }
1717
1718 static Lisp_Object
1719 autodetect_normalize (Lisp_Object instantiator,
1720 Lisp_Object console_type)
1721 {
1722 Lisp_Object file = find_keyword_in_vector (instantiator, Q_data);
1723 Lisp_Object filename = Qnil;
1724 Lisp_Object data = Qnil;
1725 struct gcpro gcpro1, gcpro2, gcpro3;
1726 Lisp_Object alist = Qnil;
1727
1728 GCPRO3 (filename, data, alist);
1729
1730 if (NILP (file)) /* no conversion necessary */
1731 RETURN_UNGCPRO (instantiator);
1732
1733 alist = tagged_vector_to_alist (instantiator);
1734
1735 filename = locate_pixmap_file (file);
1736 if (!NILP (filename))
1737 {
1738 int xhot, yhot;
1739 /* #### Apparently some versions of XpmReadFileToData, which is
1740 called by pixmap_to_lisp_data, don't return an error value
1741 if the given file is not a valid XPM file. Instead, they
1742 just seg fault. It is definitely caused by passing a
1743 bitmap. To try and avoid this we check for bitmaps first. */
1744
1745 data = bitmap_to_lisp_data (filename, &xhot, &yhot, 1);
1746
1747 if (!EQ (data, Qt))
1748 {
1749 alist = remassq_no_quit (Q_data, alist);
1750 alist = Fcons (Fcons (Q_file, filename),
1751 Fcons (Fcons (Q_data, data), alist));
1752 if (xhot != -1)
1753 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
1754 alist);
1755 if (yhot != -1)
1756 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
1757 alist);
1758
1759 alist = xbm_mask_file_munging (alist, filename, Qnil, console_type);
1760
1761 {
1762 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
1763 free_alist (alist);
1764 RETURN_UNGCPRO (result);
1765 }
1766 }
1767
1768 #ifdef HAVE_XPM
1769 data = pixmap_to_lisp_data (filename, 1);
1770
1771 if (!EQ (data, Qt))
1772 {
1773 alist = remassq_no_quit (Q_data, alist);
1774 alist = Fcons (Fcons (Q_file, filename),
1775 Fcons (Fcons (Q_data, data), alist));
1776 alist = Fcons (Fcons (Q_color_symbols,
1777 evaluate_xpm_color_symbols ()),
1778 alist);
1779 {
1780 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
1781 free_alist (alist);
1782 RETURN_UNGCPRO (result);
1783 }
1784 }
1785 #endif
1786 }
1787
1788 /* If we couldn't convert it, just put it back as it is.
1789 We might try to further frob it later as a cursor-font
1790 specification. (We can't do that now because we don't know
1791 what dest-types it's going to be instantiated into.) */
1792 {
1793 Lisp_Object result = alist_to_tagged_vector (Qautodetect, alist);
1794 free_alist (alist);
1795 RETURN_UNGCPRO (result);
1796 }
1797 }
1798
1799 static int
1800 autodetect_possible_dest_types (void)
1801 {
1802 return
1803 IMAGE_MONO_PIXMAP_MASK |
1804 IMAGE_COLOR_PIXMAP_MASK |
1805 IMAGE_POINTER_MASK |
1806 IMAGE_TEXT_MASK;
1807 }
1808
1809 static void
1810 autodetect_instantiate (Lisp_Object image_instance,
1811 Lisp_Object instantiator,
1812 Lisp_Object pointer_fg,
1813 Lisp_Object pointer_bg,
1814 int dest_mask, Lisp_Object domain)
1815 {
1816 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1817 struct gcpro gcpro1, gcpro2, gcpro3;
1818 Lisp_Object alist = Qnil;
1819 Lisp_Object result = Qnil;
1820 int is_cursor_font = 0;
1821
1822 GCPRO3 (data, alist, result);
1823
1824 alist = tagged_vector_to_alist (instantiator);
1825 if (dest_mask & IMAGE_POINTER_MASK)
1826 {
1827 CONST char *name_ext;
1828 GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext);
1829 if (XmuCursorNameToIndex (name_ext) != -1)
1830 {
1831 result = alist_to_tagged_vector (Qcursor_font, alist);
1832 is_cursor_font = 1;
1833 }
1834 }
1835
1836 if (!is_cursor_font)
1837 result = alist_to_tagged_vector (Qstring, alist);
1838 free_alist (alist);
1839
1840 if (is_cursor_font)
1841 cursor_font_instantiate (image_instance, result, pointer_fg,
1842 pointer_bg, dest_mask, domain);
1843 else
1844 string_instantiate (image_instance, result, pointer_fg,
1845 pointer_bg, dest_mask, domain);
1846
1847 UNGCPRO;
1848 }
1849
1850
1851 /**********************************************************************
1852 * Font *
1853 **********************************************************************/
1854
1855 static void
1856 font_validate (Lisp_Object instantiator)
1857 {
1858 data_must_be_present (instantiator);
1859 }
1860
1861 /* XmuCvtStringToCursor is bogus in the following ways:
1862
1863 - When it can't convert the given string to a real cursor, it will
1864 sometimes return a "success" value, after triggering a BadPixmap
1865 error. It then gives you a cursor that will itself generate BadCursor
1866 errors. So we install this error handler to catch/notice the X error
1867 and take that as meaning "couldn't convert."
1868
1869 - When you tell it to find a cursor file that doesn't exist, it prints
1870 an error message on stderr. You can't make it not do that.
1871
1872 - Also, using Xmu means we can't properly hack Lisp_Image_Instance
1873 objects, or XPM files, or $XBMLANGPATH.
1874 */
1875
1876 /* Duplicate the behavior of XmuCvtStringToCursor() to bypass its bogusness. */
1877
1878 static int XLoadFont_got_error;
1879
1880 static int
1881 XLoadFont_error_handler (Display *dpy, XErrorEvent *xerror)
1882 {
1883 XLoadFont_got_error = 1;
1884 return 0;
1885 }
1886
1887 static Font
1888 safe_XLoadFont (Display *dpy, char *name)
1889 {
1890 Font font;
1891 int (*old_handler) (Display *, XErrorEvent *);
1892 XLoadFont_got_error = 0;
1893 XSync (dpy, 0);
1894 old_handler = XSetErrorHandler (XLoadFont_error_handler);
1895 font = XLoadFont (dpy, name);
1896 XSync (dpy, 0);
1897 XSetErrorHandler (old_handler);
1898 if (XLoadFont_got_error) return 0;
1899 return font;
1900 }
1901
1902 static int
1903 font_possible_dest_types (void)
1904 {
1905 return IMAGE_POINTER_MASK;
1906 }
1907
1908 static void
1909 font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1910 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1911 int dest_mask, Lisp_Object domain)
1912 {
1913 /* This function can GC */
1914 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1915 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1916 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
1917 Display *dpy;
1918 XColor fg, bg;
1919 Font source, mask;
1920 char source_name[MAXPATHLEN], mask_name[MAXPATHLEN], dummy;
1921 int source_char, mask_char;
1922 int count;
1923 Lisp_Object foreground, background;
1924
1925 if (!DEVICE_X_P (XDEVICE (device)))
1926 signal_simple_error ("Not an X device", device);
1927
1928 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
1929
1930 if (!STRINGP (data) ||
1931 strncmp ("FONT ", (char *) XSTRING_DATA (data), 5))
1932 signal_simple_error ("Invalid font-glyph instantiator",
1933 instantiator);
1934
1935 if (!(dest_mask & IMAGE_POINTER_MASK))
1936 incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
1937
1938 foreground = find_keyword_in_vector (instantiator, Q_foreground);
1939 if (NILP (foreground))
1940 foreground = pointer_fg;
1941 background = find_keyword_in_vector (instantiator, Q_background);
1942 if (NILP (background))
1943 background = pointer_bg;
1944
1945 generate_cursor_fg_bg (device, &foreground, &background, &fg, &bg);
1946
1947 count = sscanf ((char *) XSTRING_DATA (data),
1948 "FONT %s %d %s %d %c",
1949 source_name, &source_char,
1950 mask_name, &mask_char, &dummy);
1951 /* Allow "%s %d %d" as well... */
1952 if (count == 3 && (1 == sscanf (mask_name, "%d %c", &mask_char, &dummy)))
1953 count = 4, mask_name[0] = 0;
1954
1955 if (count != 2 && count != 4)
1956 signal_simple_error ("invalid cursor specification", data);
1957 source = safe_XLoadFont (dpy, source_name);
1958 if (! source)
1959 signal_simple_error_2 ("couldn't load font",
1960 build_string (source_name),
1961 data);
1962 if (count == 2)
1963 mask = 0;
1964 else if (!mask_name[0])
1965 mask = source;
1966 else
1967 {
1968 mask = safe_XLoadFont (dpy, mask_name);
1969 if (!mask)
1970 /* continuable */
1971 Fsignal (Qerror, list3 (build_string ("couldn't load font"),
1972 build_string (mask_name), data));
1973 }
1974 if (!mask)
1975 mask_char = 0;
1976
1977 /* #### call XQueryTextExtents() and check_pointer_sizes() here. */
1978
1979 x_initialize_pixmap_image_instance (ii, 1, IMAGE_POINTER);
1980 IMAGE_INSTANCE_X_CURSOR (ii) =
1981 XCreateGlyphCursor (dpy, source, mask, source_char, mask_char,
1982 &fg, &bg);
1983 XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
1984 XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
1985 XUnloadFont (dpy, source);
1986 if (mask && mask != source) XUnloadFont (dpy, mask);
1987 }
1988
1989
1990 /**********************************************************************
1991 * Cursor-Font *
1992 **********************************************************************/
1993
1994 static void
1995 cursor_font_validate (Lisp_Object instantiator)
1996 {
1997 data_must_be_present (instantiator);
1998 }
1999
2000 static int
2001 cursor_font_possible_dest_types (void)
2002 {
2003 return IMAGE_POINTER_MASK;
2004 }
2005
2006 static void
2007 cursor_font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2008 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2009 int dest_mask, Lisp_Object domain)
2010 {
2011 /* This function can GC */
2012 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
2013 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2014 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
2015 Display *dpy;
2016 int i;
2017 CONST char *name_ext;
2018 Lisp_Object foreground, background;
2019
2020 if (!DEVICE_X_P (XDEVICE (device)))
2021 signal_simple_error ("Not an X device", device);
2022
2023 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2024
2025 if (!(dest_mask & IMAGE_POINTER_MASK))
2026 incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
2027
2028 GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext);
2029 if ((i = XmuCursorNameToIndex (name_ext)) == -1)
2030 signal_simple_error ("Unrecognized cursor-font name", data);
2031
2032 x_initialize_pixmap_image_instance (ii, 1, IMAGE_POINTER);
2033 IMAGE_INSTANCE_X_CURSOR (ii) = XCreateFontCursor (dpy, i);
2034 foreground = find_keyword_in_vector (instantiator, Q_foreground);
2035 if (NILP (foreground))
2036 foreground = pointer_fg;
2037 background = find_keyword_in_vector (instantiator, Q_background);
2038 if (NILP (background))
2039 background = pointer_bg;
2040 maybe_recolor_cursor (image_instance, foreground, background);
2041 }
2042
2043 static int
2044 x_colorize_image_instance (Lisp_Object image_instance,
2045 Lisp_Object foreground, Lisp_Object background)
2046 {
2047 struct Lisp_Image_Instance *p;
2048
2049 p = XIMAGE_INSTANCE (image_instance);
2050
2051 switch (IMAGE_INSTANCE_TYPE (p))
2052 {
2053 case IMAGE_MONO_PIXMAP:
2054 IMAGE_INSTANCE_TYPE (p) = IMAGE_COLOR_PIXMAP;
2055 /* Make sure there aren't two pointers to the same mask, causing
2056 it to get freed twice. */
2057 IMAGE_INSTANCE_PIXMAP_MASK (p) = 0;
2058 break;
2059
2060 default:
2061 return 0;
2062 }
2063
2064 {
2065 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
2066 Drawable draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (IMAGE_INSTANCE_DEVICE (p))));
2067 Dimension d = DEVICE_X_DEPTH (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
2068 Pixmap new = XCreatePixmap (dpy, draw,
2069 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
2070 IMAGE_INSTANCE_PIXMAP_HEIGHT (p), d);
2071 XColor color;
2072 XGCValues gcv;
2073 GC gc;
2074 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground));
2075 gcv.foreground = color.pixel;
2076 color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background));
2077 gcv.background = color.pixel;
2078 gc = XCreateGC (dpy, new, GCBackground|GCForeground, &gcv);
2079 XCopyPlane (dpy, IMAGE_INSTANCE_X_PIXMAP (p), new, gc, 0, 0,
2080 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
2081 IMAGE_INSTANCE_PIXMAP_HEIGHT (p),
2082 0, 0, 1);
2083 XFreeGC (dpy, gc);
2084 IMAGE_INSTANCE_X_PIXMAP (p) = new;
2085 IMAGE_INSTANCE_PIXMAP_DEPTH (p) = d;
2086 IMAGE_INSTANCE_PIXMAP_FG (p) = foreground;
2087 IMAGE_INSTANCE_PIXMAP_BG (p) = background;
2088 return 1;
2089 }
2090 }
2091
2092
2093 /************************************************************************/
2094 /* subwindow and widget support */
2095 /************************************************************************/
2096
2097 /* unmap the image if it is a widget. This is used by redisplay via
2098 redisplay_unmap_subwindows */
2099 static void
2100 x_unmap_subwindow (struct Lisp_Image_Instance *p)
2101 {
2102 if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
2103 {
2104 XUnmapWindow
2105 (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2106 IMAGE_INSTANCE_X_CLIPWINDOW (p));
2107 }
2108 else /* must be a widget */
2109 {
2110 XtUnmapWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p));
2111 }
2112 }
2113
2114 /* map the subwindow. This is used by redisplay via
2115 redisplay_output_subwindow */
2116 static void
2117 x_map_subwindow (struct Lisp_Image_Instance *p, int x, int y,
2118 struct display_glyph_area* dga)
2119 {
2120 if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
2121 {
2122 Window subwindow = IMAGE_INSTANCE_X_SUBWINDOW_ID (p);
2123 XMoveResizeWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2124 IMAGE_INSTANCE_X_CLIPWINDOW (p),
2125 x, y, dga->width, dga->height);
2126 XMoveWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2127 subwindow, -dga->xoffset, -dga->yoffset);
2128 XMapWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
2129 IMAGE_INSTANCE_X_CLIPWINDOW (p));
2130 }
2131 else /* must be a widget */
2132 {
2133 XtConfigureWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p),
2134 x + IMAGE_INSTANCE_X_WIDGET_XOFFSET (p),
2135 y + IMAGE_INSTANCE_X_WIDGET_YOFFSET (p),
2136 dga->width, dga->height, 0);
2137 XtMoveWidget (IMAGE_INSTANCE_X_WIDGET_ID (p),
2138 -dga->xoffset, -dga->yoffset);
2139 XtMapWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p));
2140 }
2141 }
2142
2143 /* when you click on a widget you may activate another widget this
2144 needs to be checked and all appropriate widgets updated */
2145 static void
2146 x_update_subwindow (struct Lisp_Image_Instance *p)
2147 {
2148 #ifdef HAVE_WIDGETS
2149 if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET)
2150 {
2151 Arg al[5];
2152 widget_value* wv = gui_items_to_widget_values
2153 (IMAGE_INSTANCE_WIDGET_ITEMS (p));
2154
2155 /* This seems ugly, but I'm not sure what else to do. */
2156 if (EQ (IMAGE_INSTANCE_WIDGET_TYPE (p), Qtab_control))
2157 {
2158 widget_value* cur = 0;
2159 /* Give each child label the correct foreground color. */
2160 Lisp_Object pixel = FACE_FOREGROUND
2161 (IMAGE_INSTANCE_WIDGET_FACE (p),
2162 IMAGE_INSTANCE_SUBWINDOW_FRAME (p));
2163 XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2164 XtSetArg (al [0], XtNtabForeground, fcolor.pixel);
2165
2166 for (cur = wv->contents; cur; cur = cur->next)
2167 {
2168 if (cur->value)
2169 {
2170 cur->nargs = 1;
2171 cur->args = al;
2172 }
2173 }
2174 }
2175
2176 /* now modify the widget */
2177 lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (p),
2178 wv, True);
2179 free_widget_value_tree (wv);
2180 /* update the colors and font */
2181 update_widget_face (p, IMAGE_INSTANCE_SUBWINDOW_FRAME (p));
2182 /* We have to do this otherwise Motif will unceremoniously
2183 resize us when the label gets set. */
2184 XtSetArg (al [0], XtNwidth, IMAGE_INSTANCE_WIDGET_WIDTH (p));
2185 XtSetArg (al [1], XtNheight, IMAGE_INSTANCE_WIDGET_HEIGHT (p));
2186 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (p), al, 2);
2187 }
2188 #endif
2189 }
2190
2191 /* instantiate and x type subwindow */
2192 static void
2193 x_subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2194 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2195 int dest_mask, Lisp_Object domain)
2196 {
2197 /* This function can GC */
2198 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2199 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
2200 Lisp_Object frame = FW_FRAME (domain);
2201 struct frame* f = XFRAME (frame);
2202 Display *dpy;
2203 Screen *xs;
2204 Window pw, win;
2205 XSetWindowAttributes xswa;
2206 Mask valueMask = 0;
2207 unsigned int w = IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii),
2208 h = IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii);
2209
2210 if (!DEVICE_X_P (XDEVICE (device)))
2211 signal_simple_error ("Not an X device", device);
2212
2213 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
2214 xs = DefaultScreenOfDisplay (dpy);
2215
2216 IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW;
2217
2218 pw = XtWindow (FRAME_X_TEXT_WIDGET (f));
2219
2220 ii->data = xnew_and_zero (struct x_subwindow_data);
2221
2222 IMAGE_INSTANCE_X_SUBWINDOW_PARENT (ii) = pw;
2223 IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (ii) = DisplayOfScreen (xs);
2224
2225 xswa.backing_store = Always;
2226 valueMask |= CWBackingStore;
2227 xswa.colormap = DefaultColormapOfScreen (xs);
2228 valueMask |= CWColormap;
2229
2230 /* Create a window for clipping */
2231 IMAGE_INSTANCE_X_CLIPWINDOW (ii) =
2232 XCreateWindow (dpy, pw, 0, 0, w, h, 0, CopyFromParent,
2233 InputOutput, CopyFromParent, valueMask,
2234 &xswa);
2235
2236 /* Now put the subwindow inside the clip window. */
2237 win = XCreateWindow (dpy, IMAGE_INSTANCE_X_CLIPWINDOW (ii),
2238 0, 0, w, h, 0, CopyFromParent,
2239 InputOutput, CopyFromParent, valueMask,
2240 &xswa);
2241
2242 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)win;
2243 }
2244
2245 #if 0
2246 /* #### Should this function exist? If there's any doubt I'm not implementing it --andyp */
2247 DEFUN ("change-subwindow-property", Fchange_subwindow_property, 3, 3, 0, /*
2248 For the given SUBWINDOW, set PROPERTY to DATA, which is a string.
2249 Subwindows are not currently implemented.
2250 */
2251 (subwindow, property, data))
2252 {
2253 Atom property_atom;
2254 struct Lisp_Subwindow *sw;
2255 Display *dpy;
2256
2257 CHECK_SUBWINDOW (subwindow);
2258 CHECK_STRING (property);
2259 CHECK_STRING (data);
2260
2261 sw = XSUBWINDOW (subwindow);
2262 dpy = DisplayOfScreen (LISP_DEVICE_TO_X_SCREEN
2263 (FRAME_DEVICE (XFRAME (sw->frame))));
2264
2265 property_atom = XInternAtom (dpy, (char *) XSTRING_DATA (property), False);
2266 XChangeProperty (dpy, sw->subwindow, property_atom, XA_STRING, 8,
2267 PropModeReplace,
2268 XSTRING_DATA (data),
2269 XSTRING_LENGTH (data));
2270
2271 return property;
2272 }
2273 #endif
2274
2275 static void
2276 x_resize_subwindow (struct Lisp_Image_Instance* ii, int w, int h)
2277 {
2278 if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
2279 {
2280 XResizeWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (ii),
2281 IMAGE_INSTANCE_X_SUBWINDOW_ID (ii),
2282 w, h);
2283 }
2284 else /* must be a widget */
2285 {
2286 Arg al[2];
2287
2288 if (!XtIsRealized (IMAGE_INSTANCE_X_WIDGET_ID (ii)))
2289 {
2290 Lisp_Object sw;
2291 XSETIMAGE_INSTANCE (sw, ii);
2292 signal_simple_error ("XEmacs bug: subwindow is not realized", sw);
2293 }
2294
2295 XtSetArg (al [0], XtNwidth, (Dimension)w);
2296 XtSetArg (al [1], XtNheight, (Dimension)h);
2297 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 2);
2298 }
2299 }
2300
2301
2302 #ifdef HAVE_WIDGETS
2303
2304 /************************************************************************/
2305 /* widgets */
2306 /************************************************************************/
2307
2308 static void
2309 update_widget_face (struct Lisp_Image_Instance* ii, Lisp_Object domain)
2310 {
2311 Arg al[3];
2312 #ifdef LWLIB_WIDGETS_MOTIF
2313 XmFontList fontList;
2314 #endif
2315
2316 Lisp_Object pixel = FACE_FOREGROUND
2317 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2318 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2319 XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2320 XColor bcolor;
2321
2322 pixel = FACE_BACKGROUND
2323 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2324 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2325 bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2326
2327 XtSetArg (al [0], XtNbackground, bcolor.pixel);
2328 XtSetArg (al [1], XtNforeground, fcolor.pixel);
2329
2330 #ifdef LWLIB_WIDGETS_MOTIF
2331 fontList = XmFontListCreate
2332 (FONT_INSTANCE_X_FONT
2333 (XFONT_INSTANCE (widget_face_font_info
2334 (domain, IMAGE_INSTANCE_WIDGET_FACE (ii),
2335 0, 0))), XmSTRING_DEFAULT_CHARSET);
2336 XtSetArg (al [2], XmNfontList, fontList );
2337 #else
2338 XtSetArg (al [2], XtNfont, (void*)FONT_INSTANCE_X_FONT
2339 (XFONT_INSTANCE (widget_face_font_info
2340 (domain,
2341 IMAGE_INSTANCE_WIDGET_FACE (ii),
2342 0, 0))));
2343 #endif
2344 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 3);
2345 #ifdef LWLIB_WIDGETS_MOTIF
2346 XmFontListFree (fontList);
2347 #endif
2348 }
2349
2350 static void
2351 x_widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2352 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2353 int dest_mask, Lisp_Object domain,
2354 CONST char* type, widget_value* wv)
2355 {
2356 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2357 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii), pixel;
2358 struct device* d = XDEVICE (device);
2359 Lisp_Object frame = FW_FRAME (domain);
2360 struct frame* f = XFRAME (frame);
2361 char* nm=0;
2362 Widget wid;
2363 Arg al [32];
2364 int ac = 0;
2365 int id = new_lwlib_id ();
2366 widget_value* clip_wv;
2367 XColor fcolor, bcolor;
2368
2369 if (!DEVICE_X_P (d))
2370 signal_simple_error ("Not an X device", device);
2371
2372 /* have to set the type this late in case there is no device
2373 instantiation for a widget. But we can go ahead and do it without
2374 checking because there is always a generic instantiator. */
2375 IMAGE_INSTANCE_TYPE (ii) = IMAGE_WIDGET;
2376
2377 if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
2378 GET_C_STRING_OS_DATA_ALLOCA (IMAGE_INSTANCE_WIDGET_TEXT (ii), nm);
2379
2380 ii->data = xnew_and_zero (struct x_subwindow_data);
2381
2382 /* Create a clip window to contain the subwidget. Incredibly the
2383 XEmacs manager seems to be the most appropriate widget for
2384 this. Nothing else is simple enough and yet does what is
2385 required. */
2386 clip_wv = xmalloc_widget_value ();
2387
2388 XtSetArg (al [ac], XtNresize, False); ac++;
2389 XtSetArg (al [ac], XtNwidth,
2390 (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii)); ac++;
2391 XtSetArg (al [ac], XtNheight,
2392 (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); ac++;
2393
2394 clip_wv->enabled = True;
2395 clip_wv->nargs = ac;
2396 clip_wv->args = al;
2397 clip_wv->name = xstrdup ("clip-window");
2398 clip_wv->value = xstrdup ("clip-window");
2399
2400 IMAGE_INSTANCE_X_CLIPWIDGET (ii)
2401 = lw_create_widget ("clip-window", "clip-window", new_lwlib_id (),
2402 clip_wv, FRAME_X_CONTAINER_WIDGET (f),
2403 False, 0, 0, 0);
2404
2405 free_widget_value_tree (clip_wv);
2406
2407 /* copy any args we were given */
2408 ac = 0;
2409
2410 if (wv->nargs)
2411 lw_add_value_args_to_args (wv, al, &ac);
2412
2413 /* Fixup the colors. We have to do this *before* the widget gets
2414 created so that Motif will fix up the shadow colors
2415 correctly. Once the widget is created Motif won't do this
2416 anymore...*/
2417 pixel = FACE_FOREGROUND
2418 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2419 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2420 fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2421
2422 pixel = FACE_BACKGROUND
2423 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2424 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2425 bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2426
2427 XtSetArg (al [ac], XtNbackground, bcolor.pixel); ac++;
2428 XtSetArg (al [ac], XtNforeground, fcolor.pixel); ac++;
2429 /* we cannot allow widgets to resize themselves */
2430 XtSetArg (al [ac], XtNresize, False); ac++;
2431 XtSetArg (al [ac], XtNwidth,
2432 (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii)); ac++;
2433 XtSetArg (al [ac], XtNheight,
2434 (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); ac++;
2435
2436 wv->nargs = ac;
2437 wv->args = al;
2438
2439 wid = lw_create_widget (type, wv->name, id, wv, IMAGE_INSTANCE_X_CLIPWIDGET (ii),
2440 False, 0, popup_selection_callback, 0);
2441
2442 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)wid;
2443 IMAGE_INSTANCE_X_WIDGET_LWID (ii) = id;
2444
2445 /* update the font. */
2446 update_widget_face (ii, domain);
2447
2448 /* Resize the widget here so that the values do not get copied by
2449 lwlib. */
2450 ac = 0;
2451 XtSetArg (al [ac], XtNwidth,
2452 (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii)); ac++;
2453 XtSetArg (al [ac], XtNheight,
2454 (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); ac++;
2455 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, ac);
2456 /* because the EmacsManager is the widgets parent we have to
2457 offset the redisplay of the widget by the amount the text
2458 widget is inside the manager. */
2459 ac = 0;
2460 XtSetArg (al [ac], XtNx, &IMAGE_INSTANCE_X_WIDGET_XOFFSET (ii)); ac++;
2461 XtSetArg (al [ac], XtNy, &IMAGE_INSTANCE_X_WIDGET_YOFFSET (ii)); ac++;
2462 XtGetValues (FRAME_X_TEXT_WIDGET (f), al, ac);
2463
2464 XtMapWidget (wid);
2465
2466 free_widget_value_tree (wv);
2467 }
2468
2469 static Lisp_Object
2470 x_widget_set_property (Lisp_Object image_instance, Lisp_Object prop,
2471 Lisp_Object val)
2472 {
2473 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2474
2475 if (EQ (prop, Q_text))
2476 {
2477 char* str;
2478 widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2479 CHECK_STRING (val);
2480 GET_C_STRING_OS_DATA_ALLOCA (val, str);
2481 wv->value = str;
2482 lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, False);
2483 return Qt;
2484 }
2485 /* Modify the face properties of the widget */
2486 if (EQ (prop, Q_face))
2487 {
2488 update_widget_face (ii, IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2489 return Qt;
2490 }
2491 return Qunbound;
2492 }
2493
2494 /* get properties of a control */
2495 static Lisp_Object
2496 x_widget_property (Lisp_Object image_instance, Lisp_Object prop)
2497 {
2498 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2499 /* get the text from a control */
2500 if (EQ (prop, Q_text))
2501 {
2502 widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2503 return build_ext_string (wv->value, FORMAT_OS);
2504 }
2505 return Qunbound;
2506 }
2507
2508 /* Instantiate a button widget. Unfortunately instantiated widgets are
2509 particular to a frame since they need to have a parent. It's not
2510 like images where you just select the image into the context you
2511 want to display it in and BitBlt it. So images instances can have a
2512 many-to-one relationship with things you see, whereas widgets can
2513 only be one-to-one (i.e. per frame) */
2514 static void
2515 x_button_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2516 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2517 int dest_mask, Lisp_Object domain)
2518 {
2519 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2520 Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2521 Lisp_Object glyph = find_keyword_in_vector (instantiator, Q_image);
2522 widget_value* wv = xmalloc_widget_value ();
2523
2524 button_item_to_widget_value (gui, wv, 1, 1);
2525
2526 if (!NILP (glyph))
2527 {
2528 if (!IMAGE_INSTANCEP (glyph))
2529 glyph = glyph_image_instance (glyph, domain, ERROR_ME, 1);
2530 }
2531
2532 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2533 pointer_bg, dest_mask, domain, "button", wv);
2534
2535 /* add the image if one was given */
2536 if (!NILP (glyph) && IMAGE_INSTANCEP (glyph))
2537 {
2538 Arg al [2];
2539 int ac =0;
2540 #ifdef LWLIB_WIDGETS_MOTIF
2541 XtSetArg (al [ac], XmNlabelType, XmPIXMAP); ac++;
2542 XtSetArg (al [ac], XmNlabelPixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph));ac++;
2543 #else
2544 XtSetArg (al [ac], XtNpixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph)); ac++;
2545 #endif
2546 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, ac);
2547 }
2548 }
2549
2550 /* get properties of a button */
2551 static Lisp_Object
2552 x_button_property (Lisp_Object image_instance, Lisp_Object prop)
2553 {
2554 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2555 /* check the state of a button */
2556 if (EQ (prop, Q_selected))
2557 {
2558 widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
2559
2560 if (wv->selected)
2561 return Qt;
2562 else
2563 return Qnil;
2564 }
2565 return Qunbound;
2566 }
2567
2568 /* instantiate a progress gauge */
2569 static void
2570 x_progress_gauge_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2571 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2572 int dest_mask, Lisp_Object domain)
2573 {
2574 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2575 Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2576 widget_value* wv = xmalloc_widget_value ();
2577
2578 button_item_to_widget_value (gui, wv, 1, 1);
2579
2580 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2581 pointer_bg, dest_mask, domain, "progress", wv);
2582 }
2583
2584 /* set the properties of a progres guage */
2585 static Lisp_Object
2586 x_progress_gauge_set_property (Lisp_Object image_instance, Lisp_Object prop,
2587 Lisp_Object val)
2588 {
2589 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2590
2591 if (EQ (prop, Q_percent))
2592 {
2593 Arg al [1];
2594 CHECK_INT (val);
2595 XtSetArg (al[0], XtNvalue, XINT (val));
2596 XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 1);
2597 return Qt;
2598 }
2599 return Qunbound;
2600 }
2601
2602 /* instantiate an edit control */
2603 static void
2604 x_edit_field_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2605 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2606 int dest_mask, Lisp_Object domain)
2607 {
2608 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2609 Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2610 widget_value* wv = xmalloc_widget_value ();
2611
2612 button_item_to_widget_value (gui, wv, 1, 1);
2613
2614 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2615 pointer_bg, dest_mask, domain, "text-field", wv);
2616 }
2617
2618 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
2619 /* instantiate a combo control */
2620 static void
2621 x_combo_box_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2622 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2623 int dest_mask, Lisp_Object domain)
2624 {
2625 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2626 widget_value * wv = 0;
2627 /* This is not done generically because of sizing problems under
2628 mswindows. */
2629 widget_instantiate_1 (image_instance, instantiator, pointer_fg,
2630 pointer_bg, dest_mask, domain, 1, 0, 0);
2631
2632 wv = gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2633
2634 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2635 pointer_bg, dest_mask, domain, "combo-box", wv);
2636 }
2637 #endif
2638
2639 static void
2640 x_tab_control_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2641 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2642 int dest_mask, Lisp_Object domain)
2643 {
2644 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2645 Arg al [1];
2646 XColor fcolor;
2647 Lisp_Object pixel;
2648 widget_value* cur;
2649
2650 widget_value * wv =
2651 gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2652
2653 /* Give each child label the correct foreground color. */
2654 pixel = FACE_FOREGROUND
2655 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2656 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2657 fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2658 XtSetArg (al [0], XtNtabForeground, fcolor.pixel);
2659
2660 for (cur = wv->contents; cur; cur = cur->next)
2661 {
2662 if (cur->value)
2663 {
2664 cur->nargs = 1;
2665 cur->args = al;
2666 }
2667 }
2668
2669 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2670 pointer_bg, dest_mask, domain, "tab-control", wv);
2671 }
2672
2673 /* set the properties of a tab control */
2674 static Lisp_Object
2675 x_tab_control_set_property (Lisp_Object image_instance, Lisp_Object prop,
2676 Lisp_Object val)
2677 {
2678 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2679
2680 if (EQ (prop, Q_items))
2681 {
2682 widget_value * wv = 0, *cur;
2683 Arg al [1];
2684 XColor fcolor;
2685 Lisp_Object pixel;
2686
2687 check_valid_item_list_1 (val);
2688
2689 IMAGE_INSTANCE_WIDGET_ITEMS (ii) =
2690 Fcons (XCAR (IMAGE_INSTANCE_WIDGET_ITEMS (ii)),
2691 parse_gui_item_tree_children (val));
2692
2693 wv = gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
2694
2695 /* Give each child label the correct foreground color. */
2696 pixel = FACE_FOREGROUND
2697 (IMAGE_INSTANCE_WIDGET_FACE (ii),
2698 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
2699 fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
2700 XtSetArg (al [0], XtNtabForeground, fcolor.pixel);
2701
2702 for (cur = wv->contents; cur; cur = cur->next)
2703 {
2704 if (cur->value)
2705 {
2706 cur->nargs = 1;
2707 cur->args = al;
2708 }
2709 }
2710
2711 lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, True);
2712
2713 free_widget_value_tree (wv);
2714 return Qt;
2715 }
2716
2717 return Qunbound;
2718 }
2719
2720 /* instantiate a static control possible for putting other things in */
2721 static void
2722 x_label_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2723 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2724 int dest_mask, Lisp_Object domain)
2725 {
2726 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2727 Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
2728 widget_value* wv = xmalloc_widget_value ();
2729
2730 button_item_to_widget_value (gui, wv, 1, 1);
2731
2732 x_widget_instantiate (image_instance, instantiator, pointer_fg,
2733 pointer_bg, dest_mask, domain, "button", wv);
2734 }
2735 #endif /* HAVE_WIDGETS */
2736
2737
2738 /************************************************************************/
2739 /* initialization */
2740 /************************************************************************/
2741
2742 void
2743 syms_of_glyphs_x (void)
2744 {
2745 #if 0
2746 DEFSUBR (Fchange_subwindow_property);
2747 #endif
2748 }
2749
2750 void
2751 console_type_create_glyphs_x (void)
2752 {
2753 /* image methods */
2754
2755 CONSOLE_HAS_METHOD (x, print_image_instance);
2756 CONSOLE_HAS_METHOD (x, finalize_image_instance);
2757 CONSOLE_HAS_METHOD (x, image_instance_equal);
2758 CONSOLE_HAS_METHOD (x, image_instance_hash);
2759 CONSOLE_HAS_METHOD (x, colorize_image_instance);
2760 CONSOLE_HAS_METHOD (x, init_image_instance_from_eimage);
2761 CONSOLE_HAS_METHOD (x, locate_pixmap_file);
2762 CONSOLE_HAS_METHOD (x, unmap_subwindow);
2763 CONSOLE_HAS_METHOD (x, map_subwindow);
2764 CONSOLE_HAS_METHOD (x, resize_subwindow);
2765 CONSOLE_HAS_METHOD (x, update_subwindow);
2766 }
2767
2768 void
2769 image_instantiator_format_create_glyphs_x (void)
2770 {
2771 IIFORMAT_VALID_CONSOLE (x, nothing);
2772 IIFORMAT_VALID_CONSOLE (x, string);
2773 IIFORMAT_VALID_CONSOLE (x, layout);
2774 IIFORMAT_VALID_CONSOLE (x, formatted_string);
2775 IIFORMAT_VALID_CONSOLE (x, inherit);
2776 #ifdef HAVE_XPM
2777 INITIALIZE_DEVICE_IIFORMAT (x, xpm);
2778 IIFORMAT_HAS_DEVMETHOD (x, xpm, instantiate);
2779 #endif
2780 #ifdef HAVE_JPEG
2781 IIFORMAT_VALID_CONSOLE (x, jpeg);
2782 #endif
2783 #ifdef HAVE_TIFF
2784 IIFORMAT_VALID_CONSOLE (x, tiff);
2785 #endif
2786 #ifdef HAVE_PNG
2787 IIFORMAT_VALID_CONSOLE (x, png);
2788 #endif
2789 #ifdef HAVE_GIF
2790 IIFORMAT_VALID_CONSOLE (x, gif);
2791 #endif
2792 INITIALIZE_DEVICE_IIFORMAT (x, xbm);
2793 IIFORMAT_HAS_DEVMETHOD (x, xbm, instantiate);
2794
2795 INITIALIZE_DEVICE_IIFORMAT (x, subwindow);
2796 IIFORMAT_HAS_DEVMETHOD (x, subwindow, instantiate);
2797 #ifdef HAVE_WIDGETS
2798 /* button widget */
2799 INITIALIZE_DEVICE_IIFORMAT (x, button);
2800 IIFORMAT_HAS_DEVMETHOD (x, button, property);
2801 IIFORMAT_HAS_DEVMETHOD (x, button, instantiate);
2802
2803 INITIALIZE_DEVICE_IIFORMAT (x, widget);
2804 IIFORMAT_HAS_DEVMETHOD (x, widget, property);
2805 IIFORMAT_HAS_DEVMETHOD (x, widget, set_property);
2806 /* progress gauge */
2807 INITIALIZE_DEVICE_IIFORMAT (x, progress_gauge);
2808 IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, set_property);
2809 IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, instantiate);
2810 /* text field */
2811 INITIALIZE_DEVICE_IIFORMAT (x, edit_field);
2812 IIFORMAT_HAS_DEVMETHOD (x, edit_field, instantiate);
2813 #if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
2814 /* combo box */
2815 INITIALIZE_DEVICE_IIFORMAT (x, combo_box);
2816 IIFORMAT_HAS_DEVMETHOD (x, combo_box, instantiate);
2817 IIFORMAT_HAS_SHARED_DEVMETHOD (x, combo_box, set_property, tab_control);
2818 #endif
2819 /* tab control widget */
2820 INITIALIZE_DEVICE_IIFORMAT (x, tab_control);
2821 IIFORMAT_HAS_DEVMETHOD (x, tab_control, instantiate);
2822 IIFORMAT_HAS_DEVMETHOD (x, tab_control, set_property);
2823 /* label */
2824 INITIALIZE_DEVICE_IIFORMAT (x, label);
2825 IIFORMAT_HAS_DEVMETHOD (x, label, instantiate);
2826 #endif
2827 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (cursor_font, "cursor-font");
2828 IIFORMAT_VALID_CONSOLE (x, cursor_font);
2829
2830 IIFORMAT_HAS_METHOD (cursor_font, validate);
2831 IIFORMAT_HAS_METHOD (cursor_font, possible_dest_types);
2832 IIFORMAT_HAS_METHOD (cursor_font, instantiate);
2833
2834 IIFORMAT_VALID_KEYWORD (cursor_font, Q_data, check_valid_string);
2835 IIFORMAT_VALID_KEYWORD (cursor_font, Q_foreground, check_valid_string);
2836 IIFORMAT_VALID_KEYWORD (cursor_font, Q_background, check_valid_string);
2837
2838 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (font, "font");
2839
2840 IIFORMAT_HAS_METHOD (font, validate);
2841 IIFORMAT_HAS_METHOD (font, possible_dest_types);
2842 IIFORMAT_HAS_METHOD (font, instantiate);
2843 IIFORMAT_VALID_CONSOLE (x, font);
2844
2845 IIFORMAT_VALID_KEYWORD (font, Q_data, check_valid_string);
2846 IIFORMAT_VALID_KEYWORD (font, Q_foreground, check_valid_string);
2847 IIFORMAT_VALID_KEYWORD (font, Q_background, check_valid_string);
2848
2849 #ifdef HAVE_XFACE
2850 INITIALIZE_DEVICE_IIFORMAT (x, xface);
2851 IIFORMAT_HAS_DEVMETHOD (x, xface, instantiate);
2852 #endif
2853
2854 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (autodetect,
2855 "autodetect");
2856
2857 IIFORMAT_HAS_METHOD (autodetect, validate);
2858 IIFORMAT_HAS_METHOD (autodetect, normalize);
2859 IIFORMAT_HAS_METHOD (autodetect, possible_dest_types);
2860 IIFORMAT_HAS_METHOD (autodetect, instantiate);
2861 IIFORMAT_VALID_CONSOLE (x, autodetect);
2862
2863 IIFORMAT_VALID_KEYWORD (autodetect, Q_data, check_valid_string);
2864 }
2865
2866 void
2867 vars_of_glyphs_x (void)
2868 {
2869 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path /*
2870 A list of the directories in which X bitmap files may be found.
2871 If nil, this is initialized from the "*bitmapFilePath" resource.
2872 This is used by the `make-image-instance' function (however, note that if
2873 the environment variable XBMLANGPATH is set, it is consulted first).
2874 */ );
2875 Vx_bitmap_file_path = Qnil;
2876 }
2877
2878 void
2879 complex_vars_of_glyphs_x (void)
2880 {
2881 #define BUILD_GLYPH_INST(variable, name) \
2882 Fadd_spec_to_specifier \
2883 (GLYPH_IMAGE (XGLYPH (variable)), \
2884 vector3 (Qxbm, Q_data, \
2885 list3 (make_int (name##_width), \
2886 make_int (name##_height), \
2887 make_ext_string (name##_bits, \
2888 sizeof (name##_bits), \
2889 FORMAT_BINARY))), \
2890 Qglobal, Qx, Qnil)
2891
2892 BUILD_GLYPH_INST (Vtruncation_glyph, truncator);
2893 BUILD_GLYPH_INST (Vcontinuation_glyph, continuer);
2894 BUILD_GLYPH_INST (Vxemacs_logo, xemacs);
2895 BUILD_GLYPH_INST (Vhscroll_glyph, hscroll);
2896
2897 #undef BUILD_GLYPH_INST
2898 }