* xfns.c (x-send-client-message): Moved to xselect.c
[bpt/emacs.git] / src / xfns.c
1 /* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 01, 02, 03
3 Free Software Foundation.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
21
22 #include <config.h>
23 #include <signal.h>
24 #include <stdio.h>
25 #include <math.h>
26
27 #ifdef HAVE_UNISTD_H
28 #include <unistd.h>
29 #endif
30
31 /* This makes the fields of a Display accessible, in Xlib header files. */
32
33 #define XLIB_ILLEGAL_ACCESS
34
35 #include "lisp.h"
36 #include "xterm.h"
37 #include "frame.h"
38 #include "window.h"
39 #include "buffer.h"
40 #include "intervals.h"
41 #include "dispextern.h"
42 #include "keyboard.h"
43 #include "blockinput.h"
44 #include <epaths.h>
45 #include "charset.h"
46 #include "coding.h"
47 #include "fontset.h"
48 #include "systime.h"
49 #include "termhooks.h"
50 #include "atimer.h"
51
52 #ifdef HAVE_X_WINDOWS
53
54 #include <ctype.h>
55 #include <sys/types.h>
56 #include <sys/stat.h>
57
58 #ifndef VMS
59 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
60 #include "bitmaps/gray.xbm"
61 #else
62 #include <X11/bitmaps/gray>
63 #endif
64 #else
65 #include "[.bitmaps]gray.xbm"
66 #endif
67
68 #ifdef USE_GTK
69 #include "gtkutil.h"
70 #endif
71
72 #ifdef USE_X_TOOLKIT
73 #include <X11/Shell.h>
74
75 #ifndef USE_MOTIF
76 #include <X11/Xaw/Paned.h>
77 #include <X11/Xaw/Label.h>
78 #endif /* USE_MOTIF */
79
80 #ifdef USG
81 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
82 #include <X11/Xos.h>
83 #define USG
84 #else
85 #include <X11/Xos.h>
86 #endif
87
88 #include "widget.h"
89
90 #include "../lwlib/lwlib.h"
91
92 #ifdef USE_MOTIF
93 #include <Xm/Xm.h>
94 #include <Xm/DialogS.h>
95 #include <Xm/FileSB.h>
96 #endif
97
98 /* Do the EDITRES protocol if running X11R5
99 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
100
101 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
102 #define HACK_EDITRES
103 extern void _XEditResCheckMessages ();
104 #endif /* R5 + Athena */
105
106 /* Unique id counter for widgets created by the Lucid Widget Library. */
107
108 extern LWLIB_ID widget_id_tick;
109
110 #ifdef USE_LUCID
111 /* This is part of a kludge--see lwlib/xlwmenu.c. */
112 extern XFontStruct *xlwmenu_default_font;
113 #endif
114
115 extern void free_frame_menubar ();
116 extern double atof ();
117
118 #ifdef USE_MOTIF
119
120 /* LessTif/Motif version info. */
121
122 static Lisp_Object Vmotif_version_string;
123
124 #endif /* USE_MOTIF */
125
126 #endif /* USE_X_TOOLKIT */
127
128 #ifdef USE_GTK
129
130 /* GTK+ version info */
131
132 static Lisp_Object Vgtk_version_string;
133
134 #endif /* USE_GTK */
135
136 #ifdef HAVE_X11R4
137 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
138 #else
139 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
140 #endif
141
142 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
143 it, and including `bitmaps/gray' more than once is a problem when
144 config.h defines `static' as an empty replacement string. */
145
146 int gray_bitmap_width = gray_width;
147 int gray_bitmap_height = gray_height;
148 char *gray_bitmap_bits = gray_bits;
149
150 /* Non-zero means we're allowed to display an hourglass cursor. */
151
152 int display_hourglass_p;
153
154 /* The background and shape of the mouse pointer, and shape when not
155 over text or in the modeline. */
156
157 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
158 Lisp_Object Vx_hourglass_pointer_shape;
159
160 /* The shape when over mouse-sensitive text. */
161
162 Lisp_Object Vx_sensitive_text_pointer_shape;
163
164 /* If non-nil, the pointer shape to indicate that windows can be
165 dragged horizontally. */
166
167 Lisp_Object Vx_window_horizontal_drag_shape;
168
169 /* Color of chars displayed in cursor box. */
170
171 Lisp_Object Vx_cursor_fore_pixel;
172
173 /* Nonzero if using X. */
174
175 static int x_in_use;
176
177 /* Non nil if no window manager is in use. */
178
179 Lisp_Object Vx_no_window_manager;
180
181 /* Search path for bitmap files. */
182
183 Lisp_Object Vx_bitmap_file_path;
184
185 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
186
187 Lisp_Object Vx_pixel_size_width_font_regexp;
188
189 Lisp_Object Qnone;
190 Lisp_Object Qsuppress_icon;
191 Lisp_Object Qundefined_color;
192 Lisp_Object Qcenter;
193 Lisp_Object Qcompound_text, Qcancel_timer;
194
195 /* In dispnew.c */
196
197 extern Lisp_Object Vwindow_system_version;
198
199 /* The below are defined in frame.c. */
200
201 #if GLYPH_DEBUG
202 int image_cache_refcount, dpyinfo_refcount;
203 #endif
204
205
206 \f
207 /* Error if we are not connected to X. */
208
209 void
210 check_x ()
211 {
212 if (! x_in_use)
213 error ("X windows are not in use or not initialized");
214 }
215
216 /* Nonzero if we can use mouse menus.
217 You should not call this unless HAVE_MENUS is defined. */
218
219 int
220 have_menus_p ()
221 {
222 return x_in_use;
223 }
224
225 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
226 and checking validity for X. */
227
228 FRAME_PTR
229 check_x_frame (frame)
230 Lisp_Object frame;
231 {
232 FRAME_PTR f;
233
234 if (NILP (frame))
235 frame = selected_frame;
236 CHECK_LIVE_FRAME (frame);
237 f = XFRAME (frame);
238 if (! FRAME_X_P (f))
239 error ("Non-X frame used");
240 return f;
241 }
242
243 /* Let the user specify an X display with a frame.
244 nil stands for the selected frame--or, if that is not an X frame,
245 the first X display on the list. */
246
247 struct x_display_info *
248 check_x_display_info (frame)
249 Lisp_Object frame;
250 {
251 struct x_display_info *dpyinfo = NULL;
252
253 if (NILP (frame))
254 {
255 struct frame *sf = XFRAME (selected_frame);
256
257 if (FRAME_X_P (sf) && FRAME_LIVE_P (sf))
258 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
259 else if (x_display_list != 0)
260 dpyinfo = x_display_list;
261 else
262 error ("X windows are not in use or not initialized");
263 }
264 else if (STRINGP (frame))
265 dpyinfo = x_display_info_for_name (frame);
266 else
267 {
268 FRAME_PTR f = check_x_frame (frame);
269 dpyinfo = FRAME_X_DISPLAY_INFO (f);
270 }
271
272 return dpyinfo;
273 }
274
275 \f
276 /* Return the Emacs frame-object corresponding to an X window.
277 It could be the frame's main window or an icon window. */
278
279 /* This function can be called during GC, so use GC_xxx type test macros. */
280
281 struct frame *
282 x_window_to_frame (dpyinfo, wdesc)
283 struct x_display_info *dpyinfo;
284 int wdesc;
285 {
286 Lisp_Object tail, frame;
287 struct frame *f;
288
289 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
290 {
291 frame = XCAR (tail);
292 if (!GC_FRAMEP (frame))
293 continue;
294 f = XFRAME (frame);
295 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
296 continue;
297 if (f->output_data.x->hourglass_window == wdesc)
298 return f;
299 #ifdef USE_X_TOOLKIT
300 if ((f->output_data.x->edit_widget
301 && XtWindow (f->output_data.x->edit_widget) == wdesc)
302 /* A tooltip frame? */
303 || (!f->output_data.x->edit_widget
304 && FRAME_X_WINDOW (f) == wdesc)
305 || f->output_data.x->icon_desc == wdesc)
306 return f;
307 #else /* not USE_X_TOOLKIT */
308 #ifdef USE_GTK
309 if (f->output_data.x->edit_widget)
310 {
311 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
312 struct x_output *x = f->output_data.x;
313 if (gwdesc != 0 && gwdesc == x->edit_widget)
314 return f;
315 }
316 #endif /* USE_GTK */
317 if (FRAME_X_WINDOW (f) == wdesc
318 || f->output_data.x->icon_desc == wdesc)
319 return f;
320 #endif /* not USE_X_TOOLKIT */
321 }
322 return 0;
323 }
324
325 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
326 /* Like x_window_to_frame but also compares the window with the widget's
327 windows. */
328
329 struct frame *
330 x_any_window_to_frame (dpyinfo, wdesc)
331 struct x_display_info *dpyinfo;
332 int wdesc;
333 {
334 Lisp_Object tail, frame;
335 struct frame *f, *found;
336 struct x_output *x;
337
338 found = NULL;
339 for (tail = Vframe_list; GC_CONSP (tail) && !found; tail = XCDR (tail))
340 {
341 frame = XCAR (tail);
342 if (!GC_FRAMEP (frame))
343 continue;
344
345 f = XFRAME (frame);
346 if (FRAME_X_P (f) && FRAME_X_DISPLAY_INFO (f) == dpyinfo)
347 {
348 /* This frame matches if the window is any of its widgets. */
349 x = f->output_data.x;
350 if (x->hourglass_window == wdesc)
351 found = f;
352 else if (x->widget)
353 {
354 #ifdef USE_GTK
355 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
356 if (gwdesc != 0
357 && (gwdesc == x->widget
358 || gwdesc == x->edit_widget
359 || gwdesc == x->vbox_widget
360 || gwdesc == x->menubar_widget))
361 found = f;
362 #else
363 if (wdesc == XtWindow (x->widget)
364 || wdesc == XtWindow (x->column_widget)
365 || wdesc == XtWindow (x->edit_widget))
366 found = f;
367 /* Match if the window is this frame's menubar. */
368 else if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
369 found = f;
370 #endif
371 }
372 else if (FRAME_X_WINDOW (f) == wdesc)
373 /* A tooltip frame. */
374 found = f;
375 }
376 }
377
378 return found;
379 }
380
381 /* Likewise, but exclude the menu bar widget. */
382
383 struct frame *
384 x_non_menubar_window_to_frame (dpyinfo, wdesc)
385 struct x_display_info *dpyinfo;
386 int wdesc;
387 {
388 Lisp_Object tail, frame;
389 struct frame *f;
390 struct x_output *x;
391
392 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
393 {
394 frame = XCAR (tail);
395 if (!GC_FRAMEP (frame))
396 continue;
397 f = XFRAME (frame);
398 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
399 continue;
400 x = f->output_data.x;
401 /* This frame matches if the window is any of its widgets. */
402 if (x->hourglass_window == wdesc)
403 return f;
404 else if (x->widget)
405 {
406 #ifdef USE_GTK
407 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
408 if (gwdesc != 0
409 && (gwdesc == x->widget
410 || gwdesc == x->edit_widget
411 || gwdesc == x->vbox_widget))
412 return f;
413 #else
414 if (wdesc == XtWindow (x->widget)
415 || wdesc == XtWindow (x->column_widget)
416 || wdesc == XtWindow (x->edit_widget))
417 return f;
418 #endif
419 }
420 else if (FRAME_X_WINDOW (f) == wdesc)
421 /* A tooltip frame. */
422 return f;
423 }
424 return 0;
425 }
426
427 /* Likewise, but consider only the menu bar widget. */
428
429 struct frame *
430 x_menubar_window_to_frame (dpyinfo, wdesc)
431 struct x_display_info *dpyinfo;
432 int wdesc;
433 {
434 Lisp_Object tail, frame;
435 struct frame *f;
436 struct x_output *x;
437
438 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
439 {
440 frame = XCAR (tail);
441 if (!GC_FRAMEP (frame))
442 continue;
443 f = XFRAME (frame);
444 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
445 continue;
446 x = f->output_data.x;
447 /* Match if the window is this frame's menubar. */
448 #ifdef USE_GTK
449 if (x->menubar_widget)
450 {
451 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
452 int found = 0;
453
454 BLOCK_INPUT;
455 if (gwdesc != 0
456 && (gwdesc == x->menubar_widget
457 || gtk_widget_get_parent (gwdesc) == x->menubar_widget))
458 found = 1;
459 UNBLOCK_INPUT;
460 if (found) return f;
461 }
462 #else
463 if (x->menubar_widget
464 && lw_window_is_in_menubar (wdesc, x->menubar_widget))
465 return f;
466 #endif
467 }
468 return 0;
469 }
470
471 /* Return the frame whose principal (outermost) window is WDESC.
472 If WDESC is some other (smaller) window, we return 0. */
473
474 struct frame *
475 x_top_window_to_frame (dpyinfo, wdesc)
476 struct x_display_info *dpyinfo;
477 int wdesc;
478 {
479 Lisp_Object tail, frame;
480 struct frame *f;
481 struct x_output *x;
482
483 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
484 {
485 frame = XCAR (tail);
486 if (!GC_FRAMEP (frame))
487 continue;
488 f = XFRAME (frame);
489 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
490 continue;
491 x = f->output_data.x;
492
493 if (x->widget)
494 {
495 /* This frame matches if the window is its topmost widget. */
496 #ifdef USE_GTK
497 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
498 if (gwdesc == x->widget)
499 return f;
500 #else
501 if (wdesc == XtWindow (x->widget))
502 return f;
503 #if 0 /* I don't know why it did this,
504 but it seems logically wrong,
505 and it causes trouble for MapNotify events. */
506 /* Match if the window is this frame's menubar. */
507 if (x->menubar_widget
508 && wdesc == XtWindow (x->menubar_widget))
509 return f;
510 #endif
511 #endif
512 }
513 else if (FRAME_X_WINDOW (f) == wdesc)
514 /* Tooltip frame. */
515 return f;
516 }
517 return 0;
518 }
519 #endif /* USE_X_TOOLKIT || USE_GTK */
520
521 \f
522
523 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
524 id, which is just an int that this section returns. Bitmaps are
525 reference counted so they can be shared among frames.
526
527 Bitmap indices are guaranteed to be > 0, so a negative number can
528 be used to indicate no bitmap.
529
530 If you use x_create_bitmap_from_data, then you must keep track of
531 the bitmaps yourself. That is, creating a bitmap from the same
532 data more than once will not be caught. */
533
534
535 /* Functions to access the contents of a bitmap, given an id. */
536
537 int
538 x_bitmap_height (f, id)
539 FRAME_PTR f;
540 int id;
541 {
542 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].height;
543 }
544
545 int
546 x_bitmap_width (f, id)
547 FRAME_PTR f;
548 int id;
549 {
550 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].width;
551 }
552
553 int
554 x_bitmap_pixmap (f, id)
555 FRAME_PTR f;
556 int id;
557 {
558 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
559 }
560
561 int
562 x_bitmap_mask (f, id)
563 FRAME_PTR f;
564 int id;
565 {
566 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].mask;
567 }
568
569
570 /* Allocate a new bitmap record. Returns index of new record. */
571
572 static int
573 x_allocate_bitmap_record (f)
574 FRAME_PTR f;
575 {
576 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
577 int i;
578
579 if (dpyinfo->bitmaps == NULL)
580 {
581 dpyinfo->bitmaps_size = 10;
582 dpyinfo->bitmaps
583 = (struct x_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
584 dpyinfo->bitmaps_last = 1;
585 return 1;
586 }
587
588 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
589 return ++dpyinfo->bitmaps_last;
590
591 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
592 if (dpyinfo->bitmaps[i].refcount == 0)
593 return i + 1;
594
595 dpyinfo->bitmaps_size *= 2;
596 dpyinfo->bitmaps
597 = (struct x_bitmap_record *) xrealloc (dpyinfo->bitmaps,
598 dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
599 return ++dpyinfo->bitmaps_last;
600 }
601
602 /* Add one reference to the reference count of the bitmap with id ID. */
603
604 void
605 x_reference_bitmap (f, id)
606 FRAME_PTR f;
607 int id;
608 {
609 ++FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
610 }
611
612 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
613
614 int
615 x_create_bitmap_from_data (f, bits, width, height)
616 struct frame *f;
617 char *bits;
618 unsigned int width, height;
619 {
620 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
621 Pixmap bitmap;
622 int id;
623
624 bitmap = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
625 bits, width, height);
626
627
628
629 if (! bitmap)
630 return -1;
631
632 id = x_allocate_bitmap_record (f);
633 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
634 dpyinfo->bitmaps[id - 1].have_mask = 0;
635 dpyinfo->bitmaps[id - 1].file = NULL;
636 dpyinfo->bitmaps[id - 1].refcount = 1;
637 dpyinfo->bitmaps[id - 1].depth = 1;
638 dpyinfo->bitmaps[id - 1].height = height;
639 dpyinfo->bitmaps[id - 1].width = width;
640
641 return id;
642 }
643
644 /* Create bitmap from file FILE for frame F. */
645
646 int
647 x_create_bitmap_from_file (f, file)
648 struct frame *f;
649 Lisp_Object file;
650 {
651 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
652 unsigned int width, height;
653 Pixmap bitmap;
654 int xhot, yhot, result, id;
655 Lisp_Object found;
656 int fd;
657 char *filename;
658
659 /* Look for an existing bitmap with the same name. */
660 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
661 {
662 if (dpyinfo->bitmaps[id].refcount
663 && dpyinfo->bitmaps[id].file
664 && !strcmp (dpyinfo->bitmaps[id].file, (char *) SDATA (file)))
665 {
666 ++dpyinfo->bitmaps[id].refcount;
667 return id + 1;
668 }
669 }
670
671 /* Search bitmap-file-path for the file, if appropriate. */
672 fd = openp (Vx_bitmap_file_path, file, Qnil, &found, Qnil);
673 if (fd < 0)
674 return -1;
675 emacs_close (fd);
676
677 filename = (char *) SDATA (found);
678
679 result = XReadBitmapFile (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
680 filename, &width, &height, &bitmap, &xhot, &yhot);
681 if (result != BitmapSuccess)
682 return -1;
683
684 id = x_allocate_bitmap_record (f);
685 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
686 dpyinfo->bitmaps[id - 1].have_mask = 0;
687 dpyinfo->bitmaps[id - 1].refcount = 1;
688 dpyinfo->bitmaps[id - 1].file
689 = (char *) xmalloc (SBYTES (file) + 1);
690 dpyinfo->bitmaps[id - 1].depth = 1;
691 dpyinfo->bitmaps[id - 1].height = height;
692 dpyinfo->bitmaps[id - 1].width = width;
693 strcpy (dpyinfo->bitmaps[id - 1].file, SDATA (file));
694
695 return id;
696 }
697
698 /* Remove reference to bitmap with id number ID. */
699
700 void
701 x_destroy_bitmap (f, id)
702 FRAME_PTR f;
703 int id;
704 {
705 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
706
707 if (id > 0)
708 {
709 --dpyinfo->bitmaps[id - 1].refcount;
710 if (dpyinfo->bitmaps[id - 1].refcount == 0)
711 {
712 BLOCK_INPUT;
713 XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].pixmap);
714 if (dpyinfo->bitmaps[id - 1].have_mask)
715 XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].mask);
716 if (dpyinfo->bitmaps[id - 1].file)
717 {
718 xfree (dpyinfo->bitmaps[id - 1].file);
719 dpyinfo->bitmaps[id - 1].file = NULL;
720 }
721 UNBLOCK_INPUT;
722 }
723 }
724 }
725
726 /* Free all the bitmaps for the display specified by DPYINFO. */
727
728 static void
729 x_destroy_all_bitmaps (dpyinfo)
730 struct x_display_info *dpyinfo;
731 {
732 int i;
733 for (i = 0; i < dpyinfo->bitmaps_last; i++)
734 if (dpyinfo->bitmaps[i].refcount > 0)
735 {
736 XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].pixmap);
737 if (dpyinfo->bitmaps[i].have_mask)
738 XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].mask);
739 if (dpyinfo->bitmaps[i].file)
740 xfree (dpyinfo->bitmaps[i].file);
741 }
742 dpyinfo->bitmaps_last = 0;
743 }
744 \f
745
746
747
748 /* Useful functions defined in the section
749 `Image type independent image structures' below. */
750
751 static unsigned long four_corners_best P_ ((XImage *ximg, unsigned long width,
752 unsigned long height));
753
754 static int x_create_x_image_and_pixmap P_ ((struct frame *f, int width, int height,
755 int depth, XImage **ximg,
756 Pixmap *pixmap));
757
758 static void x_destroy_x_image P_ ((XImage *ximg));
759
760
761 /* Create a mask of a bitmap. Note is this not a perfect mask.
762 It's nicer with some borders in this context */
763
764 int
765 x_create_bitmap_mask (f, id)
766 struct frame *f;
767 int id;
768 {
769 Pixmap pixmap, mask;
770 XImage *ximg, *mask_img;
771 unsigned long width, height;
772 int result;
773 unsigned long bg;
774 unsigned long x, y, xp, xm, yp, ym;
775 GC gc;
776
777 int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
778 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
779
780 if (!(id > 0))
781 return -1;
782
783 pixmap = x_bitmap_pixmap (f, id);
784 width = x_bitmap_width (f, id);
785 height = x_bitmap_height (f, id);
786
787 BLOCK_INPUT;
788 ximg = XGetImage (FRAME_X_DISPLAY (f), pixmap, 0, 0, width, height,
789 ~0, ZPixmap);
790
791 if (!ximg)
792 {
793 UNBLOCK_INPUT;
794 return -1;
795 }
796
797 result = x_create_x_image_and_pixmap (f, width, height, 1, &mask_img, &mask);
798
799 UNBLOCK_INPUT;
800 if (!result)
801 {
802 XDestroyImage (ximg);
803 return -1;
804 }
805
806 bg = four_corners_best (ximg, width, height);
807
808 for (y = 0; y < ximg->height; ++y)
809 {
810 for (x = 0; x < ximg->width; ++x)
811 {
812 xp = x != ximg->width - 1 ? x + 1 : 0;
813 xm = x != 0 ? x - 1 : ximg->width - 1;
814 yp = y != ximg->height - 1 ? y + 1 : 0;
815 ym = y != 0 ? y - 1 : ximg->height - 1;
816 if (XGetPixel (ximg, x, y) == bg
817 && XGetPixel (ximg, x, yp) == bg
818 && XGetPixel (ximg, x, ym) == bg
819 && XGetPixel (ximg, xp, y) == bg
820 && XGetPixel (ximg, xp, yp) == bg
821 && XGetPixel (ximg, xp, ym) == bg
822 && XGetPixel (ximg, xm, y) == bg
823 && XGetPixel (ximg, xm, yp) == bg
824 && XGetPixel (ximg, xm, ym) == bg)
825 XPutPixel (mask_img, x, y, 0);
826 else
827 XPutPixel (mask_img, x, y, 1);
828 }
829 }
830
831 xassert (interrupt_input_blocked);
832 gc = XCreateGC (FRAME_X_DISPLAY (f), mask, 0, NULL);
833 XPutImage (FRAME_X_DISPLAY (f), mask, gc, mask_img, 0, 0, 0, 0,
834 width, height);
835 XFreeGC (FRAME_X_DISPLAY (f), gc);
836
837 dpyinfo->bitmaps[id - 1].have_mask = 1;
838 dpyinfo->bitmaps[id - 1].mask = mask;
839
840 XDestroyImage (ximg);
841 x_destroy_x_image (mask_img);
842
843 return 0;
844 }
845
846 static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
847 static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
848 static void x_disable_image P_ ((struct frame *, struct image *));
849
850 void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
851 static void x_set_wait_for_wm P_ ((struct frame *, Lisp_Object, Lisp_Object));
852 void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
853 void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
854 void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
855 void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
856 void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
857 void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
858 void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
859 void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
860 void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
861 void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
862 void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
863 void x_set_scroll_bar_foreground P_ ((struct frame *, Lisp_Object,
864 Lisp_Object));
865 void x_set_scroll_bar_background P_ ((struct frame *, Lisp_Object,
866 Lisp_Object));
867 static Lisp_Object x_default_scroll_bar_color_parameter P_ ((struct frame *,
868 Lisp_Object,
869 Lisp_Object,
870 char *, char *,
871 int));
872 static void x_edge_detection P_ ((struct frame *, struct image *, Lisp_Object,
873 Lisp_Object));
874 static void init_color_table P_ ((void));
875 static void free_color_table P_ ((void));
876 static unsigned long *colors_in_color_table P_ ((int *n));
877 static unsigned long lookup_rgb_color P_ ((struct frame *f, int r, int g, int b));
878 static unsigned long lookup_pixel_color P_ ((struct frame *f, unsigned long p));
879
880
881
882 \f
883
884 /* Store the screen positions of frame F into XPTR and YPTR.
885 These are the positions of the containing window manager window,
886 not Emacs's own window. */
887
888 void
889 x_real_positions (f, xptr, yptr)
890 FRAME_PTR f;
891 int *xptr, *yptr;
892 {
893 int win_x, win_y, outer_x, outer_y;
894 int real_x = 0, real_y = 0;
895 int had_errors = 0;
896 Window win = f->output_data.x->parent_desc;
897
898 int count;
899
900 BLOCK_INPUT;
901
902 count = x_catch_errors (FRAME_X_DISPLAY (f));
903
904 if (win == FRAME_X_DISPLAY_INFO (f)->root_window)
905 win = FRAME_OUTER_WINDOW (f);
906
907 /* This loop traverses up the containment tree until we hit the root
908 window. Window managers may intersect many windows between our window
909 and the root window. The window we find just before the root window
910 should be the outer WM window. */
911 for (;;)
912 {
913 Window wm_window, rootw;
914 Window *tmp_children;
915 unsigned int tmp_nchildren;
916 int success;
917
918 success = XQueryTree (FRAME_X_DISPLAY (f), win, &rootw,
919 &wm_window, &tmp_children, &tmp_nchildren);
920
921 had_errors = x_had_errors_p (FRAME_X_DISPLAY (f));
922
923 /* Don't free tmp_children if XQueryTree failed. */
924 if (! success)
925 break;
926
927 XFree ((char *) tmp_children);
928
929 if (wm_window == rootw || had_errors)
930 break;
931
932 win = wm_window;
933 }
934
935 if (! had_errors)
936 {
937 int ign;
938 Window child, rootw;
939
940 /* Get the real coordinates for the WM window upper left corner */
941 XGetGeometry (FRAME_X_DISPLAY (f), win,
942 &rootw, &real_x, &real_y, &ign, &ign, &ign, &ign);
943
944 /* Translate real coordinates to coordinates relative to our
945 window. For our window, the upper left corner is 0, 0.
946 Since the upper left corner of the WM window is outside
947 our window, win_x and win_y will be negative:
948
949 ------------------ ---> x
950 | title |
951 | ----------------- v y
952 | | our window
953 */
954 XTranslateCoordinates (FRAME_X_DISPLAY (f),
955
956 /* From-window, to-window. */
957 FRAME_X_DISPLAY_INFO (f)->root_window,
958 FRAME_X_WINDOW (f),
959
960 /* From-position, to-position. */
961 real_x, real_y, &win_x, &win_y,
962
963 /* Child of win. */
964 &child);
965
966 if (FRAME_X_WINDOW (f) == FRAME_OUTER_WINDOW (f))
967 {
968 outer_x = win_x;
969 outer_y = win_y;
970 }
971 else
972 {
973 XTranslateCoordinates (FRAME_X_DISPLAY (f),
974
975 /* From-window, to-window. */
976 FRAME_X_DISPLAY_INFO (f)->root_window,
977 FRAME_OUTER_WINDOW (f),
978
979 /* From-position, to-position. */
980 real_x, real_y, &outer_x, &outer_y,
981
982 /* Child of win. */
983 &child);
984 }
985
986 had_errors = x_had_errors_p (FRAME_X_DISPLAY (f));
987 }
988
989 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
990
991 UNBLOCK_INPUT;
992
993 if (had_errors) return;
994
995 f->x_pixels_diff = -win_x;
996 f->y_pixels_diff = -win_y;
997
998 FRAME_X_OUTPUT (f)->x_pixels_outer_diff = -outer_x;
999 FRAME_X_OUTPUT (f)->y_pixels_outer_diff = -outer_y;
1000
1001 *xptr = real_x;
1002 *yptr = real_y;
1003 }
1004
1005 \f
1006
1007
1008 /* Gamma-correct COLOR on frame F. */
1009
1010 void
1011 gamma_correct (f, color)
1012 struct frame *f;
1013 XColor *color;
1014 {
1015 if (f->gamma)
1016 {
1017 color->red = pow (color->red / 65535.0, f->gamma) * 65535.0 + 0.5;
1018 color->green = pow (color->green / 65535.0, f->gamma) * 65535.0 + 0.5;
1019 color->blue = pow (color->blue / 65535.0, f->gamma) * 65535.0 + 0.5;
1020 }
1021 }
1022
1023
1024 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1025 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1026 allocate the color. Value is zero if COLOR_NAME is invalid, or
1027 no color could be allocated. */
1028
1029 int
1030 x_defined_color (f, color_name, color, alloc_p)
1031 struct frame *f;
1032 char *color_name;
1033 XColor *color;
1034 int alloc_p;
1035 {
1036 int success_p;
1037 Display *dpy = FRAME_X_DISPLAY (f);
1038 Colormap cmap = FRAME_X_COLORMAP (f);
1039
1040 BLOCK_INPUT;
1041 success_p = XParseColor (dpy, cmap, color_name, color);
1042 if (success_p && alloc_p)
1043 success_p = x_alloc_nearest_color (f, cmap, color);
1044 UNBLOCK_INPUT;
1045
1046 return success_p;
1047 }
1048
1049
1050 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1051 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1052 Signal an error if color can't be allocated. */
1053
1054 int
1055 x_decode_color (f, color_name, mono_color)
1056 FRAME_PTR f;
1057 Lisp_Object color_name;
1058 int mono_color;
1059 {
1060 XColor cdef;
1061
1062 CHECK_STRING (color_name);
1063
1064 #if 0 /* Don't do this. It's wrong when we're not using the default
1065 colormap, it makes freeing difficult, and it's probably not
1066 an important optimization. */
1067 if (strcmp (SDATA (color_name), "black") == 0)
1068 return BLACK_PIX_DEFAULT (f);
1069 else if (strcmp (SDATA (color_name), "white") == 0)
1070 return WHITE_PIX_DEFAULT (f);
1071 #endif
1072
1073 /* Return MONO_COLOR for monochrome frames. */
1074 if (FRAME_X_DISPLAY_INFO (f)->n_planes == 1)
1075 return mono_color;
1076
1077 /* x_defined_color is responsible for coping with failures
1078 by looking for a near-miss. */
1079 if (x_defined_color (f, SDATA (color_name), &cdef, 1))
1080 return cdef.pixel;
1081
1082 Fsignal (Qerror, Fcons (build_string ("Undefined color"),
1083 Fcons (color_name, Qnil)));
1084 return 0;
1085 }
1086
1087
1088 \f
1089 /* Change the `wait-for-wm' frame parameter of frame F. OLD_VALUE is
1090 the previous value of that parameter, NEW_VALUE is the new value.
1091 See also the comment of wait_for_wm in struct x_output. */
1092
1093 static void
1094 x_set_wait_for_wm (f, new_value, old_value)
1095 struct frame *f;
1096 Lisp_Object new_value, old_value;
1097 {
1098 f->output_data.x->wait_for_wm = !NILP (new_value);
1099 }
1100
1101 #ifdef USE_GTK
1102
1103 static Lisp_Object x_find_image_file P_ ((Lisp_Object file));
1104
1105 /* Set icon from FILE for frame F. By using GTK functions the icon
1106 may be any format that GdkPixbuf knows about, i.e. not just bitmaps. */
1107
1108 int
1109 xg_set_icon (f, file)
1110 FRAME_PTR f;
1111 Lisp_Object file;
1112 {
1113 struct gcpro gcpro1;
1114 int result = 0;
1115 Lisp_Object found;
1116
1117 GCPRO1 (found);
1118
1119 found = x_find_image_file (file);
1120
1121 if (! NILP (found))
1122 {
1123 GdkPixbuf *pixbuf;
1124 GError *err = NULL;
1125 char *filename;
1126
1127 filename = SDATA (found);
1128 BLOCK_INPUT;
1129
1130 pixbuf = gdk_pixbuf_new_from_file (filename, &err);
1131
1132 if (pixbuf)
1133 {
1134 gtk_window_set_icon (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
1135 pixbuf);
1136 g_object_unref (pixbuf);
1137
1138 result = 1;
1139 }
1140 else
1141 g_error_free (err);
1142
1143 UNBLOCK_INPUT;
1144 }
1145
1146 UNGCPRO;
1147 return result;
1148 }
1149 #endif /* USE_GTK */
1150
1151
1152 /* Functions called only from `x_set_frame_param'
1153 to set individual parameters.
1154
1155 If FRAME_X_WINDOW (f) is 0,
1156 the frame is being created and its X-window does not exist yet.
1157 In that case, just record the parameter's new value
1158 in the standard place; do not attempt to change the window. */
1159
1160 void
1161 x_set_foreground_color (f, arg, oldval)
1162 struct frame *f;
1163 Lisp_Object arg, oldval;
1164 {
1165 struct x_output *x = f->output_data.x;
1166 unsigned long fg, old_fg;
1167
1168 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1169 old_fg = x->foreground_pixel;
1170 x->foreground_pixel = fg;
1171
1172 if (FRAME_X_WINDOW (f) != 0)
1173 {
1174 Display *dpy = FRAME_X_DISPLAY (f);
1175
1176 BLOCK_INPUT;
1177 XSetForeground (dpy, x->normal_gc, fg);
1178 XSetBackground (dpy, x->reverse_gc, fg);
1179
1180 if (x->cursor_pixel == old_fg)
1181 {
1182 unload_color (f, x->cursor_pixel);
1183 x->cursor_pixel = x_copy_color (f, fg);
1184 XSetBackground (dpy, x->cursor_gc, x->cursor_pixel);
1185 }
1186
1187 UNBLOCK_INPUT;
1188
1189 update_face_from_frame_parameter (f, Qforeground_color, arg);
1190
1191 if (FRAME_VISIBLE_P (f))
1192 redraw_frame (f);
1193 }
1194
1195 unload_color (f, old_fg);
1196 }
1197
1198 void
1199 x_set_background_color (f, arg, oldval)
1200 struct frame *f;
1201 Lisp_Object arg, oldval;
1202 {
1203 struct x_output *x = f->output_data.x;
1204 unsigned long bg;
1205
1206 bg = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1207 unload_color (f, x->background_pixel);
1208 x->background_pixel = bg;
1209
1210 if (FRAME_X_WINDOW (f) != 0)
1211 {
1212 Display *dpy = FRAME_X_DISPLAY (f);
1213
1214 BLOCK_INPUT;
1215 XSetBackground (dpy, x->normal_gc, bg);
1216 XSetForeground (dpy, x->reverse_gc, bg);
1217 XSetWindowBackground (dpy, FRAME_X_WINDOW (f), bg);
1218 XSetForeground (dpy, x->cursor_gc, bg);
1219
1220 #ifdef USE_GTK
1221 xg_set_background_color (f, bg);
1222 #endif
1223
1224 #ifndef USE_TOOLKIT_SCROLL_BARS /* Turns out to be annoying with
1225 toolkit scroll bars. */
1226 {
1227 Lisp_Object bar;
1228 for (bar = FRAME_SCROLL_BARS (f);
1229 !NILP (bar);
1230 bar = XSCROLL_BAR (bar)->next)
1231 {
1232 Window window = SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar));
1233 XSetWindowBackground (dpy, window, bg);
1234 }
1235 }
1236 #endif /* USE_TOOLKIT_SCROLL_BARS */
1237
1238 UNBLOCK_INPUT;
1239 update_face_from_frame_parameter (f, Qbackground_color, arg);
1240
1241 if (FRAME_VISIBLE_P (f))
1242 redraw_frame (f);
1243 }
1244 }
1245
1246 void
1247 x_set_mouse_color (f, arg, oldval)
1248 struct frame *f;
1249 Lisp_Object arg, oldval;
1250 {
1251 struct x_output *x = f->output_data.x;
1252 Display *dpy = FRAME_X_DISPLAY (f);
1253 Cursor cursor, nontext_cursor, mode_cursor, hand_cursor;
1254 Cursor hourglass_cursor, horizontal_drag_cursor;
1255 int count;
1256 unsigned long pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1257 unsigned long mask_color = x->background_pixel;
1258
1259 /* Don't let pointers be invisible. */
1260 if (mask_color == pixel)
1261 {
1262 x_free_colors (f, &pixel, 1);
1263 pixel = x_copy_color (f, x->foreground_pixel);
1264 }
1265
1266 unload_color (f, x->mouse_pixel);
1267 x->mouse_pixel = pixel;
1268
1269 BLOCK_INPUT;
1270
1271 /* It's not okay to crash if the user selects a screwy cursor. */
1272 count = x_catch_errors (dpy);
1273
1274 if (!NILP (Vx_pointer_shape))
1275 {
1276 CHECK_NUMBER (Vx_pointer_shape);
1277 cursor = XCreateFontCursor (dpy, XINT (Vx_pointer_shape));
1278 }
1279 else
1280 cursor = XCreateFontCursor (dpy, XC_xterm);
1281 x_check_errors (dpy, "bad text pointer cursor: %s");
1282
1283 if (!NILP (Vx_nontext_pointer_shape))
1284 {
1285 CHECK_NUMBER (Vx_nontext_pointer_shape);
1286 nontext_cursor
1287 = XCreateFontCursor (dpy, XINT (Vx_nontext_pointer_shape));
1288 }
1289 else
1290 nontext_cursor = XCreateFontCursor (dpy, XC_left_ptr);
1291 x_check_errors (dpy, "bad nontext pointer cursor: %s");
1292
1293 if (!NILP (Vx_hourglass_pointer_shape))
1294 {
1295 CHECK_NUMBER (Vx_hourglass_pointer_shape);
1296 hourglass_cursor
1297 = XCreateFontCursor (dpy, XINT (Vx_hourglass_pointer_shape));
1298 }
1299 else
1300 hourglass_cursor = XCreateFontCursor (dpy, XC_watch);
1301 x_check_errors (dpy, "bad hourglass pointer cursor: %s");
1302
1303 if (!NILP (Vx_mode_pointer_shape))
1304 {
1305 CHECK_NUMBER (Vx_mode_pointer_shape);
1306 mode_cursor = XCreateFontCursor (dpy, XINT (Vx_mode_pointer_shape));
1307 }
1308 else
1309 mode_cursor = XCreateFontCursor (dpy, XC_xterm);
1310 x_check_errors (dpy, "bad modeline pointer cursor: %s");
1311
1312 if (!NILP (Vx_sensitive_text_pointer_shape))
1313 {
1314 CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
1315 hand_cursor
1316 = XCreateFontCursor (dpy, XINT (Vx_sensitive_text_pointer_shape));
1317 }
1318 else
1319 hand_cursor = XCreateFontCursor (dpy, XC_hand2);
1320
1321 if (!NILP (Vx_window_horizontal_drag_shape))
1322 {
1323 CHECK_NUMBER (Vx_window_horizontal_drag_shape);
1324 horizontal_drag_cursor
1325 = XCreateFontCursor (dpy, XINT (Vx_window_horizontal_drag_shape));
1326 }
1327 else
1328 horizontal_drag_cursor
1329 = XCreateFontCursor (dpy, XC_sb_h_double_arrow);
1330
1331 /* Check and report errors with the above calls. */
1332 x_check_errors (dpy, "can't set cursor shape: %s");
1333 x_uncatch_errors (dpy, count);
1334
1335 {
1336 XColor fore_color, back_color;
1337
1338 fore_color.pixel = x->mouse_pixel;
1339 x_query_color (f, &fore_color);
1340 back_color.pixel = mask_color;
1341 x_query_color (f, &back_color);
1342
1343 XRecolorCursor (dpy, cursor, &fore_color, &back_color);
1344 XRecolorCursor (dpy, nontext_cursor, &fore_color, &back_color);
1345 XRecolorCursor (dpy, mode_cursor, &fore_color, &back_color);
1346 XRecolorCursor (dpy, hand_cursor, &fore_color, &back_color);
1347 XRecolorCursor (dpy, hourglass_cursor, &fore_color, &back_color);
1348 XRecolorCursor (dpy, horizontal_drag_cursor, &fore_color, &back_color);
1349 }
1350
1351 if (FRAME_X_WINDOW (f) != 0)
1352 XDefineCursor (dpy, FRAME_X_WINDOW (f), cursor);
1353
1354 if (cursor != x->text_cursor
1355 && x->text_cursor != 0)
1356 XFreeCursor (dpy, x->text_cursor);
1357 x->text_cursor = cursor;
1358
1359 if (nontext_cursor != x->nontext_cursor
1360 && x->nontext_cursor != 0)
1361 XFreeCursor (dpy, x->nontext_cursor);
1362 x->nontext_cursor = nontext_cursor;
1363
1364 if (hourglass_cursor != x->hourglass_cursor
1365 && x->hourglass_cursor != 0)
1366 XFreeCursor (dpy, x->hourglass_cursor);
1367 x->hourglass_cursor = hourglass_cursor;
1368
1369 if (mode_cursor != x->modeline_cursor
1370 && x->modeline_cursor != 0)
1371 XFreeCursor (dpy, f->output_data.x->modeline_cursor);
1372 x->modeline_cursor = mode_cursor;
1373
1374 if (hand_cursor != x->hand_cursor
1375 && x->hand_cursor != 0)
1376 XFreeCursor (dpy, x->hand_cursor);
1377 x->hand_cursor = hand_cursor;
1378
1379 if (horizontal_drag_cursor != x->horizontal_drag_cursor
1380 && x->horizontal_drag_cursor != 0)
1381 XFreeCursor (dpy, x->horizontal_drag_cursor);
1382 x->horizontal_drag_cursor = horizontal_drag_cursor;
1383
1384 XFlush (dpy);
1385 UNBLOCK_INPUT;
1386
1387 update_face_from_frame_parameter (f, Qmouse_color, arg);
1388 }
1389
1390 void
1391 x_set_cursor_color (f, arg, oldval)
1392 struct frame *f;
1393 Lisp_Object arg, oldval;
1394 {
1395 unsigned long fore_pixel, pixel;
1396 int fore_pixel_allocated_p = 0, pixel_allocated_p = 0;
1397 struct x_output *x = f->output_data.x;
1398
1399 if (!NILP (Vx_cursor_fore_pixel))
1400 {
1401 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1402 WHITE_PIX_DEFAULT (f));
1403 fore_pixel_allocated_p = 1;
1404 }
1405 else
1406 fore_pixel = x->background_pixel;
1407
1408 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1409 pixel_allocated_p = 1;
1410
1411 /* Make sure that the cursor color differs from the background color. */
1412 if (pixel == x->background_pixel)
1413 {
1414 if (pixel_allocated_p)
1415 {
1416 x_free_colors (f, &pixel, 1);
1417 pixel_allocated_p = 0;
1418 }
1419
1420 pixel = x->mouse_pixel;
1421 if (pixel == fore_pixel)
1422 {
1423 if (fore_pixel_allocated_p)
1424 {
1425 x_free_colors (f, &fore_pixel, 1);
1426 fore_pixel_allocated_p = 0;
1427 }
1428 fore_pixel = x->background_pixel;
1429 }
1430 }
1431
1432 unload_color (f, x->cursor_foreground_pixel);
1433 if (!fore_pixel_allocated_p)
1434 fore_pixel = x_copy_color (f, fore_pixel);
1435 x->cursor_foreground_pixel = fore_pixel;
1436
1437 unload_color (f, x->cursor_pixel);
1438 if (!pixel_allocated_p)
1439 pixel = x_copy_color (f, pixel);
1440 x->cursor_pixel = pixel;
1441
1442 if (FRAME_X_WINDOW (f) != 0)
1443 {
1444 BLOCK_INPUT;
1445 XSetBackground (FRAME_X_DISPLAY (f), x->cursor_gc, x->cursor_pixel);
1446 XSetForeground (FRAME_X_DISPLAY (f), x->cursor_gc, fore_pixel);
1447 UNBLOCK_INPUT;
1448
1449 if (FRAME_VISIBLE_P (f))
1450 {
1451 x_update_cursor (f, 0);
1452 x_update_cursor (f, 1);
1453 }
1454 }
1455
1456 update_face_from_frame_parameter (f, Qcursor_color, arg);
1457 }
1458 \f
1459 /* Set the border-color of frame F to pixel value PIX.
1460 Note that this does not fully take effect if done before
1461 F has an x-window. */
1462
1463 void
1464 x_set_border_pixel (f, pix)
1465 struct frame *f;
1466 int pix;
1467 {
1468 unload_color (f, f->output_data.x->border_pixel);
1469 f->output_data.x->border_pixel = pix;
1470
1471 if (FRAME_X_WINDOW (f) != 0 && f->border_width > 0)
1472 {
1473 BLOCK_INPUT;
1474 XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1475 (unsigned long)pix);
1476 UNBLOCK_INPUT;
1477
1478 if (FRAME_VISIBLE_P (f))
1479 redraw_frame (f);
1480 }
1481 }
1482
1483 /* Set the border-color of frame F to value described by ARG.
1484 ARG can be a string naming a color.
1485 The border-color is used for the border that is drawn by the X server.
1486 Note that this does not fully take effect if done before
1487 F has an x-window; it must be redone when the window is created.
1488
1489 Note: this is done in two routines because of the way X10 works.
1490
1491 Note: under X11, this is normally the province of the window manager,
1492 and so emacs' border colors may be overridden. */
1493
1494 void
1495 x_set_border_color (f, arg, oldval)
1496 struct frame *f;
1497 Lisp_Object arg, oldval;
1498 {
1499 int pix;
1500
1501 CHECK_STRING (arg);
1502 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1503 x_set_border_pixel (f, pix);
1504 update_face_from_frame_parameter (f, Qborder_color, arg);
1505 }
1506
1507
1508 void
1509 x_set_cursor_type (f, arg, oldval)
1510 FRAME_PTR f;
1511 Lisp_Object arg, oldval;
1512 {
1513 set_frame_cursor_types (f, arg);
1514
1515 /* Make sure the cursor gets redrawn. */
1516 cursor_type_changed = 1;
1517 }
1518 \f
1519 void
1520 x_set_icon_type (f, arg, oldval)
1521 struct frame *f;
1522 Lisp_Object arg, oldval;
1523 {
1524 int result;
1525
1526 if (STRINGP (arg))
1527 {
1528 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1529 return;
1530 }
1531 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1532 return;
1533
1534 BLOCK_INPUT;
1535 if (NILP (arg))
1536 result = x_text_icon (f,
1537 (char *) SDATA ((!NILP (f->icon_name)
1538 ? f->icon_name
1539 : f->name)));
1540 else
1541 result = x_bitmap_icon (f, arg);
1542
1543 if (result)
1544 {
1545 UNBLOCK_INPUT;
1546 error ("No icon window available");
1547 }
1548
1549 XFlush (FRAME_X_DISPLAY (f));
1550 UNBLOCK_INPUT;
1551 }
1552
1553 void
1554 x_set_icon_name (f, arg, oldval)
1555 struct frame *f;
1556 Lisp_Object arg, oldval;
1557 {
1558 int result;
1559
1560 if (STRINGP (arg))
1561 {
1562 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1563 return;
1564 }
1565 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1566 return;
1567
1568 f->icon_name = arg;
1569
1570 if (f->output_data.x->icon_bitmap != 0)
1571 return;
1572
1573 BLOCK_INPUT;
1574
1575 result = x_text_icon (f,
1576 (char *) SDATA ((!NILP (f->icon_name)
1577 ? f->icon_name
1578 : !NILP (f->title)
1579 ? f->title
1580 : f->name)));
1581
1582 if (result)
1583 {
1584 UNBLOCK_INPUT;
1585 error ("No icon window available");
1586 }
1587
1588 XFlush (FRAME_X_DISPLAY (f));
1589 UNBLOCK_INPUT;
1590 }
1591
1592 \f
1593 void
1594 x_set_menu_bar_lines (f, value, oldval)
1595 struct frame *f;
1596 Lisp_Object value, oldval;
1597 {
1598 int nlines;
1599 #ifndef USE_X_TOOLKIT
1600 int olines = FRAME_MENU_BAR_LINES (f);
1601 #endif
1602
1603 /* Right now, menu bars don't work properly in minibuf-only frames;
1604 most of the commands try to apply themselves to the minibuffer
1605 frame itself, and get an error because you can't switch buffers
1606 in or split the minibuffer window. */
1607 if (FRAME_MINIBUF_ONLY_P (f))
1608 return;
1609
1610 if (INTEGERP (value))
1611 nlines = XINT (value);
1612 else
1613 nlines = 0;
1614
1615 /* Make sure we redisplay all windows in this frame. */
1616 windows_or_buffers_changed++;
1617
1618 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
1619 FRAME_MENU_BAR_LINES (f) = 0;
1620 if (nlines)
1621 {
1622 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1623 if (FRAME_X_P (f) && f->output_data.x->menubar_widget == 0)
1624 /* Make sure next redisplay shows the menu bar. */
1625 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1626 }
1627 else
1628 {
1629 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1630 free_frame_menubar (f);
1631 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1632 if (FRAME_X_P (f))
1633 f->output_data.x->menubar_widget = 0;
1634 }
1635 #else /* not USE_X_TOOLKIT && not USE_GTK */
1636 FRAME_MENU_BAR_LINES (f) = nlines;
1637 change_window_heights (f->root_window, nlines - olines);
1638 #endif /* not USE_X_TOOLKIT */
1639 adjust_glyphs (f);
1640 }
1641
1642
1643 /* Set the number of lines used for the tool bar of frame F to VALUE.
1644 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1645 is the old number of tool bar lines. This function changes the
1646 height of all windows on frame F to match the new tool bar height.
1647 The frame's height doesn't change. */
1648
1649 void
1650 x_set_tool_bar_lines (f, value, oldval)
1651 struct frame *f;
1652 Lisp_Object value, oldval;
1653 {
1654 int delta, nlines, root_height;
1655 Lisp_Object root_window;
1656
1657 /* Treat tool bars like menu bars. */
1658 if (FRAME_MINIBUF_ONLY_P (f))
1659 return;
1660
1661 /* Use VALUE only if an integer >= 0. */
1662 if (INTEGERP (value) && XINT (value) >= 0)
1663 nlines = XFASTINT (value);
1664 else
1665 nlines = 0;
1666
1667 #ifdef USE_GTK
1668 FRAME_TOOL_BAR_LINES (f) = 0;
1669 if (nlines)
1670 {
1671 FRAME_EXTERNAL_TOOL_BAR (f) = 1;
1672 if (FRAME_X_P (f) && f->output_data.x->toolbar_widget == 0)
1673 /* Make sure next redisplay shows the tool bar. */
1674 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1675 update_frame_tool_bar (f);
1676 }
1677 else
1678 {
1679 if (FRAME_EXTERNAL_TOOL_BAR (f))
1680 free_frame_tool_bar (f);
1681 FRAME_EXTERNAL_TOOL_BAR (f) = 0;
1682 }
1683
1684 return;
1685 #endif
1686
1687 /* Make sure we redisplay all windows in this frame. */
1688 ++windows_or_buffers_changed;
1689
1690 delta = nlines - FRAME_TOOL_BAR_LINES (f);
1691
1692 /* Don't resize the tool-bar to more than we have room for. */
1693 root_window = FRAME_ROOT_WINDOW (f);
1694 root_height = WINDOW_TOTAL_LINES (XWINDOW (root_window));
1695 if (root_height - delta < 1)
1696 {
1697 delta = root_height - 1;
1698 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
1699 }
1700
1701 FRAME_TOOL_BAR_LINES (f) = nlines;
1702 change_window_heights (root_window, delta);
1703 adjust_glyphs (f);
1704
1705 /* We also have to make sure that the internal border at the top of
1706 the frame, below the menu bar or tool bar, is redrawn when the
1707 tool bar disappears. This is so because the internal border is
1708 below the tool bar if one is displayed, but is below the menu bar
1709 if there isn't a tool bar. The tool bar draws into the area
1710 below the menu bar. */
1711 if (FRAME_X_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
1712 {
1713 updating_frame = f;
1714 clear_frame ();
1715 clear_current_matrices (f);
1716 updating_frame = NULL;
1717 }
1718
1719 /* If the tool bar gets smaller, the internal border below it
1720 has to be cleared. It was formerly part of the display
1721 of the larger tool bar, and updating windows won't clear it. */
1722 if (delta < 0)
1723 {
1724 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
1725 int width = FRAME_PIXEL_WIDTH (f);
1726 int y = nlines * FRAME_LINE_HEIGHT (f);
1727
1728 BLOCK_INPUT;
1729 x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1730 0, y, width, height, False);
1731 UNBLOCK_INPUT;
1732
1733 if (WINDOWP (f->tool_bar_window))
1734 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
1735 }
1736 }
1737
1738
1739 /* Set the foreground color for scroll bars on frame F to VALUE.
1740 VALUE should be a string, a color name. If it isn't a string or
1741 isn't a valid color name, do nothing. OLDVAL is the old value of
1742 the frame parameter. */
1743
1744 void
1745 x_set_scroll_bar_foreground (f, value, oldval)
1746 struct frame *f;
1747 Lisp_Object value, oldval;
1748 {
1749 unsigned long pixel;
1750
1751 if (STRINGP (value))
1752 pixel = x_decode_color (f, value, BLACK_PIX_DEFAULT (f));
1753 else
1754 pixel = -1;
1755
1756 if (f->output_data.x->scroll_bar_foreground_pixel != -1)
1757 unload_color (f, f->output_data.x->scroll_bar_foreground_pixel);
1758
1759 f->output_data.x->scroll_bar_foreground_pixel = pixel;
1760 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
1761 {
1762 /* Remove all scroll bars because they have wrong colors. */
1763 if (condemn_scroll_bars_hook)
1764 (*condemn_scroll_bars_hook) (f);
1765 if (judge_scroll_bars_hook)
1766 (*judge_scroll_bars_hook) (f);
1767
1768 update_face_from_frame_parameter (f, Qscroll_bar_foreground, value);
1769 redraw_frame (f);
1770 }
1771 }
1772
1773
1774 /* Set the background color for scroll bars on frame F to VALUE VALUE
1775 should be a string, a color name. If it isn't a string or isn't a
1776 valid color name, do nothing. OLDVAL is the old value of the frame
1777 parameter. */
1778
1779 void
1780 x_set_scroll_bar_background (f, value, oldval)
1781 struct frame *f;
1782 Lisp_Object value, oldval;
1783 {
1784 unsigned long pixel;
1785
1786 if (STRINGP (value))
1787 pixel = x_decode_color (f, value, WHITE_PIX_DEFAULT (f));
1788 else
1789 pixel = -1;
1790
1791 if (f->output_data.x->scroll_bar_background_pixel != -1)
1792 unload_color (f, f->output_data.x->scroll_bar_background_pixel);
1793
1794 #ifdef USE_TOOLKIT_SCROLL_BARS
1795 /* Scrollbar shadow colors. */
1796 if (f->output_data.x->scroll_bar_top_shadow_pixel != -1)
1797 {
1798 unload_color (f, f->output_data.x->scroll_bar_top_shadow_pixel);
1799 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
1800 }
1801 if (f->output_data.x->scroll_bar_bottom_shadow_pixel != -1)
1802 {
1803 unload_color (f, f->output_data.x->scroll_bar_bottom_shadow_pixel);
1804 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
1805 }
1806 #endif /* USE_TOOLKIT_SCROLL_BARS */
1807
1808 f->output_data.x->scroll_bar_background_pixel = pixel;
1809 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
1810 {
1811 /* Remove all scroll bars because they have wrong colors. */
1812 if (condemn_scroll_bars_hook)
1813 (*condemn_scroll_bars_hook) (f);
1814 if (judge_scroll_bars_hook)
1815 (*judge_scroll_bars_hook) (f);
1816
1817 update_face_from_frame_parameter (f, Qscroll_bar_background, value);
1818 redraw_frame (f);
1819 }
1820 }
1821
1822 \f
1823 /* Encode Lisp string STRING as a text in a format appropriate for
1824 XICCC (X Inter Client Communication Conventions).
1825
1826 If STRING contains only ASCII characters, do no conversion and
1827 return the string data of STRING. Otherwise, encode the text by
1828 CODING_SYSTEM, and return a newly allocated memory area which
1829 should be freed by `xfree' by a caller.
1830
1831 SELECTIONP non-zero means the string is being encoded for an X
1832 selection, so it is safe to run pre-write conversions (which
1833 may run Lisp code).
1834
1835 Store the byte length of resulting text in *TEXT_BYTES.
1836
1837 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
1838 which means that the `encoding' of the result can be `STRING'.
1839 Otherwise store 0 in *STRINGP, which means that the `encoding' of
1840 the result should be `COMPOUND_TEXT'. */
1841
1842 unsigned char *
1843 x_encode_text (string, coding_system, selectionp, text_bytes, stringp)
1844 Lisp_Object string, coding_system;
1845 int *text_bytes, *stringp;
1846 int selectionp;
1847 {
1848 unsigned char *str = SDATA (string);
1849 int chars = SCHARS (string);
1850 int bytes = SBYTES (string);
1851 int charset_info;
1852 int bufsize;
1853 unsigned char *buf;
1854 struct coding_system coding;
1855 extern Lisp_Object Qcompound_text_with_extensions;
1856
1857 charset_info = find_charset_in_text (str, chars, bytes, NULL, Qnil);
1858 if (charset_info == 0)
1859 {
1860 /* No multibyte character in OBJ. We need not encode it. */
1861 *text_bytes = bytes;
1862 *stringp = 1;
1863 return str;
1864 }
1865
1866 setup_coding_system (coding_system, &coding);
1867 if (selectionp
1868 && SYMBOLP (coding.pre_write_conversion)
1869 && !NILP (Ffboundp (coding.pre_write_conversion)))
1870 {
1871 string = run_pre_post_conversion_on_str (string, &coding, 1);
1872 str = SDATA (string);
1873 chars = SCHARS (string);
1874 bytes = SBYTES (string);
1875 }
1876 coding.src_multibyte = 1;
1877 coding.dst_multibyte = 0;
1878 coding.mode |= CODING_MODE_LAST_BLOCK;
1879 if (coding.type == coding_type_iso2022)
1880 coding.flags |= CODING_FLAG_ISO_SAFE;
1881 /* We suppress producing escape sequences for composition. */
1882 coding.composing = COMPOSITION_DISABLED;
1883 bufsize = encoding_buffer_size (&coding, bytes);
1884 buf = (unsigned char *) xmalloc (bufsize);
1885 encode_coding (&coding, str, buf, bytes, bufsize);
1886 *text_bytes = coding.produced;
1887 *stringp = (charset_info == 1
1888 || (!EQ (coding_system, Qcompound_text)
1889 && !EQ (coding_system, Qcompound_text_with_extensions)));
1890 return buf;
1891 }
1892
1893 \f
1894 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1895 x_id_name.
1896
1897 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1898 name; if NAME is a string, set F's name to NAME and set
1899 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1900
1901 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1902 suggesting a new name, which lisp code should override; if
1903 F->explicit_name is set, ignore the new name; otherwise, set it. */
1904
1905 void
1906 x_set_name (f, name, explicit)
1907 struct frame *f;
1908 Lisp_Object name;
1909 int explicit;
1910 {
1911 /* Make sure that requests from lisp code override requests from
1912 Emacs redisplay code. */
1913 if (explicit)
1914 {
1915 /* If we're switching from explicit to implicit, we had better
1916 update the mode lines and thereby update the title. */
1917 if (f->explicit_name && NILP (name))
1918 update_mode_lines = 1;
1919
1920 f->explicit_name = ! NILP (name);
1921 }
1922 else if (f->explicit_name)
1923 return;
1924
1925 /* If NAME is nil, set the name to the x_id_name. */
1926 if (NILP (name))
1927 {
1928 /* Check for no change needed in this very common case
1929 before we do any consing. */
1930 if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name,
1931 SDATA (f->name)))
1932 return;
1933 name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name);
1934 }
1935 else
1936 CHECK_STRING (name);
1937
1938 /* Don't change the name if it's already NAME. */
1939 if (! NILP (Fstring_equal (name, f->name)))
1940 return;
1941
1942 f->name = name;
1943
1944 /* For setting the frame title, the title parameter should override
1945 the name parameter. */
1946 if (! NILP (f->title))
1947 name = f->title;
1948
1949 if (FRAME_X_WINDOW (f))
1950 {
1951 BLOCK_INPUT;
1952 #ifdef HAVE_X11R4
1953 {
1954 XTextProperty text, icon;
1955 int bytes, stringp;
1956 Lisp_Object coding_system;
1957
1958 /* Note: Encoding strategy
1959
1960 We encode NAME by compound-text and use "COMPOUND-TEXT" in
1961 text.encoding. But, there are non-internationalized window
1962 managers which don't support that encoding. So, if NAME
1963 contains only ASCII and 8859-1 characters, encode it by
1964 iso-latin-1, and use "STRING" in text.encoding hoping that
1965 such window managers at least analyze this format correctly,
1966 i.e. treat 8-bit bytes as 8859-1 characters.
1967
1968 We may also be able to use "UTF8_STRING" in text.encoding
1969 in the future which can encode all Unicode characters.
1970 But, for the moment, there's no way to know that the
1971 current window manager supports it or not. */
1972 coding_system = Qcompound_text;
1973 text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp);
1974 text.encoding = (stringp ? XA_STRING
1975 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
1976 text.format = 8;
1977 text.nitems = bytes;
1978
1979 if (NILP (f->icon_name))
1980 {
1981 icon = text;
1982 }
1983 else
1984 {
1985 /* See the above comment "Note: Encoding strategy". */
1986 icon.value = x_encode_text (f->icon_name, coding_system, 0,
1987 &bytes, &stringp);
1988 icon.encoding = (stringp ? XA_STRING
1989 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
1990 icon.format = 8;
1991 icon.nitems = bytes;
1992 }
1993 #ifdef USE_GTK
1994 gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
1995 SDATA (name));
1996 #else /* not USE_GTK */
1997 XSetWMName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &text);
1998 #endif /* not USE_GTK */
1999
2000 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &icon);
2001
2002 if (!NILP (f->icon_name)
2003 && icon.value != (unsigned char *) SDATA (f->icon_name))
2004 xfree (icon.value);
2005 if (text.value != (unsigned char *) SDATA (name))
2006 xfree (text.value);
2007 }
2008 #else /* not HAVE_X11R4 */
2009 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2010 SDATA (name));
2011 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2012 SDATA (name));
2013 #endif /* not HAVE_X11R4 */
2014 UNBLOCK_INPUT;
2015 }
2016 }
2017
2018 /* This function should be called when the user's lisp code has
2019 specified a name for the frame; the name will override any set by the
2020 redisplay code. */
2021 void
2022 x_explicitly_set_name (f, arg, oldval)
2023 FRAME_PTR f;
2024 Lisp_Object arg, oldval;
2025 {
2026 x_set_name (f, arg, 1);
2027 }
2028
2029 /* This function should be called by Emacs redisplay code to set the
2030 name; names set this way will never override names set by the user's
2031 lisp code. */
2032 void
2033 x_implicitly_set_name (f, arg, oldval)
2034 FRAME_PTR f;
2035 Lisp_Object arg, oldval;
2036 {
2037 x_set_name (f, arg, 0);
2038 }
2039 \f
2040 /* Change the title of frame F to NAME.
2041 If NAME is nil, use the frame name as the title.
2042
2043 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2044 name; if NAME is a string, set F's name to NAME and set
2045 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2046
2047 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2048 suggesting a new name, which lisp code should override; if
2049 F->explicit_name is set, ignore the new name; otherwise, set it. */
2050
2051 void
2052 x_set_title (f, name, old_name)
2053 struct frame *f;
2054 Lisp_Object name, old_name;
2055 {
2056 /* Don't change the title if it's already NAME. */
2057 if (EQ (name, f->title))
2058 return;
2059
2060 update_mode_lines = 1;
2061
2062 f->title = name;
2063
2064 if (NILP (name))
2065 name = f->name;
2066 else
2067 CHECK_STRING (name);
2068
2069 if (FRAME_X_WINDOW (f))
2070 {
2071 BLOCK_INPUT;
2072 #ifdef HAVE_X11R4
2073 {
2074 XTextProperty text, icon;
2075 int bytes, stringp;
2076 Lisp_Object coding_system;
2077
2078 coding_system = Qcompound_text;
2079 /* See the comment "Note: Encoding strategy" in x_set_name. */
2080 text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp);
2081 text.encoding = (stringp ? XA_STRING
2082 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
2083 text.format = 8;
2084 text.nitems = bytes;
2085
2086 if (NILP (f->icon_name))
2087 {
2088 icon = text;
2089 }
2090 else
2091 {
2092 /* See the comment "Note: Encoding strategy" in x_set_name. */
2093 icon.value = x_encode_text (f->icon_name, coding_system, 0,
2094 &bytes, &stringp);
2095 icon.encoding = (stringp ? XA_STRING
2096 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
2097 icon.format = 8;
2098 icon.nitems = bytes;
2099 }
2100
2101 #ifdef USE_GTK
2102 gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
2103 SDATA (name));
2104 #else /* not USE_GTK */
2105 XSetWMName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &text);
2106 #endif /* not USE_GTK */
2107
2108 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
2109 &icon);
2110
2111 if (!NILP (f->icon_name)
2112 && icon.value != (unsigned char *) SDATA (f->icon_name))
2113 xfree (icon.value);
2114 if (text.value != (unsigned char *) SDATA (name))
2115 xfree (text.value);
2116 }
2117 #else /* not HAVE_X11R4 */
2118 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2119 SDATA (name));
2120 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2121 SDATA (name));
2122 #endif /* not HAVE_X11R4 */
2123 UNBLOCK_INPUT;
2124 }
2125 }
2126
2127 void
2128 x_set_scroll_bar_default_width (f)
2129 struct frame *f;
2130 {
2131 int wid = FRAME_COLUMN_WIDTH (f);
2132
2133 #ifdef USE_TOOLKIT_SCROLL_BARS
2134 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2135 int width = 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM;
2136 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (width + wid - 1) / wid;
2137 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = width;
2138 #else
2139 /* Make the actual width at least 14 pixels and a multiple of a
2140 character width. */
2141 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid;
2142
2143 /* Use all of that space (aside from required margins) for the
2144 scroll bar. */
2145 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = 0;
2146 #endif
2147 }
2148
2149 \f
2150 /* Record in frame F the specified or default value according to ALIST
2151 of the parameter named PROP (a Lisp symbol). If no value is
2152 specified for PROP, look for an X default for XPROP on the frame
2153 named NAME. If that is not found either, use the value DEFLT. */
2154
2155 static Lisp_Object
2156 x_default_scroll_bar_color_parameter (f, alist, prop, xprop, xclass,
2157 foreground_p)
2158 struct frame *f;
2159 Lisp_Object alist;
2160 Lisp_Object prop;
2161 char *xprop;
2162 char *xclass;
2163 int foreground_p;
2164 {
2165 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2166 Lisp_Object tem;
2167
2168 tem = x_get_arg (dpyinfo, alist, prop, xprop, xclass, RES_TYPE_STRING);
2169 if (EQ (tem, Qunbound))
2170 {
2171 #ifdef USE_TOOLKIT_SCROLL_BARS
2172
2173 /* See if an X resource for the scroll bar color has been
2174 specified. */
2175 tem = display_x_get_resource (dpyinfo,
2176 build_string (foreground_p
2177 ? "foreground"
2178 : "background"),
2179 empty_string,
2180 build_string ("verticalScrollBar"),
2181 empty_string);
2182 if (!STRINGP (tem))
2183 {
2184 /* If nothing has been specified, scroll bars will use a
2185 toolkit-dependent default. Because these defaults are
2186 difficult to get at without actually creating a scroll
2187 bar, use nil to indicate that no color has been
2188 specified. */
2189 tem = Qnil;
2190 }
2191
2192 #else /* not USE_TOOLKIT_SCROLL_BARS */
2193
2194 tem = Qnil;
2195
2196 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2197 }
2198
2199 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2200 return tem;
2201 }
2202
2203
2204
2205 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2206
2207 Status
2208 XSetWMProtocols (dpy, w, protocols, count)
2209 Display *dpy;
2210 Window w;
2211 Atom *protocols;
2212 int count;
2213 {
2214 Atom prop;
2215 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
2216 if (prop == None) return False;
2217 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
2218 (unsigned char *) protocols, count);
2219 return True;
2220 }
2221 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2222 \f
2223 #ifdef USE_X_TOOLKIT
2224
2225 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2226 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2227 already be present because of the toolkit (Motif adds some of them,
2228 for example, but Xt doesn't). */
2229
2230 static void
2231 hack_wm_protocols (f, widget)
2232 FRAME_PTR f;
2233 Widget widget;
2234 {
2235 Display *dpy = XtDisplay (widget);
2236 Window w = XtWindow (widget);
2237 int need_delete = 1;
2238 int need_focus = 1;
2239 int need_save = 1;
2240
2241 BLOCK_INPUT;
2242 {
2243 Atom type, *atoms = 0;
2244 int format = 0;
2245 unsigned long nitems = 0;
2246 unsigned long bytes_after;
2247
2248 if ((XGetWindowProperty (dpy, w,
2249 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2250 (long)0, (long)100, False, XA_ATOM,
2251 &type, &format, &nitems, &bytes_after,
2252 (unsigned char **) &atoms)
2253 == Success)
2254 && format == 32 && type == XA_ATOM)
2255 while (nitems > 0)
2256 {
2257 nitems--;
2258 if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window)
2259 need_delete = 0;
2260 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus)
2261 need_focus = 0;
2262 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
2263 need_save = 0;
2264 }
2265 if (atoms) XFree ((char *) atoms);
2266 }
2267 {
2268 Atom props [10];
2269 int count = 0;
2270 if (need_delete)
2271 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2272 if (need_focus)
2273 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus;
2274 if (need_save)
2275 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2276 if (count)
2277 XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2278 XA_ATOM, 32, PropModeAppend,
2279 (unsigned char *) props, count);
2280 }
2281 UNBLOCK_INPUT;
2282 }
2283 #endif
2284
2285
2286 \f
2287 /* Support routines for XIC (X Input Context). */
2288
2289 #ifdef HAVE_X_I18N
2290
2291 static XFontSet xic_create_xfontset P_ ((struct frame *, char *));
2292 static XIMStyle best_xim_style P_ ((XIMStyles *, XIMStyles *));
2293
2294
2295 /* Supported XIM styles, ordered by preference. */
2296
2297 static XIMStyle supported_xim_styles[] =
2298 {
2299 XIMPreeditPosition | XIMStatusArea,
2300 XIMPreeditPosition | XIMStatusNothing,
2301 XIMPreeditPosition | XIMStatusNone,
2302 XIMPreeditNothing | XIMStatusArea,
2303 XIMPreeditNothing | XIMStatusNothing,
2304 XIMPreeditNothing | XIMStatusNone,
2305 XIMPreeditNone | XIMStatusArea,
2306 XIMPreeditNone | XIMStatusNothing,
2307 XIMPreeditNone | XIMStatusNone,
2308 0,
2309 };
2310
2311
2312 /* Create an X fontset on frame F with base font name
2313 BASE_FONTNAME.. */
2314
2315 static XFontSet
2316 xic_create_xfontset (f, base_fontname)
2317 struct frame *f;
2318 char *base_fontname;
2319 {
2320 XFontSet xfs;
2321 char **missing_list;
2322 int missing_count;
2323 char *def_string;
2324
2325 xfs = XCreateFontSet (FRAME_X_DISPLAY (f),
2326 base_fontname, &missing_list,
2327 &missing_count, &def_string);
2328 if (missing_list)
2329 XFreeStringList (missing_list);
2330
2331 /* No need to free def_string. */
2332 return xfs;
2333 }
2334
2335
2336 /* Value is the best input style, given user preferences USER (already
2337 checked to be supported by Emacs), and styles supported by the
2338 input method XIM. */
2339
2340 static XIMStyle
2341 best_xim_style (user, xim)
2342 XIMStyles *user;
2343 XIMStyles *xim;
2344 {
2345 int i, j;
2346
2347 for (i = 0; i < user->count_styles; ++i)
2348 for (j = 0; j < xim->count_styles; ++j)
2349 if (user->supported_styles[i] == xim->supported_styles[j])
2350 return user->supported_styles[i];
2351
2352 /* Return the default style. */
2353 return XIMPreeditNothing | XIMStatusNothing;
2354 }
2355
2356 /* Create XIC for frame F. */
2357
2358 static XIMStyle xic_style;
2359
2360 void
2361 create_frame_xic (f)
2362 struct frame *f;
2363 {
2364 XIM xim;
2365 XIC xic = NULL;
2366 XFontSet xfs = NULL;
2367
2368 if (FRAME_XIC (f))
2369 return;
2370
2371 xim = FRAME_X_XIM (f);
2372 if (xim)
2373 {
2374 XRectangle s_area;
2375 XPoint spot;
2376 XVaNestedList preedit_attr;
2377 XVaNestedList status_attr;
2378 char *base_fontname;
2379 int fontset;
2380
2381 s_area.x = 0; s_area.y = 0; s_area.width = 1; s_area.height = 1;
2382 spot.x = 0; spot.y = 1;
2383 /* Create X fontset. */
2384 fontset = FRAME_FONTSET (f);
2385 if (fontset < 0)
2386 base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
2387 else
2388 {
2389 /* Determine the base fontname from the ASCII font name of
2390 FONTSET. */
2391 char *ascii_font = (char *) SDATA (fontset_ascii (fontset));
2392 char *p = ascii_font;
2393 int i;
2394
2395 for (i = 0; *p; p++)
2396 if (*p == '-') i++;
2397 if (i != 14)
2398 /* As the font name doesn't conform to XLFD, we can't
2399 modify it to get a suitable base fontname for the
2400 frame. */
2401 base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
2402 else
2403 {
2404 int len = strlen (ascii_font) + 1;
2405 char *p1 = NULL;
2406
2407 for (i = 0, p = ascii_font; i < 8; p++)
2408 {
2409 if (*p == '-')
2410 {
2411 i++;
2412 if (i == 3)
2413 p1 = p + 1;
2414 }
2415 }
2416 base_fontname = (char *) alloca (len);
2417 bzero (base_fontname, len);
2418 strcpy (base_fontname, "-*-*-");
2419 bcopy (p1, base_fontname + 5, p - p1);
2420 strcat (base_fontname, "*-*-*-*-*-*-*");
2421 }
2422 }
2423 xfs = xic_create_xfontset (f, base_fontname);
2424
2425 /* Determine XIC style. */
2426 if (xic_style == 0)
2427 {
2428 XIMStyles supported_list;
2429 supported_list.count_styles = (sizeof supported_xim_styles
2430 / sizeof supported_xim_styles[0]);
2431 supported_list.supported_styles = supported_xim_styles;
2432 xic_style = best_xim_style (&supported_list,
2433 FRAME_X_XIM_STYLES (f));
2434 }
2435
2436 preedit_attr = XVaCreateNestedList (0,
2437 XNFontSet, xfs,
2438 XNForeground,
2439 FRAME_FOREGROUND_PIXEL (f),
2440 XNBackground,
2441 FRAME_BACKGROUND_PIXEL (f),
2442 (xic_style & XIMPreeditPosition
2443 ? XNSpotLocation
2444 : NULL),
2445 &spot,
2446 NULL);
2447 status_attr = XVaCreateNestedList (0,
2448 XNArea,
2449 &s_area,
2450 XNFontSet,
2451 xfs,
2452 XNForeground,
2453 FRAME_FOREGROUND_PIXEL (f),
2454 XNBackground,
2455 FRAME_BACKGROUND_PIXEL (f),
2456 NULL);
2457
2458 xic = XCreateIC (xim,
2459 XNInputStyle, xic_style,
2460 XNClientWindow, FRAME_X_WINDOW (f),
2461 XNFocusWindow, FRAME_X_WINDOW (f),
2462 XNStatusAttributes, status_attr,
2463 XNPreeditAttributes, preedit_attr,
2464 NULL);
2465 XFree (preedit_attr);
2466 XFree (status_attr);
2467 }
2468
2469 FRAME_XIC (f) = xic;
2470 FRAME_XIC_STYLE (f) = xic_style;
2471 FRAME_XIC_FONTSET (f) = xfs;
2472 }
2473
2474
2475 /* Destroy XIC and free XIC fontset of frame F, if any. */
2476
2477 void
2478 free_frame_xic (f)
2479 struct frame *f;
2480 {
2481 if (FRAME_XIC (f) == NULL)
2482 return;
2483
2484 XDestroyIC (FRAME_XIC (f));
2485 if (FRAME_XIC_FONTSET (f))
2486 XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
2487
2488 FRAME_XIC (f) = NULL;
2489 FRAME_XIC_FONTSET (f) = NULL;
2490 }
2491
2492
2493 /* Place preedit area for XIC of window W's frame to specified
2494 pixel position X/Y. X and Y are relative to window W. */
2495
2496 void
2497 xic_set_preeditarea (w, x, y)
2498 struct window *w;
2499 int x, y;
2500 {
2501 struct frame *f = XFRAME (w->frame);
2502 XVaNestedList attr;
2503 XPoint spot;
2504
2505 spot.x = WINDOW_TO_FRAME_PIXEL_X (w, x) + WINDOW_LEFT_FRINGE_WIDTH (w);
2506 spot.y = WINDOW_TO_FRAME_PIXEL_Y (w, y) + FONT_BASE (FRAME_FONT (f));
2507 attr = XVaCreateNestedList (0, XNSpotLocation, &spot, NULL);
2508 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
2509 XFree (attr);
2510 }
2511
2512
2513 /* Place status area for XIC in bottom right corner of frame F.. */
2514
2515 void
2516 xic_set_statusarea (f)
2517 struct frame *f;
2518 {
2519 XIC xic = FRAME_XIC (f);
2520 XVaNestedList attr;
2521 XRectangle area;
2522 XRectangle *needed;
2523
2524 /* Negotiate geometry of status area. If input method has existing
2525 status area, use its current size. */
2526 area.x = area.y = area.width = area.height = 0;
2527 attr = XVaCreateNestedList (0, XNAreaNeeded, &area, NULL);
2528 XSetICValues (xic, XNStatusAttributes, attr, NULL);
2529 XFree (attr);
2530
2531 attr = XVaCreateNestedList (0, XNAreaNeeded, &needed, NULL);
2532 XGetICValues (xic, XNStatusAttributes, attr, NULL);
2533 XFree (attr);
2534
2535 if (needed->width == 0) /* Use XNArea instead of XNAreaNeeded */
2536 {
2537 attr = XVaCreateNestedList (0, XNArea, &needed, NULL);
2538 XGetICValues (xic, XNStatusAttributes, attr, NULL);
2539 XFree (attr);
2540 }
2541
2542 area.width = needed->width;
2543 area.height = needed->height;
2544 area.x = FRAME_PIXEL_WIDTH (f) - area.width - FRAME_INTERNAL_BORDER_WIDTH (f);
2545 area.y = (FRAME_PIXEL_HEIGHT (f) - area.height
2546 - FRAME_MENUBAR_HEIGHT (f)
2547 - FRAME_TOOLBAR_HEIGHT (f)
2548 - FRAME_INTERNAL_BORDER_WIDTH (f));
2549 XFree (needed);
2550
2551 attr = XVaCreateNestedList (0, XNArea, &area, NULL);
2552 XSetICValues (xic, XNStatusAttributes, attr, NULL);
2553 XFree (attr);
2554 }
2555
2556
2557 /* Set X fontset for XIC of frame F, using base font name
2558 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
2559
2560 void
2561 xic_set_xfontset (f, base_fontname)
2562 struct frame *f;
2563 char *base_fontname;
2564 {
2565 XVaNestedList attr;
2566 XFontSet xfs;
2567
2568 xfs = xic_create_xfontset (f, base_fontname);
2569
2570 attr = XVaCreateNestedList (0, XNFontSet, xfs, NULL);
2571 if (FRAME_XIC_STYLE (f) & XIMPreeditPosition)
2572 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
2573 if (FRAME_XIC_STYLE (f) & XIMStatusArea)
2574 XSetICValues (FRAME_XIC (f), XNStatusAttributes, attr, NULL);
2575 XFree (attr);
2576
2577 if (FRAME_XIC_FONTSET (f))
2578 XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
2579 FRAME_XIC_FONTSET (f) = xfs;
2580 }
2581
2582 #endif /* HAVE_X_I18N */
2583
2584
2585 \f
2586 #ifdef USE_X_TOOLKIT
2587
2588 /* Create and set up the X widget for frame F. */
2589
2590 static void
2591 x_window (f, window_prompting, minibuffer_only)
2592 struct frame *f;
2593 long window_prompting;
2594 int minibuffer_only;
2595 {
2596 XClassHint class_hints;
2597 XSetWindowAttributes attributes;
2598 unsigned long attribute_mask;
2599 Widget shell_widget;
2600 Widget pane_widget;
2601 Widget frame_widget;
2602 Arg al [25];
2603 int ac;
2604
2605 BLOCK_INPUT;
2606
2607 /* Use the resource name as the top-level widget name
2608 for looking up resources. Make a non-Lisp copy
2609 for the window manager, so GC relocation won't bother it.
2610
2611 Elsewhere we specify the window name for the window manager. */
2612
2613 {
2614 char *str = (char *) SDATA (Vx_resource_name);
2615 f->namebuf = (char *) xmalloc (strlen (str) + 1);
2616 strcpy (f->namebuf, str);
2617 }
2618
2619 ac = 0;
2620 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
2621 XtSetArg (al[ac], XtNinput, 1); ac++;
2622 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2623 XtSetArg (al[ac], XtNborderWidth, f->border_width); ac++;
2624 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
2625 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
2626 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
2627 shell_widget = XtAppCreateShell (f->namebuf, EMACS_CLASS,
2628 applicationShellWidgetClass,
2629 FRAME_X_DISPLAY (f), al, ac);
2630
2631 f->output_data.x->widget = shell_widget;
2632 /* maybe_set_screen_title_format (shell_widget); */
2633
2634 pane_widget = lw_create_widget ("main", "pane", widget_id_tick++,
2635 (widget_value *) NULL,
2636 shell_widget, False,
2637 (lw_callback) NULL,
2638 (lw_callback) NULL,
2639 (lw_callback) NULL,
2640 (lw_callback) NULL);
2641
2642 ac = 0;
2643 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
2644 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
2645 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
2646 XtSetValues (pane_widget, al, ac);
2647 f->output_data.x->column_widget = pane_widget;
2648
2649 /* mappedWhenManaged to false tells to the paned window to not map/unmap
2650 the emacs screen when changing menubar. This reduces flickering. */
2651
2652 ac = 0;
2653 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2654 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
2655 XtSetArg (al[ac], XtNallowResize, 1); ac++;
2656 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
2657 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
2658 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
2659 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
2660 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
2661 frame_widget = XtCreateWidget (f->namebuf, emacsFrameClass, pane_widget,
2662 al, ac);
2663
2664 f->output_data.x->edit_widget = frame_widget;
2665
2666 XtManageChild (frame_widget);
2667
2668 /* Do some needed geometry management. */
2669 {
2670 int len;
2671 char *tem, shell_position[32];
2672 Arg al[10];
2673 int ac = 0;
2674 int extra_borders = 0;
2675 int menubar_size
2676 = (f->output_data.x->menubar_widget
2677 ? (f->output_data.x->menubar_widget->core.height
2678 + f->output_data.x->menubar_widget->core.border_width)
2679 : 0);
2680
2681 #if 0 /* Experimentally, we now get the right results
2682 for -geometry -0-0 without this. 24 Aug 96, rms. */
2683 if (FRAME_EXTERNAL_MENU_BAR (f))
2684 {
2685 Dimension ibw = 0;
2686 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
2687 menubar_size += ibw;
2688 }
2689 #endif
2690
2691 f->output_data.x->menubar_height = menubar_size;
2692
2693 #ifndef USE_LUCID
2694 /* Motif seems to need this amount added to the sizes
2695 specified for the shell widget. The Athena/Lucid widgets don't.
2696 Both conclusions reached experimentally. -- rms. */
2697 XtVaGetValues (f->output_data.x->edit_widget, XtNinternalBorderWidth,
2698 &extra_borders, NULL);
2699 extra_borders *= 2;
2700 #endif
2701
2702 /* Convert our geometry parameters into a geometry string
2703 and specify it.
2704 Note that we do not specify here whether the position
2705 is a user-specified or program-specified one.
2706 We pass that information later, in x_wm_set_size_hints. */
2707 {
2708 int left = f->left_pos;
2709 int xneg = window_prompting & XNegative;
2710 int top = f->top_pos;
2711 int yneg = window_prompting & YNegative;
2712 if (xneg)
2713 left = -left;
2714 if (yneg)
2715 top = -top;
2716
2717 if (window_prompting & USPosition)
2718 sprintf (shell_position, "=%dx%d%c%d%c%d",
2719 FRAME_PIXEL_WIDTH (f) + extra_borders,
2720 FRAME_PIXEL_HEIGHT (f) + menubar_size + extra_borders,
2721 (xneg ? '-' : '+'), left,
2722 (yneg ? '-' : '+'), top);
2723 else
2724 {
2725 sprintf (shell_position, "=%dx%d",
2726 FRAME_PIXEL_WIDTH (f) + extra_borders,
2727 FRAME_PIXEL_HEIGHT (f) + menubar_size + extra_borders);
2728
2729 /* Setting x and y when the position is not specified in
2730 the geometry string will set program position in the WM hints.
2731 If Emacs had just one program position, we could set it in
2732 fallback resources, but since each make-frame call can specify
2733 different program positions, this is easier. */
2734 XtSetArg (al[ac], XtNx, left); ac++;
2735 XtSetArg (al[ac], XtNy, top); ac++;
2736 }
2737 }
2738
2739 len = strlen (shell_position) + 1;
2740 /* We don't free this because we don't know whether
2741 it is safe to free it while the frame exists.
2742 It isn't worth the trouble of arranging to free it
2743 when the frame is deleted. */
2744 tem = (char *) xmalloc (len);
2745 strncpy (tem, shell_position, len);
2746 XtSetArg (al[ac], XtNgeometry, tem); ac++;
2747 XtSetValues (shell_widget, al, ac);
2748 }
2749
2750 XtManageChild (pane_widget);
2751 XtRealizeWidget (shell_widget);
2752
2753 FRAME_X_WINDOW (f) = XtWindow (frame_widget);
2754
2755 validate_x_resource_name ();
2756
2757 class_hints.res_name = (char *) SDATA (Vx_resource_name);
2758 class_hints.res_class = (char *) SDATA (Vx_resource_class);
2759 XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
2760
2761 #ifdef HAVE_X_I18N
2762 FRAME_XIC (f) = NULL;
2763 if (use_xim)
2764 create_frame_xic (f);
2765 #endif
2766
2767 f->output_data.x->wm_hints.input = True;
2768 f->output_data.x->wm_hints.flags |= InputHint;
2769 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2770 &f->output_data.x->wm_hints);
2771
2772 hack_wm_protocols (f, shell_widget);
2773
2774 #ifdef HACK_EDITRES
2775 XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
2776 #endif
2777
2778 /* Do a stupid property change to force the server to generate a
2779 PropertyNotify event so that the event_stream server timestamp will
2780 be initialized to something relevant to the time we created the window.
2781 */
2782 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
2783 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2784 XA_ATOM, 32, PropModeAppend,
2785 (unsigned char*) NULL, 0);
2786
2787 /* Make all the standard events reach the Emacs frame. */
2788 attributes.event_mask = STANDARD_EVENT_SET;
2789
2790 #ifdef HAVE_X_I18N
2791 if (FRAME_XIC (f))
2792 {
2793 /* XIM server might require some X events. */
2794 unsigned long fevent = NoEventMask;
2795 XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
2796 attributes.event_mask |= fevent;
2797 }
2798 #endif /* HAVE_X_I18N */
2799
2800 attribute_mask = CWEventMask;
2801 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
2802 attribute_mask, &attributes);
2803
2804 XtMapWidget (frame_widget);
2805
2806 /* x_set_name normally ignores requests to set the name if the
2807 requested name is the same as the current name. This is the one
2808 place where that assumption isn't correct; f->name is set, but
2809 the X server hasn't been told. */
2810 {
2811 Lisp_Object name;
2812 int explicit = f->explicit_name;
2813
2814 f->explicit_name = 0;
2815 name = f->name;
2816 f->name = Qnil;
2817 x_set_name (f, name, explicit);
2818 }
2819
2820 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2821 f->output_data.x->text_cursor);
2822
2823 UNBLOCK_INPUT;
2824
2825 /* This is a no-op, except under Motif. Make sure main areas are
2826 set to something reasonable, in case we get an error later. */
2827 lw_set_main_areas (pane_widget, 0, frame_widget);
2828 }
2829
2830 #else /* not USE_X_TOOLKIT */
2831 #ifdef USE_GTK
2832 void
2833 x_window (f)
2834 FRAME_PTR f;
2835 {
2836 if (! xg_create_frame_widgets (f))
2837 error ("Unable to create window");
2838
2839 #ifdef HAVE_X_I18N
2840 FRAME_XIC (f) = NULL;
2841 if (use_xim)
2842 {
2843 BLOCK_INPUT;
2844 create_frame_xic (f);
2845 if (FRAME_XIC (f))
2846 {
2847 /* XIM server might require some X events. */
2848 unsigned long fevent = NoEventMask;
2849 XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
2850
2851 if (fevent != NoEventMask)
2852 {
2853 XSetWindowAttributes attributes;
2854 XWindowAttributes wattr;
2855 unsigned long attribute_mask;
2856
2857 XGetWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2858 &wattr);
2859 attributes.event_mask = wattr.your_event_mask | fevent;
2860 attribute_mask = CWEventMask;
2861 XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2862 attribute_mask, &attributes);
2863 }
2864 }
2865 UNBLOCK_INPUT;
2866 }
2867 #endif
2868 }
2869
2870 #else /*! USE_GTK */
2871 /* Create and set up the X window for frame F. */
2872
2873 void
2874 x_window (f)
2875 struct frame *f;
2876
2877 {
2878 XClassHint class_hints;
2879 XSetWindowAttributes attributes;
2880 unsigned long attribute_mask;
2881
2882 attributes.background_pixel = f->output_data.x->background_pixel;
2883 attributes.border_pixel = f->output_data.x->border_pixel;
2884 attributes.bit_gravity = StaticGravity;
2885 attributes.backing_store = NotUseful;
2886 attributes.save_under = True;
2887 attributes.event_mask = STANDARD_EVENT_SET;
2888 attributes.colormap = FRAME_X_COLORMAP (f);
2889 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity | CWEventMask
2890 | CWColormap);
2891
2892 BLOCK_INPUT;
2893 FRAME_X_WINDOW (f)
2894 = XCreateWindow (FRAME_X_DISPLAY (f),
2895 f->output_data.x->parent_desc,
2896 f->left_pos,
2897 f->top_pos,
2898 FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f),
2899 f->border_width,
2900 CopyFromParent, /* depth */
2901 InputOutput, /* class */
2902 FRAME_X_VISUAL (f),
2903 attribute_mask, &attributes);
2904
2905 #ifdef HAVE_X_I18N
2906 if (use_xim)
2907 {
2908 create_frame_xic (f);
2909 if (FRAME_XIC (f))
2910 {
2911 /* XIM server might require some X events. */
2912 unsigned long fevent = NoEventMask;
2913 XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
2914 attributes.event_mask |= fevent;
2915 attribute_mask = CWEventMask;
2916 XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2917 attribute_mask, &attributes);
2918 }
2919 }
2920 #endif /* HAVE_X_I18N */
2921
2922 validate_x_resource_name ();
2923
2924 class_hints.res_name = (char *) SDATA (Vx_resource_name);
2925 class_hints.res_class = (char *) SDATA (Vx_resource_class);
2926 XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
2927
2928 /* The menubar is part of the ordinary display;
2929 it does not count in addition to the height of the window. */
2930 f->output_data.x->menubar_height = 0;
2931
2932 /* This indicates that we use the "Passive Input" input model.
2933 Unless we do this, we don't get the Focus{In,Out} events that we
2934 need to draw the cursor correctly. Accursed bureaucrats.
2935 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
2936
2937 f->output_data.x->wm_hints.input = True;
2938 f->output_data.x->wm_hints.flags |= InputHint;
2939 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2940 &f->output_data.x->wm_hints);
2941 f->output_data.x->wm_hints.icon_pixmap = None;
2942
2943 /* Request "save yourself" and "delete window" commands from wm. */
2944 {
2945 Atom protocols[2];
2946 protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2947 protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2948 XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
2949 }
2950
2951 /* x_set_name normally ignores requests to set the name if the
2952 requested name is the same as the current name. This is the one
2953 place where that assumption isn't correct; f->name is set, but
2954 the X server hasn't been told. */
2955 {
2956 Lisp_Object name;
2957 int explicit = f->explicit_name;
2958
2959 f->explicit_name = 0;
2960 name = f->name;
2961 f->name = Qnil;
2962 x_set_name (f, name, explicit);
2963 }
2964
2965 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2966 f->output_data.x->text_cursor);
2967
2968 UNBLOCK_INPUT;
2969
2970 if (FRAME_X_WINDOW (f) == 0)
2971 error ("Unable to create window");
2972 }
2973
2974 #endif /* not USE_GTK */
2975 #endif /* not USE_X_TOOLKIT */
2976
2977 /* Handle the icon stuff for this window. Perhaps later we might
2978 want an x_set_icon_position which can be called interactively as
2979 well. */
2980
2981 static void
2982 x_icon (f, parms)
2983 struct frame *f;
2984 Lisp_Object parms;
2985 {
2986 Lisp_Object icon_x, icon_y;
2987 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2988
2989 /* Set the position of the icon. Note that twm groups all
2990 icons in an icon window. */
2991 icon_x = x_frame_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
2992 icon_y = x_frame_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
2993 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
2994 {
2995 CHECK_NUMBER (icon_x);
2996 CHECK_NUMBER (icon_y);
2997 }
2998 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
2999 error ("Both left and top icon corners of icon must be specified");
3000
3001 BLOCK_INPUT;
3002
3003 if (! EQ (icon_x, Qunbound))
3004 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
3005
3006 /* Start up iconic or window? */
3007 x_wm_set_window_state
3008 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL),
3009 Qicon)
3010 ? IconicState
3011 : NormalState));
3012
3013 x_text_icon (f, (char *) SDATA ((!NILP (f->icon_name)
3014 ? f->icon_name
3015 : f->name)));
3016
3017 UNBLOCK_INPUT;
3018 }
3019
3020 /* Make the GCs needed for this window, setting the
3021 background, border and mouse colors; also create the
3022 mouse cursor and the gray border tile. */
3023
3024 static char cursor_bits[] =
3025 {
3026 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3027 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3028 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3029 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3030 };
3031
3032 static void
3033 x_make_gc (f)
3034 struct frame *f;
3035 {
3036 XGCValues gc_values;
3037
3038 BLOCK_INPUT;
3039
3040 /* Create the GCs of this frame.
3041 Note that many default values are used. */
3042
3043 /* Normal video */
3044 gc_values.font = FRAME_FONT (f)->fid;
3045 gc_values.foreground = f->output_data.x->foreground_pixel;
3046 gc_values.background = f->output_data.x->background_pixel;
3047 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
3048 f->output_data.x->normal_gc
3049 = XCreateGC (FRAME_X_DISPLAY (f),
3050 FRAME_X_WINDOW (f),
3051 GCLineWidth | GCFont | GCForeground | GCBackground,
3052 &gc_values);
3053
3054 /* Reverse video style. */
3055 gc_values.foreground = f->output_data.x->background_pixel;
3056 gc_values.background = f->output_data.x->foreground_pixel;
3057 f->output_data.x->reverse_gc
3058 = XCreateGC (FRAME_X_DISPLAY (f),
3059 FRAME_X_WINDOW (f),
3060 GCFont | GCForeground | GCBackground | GCLineWidth,
3061 &gc_values);
3062
3063 /* Cursor has cursor-color background, background-color foreground. */
3064 gc_values.foreground = f->output_data.x->background_pixel;
3065 gc_values.background = f->output_data.x->cursor_pixel;
3066 gc_values.fill_style = FillOpaqueStippled;
3067 gc_values.stipple
3068 = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
3069 FRAME_X_DISPLAY_INFO (f)->root_window,
3070 cursor_bits, 16, 16);
3071 f->output_data.x->cursor_gc
3072 = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3073 (GCFont | GCForeground | GCBackground
3074 | GCFillStyle /* | GCStipple */ | GCLineWidth),
3075 &gc_values);
3076
3077 /* Reliefs. */
3078 f->output_data.x->white_relief.gc = 0;
3079 f->output_data.x->black_relief.gc = 0;
3080
3081 /* Create the gray border tile used when the pointer is not in
3082 the frame. Since this depends on the frame's pixel values,
3083 this must be done on a per-frame basis. */
3084 f->output_data.x->border_tile
3085 = (XCreatePixmapFromBitmapData
3086 (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
3087 gray_bits, gray_width, gray_height,
3088 f->output_data.x->foreground_pixel,
3089 f->output_data.x->background_pixel,
3090 DefaultDepth (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f))));
3091
3092 UNBLOCK_INPUT;
3093 }
3094
3095
3096 /* Free what was was allocated in x_make_gc. */
3097
3098 void
3099 x_free_gcs (f)
3100 struct frame *f;
3101 {
3102 Display *dpy = FRAME_X_DISPLAY (f);
3103
3104 BLOCK_INPUT;
3105
3106 if (f->output_data.x->normal_gc)
3107 {
3108 XFreeGC (dpy, f->output_data.x->normal_gc);
3109 f->output_data.x->normal_gc = 0;
3110 }
3111
3112 if (f->output_data.x->reverse_gc)
3113 {
3114 XFreeGC (dpy, f->output_data.x->reverse_gc);
3115 f->output_data.x->reverse_gc = 0;
3116 }
3117
3118 if (f->output_data.x->cursor_gc)
3119 {
3120 XFreeGC (dpy, f->output_data.x->cursor_gc);
3121 f->output_data.x->cursor_gc = 0;
3122 }
3123
3124 if (f->output_data.x->border_tile)
3125 {
3126 XFreePixmap (dpy, f->output_data.x->border_tile);
3127 f->output_data.x->border_tile = 0;
3128 }
3129
3130 UNBLOCK_INPUT;
3131 }
3132
3133
3134 /* Handler for signals raised during x_create_frame and
3135 x_create_top_frame. FRAME is the frame which is partially
3136 constructed. */
3137
3138 static Lisp_Object
3139 unwind_create_frame (frame)
3140 Lisp_Object frame;
3141 {
3142 struct frame *f = XFRAME (frame);
3143
3144 /* If frame is ``official'', nothing to do. */
3145 if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
3146 {
3147 #if GLYPH_DEBUG
3148 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3149 #endif
3150
3151 x_free_frame_resources (f);
3152
3153 /* Check that reference counts are indeed correct. */
3154 xassert (dpyinfo->reference_count == dpyinfo_refcount);
3155 xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
3156 return Qt;
3157 }
3158
3159 return Qnil;
3160 }
3161
3162
3163 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
3164 1, 1, 0,
3165 doc: /* Make a new X window, which is called a "frame" in Emacs terms.
3166 Returns an Emacs frame object.
3167 ALIST is an alist of frame parameters.
3168 If the parameters specify that the frame should not have a minibuffer,
3169 and do not specify a specific minibuffer window to use,
3170 then `default-minibuffer-frame' must be a frame whose minibuffer can
3171 be shared by the new frame.
3172
3173 This function is an internal primitive--use `make-frame' instead. */)
3174 (parms)
3175 Lisp_Object parms;
3176 {
3177 struct frame *f;
3178 Lisp_Object frame, tem;
3179 Lisp_Object name;
3180 int minibuffer_only = 0;
3181 long window_prompting = 0;
3182 int width, height;
3183 int count = SPECPDL_INDEX ();
3184 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3185 Lisp_Object display;
3186 struct x_display_info *dpyinfo = NULL;
3187 Lisp_Object parent;
3188 struct kboard *kb;
3189
3190 check_x ();
3191
3192 /* Use this general default value to start with
3193 until we know if this frame has a specified name. */
3194 Vx_resource_name = Vinvocation_name;
3195
3196 display = x_get_arg (dpyinfo, parms, Qdisplay, 0, 0, RES_TYPE_STRING);
3197 if (EQ (display, Qunbound))
3198 display = Qnil;
3199 dpyinfo = check_x_display_info (display);
3200 #ifdef MULTI_KBOARD
3201 kb = dpyinfo->kboard;
3202 #else
3203 kb = &the_only_kboard;
3204 #endif
3205
3206 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
3207 if (!STRINGP (name)
3208 && ! EQ (name, Qunbound)
3209 && ! NILP (name))
3210 error ("Invalid frame name--not a string or nil");
3211
3212 if (STRINGP (name))
3213 Vx_resource_name = name;
3214
3215 /* See if parent window is specified. */
3216 parent = x_get_arg (dpyinfo, parms, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
3217 if (EQ (parent, Qunbound))
3218 parent = Qnil;
3219 if (! NILP (parent))
3220 CHECK_NUMBER (parent);
3221
3222 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3223 /* No need to protect DISPLAY because that's not used after passing
3224 it to make_frame_without_minibuffer. */
3225 frame = Qnil;
3226 GCPRO4 (parms, parent, name, frame);
3227 tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
3228 RES_TYPE_SYMBOL);
3229 if (EQ (tem, Qnone) || NILP (tem))
3230 f = make_frame_without_minibuffer (Qnil, kb, display);
3231 else if (EQ (tem, Qonly))
3232 {
3233 f = make_minibuffer_frame ();
3234 minibuffer_only = 1;
3235 }
3236 else if (WINDOWP (tem))
3237 f = make_frame_without_minibuffer (tem, kb, display);
3238 else
3239 f = make_frame (1);
3240
3241 XSETFRAME (frame, f);
3242
3243 /* Note that X Windows does support scroll bars. */
3244 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
3245
3246 f->output_method = output_x_window;
3247 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
3248 bzero (f->output_data.x, sizeof (struct x_output));
3249 f->output_data.x->icon_bitmap = -1;
3250 FRAME_FONTSET (f) = -1;
3251 f->output_data.x->scroll_bar_foreground_pixel = -1;
3252 f->output_data.x->scroll_bar_background_pixel = -1;
3253 #ifdef USE_TOOLKIT_SCROLL_BARS
3254 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
3255 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
3256 #endif /* USE_TOOLKIT_SCROLL_BARS */
3257 record_unwind_protect (unwind_create_frame, frame);
3258
3259 f->icon_name
3260 = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
3261 RES_TYPE_STRING);
3262 if (! STRINGP (f->icon_name))
3263 f->icon_name = Qnil;
3264
3265 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
3266 #if GLYPH_DEBUG
3267 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
3268 dpyinfo_refcount = dpyinfo->reference_count;
3269 #endif /* GLYPH_DEBUG */
3270 #ifdef MULTI_KBOARD
3271 FRAME_KBOARD (f) = kb;
3272 #endif
3273
3274 /* These colors will be set anyway later, but it's important
3275 to get the color reference counts right, so initialize them! */
3276 {
3277 Lisp_Object black;
3278 struct gcpro gcpro1;
3279
3280 /* Function x_decode_color can signal an error. Make
3281 sure to initialize color slots so that we won't try
3282 to free colors we haven't allocated. */
3283 f->output_data.x->foreground_pixel = -1;
3284 f->output_data.x->background_pixel = -1;
3285 f->output_data.x->cursor_pixel = -1;
3286 f->output_data.x->cursor_foreground_pixel = -1;
3287 f->output_data.x->border_pixel = -1;
3288 f->output_data.x->mouse_pixel = -1;
3289
3290 black = build_string ("black");
3291 GCPRO1 (black);
3292 f->output_data.x->foreground_pixel
3293 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3294 f->output_data.x->background_pixel
3295 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3296 f->output_data.x->cursor_pixel
3297 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3298 f->output_data.x->cursor_foreground_pixel
3299 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3300 f->output_data.x->border_pixel
3301 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3302 f->output_data.x->mouse_pixel
3303 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3304 UNGCPRO;
3305 }
3306
3307 /* Specify the parent under which to make this X window. */
3308
3309 if (!NILP (parent))
3310 {
3311 f->output_data.x->parent_desc = (Window) XFASTINT (parent);
3312 f->output_data.x->explicit_parent = 1;
3313 }
3314 else
3315 {
3316 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3317 f->output_data.x->explicit_parent = 0;
3318 }
3319
3320 /* Set the name; the functions to which we pass f expect the name to
3321 be set. */
3322 if (EQ (name, Qunbound) || NILP (name))
3323 {
3324 f->name = build_string (dpyinfo->x_id_name);
3325 f->explicit_name = 0;
3326 }
3327 else
3328 {
3329 f->name = name;
3330 f->explicit_name = 1;
3331 /* use the frame's title when getting resources for this frame. */
3332 specbind (Qx_resource_name, name);
3333 }
3334
3335 /* Extract the window parameters from the supplied values
3336 that are needed to determine window geometry. */
3337 {
3338 Lisp_Object font;
3339
3340 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
3341
3342 BLOCK_INPUT;
3343 /* First, try whatever font the caller has specified. */
3344 if (STRINGP (font))
3345 {
3346 tem = Fquery_fontset (font, Qnil);
3347 if (STRINGP (tem))
3348 font = x_new_fontset (f, SDATA (tem));
3349 else
3350 font = x_new_font (f, SDATA (font));
3351 }
3352
3353 /* Try out a font which we hope has bold and italic variations. */
3354 if (!STRINGP (font))
3355 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
3356 if (!STRINGP (font))
3357 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3358 if (! STRINGP (font))
3359 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3360 if (! STRINGP (font))
3361 /* This was formerly the first thing tried, but it finds too many fonts
3362 and takes too long. */
3363 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3364 /* If those didn't work, look for something which will at least work. */
3365 if (! STRINGP (font))
3366 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3367 UNBLOCK_INPUT;
3368 if (! STRINGP (font))
3369 font = build_string ("fixed");
3370
3371 x_default_parameter (f, parms, Qfont, font,
3372 "font", "Font", RES_TYPE_STRING);
3373 }
3374
3375 #ifdef USE_LUCID
3376 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3377 whereby it fails to get any font. */
3378 xlwmenu_default_font = FRAME_FONT (f);
3379 #endif
3380
3381 x_default_parameter (f, parms, Qborder_width, make_number (2),
3382 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
3383
3384 /* This defaults to 1 in order to match xterm. We recognize either
3385 internalBorderWidth or internalBorder (which is what xterm calls
3386 it). */
3387 if (NILP (Fassq (Qinternal_border_width, parms)))
3388 {
3389 Lisp_Object value;
3390
3391 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
3392 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
3393 if (! EQ (value, Qunbound))
3394 parms = Fcons (Fcons (Qinternal_border_width, value),
3395 parms);
3396 }
3397 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
3398 "internalBorderWidth", "internalBorderWidth",
3399 RES_TYPE_NUMBER);
3400 x_default_parameter (f, parms, Qvertical_scroll_bars, Qleft,
3401 "verticalScrollBars", "ScrollBars",
3402 RES_TYPE_SYMBOL);
3403
3404 /* Also do the stuff which must be set before the window exists. */
3405 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
3406 "foreground", "Foreground", RES_TYPE_STRING);
3407 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
3408 "background", "Background", RES_TYPE_STRING);
3409 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
3410 "pointerColor", "Foreground", RES_TYPE_STRING);
3411 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
3412 "cursorColor", "Foreground", RES_TYPE_STRING);
3413 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
3414 "borderColor", "BorderColor", RES_TYPE_STRING);
3415 x_default_parameter (f, parms, Qscreen_gamma, Qnil,
3416 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
3417 x_default_parameter (f, parms, Qline_spacing, Qnil,
3418 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
3419 x_default_parameter (f, parms, Qleft_fringe, Qnil,
3420 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
3421 x_default_parameter (f, parms, Qright_fringe, Qnil,
3422 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
3423
3424 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_foreground,
3425 "scrollBarForeground",
3426 "ScrollBarForeground", 1);
3427 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_background,
3428 "scrollBarBackground",
3429 "ScrollBarBackground", 0);
3430
3431 /* Init faces before x_default_parameter is called for scroll-bar
3432 parameters because that function calls x_set_scroll_bar_width,
3433 which calls change_frame_size, which calls Fset_window_buffer,
3434 which runs hooks, which call Fvertical_motion. At the end, we
3435 end up in init_iterator with a null face cache, which should not
3436 happen. */
3437 init_frame_faces (f);
3438
3439 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
3440 "menuBar", "MenuBar", RES_TYPE_NUMBER);
3441 x_default_parameter (f, parms, Qtool_bar_lines, make_number (1),
3442 "toolBar", "ToolBar", RES_TYPE_NUMBER);
3443 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
3444 "bufferPredicate", "BufferPredicate",
3445 RES_TYPE_SYMBOL);
3446 x_default_parameter (f, parms, Qtitle, Qnil,
3447 "title", "Title", RES_TYPE_STRING);
3448 x_default_parameter (f, parms, Qwait_for_wm, Qt,
3449 "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN);
3450 x_default_parameter (f, parms, Qfullscreen, Qnil,
3451 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
3452
3453 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3454
3455 /* Compute the size of the X window. */
3456 window_prompting = x_figure_window_size (f, parms, 1);
3457
3458 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
3459 f->no_split = minibuffer_only || EQ (tem, Qt);
3460
3461 /* Create the X widget or window. */
3462 #ifdef USE_X_TOOLKIT
3463 x_window (f, window_prompting, minibuffer_only);
3464 #else
3465 x_window (f);
3466 #endif
3467
3468 x_icon (f, parms);
3469 x_make_gc (f);
3470
3471 /* Now consider the frame official. */
3472 FRAME_X_DISPLAY_INFO (f)->reference_count++;
3473 Vframe_list = Fcons (frame, Vframe_list);
3474
3475 /* We need to do this after creating the X window, so that the
3476 icon-creation functions can say whose icon they're describing. */
3477 x_default_parameter (f, parms, Qicon_type, Qnil,
3478 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
3479
3480 x_default_parameter (f, parms, Qauto_raise, Qnil,
3481 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
3482 x_default_parameter (f, parms, Qauto_lower, Qnil,
3483 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
3484 x_default_parameter (f, parms, Qcursor_type, Qbox,
3485 "cursorType", "CursorType", RES_TYPE_SYMBOL);
3486 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
3487 "scrollBarWidth", "ScrollBarWidth",
3488 RES_TYPE_NUMBER);
3489
3490 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
3491 Change will not be effected unless different from the current
3492 FRAME_LINES (f). */
3493 width = FRAME_COLS (f);
3494 height = FRAME_LINES (f);
3495
3496 SET_FRAME_COLS (f, 0);
3497 FRAME_LINES (f) = 0;
3498 change_frame_size (f, height, width, 1, 0, 0);
3499
3500 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
3501 /* Create the menu bar. */
3502 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
3503 {
3504 /* If this signals an error, we haven't set size hints for the
3505 frame and we didn't make it visible. */
3506 initialize_frame_menubar (f);
3507
3508 #ifndef USE_GTK
3509 /* This is a no-op, except under Motif where it arranges the
3510 main window for the widgets on it. */
3511 lw_set_main_areas (f->output_data.x->column_widget,
3512 f->output_data.x->menubar_widget,
3513 f->output_data.x->edit_widget);
3514 #endif /* not USE_GTK */
3515 }
3516 #endif /* USE_X_TOOLKIT || USE_GTK */
3517
3518 /* Tell the server what size and position, etc, we want, and how
3519 badly we want them. This should be done after we have the menu
3520 bar so that its size can be taken into account. */
3521 BLOCK_INPUT;
3522 x_wm_set_size_hint (f, window_prompting, 0);
3523 UNBLOCK_INPUT;
3524
3525 /* Make the window appear on the frame and enable display, unless
3526 the caller says not to. However, with explicit parent, Emacs
3527 cannot control visibility, so don't try. */
3528 if (! f->output_data.x->explicit_parent)
3529 {
3530 Lisp_Object visibility;
3531
3532 visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
3533 RES_TYPE_SYMBOL);
3534 if (EQ (visibility, Qunbound))
3535 visibility = Qt;
3536
3537 if (EQ (visibility, Qicon))
3538 x_iconify_frame (f);
3539 else if (! NILP (visibility))
3540 x_make_frame_visible (f);
3541 else
3542 /* Must have been Qnil. */
3543 ;
3544 }
3545
3546 /* Set the WM leader property. GTK does this itself, so this is not
3547 needed when using GTK. */
3548 if (dpyinfo->client_leader_window != 0)
3549 {
3550 BLOCK_INPUT;
3551 XChangeProperty (FRAME_X_DISPLAY (f),
3552 FRAME_OUTER_WINDOW (f),
3553 dpyinfo->Xatom_wm_client_leader,
3554 XA_WINDOW, 32, PropModeReplace,
3555 (char *) &dpyinfo->client_leader_window, 1);
3556 UNBLOCK_INPUT;
3557 }
3558
3559 UNGCPRO;
3560
3561 /* Make sure windows on this frame appear in calls to next-window
3562 and similar functions. */
3563 Vwindow_list = Qnil;
3564
3565 return unbind_to (count, frame);
3566 }
3567
3568
3569 /* FRAME is used only to get a handle on the X display. We don't pass the
3570 display info directly because we're called from frame.c, which doesn't
3571 know about that structure. */
3572
3573 Lisp_Object
3574 x_get_focus_frame (frame)
3575 struct frame *frame;
3576 {
3577 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
3578 Lisp_Object xfocus;
3579 if (! dpyinfo->x_focus_frame)
3580 return Qnil;
3581
3582 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
3583 return xfocus;
3584 }
3585
3586
3587 /* In certain situations, when the window manager follows a
3588 click-to-focus policy, there seems to be no way around calling
3589 XSetInputFocus to give another frame the input focus .
3590
3591 In an ideal world, XSetInputFocus should generally be avoided so
3592 that applications don't interfere with the window manager's focus
3593 policy. But I think it's okay to use when it's clearly done
3594 following a user-command. */
3595
3596 DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
3597 doc: /* Set the input focus to FRAME.
3598 FRAME nil means use the selected frame. */)
3599 (frame)
3600 Lisp_Object frame;
3601 {
3602 struct frame *f = check_x_frame (frame);
3603 Display *dpy = FRAME_X_DISPLAY (f);
3604 int count;
3605
3606 BLOCK_INPUT;
3607 count = x_catch_errors (dpy);
3608 XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3609 RevertToParent, CurrentTime);
3610 x_uncatch_errors (dpy, count);
3611 UNBLOCK_INPUT;
3612
3613 return Qnil;
3614 }
3615
3616 \f
3617 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
3618 doc: /* Internal function called by `color-defined-p', which see. */)
3619 (color, frame)
3620 Lisp_Object color, frame;
3621 {
3622 XColor foo;
3623 FRAME_PTR f = check_x_frame (frame);
3624
3625 CHECK_STRING (color);
3626
3627 if (x_defined_color (f, SDATA (color), &foo, 0))
3628 return Qt;
3629 else
3630 return Qnil;
3631 }
3632
3633 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
3634 doc: /* Internal function called by `color-values', which see. */)
3635 (color, frame)
3636 Lisp_Object color, frame;
3637 {
3638 XColor foo;
3639 FRAME_PTR f = check_x_frame (frame);
3640
3641 CHECK_STRING (color);
3642
3643 if (x_defined_color (f, SDATA (color), &foo, 0))
3644 {
3645 Lisp_Object rgb[3];
3646
3647 rgb[0] = make_number (foo.red);
3648 rgb[1] = make_number (foo.green);
3649 rgb[2] = make_number (foo.blue);
3650 return Flist (3, rgb);
3651 }
3652 else
3653 return Qnil;
3654 }
3655
3656 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
3657 doc: /* Internal function called by `display-color-p', which see. */)
3658 (display)
3659 Lisp_Object display;
3660 {
3661 struct x_display_info *dpyinfo = check_x_display_info (display);
3662
3663 if (dpyinfo->n_planes <= 2)
3664 return Qnil;
3665
3666 switch (dpyinfo->visual->class)
3667 {
3668 case StaticColor:
3669 case PseudoColor:
3670 case TrueColor:
3671 case DirectColor:
3672 return Qt;
3673
3674 default:
3675 return Qnil;
3676 }
3677 }
3678
3679 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
3680 0, 1, 0,
3681 doc: /* Return t if the X display supports shades of gray.
3682 Note that color displays do support shades of gray.
3683 The optional argument DISPLAY specifies which display to ask about.
3684 DISPLAY should be either a frame or a display name (a string).
3685 If omitted or nil, that stands for the selected frame's display. */)
3686 (display)
3687 Lisp_Object display;
3688 {
3689 struct x_display_info *dpyinfo = check_x_display_info (display);
3690
3691 if (dpyinfo->n_planes <= 1)
3692 return Qnil;
3693
3694 switch (dpyinfo->visual->class)
3695 {
3696 case StaticColor:
3697 case PseudoColor:
3698 case TrueColor:
3699 case DirectColor:
3700 case StaticGray:
3701 case GrayScale:
3702 return Qt;
3703
3704 default:
3705 return Qnil;
3706 }
3707 }
3708
3709 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
3710 0, 1, 0,
3711 doc: /* Returns the width in pixels of the X display DISPLAY.
3712 The optional argument DISPLAY specifies which display to ask about.
3713 DISPLAY should be either a frame or a display name (a string).
3714 If omitted or nil, that stands for the selected frame's display. */)
3715 (display)
3716 Lisp_Object display;
3717 {
3718 struct x_display_info *dpyinfo = check_x_display_info (display);
3719
3720 return make_number (dpyinfo->width);
3721 }
3722
3723 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
3724 Sx_display_pixel_height, 0, 1, 0,
3725 doc: /* Returns the height in pixels of the X display DISPLAY.
3726 The optional argument DISPLAY specifies which display to ask about.
3727 DISPLAY should be either a frame or a display name (a string).
3728 If omitted or nil, that stands for the selected frame's display. */)
3729 (display)
3730 Lisp_Object display;
3731 {
3732 struct x_display_info *dpyinfo = check_x_display_info (display);
3733
3734 return make_number (dpyinfo->height);
3735 }
3736
3737 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
3738 0, 1, 0,
3739 doc: /* Returns the number of bitplanes of the X display DISPLAY.
3740 The optional argument DISPLAY specifies which display to ask about.
3741 DISPLAY should be either a frame or a display name (a string).
3742 If omitted or nil, that stands for the selected frame's display. */)
3743 (display)
3744 Lisp_Object display;
3745 {
3746 struct x_display_info *dpyinfo = check_x_display_info (display);
3747
3748 return make_number (dpyinfo->n_planes);
3749 }
3750
3751 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
3752 0, 1, 0,
3753 doc: /* Returns the number of color cells of the X display DISPLAY.
3754 The optional argument DISPLAY specifies which display to ask about.
3755 DISPLAY should be either a frame or a display name (a string).
3756 If omitted or nil, that stands for the selected frame's display. */)
3757 (display)
3758 Lisp_Object display;
3759 {
3760 struct x_display_info *dpyinfo = check_x_display_info (display);
3761
3762 return make_number (DisplayCells (dpyinfo->display,
3763 XScreenNumberOfScreen (dpyinfo->screen)));
3764 }
3765
3766 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
3767 Sx_server_max_request_size,
3768 0, 1, 0,
3769 doc: /* Returns the maximum request size of the X server of display DISPLAY.
3770 The optional argument DISPLAY specifies which display to ask about.
3771 DISPLAY should be either a frame or a display name (a string).
3772 If omitted or nil, that stands for the selected frame's display. */)
3773 (display)
3774 Lisp_Object display;
3775 {
3776 struct x_display_info *dpyinfo = check_x_display_info (display);
3777
3778 return make_number (MAXREQUEST (dpyinfo->display));
3779 }
3780
3781 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
3782 doc: /* Returns the vendor ID string of the X server of display DISPLAY.
3783 The optional argument DISPLAY specifies which display to ask about.
3784 DISPLAY should be either a frame or a display name (a string).
3785 If omitted or nil, that stands for the selected frame's display. */)
3786 (display)
3787 Lisp_Object display;
3788 {
3789 struct x_display_info *dpyinfo = check_x_display_info (display);
3790 char *vendor = ServerVendor (dpyinfo->display);
3791
3792 if (! vendor) vendor = "";
3793 return build_string (vendor);
3794 }
3795
3796 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
3797 doc: /* Returns the version numbers of the X server of display DISPLAY.
3798 The value is a list of three integers: the major and minor
3799 version numbers of the X Protocol in use, and the vendor-specific release
3800 number. See also the function `x-server-vendor'.
3801
3802 The optional argument DISPLAY specifies which display to ask about.
3803 DISPLAY should be either a frame or a display name (a string).
3804 If omitted or nil, that stands for the selected frame's display. */)
3805 (display)
3806 Lisp_Object display;
3807 {
3808 struct x_display_info *dpyinfo = check_x_display_info (display);
3809 Display *dpy = dpyinfo->display;
3810
3811 return Fcons (make_number (ProtocolVersion (dpy)),
3812 Fcons (make_number (ProtocolRevision (dpy)),
3813 Fcons (make_number (VendorRelease (dpy)), Qnil)));
3814 }
3815
3816 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
3817 doc: /* Return the number of screens on the X server of display DISPLAY.
3818 The optional argument DISPLAY specifies which display to ask about.
3819 DISPLAY should be either a frame or a display name (a string).
3820 If omitted or nil, that stands for the selected frame's display. */)
3821 (display)
3822 Lisp_Object display;
3823 {
3824 struct x_display_info *dpyinfo = check_x_display_info (display);
3825
3826 return make_number (ScreenCount (dpyinfo->display));
3827 }
3828
3829 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
3830 doc: /* Return the height in millimeters of the X display DISPLAY.
3831 The optional argument DISPLAY specifies which display to ask about.
3832 DISPLAY should be either a frame or a display name (a string).
3833 If omitted or nil, that stands for the selected frame's display. */)
3834 (display)
3835 Lisp_Object display;
3836 {
3837 struct x_display_info *dpyinfo = check_x_display_info (display);
3838
3839 return make_number (HeightMMOfScreen (dpyinfo->screen));
3840 }
3841
3842 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
3843 doc: /* Return the width in millimeters of the X display DISPLAY.
3844 The optional argument DISPLAY specifies which display to ask about.
3845 DISPLAY should be either a frame or a display name (a string).
3846 If omitted or nil, that stands for the selected frame's display. */)
3847 (display)
3848 Lisp_Object display;
3849 {
3850 struct x_display_info *dpyinfo = check_x_display_info (display);
3851
3852 return make_number (WidthMMOfScreen (dpyinfo->screen));
3853 }
3854
3855 DEFUN ("x-display-backing-store", Fx_display_backing_store,
3856 Sx_display_backing_store, 0, 1, 0,
3857 doc: /* Returns an indication of whether X display DISPLAY does backing store.
3858 The value may be `always', `when-mapped', or `not-useful'.
3859 The optional argument DISPLAY specifies which display to ask about.
3860 DISPLAY should be either a frame or a display name (a string).
3861 If omitted or nil, that stands for the selected frame's display. */)
3862 (display)
3863 Lisp_Object display;
3864 {
3865 struct x_display_info *dpyinfo = check_x_display_info (display);
3866 Lisp_Object result;
3867
3868 switch (DoesBackingStore (dpyinfo->screen))
3869 {
3870 case Always:
3871 result = intern ("always");
3872 break;
3873
3874 case WhenMapped:
3875 result = intern ("when-mapped");
3876 break;
3877
3878 case NotUseful:
3879 result = intern ("not-useful");
3880 break;
3881
3882 default:
3883 error ("Strange value for BackingStore parameter of screen");
3884 result = Qnil;
3885 }
3886
3887 return result;
3888 }
3889
3890 DEFUN ("x-display-visual-class", Fx_display_visual_class,
3891 Sx_display_visual_class, 0, 1, 0,
3892 doc: /* Return the visual class of the X display DISPLAY.
3893 The value is one of the symbols `static-gray', `gray-scale',
3894 `static-color', `pseudo-color', `true-color', or `direct-color'.
3895
3896 The optional argument DISPLAY specifies which display to ask about.
3897 DISPLAY should be either a frame or a display name (a string).
3898 If omitted or nil, that stands for the selected frame's display. */)
3899 (display)
3900 Lisp_Object display;
3901 {
3902 struct x_display_info *dpyinfo = check_x_display_info (display);
3903 Lisp_Object result;
3904
3905 switch (dpyinfo->visual->class)
3906 {
3907 case StaticGray:
3908 result = intern ("static-gray");
3909 break;
3910 case GrayScale:
3911 result = intern ("gray-scale");
3912 break;
3913 case StaticColor:
3914 result = intern ("static-color");
3915 break;
3916 case PseudoColor:
3917 result = intern ("pseudo-color");
3918 break;
3919 case TrueColor:
3920 result = intern ("true-color");
3921 break;
3922 case DirectColor:
3923 result = intern ("direct-color");
3924 break;
3925 default:
3926 error ("Display has an unknown visual class");
3927 result = Qnil;
3928 }
3929
3930 return result;
3931 }
3932
3933 DEFUN ("x-display-save-under", Fx_display_save_under,
3934 Sx_display_save_under, 0, 1, 0,
3935 doc: /* Returns t if the X display DISPLAY supports the save-under feature.
3936 The optional argument DISPLAY specifies which display to ask about.
3937 DISPLAY should be either a frame or a display name (a string).
3938 If omitted or nil, that stands for the selected frame's display. */)
3939 (display)
3940 Lisp_Object display;
3941 {
3942 struct x_display_info *dpyinfo = check_x_display_info (display);
3943
3944 if (DoesSaveUnders (dpyinfo->screen) == True)
3945 return Qt;
3946 else
3947 return Qnil;
3948 }
3949 \f
3950 int
3951 x_pixel_width (f)
3952 register struct frame *f;
3953 {
3954 return FRAME_PIXEL_WIDTH (f);
3955 }
3956
3957 int
3958 x_pixel_height (f)
3959 register struct frame *f;
3960 {
3961 return FRAME_PIXEL_HEIGHT (f);
3962 }
3963
3964 int
3965 x_char_width (f)
3966 register struct frame *f;
3967 {
3968 return FRAME_COLUMN_WIDTH (f);
3969 }
3970
3971 int
3972 x_char_height (f)
3973 register struct frame *f;
3974 {
3975 return FRAME_LINE_HEIGHT (f);
3976 }
3977
3978 int
3979 x_screen_planes (f)
3980 register struct frame *f;
3981 {
3982 return FRAME_X_DISPLAY_INFO (f)->n_planes;
3983 }
3984
3985
3986 \f
3987 /************************************************************************
3988 X Displays
3989 ************************************************************************/
3990
3991 \f
3992 /* Mapping visual names to visuals. */
3993
3994 static struct visual_class
3995 {
3996 char *name;
3997 int class;
3998 }
3999 visual_classes[] =
4000 {
4001 {"StaticGray", StaticGray},
4002 {"GrayScale", GrayScale},
4003 {"StaticColor", StaticColor},
4004 {"PseudoColor", PseudoColor},
4005 {"TrueColor", TrueColor},
4006 {"DirectColor", DirectColor},
4007 {NULL, 0}
4008 };
4009
4010
4011 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4012
4013 /* Value is the screen number of screen SCR. This is a substitute for
4014 the X function with the same name when that doesn't exist. */
4015
4016 int
4017 XScreenNumberOfScreen (scr)
4018 register Screen *scr;
4019 {
4020 Display *dpy = scr->display;
4021 int i;
4022
4023 for (i = 0; i < dpy->nscreens; ++i)
4024 if (scr == dpy->screens + i)
4025 break;
4026
4027 return i;
4028 }
4029
4030 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4031
4032
4033 /* Select the visual that should be used on display DPYINFO. Set
4034 members of DPYINFO appropriately. Called from x_term_init. */
4035
4036 void
4037 select_visual (dpyinfo)
4038 struct x_display_info *dpyinfo;
4039 {
4040 Display *dpy = dpyinfo->display;
4041 Screen *screen = dpyinfo->screen;
4042 Lisp_Object value;
4043
4044 /* See if a visual is specified. */
4045 value = display_x_get_resource (dpyinfo,
4046 build_string ("visualClass"),
4047 build_string ("VisualClass"),
4048 Qnil, Qnil);
4049 if (STRINGP (value))
4050 {
4051 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4052 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4053 depth, a decimal number. NAME is compared with case ignored. */
4054 char *s = (char *) alloca (SBYTES (value) + 1);
4055 char *dash;
4056 int i, class = -1;
4057 XVisualInfo vinfo;
4058
4059 strcpy (s, SDATA (value));
4060 dash = index (s, '-');
4061 if (dash)
4062 {
4063 dpyinfo->n_planes = atoi (dash + 1);
4064 *dash = '\0';
4065 }
4066 else
4067 /* We won't find a matching visual with depth 0, so that
4068 an error will be printed below. */
4069 dpyinfo->n_planes = 0;
4070
4071 /* Determine the visual class. */
4072 for (i = 0; visual_classes[i].name; ++i)
4073 if (xstricmp (s, visual_classes[i].name) == 0)
4074 {
4075 class = visual_classes[i].class;
4076 break;
4077 }
4078
4079 /* Look up a matching visual for the specified class. */
4080 if (class == -1
4081 || !XMatchVisualInfo (dpy, XScreenNumberOfScreen (screen),
4082 dpyinfo->n_planes, class, &vinfo))
4083 fatal ("Invalid visual specification `%s'", SDATA (value));
4084
4085 dpyinfo->visual = vinfo.visual;
4086 }
4087 else
4088 {
4089 int n_visuals;
4090 XVisualInfo *vinfo, vinfo_template;
4091
4092 dpyinfo->visual = DefaultVisualOfScreen (screen);
4093
4094 #ifdef HAVE_X11R4
4095 vinfo_template.visualid = XVisualIDFromVisual (dpyinfo->visual);
4096 #else
4097 vinfo_template.visualid = dpyinfo->visual->visualid;
4098 #endif
4099 vinfo_template.screen = XScreenNumberOfScreen (screen);
4100 vinfo = XGetVisualInfo (dpy, VisualIDMask | VisualScreenMask,
4101 &vinfo_template, &n_visuals);
4102 if (n_visuals != 1)
4103 fatal ("Can't get proper X visual info");
4104
4105 dpyinfo->n_planes = vinfo->depth;
4106 XFree ((char *) vinfo);
4107 }
4108 }
4109
4110
4111 /* Return the X display structure for the display named NAME.
4112 Open a new connection if necessary. */
4113
4114 struct x_display_info *
4115 x_display_info_for_name (name)
4116 Lisp_Object name;
4117 {
4118 Lisp_Object names;
4119 struct x_display_info *dpyinfo;
4120
4121 CHECK_STRING (name);
4122
4123 if (! EQ (Vwindow_system, intern ("x")))
4124 error ("Not using X Windows");
4125
4126 for (dpyinfo = x_display_list, names = x_display_name_list;
4127 dpyinfo;
4128 dpyinfo = dpyinfo->next, names = XCDR (names))
4129 {
4130 Lisp_Object tem;
4131 tem = Fstring_equal (XCAR (XCAR (names)), name);
4132 if (!NILP (tem))
4133 return dpyinfo;
4134 }
4135
4136 /* Use this general default value to start with. */
4137 Vx_resource_name = Vinvocation_name;
4138
4139 validate_x_resource_name ();
4140
4141 dpyinfo = x_term_init (name, (char *)0,
4142 (char *) SDATA (Vx_resource_name));
4143
4144 if (dpyinfo == 0)
4145 error ("Cannot connect to X server %s", SDATA (name));
4146
4147 x_in_use = 1;
4148 XSETFASTINT (Vwindow_system_version, 11);
4149
4150 return dpyinfo;
4151 }
4152
4153
4154 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4155 1, 3, 0,
4156 doc: /* Open a connection to an X server.
4157 DISPLAY is the name of the display to connect to.
4158 Optional second arg XRM-STRING is a string of resources in xrdb format.
4159 If the optional third arg MUST-SUCCEED is non-nil,
4160 terminate Emacs if we can't open the connection. */)
4161 (display, xrm_string, must_succeed)
4162 Lisp_Object display, xrm_string, must_succeed;
4163 {
4164 unsigned char *xrm_option;
4165 struct x_display_info *dpyinfo;
4166
4167 CHECK_STRING (display);
4168 if (! NILP (xrm_string))
4169 CHECK_STRING (xrm_string);
4170
4171 if (! EQ (Vwindow_system, intern ("x")))
4172 error ("Not using X Windows");
4173
4174 if (! NILP (xrm_string))
4175 xrm_option = (unsigned char *) SDATA (xrm_string);
4176 else
4177 xrm_option = (unsigned char *) 0;
4178
4179 validate_x_resource_name ();
4180
4181 /* This is what opens the connection and sets x_current_display.
4182 This also initializes many symbols, such as those used for input. */
4183 dpyinfo = x_term_init (display, xrm_option,
4184 (char *) SDATA (Vx_resource_name));
4185
4186 if (dpyinfo == 0)
4187 {
4188 if (!NILP (must_succeed))
4189 fatal ("Cannot connect to X server %s.\n\
4190 Check the DISPLAY environment variable or use `-d'.\n\
4191 Also use the `xauth' program to verify that you have the proper\n\
4192 authorization information needed to connect the X server.\n\
4193 An insecure way to solve the problem may be to use `xhost'.\n",
4194 SDATA (display));
4195 else
4196 error ("Cannot connect to X server %s", SDATA (display));
4197 }
4198
4199 x_in_use = 1;
4200
4201 XSETFASTINT (Vwindow_system_version, 11);
4202 return Qnil;
4203 }
4204
4205 DEFUN ("x-close-connection", Fx_close_connection,
4206 Sx_close_connection, 1, 1, 0,
4207 doc: /* Close the connection to DISPLAY's X server.
4208 For DISPLAY, specify either a frame or a display name (a string).
4209 If DISPLAY is nil, that stands for the selected frame's display. */)
4210 (display)
4211 Lisp_Object display;
4212 {
4213 struct x_display_info *dpyinfo = check_x_display_info (display);
4214 int i;
4215
4216 if (dpyinfo->reference_count > 0)
4217 error ("Display still has frames on it");
4218
4219 BLOCK_INPUT;
4220 /* Free the fonts in the font table. */
4221 for (i = 0; i < dpyinfo->n_fonts; i++)
4222 if (dpyinfo->font_table[i].name)
4223 {
4224 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
4225 }
4226
4227 x_destroy_all_bitmaps (dpyinfo);
4228 XSetCloseDownMode (dpyinfo->display, DestroyAll);
4229
4230 #ifdef USE_X_TOOLKIT
4231 XtCloseDisplay (dpyinfo->display);
4232 #else
4233 XCloseDisplay (dpyinfo->display);
4234 #endif
4235
4236 x_delete_display (dpyinfo);
4237 UNBLOCK_INPUT;
4238
4239 return Qnil;
4240 }
4241
4242 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
4243 doc: /* Return the list of display names that Emacs has connections to. */)
4244 ()
4245 {
4246 Lisp_Object tail, result;
4247
4248 result = Qnil;
4249 for (tail = x_display_name_list; ! NILP (tail); tail = XCDR (tail))
4250 result = Fcons (XCAR (XCAR (tail)), result);
4251
4252 return result;
4253 }
4254
4255 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
4256 doc: /* If ON is non-nil, report X errors as soon as the erring request is made.
4257 If ON is nil, allow buffering of requests.
4258 Turning on synchronization prohibits the Xlib routines from buffering
4259 requests and seriously degrades performance, but makes debugging much
4260 easier.
4261 The optional second argument DISPLAY specifies which display to act on.
4262 DISPLAY should be either a frame or a display name (a string).
4263 If DISPLAY is omitted or nil, that stands for the selected frame's display. */)
4264 (on, display)
4265 Lisp_Object display, on;
4266 {
4267 struct x_display_info *dpyinfo = check_x_display_info (display);
4268
4269 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
4270
4271 return Qnil;
4272 }
4273
4274 /* Wait for responses to all X commands issued so far for frame F. */
4275
4276 void
4277 x_sync (f)
4278 FRAME_PTR f;
4279 {
4280 BLOCK_INPUT;
4281 XSync (FRAME_X_DISPLAY (f), False);
4282 UNBLOCK_INPUT;
4283 }
4284
4285 \f
4286 /***********************************************************************
4287 Image types
4288 ***********************************************************************/
4289
4290 /* Value is the number of elements of vector VECTOR. */
4291
4292 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
4293
4294 /* List of supported image types. Use define_image_type to add new
4295 types. Use lookup_image_type to find a type for a given symbol. */
4296
4297 static struct image_type *image_types;
4298
4299 /* The symbol `xbm' which is used as the type symbol for XBM images. */
4300
4301 Lisp_Object Qxbm;
4302
4303 /* Keywords. */
4304
4305 extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
4306 extern Lisp_Object QCdata, QCtype;
4307 Lisp_Object QCascent, QCmargin, QCrelief;
4308 Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask;
4309 Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask;
4310
4311 /* Other symbols. */
4312
4313 Lisp_Object Qlaplace, Qemboss, Qedge_detection, Qheuristic;
4314
4315 /* Time in seconds after which images should be removed from the cache
4316 if not displayed. */
4317
4318 Lisp_Object Vimage_cache_eviction_delay;
4319
4320 /* Function prototypes. */
4321
4322 static void define_image_type P_ ((struct image_type *type));
4323 static struct image_type *lookup_image_type P_ ((Lisp_Object symbol));
4324 static void image_error P_ ((char *format, Lisp_Object, Lisp_Object));
4325 static void x_laplace P_ ((struct frame *, struct image *));
4326 static void x_emboss P_ ((struct frame *, struct image *));
4327 static int x_build_heuristic_mask P_ ((struct frame *, struct image *,
4328 Lisp_Object));
4329
4330
4331 /* Define a new image type from TYPE. This adds a copy of TYPE to
4332 image_types and adds the symbol *TYPE->type to Vimage_types. */
4333
4334 static void
4335 define_image_type (type)
4336 struct image_type *type;
4337 {
4338 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
4339 The initialized data segment is read-only. */
4340 struct image_type *p = (struct image_type *) xmalloc (sizeof *p);
4341 bcopy (type, p, sizeof *p);
4342 p->next = image_types;
4343 image_types = p;
4344 Vimage_types = Fcons (*p->type, Vimage_types);
4345 }
4346
4347
4348 /* Look up image type SYMBOL, and return a pointer to its image_type
4349 structure. Value is null if SYMBOL is not a known image type. */
4350
4351 static INLINE struct image_type *
4352 lookup_image_type (symbol)
4353 Lisp_Object symbol;
4354 {
4355 struct image_type *type;
4356
4357 for (type = image_types; type; type = type->next)
4358 if (EQ (symbol, *type->type))
4359 break;
4360
4361 return type;
4362 }
4363
4364
4365 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
4366 valid image specification is a list whose car is the symbol
4367 `image', and whose rest is a property list. The property list must
4368 contain a value for key `:type'. That value must be the name of a
4369 supported image type. The rest of the property list depends on the
4370 image type. */
4371
4372 int
4373 valid_image_p (object)
4374 Lisp_Object object;
4375 {
4376 int valid_p = 0;
4377
4378 if (IMAGEP (object))
4379 {
4380 Lisp_Object tem;
4381
4382 for (tem = XCDR (object); CONSP (tem); tem = XCDR (tem))
4383 if (EQ (XCAR (tem), QCtype))
4384 {
4385 tem = XCDR (tem);
4386 if (CONSP (tem) && SYMBOLP (XCAR (tem)))
4387 {
4388 struct image_type *type;
4389 type = lookup_image_type (XCAR (tem));
4390 if (type)
4391 valid_p = type->valid_p (object);
4392 }
4393
4394 break;
4395 }
4396 }
4397
4398 return valid_p;
4399 }
4400
4401
4402 /* Log error message with format string FORMAT and argument ARG.
4403 Signaling an error, e.g. when an image cannot be loaded, is not a
4404 good idea because this would interrupt redisplay, and the error
4405 message display would lead to another redisplay. This function
4406 therefore simply displays a message. */
4407
4408 static void
4409 image_error (format, arg1, arg2)
4410 char *format;
4411 Lisp_Object arg1, arg2;
4412 {
4413 add_to_log (format, arg1, arg2);
4414 }
4415
4416
4417 \f
4418 /***********************************************************************
4419 Image specifications
4420 ***********************************************************************/
4421
4422 enum image_value_type
4423 {
4424 IMAGE_DONT_CHECK_VALUE_TYPE,
4425 IMAGE_STRING_VALUE,
4426 IMAGE_STRING_OR_NIL_VALUE,
4427 IMAGE_SYMBOL_VALUE,
4428 IMAGE_POSITIVE_INTEGER_VALUE,
4429 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR,
4430 IMAGE_NON_NEGATIVE_INTEGER_VALUE,
4431 IMAGE_ASCENT_VALUE,
4432 IMAGE_INTEGER_VALUE,
4433 IMAGE_FUNCTION_VALUE,
4434 IMAGE_NUMBER_VALUE,
4435 IMAGE_BOOL_VALUE
4436 };
4437
4438 /* Structure used when parsing image specifications. */
4439
4440 struct image_keyword
4441 {
4442 /* Name of keyword. */
4443 char *name;
4444
4445 /* The type of value allowed. */
4446 enum image_value_type type;
4447
4448 /* Non-zero means key must be present. */
4449 int mandatory_p;
4450
4451 /* Used to recognize duplicate keywords in a property list. */
4452 int count;
4453
4454 /* The value that was found. */
4455 Lisp_Object value;
4456 };
4457
4458
4459 static int parse_image_spec P_ ((Lisp_Object, struct image_keyword *,
4460 int, Lisp_Object));
4461 static Lisp_Object image_spec_value P_ ((Lisp_Object, Lisp_Object, int *));
4462
4463
4464 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
4465 has the format (image KEYWORD VALUE ...). One of the keyword/
4466 value pairs must be `:type TYPE'. KEYWORDS is a vector of
4467 image_keywords structures of size NKEYWORDS describing other
4468 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
4469
4470 static int
4471 parse_image_spec (spec, keywords, nkeywords, type)
4472 Lisp_Object spec;
4473 struct image_keyword *keywords;
4474 int nkeywords;
4475 Lisp_Object type;
4476 {
4477 int i;
4478 Lisp_Object plist;
4479
4480 if (!IMAGEP (spec))
4481 return 0;
4482
4483 plist = XCDR (spec);
4484 while (CONSP (plist))
4485 {
4486 Lisp_Object key, value;
4487
4488 /* First element of a pair must be a symbol. */
4489 key = XCAR (plist);
4490 plist = XCDR (plist);
4491 if (!SYMBOLP (key))
4492 return 0;
4493
4494 /* There must follow a value. */
4495 if (!CONSP (plist))
4496 return 0;
4497 value = XCAR (plist);
4498 plist = XCDR (plist);
4499
4500 /* Find key in KEYWORDS. Error if not found. */
4501 for (i = 0; i < nkeywords; ++i)
4502 if (strcmp (keywords[i].name, SDATA (SYMBOL_NAME (key))) == 0)
4503 break;
4504
4505 if (i == nkeywords)
4506 continue;
4507
4508 /* Record that we recognized the keyword. If a keywords
4509 was found more than once, it's an error. */
4510 keywords[i].value = value;
4511 ++keywords[i].count;
4512
4513 if (keywords[i].count > 1)
4514 return 0;
4515
4516 /* Check type of value against allowed type. */
4517 switch (keywords[i].type)
4518 {
4519 case IMAGE_STRING_VALUE:
4520 if (!STRINGP (value))
4521 return 0;
4522 break;
4523
4524 case IMAGE_STRING_OR_NIL_VALUE:
4525 if (!STRINGP (value) && !NILP (value))
4526 return 0;
4527 break;
4528
4529 case IMAGE_SYMBOL_VALUE:
4530 if (!SYMBOLP (value))
4531 return 0;
4532 break;
4533
4534 case IMAGE_POSITIVE_INTEGER_VALUE:
4535 if (!INTEGERP (value) || XINT (value) <= 0)
4536 return 0;
4537 break;
4538
4539 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR:
4540 if (INTEGERP (value) && XINT (value) >= 0)
4541 break;
4542 if (CONSP (value)
4543 && INTEGERP (XCAR (value)) && INTEGERP (XCDR (value))
4544 && XINT (XCAR (value)) >= 0 && XINT (XCDR (value)) >= 0)
4545 break;
4546 return 0;
4547
4548 case IMAGE_ASCENT_VALUE:
4549 if (SYMBOLP (value) && EQ (value, Qcenter))
4550 break;
4551 else if (INTEGERP (value)
4552 && XINT (value) >= 0
4553 && XINT (value) <= 100)
4554 break;
4555 return 0;
4556
4557 case IMAGE_NON_NEGATIVE_INTEGER_VALUE:
4558 if (!INTEGERP (value) || XINT (value) < 0)
4559 return 0;
4560 break;
4561
4562 case IMAGE_DONT_CHECK_VALUE_TYPE:
4563 break;
4564
4565 case IMAGE_FUNCTION_VALUE:
4566 value = indirect_function (value);
4567 if (SUBRP (value)
4568 || COMPILEDP (value)
4569 || (CONSP (value) && EQ (XCAR (value), Qlambda)))
4570 break;
4571 return 0;
4572
4573 case IMAGE_NUMBER_VALUE:
4574 if (!INTEGERP (value) && !FLOATP (value))
4575 return 0;
4576 break;
4577
4578 case IMAGE_INTEGER_VALUE:
4579 if (!INTEGERP (value))
4580 return 0;
4581 break;
4582
4583 case IMAGE_BOOL_VALUE:
4584 if (!NILP (value) && !EQ (value, Qt))
4585 return 0;
4586 break;
4587
4588 default:
4589 abort ();
4590 break;
4591 }
4592
4593 if (EQ (key, QCtype) && !EQ (type, value))
4594 return 0;
4595 }
4596
4597 /* Check that all mandatory fields are present. */
4598 for (i = 0; i < nkeywords; ++i)
4599 if (keywords[i].mandatory_p && keywords[i].count == 0)
4600 return 0;
4601
4602 return NILP (plist);
4603 }
4604
4605
4606 /* Return the value of KEY in image specification SPEC. Value is nil
4607 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
4608 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
4609
4610 static Lisp_Object
4611 image_spec_value (spec, key, found)
4612 Lisp_Object spec, key;
4613 int *found;
4614 {
4615 Lisp_Object tail;
4616
4617 xassert (valid_image_p (spec));
4618
4619 for (tail = XCDR (spec);
4620 CONSP (tail) && CONSP (XCDR (tail));
4621 tail = XCDR (XCDR (tail)))
4622 {
4623 if (EQ (XCAR (tail), key))
4624 {
4625 if (found)
4626 *found = 1;
4627 return XCAR (XCDR (tail));
4628 }
4629 }
4630
4631 if (found)
4632 *found = 0;
4633 return Qnil;
4634 }
4635
4636
4637 DEFUN ("image-size", Fimage_size, Simage_size, 1, 3, 0,
4638 doc: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
4639 PIXELS non-nil means return the size in pixels, otherwise return the
4640 size in canonical character units.
4641 FRAME is the frame on which the image will be displayed. FRAME nil
4642 or omitted means use the selected frame. */)
4643 (spec, pixels, frame)
4644 Lisp_Object spec, pixels, frame;
4645 {
4646 Lisp_Object size;
4647
4648 size = Qnil;
4649 if (valid_image_p (spec))
4650 {
4651 struct frame *f = check_x_frame (frame);
4652 int id = lookup_image (f, spec);
4653 struct image *img = IMAGE_FROM_ID (f, id);
4654 int width = img->width + 2 * img->hmargin;
4655 int height = img->height + 2 * img->vmargin;
4656
4657 if (NILP (pixels))
4658 size = Fcons (make_float ((double) width / FRAME_COLUMN_WIDTH (f)),
4659 make_float ((double) height / FRAME_LINE_HEIGHT (f)));
4660 else
4661 size = Fcons (make_number (width), make_number (height));
4662 }
4663 else
4664 error ("Invalid image specification");
4665
4666 return size;
4667 }
4668
4669
4670 DEFUN ("image-mask-p", Fimage_mask_p, Simage_mask_p, 1, 2, 0,
4671 doc: /* Return t if image SPEC has a mask bitmap.
4672 FRAME is the frame on which the image will be displayed. FRAME nil
4673 or omitted means use the selected frame. */)
4674 (spec, frame)
4675 Lisp_Object spec, frame;
4676 {
4677 Lisp_Object mask;
4678
4679 mask = Qnil;
4680 if (valid_image_p (spec))
4681 {
4682 struct frame *f = check_x_frame (frame);
4683 int id = lookup_image (f, spec);
4684 struct image *img = IMAGE_FROM_ID (f, id);
4685 if (img->mask)
4686 mask = Qt;
4687 }
4688 else
4689 error ("Invalid image specification");
4690
4691 return mask;
4692 }
4693
4694
4695 \f
4696 /***********************************************************************
4697 Image type independent image structures
4698 ***********************************************************************/
4699
4700 static struct image *make_image P_ ((Lisp_Object spec, unsigned hash));
4701 static void free_image P_ ((struct frame *f, struct image *img));
4702
4703
4704 /* Allocate and return a new image structure for image specification
4705 SPEC. SPEC has a hash value of HASH. */
4706
4707 static struct image *
4708 make_image (spec, hash)
4709 Lisp_Object spec;
4710 unsigned hash;
4711 {
4712 struct image *img = (struct image *) xmalloc (sizeof *img);
4713
4714 xassert (valid_image_p (spec));
4715 bzero (img, sizeof *img);
4716 img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
4717 xassert (img->type != NULL);
4718 img->spec = spec;
4719 img->data.lisp_val = Qnil;
4720 img->ascent = DEFAULT_IMAGE_ASCENT;
4721 img->hash = hash;
4722 return img;
4723 }
4724
4725
4726 /* Free image IMG which was used on frame F, including its resources. */
4727
4728 static void
4729 free_image (f, img)
4730 struct frame *f;
4731 struct image *img;
4732 {
4733 if (img)
4734 {
4735 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
4736
4737 /* Remove IMG from the hash table of its cache. */
4738 if (img->prev)
4739 img->prev->next = img->next;
4740 else
4741 c->buckets[img->hash % IMAGE_CACHE_BUCKETS_SIZE] = img->next;
4742
4743 if (img->next)
4744 img->next->prev = img->prev;
4745
4746 c->images[img->id] = NULL;
4747
4748 /* Free resources, then free IMG. */
4749 img->type->free (f, img);
4750 xfree (img);
4751 }
4752 }
4753
4754
4755 /* Prepare image IMG for display on frame F. Must be called before
4756 drawing an image. */
4757
4758 void
4759 prepare_image_for_display (f, img)
4760 struct frame *f;
4761 struct image *img;
4762 {
4763 EMACS_TIME t;
4764
4765 /* We're about to display IMG, so set its timestamp to `now'. */
4766 EMACS_GET_TIME (t);
4767 img->timestamp = EMACS_SECS (t);
4768
4769 /* If IMG doesn't have a pixmap yet, load it now, using the image
4770 type dependent loader function. */
4771 if (img->pixmap == None && !img->load_failed_p)
4772 img->load_failed_p = img->type->load (f, img) == 0;
4773 }
4774
4775
4776 /* Value is the number of pixels for the ascent of image IMG when
4777 drawn in face FACE. */
4778
4779 int
4780 image_ascent (img, face)
4781 struct image *img;
4782 struct face *face;
4783 {
4784 int height = img->height + img->vmargin;
4785 int ascent;
4786
4787 if (img->ascent == CENTERED_IMAGE_ASCENT)
4788 {
4789 if (face->font)
4790 /* This expression is arranged so that if the image can't be
4791 exactly centered, it will be moved slightly up. This is
4792 because a typical font is `top-heavy' (due to the presence
4793 uppercase letters), so the image placement should err towards
4794 being top-heavy too. It also just generally looks better. */
4795 ascent = (height + face->font->ascent - face->font->descent + 1) / 2;
4796 else
4797 ascent = height / 2;
4798 }
4799 else
4800 ascent = height * img->ascent / 100.0;
4801
4802 return ascent;
4803 }
4804
4805 \f
4806 /* Image background colors. */
4807
4808 static unsigned long
4809 four_corners_best (ximg, width, height)
4810 XImage *ximg;
4811 unsigned long width, height;
4812 {
4813 unsigned long corners[4], best;
4814 int i, best_count;
4815
4816 /* Get the colors at the corners of ximg. */
4817 corners[0] = XGetPixel (ximg, 0, 0);
4818 corners[1] = XGetPixel (ximg, width - 1, 0);
4819 corners[2] = XGetPixel (ximg, width - 1, height - 1);
4820 corners[3] = XGetPixel (ximg, 0, height - 1);
4821
4822 /* Choose the most frequently found color as background. */
4823 for (i = best_count = 0; i < 4; ++i)
4824 {
4825 int j, n;
4826
4827 for (j = n = 0; j < 4; ++j)
4828 if (corners[i] == corners[j])
4829 ++n;
4830
4831 if (n > best_count)
4832 best = corners[i], best_count = n;
4833 }
4834
4835 return best;
4836 }
4837
4838 /* Return the `background' field of IMG. If IMG doesn't have one yet,
4839 it is guessed heuristically. If non-zero, XIMG is an existing XImage
4840 object to use for the heuristic. */
4841
4842 unsigned long
4843 image_background (img, f, ximg)
4844 struct image *img;
4845 struct frame *f;
4846 XImage *ximg;
4847 {
4848 if (! img->background_valid)
4849 /* IMG doesn't have a background yet, try to guess a reasonable value. */
4850 {
4851 int free_ximg = !ximg;
4852
4853 if (! ximg)
4854 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
4855 0, 0, img->width, img->height, ~0, ZPixmap);
4856
4857 img->background = four_corners_best (ximg, img->width, img->height);
4858
4859 if (free_ximg)
4860 XDestroyImage (ximg);
4861
4862 img->background_valid = 1;
4863 }
4864
4865 return img->background;
4866 }
4867
4868 /* Return the `background_transparent' field of IMG. If IMG doesn't
4869 have one yet, it is guessed heuristically. If non-zero, MASK is an
4870 existing XImage object to use for the heuristic. */
4871
4872 int
4873 image_background_transparent (img, f, mask)
4874 struct image *img;
4875 struct frame *f;
4876 XImage *mask;
4877 {
4878 if (! img->background_transparent_valid)
4879 /* IMG doesn't have a background yet, try to guess a reasonable value. */
4880 {
4881 if (img->mask)
4882 {
4883 int free_mask = !mask;
4884
4885 if (! mask)
4886 mask = XGetImage (FRAME_X_DISPLAY (f), img->mask,
4887 0, 0, img->width, img->height, ~0, ZPixmap);
4888
4889 img->background_transparent
4890 = !four_corners_best (mask, img->width, img->height);
4891
4892 if (free_mask)
4893 XDestroyImage (mask);
4894 }
4895 else
4896 img->background_transparent = 0;
4897
4898 img->background_transparent_valid = 1;
4899 }
4900
4901 return img->background_transparent;
4902 }
4903
4904 \f
4905 /***********************************************************************
4906 Helper functions for X image types
4907 ***********************************************************************/
4908
4909 static void x_clear_image_1 P_ ((struct frame *, struct image *, int,
4910 int, int));
4911 static void x_clear_image P_ ((struct frame *f, struct image *img));
4912 static unsigned long x_alloc_image_color P_ ((struct frame *f,
4913 struct image *img,
4914 Lisp_Object color_name,
4915 unsigned long dflt));
4916
4917
4918 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
4919 free the pixmap if any. MASK_P non-zero means clear the mask
4920 pixmap if any. COLORS_P non-zero means free colors allocated for
4921 the image, if any. */
4922
4923 static void
4924 x_clear_image_1 (f, img, pixmap_p, mask_p, colors_p)
4925 struct frame *f;
4926 struct image *img;
4927 int pixmap_p, mask_p, colors_p;
4928 {
4929 if (pixmap_p && img->pixmap)
4930 {
4931 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
4932 img->pixmap = None;
4933 img->background_valid = 0;
4934 }
4935
4936 if (mask_p && img->mask)
4937 {
4938 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
4939 img->mask = None;
4940 img->background_transparent_valid = 0;
4941 }
4942
4943 if (colors_p && img->ncolors)
4944 {
4945 x_free_colors (f, img->colors, img->ncolors);
4946 xfree (img->colors);
4947 img->colors = NULL;
4948 img->ncolors = 0;
4949 }
4950 }
4951
4952 /* Free X resources of image IMG which is used on frame F. */
4953
4954 static void
4955 x_clear_image (f, img)
4956 struct frame *f;
4957 struct image *img;
4958 {
4959 BLOCK_INPUT;
4960 x_clear_image_1 (f, img, 1, 1, 1);
4961 UNBLOCK_INPUT;
4962 }
4963
4964
4965 /* Allocate color COLOR_NAME for image IMG on frame F. If color
4966 cannot be allocated, use DFLT. Add a newly allocated color to
4967 IMG->colors, so that it can be freed again. Value is the pixel
4968 color. */
4969
4970 static unsigned long
4971 x_alloc_image_color (f, img, color_name, dflt)
4972 struct frame *f;
4973 struct image *img;
4974 Lisp_Object color_name;
4975 unsigned long dflt;
4976 {
4977 XColor color;
4978 unsigned long result;
4979
4980 xassert (STRINGP (color_name));
4981
4982 if (x_defined_color (f, SDATA (color_name), &color, 1))
4983 {
4984 /* This isn't called frequently so we get away with simply
4985 reallocating the color vector to the needed size, here. */
4986 ++img->ncolors;
4987 img->colors =
4988 (unsigned long *) xrealloc (img->colors,
4989 img->ncolors * sizeof *img->colors);
4990 img->colors[img->ncolors - 1] = color.pixel;
4991 result = color.pixel;
4992 }
4993 else
4994 result = dflt;
4995
4996 return result;
4997 }
4998
4999
5000 \f
5001 /***********************************************************************
5002 Image Cache
5003 ***********************************************************************/
5004
5005 static void cache_image P_ ((struct frame *f, struct image *img));
5006 static void postprocess_image P_ ((struct frame *, struct image *));
5007
5008
5009 /* Return a new, initialized image cache that is allocated from the
5010 heap. Call free_image_cache to free an image cache. */
5011
5012 struct image_cache *
5013 make_image_cache ()
5014 {
5015 struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
5016 int size;
5017
5018 bzero (c, sizeof *c);
5019 c->size = 50;
5020 c->images = (struct image **) xmalloc (c->size * sizeof *c->images);
5021 size = IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
5022 c->buckets = (struct image **) xmalloc (size);
5023 bzero (c->buckets, size);
5024 return c;
5025 }
5026
5027
5028 /* Free image cache of frame F. Be aware that X frames share images
5029 caches. */
5030
5031 void
5032 free_image_cache (f)
5033 struct frame *f;
5034 {
5035 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5036 if (c)
5037 {
5038 int i;
5039
5040 /* Cache should not be referenced by any frame when freed. */
5041 xassert (c->refcount == 0);
5042
5043 for (i = 0; i < c->used; ++i)
5044 free_image (f, c->images[i]);
5045 xfree (c->images);
5046 xfree (c->buckets);
5047 xfree (c);
5048 FRAME_X_IMAGE_CACHE (f) = NULL;
5049 }
5050 }
5051
5052
5053 /* Clear image cache of frame F. FORCE_P non-zero means free all
5054 images. FORCE_P zero means clear only images that haven't been
5055 displayed for some time. Should be called from time to time to
5056 reduce the number of loaded images. If image-eviction-seconds is
5057 non-nil, this frees images in the cache which weren't displayed for
5058 at least that many seconds. */
5059
5060 void
5061 clear_image_cache (f, force_p)
5062 struct frame *f;
5063 int force_p;
5064 {
5065 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5066
5067 if (c && INTEGERP (Vimage_cache_eviction_delay))
5068 {
5069 EMACS_TIME t;
5070 unsigned long old;
5071 int i, nfreed;
5072
5073 EMACS_GET_TIME (t);
5074 old = EMACS_SECS (t) - XFASTINT (Vimage_cache_eviction_delay);
5075
5076 /* Block input so that we won't be interrupted by a SIGIO
5077 while being in an inconsistent state. */
5078 BLOCK_INPUT;
5079
5080 for (i = nfreed = 0; i < c->used; ++i)
5081 {
5082 struct image *img = c->images[i];
5083 if (img != NULL
5084 && (force_p || img->timestamp < old))
5085 {
5086 free_image (f, img);
5087 ++nfreed;
5088 }
5089 }
5090
5091 /* We may be clearing the image cache because, for example,
5092 Emacs was iconified for a longer period of time. In that
5093 case, current matrices may still contain references to
5094 images freed above. So, clear these matrices. */
5095 if (nfreed)
5096 {
5097 Lisp_Object tail, frame;
5098
5099 FOR_EACH_FRAME (tail, frame)
5100 {
5101 struct frame *f = XFRAME (frame);
5102 if (FRAME_X_P (f)
5103 && FRAME_X_IMAGE_CACHE (f) == c)
5104 clear_current_matrices (f);
5105 }
5106
5107 ++windows_or_buffers_changed;
5108 }
5109
5110 UNBLOCK_INPUT;
5111 }
5112 }
5113
5114
5115 DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache,
5116 0, 1, 0,
5117 doc: /* Clear the image cache of FRAME.
5118 FRAME nil or omitted means use the selected frame.
5119 FRAME t means clear the image caches of all frames. */)
5120 (frame)
5121 Lisp_Object frame;
5122 {
5123 if (EQ (frame, Qt))
5124 {
5125 Lisp_Object tail;
5126
5127 FOR_EACH_FRAME (tail, frame)
5128 if (FRAME_X_P (XFRAME (frame)))
5129 clear_image_cache (XFRAME (frame), 1);
5130 }
5131 else
5132 clear_image_cache (check_x_frame (frame), 1);
5133
5134 return Qnil;
5135 }
5136
5137
5138 /* Compute masks and transform image IMG on frame F, as specified
5139 by the image's specification, */
5140
5141 static void
5142 postprocess_image (f, img)
5143 struct frame *f;
5144 struct image *img;
5145 {
5146 /* Manipulation of the image's mask. */
5147 if (img->pixmap)
5148 {
5149 Lisp_Object conversion, spec;
5150 Lisp_Object mask;
5151
5152 spec = img->spec;
5153
5154 /* `:heuristic-mask t'
5155 `:mask heuristic'
5156 means build a mask heuristically.
5157 `:heuristic-mask (R G B)'
5158 `:mask (heuristic (R G B))'
5159 means build a mask from color (R G B) in the
5160 image.
5161 `:mask nil'
5162 means remove a mask, if any. */
5163
5164 mask = image_spec_value (spec, QCheuristic_mask, NULL);
5165 if (!NILP (mask))
5166 x_build_heuristic_mask (f, img, mask);
5167 else
5168 {
5169 int found_p;
5170
5171 mask = image_spec_value (spec, QCmask, &found_p);
5172
5173 if (EQ (mask, Qheuristic))
5174 x_build_heuristic_mask (f, img, Qt);
5175 else if (CONSP (mask)
5176 && EQ (XCAR (mask), Qheuristic))
5177 {
5178 if (CONSP (XCDR (mask)))
5179 x_build_heuristic_mask (f, img, XCAR (XCDR (mask)));
5180 else
5181 x_build_heuristic_mask (f, img, XCDR (mask));
5182 }
5183 else if (NILP (mask) && found_p && img->mask)
5184 {
5185 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
5186 img->mask = None;
5187 }
5188 }
5189
5190
5191 /* Should we apply an image transformation algorithm? */
5192 conversion = image_spec_value (spec, QCconversion, NULL);
5193 if (EQ (conversion, Qdisabled))
5194 x_disable_image (f, img);
5195 else if (EQ (conversion, Qlaplace))
5196 x_laplace (f, img);
5197 else if (EQ (conversion, Qemboss))
5198 x_emboss (f, img);
5199 else if (CONSP (conversion)
5200 && EQ (XCAR (conversion), Qedge_detection))
5201 {
5202 Lisp_Object tem;
5203 tem = XCDR (conversion);
5204 if (CONSP (tem))
5205 x_edge_detection (f, img,
5206 Fplist_get (tem, QCmatrix),
5207 Fplist_get (tem, QCcolor_adjustment));
5208 }
5209 }
5210 }
5211
5212
5213 /* Return the id of image with Lisp specification SPEC on frame F.
5214 SPEC must be a valid Lisp image specification (see valid_image_p). */
5215
5216 int
5217 lookup_image (f, spec)
5218 struct frame *f;
5219 Lisp_Object spec;
5220 {
5221 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5222 struct image *img;
5223 int i;
5224 unsigned hash;
5225 struct gcpro gcpro1;
5226 EMACS_TIME now;
5227
5228 /* F must be a window-system frame, and SPEC must be a valid image
5229 specification. */
5230 xassert (FRAME_WINDOW_P (f));
5231 xassert (valid_image_p (spec));
5232
5233 GCPRO1 (spec);
5234
5235 /* Look up SPEC in the hash table of the image cache. */
5236 hash = sxhash (spec, 0);
5237 i = hash % IMAGE_CACHE_BUCKETS_SIZE;
5238
5239 for (img = c->buckets[i]; img; img = img->next)
5240 if (img->hash == hash && !NILP (Fequal (img->spec, spec)))
5241 break;
5242
5243 /* If not found, create a new image and cache it. */
5244 if (img == NULL)
5245 {
5246 extern Lisp_Object Qpostscript;
5247
5248 BLOCK_INPUT;
5249 img = make_image (spec, hash);
5250 cache_image (f, img);
5251 img->load_failed_p = img->type->load (f, img) == 0;
5252
5253 /* If we can't load the image, and we don't have a width and
5254 height, use some arbitrary width and height so that we can
5255 draw a rectangle for it. */
5256 if (img->load_failed_p)
5257 {
5258 Lisp_Object value;
5259
5260 value = image_spec_value (spec, QCwidth, NULL);
5261 img->width = (INTEGERP (value)
5262 ? XFASTINT (value) : DEFAULT_IMAGE_WIDTH);
5263 value = image_spec_value (spec, QCheight, NULL);
5264 img->height = (INTEGERP (value)
5265 ? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT);
5266 }
5267 else
5268 {
5269 /* Handle image type independent image attributes
5270 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF',
5271 `:background COLOR'. */
5272 Lisp_Object ascent, margin, relief, bg;
5273
5274 ascent = image_spec_value (spec, QCascent, NULL);
5275 if (INTEGERP (ascent))
5276 img->ascent = XFASTINT (ascent);
5277 else if (EQ (ascent, Qcenter))
5278 img->ascent = CENTERED_IMAGE_ASCENT;
5279
5280 margin = image_spec_value (spec, QCmargin, NULL);
5281 if (INTEGERP (margin) && XINT (margin) >= 0)
5282 img->vmargin = img->hmargin = XFASTINT (margin);
5283 else if (CONSP (margin) && INTEGERP (XCAR (margin))
5284 && INTEGERP (XCDR (margin)))
5285 {
5286 if (XINT (XCAR (margin)) > 0)
5287 img->hmargin = XFASTINT (XCAR (margin));
5288 if (XINT (XCDR (margin)) > 0)
5289 img->vmargin = XFASTINT (XCDR (margin));
5290 }
5291
5292 relief = image_spec_value (spec, QCrelief, NULL);
5293 if (INTEGERP (relief))
5294 {
5295 img->relief = XINT (relief);
5296 img->hmargin += abs (img->relief);
5297 img->vmargin += abs (img->relief);
5298 }
5299
5300 if (! img->background_valid)
5301 {
5302 bg = image_spec_value (img->spec, QCbackground, NULL);
5303 if (!NILP (bg))
5304 {
5305 img->background
5306 = x_alloc_image_color (f, img, bg,
5307 FRAME_BACKGROUND_PIXEL (f));
5308 img->background_valid = 1;
5309 }
5310 }
5311
5312 /* Do image transformations and compute masks, unless we
5313 don't have the image yet. */
5314 if (!EQ (*img->type->type, Qpostscript))
5315 postprocess_image (f, img);
5316 }
5317
5318 UNBLOCK_INPUT;
5319 xassert (!interrupt_input_blocked);
5320 }
5321
5322 /* We're using IMG, so set its timestamp to `now'. */
5323 EMACS_GET_TIME (now);
5324 img->timestamp = EMACS_SECS (now);
5325
5326 UNGCPRO;
5327
5328 /* Value is the image id. */
5329 return img->id;
5330 }
5331
5332
5333 /* Cache image IMG in the image cache of frame F. */
5334
5335 static void
5336 cache_image (f, img)
5337 struct frame *f;
5338 struct image *img;
5339 {
5340 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5341 int i;
5342
5343 /* Find a free slot in c->images. */
5344 for (i = 0; i < c->used; ++i)
5345 if (c->images[i] == NULL)
5346 break;
5347
5348 /* If no free slot found, maybe enlarge c->images. */
5349 if (i == c->used && c->used == c->size)
5350 {
5351 c->size *= 2;
5352 c->images = (struct image **) xrealloc (c->images,
5353 c->size * sizeof *c->images);
5354 }
5355
5356 /* Add IMG to c->images, and assign IMG an id. */
5357 c->images[i] = img;
5358 img->id = i;
5359 if (i == c->used)
5360 ++c->used;
5361
5362 /* Add IMG to the cache's hash table. */
5363 i = img->hash % IMAGE_CACHE_BUCKETS_SIZE;
5364 img->next = c->buckets[i];
5365 if (img->next)
5366 img->next->prev = img;
5367 img->prev = NULL;
5368 c->buckets[i] = img;
5369 }
5370
5371
5372 /* Call FN on every image in the image cache of frame F. Used to mark
5373 Lisp Objects in the image cache. */
5374
5375 void
5376 forall_images_in_image_cache (f, fn)
5377 struct frame *f;
5378 void (*fn) P_ ((struct image *img));
5379 {
5380 if (FRAME_LIVE_P (f) && FRAME_X_P (f))
5381 {
5382 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5383 if (c)
5384 {
5385 int i;
5386 for (i = 0; i < c->used; ++i)
5387 if (c->images[i])
5388 fn (c->images[i]);
5389 }
5390 }
5391 }
5392
5393
5394 \f
5395 /***********************************************************************
5396 X support code
5397 ***********************************************************************/
5398
5399 static int x_create_x_image_and_pixmap P_ ((struct frame *, int, int, int,
5400 XImage **, Pixmap *));
5401 static void x_destroy_x_image P_ ((XImage *));
5402 static void x_put_x_image P_ ((struct frame *, XImage *, Pixmap, int, int));
5403
5404
5405 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
5406 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
5407 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
5408 via xmalloc. Print error messages via image_error if an error
5409 occurs. Value is non-zero if successful. */
5410
5411 static int
5412 x_create_x_image_and_pixmap (f, width, height, depth, ximg, pixmap)
5413 struct frame *f;
5414 int width, height, depth;
5415 XImage **ximg;
5416 Pixmap *pixmap;
5417 {
5418 Display *display = FRAME_X_DISPLAY (f);
5419 Screen *screen = FRAME_X_SCREEN (f);
5420 Window window = FRAME_X_WINDOW (f);
5421
5422 xassert (interrupt_input_blocked);
5423
5424 if (depth <= 0)
5425 depth = DefaultDepthOfScreen (screen);
5426 *ximg = XCreateImage (display, DefaultVisualOfScreen (screen),
5427 depth, ZPixmap, 0, NULL, width, height,
5428 depth > 16 ? 32 : depth > 8 ? 16 : 8, 0);
5429 if (*ximg == NULL)
5430 {
5431 image_error ("Unable to allocate X image", Qnil, Qnil);
5432 return 0;
5433 }
5434
5435 /* Allocate image raster. */
5436 (*ximg)->data = (char *) xmalloc ((*ximg)->bytes_per_line * height);
5437
5438 /* Allocate a pixmap of the same size. */
5439 *pixmap = XCreatePixmap (display, window, width, height, depth);
5440 if (*pixmap == None)
5441 {
5442 x_destroy_x_image (*ximg);
5443 *ximg = NULL;
5444 image_error ("Unable to create X pixmap", Qnil, Qnil);
5445 return 0;
5446 }
5447
5448 return 1;
5449 }
5450
5451
5452 /* Destroy XImage XIMG. Free XIMG->data. */
5453
5454 static void
5455 x_destroy_x_image (ximg)
5456 XImage *ximg;
5457 {
5458 xassert (interrupt_input_blocked);
5459 if (ximg)
5460 {
5461 xfree (ximg->data);
5462 ximg->data = NULL;
5463 XDestroyImage (ximg);
5464 }
5465 }
5466
5467
5468 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
5469 are width and height of both the image and pixmap. */
5470
5471 static void
5472 x_put_x_image (f, ximg, pixmap, width, height)
5473 struct frame *f;
5474 XImage *ximg;
5475 Pixmap pixmap;
5476 int width, height;
5477 {
5478 GC gc;
5479
5480 xassert (interrupt_input_blocked);
5481 gc = XCreateGC (FRAME_X_DISPLAY (f), pixmap, 0, NULL);
5482 XPutImage (FRAME_X_DISPLAY (f), pixmap, gc, ximg, 0, 0, 0, 0, width, height);
5483 XFreeGC (FRAME_X_DISPLAY (f), gc);
5484 }
5485
5486
5487 \f
5488 /***********************************************************************
5489 File Handling
5490 ***********************************************************************/
5491
5492 static Lisp_Object x_find_image_file P_ ((Lisp_Object));
5493 static char *slurp_file P_ ((char *, int *));
5494
5495
5496 /* Find image file FILE. Look in data-directory, then
5497 x-bitmap-file-path. Value is the full name of the file found, or
5498 nil if not found. */
5499
5500 static Lisp_Object
5501 x_find_image_file (file)
5502 Lisp_Object file;
5503 {
5504 Lisp_Object file_found, search_path;
5505 struct gcpro gcpro1, gcpro2;
5506 int fd;
5507
5508 file_found = Qnil;
5509 search_path = Fcons (Vdata_directory, Vx_bitmap_file_path);
5510 GCPRO2 (file_found, search_path);
5511
5512 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
5513 fd = openp (search_path, file, Qnil, &file_found, Qnil);
5514
5515 if (fd == -1)
5516 file_found = Qnil;
5517 else
5518 close (fd);
5519
5520 UNGCPRO;
5521 return file_found;
5522 }
5523
5524
5525 /* Read FILE into memory. Value is a pointer to a buffer allocated
5526 with xmalloc holding FILE's contents. Value is null if an error
5527 occurred. *SIZE is set to the size of the file. */
5528
5529 static char *
5530 slurp_file (file, size)
5531 char *file;
5532 int *size;
5533 {
5534 FILE *fp = NULL;
5535 char *buf = NULL;
5536 struct stat st;
5537
5538 if (stat (file, &st) == 0
5539 && (fp = fopen (file, "r")) != NULL
5540 && (buf = (char *) xmalloc (st.st_size),
5541 fread (buf, 1, st.st_size, fp) == st.st_size))
5542 {
5543 *size = st.st_size;
5544 fclose (fp);
5545 }
5546 else
5547 {
5548 if (fp)
5549 fclose (fp);
5550 if (buf)
5551 {
5552 xfree (buf);
5553 buf = NULL;
5554 }
5555 }
5556
5557 return buf;
5558 }
5559
5560
5561 \f
5562 /***********************************************************************
5563 XBM images
5564 ***********************************************************************/
5565
5566 static int xbm_scan P_ ((char **, char *, char *, int *));
5567 static int xbm_load P_ ((struct frame *f, struct image *img));
5568 static int xbm_load_image P_ ((struct frame *f, struct image *img,
5569 char *, char *));
5570 static int xbm_image_p P_ ((Lisp_Object object));
5571 static int xbm_read_bitmap_data P_ ((char *, char *, int *, int *,
5572 unsigned char **));
5573 static int xbm_file_p P_ ((Lisp_Object));
5574
5575
5576 /* Indices of image specification fields in xbm_format, below. */
5577
5578 enum xbm_keyword_index
5579 {
5580 XBM_TYPE,
5581 XBM_FILE,
5582 XBM_WIDTH,
5583 XBM_HEIGHT,
5584 XBM_DATA,
5585 XBM_FOREGROUND,
5586 XBM_BACKGROUND,
5587 XBM_ASCENT,
5588 XBM_MARGIN,
5589 XBM_RELIEF,
5590 XBM_ALGORITHM,
5591 XBM_HEURISTIC_MASK,
5592 XBM_MASK,
5593 XBM_LAST
5594 };
5595
5596 /* Vector of image_keyword structures describing the format
5597 of valid XBM image specifications. */
5598
5599 static struct image_keyword xbm_format[XBM_LAST] =
5600 {
5601 {":type", IMAGE_SYMBOL_VALUE, 1},
5602 {":file", IMAGE_STRING_VALUE, 0},
5603 {":width", IMAGE_POSITIVE_INTEGER_VALUE, 0},
5604 {":height", IMAGE_POSITIVE_INTEGER_VALUE, 0},
5605 {":data", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
5606 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
5607 {":background", IMAGE_STRING_OR_NIL_VALUE, 0},
5608 {":ascent", IMAGE_ASCENT_VALUE, 0},
5609 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
5610 {":relief", IMAGE_INTEGER_VALUE, 0},
5611 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
5612 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
5613 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
5614 };
5615
5616 /* Structure describing the image type XBM. */
5617
5618 static struct image_type xbm_type =
5619 {
5620 &Qxbm,
5621 xbm_image_p,
5622 xbm_load,
5623 x_clear_image,
5624 NULL
5625 };
5626
5627 /* Tokens returned from xbm_scan. */
5628
5629 enum xbm_token
5630 {
5631 XBM_TK_IDENT = 256,
5632 XBM_TK_NUMBER
5633 };
5634
5635
5636 /* Return non-zero if OBJECT is a valid XBM-type image specification.
5637 A valid specification is a list starting with the symbol `image'
5638 The rest of the list is a property list which must contain an
5639 entry `:type xbm..
5640
5641 If the specification specifies a file to load, it must contain
5642 an entry `:file FILENAME' where FILENAME is a string.
5643
5644 If the specification is for a bitmap loaded from memory it must
5645 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
5646 WIDTH and HEIGHT are integers > 0. DATA may be:
5647
5648 1. a string large enough to hold the bitmap data, i.e. it must
5649 have a size >= (WIDTH + 7) / 8 * HEIGHT
5650
5651 2. a bool-vector of size >= WIDTH * HEIGHT
5652
5653 3. a vector of strings or bool-vectors, one for each line of the
5654 bitmap.
5655
5656 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
5657 may not be specified in this case because they are defined in the
5658 XBM file.
5659
5660 Both the file and data forms may contain the additional entries
5661 `:background COLOR' and `:foreground COLOR'. If not present,
5662 foreground and background of the frame on which the image is
5663 displayed is used. */
5664
5665 static int
5666 xbm_image_p (object)
5667 Lisp_Object object;
5668 {
5669 struct image_keyword kw[XBM_LAST];
5670
5671 bcopy (xbm_format, kw, sizeof kw);
5672 if (!parse_image_spec (object, kw, XBM_LAST, Qxbm))
5673 return 0;
5674
5675 xassert (EQ (kw[XBM_TYPE].value, Qxbm));
5676
5677 if (kw[XBM_FILE].count)
5678 {
5679 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_DATA].count)
5680 return 0;
5681 }
5682 else if (kw[XBM_DATA].count && xbm_file_p (kw[XBM_DATA].value))
5683 {
5684 /* In-memory XBM file. */
5685 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_FILE].count)
5686 return 0;
5687 }
5688 else
5689 {
5690 Lisp_Object data;
5691 int width, height;
5692
5693 /* Entries for `:width', `:height' and `:data' must be present. */
5694 if (!kw[XBM_WIDTH].count
5695 || !kw[XBM_HEIGHT].count
5696 || !kw[XBM_DATA].count)
5697 return 0;
5698
5699 data = kw[XBM_DATA].value;
5700 width = XFASTINT (kw[XBM_WIDTH].value);
5701 height = XFASTINT (kw[XBM_HEIGHT].value);
5702
5703 /* Check type of data, and width and height against contents of
5704 data. */
5705 if (VECTORP (data))
5706 {
5707 int i;
5708
5709 /* Number of elements of the vector must be >= height. */
5710 if (XVECTOR (data)->size < height)
5711 return 0;
5712
5713 /* Each string or bool-vector in data must be large enough
5714 for one line of the image. */
5715 for (i = 0; i < height; ++i)
5716 {
5717 Lisp_Object elt = XVECTOR (data)->contents[i];
5718
5719 if (STRINGP (elt))
5720 {
5721 if (SCHARS (elt)
5722 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR)
5723 return 0;
5724 }
5725 else if (BOOL_VECTOR_P (elt))
5726 {
5727 if (XBOOL_VECTOR (elt)->size < width)
5728 return 0;
5729 }
5730 else
5731 return 0;
5732 }
5733 }
5734 else if (STRINGP (data))
5735 {
5736 if (SCHARS (data)
5737 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR * height)
5738 return 0;
5739 }
5740 else if (BOOL_VECTOR_P (data))
5741 {
5742 if (XBOOL_VECTOR (data)->size < width * height)
5743 return 0;
5744 }
5745 else
5746 return 0;
5747 }
5748
5749 return 1;
5750 }
5751
5752
5753 /* Scan a bitmap file. FP is the stream to read from. Value is
5754 either an enumerator from enum xbm_token, or a character for a
5755 single-character token, or 0 at end of file. If scanning an
5756 identifier, store the lexeme of the identifier in SVAL. If
5757 scanning a number, store its value in *IVAL. */
5758
5759 static int
5760 xbm_scan (s, end, sval, ival)
5761 char **s, *end;
5762 char *sval;
5763 int *ival;
5764 {
5765 int c;
5766
5767 loop:
5768
5769 /* Skip white space. */
5770 while (*s < end && (c = *(*s)++, isspace (c)))
5771 ;
5772
5773 if (*s >= end)
5774 c = 0;
5775 else if (isdigit (c))
5776 {
5777 int value = 0, digit;
5778
5779 if (c == '0' && *s < end)
5780 {
5781 c = *(*s)++;
5782 if (c == 'x' || c == 'X')
5783 {
5784 while (*s < end)
5785 {
5786 c = *(*s)++;
5787 if (isdigit (c))
5788 digit = c - '0';
5789 else if (c >= 'a' && c <= 'f')
5790 digit = c - 'a' + 10;
5791 else if (c >= 'A' && c <= 'F')
5792 digit = c - 'A' + 10;
5793 else
5794 break;
5795 value = 16 * value + digit;
5796 }
5797 }
5798 else if (isdigit (c))
5799 {
5800 value = c - '0';
5801 while (*s < end
5802 && (c = *(*s)++, isdigit (c)))
5803 value = 8 * value + c - '0';
5804 }
5805 }
5806 else
5807 {
5808 value = c - '0';
5809 while (*s < end
5810 && (c = *(*s)++, isdigit (c)))
5811 value = 10 * value + c - '0';
5812 }
5813
5814 if (*s < end)
5815 *s = *s - 1;
5816 *ival = value;
5817 c = XBM_TK_NUMBER;
5818 }
5819 else if (isalpha (c) || c == '_')
5820 {
5821 *sval++ = c;
5822 while (*s < end
5823 && (c = *(*s)++, (isalnum (c) || c == '_')))
5824 *sval++ = c;
5825 *sval = 0;
5826 if (*s < end)
5827 *s = *s - 1;
5828 c = XBM_TK_IDENT;
5829 }
5830 else if (c == '/' && **s == '*')
5831 {
5832 /* C-style comment. */
5833 ++*s;
5834 while (**s && (**s != '*' || *(*s + 1) != '/'))
5835 ++*s;
5836 if (**s)
5837 {
5838 *s += 2;
5839 goto loop;
5840 }
5841 }
5842
5843 return c;
5844 }
5845
5846
5847 /* Replacement for XReadBitmapFileData which isn't available under old
5848 X versions. CONTENTS is a pointer to a buffer to parse; END is the
5849 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
5850 the image. Return in *DATA the bitmap data allocated with xmalloc.
5851 Value is non-zero if successful. DATA null means just test if
5852 CONTENTS looks like an in-memory XBM file. */
5853
5854 static int
5855 xbm_read_bitmap_data (contents, end, width, height, data)
5856 char *contents, *end;
5857 int *width, *height;
5858 unsigned char **data;
5859 {
5860 char *s = contents;
5861 char buffer[BUFSIZ];
5862 int padding_p = 0;
5863 int v10 = 0;
5864 int bytes_per_line, i, nbytes;
5865 unsigned char *p;
5866 int value;
5867 int LA1;
5868
5869 #define match() \
5870 LA1 = xbm_scan (&s, end, buffer, &value)
5871
5872 #define expect(TOKEN) \
5873 if (LA1 != (TOKEN)) \
5874 goto failure; \
5875 else \
5876 match ()
5877
5878 #define expect_ident(IDENT) \
5879 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
5880 match (); \
5881 else \
5882 goto failure
5883
5884 *width = *height = -1;
5885 if (data)
5886 *data = NULL;
5887 LA1 = xbm_scan (&s, end, buffer, &value);
5888
5889 /* Parse defines for width, height and hot-spots. */
5890 while (LA1 == '#')
5891 {
5892 match ();
5893 expect_ident ("define");
5894 expect (XBM_TK_IDENT);
5895
5896 if (LA1 == XBM_TK_NUMBER);
5897 {
5898 char *p = strrchr (buffer, '_');
5899 p = p ? p + 1 : buffer;
5900 if (strcmp (p, "width") == 0)
5901 *width = value;
5902 else if (strcmp (p, "height") == 0)
5903 *height = value;
5904 }
5905 expect (XBM_TK_NUMBER);
5906 }
5907
5908 if (*width < 0 || *height < 0)
5909 goto failure;
5910 else if (data == NULL)
5911 goto success;
5912
5913 /* Parse bits. Must start with `static'. */
5914 expect_ident ("static");
5915 if (LA1 == XBM_TK_IDENT)
5916 {
5917 if (strcmp (buffer, "unsigned") == 0)
5918 {
5919 match ();
5920 expect_ident ("char");
5921 }
5922 else if (strcmp (buffer, "short") == 0)
5923 {
5924 match ();
5925 v10 = 1;
5926 if (*width % 16 && *width % 16 < 9)
5927 padding_p = 1;
5928 }
5929 else if (strcmp (buffer, "char") == 0)
5930 match ();
5931 else
5932 goto failure;
5933 }
5934 else
5935 goto failure;
5936
5937 expect (XBM_TK_IDENT);
5938 expect ('[');
5939 expect (']');
5940 expect ('=');
5941 expect ('{');
5942
5943 bytes_per_line = (*width + 7) / 8 + padding_p;
5944 nbytes = bytes_per_line * *height;
5945 p = *data = (char *) xmalloc (nbytes);
5946
5947 if (v10)
5948 {
5949 for (i = 0; i < nbytes; i += 2)
5950 {
5951 int val = value;
5952 expect (XBM_TK_NUMBER);
5953
5954 *p++ = val;
5955 if (!padding_p || ((i + 2) % bytes_per_line))
5956 *p++ = value >> 8;
5957
5958 if (LA1 == ',' || LA1 == '}')
5959 match ();
5960 else
5961 goto failure;
5962 }
5963 }
5964 else
5965 {
5966 for (i = 0; i < nbytes; ++i)
5967 {
5968 int val = value;
5969 expect (XBM_TK_NUMBER);
5970
5971 *p++ = val;
5972
5973 if (LA1 == ',' || LA1 == '}')
5974 match ();
5975 else
5976 goto failure;
5977 }
5978 }
5979
5980 success:
5981 return 1;
5982
5983 failure:
5984
5985 if (data && *data)
5986 {
5987 xfree (*data);
5988 *data = NULL;
5989 }
5990 return 0;
5991
5992 #undef match
5993 #undef expect
5994 #undef expect_ident
5995 }
5996
5997
5998 /* Load XBM image IMG which will be displayed on frame F from buffer
5999 CONTENTS. END is the end of the buffer. Value is non-zero if
6000 successful. */
6001
6002 static int
6003 xbm_load_image (f, img, contents, end)
6004 struct frame *f;
6005 struct image *img;
6006 char *contents, *end;
6007 {
6008 int rc;
6009 unsigned char *data;
6010 int success_p = 0;
6011
6012 rc = xbm_read_bitmap_data (contents, end, &img->width, &img->height, &data);
6013 if (rc)
6014 {
6015 int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
6016 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
6017 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
6018 Lisp_Object value;
6019
6020 xassert (img->width > 0 && img->height > 0);
6021
6022 /* Get foreground and background colors, maybe allocate colors. */
6023 value = image_spec_value (img->spec, QCforeground, NULL);
6024 if (!NILP (value))
6025 foreground = x_alloc_image_color (f, img, value, foreground);
6026 value = image_spec_value (img->spec, QCbackground, NULL);
6027 if (!NILP (value))
6028 {
6029 background = x_alloc_image_color (f, img, value, background);
6030 img->background = background;
6031 img->background_valid = 1;
6032 }
6033
6034 img->pixmap
6035 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
6036 FRAME_X_WINDOW (f),
6037 data,
6038 img->width, img->height,
6039 foreground, background,
6040 depth);
6041 xfree (data);
6042
6043 if (img->pixmap == None)
6044 {
6045 x_clear_image (f, img);
6046 image_error ("Unable to create X pixmap for `%s'", img->spec, Qnil);
6047 }
6048 else
6049 success_p = 1;
6050 }
6051 else
6052 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
6053
6054 return success_p;
6055 }
6056
6057
6058 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6059
6060 static int
6061 xbm_file_p (data)
6062 Lisp_Object data;
6063 {
6064 int w, h;
6065 return (STRINGP (data)
6066 && xbm_read_bitmap_data (SDATA (data),
6067 (SDATA (data)
6068 + SBYTES (data)),
6069 &w, &h, NULL));
6070 }
6071
6072
6073 /* Fill image IMG which is used on frame F with pixmap data. Value is
6074 non-zero if successful. */
6075
6076 static int
6077 xbm_load (f, img)
6078 struct frame *f;
6079 struct image *img;
6080 {
6081 int success_p = 0;
6082 Lisp_Object file_name;
6083
6084 xassert (xbm_image_p (img->spec));
6085
6086 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6087 file_name = image_spec_value (img->spec, QCfile, NULL);
6088 if (STRINGP (file_name))
6089 {
6090 Lisp_Object file;
6091 char *contents;
6092 int size;
6093 struct gcpro gcpro1;
6094
6095 file = x_find_image_file (file_name);
6096 GCPRO1 (file);
6097 if (!STRINGP (file))
6098 {
6099 image_error ("Cannot find image file `%s'", file_name, Qnil);
6100 UNGCPRO;
6101 return 0;
6102 }
6103
6104 contents = slurp_file (SDATA (file), &size);
6105 if (contents == NULL)
6106 {
6107 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
6108 UNGCPRO;
6109 return 0;
6110 }
6111
6112 success_p = xbm_load_image (f, img, contents, contents + size);
6113 UNGCPRO;
6114 }
6115 else
6116 {
6117 struct image_keyword fmt[XBM_LAST];
6118 Lisp_Object data;
6119 int depth;
6120 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
6121 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
6122 char *bits;
6123 int parsed_p;
6124 int in_memory_file_p = 0;
6125
6126 /* See if data looks like an in-memory XBM file. */
6127 data = image_spec_value (img->spec, QCdata, NULL);
6128 in_memory_file_p = xbm_file_p (data);
6129
6130 /* Parse the image specification. */
6131 bcopy (xbm_format, fmt, sizeof fmt);
6132 parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm);
6133 xassert (parsed_p);
6134
6135 /* Get specified width, and height. */
6136 if (!in_memory_file_p)
6137 {
6138 img->width = XFASTINT (fmt[XBM_WIDTH].value);
6139 img->height = XFASTINT (fmt[XBM_HEIGHT].value);
6140 xassert (img->width > 0 && img->height > 0);
6141 }
6142
6143 /* Get foreground and background colors, maybe allocate colors. */
6144 if (fmt[XBM_FOREGROUND].count
6145 && STRINGP (fmt[XBM_FOREGROUND].value))
6146 foreground = x_alloc_image_color (f, img, fmt[XBM_FOREGROUND].value,
6147 foreground);
6148 if (fmt[XBM_BACKGROUND].count
6149 && STRINGP (fmt[XBM_BACKGROUND].value))
6150 background = x_alloc_image_color (f, img, fmt[XBM_BACKGROUND].value,
6151 background);
6152
6153 if (in_memory_file_p)
6154 success_p = xbm_load_image (f, img, SDATA (data),
6155 (SDATA (data)
6156 + SBYTES (data)));
6157 else
6158 {
6159 if (VECTORP (data))
6160 {
6161 int i;
6162 char *p;
6163 int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
6164
6165 p = bits = (char *) alloca (nbytes * img->height);
6166 for (i = 0; i < img->height; ++i, p += nbytes)
6167 {
6168 Lisp_Object line = XVECTOR (data)->contents[i];
6169 if (STRINGP (line))
6170 bcopy (SDATA (line), p, nbytes);
6171 else
6172 bcopy (XBOOL_VECTOR (line)->data, p, nbytes);
6173 }
6174 }
6175 else if (STRINGP (data))
6176 bits = SDATA (data);
6177 else
6178 bits = XBOOL_VECTOR (data)->data;
6179
6180 /* Create the pixmap. */
6181 depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
6182 img->pixmap
6183 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
6184 FRAME_X_WINDOW (f),
6185 bits,
6186 img->width, img->height,
6187 foreground, background,
6188 depth);
6189 if (img->pixmap)
6190 success_p = 1;
6191 else
6192 {
6193 image_error ("Unable to create pixmap for XBM image `%s'",
6194 img->spec, Qnil);
6195 x_clear_image (f, img);
6196 }
6197 }
6198 }
6199
6200 return success_p;
6201 }
6202
6203
6204 \f
6205 /***********************************************************************
6206 XPM images
6207 ***********************************************************************/
6208
6209 #if HAVE_XPM
6210
6211 static int xpm_image_p P_ ((Lisp_Object object));
6212 static int xpm_load P_ ((struct frame *f, struct image *img));
6213 static int xpm_valid_color_symbols_p P_ ((Lisp_Object));
6214
6215 #include "X11/xpm.h"
6216
6217 /* The symbol `xpm' identifying XPM-format images. */
6218
6219 Lisp_Object Qxpm;
6220
6221 /* Indices of image specification fields in xpm_format, below. */
6222
6223 enum xpm_keyword_index
6224 {
6225 XPM_TYPE,
6226 XPM_FILE,
6227 XPM_DATA,
6228 XPM_ASCENT,
6229 XPM_MARGIN,
6230 XPM_RELIEF,
6231 XPM_ALGORITHM,
6232 XPM_HEURISTIC_MASK,
6233 XPM_MASK,
6234 XPM_COLOR_SYMBOLS,
6235 XPM_BACKGROUND,
6236 XPM_LAST
6237 };
6238
6239 /* Vector of image_keyword structures describing the format
6240 of valid XPM image specifications. */
6241
6242 static struct image_keyword xpm_format[XPM_LAST] =
6243 {
6244 {":type", IMAGE_SYMBOL_VALUE, 1},
6245 {":file", IMAGE_STRING_VALUE, 0},
6246 {":data", IMAGE_STRING_VALUE, 0},
6247 {":ascent", IMAGE_ASCENT_VALUE, 0},
6248 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6249 {":relief", IMAGE_INTEGER_VALUE, 0},
6250 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6251 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6252 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6253 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6254 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
6255 };
6256
6257 /* Structure describing the image type XBM. */
6258
6259 static struct image_type xpm_type =
6260 {
6261 &Qxpm,
6262 xpm_image_p,
6263 xpm_load,
6264 x_clear_image,
6265 NULL
6266 };
6267
6268
6269 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
6270 functions for allocating image colors. Our own functions handle
6271 color allocation failures more gracefully than the ones on the XPM
6272 lib. */
6273
6274 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
6275 #define ALLOC_XPM_COLORS
6276 #endif
6277
6278 #ifdef ALLOC_XPM_COLORS
6279
6280 static void xpm_init_color_cache P_ ((struct frame *, XpmAttributes *));
6281 static void xpm_free_color_cache P_ ((void));
6282 static int xpm_lookup_color P_ ((struct frame *, char *, XColor *));
6283 static int xpm_color_bucket P_ ((char *));
6284 static struct xpm_cached_color *xpm_cache_color P_ ((struct frame *, char *,
6285 XColor *, int));
6286
6287 /* An entry in a hash table used to cache color definitions of named
6288 colors. This cache is necessary to speed up XPM image loading in
6289 case we do color allocations ourselves. Without it, we would need
6290 a call to XParseColor per pixel in the image. */
6291
6292 struct xpm_cached_color
6293 {
6294 /* Next in collision chain. */
6295 struct xpm_cached_color *next;
6296
6297 /* Color definition (RGB and pixel color). */
6298 XColor color;
6299
6300 /* Color name. */
6301 char name[1];
6302 };
6303
6304 /* The hash table used for the color cache, and its bucket vector
6305 size. */
6306
6307 #define XPM_COLOR_CACHE_BUCKETS 1001
6308 struct xpm_cached_color **xpm_color_cache;
6309
6310 /* Initialize the color cache. */
6311
6312 static void
6313 xpm_init_color_cache (f, attrs)
6314 struct frame *f;
6315 XpmAttributes *attrs;
6316 {
6317 size_t nbytes = XPM_COLOR_CACHE_BUCKETS * sizeof *xpm_color_cache;
6318 xpm_color_cache = (struct xpm_cached_color **) xmalloc (nbytes);
6319 memset (xpm_color_cache, 0, nbytes);
6320 init_color_table ();
6321
6322 if (attrs->valuemask & XpmColorSymbols)
6323 {
6324 int i;
6325 XColor color;
6326
6327 for (i = 0; i < attrs->numsymbols; ++i)
6328 if (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
6329 attrs->colorsymbols[i].value, &color))
6330 {
6331 color.pixel = lookup_rgb_color (f, color.red, color.green,
6332 color.blue);
6333 xpm_cache_color (f, attrs->colorsymbols[i].name, &color, -1);
6334 }
6335 }
6336 }
6337
6338
6339 /* Free the color cache. */
6340
6341 static void
6342 xpm_free_color_cache ()
6343 {
6344 struct xpm_cached_color *p, *next;
6345 int i;
6346
6347 for (i = 0; i < XPM_COLOR_CACHE_BUCKETS; ++i)
6348 for (p = xpm_color_cache[i]; p; p = next)
6349 {
6350 next = p->next;
6351 xfree (p);
6352 }
6353
6354 xfree (xpm_color_cache);
6355 xpm_color_cache = NULL;
6356 free_color_table ();
6357 }
6358
6359
6360 /* Return the bucket index for color named COLOR_NAME in the color
6361 cache. */
6362
6363 static int
6364 xpm_color_bucket (color_name)
6365 char *color_name;
6366 {
6367 unsigned h = 0;
6368 char *s;
6369
6370 for (s = color_name; *s; ++s)
6371 h = (h << 2) ^ *s;
6372 return h %= XPM_COLOR_CACHE_BUCKETS;
6373 }
6374
6375
6376 /* On frame F, cache values COLOR for color with name COLOR_NAME.
6377 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
6378 entry added. */
6379
6380 static struct xpm_cached_color *
6381 xpm_cache_color (f, color_name, color, bucket)
6382 struct frame *f;
6383 char *color_name;
6384 XColor *color;
6385 int bucket;
6386 {
6387 size_t nbytes;
6388 struct xpm_cached_color *p;
6389
6390 if (bucket < 0)
6391 bucket = xpm_color_bucket (color_name);
6392
6393 nbytes = sizeof *p + strlen (color_name);
6394 p = (struct xpm_cached_color *) xmalloc (nbytes);
6395 strcpy (p->name, color_name);
6396 p->color = *color;
6397 p->next = xpm_color_cache[bucket];
6398 xpm_color_cache[bucket] = p;
6399 return p;
6400 }
6401
6402
6403 /* Look up color COLOR_NAME for frame F in the color cache. If found,
6404 return the cached definition in *COLOR. Otherwise, make a new
6405 entry in the cache and allocate the color. Value is zero if color
6406 allocation failed. */
6407
6408 static int
6409 xpm_lookup_color (f, color_name, color)
6410 struct frame *f;
6411 char *color_name;
6412 XColor *color;
6413 {
6414 struct xpm_cached_color *p;
6415 int h = xpm_color_bucket (color_name);
6416
6417 for (p = xpm_color_cache[h]; p; p = p->next)
6418 if (strcmp (p->name, color_name) == 0)
6419 break;
6420
6421 if (p != NULL)
6422 *color = p->color;
6423 else if (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
6424 color_name, color))
6425 {
6426 color->pixel = lookup_rgb_color (f, color->red, color->green,
6427 color->blue);
6428 p = xpm_cache_color (f, color_name, color, h);
6429 }
6430 /* You get `opaque' at least from ImageMagick converting pbm to xpm
6431 with transparency, and it's useful. */
6432 else if (strcmp ("opaque", color_name) == 0)
6433 {
6434 bzero (color, sizeof (XColor)); /* Is this necessary/correct? */
6435 color->pixel = FRAME_FOREGROUND_PIXEL (f);
6436 p = xpm_cache_color (f, color_name, color, h);
6437 }
6438
6439 return p != NULL;
6440 }
6441
6442
6443 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
6444 CLOSURE is a pointer to the frame on which we allocate the
6445 color. Return in *COLOR the allocated color. Value is non-zero
6446 if successful. */
6447
6448 static int
6449 xpm_alloc_color (dpy, cmap, color_name, color, closure)
6450 Display *dpy;
6451 Colormap cmap;
6452 char *color_name;
6453 XColor *color;
6454 void *closure;
6455 {
6456 return xpm_lookup_color ((struct frame *) closure, color_name, color);
6457 }
6458
6459
6460 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
6461 is a pointer to the frame on which we allocate the color. Value is
6462 non-zero if successful. */
6463
6464 static int
6465 xpm_free_colors (dpy, cmap, pixels, npixels, closure)
6466 Display *dpy;
6467 Colormap cmap;
6468 Pixel *pixels;
6469 int npixels;
6470 void *closure;
6471 {
6472 return 1;
6473 }
6474
6475 #endif /* ALLOC_XPM_COLORS */
6476
6477
6478 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
6479 for XPM images. Such a list must consist of conses whose car and
6480 cdr are strings. */
6481
6482 static int
6483 xpm_valid_color_symbols_p (color_symbols)
6484 Lisp_Object color_symbols;
6485 {
6486 while (CONSP (color_symbols))
6487 {
6488 Lisp_Object sym = XCAR (color_symbols);
6489 if (!CONSP (sym)
6490 || !STRINGP (XCAR (sym))
6491 || !STRINGP (XCDR (sym)))
6492 break;
6493 color_symbols = XCDR (color_symbols);
6494 }
6495
6496 return NILP (color_symbols);
6497 }
6498
6499
6500 /* Value is non-zero if OBJECT is a valid XPM image specification. */
6501
6502 static int
6503 xpm_image_p (object)
6504 Lisp_Object object;
6505 {
6506 struct image_keyword fmt[XPM_LAST];
6507 bcopy (xpm_format, fmt, sizeof fmt);
6508 return (parse_image_spec (object, fmt, XPM_LAST, Qxpm)
6509 /* Either `:file' or `:data' must be present. */
6510 && fmt[XPM_FILE].count + fmt[XPM_DATA].count == 1
6511 /* Either no `:color-symbols' or it's a list of conses
6512 whose car and cdr are strings. */
6513 && (fmt[XPM_COLOR_SYMBOLS].count == 0
6514 || xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value)));
6515 }
6516
6517
6518 /* Load image IMG which will be displayed on frame F. Value is
6519 non-zero if successful. */
6520
6521 static int
6522 xpm_load (f, img)
6523 struct frame *f;
6524 struct image *img;
6525 {
6526 int rc;
6527 XpmAttributes attrs;
6528 Lisp_Object specified_file, color_symbols;
6529
6530 /* Configure the XPM lib. Use the visual of frame F. Allocate
6531 close colors. Return colors allocated. */
6532 bzero (&attrs, sizeof attrs);
6533 attrs.visual = FRAME_X_VISUAL (f);
6534 attrs.colormap = FRAME_X_COLORMAP (f);
6535 attrs.valuemask |= XpmVisual;
6536 attrs.valuemask |= XpmColormap;
6537
6538 #ifdef ALLOC_XPM_COLORS
6539 /* Allocate colors with our own functions which handle
6540 failing color allocation more gracefully. */
6541 attrs.color_closure = f;
6542 attrs.alloc_color = xpm_alloc_color;
6543 attrs.free_colors = xpm_free_colors;
6544 attrs.valuemask |= XpmAllocColor | XpmFreeColors | XpmColorClosure;
6545 #else /* not ALLOC_XPM_COLORS */
6546 /* Let the XPM lib allocate colors. */
6547 attrs.valuemask |= XpmReturnAllocPixels;
6548 #ifdef XpmAllocCloseColors
6549 attrs.alloc_close_colors = 1;
6550 attrs.valuemask |= XpmAllocCloseColors;
6551 #else /* not XpmAllocCloseColors */
6552 attrs.closeness = 600;
6553 attrs.valuemask |= XpmCloseness;
6554 #endif /* not XpmAllocCloseColors */
6555 #endif /* ALLOC_XPM_COLORS */
6556
6557 /* If image specification contains symbolic color definitions, add
6558 these to `attrs'. */
6559 color_symbols = image_spec_value (img->spec, QCcolor_symbols, NULL);
6560 if (CONSP (color_symbols))
6561 {
6562 Lisp_Object tail;
6563 XpmColorSymbol *xpm_syms;
6564 int i, size;
6565
6566 attrs.valuemask |= XpmColorSymbols;
6567
6568 /* Count number of symbols. */
6569 attrs.numsymbols = 0;
6570 for (tail = color_symbols; CONSP (tail); tail = XCDR (tail))
6571 ++attrs.numsymbols;
6572
6573 /* Allocate an XpmColorSymbol array. */
6574 size = attrs.numsymbols * sizeof *xpm_syms;
6575 xpm_syms = (XpmColorSymbol *) alloca (size);
6576 bzero (xpm_syms, size);
6577 attrs.colorsymbols = xpm_syms;
6578
6579 /* Fill the color symbol array. */
6580 for (tail = color_symbols, i = 0;
6581 CONSP (tail);
6582 ++i, tail = XCDR (tail))
6583 {
6584 Lisp_Object name = XCAR (XCAR (tail));
6585 Lisp_Object color = XCDR (XCAR (tail));
6586 xpm_syms[i].name = (char *) alloca (SCHARS (name) + 1);
6587 strcpy (xpm_syms[i].name, SDATA (name));
6588 xpm_syms[i].value = (char *) alloca (SCHARS (color) + 1);
6589 strcpy (xpm_syms[i].value, SDATA (color));
6590 }
6591 }
6592
6593 /* Create a pixmap for the image, either from a file, or from a
6594 string buffer containing data in the same format as an XPM file. */
6595 #ifdef ALLOC_XPM_COLORS
6596 xpm_init_color_cache (f, &attrs);
6597 #endif
6598
6599 specified_file = image_spec_value (img->spec, QCfile, NULL);
6600 if (STRINGP (specified_file))
6601 {
6602 Lisp_Object file = x_find_image_file (specified_file);
6603 if (!STRINGP (file))
6604 {
6605 image_error ("Cannot find image file `%s'", specified_file, Qnil);
6606 return 0;
6607 }
6608
6609 rc = XpmReadFileToPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
6610 SDATA (file), &img->pixmap, &img->mask,
6611 &attrs);
6612 }
6613 else
6614 {
6615 Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL);
6616 rc = XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
6617 SDATA (buffer),
6618 &img->pixmap, &img->mask,
6619 &attrs);
6620 }
6621
6622 if (rc == XpmSuccess)
6623 {
6624 #ifdef ALLOC_XPM_COLORS
6625 img->colors = colors_in_color_table (&img->ncolors);
6626 #else /* not ALLOC_XPM_COLORS */
6627 int i;
6628
6629 img->ncolors = attrs.nalloc_pixels;
6630 img->colors = (unsigned long *) xmalloc (img->ncolors
6631 * sizeof *img->colors);
6632 for (i = 0; i < attrs.nalloc_pixels; ++i)
6633 {
6634 img->colors[i] = attrs.alloc_pixels[i];
6635 #ifdef DEBUG_X_COLORS
6636 register_color (img->colors[i]);
6637 #endif
6638 }
6639 #endif /* not ALLOC_XPM_COLORS */
6640
6641 img->width = attrs.width;
6642 img->height = attrs.height;
6643 xassert (img->width > 0 && img->height > 0);
6644
6645 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
6646 XpmFreeAttributes (&attrs);
6647 }
6648 else
6649 {
6650 switch (rc)
6651 {
6652 case XpmOpenFailed:
6653 image_error ("Error opening XPM file (%s)", img->spec, Qnil);
6654 break;
6655
6656 case XpmFileInvalid:
6657 image_error ("Invalid XPM file (%s)", img->spec, Qnil);
6658 break;
6659
6660 case XpmNoMemory:
6661 image_error ("Out of memory (%s)", img->spec, Qnil);
6662 break;
6663
6664 case XpmColorFailed:
6665 image_error ("Color allocation error (%s)", img->spec, Qnil);
6666 break;
6667
6668 default:
6669 image_error ("Unknown error (%s)", img->spec, Qnil);
6670 break;
6671 }
6672 }
6673
6674 #ifdef ALLOC_XPM_COLORS
6675 xpm_free_color_cache ();
6676 #endif
6677 return rc == XpmSuccess;
6678 }
6679
6680 #endif /* HAVE_XPM != 0 */
6681
6682 \f
6683 /***********************************************************************
6684 Color table
6685 ***********************************************************************/
6686
6687 /* An entry in the color table mapping an RGB color to a pixel color. */
6688
6689 struct ct_color
6690 {
6691 int r, g, b;
6692 unsigned long pixel;
6693
6694 /* Next in color table collision list. */
6695 struct ct_color *next;
6696 };
6697
6698 /* The bucket vector size to use. Must be prime. */
6699
6700 #define CT_SIZE 101
6701
6702 /* Value is a hash of the RGB color given by R, G, and B. */
6703
6704 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
6705
6706 /* The color hash table. */
6707
6708 struct ct_color **ct_table;
6709
6710 /* Number of entries in the color table. */
6711
6712 int ct_colors_allocated;
6713
6714 /* Initialize the color table. */
6715
6716 static void
6717 init_color_table ()
6718 {
6719 int size = CT_SIZE * sizeof (*ct_table);
6720 ct_table = (struct ct_color **) xmalloc (size);
6721 bzero (ct_table, size);
6722 ct_colors_allocated = 0;
6723 }
6724
6725
6726 /* Free memory associated with the color table. */
6727
6728 static void
6729 free_color_table ()
6730 {
6731 int i;
6732 struct ct_color *p, *next;
6733
6734 for (i = 0; i < CT_SIZE; ++i)
6735 for (p = ct_table[i]; p; p = next)
6736 {
6737 next = p->next;
6738 xfree (p);
6739 }
6740
6741 xfree (ct_table);
6742 ct_table = NULL;
6743 }
6744
6745
6746 /* Value is a pixel color for RGB color R, G, B on frame F. If an
6747 entry for that color already is in the color table, return the
6748 pixel color of that entry. Otherwise, allocate a new color for R,
6749 G, B, and make an entry in the color table. */
6750
6751 static unsigned long
6752 lookup_rgb_color (f, r, g, b)
6753 struct frame *f;
6754 int r, g, b;
6755 {
6756 unsigned hash = CT_HASH_RGB (r, g, b);
6757 int i = hash % CT_SIZE;
6758 struct ct_color *p;
6759 struct x_display_info *dpyinfo;
6760
6761 /* Handle TrueColor visuals specially, which improves performance by
6762 two orders of magnitude. Freeing colors on TrueColor visuals is
6763 a nop, and pixel colors specify RGB values directly. See also
6764 the Xlib spec, chapter 3.1. */
6765 dpyinfo = FRAME_X_DISPLAY_INFO (f);
6766 if (dpyinfo->red_bits > 0)
6767 {
6768 unsigned long pr, pg, pb;
6769
6770 /* Apply gamma-correction like normal color allocation does. */
6771 if (f->gamma)
6772 {
6773 XColor color;
6774 color.red = r, color.green = g, color.blue = b;
6775 gamma_correct (f, &color);
6776 r = color.red, g = color.green, b = color.blue;
6777 }
6778
6779 /* Scale down RGB values to the visual's bits per RGB, and shift
6780 them to the right position in the pixel color. Note that the
6781 original RGB values are 16-bit values, as usual in X. */
6782 pr = (r >> (16 - dpyinfo->red_bits)) << dpyinfo->red_offset;
6783 pg = (g >> (16 - dpyinfo->green_bits)) << dpyinfo->green_offset;
6784 pb = (b >> (16 - dpyinfo->blue_bits)) << dpyinfo->blue_offset;
6785
6786 /* Assemble the pixel color. */
6787 return pr | pg | pb;
6788 }
6789
6790 for (p = ct_table[i]; p; p = p->next)
6791 if (p->r == r && p->g == g && p->b == b)
6792 break;
6793
6794 if (p == NULL)
6795 {
6796 XColor color;
6797 Colormap cmap;
6798 int rc;
6799
6800 color.red = r;
6801 color.green = g;
6802 color.blue = b;
6803
6804 cmap = FRAME_X_COLORMAP (f);
6805 rc = x_alloc_nearest_color (f, cmap, &color);
6806
6807 if (rc)
6808 {
6809 ++ct_colors_allocated;
6810
6811 p = (struct ct_color *) xmalloc (sizeof *p);
6812 p->r = r;
6813 p->g = g;
6814 p->b = b;
6815 p->pixel = color.pixel;
6816 p->next = ct_table[i];
6817 ct_table[i] = p;
6818 }
6819 else
6820 return FRAME_FOREGROUND_PIXEL (f);
6821 }
6822
6823 return p->pixel;
6824 }
6825
6826
6827 /* Look up pixel color PIXEL which is used on frame F in the color
6828 table. If not already present, allocate it. Value is PIXEL. */
6829
6830 static unsigned long
6831 lookup_pixel_color (f, pixel)
6832 struct frame *f;
6833 unsigned long pixel;
6834 {
6835 int i = pixel % CT_SIZE;
6836 struct ct_color *p;
6837
6838 for (p = ct_table[i]; p; p = p->next)
6839 if (p->pixel == pixel)
6840 break;
6841
6842 if (p == NULL)
6843 {
6844 XColor color;
6845 Colormap cmap;
6846 int rc;
6847
6848 cmap = FRAME_X_COLORMAP (f);
6849 color.pixel = pixel;
6850 x_query_color (f, &color);
6851 rc = x_alloc_nearest_color (f, cmap, &color);
6852
6853 if (rc)
6854 {
6855 ++ct_colors_allocated;
6856
6857 p = (struct ct_color *) xmalloc (sizeof *p);
6858 p->r = color.red;
6859 p->g = color.green;
6860 p->b = color.blue;
6861 p->pixel = pixel;
6862 p->next = ct_table[i];
6863 ct_table[i] = p;
6864 }
6865 else
6866 return FRAME_FOREGROUND_PIXEL (f);
6867 }
6868
6869 return p->pixel;
6870 }
6871
6872
6873 /* Value is a vector of all pixel colors contained in the color table,
6874 allocated via xmalloc. Set *N to the number of colors. */
6875
6876 static unsigned long *
6877 colors_in_color_table (n)
6878 int *n;
6879 {
6880 int i, j;
6881 struct ct_color *p;
6882 unsigned long *colors;
6883
6884 if (ct_colors_allocated == 0)
6885 {
6886 *n = 0;
6887 colors = NULL;
6888 }
6889 else
6890 {
6891 colors = (unsigned long *) xmalloc (ct_colors_allocated
6892 * sizeof *colors);
6893 *n = ct_colors_allocated;
6894
6895 for (i = j = 0; i < CT_SIZE; ++i)
6896 for (p = ct_table[i]; p; p = p->next)
6897 colors[j++] = p->pixel;
6898 }
6899
6900 return colors;
6901 }
6902
6903
6904 \f
6905 /***********************************************************************
6906 Algorithms
6907 ***********************************************************************/
6908
6909 static XColor *x_to_xcolors P_ ((struct frame *, struct image *, int));
6910 static void x_from_xcolors P_ ((struct frame *, struct image *, XColor *));
6911 static void x_detect_edges P_ ((struct frame *, struct image *, int[9], int));
6912
6913 /* Non-zero means draw a cross on images having `:conversion
6914 disabled'. */
6915
6916 int cross_disabled_images;
6917
6918 /* Edge detection matrices for different edge-detection
6919 strategies. */
6920
6921 static int emboss_matrix[9] = {
6922 /* x - 1 x x + 1 */
6923 2, -1, 0, /* y - 1 */
6924 -1, 0, 1, /* y */
6925 0, 1, -2 /* y + 1 */
6926 };
6927
6928 static int laplace_matrix[9] = {
6929 /* x - 1 x x + 1 */
6930 1, 0, 0, /* y - 1 */
6931 0, 0, 0, /* y */
6932 0, 0, -1 /* y + 1 */
6933 };
6934
6935 /* Value is the intensity of the color whose red/green/blue values
6936 are R, G, and B. */
6937
6938 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
6939
6940
6941 /* On frame F, return an array of XColor structures describing image
6942 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
6943 non-zero means also fill the red/green/blue members of the XColor
6944 structures. Value is a pointer to the array of XColors structures,
6945 allocated with xmalloc; it must be freed by the caller. */
6946
6947 static XColor *
6948 x_to_xcolors (f, img, rgb_p)
6949 struct frame *f;
6950 struct image *img;
6951 int rgb_p;
6952 {
6953 int x, y;
6954 XColor *colors, *p;
6955 XImage *ximg;
6956
6957 colors = (XColor *) xmalloc (img->width * img->height * sizeof *colors);
6958
6959 /* Get the X image IMG->pixmap. */
6960 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
6961 0, 0, img->width, img->height, ~0, ZPixmap);
6962
6963 /* Fill the `pixel' members of the XColor array. I wished there
6964 were an easy and portable way to circumvent XGetPixel. */
6965 p = colors;
6966 for (y = 0; y < img->height; ++y)
6967 {
6968 XColor *row = p;
6969
6970 for (x = 0; x < img->width; ++x, ++p)
6971 p->pixel = XGetPixel (ximg, x, y);
6972
6973 if (rgb_p)
6974 x_query_colors (f, row, img->width);
6975 }
6976
6977 XDestroyImage (ximg);
6978 return colors;
6979 }
6980
6981
6982 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
6983 RGB members are set. F is the frame on which this all happens.
6984 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
6985
6986 static void
6987 x_from_xcolors (f, img, colors)
6988 struct frame *f;
6989 struct image *img;
6990 XColor *colors;
6991 {
6992 int x, y;
6993 XImage *oimg;
6994 Pixmap pixmap;
6995 XColor *p;
6996
6997 init_color_table ();
6998
6999 x_create_x_image_and_pixmap (f, img->width, img->height, 0,
7000 &oimg, &pixmap);
7001 p = colors;
7002 for (y = 0; y < img->height; ++y)
7003 for (x = 0; x < img->width; ++x, ++p)
7004 {
7005 unsigned long pixel;
7006 pixel = lookup_rgb_color (f, p->red, p->green, p->blue);
7007 XPutPixel (oimg, x, y, pixel);
7008 }
7009
7010 xfree (colors);
7011 x_clear_image_1 (f, img, 1, 0, 1);
7012
7013 x_put_x_image (f, oimg, pixmap, img->width, img->height);
7014 x_destroy_x_image (oimg);
7015 img->pixmap = pixmap;
7016 img->colors = colors_in_color_table (&img->ncolors);
7017 free_color_table ();
7018 }
7019
7020
7021 /* On frame F, perform edge-detection on image IMG.
7022
7023 MATRIX is a nine-element array specifying the transformation
7024 matrix. See emboss_matrix for an example.
7025
7026 COLOR_ADJUST is a color adjustment added to each pixel of the
7027 outgoing image. */
7028
7029 static void
7030 x_detect_edges (f, img, matrix, color_adjust)
7031 struct frame *f;
7032 struct image *img;
7033 int matrix[9], color_adjust;
7034 {
7035 XColor *colors = x_to_xcolors (f, img, 1);
7036 XColor *new, *p;
7037 int x, y, i, sum;
7038
7039 for (i = sum = 0; i < 9; ++i)
7040 sum += abs (matrix[i]);
7041
7042 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7043
7044 new = (XColor *) xmalloc (img->width * img->height * sizeof *new);
7045
7046 for (y = 0; y < img->height; ++y)
7047 {
7048 p = COLOR (new, 0, y);
7049 p->red = p->green = p->blue = 0xffff/2;
7050 p = COLOR (new, img->width - 1, y);
7051 p->red = p->green = p->blue = 0xffff/2;
7052 }
7053
7054 for (x = 1; x < img->width - 1; ++x)
7055 {
7056 p = COLOR (new, x, 0);
7057 p->red = p->green = p->blue = 0xffff/2;
7058 p = COLOR (new, x, img->height - 1);
7059 p->red = p->green = p->blue = 0xffff/2;
7060 }
7061
7062 for (y = 1; y < img->height - 1; ++y)
7063 {
7064 p = COLOR (new, 1, y);
7065
7066 for (x = 1; x < img->width - 1; ++x, ++p)
7067 {
7068 int r, g, b, y1, x1;
7069
7070 r = g = b = i = 0;
7071 for (y1 = y - 1; y1 < y + 2; ++y1)
7072 for (x1 = x - 1; x1 < x + 2; ++x1, ++i)
7073 if (matrix[i])
7074 {
7075 XColor *t = COLOR (colors, x1, y1);
7076 r += matrix[i] * t->red;
7077 g += matrix[i] * t->green;
7078 b += matrix[i] * t->blue;
7079 }
7080
7081 r = (r / sum + color_adjust) & 0xffff;
7082 g = (g / sum + color_adjust) & 0xffff;
7083 b = (b / sum + color_adjust) & 0xffff;
7084 p->red = p->green = p->blue = COLOR_INTENSITY (r, g, b);
7085 }
7086 }
7087
7088 xfree (colors);
7089 x_from_xcolors (f, img, new);
7090
7091 #undef COLOR
7092 }
7093
7094
7095 /* Perform the pre-defined `emboss' edge-detection on image IMG
7096 on frame F. */
7097
7098 static void
7099 x_emboss (f, img)
7100 struct frame *f;
7101 struct image *img;
7102 {
7103 x_detect_edges (f, img, emboss_matrix, 0xffff / 2);
7104 }
7105
7106
7107 /* Perform the pre-defined `laplace' edge-detection on image IMG
7108 on frame F. */
7109
7110 static void
7111 x_laplace (f, img)
7112 struct frame *f;
7113 struct image *img;
7114 {
7115 x_detect_edges (f, img, laplace_matrix, 45000);
7116 }
7117
7118
7119 /* Perform edge-detection on image IMG on frame F, with specified
7120 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7121
7122 MATRIX must be either
7123
7124 - a list of at least 9 numbers in row-major form
7125 - a vector of at least 9 numbers
7126
7127 COLOR_ADJUST nil means use a default; otherwise it must be a
7128 number. */
7129
7130 static void
7131 x_edge_detection (f, img, matrix, color_adjust)
7132 struct frame *f;
7133 struct image *img;
7134 Lisp_Object matrix, color_adjust;
7135 {
7136 int i = 0;
7137 int trans[9];
7138
7139 if (CONSP (matrix))
7140 {
7141 for (i = 0;
7142 i < 9 && CONSP (matrix) && NUMBERP (XCAR (matrix));
7143 ++i, matrix = XCDR (matrix))
7144 trans[i] = XFLOATINT (XCAR (matrix));
7145 }
7146 else if (VECTORP (matrix) && ASIZE (matrix) >= 9)
7147 {
7148 for (i = 0; i < 9 && NUMBERP (AREF (matrix, i)); ++i)
7149 trans[i] = XFLOATINT (AREF (matrix, i));
7150 }
7151
7152 if (NILP (color_adjust))
7153 color_adjust = make_number (0xffff / 2);
7154
7155 if (i == 9 && NUMBERP (color_adjust))
7156 x_detect_edges (f, img, trans, (int) XFLOATINT (color_adjust));
7157 }
7158
7159
7160 /* Transform image IMG on frame F so that it looks disabled. */
7161
7162 static void
7163 x_disable_image (f, img)
7164 struct frame *f;
7165 struct image *img;
7166 {
7167 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
7168
7169 if (dpyinfo->n_planes >= 2)
7170 {
7171 /* Color (or grayscale). Convert to gray, and equalize. Just
7172 drawing such images with a stipple can look very odd, so
7173 we're using this method instead. */
7174 XColor *colors = x_to_xcolors (f, img, 1);
7175 XColor *p, *end;
7176 const int h = 15000;
7177 const int l = 30000;
7178
7179 for (p = colors, end = colors + img->width * img->height;
7180 p < end;
7181 ++p)
7182 {
7183 int i = COLOR_INTENSITY (p->red, p->green, p->blue);
7184 int i2 = (0xffff - h - l) * i / 0xffff + l;
7185 p->red = p->green = p->blue = i2;
7186 }
7187
7188 x_from_xcolors (f, img, colors);
7189 }
7190
7191 /* Draw a cross over the disabled image, if we must or if we
7192 should. */
7193 if (dpyinfo->n_planes < 2 || cross_disabled_images)
7194 {
7195 Display *dpy = FRAME_X_DISPLAY (f);
7196 GC gc;
7197
7198 gc = XCreateGC (dpy, img->pixmap, 0, NULL);
7199 XSetForeground (dpy, gc, BLACK_PIX_DEFAULT (f));
7200 XDrawLine (dpy, img->pixmap, gc, 0, 0,
7201 img->width - 1, img->height - 1);
7202 XDrawLine (dpy, img->pixmap, gc, 0, img->height - 1,
7203 img->width - 1, 0);
7204 XFreeGC (dpy, gc);
7205
7206 if (img->mask)
7207 {
7208 gc = XCreateGC (dpy, img->mask, 0, NULL);
7209 XSetForeground (dpy, gc, WHITE_PIX_DEFAULT (f));
7210 XDrawLine (dpy, img->mask, gc, 0, 0,
7211 img->width - 1, img->height - 1);
7212 XDrawLine (dpy, img->mask, gc, 0, img->height - 1,
7213 img->width - 1, 0);
7214 XFreeGC (dpy, gc);
7215 }
7216 }
7217 }
7218
7219
7220 /* Build a mask for image IMG which is used on frame F. FILE is the
7221 name of an image file, for error messages. HOW determines how to
7222 determine the background color of IMG. If it is a list '(R G B)',
7223 with R, G, and B being integers >= 0, take that as the color of the
7224 background. Otherwise, determine the background color of IMG
7225 heuristically. Value is non-zero if successful. */
7226
7227 static int
7228 x_build_heuristic_mask (f, img, how)
7229 struct frame *f;
7230 struct image *img;
7231 Lisp_Object how;
7232 {
7233 Display *dpy = FRAME_X_DISPLAY (f);
7234 XImage *ximg, *mask_img;
7235 int x, y, rc, use_img_background;
7236 unsigned long bg = 0;
7237
7238 if (img->mask)
7239 {
7240 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
7241 img->mask = None;
7242 img->background_transparent_valid = 0;
7243 }
7244
7245 /* Create an image and pixmap serving as mask. */
7246 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1,
7247 &mask_img, &img->mask);
7248 if (!rc)
7249 return 0;
7250
7251 /* Get the X image of IMG->pixmap. */
7252 ximg = XGetImage (dpy, img->pixmap, 0, 0, img->width, img->height,
7253 ~0, ZPixmap);
7254
7255 /* Determine the background color of ximg. If HOW is `(R G B)'
7256 take that as color. Otherwise, use the image's background color. */
7257 use_img_background = 1;
7258
7259 if (CONSP (how))
7260 {
7261 int rgb[3], i;
7262
7263 for (i = 0; i < 3 && CONSP (how) && NATNUMP (XCAR (how)); ++i)
7264 {
7265 rgb[i] = XFASTINT (XCAR (how)) & 0xffff;
7266 how = XCDR (how);
7267 }
7268
7269 if (i == 3 && NILP (how))
7270 {
7271 char color_name[30];
7272 sprintf (color_name, "#%04x%04x%04x", rgb[0], rgb[1], rgb[2]);
7273 bg = x_alloc_image_color (f, img, build_string (color_name), 0);
7274 use_img_background = 0;
7275 }
7276 }
7277
7278 if (use_img_background)
7279 bg = four_corners_best (ximg, img->width, img->height);
7280
7281 /* Set all bits in mask_img to 1 whose color in ximg is different
7282 from the background color bg. */
7283 for (y = 0; y < img->height; ++y)
7284 for (x = 0; x < img->width; ++x)
7285 XPutPixel (mask_img, x, y, XGetPixel (ximg, x, y) != bg);
7286
7287 /* Fill in the background_transparent field while we have the mask handy. */
7288 image_background_transparent (img, f, mask_img);
7289
7290 /* Put mask_img into img->mask. */
7291 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
7292 x_destroy_x_image (mask_img);
7293 XDestroyImage (ximg);
7294
7295 return 1;
7296 }
7297
7298
7299 \f
7300 /***********************************************************************
7301 PBM (mono, gray, color)
7302 ***********************************************************************/
7303
7304 static int pbm_image_p P_ ((Lisp_Object object));
7305 static int pbm_load P_ ((struct frame *f, struct image *img));
7306 static int pbm_scan_number P_ ((unsigned char **, unsigned char *));
7307
7308 /* The symbol `pbm' identifying images of this type. */
7309
7310 Lisp_Object Qpbm;
7311
7312 /* Indices of image specification fields in gs_format, below. */
7313
7314 enum pbm_keyword_index
7315 {
7316 PBM_TYPE,
7317 PBM_FILE,
7318 PBM_DATA,
7319 PBM_ASCENT,
7320 PBM_MARGIN,
7321 PBM_RELIEF,
7322 PBM_ALGORITHM,
7323 PBM_HEURISTIC_MASK,
7324 PBM_MASK,
7325 PBM_FOREGROUND,
7326 PBM_BACKGROUND,
7327 PBM_LAST
7328 };
7329
7330 /* Vector of image_keyword structures describing the format
7331 of valid user-defined image specifications. */
7332
7333 static struct image_keyword pbm_format[PBM_LAST] =
7334 {
7335 {":type", IMAGE_SYMBOL_VALUE, 1},
7336 {":file", IMAGE_STRING_VALUE, 0},
7337 {":data", IMAGE_STRING_VALUE, 0},
7338 {":ascent", IMAGE_ASCENT_VALUE, 0},
7339 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
7340 {":relief", IMAGE_INTEGER_VALUE, 0},
7341 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7342 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7343 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7344 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
7345 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
7346 };
7347
7348 /* Structure describing the image type `pbm'. */
7349
7350 static struct image_type pbm_type =
7351 {
7352 &Qpbm,
7353 pbm_image_p,
7354 pbm_load,
7355 x_clear_image,
7356 NULL
7357 };
7358
7359
7360 /* Return non-zero if OBJECT is a valid PBM image specification. */
7361
7362 static int
7363 pbm_image_p (object)
7364 Lisp_Object object;
7365 {
7366 struct image_keyword fmt[PBM_LAST];
7367
7368 bcopy (pbm_format, fmt, sizeof fmt);
7369
7370 if (!parse_image_spec (object, fmt, PBM_LAST, Qpbm))
7371 return 0;
7372
7373 /* Must specify either :data or :file. */
7374 return fmt[PBM_DATA].count + fmt[PBM_FILE].count == 1;
7375 }
7376
7377
7378 /* Scan a decimal number from *S and return it. Advance *S while
7379 reading the number. END is the end of the string. Value is -1 at
7380 end of input. */
7381
7382 static int
7383 pbm_scan_number (s, end)
7384 unsigned char **s, *end;
7385 {
7386 int c = 0, val = -1;
7387
7388 while (*s < end)
7389 {
7390 /* Skip white-space. */
7391 while (*s < end && (c = *(*s)++, isspace (c)))
7392 ;
7393
7394 if (c == '#')
7395 {
7396 /* Skip comment to end of line. */
7397 while (*s < end && (c = *(*s)++, c != '\n'))
7398 ;
7399 }
7400 else if (isdigit (c))
7401 {
7402 /* Read decimal number. */
7403 val = c - '0';
7404 while (*s < end && (c = *(*s)++, isdigit (c)))
7405 val = 10 * val + c - '0';
7406 break;
7407 }
7408 else
7409 break;
7410 }
7411
7412 return val;
7413 }
7414
7415
7416 /* Load PBM image IMG for use on frame F. */
7417
7418 static int
7419 pbm_load (f, img)
7420 struct frame *f;
7421 struct image *img;
7422 {
7423 int raw_p, x, y;
7424 int width, height, max_color_idx = 0;
7425 XImage *ximg;
7426 Lisp_Object file, specified_file;
7427 enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type;
7428 struct gcpro gcpro1;
7429 unsigned char *contents = NULL;
7430 unsigned char *end, *p;
7431 int size;
7432
7433 specified_file = image_spec_value (img->spec, QCfile, NULL);
7434 file = Qnil;
7435 GCPRO1 (file);
7436
7437 if (STRINGP (specified_file))
7438 {
7439 file = x_find_image_file (specified_file);
7440 if (!STRINGP (file))
7441 {
7442 image_error ("Cannot find image file `%s'", specified_file, Qnil);
7443 UNGCPRO;
7444 return 0;
7445 }
7446
7447 contents = slurp_file (SDATA (file), &size);
7448 if (contents == NULL)
7449 {
7450 image_error ("Error reading `%s'", file, Qnil);
7451 UNGCPRO;
7452 return 0;
7453 }
7454
7455 p = contents;
7456 end = contents + size;
7457 }
7458 else
7459 {
7460 Lisp_Object data;
7461 data = image_spec_value (img->spec, QCdata, NULL);
7462 p = SDATA (data);
7463 end = p + SBYTES (data);
7464 }
7465
7466 /* Check magic number. */
7467 if (end - p < 2 || *p++ != 'P')
7468 {
7469 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
7470 error:
7471 xfree (contents);
7472 UNGCPRO;
7473 return 0;
7474 }
7475
7476 switch (*p++)
7477 {
7478 case '1':
7479 raw_p = 0, type = PBM_MONO;
7480 break;
7481
7482 case '2':
7483 raw_p = 0, type = PBM_GRAY;
7484 break;
7485
7486 case '3':
7487 raw_p = 0, type = PBM_COLOR;
7488 break;
7489
7490 case '4':
7491 raw_p = 1, type = PBM_MONO;
7492 break;
7493
7494 case '5':
7495 raw_p = 1, type = PBM_GRAY;
7496 break;
7497
7498 case '6':
7499 raw_p = 1, type = PBM_COLOR;
7500 break;
7501
7502 default:
7503 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
7504 goto error;
7505 }
7506
7507 /* Read width, height, maximum color-component. Characters
7508 starting with `#' up to the end of a line are ignored. */
7509 width = pbm_scan_number (&p, end);
7510 height = pbm_scan_number (&p, end);
7511
7512 if (type != PBM_MONO)
7513 {
7514 max_color_idx = pbm_scan_number (&p, end);
7515 if (raw_p && max_color_idx > 255)
7516 max_color_idx = 255;
7517 }
7518
7519 if (width < 0
7520 || height < 0
7521 || (type != PBM_MONO && max_color_idx < 0))
7522 goto error;
7523
7524 if (!x_create_x_image_and_pixmap (f, width, height, 0,
7525 &ximg, &img->pixmap))
7526 goto error;
7527
7528 /* Initialize the color hash table. */
7529 init_color_table ();
7530
7531 if (type == PBM_MONO)
7532 {
7533 int c = 0, g;
7534 struct image_keyword fmt[PBM_LAST];
7535 unsigned long fg = FRAME_FOREGROUND_PIXEL (f);
7536 unsigned long bg = FRAME_BACKGROUND_PIXEL (f);
7537
7538 /* Parse the image specification. */
7539 bcopy (pbm_format, fmt, sizeof fmt);
7540 parse_image_spec (img->spec, fmt, PBM_LAST, Qpbm);
7541
7542 /* Get foreground and background colors, maybe allocate colors. */
7543 if (fmt[PBM_FOREGROUND].count
7544 && STRINGP (fmt[PBM_FOREGROUND].value))
7545 fg = x_alloc_image_color (f, img, fmt[PBM_FOREGROUND].value, fg);
7546 if (fmt[PBM_BACKGROUND].count
7547 && STRINGP (fmt[PBM_BACKGROUND].value))
7548 {
7549 bg = x_alloc_image_color (f, img, fmt[PBM_BACKGROUND].value, bg);
7550 img->background = bg;
7551 img->background_valid = 1;
7552 }
7553
7554 for (y = 0; y < height; ++y)
7555 for (x = 0; x < width; ++x)
7556 {
7557 if (raw_p)
7558 {
7559 if ((x & 7) == 0)
7560 c = *p++;
7561 g = c & 0x80;
7562 c <<= 1;
7563 }
7564 else
7565 g = pbm_scan_number (&p, end);
7566
7567 XPutPixel (ximg, x, y, g ? fg : bg);
7568 }
7569 }
7570 else
7571 {
7572 for (y = 0; y < height; ++y)
7573 for (x = 0; x < width; ++x)
7574 {
7575 int r, g, b;
7576
7577 if (type == PBM_GRAY)
7578 r = g = b = raw_p ? *p++ : pbm_scan_number (&p, end);
7579 else if (raw_p)
7580 {
7581 r = *p++;
7582 g = *p++;
7583 b = *p++;
7584 }
7585 else
7586 {
7587 r = pbm_scan_number (&p, end);
7588 g = pbm_scan_number (&p, end);
7589 b = pbm_scan_number (&p, end);
7590 }
7591
7592 if (r < 0 || g < 0 || b < 0)
7593 {
7594 xfree (ximg->data);
7595 ximg->data = NULL;
7596 XDestroyImage (ximg);
7597 image_error ("Invalid pixel value in image `%s'",
7598 img->spec, Qnil);
7599 goto error;
7600 }
7601
7602 /* RGB values are now in the range 0..max_color_idx.
7603 Scale this to the range 0..0xffff supported by X. */
7604 r = (double) r * 65535 / max_color_idx;
7605 g = (double) g * 65535 / max_color_idx;
7606 b = (double) b * 65535 / max_color_idx;
7607 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
7608 }
7609 }
7610
7611 /* Store in IMG->colors the colors allocated for the image, and
7612 free the color table. */
7613 img->colors = colors_in_color_table (&img->ncolors);
7614 free_color_table ();
7615
7616 /* Maybe fill in the background field while we have ximg handy. */
7617 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
7618 IMAGE_BACKGROUND (img, f, ximg);
7619
7620 /* Put the image into a pixmap. */
7621 x_put_x_image (f, ximg, img->pixmap, width, height);
7622 x_destroy_x_image (ximg);
7623
7624 img->width = width;
7625 img->height = height;
7626
7627 UNGCPRO;
7628 xfree (contents);
7629 return 1;
7630 }
7631
7632
7633 \f
7634 /***********************************************************************
7635 PNG
7636 ***********************************************************************/
7637
7638 #if HAVE_PNG
7639
7640 #if defined HAVE_LIBPNG_PNG_H
7641 # include <libpng/png.h>
7642 #else
7643 # include <png.h>
7644 #endif
7645
7646 /* Function prototypes. */
7647
7648 static int png_image_p P_ ((Lisp_Object object));
7649 static int png_load P_ ((struct frame *f, struct image *img));
7650
7651 /* The symbol `png' identifying images of this type. */
7652
7653 Lisp_Object Qpng;
7654
7655 /* Indices of image specification fields in png_format, below. */
7656
7657 enum png_keyword_index
7658 {
7659 PNG_TYPE,
7660 PNG_DATA,
7661 PNG_FILE,
7662 PNG_ASCENT,
7663 PNG_MARGIN,
7664 PNG_RELIEF,
7665 PNG_ALGORITHM,
7666 PNG_HEURISTIC_MASK,
7667 PNG_MASK,
7668 PNG_BACKGROUND,
7669 PNG_LAST
7670 };
7671
7672 /* Vector of image_keyword structures describing the format
7673 of valid user-defined image specifications. */
7674
7675 static struct image_keyword png_format[PNG_LAST] =
7676 {
7677 {":type", IMAGE_SYMBOL_VALUE, 1},
7678 {":data", IMAGE_STRING_VALUE, 0},
7679 {":file", IMAGE_STRING_VALUE, 0},
7680 {":ascent", IMAGE_ASCENT_VALUE, 0},
7681 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
7682 {":relief", IMAGE_INTEGER_VALUE, 0},
7683 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7684 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7685 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7686 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
7687 };
7688
7689 /* Structure describing the image type `png'. */
7690
7691 static struct image_type png_type =
7692 {
7693 &Qpng,
7694 png_image_p,
7695 png_load,
7696 x_clear_image,
7697 NULL
7698 };
7699
7700
7701 /* Return non-zero if OBJECT is a valid PNG image specification. */
7702
7703 static int
7704 png_image_p (object)
7705 Lisp_Object object;
7706 {
7707 struct image_keyword fmt[PNG_LAST];
7708 bcopy (png_format, fmt, sizeof fmt);
7709
7710 if (!parse_image_spec (object, fmt, PNG_LAST, Qpng))
7711 return 0;
7712
7713 /* Must specify either the :data or :file keyword. */
7714 return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
7715 }
7716
7717
7718 /* Error and warning handlers installed when the PNG library
7719 is initialized. */
7720
7721 static void
7722 my_png_error (png_ptr, msg)
7723 png_struct *png_ptr;
7724 char *msg;
7725 {
7726 xassert (png_ptr != NULL);
7727 image_error ("PNG error: %s", build_string (msg), Qnil);
7728 longjmp (png_ptr->jmpbuf, 1);
7729 }
7730
7731
7732 static void
7733 my_png_warning (png_ptr, msg)
7734 png_struct *png_ptr;
7735 char *msg;
7736 {
7737 xassert (png_ptr != NULL);
7738 image_error ("PNG warning: %s", build_string (msg), Qnil);
7739 }
7740
7741 /* Memory source for PNG decoding. */
7742
7743 struct png_memory_storage
7744 {
7745 unsigned char *bytes; /* The data */
7746 size_t len; /* How big is it? */
7747 int index; /* Where are we? */
7748 };
7749
7750
7751 /* Function set as reader function when reading PNG image from memory.
7752 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
7753 bytes from the input to DATA. */
7754
7755 static void
7756 png_read_from_memory (png_ptr, data, length)
7757 png_structp png_ptr;
7758 png_bytep data;
7759 png_size_t length;
7760 {
7761 struct png_memory_storage *tbr
7762 = (struct png_memory_storage *) png_get_io_ptr (png_ptr);
7763
7764 if (length > tbr->len - tbr->index)
7765 png_error (png_ptr, "Read error");
7766
7767 bcopy (tbr->bytes + tbr->index, data, length);
7768 tbr->index = tbr->index + length;
7769 }
7770
7771 /* Load PNG image IMG for use on frame F. Value is non-zero if
7772 successful. */
7773
7774 static int
7775 png_load (f, img)
7776 struct frame *f;
7777 struct image *img;
7778 {
7779 Lisp_Object file, specified_file;
7780 Lisp_Object specified_data;
7781 int x, y, i;
7782 XImage *ximg, *mask_img = NULL;
7783 struct gcpro gcpro1;
7784 png_struct *png_ptr = NULL;
7785 png_info *info_ptr = NULL, *end_info = NULL;
7786 FILE *volatile fp = NULL;
7787 png_byte sig[8];
7788 png_byte * volatile pixels = NULL;
7789 png_byte ** volatile rows = NULL;
7790 png_uint_32 width, height;
7791 int bit_depth, color_type, interlace_type;
7792 png_byte channels;
7793 png_uint_32 row_bytes;
7794 int transparent_p;
7795 double screen_gamma;
7796 struct png_memory_storage tbr; /* Data to be read */
7797
7798 /* Find out what file to load. */
7799 specified_file = image_spec_value (img->spec, QCfile, NULL);
7800 specified_data = image_spec_value (img->spec, QCdata, NULL);
7801 file = Qnil;
7802 GCPRO1 (file);
7803
7804 if (NILP (specified_data))
7805 {
7806 file = x_find_image_file (specified_file);
7807 if (!STRINGP (file))
7808 {
7809 image_error ("Cannot find image file `%s'", specified_file, Qnil);
7810 UNGCPRO;
7811 return 0;
7812 }
7813
7814 /* Open the image file. */
7815 fp = fopen (SDATA (file), "rb");
7816 if (!fp)
7817 {
7818 image_error ("Cannot open image file `%s'", file, Qnil);
7819 UNGCPRO;
7820 fclose (fp);
7821 return 0;
7822 }
7823
7824 /* Check PNG signature. */
7825 if (fread (sig, 1, sizeof sig, fp) != sizeof sig
7826 || !png_check_sig (sig, sizeof sig))
7827 {
7828 image_error ("Not a PNG file: `%s'", file, Qnil);
7829 UNGCPRO;
7830 fclose (fp);
7831 return 0;
7832 }
7833 }
7834 else
7835 {
7836 /* Read from memory. */
7837 tbr.bytes = SDATA (specified_data);
7838 tbr.len = SBYTES (specified_data);
7839 tbr.index = 0;
7840
7841 /* Check PNG signature. */
7842 if (tbr.len < sizeof sig
7843 || !png_check_sig (tbr.bytes, sizeof sig))
7844 {
7845 image_error ("Not a PNG image: `%s'", img->spec, Qnil);
7846 UNGCPRO;
7847 return 0;
7848 }
7849
7850 /* Need to skip past the signature. */
7851 tbr.bytes += sizeof (sig);
7852 }
7853
7854 /* Initialize read and info structs for PNG lib. */
7855 png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL,
7856 my_png_error, my_png_warning);
7857 if (!png_ptr)
7858 {
7859 if (fp) fclose (fp);
7860 UNGCPRO;
7861 return 0;
7862 }
7863
7864 info_ptr = png_create_info_struct (png_ptr);
7865 if (!info_ptr)
7866 {
7867 png_destroy_read_struct (&png_ptr, NULL, NULL);
7868 if (fp) fclose (fp);
7869 UNGCPRO;
7870 return 0;
7871 }
7872
7873 end_info = png_create_info_struct (png_ptr);
7874 if (!end_info)
7875 {
7876 png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
7877 if (fp) fclose (fp);
7878 UNGCPRO;
7879 return 0;
7880 }
7881
7882 /* Set error jump-back. We come back here when the PNG library
7883 detects an error. */
7884 if (setjmp (png_ptr->jmpbuf))
7885 {
7886 error:
7887 if (png_ptr)
7888 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
7889 xfree (pixels);
7890 xfree (rows);
7891 if (fp) fclose (fp);
7892 UNGCPRO;
7893 return 0;
7894 }
7895
7896 /* Read image info. */
7897 if (!NILP (specified_data))
7898 png_set_read_fn (png_ptr, (void *) &tbr, png_read_from_memory);
7899 else
7900 png_init_io (png_ptr, fp);
7901
7902 png_set_sig_bytes (png_ptr, sizeof sig);
7903 png_read_info (png_ptr, info_ptr);
7904 png_get_IHDR (png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
7905 &interlace_type, NULL, NULL);
7906
7907 /* If image contains simply transparency data, we prefer to
7908 construct a clipping mask. */
7909 if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
7910 transparent_p = 1;
7911 else
7912 transparent_p = 0;
7913
7914 /* This function is easier to write if we only have to handle
7915 one data format: RGB or RGBA with 8 bits per channel. Let's
7916 transform other formats into that format. */
7917
7918 /* Strip more than 8 bits per channel. */
7919 if (bit_depth == 16)
7920 png_set_strip_16 (png_ptr);
7921
7922 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
7923 if available. */
7924 png_set_expand (png_ptr);
7925
7926 /* Convert grayscale images to RGB. */
7927 if (color_type == PNG_COLOR_TYPE_GRAY
7928 || color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
7929 png_set_gray_to_rgb (png_ptr);
7930
7931 screen_gamma = (f->gamma ? 1 / f->gamma / 0.45455 : 2.2);
7932
7933 #if 0 /* Avoid double gamma correction for PNG images. */
7934 { /* Tell the PNG lib to handle gamma correction for us. */
7935 int intent;
7936 double image_gamma;
7937 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
7938 if (png_get_sRGB (png_ptr, info_ptr, &intent))
7939 /* The libpng documentation says this is right in this case. */
7940 png_set_gamma (png_ptr, screen_gamma, 0.45455);
7941 else
7942 #endif
7943 if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
7944 /* Image contains gamma information. */
7945 png_set_gamma (png_ptr, screen_gamma, image_gamma);
7946 else
7947 /* Use the standard default for the image gamma. */
7948 png_set_gamma (png_ptr, screen_gamma, 0.45455);
7949 }
7950 #endif /* if 0 */
7951
7952 /* Handle alpha channel by combining the image with a background
7953 color. Do this only if a real alpha channel is supplied. For
7954 simple transparency, we prefer a clipping mask. */
7955 if (!transparent_p)
7956 {
7957 png_color_16 *image_bg;
7958 Lisp_Object specified_bg
7959 = image_spec_value (img->spec, QCbackground, NULL);
7960
7961 if (STRINGP (specified_bg))
7962 /* The user specified `:background', use that. */
7963 {
7964 XColor color;
7965 if (x_defined_color (f, SDATA (specified_bg), &color, 0))
7966 {
7967 png_color_16 user_bg;
7968
7969 bzero (&user_bg, sizeof user_bg);
7970 user_bg.red = color.red;
7971 user_bg.green = color.green;
7972 user_bg.blue = color.blue;
7973
7974 png_set_background (png_ptr, &user_bg,
7975 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
7976 }
7977 }
7978 else if (png_get_bKGD (png_ptr, info_ptr, &image_bg))
7979 /* Image contains a background color with which to
7980 combine the image. */
7981 png_set_background (png_ptr, image_bg,
7982 PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
7983 else
7984 {
7985 /* Image does not contain a background color with which
7986 to combine the image data via an alpha channel. Use
7987 the frame's background instead. */
7988 XColor color;
7989 Colormap cmap;
7990 png_color_16 frame_background;
7991
7992 cmap = FRAME_X_COLORMAP (f);
7993 color.pixel = FRAME_BACKGROUND_PIXEL (f);
7994 x_query_color (f, &color);
7995
7996 bzero (&frame_background, sizeof frame_background);
7997 frame_background.red = color.red;
7998 frame_background.green = color.green;
7999 frame_background.blue = color.blue;
8000
8001 png_set_background (png_ptr, &frame_background,
8002 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
8003 }
8004 }
8005
8006 /* Update info structure. */
8007 png_read_update_info (png_ptr, info_ptr);
8008
8009 /* Get number of channels. Valid values are 1 for grayscale images
8010 and images with a palette, 2 for grayscale images with transparency
8011 information (alpha channel), 3 for RGB images, and 4 for RGB
8012 images with alpha channel, i.e. RGBA. If conversions above were
8013 sufficient we should only have 3 or 4 channels here. */
8014 channels = png_get_channels (png_ptr, info_ptr);
8015 xassert (channels == 3 || channels == 4);
8016
8017 /* Number of bytes needed for one row of the image. */
8018 row_bytes = png_get_rowbytes (png_ptr, info_ptr);
8019
8020 /* Allocate memory for the image. */
8021 pixels = (png_byte *) xmalloc (row_bytes * height * sizeof *pixels);
8022 rows = (png_byte **) xmalloc (height * sizeof *rows);
8023 for (i = 0; i < height; ++i)
8024 rows[i] = pixels + i * row_bytes;
8025
8026 /* Read the entire image. */
8027 png_read_image (png_ptr, rows);
8028 png_read_end (png_ptr, info_ptr);
8029 if (fp)
8030 {
8031 fclose (fp);
8032 fp = NULL;
8033 }
8034
8035 /* Create the X image and pixmap. */
8036 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
8037 &img->pixmap))
8038 goto error;
8039
8040 /* Create an image and pixmap serving as mask if the PNG image
8041 contains an alpha channel. */
8042 if (channels == 4
8043 && !transparent_p
8044 && !x_create_x_image_and_pixmap (f, width, height, 1,
8045 &mask_img, &img->mask))
8046 {
8047 x_destroy_x_image (ximg);
8048 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
8049 img->pixmap = None;
8050 goto error;
8051 }
8052
8053 /* Fill the X image and mask from PNG data. */
8054 init_color_table ();
8055
8056 for (y = 0; y < height; ++y)
8057 {
8058 png_byte *p = rows[y];
8059
8060 for (x = 0; x < width; ++x)
8061 {
8062 unsigned r, g, b;
8063
8064 r = *p++ << 8;
8065 g = *p++ << 8;
8066 b = *p++ << 8;
8067 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
8068
8069 /* An alpha channel, aka mask channel, associates variable
8070 transparency with an image. Where other image formats
8071 support binary transparency---fully transparent or fully
8072 opaque---PNG allows up to 254 levels of partial transparency.
8073 The PNG library implements partial transparency by combining
8074 the image with a specified background color.
8075
8076 I'm not sure how to handle this here nicely: because the
8077 background on which the image is displayed may change, for
8078 real alpha channel support, it would be necessary to create
8079 a new image for each possible background.
8080
8081 What I'm doing now is that a mask is created if we have
8082 boolean transparency information. Otherwise I'm using
8083 the frame's background color to combine the image with. */
8084
8085 if (channels == 4)
8086 {
8087 if (mask_img)
8088 XPutPixel (mask_img, x, y, *p > 0);
8089 ++p;
8090 }
8091 }
8092 }
8093
8094 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
8095 /* Set IMG's background color from the PNG image, unless the user
8096 overrode it. */
8097 {
8098 png_color_16 *bg;
8099 if (png_get_bKGD (png_ptr, info_ptr, &bg))
8100 {
8101 img->background = lookup_rgb_color (f, bg->red, bg->green, bg->blue);
8102 img->background_valid = 1;
8103 }
8104 }
8105
8106 /* Remember colors allocated for this image. */
8107 img->colors = colors_in_color_table (&img->ncolors);
8108 free_color_table ();
8109
8110 /* Clean up. */
8111 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
8112 xfree (rows);
8113 xfree (pixels);
8114
8115 img->width = width;
8116 img->height = height;
8117
8118 /* Maybe fill in the background field while we have ximg handy. */
8119 IMAGE_BACKGROUND (img, f, ximg);
8120
8121 /* Put the image into the pixmap, then free the X image and its buffer. */
8122 x_put_x_image (f, ximg, img->pixmap, width, height);
8123 x_destroy_x_image (ximg);
8124
8125 /* Same for the mask. */
8126 if (mask_img)
8127 {
8128 /* Fill in the background_transparent field while we have the mask
8129 handy. */
8130 image_background_transparent (img, f, mask_img);
8131
8132 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
8133 x_destroy_x_image (mask_img);
8134 }
8135
8136 UNGCPRO;
8137 return 1;
8138 }
8139
8140 #endif /* HAVE_PNG != 0 */
8141
8142
8143 \f
8144 /***********************************************************************
8145 JPEG
8146 ***********************************************************************/
8147
8148 #if HAVE_JPEG
8149
8150 /* Work around a warning about HAVE_STDLIB_H being redefined in
8151 jconfig.h. */
8152 #ifdef HAVE_STDLIB_H
8153 #define HAVE_STDLIB_H_1
8154 #undef HAVE_STDLIB_H
8155 #endif /* HAVE_STLIB_H */
8156
8157 #include <jpeglib.h>
8158 #include <jerror.h>
8159 #include <setjmp.h>
8160
8161 #ifdef HAVE_STLIB_H_1
8162 #define HAVE_STDLIB_H 1
8163 #endif
8164
8165 static int jpeg_image_p P_ ((Lisp_Object object));
8166 static int jpeg_load P_ ((struct frame *f, struct image *img));
8167
8168 /* The symbol `jpeg' identifying images of this type. */
8169
8170 Lisp_Object Qjpeg;
8171
8172 /* Indices of image specification fields in gs_format, below. */
8173
8174 enum jpeg_keyword_index
8175 {
8176 JPEG_TYPE,
8177 JPEG_DATA,
8178 JPEG_FILE,
8179 JPEG_ASCENT,
8180 JPEG_MARGIN,
8181 JPEG_RELIEF,
8182 JPEG_ALGORITHM,
8183 JPEG_HEURISTIC_MASK,
8184 JPEG_MASK,
8185 JPEG_BACKGROUND,
8186 JPEG_LAST
8187 };
8188
8189 /* Vector of image_keyword structures describing the format
8190 of valid user-defined image specifications. */
8191
8192 static struct image_keyword jpeg_format[JPEG_LAST] =
8193 {
8194 {":type", IMAGE_SYMBOL_VALUE, 1},
8195 {":data", IMAGE_STRING_VALUE, 0},
8196 {":file", IMAGE_STRING_VALUE, 0},
8197 {":ascent", IMAGE_ASCENT_VALUE, 0},
8198 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
8199 {":relief", IMAGE_INTEGER_VALUE, 0},
8200 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8201 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8202 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8203 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
8204 };
8205
8206 /* Structure describing the image type `jpeg'. */
8207
8208 static struct image_type jpeg_type =
8209 {
8210 &Qjpeg,
8211 jpeg_image_p,
8212 jpeg_load,
8213 x_clear_image,
8214 NULL
8215 };
8216
8217
8218 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8219
8220 static int
8221 jpeg_image_p (object)
8222 Lisp_Object object;
8223 {
8224 struct image_keyword fmt[JPEG_LAST];
8225
8226 bcopy (jpeg_format, fmt, sizeof fmt);
8227
8228 if (!parse_image_spec (object, fmt, JPEG_LAST, Qjpeg))
8229 return 0;
8230
8231 /* Must specify either the :data or :file keyword. */
8232 return fmt[JPEG_FILE].count + fmt[JPEG_DATA].count == 1;
8233 }
8234
8235
8236 struct my_jpeg_error_mgr
8237 {
8238 struct jpeg_error_mgr pub;
8239 jmp_buf setjmp_buffer;
8240 };
8241
8242
8243 static void
8244 my_error_exit (cinfo)
8245 j_common_ptr cinfo;
8246 {
8247 struct my_jpeg_error_mgr *mgr = (struct my_jpeg_error_mgr *) cinfo->err;
8248 longjmp (mgr->setjmp_buffer, 1);
8249 }
8250
8251
8252 /* Init source method for JPEG data source manager. Called by
8253 jpeg_read_header() before any data is actually read. See
8254 libjpeg.doc from the JPEG lib distribution. */
8255
8256 static void
8257 our_init_source (cinfo)
8258 j_decompress_ptr cinfo;
8259 {
8260 }
8261
8262
8263 /* Fill input buffer method for JPEG data source manager. Called
8264 whenever more data is needed. We read the whole image in one step,
8265 so this only adds a fake end of input marker at the end. */
8266
8267 static boolean
8268 our_fill_input_buffer (cinfo)
8269 j_decompress_ptr cinfo;
8270 {
8271 /* Insert a fake EOI marker. */
8272 struct jpeg_source_mgr *src = cinfo->src;
8273 static JOCTET buffer[2];
8274
8275 buffer[0] = (JOCTET) 0xFF;
8276 buffer[1] = (JOCTET) JPEG_EOI;
8277
8278 src->next_input_byte = buffer;
8279 src->bytes_in_buffer = 2;
8280 return TRUE;
8281 }
8282
8283
8284 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8285 is the JPEG data source manager. */
8286
8287 static void
8288 our_skip_input_data (cinfo, num_bytes)
8289 j_decompress_ptr cinfo;
8290 long num_bytes;
8291 {
8292 struct jpeg_source_mgr *src = (struct jpeg_source_mgr *) cinfo->src;
8293
8294 if (src)
8295 {
8296 if (num_bytes > src->bytes_in_buffer)
8297 ERREXIT (cinfo, JERR_INPUT_EOF);
8298
8299 src->bytes_in_buffer -= num_bytes;
8300 src->next_input_byte += num_bytes;
8301 }
8302 }
8303
8304
8305 /* Method to terminate data source. Called by
8306 jpeg_finish_decompress() after all data has been processed. */
8307
8308 static void
8309 our_term_source (cinfo)
8310 j_decompress_ptr cinfo;
8311 {
8312 }
8313
8314
8315 /* Set up the JPEG lib for reading an image from DATA which contains
8316 LEN bytes. CINFO is the decompression info structure created for
8317 reading the image. */
8318
8319 static void
8320 jpeg_memory_src (cinfo, data, len)
8321 j_decompress_ptr cinfo;
8322 JOCTET *data;
8323 unsigned int len;
8324 {
8325 struct jpeg_source_mgr *src;
8326
8327 if (cinfo->src == NULL)
8328 {
8329 /* First time for this JPEG object? */
8330 cinfo->src = (struct jpeg_source_mgr *)
8331 (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,
8332 sizeof (struct jpeg_source_mgr));
8333 src = (struct jpeg_source_mgr *) cinfo->src;
8334 src->next_input_byte = data;
8335 }
8336
8337 src = (struct jpeg_source_mgr *) cinfo->src;
8338 src->init_source = our_init_source;
8339 src->fill_input_buffer = our_fill_input_buffer;
8340 src->skip_input_data = our_skip_input_data;
8341 src->resync_to_restart = jpeg_resync_to_restart; /* Use default method. */
8342 src->term_source = our_term_source;
8343 src->bytes_in_buffer = len;
8344 src->next_input_byte = data;
8345 }
8346
8347
8348 /* Load image IMG for use on frame F. Patterned after example.c
8349 from the JPEG lib. */
8350
8351 static int
8352 jpeg_load (f, img)
8353 struct frame *f;
8354 struct image *img;
8355 {
8356 struct jpeg_decompress_struct cinfo;
8357 struct my_jpeg_error_mgr mgr;
8358 Lisp_Object file, specified_file;
8359 Lisp_Object specified_data;
8360 FILE * volatile fp = NULL;
8361 JSAMPARRAY buffer;
8362 int row_stride, x, y;
8363 XImage *ximg = NULL;
8364 int rc;
8365 unsigned long *colors;
8366 int width, height;
8367 struct gcpro gcpro1;
8368
8369 /* Open the JPEG file. */
8370 specified_file = image_spec_value (img->spec, QCfile, NULL);
8371 specified_data = image_spec_value (img->spec, QCdata, NULL);
8372 file = Qnil;
8373 GCPRO1 (file);
8374
8375 if (NILP (specified_data))
8376 {
8377 file = x_find_image_file (specified_file);
8378 if (!STRINGP (file))
8379 {
8380 image_error ("Cannot find image file `%s'", specified_file, Qnil);
8381 UNGCPRO;
8382 return 0;
8383 }
8384
8385 fp = fopen (SDATA (file), "r");
8386 if (fp == NULL)
8387 {
8388 image_error ("Cannot open `%s'", file, Qnil);
8389 UNGCPRO;
8390 return 0;
8391 }
8392 }
8393
8394 /* Customize libjpeg's error handling to call my_error_exit when an
8395 error is detected. This function will perform a longjmp. */
8396 cinfo.err = jpeg_std_error (&mgr.pub);
8397 mgr.pub.error_exit = my_error_exit;
8398
8399 if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
8400 {
8401 if (rc == 1)
8402 {
8403 /* Called from my_error_exit. Display a JPEG error. */
8404 char buffer[JMSG_LENGTH_MAX];
8405 cinfo.err->format_message ((j_common_ptr) &cinfo, buffer);
8406 image_error ("Error reading JPEG image `%s': %s", img->spec,
8407 build_string (buffer));
8408 }
8409
8410 /* Close the input file and destroy the JPEG object. */
8411 if (fp)
8412 fclose ((FILE *) fp);
8413 jpeg_destroy_decompress (&cinfo);
8414
8415 /* If we already have an XImage, free that. */
8416 x_destroy_x_image (ximg);
8417
8418 /* Free pixmap and colors. */
8419 x_clear_image (f, img);
8420
8421 UNGCPRO;
8422 return 0;
8423 }
8424
8425 /* Create the JPEG decompression object. Let it read from fp.
8426 Read the JPEG image header. */
8427 jpeg_create_decompress (&cinfo);
8428
8429 if (NILP (specified_data))
8430 jpeg_stdio_src (&cinfo, (FILE *) fp);
8431 else
8432 jpeg_memory_src (&cinfo, SDATA (specified_data),
8433 SBYTES (specified_data));
8434
8435 jpeg_read_header (&cinfo, TRUE);
8436
8437 /* Customize decompression so that color quantization will be used.
8438 Start decompression. */
8439 cinfo.quantize_colors = TRUE;
8440 jpeg_start_decompress (&cinfo);
8441 width = img->width = cinfo.output_width;
8442 height = img->height = cinfo.output_height;
8443
8444 /* Create X image and pixmap. */
8445 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
8446 longjmp (mgr.setjmp_buffer, 2);
8447
8448 /* Allocate colors. When color quantization is used,
8449 cinfo.actual_number_of_colors has been set with the number of
8450 colors generated, and cinfo.colormap is a two-dimensional array
8451 of color indices in the range 0..cinfo.actual_number_of_colors.
8452 No more than 255 colors will be generated. */
8453 {
8454 int i, ir, ig, ib;
8455
8456 if (cinfo.out_color_components > 2)
8457 ir = 0, ig = 1, ib = 2;
8458 else if (cinfo.out_color_components > 1)
8459 ir = 0, ig = 1, ib = 0;
8460 else
8461 ir = 0, ig = 0, ib = 0;
8462
8463 /* Use the color table mechanism because it handles colors that
8464 cannot be allocated nicely. Such colors will be replaced with
8465 a default color, and we don't have to care about which colors
8466 can be freed safely, and which can't. */
8467 init_color_table ();
8468 colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
8469 * sizeof *colors);
8470
8471 for (i = 0; i < cinfo.actual_number_of_colors; ++i)
8472 {
8473 /* Multiply RGB values with 255 because X expects RGB values
8474 in the range 0..0xffff. */
8475 int r = cinfo.colormap[ir][i] << 8;
8476 int g = cinfo.colormap[ig][i] << 8;
8477 int b = cinfo.colormap[ib][i] << 8;
8478 colors[i] = lookup_rgb_color (f, r, g, b);
8479 }
8480
8481 /* Remember those colors actually allocated. */
8482 img->colors = colors_in_color_table (&img->ncolors);
8483 free_color_table ();
8484 }
8485
8486 /* Read pixels. */
8487 row_stride = width * cinfo.output_components;
8488 buffer = cinfo.mem->alloc_sarray ((j_common_ptr) &cinfo, JPOOL_IMAGE,
8489 row_stride, 1);
8490 for (y = 0; y < height; ++y)
8491 {
8492 jpeg_read_scanlines (&cinfo, buffer, 1);
8493 for (x = 0; x < cinfo.output_width; ++x)
8494 XPutPixel (ximg, x, y, colors[buffer[0][x]]);
8495 }
8496
8497 /* Clean up. */
8498 jpeg_finish_decompress (&cinfo);
8499 jpeg_destroy_decompress (&cinfo);
8500 if (fp)
8501 fclose ((FILE *) fp);
8502
8503 /* Maybe fill in the background field while we have ximg handy. */
8504 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
8505 IMAGE_BACKGROUND (img, f, ximg);
8506
8507 /* Put the image into the pixmap. */
8508 x_put_x_image (f, ximg, img->pixmap, width, height);
8509 x_destroy_x_image (ximg);
8510 UNGCPRO;
8511 return 1;
8512 }
8513
8514 #endif /* HAVE_JPEG */
8515
8516
8517 \f
8518 /***********************************************************************
8519 TIFF
8520 ***********************************************************************/
8521
8522 #if HAVE_TIFF
8523
8524 #include <tiffio.h>
8525
8526 static int tiff_image_p P_ ((Lisp_Object object));
8527 static int tiff_load P_ ((struct frame *f, struct image *img));
8528
8529 /* The symbol `tiff' identifying images of this type. */
8530
8531 Lisp_Object Qtiff;
8532
8533 /* Indices of image specification fields in tiff_format, below. */
8534
8535 enum tiff_keyword_index
8536 {
8537 TIFF_TYPE,
8538 TIFF_DATA,
8539 TIFF_FILE,
8540 TIFF_ASCENT,
8541 TIFF_MARGIN,
8542 TIFF_RELIEF,
8543 TIFF_ALGORITHM,
8544 TIFF_HEURISTIC_MASK,
8545 TIFF_MASK,
8546 TIFF_BACKGROUND,
8547 TIFF_LAST
8548 };
8549
8550 /* Vector of image_keyword structures describing the format
8551 of valid user-defined image specifications. */
8552
8553 static struct image_keyword tiff_format[TIFF_LAST] =
8554 {
8555 {":type", IMAGE_SYMBOL_VALUE, 1},
8556 {":data", IMAGE_STRING_VALUE, 0},
8557 {":file", IMAGE_STRING_VALUE, 0},
8558 {":ascent", IMAGE_ASCENT_VALUE, 0},
8559 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
8560 {":relief", IMAGE_INTEGER_VALUE, 0},
8561 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8562 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8563 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8564 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
8565 };
8566
8567 /* Structure describing the image type `tiff'. */
8568
8569 static struct image_type tiff_type =
8570 {
8571 &Qtiff,
8572 tiff_image_p,
8573 tiff_load,
8574 x_clear_image,
8575 NULL
8576 };
8577
8578
8579 /* Return non-zero if OBJECT is a valid TIFF image specification. */
8580
8581 static int
8582 tiff_image_p (object)
8583 Lisp_Object object;
8584 {
8585 struct image_keyword fmt[TIFF_LAST];
8586 bcopy (tiff_format, fmt, sizeof fmt);
8587
8588 if (!parse_image_spec (object, fmt, TIFF_LAST, Qtiff))
8589 return 0;
8590
8591 /* Must specify either the :data or :file keyword. */
8592 return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
8593 }
8594
8595
8596 /* Reading from a memory buffer for TIFF images Based on the PNG
8597 memory source, but we have to provide a lot of extra functions.
8598 Blah.
8599
8600 We really only need to implement read and seek, but I am not
8601 convinced that the TIFF library is smart enough not to destroy
8602 itself if we only hand it the function pointers we need to
8603 override. */
8604
8605 typedef struct
8606 {
8607 unsigned char *bytes;
8608 size_t len;
8609 int index;
8610 }
8611 tiff_memory_source;
8612
8613
8614 static size_t
8615 tiff_read_from_memory (data, buf, size)
8616 thandle_t data;
8617 tdata_t buf;
8618 tsize_t size;
8619 {
8620 tiff_memory_source *src = (tiff_memory_source *) data;
8621
8622 if (size > src->len - src->index)
8623 return (size_t) -1;
8624 bcopy (src->bytes + src->index, buf, size);
8625 src->index += size;
8626 return size;
8627 }
8628
8629
8630 static size_t
8631 tiff_write_from_memory (data, buf, size)
8632 thandle_t data;
8633 tdata_t buf;
8634 tsize_t size;
8635 {
8636 return (size_t) -1;
8637 }
8638
8639
8640 static toff_t
8641 tiff_seek_in_memory (data, off, whence)
8642 thandle_t data;
8643 toff_t off;
8644 int whence;
8645 {
8646 tiff_memory_source *src = (tiff_memory_source *) data;
8647 int idx;
8648
8649 switch (whence)
8650 {
8651 case SEEK_SET: /* Go from beginning of source. */
8652 idx = off;
8653 break;
8654
8655 case SEEK_END: /* Go from end of source. */
8656 idx = src->len + off;
8657 break;
8658
8659 case SEEK_CUR: /* Go from current position. */
8660 idx = src->index + off;
8661 break;
8662
8663 default: /* Invalid `whence'. */
8664 return -1;
8665 }
8666
8667 if (idx > src->len || idx < 0)
8668 return -1;
8669
8670 src->index = idx;
8671 return src->index;
8672 }
8673
8674
8675 static int
8676 tiff_close_memory (data)
8677 thandle_t data;
8678 {
8679 /* NOOP */
8680 return 0;
8681 }
8682
8683
8684 static int
8685 tiff_mmap_memory (data, pbase, psize)
8686 thandle_t data;
8687 tdata_t *pbase;
8688 toff_t *psize;
8689 {
8690 /* It is already _IN_ memory. */
8691 return 0;
8692 }
8693
8694
8695 static void
8696 tiff_unmap_memory (data, base, size)
8697 thandle_t data;
8698 tdata_t base;
8699 toff_t size;
8700 {
8701 /* We don't need to do this. */
8702 }
8703
8704
8705 static toff_t
8706 tiff_size_of_memory (data)
8707 thandle_t data;
8708 {
8709 return ((tiff_memory_source *) data)->len;
8710 }
8711
8712
8713 static void
8714 tiff_error_handler (title, format, ap)
8715 const char *title, *format;
8716 va_list ap;
8717 {
8718 char buf[512];
8719 int len;
8720
8721 len = sprintf (buf, "TIFF error: %s ", title);
8722 vsprintf (buf + len, format, ap);
8723 add_to_log (buf, Qnil, Qnil);
8724 }
8725
8726
8727 static void
8728 tiff_warning_handler (title, format, ap)
8729 const char *title, *format;
8730 va_list ap;
8731 {
8732 char buf[512];
8733 int len;
8734
8735 len = sprintf (buf, "TIFF warning: %s ", title);
8736 vsprintf (buf + len, format, ap);
8737 add_to_log (buf, Qnil, Qnil);
8738 }
8739
8740
8741 /* Load TIFF image IMG for use on frame F. Value is non-zero if
8742 successful. */
8743
8744 static int
8745 tiff_load (f, img)
8746 struct frame *f;
8747 struct image *img;
8748 {
8749 Lisp_Object file, specified_file;
8750 Lisp_Object specified_data;
8751 TIFF *tiff;
8752 int width, height, x, y;
8753 uint32 *buf;
8754 int rc;
8755 XImage *ximg;
8756 struct gcpro gcpro1;
8757 tiff_memory_source memsrc;
8758
8759 specified_file = image_spec_value (img->spec, QCfile, NULL);
8760 specified_data = image_spec_value (img->spec, QCdata, NULL);
8761 file = Qnil;
8762 GCPRO1 (file);
8763
8764 TIFFSetErrorHandler (tiff_error_handler);
8765 TIFFSetWarningHandler (tiff_warning_handler);
8766
8767 if (NILP (specified_data))
8768 {
8769 /* Read from a file */
8770 file = x_find_image_file (specified_file);
8771 if (!STRINGP (file))
8772 {
8773 image_error ("Cannot find image file `%s'", file, Qnil);
8774 UNGCPRO;
8775 return 0;
8776 }
8777
8778 /* Try to open the image file. */
8779 tiff = TIFFOpen (SDATA (file), "r");
8780 if (tiff == NULL)
8781 {
8782 image_error ("Cannot open `%s'", file, Qnil);
8783 UNGCPRO;
8784 return 0;
8785 }
8786 }
8787 else
8788 {
8789 /* Memory source! */
8790 memsrc.bytes = SDATA (specified_data);
8791 memsrc.len = SBYTES (specified_data);
8792 memsrc.index = 0;
8793
8794 tiff = TIFFClientOpen ("memory_source", "r", &memsrc,
8795 (TIFFReadWriteProc) tiff_read_from_memory,
8796 (TIFFReadWriteProc) tiff_write_from_memory,
8797 tiff_seek_in_memory,
8798 tiff_close_memory,
8799 tiff_size_of_memory,
8800 tiff_mmap_memory,
8801 tiff_unmap_memory);
8802
8803 if (!tiff)
8804 {
8805 image_error ("Cannot open memory source for `%s'", img->spec, Qnil);
8806 UNGCPRO;
8807 return 0;
8808 }
8809 }
8810
8811 /* Get width and height of the image, and allocate a raster buffer
8812 of width x height 32-bit values. */
8813 TIFFGetField (tiff, TIFFTAG_IMAGEWIDTH, &width);
8814 TIFFGetField (tiff, TIFFTAG_IMAGELENGTH, &height);
8815 buf = (uint32 *) xmalloc (width * height * sizeof *buf);
8816
8817 rc = TIFFReadRGBAImage (tiff, width, height, buf, 0);
8818 TIFFClose (tiff);
8819 if (!rc)
8820 {
8821 image_error ("Error reading TIFF image `%s'", img->spec, Qnil);
8822 xfree (buf);
8823 UNGCPRO;
8824 return 0;
8825 }
8826
8827 /* Create the X image and pixmap. */
8828 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
8829 {
8830 xfree (buf);
8831 UNGCPRO;
8832 return 0;
8833 }
8834
8835 /* Initialize the color table. */
8836 init_color_table ();
8837
8838 /* Process the pixel raster. Origin is in the lower-left corner. */
8839 for (y = 0; y < height; ++y)
8840 {
8841 uint32 *row = buf + y * width;
8842
8843 for (x = 0; x < width; ++x)
8844 {
8845 uint32 abgr = row[x];
8846 int r = TIFFGetR (abgr) << 8;
8847 int g = TIFFGetG (abgr) << 8;
8848 int b = TIFFGetB (abgr) << 8;
8849 XPutPixel (ximg, x, height - 1 - y, lookup_rgb_color (f, r, g, b));
8850 }
8851 }
8852
8853 /* Remember the colors allocated for the image. Free the color table. */
8854 img->colors = colors_in_color_table (&img->ncolors);
8855 free_color_table ();
8856
8857 img->width = width;
8858 img->height = height;
8859
8860 /* Maybe fill in the background field while we have ximg handy. */
8861 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
8862 IMAGE_BACKGROUND (img, f, ximg);
8863
8864 /* Put the image into the pixmap, then free the X image and its buffer. */
8865 x_put_x_image (f, ximg, img->pixmap, width, height);
8866 x_destroy_x_image (ximg);
8867 xfree (buf);
8868
8869 UNGCPRO;
8870 return 1;
8871 }
8872
8873 #endif /* HAVE_TIFF != 0 */
8874
8875
8876 \f
8877 /***********************************************************************
8878 GIF
8879 ***********************************************************************/
8880
8881 #if HAVE_GIF
8882
8883 #include <gif_lib.h>
8884
8885 static int gif_image_p P_ ((Lisp_Object object));
8886 static int gif_load P_ ((struct frame *f, struct image *img));
8887
8888 /* The symbol `gif' identifying images of this type. */
8889
8890 Lisp_Object Qgif;
8891
8892 /* Indices of image specification fields in gif_format, below. */
8893
8894 enum gif_keyword_index
8895 {
8896 GIF_TYPE,
8897 GIF_DATA,
8898 GIF_FILE,
8899 GIF_ASCENT,
8900 GIF_MARGIN,
8901 GIF_RELIEF,
8902 GIF_ALGORITHM,
8903 GIF_HEURISTIC_MASK,
8904 GIF_MASK,
8905 GIF_IMAGE,
8906 GIF_BACKGROUND,
8907 GIF_LAST
8908 };
8909
8910 /* Vector of image_keyword structures describing the format
8911 of valid user-defined image specifications. */
8912
8913 static struct image_keyword gif_format[GIF_LAST] =
8914 {
8915 {":type", IMAGE_SYMBOL_VALUE, 1},
8916 {":data", IMAGE_STRING_VALUE, 0},
8917 {":file", IMAGE_STRING_VALUE, 0},
8918 {":ascent", IMAGE_ASCENT_VALUE, 0},
8919 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
8920 {":relief", IMAGE_INTEGER_VALUE, 0},
8921 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8922 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8923 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8924 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8925 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
8926 };
8927
8928 /* Structure describing the image type `gif'. */
8929
8930 static struct image_type gif_type =
8931 {
8932 &Qgif,
8933 gif_image_p,
8934 gif_load,
8935 x_clear_image,
8936 NULL
8937 };
8938
8939
8940 /* Return non-zero if OBJECT is a valid GIF image specification. */
8941
8942 static int
8943 gif_image_p (object)
8944 Lisp_Object object;
8945 {
8946 struct image_keyword fmt[GIF_LAST];
8947 bcopy (gif_format, fmt, sizeof fmt);
8948
8949 if (!parse_image_spec (object, fmt, GIF_LAST, Qgif))
8950 return 0;
8951
8952 /* Must specify either the :data or :file keyword. */
8953 return fmt[GIF_FILE].count + fmt[GIF_DATA].count == 1;
8954 }
8955
8956
8957 /* Reading a GIF image from memory
8958 Based on the PNG memory stuff to a certain extent. */
8959
8960 typedef struct
8961 {
8962 unsigned char *bytes;
8963 size_t len;
8964 int index;
8965 }
8966 gif_memory_source;
8967
8968
8969 /* Make the current memory source available to gif_read_from_memory.
8970 It's done this way because not all versions of libungif support
8971 a UserData field in the GifFileType structure. */
8972 static gif_memory_source *current_gif_memory_src;
8973
8974 static int
8975 gif_read_from_memory (file, buf, len)
8976 GifFileType *file;
8977 GifByteType *buf;
8978 int len;
8979 {
8980 gif_memory_source *src = current_gif_memory_src;
8981
8982 if (len > src->len - src->index)
8983 return -1;
8984
8985 bcopy (src->bytes + src->index, buf, len);
8986 src->index += len;
8987 return len;
8988 }
8989
8990
8991 /* Load GIF image IMG for use on frame F. Value is non-zero if
8992 successful. */
8993
8994 static int
8995 gif_load (f, img)
8996 struct frame *f;
8997 struct image *img;
8998 {
8999 Lisp_Object file, specified_file;
9000 Lisp_Object specified_data;
9001 int rc, width, height, x, y, i;
9002 XImage *ximg;
9003 ColorMapObject *gif_color_map;
9004 unsigned long pixel_colors[256];
9005 GifFileType *gif;
9006 struct gcpro gcpro1;
9007 Lisp_Object image;
9008 int ino, image_left, image_top, image_width, image_height;
9009 gif_memory_source memsrc;
9010 unsigned char *raster;
9011
9012 specified_file = image_spec_value (img->spec, QCfile, NULL);
9013 specified_data = image_spec_value (img->spec, QCdata, NULL);
9014 file = Qnil;
9015 GCPRO1 (file);
9016
9017 if (NILP (specified_data))
9018 {
9019 file = x_find_image_file (specified_file);
9020 if (!STRINGP (file))
9021 {
9022 image_error ("Cannot find image file `%s'", specified_file, Qnil);
9023 UNGCPRO;
9024 return 0;
9025 }
9026
9027 /* Open the GIF file. */
9028 gif = DGifOpenFileName (SDATA (file));
9029 if (gif == NULL)
9030 {
9031 image_error ("Cannot open `%s'", file, Qnil);
9032 UNGCPRO;
9033 return 0;
9034 }
9035 }
9036 else
9037 {
9038 /* Read from memory! */
9039 current_gif_memory_src = &memsrc;
9040 memsrc.bytes = SDATA (specified_data);
9041 memsrc.len = SBYTES (specified_data);
9042 memsrc.index = 0;
9043
9044 gif = DGifOpen (&memsrc, gif_read_from_memory);
9045 if (!gif)
9046 {
9047 image_error ("Cannot open memory source `%s'", img->spec, Qnil);
9048 UNGCPRO;
9049 return 0;
9050 }
9051 }
9052
9053 /* Read entire contents. */
9054 rc = DGifSlurp (gif);
9055 if (rc == GIF_ERROR)
9056 {
9057 image_error ("Error reading `%s'", img->spec, Qnil);
9058 DGifCloseFile (gif);
9059 UNGCPRO;
9060 return 0;
9061 }
9062
9063 image = image_spec_value (img->spec, QCindex, NULL);
9064 ino = INTEGERP (image) ? XFASTINT (image) : 0;
9065 if (ino >= gif->ImageCount)
9066 {
9067 image_error ("Invalid image number `%s' in image `%s'",
9068 image, img->spec);
9069 DGifCloseFile (gif);
9070 UNGCPRO;
9071 return 0;
9072 }
9073
9074 width = img->width = max (gif->SWidth, gif->Image.Left + gif->Image.Width);
9075 height = img->height = max (gif->SHeight, gif->Image.Top + gif->Image.Height);
9076
9077 /* Create the X image and pixmap. */
9078 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
9079 {
9080 DGifCloseFile (gif);
9081 UNGCPRO;
9082 return 0;
9083 }
9084
9085 /* Allocate colors. */
9086 gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap;
9087 if (!gif_color_map)
9088 gif_color_map = gif->SColorMap;
9089 init_color_table ();
9090 bzero (pixel_colors, sizeof pixel_colors);
9091
9092 for (i = 0; i < gif_color_map->ColorCount; ++i)
9093 {
9094 int r = gif_color_map->Colors[i].Red << 8;
9095 int g = gif_color_map->Colors[i].Green << 8;
9096 int b = gif_color_map->Colors[i].Blue << 8;
9097 pixel_colors[i] = lookup_rgb_color (f, r, g, b);
9098 }
9099
9100 img->colors = colors_in_color_table (&img->ncolors);
9101 free_color_table ();
9102
9103 /* Clear the part of the screen image that are not covered by
9104 the image from the GIF file. Full animated GIF support
9105 requires more than can be done here (see the gif89 spec,
9106 disposal methods). Let's simply assume that the part
9107 not covered by a sub-image is in the frame's background color. */
9108 image_top = gif->SavedImages[ino].ImageDesc.Top;
9109 image_left = gif->SavedImages[ino].ImageDesc.Left;
9110 image_width = gif->SavedImages[ino].ImageDesc.Width;
9111 image_height = gif->SavedImages[ino].ImageDesc.Height;
9112
9113 for (y = 0; y < image_top; ++y)
9114 for (x = 0; x < width; ++x)
9115 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9116
9117 for (y = image_top + image_height; y < height; ++y)
9118 for (x = 0; x < width; ++x)
9119 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9120
9121 for (y = image_top; y < image_top + image_height; ++y)
9122 {
9123 for (x = 0; x < image_left; ++x)
9124 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9125 for (x = image_left + image_width; x < width; ++x)
9126 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9127 }
9128
9129 /* Read the GIF image into the X image. We use a local variable
9130 `raster' here because RasterBits below is a char *, and invites
9131 problems with bytes >= 0x80. */
9132 raster = (unsigned char *) gif->SavedImages[ino].RasterBits;
9133
9134 if (gif->SavedImages[ino].ImageDesc.Interlace)
9135 {
9136 static int interlace_start[] = {0, 4, 2, 1};
9137 static int interlace_increment[] = {8, 8, 4, 2};
9138 int pass;
9139 int row = interlace_start[0];
9140
9141 pass = 0;
9142
9143 for (y = 0; y < image_height; y++)
9144 {
9145 if (row >= image_height)
9146 {
9147 row = interlace_start[++pass];
9148 while (row >= image_height)
9149 row = interlace_start[++pass];
9150 }
9151
9152 for (x = 0; x < image_width; x++)
9153 {
9154 int i = raster[(y * image_width) + x];
9155 XPutPixel (ximg, x + image_left, row + image_top,
9156 pixel_colors[i]);
9157 }
9158
9159 row += interlace_increment[pass];
9160 }
9161 }
9162 else
9163 {
9164 for (y = 0; y < image_height; ++y)
9165 for (x = 0; x < image_width; ++x)
9166 {
9167 int i = raster[y * image_width + x];
9168 XPutPixel (ximg, x + image_left, y + image_top, pixel_colors[i]);
9169 }
9170 }
9171
9172 DGifCloseFile (gif);
9173
9174 /* Maybe fill in the background field while we have ximg handy. */
9175 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
9176 IMAGE_BACKGROUND (img, f, ximg);
9177
9178 /* Put the image into the pixmap, then free the X image and its buffer. */
9179 x_put_x_image (f, ximg, img->pixmap, width, height);
9180 x_destroy_x_image (ximg);
9181
9182 UNGCPRO;
9183 return 1;
9184 }
9185
9186 #endif /* HAVE_GIF != 0 */
9187
9188
9189 \f
9190 /***********************************************************************
9191 Ghostscript
9192 ***********************************************************************/
9193
9194 static int gs_image_p P_ ((Lisp_Object object));
9195 static int gs_load P_ ((struct frame *f, struct image *img));
9196 static void gs_clear_image P_ ((struct frame *f, struct image *img));
9197
9198 /* The symbol `postscript' identifying images of this type. */
9199
9200 Lisp_Object Qpostscript;
9201
9202 /* Keyword symbols. */
9203
9204 Lisp_Object QCloader, QCbounding_box, QCpt_width, QCpt_height;
9205
9206 /* Indices of image specification fields in gs_format, below. */
9207
9208 enum gs_keyword_index
9209 {
9210 GS_TYPE,
9211 GS_PT_WIDTH,
9212 GS_PT_HEIGHT,
9213 GS_FILE,
9214 GS_LOADER,
9215 GS_BOUNDING_BOX,
9216 GS_ASCENT,
9217 GS_MARGIN,
9218 GS_RELIEF,
9219 GS_ALGORITHM,
9220 GS_HEURISTIC_MASK,
9221 GS_MASK,
9222 GS_BACKGROUND,
9223 GS_LAST
9224 };
9225
9226 /* Vector of image_keyword structures describing the format
9227 of valid user-defined image specifications. */
9228
9229 static struct image_keyword gs_format[GS_LAST] =
9230 {
9231 {":type", IMAGE_SYMBOL_VALUE, 1},
9232 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE, 1},
9233 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE, 1},
9234 {":file", IMAGE_STRING_VALUE, 1},
9235 {":loader", IMAGE_FUNCTION_VALUE, 0},
9236 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE, 1},
9237 {":ascent", IMAGE_ASCENT_VALUE, 0},
9238 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
9239 {":relief", IMAGE_INTEGER_VALUE, 0},
9240 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9241 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9242 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9243 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
9244 };
9245
9246 /* Structure describing the image type `ghostscript'. */
9247
9248 static struct image_type gs_type =
9249 {
9250 &Qpostscript,
9251 gs_image_p,
9252 gs_load,
9253 gs_clear_image,
9254 NULL
9255 };
9256
9257
9258 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9259
9260 static void
9261 gs_clear_image (f, img)
9262 struct frame *f;
9263 struct image *img;
9264 {
9265 /* IMG->data.ptr_val may contain a recorded colormap. */
9266 xfree (img->data.ptr_val);
9267 x_clear_image (f, img);
9268 }
9269
9270
9271 /* Return non-zero if OBJECT is a valid Ghostscript image
9272 specification. */
9273
9274 static int
9275 gs_image_p (object)
9276 Lisp_Object object;
9277 {
9278 struct image_keyword fmt[GS_LAST];
9279 Lisp_Object tem;
9280 int i;
9281
9282 bcopy (gs_format, fmt, sizeof fmt);
9283
9284 if (!parse_image_spec (object, fmt, GS_LAST, Qpostscript))
9285 return 0;
9286
9287 /* Bounding box must be a list or vector containing 4 integers. */
9288 tem = fmt[GS_BOUNDING_BOX].value;
9289 if (CONSP (tem))
9290 {
9291 for (i = 0; i < 4; ++i, tem = XCDR (tem))
9292 if (!CONSP (tem) || !INTEGERP (XCAR (tem)))
9293 return 0;
9294 if (!NILP (tem))
9295 return 0;
9296 }
9297 else if (VECTORP (tem))
9298 {
9299 if (XVECTOR (tem)->size != 4)
9300 return 0;
9301 for (i = 0; i < 4; ++i)
9302 if (!INTEGERP (XVECTOR (tem)->contents[i]))
9303 return 0;
9304 }
9305 else
9306 return 0;
9307
9308 return 1;
9309 }
9310
9311
9312 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9313 if successful. */
9314
9315 static int
9316 gs_load (f, img)
9317 struct frame *f;
9318 struct image *img;
9319 {
9320 char buffer[100];
9321 Lisp_Object window_and_pixmap_id = Qnil, loader, pt_height, pt_width;
9322 struct gcpro gcpro1, gcpro2;
9323 Lisp_Object frame;
9324 double in_width, in_height;
9325 Lisp_Object pixel_colors = Qnil;
9326
9327 /* Compute pixel size of pixmap needed from the given size in the
9328 image specification. Sizes in the specification are in pt. 1 pt
9329 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9330 info. */
9331 pt_width = image_spec_value (img->spec, QCpt_width, NULL);
9332 in_width = XFASTINT (pt_width) / 72.0;
9333 img->width = in_width * FRAME_X_DISPLAY_INFO (f)->resx;
9334 pt_height = image_spec_value (img->spec, QCpt_height, NULL);
9335 in_height = XFASTINT (pt_height) / 72.0;
9336 img->height = in_height * FRAME_X_DISPLAY_INFO (f)->resy;
9337
9338 /* Create the pixmap. */
9339 xassert (img->pixmap == None);
9340 img->pixmap = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9341 img->width, img->height,
9342 DefaultDepthOfScreen (FRAME_X_SCREEN (f)));
9343
9344 if (!img->pixmap)
9345 {
9346 image_error ("Unable to create pixmap for `%s'", img->spec, Qnil);
9347 return 0;
9348 }
9349
9350 /* Call the loader to fill the pixmap. It returns a process object
9351 if successful. We do not record_unwind_protect here because
9352 other places in redisplay like calling window scroll functions
9353 don't either. Let the Lisp loader use `unwind-protect' instead. */
9354 GCPRO2 (window_and_pixmap_id, pixel_colors);
9355
9356 sprintf (buffer, "%lu %lu",
9357 (unsigned long) FRAME_X_WINDOW (f),
9358 (unsigned long) img->pixmap);
9359 window_and_pixmap_id = build_string (buffer);
9360
9361 sprintf (buffer, "%lu %lu",
9362 FRAME_FOREGROUND_PIXEL (f),
9363 FRAME_BACKGROUND_PIXEL (f));
9364 pixel_colors = build_string (buffer);
9365
9366 XSETFRAME (frame, f);
9367 loader = image_spec_value (img->spec, QCloader, NULL);
9368 if (NILP (loader))
9369 loader = intern ("gs-load-image");
9370
9371 img->data.lisp_val = call6 (loader, frame, img->spec,
9372 make_number (img->width),
9373 make_number (img->height),
9374 window_and_pixmap_id,
9375 pixel_colors);
9376 UNGCPRO;
9377 return PROCESSP (img->data.lisp_val);
9378 }
9379
9380
9381 /* Kill the Ghostscript process that was started to fill PIXMAP on
9382 frame F. Called from XTread_socket when receiving an event
9383 telling Emacs that Ghostscript has finished drawing. */
9384
9385 void
9386 x_kill_gs_process (pixmap, f)
9387 Pixmap pixmap;
9388 struct frame *f;
9389 {
9390 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
9391 int class, i;
9392 struct image *img;
9393
9394 /* Find the image containing PIXMAP. */
9395 for (i = 0; i < c->used; ++i)
9396 if (c->images[i]->pixmap == pixmap)
9397 break;
9398
9399 /* Should someone in between have cleared the image cache, for
9400 instance, give up. */
9401 if (i == c->used)
9402 return;
9403
9404 /* Kill the GS process. We should have found PIXMAP in the image
9405 cache and its image should contain a process object. */
9406 img = c->images[i];
9407 xassert (PROCESSP (img->data.lisp_val));
9408 Fkill_process (img->data.lisp_val, Qnil);
9409 img->data.lisp_val = Qnil;
9410
9411 /* On displays with a mutable colormap, figure out the colors
9412 allocated for the image by looking at the pixels of an XImage for
9413 img->pixmap. */
9414 class = FRAME_X_VISUAL (f)->class;
9415 if (class != StaticColor && class != StaticGray && class != TrueColor)
9416 {
9417 XImage *ximg;
9418
9419 BLOCK_INPUT;
9420
9421 /* Try to get an XImage for img->pixmep. */
9422 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
9423 0, 0, img->width, img->height, ~0, ZPixmap);
9424 if (ximg)
9425 {
9426 int x, y;
9427
9428 /* Initialize the color table. */
9429 init_color_table ();
9430
9431 /* For each pixel of the image, look its color up in the
9432 color table. After having done so, the color table will
9433 contain an entry for each color used by the image. */
9434 for (y = 0; y < img->height; ++y)
9435 for (x = 0; x < img->width; ++x)
9436 {
9437 unsigned long pixel = XGetPixel (ximg, x, y);
9438 lookup_pixel_color (f, pixel);
9439 }
9440
9441 /* Record colors in the image. Free color table and XImage. */
9442 img->colors = colors_in_color_table (&img->ncolors);
9443 free_color_table ();
9444 XDestroyImage (ximg);
9445
9446 #if 0 /* This doesn't seem to be the case. If we free the colors
9447 here, we get a BadAccess later in x_clear_image when
9448 freeing the colors. */
9449 /* We have allocated colors once, but Ghostscript has also
9450 allocated colors on behalf of us. So, to get the
9451 reference counts right, free them once. */
9452 if (img->ncolors)
9453 x_free_colors (f, img->colors, img->ncolors);
9454 #endif
9455 }
9456 else
9457 image_error ("Cannot get X image of `%s'; colors will not be freed",
9458 img->spec, Qnil);
9459
9460 UNBLOCK_INPUT;
9461 }
9462
9463 /* Now that we have the pixmap, compute mask and transform the
9464 image if requested. */
9465 BLOCK_INPUT;
9466 postprocess_image (f, img);
9467 UNBLOCK_INPUT;
9468 }
9469
9470
9471 \f
9472 /***********************************************************************
9473 Window properties
9474 ***********************************************************************/
9475
9476 DEFUN ("x-change-window-property", Fx_change_window_property,
9477 Sx_change_window_property, 2, 6, 0,
9478 doc: /* Change window property PROP to VALUE on the X window of FRAME.
9479 PROP must be a string.
9480 VALUE may be a string or a list of conses, numbers and/or strings.
9481 If an element in the list is a string, it is converted to
9482 an Atom and the value of the Atom is used. If an element is a cons,
9483 it is converted to a 32 bit number where the car is the 16 top bits and the
9484 cdr is the lower 16 bits.
9485 FRAME nil or omitted means use the selected frame.
9486 If TYPE is given and non-nil, it is the name of the type of VALUE.
9487 If TYPE is not given or nil, the type is STRING.
9488 FORMAT gives the size in bits of each element if VALUE is a list.
9489 It must be one of 8, 16 or 32.
9490 If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
9491 If OUTER_P is non-nil, the property is changed for the outer X window of
9492 FRAME. Default is to change on the edit X window.
9493
9494 Value is VALUE. */)
9495 (prop, value, frame, type, format, outer_p)
9496 Lisp_Object frame, prop, value, outer_p;
9497 {
9498 struct frame *f = check_x_frame (frame);
9499 Atom prop_atom;
9500 Atom target_type = XA_STRING;
9501 int element_format = 8;
9502 unsigned char *data;
9503 int nelements;
9504 Lisp_Object cons;
9505 Window w;
9506
9507 CHECK_STRING (prop);
9508
9509 if (! NILP (format))
9510 {
9511 CHECK_NUMBER (format);
9512 element_format = XFASTINT (format);
9513
9514 if (element_format != 8 && element_format != 16
9515 && element_format != 32)
9516 error ("FORMAT must be one of 8, 16 or 32");
9517 }
9518
9519 if (CONSP (value))
9520 {
9521 nelements = x_check_property_data (value);
9522 if (nelements == -1)
9523 error ("Bad data in VALUE, must be number, string or cons");
9524
9525 if (element_format == 8)
9526 data = (unsigned char *) xmalloc (nelements);
9527 else if (element_format == 16)
9528 data = (unsigned char *) xmalloc (nelements*2);
9529 else
9530 data = (unsigned char *) xmalloc (nelements*4);
9531
9532 x_fill_property_data (FRAME_X_DISPLAY (f), value, data, element_format);
9533 }
9534 else
9535 {
9536 CHECK_STRING (value);
9537 data = SDATA (value);
9538 nelements = SCHARS (value);
9539 }
9540
9541 BLOCK_INPUT;
9542 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
9543 if (! NILP (type))
9544 {
9545 CHECK_STRING (type);
9546 target_type = XInternAtom (FRAME_X_DISPLAY (f), SDATA (type), False);
9547 }
9548
9549 if (! NILP (outer_p)) w = FRAME_OUTER_WINDOW (f);
9550 else w = FRAME_X_WINDOW (f);
9551
9552 XChangeProperty (FRAME_X_DISPLAY (f), w,
9553 prop_atom, target_type, element_format, PropModeReplace,
9554 data, nelements);
9555
9556 if (CONSP (value)) xfree (data);
9557
9558 /* Make sure the property is set when we return. */
9559 XFlush (FRAME_X_DISPLAY (f));
9560 UNBLOCK_INPUT;
9561
9562 return value;
9563 }
9564
9565
9566 DEFUN ("x-delete-window-property", Fx_delete_window_property,
9567 Sx_delete_window_property, 1, 2, 0,
9568 doc: /* Remove window property PROP from X window of FRAME.
9569 FRAME nil or omitted means use the selected frame. Value is PROP. */)
9570 (prop, frame)
9571 Lisp_Object prop, frame;
9572 {
9573 struct frame *f = check_x_frame (frame);
9574 Atom prop_atom;
9575
9576 CHECK_STRING (prop);
9577 BLOCK_INPUT;
9578 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
9579 XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), prop_atom);
9580
9581 /* Make sure the property is removed when we return. */
9582 XFlush (FRAME_X_DISPLAY (f));
9583 UNBLOCK_INPUT;
9584
9585 return prop;
9586 }
9587
9588
9589 DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
9590 1, 6, 0,
9591 doc: /* Value is the value of window property PROP on FRAME.
9592 If FRAME is nil or omitted, use the selected frame.
9593 If TYPE is nil or omitted, get the property as a string. Otherwise TYPE
9594 is the name of the Atom that denotes the type expected.
9595 If SOURCE is non-nil, get the property on that window instead of from
9596 FRAME. The number 0 denotes the root window.
9597 If DELETE_P is non-nil, delete the property after retreiving it.
9598 If VECTOR_RET_P is non-nil, don't return a string but a vector of values.
9599
9600 Value is nil if FRAME hasn't a property with name PROP or if PROP has
9601 no value of TYPE. */)
9602 (prop, frame, type, source, delete_p, vector_ret_p)
9603 Lisp_Object prop, frame, type, source, delete_p, vector_ret_p;
9604 {
9605 struct frame *f = check_x_frame (frame);
9606 Atom prop_atom;
9607 int rc;
9608 Lisp_Object prop_value = Qnil;
9609 char *tmp_data = NULL;
9610 Atom actual_type;
9611 Atom target_type = XA_STRING;
9612 int actual_format;
9613 unsigned long actual_size, bytes_remaining;
9614 Window target_window = FRAME_X_WINDOW (f);
9615 struct gcpro gcpro1;
9616
9617 GCPRO1 (prop_value);
9618 CHECK_STRING (prop);
9619
9620 if (! NILP (source))
9621 {
9622 if (NUMBERP (source))
9623 {
9624 if (FLOATP (source))
9625 target_window = (Window) XFLOAT (source);
9626 else
9627 target_window = XFASTINT (source);
9628
9629 if (target_window == 0)
9630 target_window = FRAME_X_DISPLAY_INFO (f)->root_window;
9631 }
9632 else if (CONSP (source))
9633 target_window = cons_to_long (source);
9634 }
9635
9636 BLOCK_INPUT;
9637 if (STRINGP (type))
9638 {
9639 if (strcmp ("AnyPropertyType", SDATA (type)) == 0)
9640 target_type = AnyPropertyType;
9641 else
9642 target_type = XInternAtom (FRAME_X_DISPLAY (f), SDATA (type), False);
9643 }
9644
9645 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
9646 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), target_window,
9647 prop_atom, 0, 0, False, target_type,
9648 &actual_type, &actual_format, &actual_size,
9649 &bytes_remaining, (unsigned char **) &tmp_data);
9650 if (rc == Success)
9651 {
9652 int size = bytes_remaining;
9653
9654 XFree (tmp_data);
9655 tmp_data = NULL;
9656
9657 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), target_window,
9658 prop_atom, 0, bytes_remaining,
9659 ! NILP (delete_p), target_type,
9660 &actual_type, &actual_format,
9661 &actual_size, &bytes_remaining,
9662 (unsigned char **) &tmp_data);
9663 if (rc == Success && tmp_data)
9664 {
9665 if (NILP (vector_ret_p))
9666 prop_value = make_string (tmp_data, size);
9667 else
9668 prop_value = x_property_data_to_lisp (f,
9669 (unsigned char *) tmp_data,
9670 actual_type,
9671 actual_format,
9672 actual_size);
9673 }
9674
9675 if (tmp_data) XFree (tmp_data);
9676 }
9677
9678 UNBLOCK_INPUT;
9679 UNGCPRO;
9680 return prop_value;
9681 }
9682
9683
9684 \f
9685 /***********************************************************************
9686 Busy cursor
9687 ***********************************************************************/
9688
9689 /* If non-null, an asynchronous timer that, when it expires, displays
9690 an hourglass cursor on all frames. */
9691
9692 static struct atimer *hourglass_atimer;
9693
9694 /* Non-zero means an hourglass cursor is currently shown. */
9695
9696 static int hourglass_shown_p;
9697
9698 /* Number of seconds to wait before displaying an hourglass cursor. */
9699
9700 static Lisp_Object Vhourglass_delay;
9701
9702 /* Default number of seconds to wait before displaying an hourglass
9703 cursor. */
9704
9705 #define DEFAULT_HOURGLASS_DELAY 1
9706
9707 /* Function prototypes. */
9708
9709 static void show_hourglass P_ ((struct atimer *));
9710 static void hide_hourglass P_ ((void));
9711
9712
9713 /* Cancel a currently active hourglass timer, and start a new one. */
9714
9715 void
9716 start_hourglass ()
9717 {
9718 EMACS_TIME delay;
9719 int secs, usecs = 0;
9720
9721 cancel_hourglass ();
9722
9723 if (INTEGERP (Vhourglass_delay)
9724 && XINT (Vhourglass_delay) > 0)
9725 secs = XFASTINT (Vhourglass_delay);
9726 else if (FLOATP (Vhourglass_delay)
9727 && XFLOAT_DATA (Vhourglass_delay) > 0)
9728 {
9729 Lisp_Object tem;
9730 tem = Ftruncate (Vhourglass_delay, Qnil);
9731 secs = XFASTINT (tem);
9732 usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
9733 }
9734 else
9735 secs = DEFAULT_HOURGLASS_DELAY;
9736
9737 EMACS_SET_SECS_USECS (delay, secs, usecs);
9738 hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
9739 show_hourglass, NULL);
9740 }
9741
9742
9743 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
9744 shown. */
9745
9746 void
9747 cancel_hourglass ()
9748 {
9749 if (hourglass_atimer)
9750 {
9751 cancel_atimer (hourglass_atimer);
9752 hourglass_atimer = NULL;
9753 }
9754
9755 if (hourglass_shown_p)
9756 hide_hourglass ();
9757 }
9758
9759
9760 /* Timer function of hourglass_atimer. TIMER is equal to
9761 hourglass_atimer.
9762
9763 Display an hourglass pointer on all frames by mapping the frames'
9764 hourglass_window. Set the hourglass_p flag in the frames'
9765 output_data.x structure to indicate that an hourglass cursor is
9766 shown on the frames. */
9767
9768 static void
9769 show_hourglass (timer)
9770 struct atimer *timer;
9771 {
9772 /* The timer implementation will cancel this timer automatically
9773 after this function has run. Set hourglass_atimer to null
9774 so that we know the timer doesn't have to be canceled. */
9775 hourglass_atimer = NULL;
9776
9777 if (!hourglass_shown_p)
9778 {
9779 Lisp_Object rest, frame;
9780
9781 BLOCK_INPUT;
9782
9783 FOR_EACH_FRAME (rest, frame)
9784 {
9785 struct frame *f = XFRAME (frame);
9786
9787 if (FRAME_LIVE_P (f) && FRAME_X_P (f) && FRAME_X_DISPLAY (f))
9788 {
9789 Display *dpy = FRAME_X_DISPLAY (f);
9790
9791 #ifdef USE_X_TOOLKIT
9792 if (f->output_data.x->widget)
9793 #else
9794 if (FRAME_OUTER_WINDOW (f))
9795 #endif
9796 {
9797 f->output_data.x->hourglass_p = 1;
9798
9799 if (!f->output_data.x->hourglass_window)
9800 {
9801 unsigned long mask = CWCursor;
9802 XSetWindowAttributes attrs;
9803
9804 attrs.cursor = f->output_data.x->hourglass_cursor;
9805
9806 f->output_data.x->hourglass_window
9807 = XCreateWindow (dpy, FRAME_OUTER_WINDOW (f),
9808 0, 0, 32000, 32000, 0, 0,
9809 InputOnly,
9810 CopyFromParent,
9811 mask, &attrs);
9812 }
9813
9814 XMapRaised (dpy, f->output_data.x->hourglass_window);
9815 XFlush (dpy);
9816 }
9817 }
9818 }
9819
9820 hourglass_shown_p = 1;
9821 UNBLOCK_INPUT;
9822 }
9823 }
9824
9825
9826 /* Hide the hourglass pointer on all frames, if it is currently
9827 shown. */
9828
9829 static void
9830 hide_hourglass ()
9831 {
9832 if (hourglass_shown_p)
9833 {
9834 Lisp_Object rest, frame;
9835
9836 BLOCK_INPUT;
9837 FOR_EACH_FRAME (rest, frame)
9838 {
9839 struct frame *f = XFRAME (frame);
9840
9841 if (FRAME_X_P (f)
9842 /* Watch out for newly created frames. */
9843 && f->output_data.x->hourglass_window)
9844 {
9845 XUnmapWindow (FRAME_X_DISPLAY (f),
9846 f->output_data.x->hourglass_window);
9847 /* Sync here because XTread_socket looks at the
9848 hourglass_p flag that is reset to zero below. */
9849 XSync (FRAME_X_DISPLAY (f), False);
9850 f->output_data.x->hourglass_p = 0;
9851 }
9852 }
9853
9854 hourglass_shown_p = 0;
9855 UNBLOCK_INPUT;
9856 }
9857 }
9858
9859
9860 \f
9861 /***********************************************************************
9862 Tool tips
9863 ***********************************************************************/
9864
9865 static Lisp_Object x_create_tip_frame P_ ((struct x_display_info *,
9866 Lisp_Object, Lisp_Object));
9867 static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
9868 Lisp_Object, int, int, int *, int *));
9869
9870 /* The frame of a currently visible tooltip. */
9871
9872 Lisp_Object tip_frame;
9873
9874 /* If non-nil, a timer started that hides the last tooltip when it
9875 fires. */
9876
9877 Lisp_Object tip_timer;
9878 Window tip_window;
9879
9880 /* If non-nil, a vector of 3 elements containing the last args
9881 with which x-show-tip was called. See there. */
9882
9883 Lisp_Object last_show_tip_args;
9884
9885 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
9886
9887 Lisp_Object Vx_max_tooltip_size;
9888
9889
9890 static Lisp_Object
9891 unwind_create_tip_frame (frame)
9892 Lisp_Object frame;
9893 {
9894 Lisp_Object deleted;
9895
9896 deleted = unwind_create_frame (frame);
9897 if (EQ (deleted, Qt))
9898 {
9899 tip_window = None;
9900 tip_frame = Qnil;
9901 }
9902
9903 return deleted;
9904 }
9905
9906
9907 /* Create a frame for a tooltip on the display described by DPYINFO.
9908 PARMS is a list of frame parameters. TEXT is the string to
9909 display in the tip frame. Value is the frame.
9910
9911 Note that functions called here, esp. x_default_parameter can
9912 signal errors, for instance when a specified color name is
9913 undefined. We have to make sure that we're in a consistent state
9914 when this happens. */
9915
9916 static Lisp_Object
9917 x_create_tip_frame (dpyinfo, parms, text)
9918 struct x_display_info *dpyinfo;
9919 Lisp_Object parms, text;
9920 {
9921 struct frame *f;
9922 Lisp_Object frame, tem;
9923 Lisp_Object name;
9924 long window_prompting = 0;
9925 int width, height;
9926 int count = SPECPDL_INDEX ();
9927 struct gcpro gcpro1, gcpro2, gcpro3;
9928 struct kboard *kb;
9929 int face_change_count_before = face_change_count;
9930 Lisp_Object buffer;
9931 struct buffer *old_buffer;
9932
9933 check_x ();
9934
9935 /* Use this general default value to start with until we know if
9936 this frame has a specified name. */
9937 Vx_resource_name = Vinvocation_name;
9938
9939 #ifdef MULTI_KBOARD
9940 kb = dpyinfo->kboard;
9941 #else
9942 kb = &the_only_kboard;
9943 #endif
9944
9945 /* Get the name of the frame to use for resource lookup. */
9946 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
9947 if (!STRINGP (name)
9948 && !EQ (name, Qunbound)
9949 && !NILP (name))
9950 error ("Invalid frame name--not a string or nil");
9951 Vx_resource_name = name;
9952
9953 frame = Qnil;
9954 GCPRO3 (parms, name, frame);
9955 f = make_frame (1);
9956 XSETFRAME (frame, f);
9957
9958 buffer = Fget_buffer_create (build_string (" *tip*"));
9959 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil);
9960 old_buffer = current_buffer;
9961 set_buffer_internal_1 (XBUFFER (buffer));
9962 current_buffer->truncate_lines = Qnil;
9963 Ferase_buffer ();
9964 Finsert (1, &text);
9965 set_buffer_internal_1 (old_buffer);
9966
9967 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
9968 record_unwind_protect (unwind_create_tip_frame, frame);
9969
9970 /* By setting the output method, we're essentially saying that
9971 the frame is live, as per FRAME_LIVE_P. If we get a signal
9972 from this point on, x_destroy_window might screw up reference
9973 counts etc. */
9974 f->output_method = output_x_window;
9975 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
9976 bzero (f->output_data.x, sizeof (struct x_output));
9977 f->output_data.x->icon_bitmap = -1;
9978 FRAME_FONTSET (f) = -1;
9979 f->output_data.x->scroll_bar_foreground_pixel = -1;
9980 f->output_data.x->scroll_bar_background_pixel = -1;
9981 #ifdef USE_TOOLKIT_SCROLL_BARS
9982 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
9983 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
9984 #endif /* USE_TOOLKIT_SCROLL_BARS */
9985 f->icon_name = Qnil;
9986 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
9987 #if GLYPH_DEBUG
9988 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
9989 dpyinfo_refcount = dpyinfo->reference_count;
9990 #endif /* GLYPH_DEBUG */
9991 #ifdef MULTI_KBOARD
9992 FRAME_KBOARD (f) = kb;
9993 #endif
9994 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
9995 f->output_data.x->explicit_parent = 0;
9996
9997 /* These colors will be set anyway later, but it's important
9998 to get the color reference counts right, so initialize them! */
9999 {
10000 Lisp_Object black;
10001 struct gcpro gcpro1;
10002
10003 black = build_string ("black");
10004 GCPRO1 (black);
10005 f->output_data.x->foreground_pixel
10006 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10007 f->output_data.x->background_pixel
10008 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10009 f->output_data.x->cursor_pixel
10010 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10011 f->output_data.x->cursor_foreground_pixel
10012 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10013 f->output_data.x->border_pixel
10014 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10015 f->output_data.x->mouse_pixel
10016 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10017 UNGCPRO;
10018 }
10019
10020 /* Set the name; the functions to which we pass f expect the name to
10021 be set. */
10022 if (EQ (name, Qunbound) || NILP (name))
10023 {
10024 f->name = build_string (dpyinfo->x_id_name);
10025 f->explicit_name = 0;
10026 }
10027 else
10028 {
10029 f->name = name;
10030 f->explicit_name = 1;
10031 /* use the frame's title when getting resources for this frame. */
10032 specbind (Qx_resource_name, name);
10033 }
10034
10035 /* Extract the window parameters from the supplied values that are
10036 needed to determine window geometry. */
10037 {
10038 Lisp_Object font;
10039
10040 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
10041
10042 BLOCK_INPUT;
10043 /* First, try whatever font the caller has specified. */
10044 if (STRINGP (font))
10045 {
10046 tem = Fquery_fontset (font, Qnil);
10047 if (STRINGP (tem))
10048 font = x_new_fontset (f, SDATA (tem));
10049 else
10050 font = x_new_font (f, SDATA (font));
10051 }
10052
10053 /* Try out a font which we hope has bold and italic variations. */
10054 if (!STRINGP (font))
10055 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10056 if (!STRINGP (font))
10057 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10058 if (! STRINGP (font))
10059 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10060 if (! STRINGP (font))
10061 /* This was formerly the first thing tried, but it finds too many fonts
10062 and takes too long. */
10063 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10064 /* If those didn't work, look for something which will at least work. */
10065 if (! STRINGP (font))
10066 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10067 UNBLOCK_INPUT;
10068 if (! STRINGP (font))
10069 font = build_string ("fixed");
10070
10071 x_default_parameter (f, parms, Qfont, font,
10072 "font", "Font", RES_TYPE_STRING);
10073 }
10074
10075 x_default_parameter (f, parms, Qborder_width, make_number (2),
10076 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
10077
10078 /* This defaults to 2 in order to match xterm. We recognize either
10079 internalBorderWidth or internalBorder (which is what xterm calls
10080 it). */
10081 if (NILP (Fassq (Qinternal_border_width, parms)))
10082 {
10083 Lisp_Object value;
10084
10085 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
10086 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
10087 if (! EQ (value, Qunbound))
10088 parms = Fcons (Fcons (Qinternal_border_width, value),
10089 parms);
10090 }
10091
10092 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
10093 "internalBorderWidth", "internalBorderWidth",
10094 RES_TYPE_NUMBER);
10095
10096 /* Also do the stuff which must be set before the window exists. */
10097 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
10098 "foreground", "Foreground", RES_TYPE_STRING);
10099 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
10100 "background", "Background", RES_TYPE_STRING);
10101 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
10102 "pointerColor", "Foreground", RES_TYPE_STRING);
10103 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
10104 "cursorColor", "Foreground", RES_TYPE_STRING);
10105 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
10106 "borderColor", "BorderColor", RES_TYPE_STRING);
10107
10108 /* Init faces before x_default_parameter is called for scroll-bar
10109 parameters because that function calls x_set_scroll_bar_width,
10110 which calls change_frame_size, which calls Fset_window_buffer,
10111 which runs hooks, which call Fvertical_motion. At the end, we
10112 end up in init_iterator with a null face cache, which should not
10113 happen. */
10114 init_frame_faces (f);
10115
10116 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
10117
10118 window_prompting = x_figure_window_size (f, parms, 0);
10119
10120 {
10121 XSetWindowAttributes attrs;
10122 unsigned long mask;
10123
10124 BLOCK_INPUT;
10125 mask = CWBackPixel | CWOverrideRedirect | CWEventMask;
10126 if (DoesSaveUnders (dpyinfo->screen))
10127 mask |= CWSaveUnder;
10128
10129 /* Window managers look at the override-redirect flag to determine
10130 whether or net to give windows a decoration (Xlib spec, chapter
10131 3.2.8). */
10132 attrs.override_redirect = True;
10133 attrs.save_under = True;
10134 attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f);
10135 /* Arrange for getting MapNotify and UnmapNotify events. */
10136 attrs.event_mask = StructureNotifyMask;
10137 tip_window
10138 = FRAME_X_WINDOW (f)
10139 = XCreateWindow (FRAME_X_DISPLAY (f),
10140 FRAME_X_DISPLAY_INFO (f)->root_window,
10141 /* x, y, width, height */
10142 0, 0, 1, 1,
10143 /* Border. */
10144 1,
10145 CopyFromParent, InputOutput, CopyFromParent,
10146 mask, &attrs);
10147 UNBLOCK_INPUT;
10148 }
10149
10150 x_make_gc (f);
10151
10152 x_default_parameter (f, parms, Qauto_raise, Qnil,
10153 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
10154 x_default_parameter (f, parms, Qauto_lower, Qnil,
10155 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
10156 x_default_parameter (f, parms, Qcursor_type, Qbox,
10157 "cursorType", "CursorType", RES_TYPE_SYMBOL);
10158
10159 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
10160 Change will not be effected unless different from the current
10161 FRAME_LINES (f). */
10162 width = FRAME_COLS (f);
10163 height = FRAME_LINES (f);
10164 SET_FRAME_COLS (f, 0);
10165 FRAME_LINES (f) = 0;
10166 change_frame_size (f, height, width, 1, 0, 0);
10167
10168 /* Add `tooltip' frame parameter's default value. */
10169 if (NILP (Fframe_parameter (frame, intern ("tooltip"))))
10170 Fmodify_frame_parameters (frame, Fcons (Fcons (intern ("tooltip"), Qt),
10171 Qnil));
10172
10173 /* Set up faces after all frame parameters are known. This call
10174 also merges in face attributes specified for new frames.
10175
10176 Frame parameters may be changed if .Xdefaults contains
10177 specifications for the default font. For example, if there is an
10178 `Emacs.default.attributeBackground: pink', the `background-color'
10179 attribute of the frame get's set, which let's the internal border
10180 of the tooltip frame appear in pink. Prevent this. */
10181 {
10182 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
10183
10184 /* Set tip_frame here, so that */
10185 tip_frame = frame;
10186 call1 (Qface_set_after_frame_default, frame);
10187
10188 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
10189 Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
10190 Qnil));
10191 }
10192
10193 f->no_split = 1;
10194
10195 UNGCPRO;
10196
10197 /* It is now ok to make the frame official even if we get an error
10198 below. And the frame needs to be on Vframe_list or making it
10199 visible won't work. */
10200 Vframe_list = Fcons (frame, Vframe_list);
10201
10202 /* Now that the frame is official, it counts as a reference to
10203 its display. */
10204 FRAME_X_DISPLAY_INFO (f)->reference_count++;
10205
10206 /* Setting attributes of faces of the tooltip frame from resources
10207 and similar will increment face_change_count, which leads to the
10208 clearing of all current matrices. Since this isn't necessary
10209 here, avoid it by resetting face_change_count to the value it
10210 had before we created the tip frame. */
10211 face_change_count = face_change_count_before;
10212
10213 /* Discard the unwind_protect. */
10214 return unbind_to (count, frame);
10215 }
10216
10217
10218 /* Compute where to display tip frame F. PARMS is the list of frame
10219 parameters for F. DX and DY are specified offsets from the current
10220 location of the mouse. WIDTH and HEIGHT are the width and height
10221 of the tooltip. Return coordinates relative to the root window of
10222 the display in *ROOT_X, and *ROOT_Y. */
10223
10224 static void
10225 compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
10226 struct frame *f;
10227 Lisp_Object parms, dx, dy;
10228 int width, height;
10229 int *root_x, *root_y;
10230 {
10231 Lisp_Object left, top;
10232 int win_x, win_y;
10233 Window root, child;
10234 unsigned pmask;
10235
10236 /* User-specified position? */
10237 left = Fcdr (Fassq (Qleft, parms));
10238 top = Fcdr (Fassq (Qtop, parms));
10239
10240 /* Move the tooltip window where the mouse pointer is. Resize and
10241 show it. */
10242 if (!INTEGERP (left) || !INTEGERP (top))
10243 {
10244 BLOCK_INPUT;
10245 XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
10246 &root, &child, root_x, root_y, &win_x, &win_y, &pmask);
10247 UNBLOCK_INPUT;
10248 }
10249
10250 if (INTEGERP (top))
10251 *root_y = XINT (top);
10252 else if (*root_y + XINT (dy) - height < 0)
10253 *root_y -= XINT (dy);
10254 else
10255 {
10256 *root_y -= height;
10257 *root_y += XINT (dy);
10258 }
10259
10260 if (INTEGERP (left))
10261 *root_x = XINT (left);
10262 else if (*root_x + XINT (dx) + width <= FRAME_X_DISPLAY_INFO (f)->width)
10263 /* It fits to the right of the pointer. */
10264 *root_x += XINT (dx);
10265 else if (width + XINT (dx) <= *root_x)
10266 /* It fits to the left of the pointer. */
10267 *root_x -= width + XINT (dx);
10268 else
10269 /* Put it left-justified on the screen--it ought to fit that way. */
10270 *root_x = 0;
10271 }
10272
10273
10274 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
10275 doc: /* Show STRING in a "tooltip" window on frame FRAME.
10276 A tooltip window is a small X window displaying a string.
10277
10278 FRAME nil or omitted means use the selected frame.
10279
10280 PARMS is an optional list of frame parameters which can be used to
10281 change the tooltip's appearance.
10282
10283 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
10284 means use the default timeout of 5 seconds.
10285
10286 If the list of frame parameters PARAMS contains a `left' parameters,
10287 the tooltip is displayed at that x-position. Otherwise it is
10288 displayed at the mouse position, with offset DX added (default is 5 if
10289 DX isn't specified). Likewise for the y-position; if a `top' frame
10290 parameter is specified, it determines the y-position of the tooltip
10291 window, otherwise it is displayed at the mouse position, with offset
10292 DY added (default is -10).
10293
10294 A tooltip's maximum size is specified by `x-max-tooltip-size'.
10295 Text larger than the specified size is clipped. */)
10296 (string, frame, parms, timeout, dx, dy)
10297 Lisp_Object string, frame, parms, timeout, dx, dy;
10298 {
10299 struct frame *f;
10300 struct window *w;
10301 int root_x, root_y;
10302 struct buffer *old_buffer;
10303 struct text_pos pos;
10304 int i, width, height;
10305 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
10306 int old_windows_or_buffers_changed = windows_or_buffers_changed;
10307 int count = SPECPDL_INDEX ();
10308
10309 specbind (Qinhibit_redisplay, Qt);
10310
10311 GCPRO4 (string, parms, frame, timeout);
10312
10313 CHECK_STRING (string);
10314 f = check_x_frame (frame);
10315 if (NILP (timeout))
10316 timeout = make_number (5);
10317 else
10318 CHECK_NATNUM (timeout);
10319
10320 if (NILP (dx))
10321 dx = make_number (5);
10322 else
10323 CHECK_NUMBER (dx);
10324
10325 if (NILP (dy))
10326 dy = make_number (-10);
10327 else
10328 CHECK_NUMBER (dy);
10329
10330 if (NILP (last_show_tip_args))
10331 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
10332
10333 if (!NILP (tip_frame))
10334 {
10335 Lisp_Object last_string = AREF (last_show_tip_args, 0);
10336 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
10337 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
10338
10339 if (EQ (frame, last_frame)
10340 && !NILP (Fequal (last_string, string))
10341 && !NILP (Fequal (last_parms, parms)))
10342 {
10343 struct frame *f = XFRAME (tip_frame);
10344
10345 /* Only DX and DY have changed. */
10346 if (!NILP (tip_timer))
10347 {
10348 Lisp_Object timer = tip_timer;
10349 tip_timer = Qnil;
10350 call1 (Qcancel_timer, timer);
10351 }
10352
10353 BLOCK_INPUT;
10354 compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f),
10355 FRAME_PIXEL_HEIGHT (f), &root_x, &root_y);
10356 XMoveWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10357 root_x, root_y);
10358 UNBLOCK_INPUT;
10359 goto start_timer;
10360 }
10361 }
10362
10363 /* Hide a previous tip, if any. */
10364 Fx_hide_tip ();
10365
10366 ASET (last_show_tip_args, 0, string);
10367 ASET (last_show_tip_args, 1, frame);
10368 ASET (last_show_tip_args, 2, parms);
10369
10370 /* Add default values to frame parameters. */
10371 if (NILP (Fassq (Qname, parms)))
10372 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
10373 if (NILP (Fassq (Qinternal_border_width, parms)))
10374 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
10375 if (NILP (Fassq (Qborder_width, parms)))
10376 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
10377 if (NILP (Fassq (Qborder_color, parms)))
10378 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
10379 if (NILP (Fassq (Qbackground_color, parms)))
10380 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
10381 parms);
10382
10383 /* Create a frame for the tooltip, and record it in the global
10384 variable tip_frame. */
10385 frame = x_create_tip_frame (FRAME_X_DISPLAY_INFO (f), parms, string);
10386 f = XFRAME (frame);
10387
10388 /* Set up the frame's root window. */
10389 w = XWINDOW (FRAME_ROOT_WINDOW (f));
10390 w->left_col = w->top_line = make_number (0);
10391
10392 if (CONSP (Vx_max_tooltip_size)
10393 && INTEGERP (XCAR (Vx_max_tooltip_size))
10394 && XINT (XCAR (Vx_max_tooltip_size)) > 0
10395 && INTEGERP (XCDR (Vx_max_tooltip_size))
10396 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
10397 {
10398 w->total_cols = XCAR (Vx_max_tooltip_size);
10399 w->total_lines = XCDR (Vx_max_tooltip_size);
10400 }
10401 else
10402 {
10403 w->total_cols = make_number (80);
10404 w->total_lines = make_number (40);
10405 }
10406
10407 FRAME_TOTAL_COLS (f) = XINT (w->total_cols);
10408 adjust_glyphs (f);
10409 w->pseudo_window_p = 1;
10410
10411 /* Display the tooltip text in a temporary buffer. */
10412 old_buffer = current_buffer;
10413 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
10414 current_buffer->truncate_lines = Qnil;
10415 clear_glyph_matrix (w->desired_matrix);
10416 clear_glyph_matrix (w->current_matrix);
10417 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
10418 try_window (FRAME_ROOT_WINDOW (f), pos);
10419
10420 /* Compute width and height of the tooltip. */
10421 width = height = 0;
10422 for (i = 0; i < w->desired_matrix->nrows; ++i)
10423 {
10424 struct glyph_row *row = &w->desired_matrix->rows[i];
10425 struct glyph *last;
10426 int row_width;
10427
10428 /* Stop at the first empty row at the end. */
10429 if (!row->enabled_p || !row->displays_text_p)
10430 break;
10431
10432 /* Let the row go over the full width of the frame. */
10433 row->full_width_p = 1;
10434
10435 /* There's a glyph at the end of rows that is used to place
10436 the cursor there. Don't include the width of this glyph. */
10437 if (row->used[TEXT_AREA])
10438 {
10439 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
10440 row_width = row->pixel_width - last->pixel_width;
10441 }
10442 else
10443 row_width = row->pixel_width;
10444
10445 height += row->height;
10446 width = max (width, row_width);
10447 }
10448
10449 /* Add the frame's internal border to the width and height the X
10450 window should have. */
10451 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
10452 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
10453
10454 /* Move the tooltip window where the mouse pointer is. Resize and
10455 show it. */
10456 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
10457
10458 BLOCK_INPUT;
10459 XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10460 root_x, root_y, width, height);
10461 XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
10462 UNBLOCK_INPUT;
10463
10464 /* Draw into the window. */
10465 w->must_be_updated_p = 1;
10466 update_single_window (w, 1);
10467
10468 /* Restore original current buffer. */
10469 set_buffer_internal_1 (old_buffer);
10470 windows_or_buffers_changed = old_windows_or_buffers_changed;
10471
10472 start_timer:
10473 /* Let the tip disappear after timeout seconds. */
10474 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
10475 intern ("x-hide-tip"));
10476
10477 UNGCPRO;
10478 return unbind_to (count, Qnil);
10479 }
10480
10481
10482 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
10483 doc: /* Hide the current tooltip window, if there is any.
10484 Value is t if tooltip was open, nil otherwise. */)
10485 ()
10486 {
10487 int count;
10488 Lisp_Object deleted, frame, timer;
10489 struct gcpro gcpro1, gcpro2;
10490
10491 /* Return quickly if nothing to do. */
10492 if (NILP (tip_timer) && NILP (tip_frame))
10493 return Qnil;
10494
10495 frame = tip_frame;
10496 timer = tip_timer;
10497 GCPRO2 (frame, timer);
10498 tip_frame = tip_timer = deleted = Qnil;
10499
10500 count = SPECPDL_INDEX ();
10501 specbind (Qinhibit_redisplay, Qt);
10502 specbind (Qinhibit_quit, Qt);
10503
10504 if (!NILP (timer))
10505 call1 (Qcancel_timer, timer);
10506
10507 if (FRAMEP (frame))
10508 {
10509 Fdelete_frame (frame, Qnil);
10510 deleted = Qt;
10511
10512 #ifdef USE_LUCID
10513 /* Bloodcurdling hack alert: The Lucid menu bar widget's
10514 redisplay procedure is not called when a tip frame over menu
10515 items is unmapped. Redisplay the menu manually... */
10516 {
10517 struct frame *f = SELECTED_FRAME ();
10518 Widget w = f->output_data.x->menubar_widget;
10519 extern void xlwmenu_redisplay P_ ((Widget));
10520
10521 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f)->screen)
10522 && w != NULL)
10523 {
10524 BLOCK_INPUT;
10525 xlwmenu_redisplay (w);
10526 UNBLOCK_INPUT;
10527 }
10528 }
10529 #endif /* USE_LUCID */
10530 }
10531
10532 UNGCPRO;
10533 return unbind_to (count, deleted);
10534 }
10535
10536
10537 \f
10538 /***********************************************************************
10539 File selection dialog
10540 ***********************************************************************/
10541
10542 #ifdef USE_MOTIF
10543
10544 /* Callback for "OK" and "Cancel" on file selection dialog. */
10545
10546 static void
10547 file_dialog_cb (widget, client_data, call_data)
10548 Widget widget;
10549 XtPointer call_data, client_data;
10550 {
10551 int *result = (int *) client_data;
10552 XmAnyCallbackStruct *cb = (XmAnyCallbackStruct *) call_data;
10553 *result = cb->reason;
10554 }
10555
10556
10557 /* Callback for unmapping a file selection dialog. This is used to
10558 capture the case where a dialog is closed via a window manager's
10559 closer button, for example. Using a XmNdestroyCallback didn't work
10560 in this case. */
10561
10562 static void
10563 file_dialog_unmap_cb (widget, client_data, call_data)
10564 Widget widget;
10565 XtPointer call_data, client_data;
10566 {
10567 int *result = (int *) client_data;
10568 *result = XmCR_CANCEL;
10569 }
10570
10571
10572 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
10573 doc: /* Read file name, prompting with PROMPT in directory DIR.
10574 Use a file selection dialog.
10575 Select DEFAULT-FILENAME in the dialog's file selection box, if
10576 specified. Don't let the user enter a file name in the file
10577 selection dialog's entry field, if MUSTMATCH is non-nil. */)
10578 (prompt, dir, default_filename, mustmatch)
10579 Lisp_Object prompt, dir, default_filename, mustmatch;
10580 {
10581 int result;
10582 struct frame *f = SELECTED_FRAME ();
10583 Lisp_Object file = Qnil;
10584 Widget dialog, text, list, help;
10585 Arg al[10];
10586 int ac = 0;
10587 extern XtAppContext Xt_app_con;
10588 XmString dir_xmstring, pattern_xmstring;
10589 int count = SPECPDL_INDEX ();
10590 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
10591
10592 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
10593 CHECK_STRING (prompt);
10594 CHECK_STRING (dir);
10595
10596 /* Prevent redisplay. */
10597 specbind (Qinhibit_redisplay, Qt);
10598
10599 BLOCK_INPUT;
10600
10601 /* Create the dialog with PROMPT as title, using DIR as initial
10602 directory and using "*" as pattern. */
10603 dir = Fexpand_file_name (dir, Qnil);
10604 dir_xmstring = XmStringCreateLocalized (SDATA (dir));
10605 pattern_xmstring = XmStringCreateLocalized ("*");
10606
10607 XtSetArg (al[ac], XmNtitle, SDATA (prompt)); ++ac;
10608 XtSetArg (al[ac], XmNdirectory, dir_xmstring); ++ac;
10609 XtSetArg (al[ac], XmNpattern, pattern_xmstring); ++ac;
10610 XtSetArg (al[ac], XmNresizePolicy, XmRESIZE_GROW); ++ac;
10611 XtSetArg (al[ac], XmNdialogStyle, XmDIALOG_APPLICATION_MODAL); ++ac;
10612 dialog = XmCreateFileSelectionDialog (f->output_data.x->widget,
10613 "fsb", al, ac);
10614 XmStringFree (dir_xmstring);
10615 XmStringFree (pattern_xmstring);
10616
10617 /* Add callbacks for OK and Cancel. */
10618 XtAddCallback (dialog, XmNokCallback, file_dialog_cb,
10619 (XtPointer) &result);
10620 XtAddCallback (dialog, XmNcancelCallback, file_dialog_cb,
10621 (XtPointer) &result);
10622 XtAddCallback (dialog, XmNunmapCallback, file_dialog_unmap_cb,
10623 (XtPointer) &result);
10624
10625 /* Disable the help button since we can't display help. */
10626 help = XmFileSelectionBoxGetChild (dialog, XmDIALOG_HELP_BUTTON);
10627 XtSetSensitive (help, False);
10628
10629 /* Mark OK button as default. */
10630 XtVaSetValues (XmFileSelectionBoxGetChild (dialog, XmDIALOG_OK_BUTTON),
10631 XmNshowAsDefault, True, NULL);
10632
10633 /* If MUSTMATCH is non-nil, disable the file entry field of the
10634 dialog, so that the user must select a file from the files list
10635 box. We can't remove it because we wouldn't have a way to get at
10636 the result file name, then. */
10637 text = XmFileSelectionBoxGetChild (dialog, XmDIALOG_TEXT);
10638 if (!NILP (mustmatch))
10639 {
10640 Widget label;
10641 label = XmFileSelectionBoxGetChild (dialog, XmDIALOG_SELECTION_LABEL);
10642 XtSetSensitive (text, False);
10643 XtSetSensitive (label, False);
10644 }
10645
10646 /* Manage the dialog, so that list boxes get filled. */
10647 XtManageChild (dialog);
10648
10649 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
10650 must include the path for this to work. */
10651 list = XmFileSelectionBoxGetChild (dialog, XmDIALOG_LIST);
10652 if (STRINGP (default_filename))
10653 {
10654 XmString default_xmstring;
10655 int item_pos;
10656
10657 default_xmstring
10658 = XmStringCreateLocalized (SDATA (default_filename));
10659
10660 if (!XmListItemExists (list, default_xmstring))
10661 {
10662 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10663 XmListAddItem (list, default_xmstring, 0);
10664 item_pos = 0;
10665 }
10666 else
10667 item_pos = XmListItemPos (list, default_xmstring);
10668 XmStringFree (default_xmstring);
10669
10670 /* Select the item and scroll it into view. */
10671 XmListSelectPos (list, item_pos, True);
10672 XmListSetPos (list, item_pos);
10673 }
10674
10675 /* Process events until the user presses Cancel or OK. */
10676 result = 0;
10677 while (result == 0)
10678 {
10679 XEvent event;
10680 XtAppNextEvent (Xt_app_con, &event);
10681 (void) x_dispatch_event (&event, FRAME_X_DISPLAY (f) );
10682 }
10683
10684 /* Get the result. */
10685 if (result == XmCR_OK)
10686 {
10687 XmString text;
10688 String data;
10689
10690 XtVaGetValues (dialog, XmNtextString, &text, NULL);
10691 XmStringGetLtoR (text, XmFONTLIST_DEFAULT_TAG, &data);
10692 XmStringFree (text);
10693 file = build_string (data);
10694 XtFree (data);
10695 }
10696 else
10697 file = Qnil;
10698
10699 /* Clean up. */
10700 XtUnmanageChild (dialog);
10701 XtDestroyWidget (dialog);
10702 UNBLOCK_INPUT;
10703 UNGCPRO;
10704
10705 /* Make "Cancel" equivalent to C-g. */
10706 if (NILP (file))
10707 Fsignal (Qquit, Qnil);
10708
10709 return unbind_to (count, file);
10710 }
10711
10712 #endif /* USE_MOTIF */
10713
10714 #ifdef USE_GTK
10715
10716 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
10717 "Read file name, prompting with PROMPT in directory DIR.\n\
10718 Use a file selection dialog.\n\
10719 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
10720 specified. Don't let the user enter a file name in the file\n\
10721 selection dialog's entry field, if MUSTMATCH is non-nil.")
10722 (prompt, dir, default_filename, mustmatch)
10723 Lisp_Object prompt, dir, default_filename, mustmatch;
10724 {
10725 FRAME_PTR f = SELECTED_FRAME ();
10726 char *fn;
10727 Lisp_Object file = Qnil;
10728 int count = specpdl_ptr - specpdl;
10729 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
10730 char *cdef_file;
10731 char *cprompt;
10732
10733 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
10734 CHECK_STRING (prompt);
10735 CHECK_STRING (dir);
10736
10737 /* Prevent redisplay. */
10738 specbind (Qinhibit_redisplay, Qt);
10739
10740 BLOCK_INPUT;
10741
10742 if (STRINGP (default_filename))
10743 cdef_file = SDATA (default_filename);
10744 else
10745 cdef_file = SDATA (dir);
10746
10747 fn = xg_get_file_name (f, SDATA (prompt), cdef_file, ! NILP (mustmatch));
10748
10749 if (fn)
10750 {
10751 file = build_string (fn);
10752 xfree (fn);
10753 }
10754
10755 UNBLOCK_INPUT;
10756 UNGCPRO;
10757
10758 /* Make "Cancel" equivalent to C-g. */
10759 if (NILP (file))
10760 Fsignal (Qquit, Qnil);
10761
10762 return unbind_to (count, file);
10763 }
10764
10765 #endif /* USE_GTK */
10766
10767 \f
10768 /***********************************************************************
10769 Keyboard
10770 ***********************************************************************/
10771
10772 #ifdef HAVE_XKBGETKEYBOARD
10773 #include <X11/XKBlib.h>
10774 #include <X11/keysym.h>
10775 #endif
10776
10777 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p,
10778 Sx_backspace_delete_keys_p, 0, 1, 0,
10779 doc: /* Check if both Backspace and Delete keys are on the keyboard of FRAME.
10780 FRAME nil means use the selected frame.
10781 Value is t if we know that both keys are present, and are mapped to the
10782 usual X keysyms. */)
10783 (frame)
10784 Lisp_Object frame;
10785 {
10786 #ifdef HAVE_XKBGETKEYBOARD
10787 XkbDescPtr kb;
10788 struct frame *f = check_x_frame (frame);
10789 Display *dpy = FRAME_X_DISPLAY (f);
10790 Lisp_Object have_keys;
10791 int major, minor, op, event, error;
10792
10793 BLOCK_INPUT;
10794
10795 /* Check library version in case we're dynamically linked. */
10796 major = XkbMajorVersion;
10797 minor = XkbMinorVersion;
10798 if (!XkbLibraryVersion (&major, &minor))
10799 {
10800 UNBLOCK_INPUT;
10801 return Qnil;
10802 }
10803
10804 /* Check that the server supports XKB. */
10805 major = XkbMajorVersion;
10806 minor = XkbMinorVersion;
10807 if (!XkbQueryExtension (dpy, &op, &event, &error, &major, &minor))
10808 {
10809 UNBLOCK_INPUT;
10810 return Qnil;
10811 }
10812
10813 have_keys = Qnil;
10814 kb = XkbGetMap (dpy, XkbAllMapComponentsMask, XkbUseCoreKbd);
10815 if (kb)
10816 {
10817 int delete_keycode = 0, backspace_keycode = 0, i;
10818
10819 if (XkbGetNames (dpy, XkbAllNamesMask, kb) == Success)
10820 {
10821 for (i = kb->min_key_code;
10822 (i < kb->max_key_code
10823 && (delete_keycode == 0 || backspace_keycode == 0));
10824 ++i)
10825 {
10826 /* The XKB symbolic key names can be seen most easily in
10827 the PS file generated by `xkbprint -label name
10828 $DISPLAY'. */
10829 if (bcmp ("DELE", kb->names->keys[i].name, 4) == 0)
10830 delete_keycode = i;
10831 else if (bcmp ("BKSP", kb->names->keys[i].name, 4) == 0)
10832 backspace_keycode = i;
10833 }
10834
10835 XkbFreeNames (kb, 0, True);
10836 }
10837
10838 XkbFreeClientMap (kb, 0, True);
10839
10840 if (delete_keycode
10841 && backspace_keycode
10842 && XKeysymToKeycode (dpy, XK_Delete) == delete_keycode
10843 && XKeysymToKeycode (dpy, XK_BackSpace) == backspace_keycode)
10844 have_keys = Qt;
10845 }
10846 UNBLOCK_INPUT;
10847 return have_keys;
10848 #else /* not HAVE_XKBGETKEYBOARD */
10849 return Qnil;
10850 #endif /* not HAVE_XKBGETKEYBOARD */
10851 }
10852
10853
10854 \f
10855 /***********************************************************************
10856 Initialization
10857 ***********************************************************************/
10858
10859 /* Keep this list in the same order as frame_parms in frame.c.
10860 Use 0 for unsupported frame parameters. */
10861
10862 frame_parm_handler x_frame_parm_handlers[] =
10863 {
10864 x_set_autoraise,
10865 x_set_autolower,
10866 x_set_background_color,
10867 x_set_border_color,
10868 x_set_border_width,
10869 x_set_cursor_color,
10870 x_set_cursor_type,
10871 x_set_font,
10872 x_set_foreground_color,
10873 x_set_icon_name,
10874 x_set_icon_type,
10875 x_set_internal_border_width,
10876 x_set_menu_bar_lines,
10877 x_set_mouse_color,
10878 x_explicitly_set_name,
10879 x_set_scroll_bar_width,
10880 x_set_title,
10881 x_set_unsplittable,
10882 x_set_vertical_scroll_bars,
10883 x_set_visibility,
10884 x_set_tool_bar_lines,
10885 x_set_scroll_bar_foreground,
10886 x_set_scroll_bar_background,
10887 x_set_screen_gamma,
10888 x_set_line_spacing,
10889 x_set_fringe_width,
10890 x_set_fringe_width,
10891 x_set_wait_for_wm,
10892 x_set_fullscreen,
10893 };
10894
10895 void
10896 syms_of_xfns ()
10897 {
10898 /* This is zero if not using X windows. */
10899 x_in_use = 0;
10900
10901 /* The section below is built by the lisp expression at the top of the file,
10902 just above where these variables are declared. */
10903 /*&&& init symbols here &&&*/
10904 Qnone = intern ("none");
10905 staticpro (&Qnone);
10906 Qsuppress_icon = intern ("suppress-icon");
10907 staticpro (&Qsuppress_icon);
10908 Qundefined_color = intern ("undefined-color");
10909 staticpro (&Qundefined_color);
10910 Qcenter = intern ("center");
10911 staticpro (&Qcenter);
10912 Qcompound_text = intern ("compound-text");
10913 staticpro (&Qcompound_text);
10914 Qcancel_timer = intern ("cancel-timer");
10915 staticpro (&Qcancel_timer);
10916 /* This is the end of symbol initialization. */
10917
10918 /* Text property `display' should be nonsticky by default. */
10919 Vtext_property_default_nonsticky
10920 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
10921
10922
10923 Qlaplace = intern ("laplace");
10924 staticpro (&Qlaplace);
10925 Qemboss = intern ("emboss");
10926 staticpro (&Qemboss);
10927 Qedge_detection = intern ("edge-detection");
10928 staticpro (&Qedge_detection);
10929 Qheuristic = intern ("heuristic");
10930 staticpro (&Qheuristic);
10931 QCmatrix = intern (":matrix");
10932 staticpro (&QCmatrix);
10933 QCcolor_adjustment = intern (":color-adjustment");
10934 staticpro (&QCcolor_adjustment);
10935 QCmask = intern (":mask");
10936 staticpro (&QCmask);
10937
10938 Fput (Qundefined_color, Qerror_conditions,
10939 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
10940 Fput (Qundefined_color, Qerror_message,
10941 build_string ("Undefined color"));
10942
10943 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images,
10944 doc: /* Non-nil means always draw a cross over disabled images.
10945 Disabled images are those having an `:conversion disabled' property.
10946 A cross is always drawn on black & white displays. */);
10947 cross_disabled_images = 0;
10948
10949 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
10950 doc: /* List of directories to search for window system bitmap files. */);
10951 Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
10952
10953 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
10954 doc: /* The shape of the pointer when over text.
10955 Changing the value does not affect existing frames
10956 unless you set the mouse color. */);
10957 Vx_pointer_shape = Qnil;
10958
10959 #if 0 /* This doesn't really do anything. */
10960 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
10961 doc: /* The shape of the pointer when not over text.
10962 This variable takes effect when you create a new frame
10963 or when you set the mouse color. */);
10964 #endif
10965 Vx_nontext_pointer_shape = Qnil;
10966
10967 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
10968 doc: /* The shape of the pointer when Emacs is busy.
10969 This variable takes effect when you create a new frame
10970 or when you set the mouse color. */);
10971 Vx_hourglass_pointer_shape = Qnil;
10972
10973 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
10974 doc: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
10975 display_hourglass_p = 1;
10976
10977 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
10978 doc: /* *Seconds to wait before displaying an hourglass pointer.
10979 Value must be an integer or float. */);
10980 Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
10981
10982 #if 0 /* This doesn't really do anything. */
10983 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
10984 doc: /* The shape of the pointer when over the mode line.
10985 This variable takes effect when you create a new frame
10986 or when you set the mouse color. */);
10987 #endif
10988 Vx_mode_pointer_shape = Qnil;
10989
10990 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
10991 &Vx_sensitive_text_pointer_shape,
10992 doc: /* The shape of the pointer when over mouse-sensitive text.
10993 This variable takes effect when you create a new frame
10994 or when you set the mouse color. */);
10995 Vx_sensitive_text_pointer_shape = Qnil;
10996
10997 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
10998 &Vx_window_horizontal_drag_shape,
10999 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
11000 This variable takes effect when you create a new frame
11001 or when you set the mouse color. */);
11002 Vx_window_horizontal_drag_shape = Qnil;
11003
11004 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
11005 doc: /* A string indicating the foreground color of the cursor box. */);
11006 Vx_cursor_fore_pixel = Qnil;
11007
11008 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
11009 doc: /* Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).
11010 Text larger than this is clipped. */);
11011 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
11012
11013 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
11014 doc: /* Non-nil if no X window manager is in use.
11015 Emacs doesn't try to figure this out; this is always nil
11016 unless you set it to something else. */);
11017 /* We don't have any way to find this out, so set it to nil
11018 and maybe the user would like to set it to t. */
11019 Vx_no_window_manager = Qnil;
11020
11021 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11022 &Vx_pixel_size_width_font_regexp,
11023 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
11024
11025 Since Emacs gets width of a font matching with this regexp from
11026 PIXEL_SIZE field of the name, font finding mechanism gets faster for
11027 such a font. This is especially effective for such large fonts as
11028 Chinese, Japanese, and Korean. */);
11029 Vx_pixel_size_width_font_regexp = Qnil;
11030
11031 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay,
11032 doc: /* Time after which cached images are removed from the cache.
11033 When an image has not been displayed this many seconds, remove it
11034 from the image cache. Value must be an integer or nil with nil
11035 meaning don't clear the cache. */);
11036 Vimage_cache_eviction_delay = make_number (30 * 60);
11037
11038 #ifdef USE_X_TOOLKIT
11039 Fprovide (intern ("x-toolkit"), Qnil);
11040 #ifdef USE_MOTIF
11041 Fprovide (intern ("motif"), Qnil);
11042
11043 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string,
11044 doc: /* Version info for LessTif/Motif. */);
11045 Vmotif_version_string = build_string (XmVERSION_STRING);
11046 #endif /* USE_MOTIF */
11047 #endif /* USE_X_TOOLKIT */
11048
11049 #ifdef USE_GTK
11050 Fprovide (intern ("gtk"), Qnil);
11051
11052 DEFVAR_LISP ("gtk-version-string", &Vgtk_version_string,
11053 doc: /* Version info for GTK+. */);
11054 {
11055 char gtk_version[40];
11056 g_snprintf (gtk_version, sizeof (gtk_version), "%u.%u.%u",
11057 GTK_MAJOR_VERSION, GTK_MINOR_VERSION, GTK_MICRO_VERSION);
11058 Vgtk_version_string = build_string (gtk_version);
11059 }
11060 #endif /* USE_GTK */
11061
11062 /* X window properties. */
11063 defsubr (&Sx_change_window_property);
11064 defsubr (&Sx_delete_window_property);
11065 defsubr (&Sx_window_property);
11066
11067 defsubr (&Sxw_display_color_p);
11068 defsubr (&Sx_display_grayscale_p);
11069 defsubr (&Sxw_color_defined_p);
11070 defsubr (&Sxw_color_values);
11071 defsubr (&Sx_server_max_request_size);
11072 defsubr (&Sx_server_vendor);
11073 defsubr (&Sx_server_version);
11074 defsubr (&Sx_display_pixel_width);
11075 defsubr (&Sx_display_pixel_height);
11076 defsubr (&Sx_display_mm_width);
11077 defsubr (&Sx_display_mm_height);
11078 defsubr (&Sx_display_screens);
11079 defsubr (&Sx_display_planes);
11080 defsubr (&Sx_display_color_cells);
11081 defsubr (&Sx_display_visual_class);
11082 defsubr (&Sx_display_backing_store);
11083 defsubr (&Sx_display_save_under);
11084 defsubr (&Sx_create_frame);
11085 defsubr (&Sx_open_connection);
11086 defsubr (&Sx_close_connection);
11087 defsubr (&Sx_display_list);
11088 defsubr (&Sx_synchronize);
11089 defsubr (&Sx_focus_frame);
11090 defsubr (&Sx_backspace_delete_keys_p);
11091
11092 /* Setting callback functions for fontset handler. */
11093 get_font_info_func = x_get_font_info;
11094
11095 #if 0 /* This function pointer doesn't seem to be used anywhere.
11096 And the pointer assigned has the wrong type, anyway. */
11097 list_fonts_func = x_list_fonts;
11098 #endif
11099
11100 load_font_func = x_load_font;
11101 find_ccl_program_func = x_find_ccl_program;
11102 query_font_func = x_query_font;
11103 set_frame_fontset_func = x_set_font;
11104 check_window_system_func = check_x;
11105
11106 /* Images. */
11107 Qxbm = intern ("xbm");
11108 staticpro (&Qxbm);
11109 QCconversion = intern (":conversion");
11110 staticpro (&QCconversion);
11111 QCheuristic_mask = intern (":heuristic-mask");
11112 staticpro (&QCheuristic_mask);
11113 QCcolor_symbols = intern (":color-symbols");
11114 staticpro (&QCcolor_symbols);
11115 QCascent = intern (":ascent");
11116 staticpro (&QCascent);
11117 QCmargin = intern (":margin");
11118 staticpro (&QCmargin);
11119 QCrelief = intern (":relief");
11120 staticpro (&QCrelief);
11121 Qpostscript = intern ("postscript");
11122 staticpro (&Qpostscript);
11123 QCloader = intern (":loader");
11124 staticpro (&QCloader);
11125 QCbounding_box = intern (":bounding-box");
11126 staticpro (&QCbounding_box);
11127 QCpt_width = intern (":pt-width");
11128 staticpro (&QCpt_width);
11129 QCpt_height = intern (":pt-height");
11130 staticpro (&QCpt_height);
11131 QCindex = intern (":index");
11132 staticpro (&QCindex);
11133 Qpbm = intern ("pbm");
11134 staticpro (&Qpbm);
11135
11136 #if HAVE_XPM
11137 Qxpm = intern ("xpm");
11138 staticpro (&Qxpm);
11139 #endif
11140
11141 #if HAVE_JPEG
11142 Qjpeg = intern ("jpeg");
11143 staticpro (&Qjpeg);
11144 #endif
11145
11146 #if HAVE_TIFF
11147 Qtiff = intern ("tiff");
11148 staticpro (&Qtiff);
11149 #endif
11150
11151 #if HAVE_GIF
11152 Qgif = intern ("gif");
11153 staticpro (&Qgif);
11154 #endif
11155
11156 #if HAVE_PNG
11157 Qpng = intern ("png");
11158 staticpro (&Qpng);
11159 #endif
11160
11161 defsubr (&Sclear_image_cache);
11162 defsubr (&Simage_size);
11163 defsubr (&Simage_mask_p);
11164
11165 hourglass_atimer = NULL;
11166 hourglass_shown_p = 0;
11167
11168 defsubr (&Sx_show_tip);
11169 defsubr (&Sx_hide_tip);
11170 tip_timer = Qnil;
11171 staticpro (&tip_timer);
11172 tip_frame = Qnil;
11173 staticpro (&tip_frame);
11174
11175 last_show_tip_args = Qnil;
11176 staticpro (&last_show_tip_args);
11177
11178 #ifdef USE_MOTIF
11179 defsubr (&Sx_file_dialog);
11180 #endif
11181 }
11182
11183
11184 void
11185 init_xfns ()
11186 {
11187 image_types = NULL;
11188 Vimage_types = Qnil;
11189
11190 define_image_type (&xbm_type);
11191 define_image_type (&gs_type);
11192 define_image_type (&pbm_type);
11193
11194 #if HAVE_XPM
11195 define_image_type (&xpm_type);
11196 #endif
11197
11198 #if HAVE_JPEG
11199 define_image_type (&jpeg_type);
11200 #endif
11201
11202 #if HAVE_TIFF
11203 define_image_type (&tiff_type);
11204 #endif
11205
11206 #if HAVE_GIF
11207 define_image_type (&gif_type);
11208 #endif
11209
11210 #if HAVE_PNG
11211 define_image_type (&png_type);
11212 #endif
11213 }
11214
11215 #endif /* HAVE_X_WINDOWS */
11216
11217 /* arch-tag: 55040d02-5485-4d58-8b22-95a7a05f3288
11218 (do not change this comment) */