(Fdefine_fringe_bitmap): Fix typo in docstring.
[emacs.git] / src / xfns.c
blob3028a61018c51c71da8335648a45cdc73b10b847
1 /* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 97, 98, 99, 2000,01,02,03,04
3 Free Software Foundation.
5 This file is part of GNU Emacs.
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.
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.
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. */
22 #include <config.h>
23 #include <signal.h>
24 #include <stdio.h>
25 #include <math.h>
27 #ifdef HAVE_UNISTD_H
28 #include <unistd.h>
29 #endif
31 /* This makes the fields of a Display accessible, in Xlib header files. */
33 #define XLIB_ILLEGAL_ACCESS
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"
52 #ifdef HAVE_X_WINDOWS
54 #include <ctype.h>
55 #include <sys/types.h>
56 #include <sys/stat.h>
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
68 #ifdef USE_GTK
69 #include "gtkutil.h"
70 #endif
72 #ifdef USE_X_TOOLKIT
73 #include <X11/Shell.h>
75 #ifndef USE_MOTIF
76 #include <X11/Xaw/Paned.h>
77 #include <X11/Xaw/Label.h>
78 #endif /* USE_MOTIF */
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
88 #include "widget.h"
90 #include "../lwlib/lwlib.h"
92 #ifdef USE_MOTIF
93 #include <Xm/Xm.h>
94 #include <Xm/DialogS.h>
95 #include <Xm/FileSB.h>
96 #endif
98 /* Do the EDITRES protocol if running X11R5
99 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
101 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
102 #define HACK_EDITRES
103 extern void _XEditResCheckMessages ();
104 #endif /* R5 + Athena */
106 /* Unique id counter for widgets created by the Lucid Widget Library. */
108 extern LWLIB_ID widget_id_tick;
110 #ifdef USE_LUCID
111 /* This is part of a kludge--see lwlib/xlwmenu.c. */
112 extern XFontStruct *xlwmenu_default_font;
113 #endif
115 extern void free_frame_menubar ();
116 extern double atof ();
118 #ifdef USE_MOTIF
120 /* LessTif/Motif version info. */
122 static Lisp_Object Vmotif_version_string;
124 #endif /* USE_MOTIF */
126 #endif /* USE_X_TOOLKIT */
128 #ifdef USE_GTK
130 /* GTK+ version info */
132 static Lisp_Object Vgtk_version_string;
134 #endif /* USE_GTK */
136 #ifdef HAVE_X11R4
137 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
138 #else
139 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
140 #endif
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. */
146 int gray_bitmap_width = gray_width;
147 int gray_bitmap_height = gray_height;
148 char *gray_bitmap_bits = gray_bits;
150 /* Non-zero means we're allowed to display an hourglass cursor. */
152 int display_hourglass_p;
154 /* The background and shape of the mouse pointer, and shape when not
155 over text or in the modeline. */
157 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
158 Lisp_Object Vx_hourglass_pointer_shape;
160 /* The shape when over mouse-sensitive text. */
162 Lisp_Object Vx_sensitive_text_pointer_shape;
164 /* If non-nil, the pointer shape to indicate that windows can be
165 dragged horizontally. */
167 Lisp_Object Vx_window_horizontal_drag_shape;
169 /* Color of chars displayed in cursor box. */
171 Lisp_Object Vx_cursor_fore_pixel;
173 /* Nonzero if using X. */
175 static int x_in_use;
177 /* Non nil if no window manager is in use. */
179 Lisp_Object Vx_no_window_manager;
181 /* Search path for bitmap files. */
183 Lisp_Object Vx_bitmap_file_path;
185 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
187 Lisp_Object Vx_pixel_size_width_font_regexp;
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;
195 /* In dispnew.c */
197 extern Lisp_Object Vwindow_system_version;
199 /* The below are defined in frame.c. */
201 #if GLYPH_DEBUG
202 int image_cache_refcount, dpyinfo_refcount;
203 #endif
207 /* Error if we are not connected to X. */
209 void
210 check_x ()
212 if (! x_in_use)
213 error ("X windows are not in use or not initialized");
216 /* Nonzero if we can use mouse menus.
217 You should not call this unless HAVE_MENUS is defined. */
220 have_menus_p ()
222 return x_in_use;
225 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
226 and checking validity for X. */
228 FRAME_PTR
229 check_x_frame (frame)
230 Lisp_Object frame;
232 FRAME_PTR f;
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;
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. */
247 struct x_display_info *
248 check_x_display_info (frame)
249 Lisp_Object frame;
251 struct x_display_info *dpyinfo = NULL;
253 if (NILP (frame))
255 struct frame *sf = XFRAME (selected_frame);
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");
264 else if (STRINGP (frame))
265 dpyinfo = x_display_info_for_name (frame);
266 else
268 FRAME_PTR f = check_x_frame (frame);
269 dpyinfo = FRAME_X_DISPLAY_INFO (f);
272 return dpyinfo;
276 /* Return the Emacs frame-object corresponding to an X window.
277 It could be the frame's main window or an icon window. */
279 /* This function can be called during GC, so use GC_xxx type test macros. */
281 struct frame *
282 x_window_to_frame (dpyinfo, wdesc)
283 struct x_display_info *dpyinfo;
284 int wdesc;
286 Lisp_Object tail, frame;
287 struct frame *f;
289 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
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)
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;
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 */
322 return 0;
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. */
329 struct frame *
330 x_any_window_to_frame (dpyinfo, wdesc)
331 struct x_display_info *dpyinfo;
332 int wdesc;
334 Lisp_Object tail, frame;
335 struct frame *f, *found;
336 struct x_output *x;
338 found = NULL;
339 for (tail = Vframe_list; GC_CONSP (tail) && !found; tail = XCDR (tail))
341 frame = XCAR (tail);
342 if (!GC_FRAMEP (frame))
343 continue;
345 f = XFRAME (frame);
346 if (FRAME_X_P (f) && FRAME_X_DISPLAY_INFO (f) == dpyinfo)
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)
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
372 else if (FRAME_X_WINDOW (f) == wdesc)
373 /* A tooltip frame. */
374 found = f;
378 return found;
381 /* Likewise, but exclude the menu bar widget. */
383 struct frame *
384 x_non_menubar_window_to_frame (dpyinfo, wdesc)
385 struct x_display_info *dpyinfo;
386 int wdesc;
388 Lisp_Object tail, frame;
389 struct frame *f;
390 struct x_output *x;
392 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
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)
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
420 else if (FRAME_X_WINDOW (f) == wdesc)
421 /* A tooltip frame. */
422 return f;
424 return 0;
427 /* Likewise, but consider only the menu bar widget. */
429 struct frame *
430 x_menubar_window_to_frame (dpyinfo, wdesc)
431 struct x_display_info *dpyinfo;
432 int wdesc;
434 Lisp_Object tail, frame;
435 struct frame *f;
436 struct x_output *x;
438 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
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)
451 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
452 int found = 0;
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;
462 #else
463 if (x->menubar_widget
464 && lw_window_is_in_menubar (wdesc, x->menubar_widget))
465 return f;
466 #endif
468 return 0;
471 /* Return the frame whose principal (outermost) window is WDESC.
472 If WDESC is some other (smaller) window, we return 0. */
474 struct frame *
475 x_top_window_to_frame (dpyinfo, wdesc)
476 struct x_display_info *dpyinfo;
477 int wdesc;
479 Lisp_Object tail, frame;
480 struct frame *f;
481 struct x_output *x;
483 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
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;
493 if (x->widget)
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
513 else if (FRAME_X_WINDOW (f) == wdesc)
514 /* Tooltip frame. */
515 return f;
517 return 0;
519 #endif /* USE_X_TOOLKIT || USE_GTK */
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.
527 Bitmap indices are guaranteed to be > 0, so a negative number can
528 be used to indicate no bitmap.
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. */
535 /* Functions to access the contents of a bitmap, given an id. */
538 x_bitmap_height (f, id)
539 FRAME_PTR f;
540 int id;
542 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].height;
546 x_bitmap_width (f, id)
547 FRAME_PTR f;
548 int id;
550 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].width;
554 x_bitmap_pixmap (f, id)
555 FRAME_PTR f;
556 int id;
558 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
562 x_bitmap_mask (f, id)
563 FRAME_PTR f;
564 int id;
566 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].mask;
570 /* Allocate a new bitmap record. Returns index of new record. */
572 static int
573 x_allocate_bitmap_record (f)
574 FRAME_PTR f;
576 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
577 int i;
579 if (dpyinfo->bitmaps == NULL)
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;
588 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
589 return ++dpyinfo->bitmaps_last;
591 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
592 if (dpyinfo->bitmaps[i].refcount == 0)
593 return i + 1;
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;
602 /* Add one reference to the reference count of the bitmap with id ID. */
604 void
605 x_reference_bitmap (f, id)
606 FRAME_PTR f;
607 int id;
609 ++FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
612 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
615 x_create_bitmap_from_data (f, bits, width, height)
616 struct frame *f;
617 char *bits;
618 unsigned int width, height;
620 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
621 Pixmap bitmap;
622 int id;
624 bitmap = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
625 bits, width, height);
629 if (! bitmap)
630 return -1;
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;
641 return id;
644 /* Create bitmap from file FILE for frame F. */
647 x_create_bitmap_from_file (f, file)
648 struct frame *f;
649 Lisp_Object file;
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;
659 /* Look for an existing bitmap with the same name. */
660 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
662 if (dpyinfo->bitmaps[id].refcount
663 && dpyinfo->bitmaps[id].file
664 && !strcmp (dpyinfo->bitmaps[id].file, (char *) SDATA (file)))
666 ++dpyinfo->bitmaps[id].refcount;
667 return id + 1;
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);
677 filename = (char *) SDATA (found);
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;
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));
695 return id;
698 /* Remove reference to bitmap with id number ID. */
700 void
701 x_destroy_bitmap (f, id)
702 FRAME_PTR f;
703 int id;
705 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
707 if (id > 0)
709 --dpyinfo->bitmaps[id - 1].refcount;
710 if (dpyinfo->bitmaps[id - 1].refcount == 0)
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)
718 xfree (dpyinfo->bitmaps[id - 1].file);
719 dpyinfo->bitmaps[id - 1].file = NULL;
721 UNBLOCK_INPUT;
726 /* Free all the bitmaps for the display specified by DPYINFO. */
728 static void
729 x_destroy_all_bitmaps (dpyinfo)
730 struct x_display_info *dpyinfo;
732 int i;
733 for (i = 0; i < dpyinfo->bitmaps_last; i++)
734 if (dpyinfo->bitmaps[i].refcount > 0)
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);
742 dpyinfo->bitmaps_last = 0;
748 /* Useful functions defined in the section
749 `Image type independent image structures' below. */
751 static unsigned long four_corners_best P_ ((XImage *ximg, unsigned long width,
752 unsigned long height));
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));
758 static void x_destroy_x_image P_ ((XImage *ximg));
761 /* Create a mask of a bitmap. Note is this not a perfect mask.
762 It's nicer with some borders in this context */
765 x_create_bitmap_mask (f, id)
766 struct frame *f;
767 int id;
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;
777 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
779 if (!(id > 0))
780 return -1;
782 pixmap = x_bitmap_pixmap (f, id);
783 width = x_bitmap_width (f, id);
784 height = x_bitmap_height (f, id);
786 BLOCK_INPUT;
787 ximg = XGetImage (FRAME_X_DISPLAY (f), pixmap, 0, 0, width, height,
788 ~0, ZPixmap);
790 if (!ximg)
792 UNBLOCK_INPUT;
793 return -1;
796 result = x_create_x_image_and_pixmap (f, width, height, 1, &mask_img, &mask);
798 UNBLOCK_INPUT;
799 if (!result)
801 XDestroyImage (ximg);
802 return -1;
805 bg = four_corners_best (ximg, width, height);
807 for (y = 0; y < ximg->height; ++y)
809 for (x = 0; x < ximg->width; ++x)
811 xp = x != ximg->width - 1 ? x + 1 : 0;
812 xm = x != 0 ? x - 1 : ximg->width - 1;
813 yp = y != ximg->height - 1 ? y + 1 : 0;
814 ym = y != 0 ? y - 1 : ximg->height - 1;
815 if (XGetPixel (ximg, x, y) == bg
816 && XGetPixel (ximg, x, yp) == bg
817 && XGetPixel (ximg, x, ym) == bg
818 && XGetPixel (ximg, xp, y) == bg
819 && XGetPixel (ximg, xp, yp) == bg
820 && XGetPixel (ximg, xp, ym) == bg
821 && XGetPixel (ximg, xm, y) == bg
822 && XGetPixel (ximg, xm, yp) == bg
823 && XGetPixel (ximg, xm, ym) == bg)
824 XPutPixel (mask_img, x, y, 0);
825 else
826 XPutPixel (mask_img, x, y, 1);
830 xassert (interrupt_input_blocked);
831 gc = XCreateGC (FRAME_X_DISPLAY (f), mask, 0, NULL);
832 XPutImage (FRAME_X_DISPLAY (f), mask, gc, mask_img, 0, 0, 0, 0,
833 width, height);
834 XFreeGC (FRAME_X_DISPLAY (f), gc);
836 dpyinfo->bitmaps[id - 1].have_mask = 1;
837 dpyinfo->bitmaps[id - 1].mask = mask;
839 XDestroyImage (ximg);
840 x_destroy_x_image (mask_img);
842 return 0;
845 static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
846 static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
847 static void x_disable_image P_ ((struct frame *, struct image *));
849 void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
850 static void x_set_wait_for_wm P_ ((struct frame *, Lisp_Object, Lisp_Object));
851 void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
852 void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
853 void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
854 void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
855 void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
856 void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
857 void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
858 void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
859 void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
860 void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
861 void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
862 void x_set_scroll_bar_foreground P_ ((struct frame *, Lisp_Object,
863 Lisp_Object));
864 void x_set_scroll_bar_background P_ ((struct frame *, Lisp_Object,
865 Lisp_Object));
866 static Lisp_Object x_default_scroll_bar_color_parameter P_ ((struct frame *,
867 Lisp_Object,
868 Lisp_Object,
869 char *, char *,
870 int));
871 static void x_edge_detection P_ ((struct frame *, struct image *, Lisp_Object,
872 Lisp_Object));
873 static void init_color_table P_ ((void));
874 static void free_color_table P_ ((void));
875 static unsigned long *colors_in_color_table P_ ((int *n));
876 static unsigned long lookup_rgb_color P_ ((struct frame *f, int r, int g, int b));
877 static unsigned long lookup_pixel_color P_ ((struct frame *f, unsigned long p));
883 /* Store the screen positions of frame F into XPTR and YPTR.
884 These are the positions of the containing window manager window,
885 not Emacs's own window. */
887 void
888 x_real_positions (f, xptr, yptr)
889 FRAME_PTR f;
890 int *xptr, *yptr;
892 int win_x, win_y, outer_x, outer_y;
893 int real_x = 0, real_y = 0;
894 int had_errors = 0;
895 Window win = f->output_data.x->parent_desc;
897 int count;
899 BLOCK_INPUT;
901 count = x_catch_errors (FRAME_X_DISPLAY (f));
903 if (win == FRAME_X_DISPLAY_INFO (f)->root_window)
904 win = FRAME_OUTER_WINDOW (f);
906 /* This loop traverses up the containment tree until we hit the root
907 window. Window managers may intersect many windows between our window
908 and the root window. The window we find just before the root window
909 should be the outer WM window. */
910 for (;;)
912 Window wm_window, rootw;
913 Window *tmp_children;
914 unsigned int tmp_nchildren;
915 int success;
917 success = XQueryTree (FRAME_X_DISPLAY (f), win, &rootw,
918 &wm_window, &tmp_children, &tmp_nchildren);
920 had_errors = x_had_errors_p (FRAME_X_DISPLAY (f));
922 /* Don't free tmp_children if XQueryTree failed. */
923 if (! success)
924 break;
926 XFree ((char *) tmp_children);
928 if (wm_window == rootw || had_errors)
929 break;
931 win = wm_window;
934 if (! had_errors)
936 int ign;
937 Window child, rootw;
939 /* Get the real coordinates for the WM window upper left corner */
940 XGetGeometry (FRAME_X_DISPLAY (f), win,
941 &rootw, &real_x, &real_y, &ign, &ign, &ign, &ign);
943 /* Translate real coordinates to coordinates relative to our
944 window. For our window, the upper left corner is 0, 0.
945 Since the upper left corner of the WM window is outside
946 our window, win_x and win_y will be negative:
948 ------------------ ---> x
949 | title |
950 | ----------------- v y
951 | | our window
953 XTranslateCoordinates (FRAME_X_DISPLAY (f),
955 /* From-window, to-window. */
956 FRAME_X_DISPLAY_INFO (f)->root_window,
957 FRAME_X_WINDOW (f),
959 /* From-position, to-position. */
960 real_x, real_y, &win_x, &win_y,
962 /* Child of win. */
963 &child);
965 if (FRAME_X_WINDOW (f) == FRAME_OUTER_WINDOW (f))
967 outer_x = win_x;
968 outer_y = win_y;
970 else
972 XTranslateCoordinates (FRAME_X_DISPLAY (f),
974 /* From-window, to-window. */
975 FRAME_X_DISPLAY_INFO (f)->root_window,
976 FRAME_OUTER_WINDOW (f),
978 /* From-position, to-position. */
979 real_x, real_y, &outer_x, &outer_y,
981 /* Child of win. */
982 &child);
985 had_errors = x_had_errors_p (FRAME_X_DISPLAY (f));
988 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
990 UNBLOCK_INPUT;
992 if (had_errors) return;
994 f->x_pixels_diff = -win_x;
995 f->y_pixels_diff = -win_y;
997 FRAME_X_OUTPUT (f)->x_pixels_outer_diff = -outer_x;
998 FRAME_X_OUTPUT (f)->y_pixels_outer_diff = -outer_y;
1000 *xptr = real_x;
1001 *yptr = real_y;
1007 /* Gamma-correct COLOR on frame F. */
1009 void
1010 gamma_correct (f, color)
1011 struct frame *f;
1012 XColor *color;
1014 if (f->gamma)
1016 color->red = pow (color->red / 65535.0, f->gamma) * 65535.0 + 0.5;
1017 color->green = pow (color->green / 65535.0, f->gamma) * 65535.0 + 0.5;
1018 color->blue = pow (color->blue / 65535.0, f->gamma) * 65535.0 + 0.5;
1023 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1024 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1025 allocate the color. Value is zero if COLOR_NAME is invalid, or
1026 no color could be allocated. */
1029 x_defined_color (f, color_name, color, alloc_p)
1030 struct frame *f;
1031 char *color_name;
1032 XColor *color;
1033 int alloc_p;
1035 int success_p;
1036 Display *dpy = FRAME_X_DISPLAY (f);
1037 Colormap cmap = FRAME_X_COLORMAP (f);
1039 BLOCK_INPUT;
1040 success_p = XParseColor (dpy, cmap, color_name, color);
1041 if (success_p && alloc_p)
1042 success_p = x_alloc_nearest_color (f, cmap, color);
1043 UNBLOCK_INPUT;
1045 return success_p;
1049 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1050 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1051 Signal an error if color can't be allocated. */
1054 x_decode_color (f, color_name, mono_color)
1055 FRAME_PTR f;
1056 Lisp_Object color_name;
1057 int mono_color;
1059 XColor cdef;
1061 CHECK_STRING (color_name);
1063 #if 0 /* Don't do this. It's wrong when we're not using the default
1064 colormap, it makes freeing difficult, and it's probably not
1065 an important optimization. */
1066 if (strcmp (SDATA (color_name), "black") == 0)
1067 return BLACK_PIX_DEFAULT (f);
1068 else if (strcmp (SDATA (color_name), "white") == 0)
1069 return WHITE_PIX_DEFAULT (f);
1070 #endif
1072 /* Return MONO_COLOR for monochrome frames. */
1073 if (FRAME_X_DISPLAY_INFO (f)->n_planes == 1)
1074 return mono_color;
1076 /* x_defined_color is responsible for coping with failures
1077 by looking for a near-miss. */
1078 if (x_defined_color (f, SDATA (color_name), &cdef, 1))
1079 return cdef.pixel;
1081 Fsignal (Qerror, Fcons (build_string ("Undefined color"),
1082 Fcons (color_name, Qnil)));
1083 return 0;
1088 /* Change the `wait-for-wm' frame parameter of frame F. OLD_VALUE is
1089 the previous value of that parameter, NEW_VALUE is the new value.
1090 See also the comment of wait_for_wm in struct x_output. */
1092 static void
1093 x_set_wait_for_wm (f, new_value, old_value)
1094 struct frame *f;
1095 Lisp_Object new_value, old_value;
1097 f->output_data.x->wait_for_wm = !NILP (new_value);
1100 #ifdef USE_GTK
1102 static Lisp_Object x_find_image_file P_ ((Lisp_Object file));
1104 /* Set icon from FILE for frame F. By using GTK functions the icon
1105 may be any format that GdkPixbuf knows about, i.e. not just bitmaps. */
1108 xg_set_icon (f, file)
1109 FRAME_PTR f;
1110 Lisp_Object file;
1112 struct gcpro gcpro1;
1113 int result = 0;
1114 Lisp_Object found;
1116 GCPRO1 (found);
1118 found = x_find_image_file (file);
1120 if (! NILP (found))
1122 GdkPixbuf *pixbuf;
1123 GError *err = NULL;
1124 char *filename;
1126 filename = SDATA (found);
1127 BLOCK_INPUT;
1129 pixbuf = gdk_pixbuf_new_from_file (filename, &err);
1131 if (pixbuf)
1133 gtk_window_set_icon (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
1134 pixbuf);
1135 g_object_unref (pixbuf);
1137 result = 1;
1139 else
1140 g_error_free (err);
1142 UNBLOCK_INPUT;
1145 UNGCPRO;
1146 return result;
1148 #endif /* USE_GTK */
1151 /* Functions called only from `x_set_frame_param'
1152 to set individual parameters.
1154 If FRAME_X_WINDOW (f) is 0,
1155 the frame is being created and its X-window does not exist yet.
1156 In that case, just record the parameter's new value
1157 in the standard place; do not attempt to change the window. */
1159 void
1160 x_set_foreground_color (f, arg, oldval)
1161 struct frame *f;
1162 Lisp_Object arg, oldval;
1164 struct x_output *x = f->output_data.x;
1165 unsigned long fg, old_fg;
1167 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1168 old_fg = x->foreground_pixel;
1169 x->foreground_pixel = fg;
1171 if (FRAME_X_WINDOW (f) != 0)
1173 Display *dpy = FRAME_X_DISPLAY (f);
1175 BLOCK_INPUT;
1176 XSetForeground (dpy, x->normal_gc, fg);
1177 XSetBackground (dpy, x->reverse_gc, fg);
1179 if (x->cursor_pixel == old_fg)
1181 unload_color (f, x->cursor_pixel);
1182 x->cursor_pixel = x_copy_color (f, fg);
1183 XSetBackground (dpy, x->cursor_gc, x->cursor_pixel);
1186 UNBLOCK_INPUT;
1188 update_face_from_frame_parameter (f, Qforeground_color, arg);
1190 if (FRAME_VISIBLE_P (f))
1191 redraw_frame (f);
1194 unload_color (f, old_fg);
1197 void
1198 x_set_background_color (f, arg, oldval)
1199 struct frame *f;
1200 Lisp_Object arg, oldval;
1202 struct x_output *x = f->output_data.x;
1203 unsigned long bg;
1205 bg = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1206 unload_color (f, x->background_pixel);
1207 x->background_pixel = bg;
1209 if (FRAME_X_WINDOW (f) != 0)
1211 Display *dpy = FRAME_X_DISPLAY (f);
1213 BLOCK_INPUT;
1214 XSetBackground (dpy, x->normal_gc, bg);
1215 XSetForeground (dpy, x->reverse_gc, bg);
1216 XSetWindowBackground (dpy, FRAME_X_WINDOW (f), bg);
1217 XSetForeground (dpy, x->cursor_gc, bg);
1219 #ifdef USE_GTK
1220 xg_set_background_color (f, bg);
1221 #endif
1223 #ifndef USE_TOOLKIT_SCROLL_BARS /* Turns out to be annoying with
1224 toolkit scroll bars. */
1226 Lisp_Object bar;
1227 for (bar = FRAME_SCROLL_BARS (f);
1228 !NILP (bar);
1229 bar = XSCROLL_BAR (bar)->next)
1231 Window window = SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar));
1232 XSetWindowBackground (dpy, window, bg);
1235 #endif /* USE_TOOLKIT_SCROLL_BARS */
1237 UNBLOCK_INPUT;
1238 update_face_from_frame_parameter (f, Qbackground_color, arg);
1240 if (FRAME_VISIBLE_P (f))
1241 redraw_frame (f);
1245 void
1246 x_set_mouse_color (f, arg, oldval)
1247 struct frame *f;
1248 Lisp_Object arg, oldval;
1250 struct x_output *x = f->output_data.x;
1251 Display *dpy = FRAME_X_DISPLAY (f);
1252 Cursor cursor, nontext_cursor, mode_cursor, hand_cursor;
1253 Cursor hourglass_cursor, horizontal_drag_cursor;
1254 int count;
1255 unsigned long pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1256 unsigned long mask_color = x->background_pixel;
1258 /* Don't let pointers be invisible. */
1259 if (mask_color == pixel)
1261 x_free_colors (f, &pixel, 1);
1262 pixel = x_copy_color (f, x->foreground_pixel);
1265 unload_color (f, x->mouse_pixel);
1266 x->mouse_pixel = pixel;
1268 BLOCK_INPUT;
1270 /* It's not okay to crash if the user selects a screwy cursor. */
1271 count = x_catch_errors (dpy);
1273 if (!NILP (Vx_pointer_shape))
1275 CHECK_NUMBER (Vx_pointer_shape);
1276 cursor = XCreateFontCursor (dpy, XINT (Vx_pointer_shape));
1278 else
1279 cursor = XCreateFontCursor (dpy, XC_xterm);
1280 x_check_errors (dpy, "bad text pointer cursor: %s");
1282 if (!NILP (Vx_nontext_pointer_shape))
1284 CHECK_NUMBER (Vx_nontext_pointer_shape);
1285 nontext_cursor
1286 = XCreateFontCursor (dpy, XINT (Vx_nontext_pointer_shape));
1288 else
1289 nontext_cursor = XCreateFontCursor (dpy, XC_left_ptr);
1290 x_check_errors (dpy, "bad nontext pointer cursor: %s");
1292 if (!NILP (Vx_hourglass_pointer_shape))
1294 CHECK_NUMBER (Vx_hourglass_pointer_shape);
1295 hourglass_cursor
1296 = XCreateFontCursor (dpy, XINT (Vx_hourglass_pointer_shape));
1298 else
1299 hourglass_cursor = XCreateFontCursor (dpy, XC_watch);
1300 x_check_errors (dpy, "bad hourglass pointer cursor: %s");
1302 if (!NILP (Vx_mode_pointer_shape))
1304 CHECK_NUMBER (Vx_mode_pointer_shape);
1305 mode_cursor = XCreateFontCursor (dpy, XINT (Vx_mode_pointer_shape));
1307 else
1308 mode_cursor = XCreateFontCursor (dpy, XC_xterm);
1309 x_check_errors (dpy, "bad modeline pointer cursor: %s");
1311 if (!NILP (Vx_sensitive_text_pointer_shape))
1313 CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
1314 hand_cursor
1315 = XCreateFontCursor (dpy, XINT (Vx_sensitive_text_pointer_shape));
1317 else
1318 hand_cursor = XCreateFontCursor (dpy, XC_hand2);
1320 if (!NILP (Vx_window_horizontal_drag_shape))
1322 CHECK_NUMBER (Vx_window_horizontal_drag_shape);
1323 horizontal_drag_cursor
1324 = XCreateFontCursor (dpy, XINT (Vx_window_horizontal_drag_shape));
1326 else
1327 horizontal_drag_cursor
1328 = XCreateFontCursor (dpy, XC_sb_h_double_arrow);
1330 /* Check and report errors with the above calls. */
1331 x_check_errors (dpy, "can't set cursor shape: %s");
1332 x_uncatch_errors (dpy, count);
1335 XColor fore_color, back_color;
1337 fore_color.pixel = x->mouse_pixel;
1338 x_query_color (f, &fore_color);
1339 back_color.pixel = mask_color;
1340 x_query_color (f, &back_color);
1342 XRecolorCursor (dpy, cursor, &fore_color, &back_color);
1343 XRecolorCursor (dpy, nontext_cursor, &fore_color, &back_color);
1344 XRecolorCursor (dpy, mode_cursor, &fore_color, &back_color);
1345 XRecolorCursor (dpy, hand_cursor, &fore_color, &back_color);
1346 XRecolorCursor (dpy, hourglass_cursor, &fore_color, &back_color);
1347 XRecolorCursor (dpy, horizontal_drag_cursor, &fore_color, &back_color);
1350 if (FRAME_X_WINDOW (f) != 0)
1351 XDefineCursor (dpy, FRAME_X_WINDOW (f), cursor);
1353 if (cursor != x->text_cursor
1354 && x->text_cursor != 0)
1355 XFreeCursor (dpy, x->text_cursor);
1356 x->text_cursor = cursor;
1358 if (nontext_cursor != x->nontext_cursor
1359 && x->nontext_cursor != 0)
1360 XFreeCursor (dpy, x->nontext_cursor);
1361 x->nontext_cursor = nontext_cursor;
1363 if (hourglass_cursor != x->hourglass_cursor
1364 && x->hourglass_cursor != 0)
1365 XFreeCursor (dpy, x->hourglass_cursor);
1366 x->hourglass_cursor = hourglass_cursor;
1368 if (mode_cursor != x->modeline_cursor
1369 && x->modeline_cursor != 0)
1370 XFreeCursor (dpy, f->output_data.x->modeline_cursor);
1371 x->modeline_cursor = mode_cursor;
1373 if (hand_cursor != x->hand_cursor
1374 && x->hand_cursor != 0)
1375 XFreeCursor (dpy, x->hand_cursor);
1376 x->hand_cursor = hand_cursor;
1378 if (horizontal_drag_cursor != x->horizontal_drag_cursor
1379 && x->horizontal_drag_cursor != 0)
1380 XFreeCursor (dpy, x->horizontal_drag_cursor);
1381 x->horizontal_drag_cursor = horizontal_drag_cursor;
1383 XFlush (dpy);
1384 UNBLOCK_INPUT;
1386 update_face_from_frame_parameter (f, Qmouse_color, arg);
1389 void
1390 x_set_cursor_color (f, arg, oldval)
1391 struct frame *f;
1392 Lisp_Object arg, oldval;
1394 unsigned long fore_pixel, pixel;
1395 int fore_pixel_allocated_p = 0, pixel_allocated_p = 0;
1396 struct x_output *x = f->output_data.x;
1398 if (!NILP (Vx_cursor_fore_pixel))
1400 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1401 WHITE_PIX_DEFAULT (f));
1402 fore_pixel_allocated_p = 1;
1404 else
1405 fore_pixel = x->background_pixel;
1407 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1408 pixel_allocated_p = 1;
1410 /* Make sure that the cursor color differs from the background color. */
1411 if (pixel == x->background_pixel)
1413 if (pixel_allocated_p)
1415 x_free_colors (f, &pixel, 1);
1416 pixel_allocated_p = 0;
1419 pixel = x->mouse_pixel;
1420 if (pixel == fore_pixel)
1422 if (fore_pixel_allocated_p)
1424 x_free_colors (f, &fore_pixel, 1);
1425 fore_pixel_allocated_p = 0;
1427 fore_pixel = x->background_pixel;
1431 unload_color (f, x->cursor_foreground_pixel);
1432 if (!fore_pixel_allocated_p)
1433 fore_pixel = x_copy_color (f, fore_pixel);
1434 x->cursor_foreground_pixel = fore_pixel;
1436 unload_color (f, x->cursor_pixel);
1437 if (!pixel_allocated_p)
1438 pixel = x_copy_color (f, pixel);
1439 x->cursor_pixel = pixel;
1441 if (FRAME_X_WINDOW (f) != 0)
1443 BLOCK_INPUT;
1444 XSetBackground (FRAME_X_DISPLAY (f), x->cursor_gc, x->cursor_pixel);
1445 XSetForeground (FRAME_X_DISPLAY (f), x->cursor_gc, fore_pixel);
1446 UNBLOCK_INPUT;
1448 if (FRAME_VISIBLE_P (f))
1450 x_update_cursor (f, 0);
1451 x_update_cursor (f, 1);
1455 update_face_from_frame_parameter (f, Qcursor_color, arg);
1458 /* Set the border-color of frame F to pixel value PIX.
1459 Note that this does not fully take effect if done before
1460 F has an x-window. */
1462 void
1463 x_set_border_pixel (f, pix)
1464 struct frame *f;
1465 int pix;
1467 unload_color (f, f->output_data.x->border_pixel);
1468 f->output_data.x->border_pixel = pix;
1470 if (FRAME_X_WINDOW (f) != 0 && f->border_width > 0)
1472 BLOCK_INPUT;
1473 XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1474 (unsigned long)pix);
1475 UNBLOCK_INPUT;
1477 if (FRAME_VISIBLE_P (f))
1478 redraw_frame (f);
1482 /* Set the border-color of frame F to value described by ARG.
1483 ARG can be a string naming a color.
1484 The border-color is used for the border that is drawn by the X server.
1485 Note that this does not fully take effect if done before
1486 F has an x-window; it must be redone when the window is created.
1488 Note: this is done in two routines because of the way X10 works.
1490 Note: under X11, this is normally the province of the window manager,
1491 and so emacs' border colors may be overridden. */
1493 void
1494 x_set_border_color (f, arg, oldval)
1495 struct frame *f;
1496 Lisp_Object arg, oldval;
1498 int pix;
1500 CHECK_STRING (arg);
1501 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1502 x_set_border_pixel (f, pix);
1503 update_face_from_frame_parameter (f, Qborder_color, arg);
1507 void
1508 x_set_cursor_type (f, arg, oldval)
1509 FRAME_PTR f;
1510 Lisp_Object arg, oldval;
1512 set_frame_cursor_types (f, arg);
1514 /* Make sure the cursor gets redrawn. */
1515 cursor_type_changed = 1;
1518 void
1519 x_set_icon_type (f, arg, oldval)
1520 struct frame *f;
1521 Lisp_Object arg, oldval;
1523 int result;
1525 if (STRINGP (arg))
1527 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1528 return;
1530 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1531 return;
1533 BLOCK_INPUT;
1534 if (NILP (arg))
1535 result = x_text_icon (f,
1536 (char *) SDATA ((!NILP (f->icon_name)
1537 ? f->icon_name
1538 : f->name)));
1539 else
1540 result = x_bitmap_icon (f, arg);
1542 if (result)
1544 UNBLOCK_INPUT;
1545 error ("No icon window available");
1548 XFlush (FRAME_X_DISPLAY (f));
1549 UNBLOCK_INPUT;
1552 void
1553 x_set_icon_name (f, arg, oldval)
1554 struct frame *f;
1555 Lisp_Object arg, oldval;
1557 int result;
1559 if (STRINGP (arg))
1561 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1562 return;
1564 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1565 return;
1567 f->icon_name = arg;
1569 if (f->output_data.x->icon_bitmap != 0)
1570 return;
1572 BLOCK_INPUT;
1574 result = x_text_icon (f,
1575 (char *) SDATA ((!NILP (f->icon_name)
1576 ? f->icon_name
1577 : !NILP (f->title)
1578 ? f->title
1579 : f->name)));
1581 if (result)
1583 UNBLOCK_INPUT;
1584 error ("No icon window available");
1587 XFlush (FRAME_X_DISPLAY (f));
1588 UNBLOCK_INPUT;
1592 void
1593 x_set_menu_bar_lines (f, value, oldval)
1594 struct frame *f;
1595 Lisp_Object value, oldval;
1597 int nlines;
1598 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
1599 int olines = FRAME_MENU_BAR_LINES (f);
1600 #endif
1602 /* Right now, menu bars don't work properly in minibuf-only frames;
1603 most of the commands try to apply themselves to the minibuffer
1604 frame itself, and get an error because you can't switch buffers
1605 in or split the minibuffer window. */
1606 if (FRAME_MINIBUF_ONLY_P (f))
1607 return;
1609 if (INTEGERP (value))
1610 nlines = XINT (value);
1611 else
1612 nlines = 0;
1614 /* Make sure we redisplay all windows in this frame. */
1615 windows_or_buffers_changed++;
1617 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
1618 FRAME_MENU_BAR_LINES (f) = 0;
1619 if (nlines)
1621 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1622 if (FRAME_X_P (f) && f->output_data.x->menubar_widget == 0)
1623 /* Make sure next redisplay shows the menu bar. */
1624 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1626 else
1628 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1629 free_frame_menubar (f);
1630 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1631 if (FRAME_X_P (f))
1632 f->output_data.x->menubar_widget = 0;
1634 #else /* not USE_X_TOOLKIT && not USE_GTK */
1635 FRAME_MENU_BAR_LINES (f) = nlines;
1636 change_window_heights (f->root_window, nlines - olines);
1637 #endif /* not USE_X_TOOLKIT */
1638 adjust_glyphs (f);
1642 /* Set the number of lines used for the tool bar of frame F to VALUE.
1643 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1644 is the old number of tool bar lines. This function changes the
1645 height of all windows on frame F to match the new tool bar height.
1646 The frame's height doesn't change. */
1648 void
1649 x_set_tool_bar_lines (f, value, oldval)
1650 struct frame *f;
1651 Lisp_Object value, oldval;
1653 int delta, nlines, root_height;
1654 Lisp_Object root_window;
1656 /* Treat tool bars like menu bars. */
1657 if (FRAME_MINIBUF_ONLY_P (f))
1658 return;
1660 /* Use VALUE only if an integer >= 0. */
1661 if (INTEGERP (value) && XINT (value) >= 0)
1662 nlines = XFASTINT (value);
1663 else
1664 nlines = 0;
1666 #ifdef USE_GTK
1667 FRAME_TOOL_BAR_LINES (f) = 0;
1668 if (nlines)
1670 FRAME_EXTERNAL_TOOL_BAR (f) = 1;
1671 if (FRAME_X_P (f) && f->output_data.x->toolbar_widget == 0)
1672 /* Make sure next redisplay shows the tool bar. */
1673 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1674 update_frame_tool_bar (f);
1676 else
1678 if (FRAME_EXTERNAL_TOOL_BAR (f))
1679 free_frame_tool_bar (f);
1680 FRAME_EXTERNAL_TOOL_BAR (f) = 0;
1683 return;
1684 #endif
1686 /* Make sure we redisplay all windows in this frame. */
1687 ++windows_or_buffers_changed;
1689 delta = nlines - FRAME_TOOL_BAR_LINES (f);
1691 /* Don't resize the tool-bar to more than we have room for. */
1692 root_window = FRAME_ROOT_WINDOW (f);
1693 root_height = WINDOW_TOTAL_LINES (XWINDOW (root_window));
1694 if (root_height - delta < 1)
1696 delta = root_height - 1;
1697 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
1700 FRAME_TOOL_BAR_LINES (f) = nlines;
1701 change_window_heights (root_window, delta);
1702 adjust_glyphs (f);
1704 /* We also have to make sure that the internal border at the top of
1705 the frame, below the menu bar or tool bar, is redrawn when the
1706 tool bar disappears. This is so because the internal border is
1707 below the tool bar if one is displayed, but is below the menu bar
1708 if there isn't a tool bar. The tool bar draws into the area
1709 below the menu bar. */
1710 if (FRAME_X_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
1712 updating_frame = f;
1713 clear_frame ();
1714 clear_current_matrices (f);
1715 updating_frame = NULL;
1718 /* If the tool bar gets smaller, the internal border below it
1719 has to be cleared. It was formerly part of the display
1720 of the larger tool bar, and updating windows won't clear it. */
1721 if (delta < 0)
1723 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
1724 int width = FRAME_PIXEL_WIDTH (f);
1725 int y = nlines * FRAME_LINE_HEIGHT (f);
1727 BLOCK_INPUT;
1728 x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1729 0, y, width, height, False);
1730 UNBLOCK_INPUT;
1732 if (WINDOWP (f->tool_bar_window))
1733 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
1738 /* Set the foreground color for scroll bars on frame F to VALUE.
1739 VALUE should be a string, a color name. If it isn't a string or
1740 isn't a valid color name, do nothing. OLDVAL is the old value of
1741 the frame parameter. */
1743 void
1744 x_set_scroll_bar_foreground (f, value, oldval)
1745 struct frame *f;
1746 Lisp_Object value, oldval;
1748 unsigned long pixel;
1750 if (STRINGP (value))
1751 pixel = x_decode_color (f, value, BLACK_PIX_DEFAULT (f));
1752 else
1753 pixel = -1;
1755 if (f->output_data.x->scroll_bar_foreground_pixel != -1)
1756 unload_color (f, f->output_data.x->scroll_bar_foreground_pixel);
1758 f->output_data.x->scroll_bar_foreground_pixel = pixel;
1759 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
1761 /* Remove all scroll bars because they have wrong colors. */
1762 if (condemn_scroll_bars_hook)
1763 (*condemn_scroll_bars_hook) (f);
1764 if (judge_scroll_bars_hook)
1765 (*judge_scroll_bars_hook) (f);
1767 update_face_from_frame_parameter (f, Qscroll_bar_foreground, value);
1768 redraw_frame (f);
1773 /* Set the background color for scroll bars on frame F to VALUE VALUE
1774 should be a string, a color name. If it isn't a string or isn't a
1775 valid color name, do nothing. OLDVAL is the old value of the frame
1776 parameter. */
1778 void
1779 x_set_scroll_bar_background (f, value, oldval)
1780 struct frame *f;
1781 Lisp_Object value, oldval;
1783 unsigned long pixel;
1785 if (STRINGP (value))
1786 pixel = x_decode_color (f, value, WHITE_PIX_DEFAULT (f));
1787 else
1788 pixel = -1;
1790 if (f->output_data.x->scroll_bar_background_pixel != -1)
1791 unload_color (f, f->output_data.x->scroll_bar_background_pixel);
1793 #ifdef USE_TOOLKIT_SCROLL_BARS
1794 /* Scrollbar shadow colors. */
1795 if (f->output_data.x->scroll_bar_top_shadow_pixel != -1)
1797 unload_color (f, f->output_data.x->scroll_bar_top_shadow_pixel);
1798 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
1800 if (f->output_data.x->scroll_bar_bottom_shadow_pixel != -1)
1802 unload_color (f, f->output_data.x->scroll_bar_bottom_shadow_pixel);
1803 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
1805 #endif /* USE_TOOLKIT_SCROLL_BARS */
1807 f->output_data.x->scroll_bar_background_pixel = pixel;
1808 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
1810 /* Remove all scroll bars because they have wrong colors. */
1811 if (condemn_scroll_bars_hook)
1812 (*condemn_scroll_bars_hook) (f);
1813 if (judge_scroll_bars_hook)
1814 (*judge_scroll_bars_hook) (f);
1816 update_face_from_frame_parameter (f, Qscroll_bar_background, value);
1817 redraw_frame (f);
1822 /* Encode Lisp string STRING as a text in a format appropriate for
1823 XICCC (X Inter Client Communication Conventions).
1825 If STRING contains only ASCII characters, do no conversion and
1826 return the string data of STRING. Otherwise, encode the text by
1827 CODING_SYSTEM, and return a newly allocated memory area which
1828 should be freed by `xfree' by a caller.
1830 SELECTIONP non-zero means the string is being encoded for an X
1831 selection, so it is safe to run pre-write conversions (which
1832 may run Lisp code).
1834 Store the byte length of resulting text in *TEXT_BYTES.
1836 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
1837 which means that the `encoding' of the result can be `STRING'.
1838 Otherwise store 0 in *STRINGP, which means that the `encoding' of
1839 the result should be `COMPOUND_TEXT'. */
1841 unsigned char *
1842 x_encode_text (string, coding_system, selectionp, text_bytes, stringp)
1843 Lisp_Object string, coding_system;
1844 int *text_bytes, *stringp;
1845 int selectionp;
1847 unsigned char *str = SDATA (string);
1848 int chars = SCHARS (string);
1849 int bytes = SBYTES (string);
1850 int charset_info;
1851 int bufsize;
1852 unsigned char *buf;
1853 struct coding_system coding;
1854 extern Lisp_Object Qcompound_text_with_extensions;
1856 charset_info = find_charset_in_text (str, chars, bytes, NULL, Qnil);
1857 if (charset_info == 0)
1859 /* No multibyte character in OBJ. We need not encode it. */
1860 *text_bytes = bytes;
1861 *stringp = 1;
1862 return str;
1865 setup_coding_system (coding_system, &coding);
1866 if (selectionp
1867 && SYMBOLP (coding.pre_write_conversion)
1868 && !NILP (Ffboundp (coding.pre_write_conversion)))
1870 string = run_pre_post_conversion_on_str (string, &coding, 1);
1871 str = SDATA (string);
1872 chars = SCHARS (string);
1873 bytes = SBYTES (string);
1875 coding.src_multibyte = 1;
1876 coding.dst_multibyte = 0;
1877 coding.mode |= CODING_MODE_LAST_BLOCK;
1878 if (coding.type == coding_type_iso2022)
1879 coding.flags |= CODING_FLAG_ISO_SAFE;
1880 /* We suppress producing escape sequences for composition. */
1881 coding.composing = COMPOSITION_DISABLED;
1882 bufsize = encoding_buffer_size (&coding, bytes);
1883 buf = (unsigned char *) xmalloc (bufsize);
1884 encode_coding (&coding, str, buf, bytes, bufsize);
1885 *text_bytes = coding.produced;
1886 *stringp = (charset_info == 1
1887 || (!EQ (coding_system, Qcompound_text)
1888 && !EQ (coding_system, Qcompound_text_with_extensions)));
1889 return buf;
1893 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1894 x_id_name.
1896 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1897 name; if NAME is a string, set F's name to NAME and set
1898 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1900 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1901 suggesting a new name, which lisp code should override; if
1902 F->explicit_name is set, ignore the new name; otherwise, set it. */
1904 void
1905 x_set_name (f, name, explicit)
1906 struct frame *f;
1907 Lisp_Object name;
1908 int explicit;
1910 /* Make sure that requests from lisp code override requests from
1911 Emacs redisplay code. */
1912 if (explicit)
1914 /* If we're switching from explicit to implicit, we had better
1915 update the mode lines and thereby update the title. */
1916 if (f->explicit_name && NILP (name))
1917 update_mode_lines = 1;
1919 f->explicit_name = ! NILP (name);
1921 else if (f->explicit_name)
1922 return;
1924 /* If NAME is nil, set the name to the x_id_name. */
1925 if (NILP (name))
1927 /* Check for no change needed in this very common case
1928 before we do any consing. */
1929 if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name,
1930 SDATA (f->name)))
1931 return;
1932 name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name);
1934 else
1935 CHECK_STRING (name);
1937 /* Don't change the name if it's already NAME. */
1938 if (! NILP (Fstring_equal (name, f->name)))
1939 return;
1941 f->name = name;
1943 /* For setting the frame title, the title parameter should override
1944 the name parameter. */
1945 if (! NILP (f->title))
1946 name = f->title;
1948 if (FRAME_X_WINDOW (f))
1950 BLOCK_INPUT;
1951 #ifdef HAVE_X11R4
1953 XTextProperty text, icon;
1954 int bytes, stringp;
1955 Lisp_Object coding_system;
1957 /* Note: Encoding strategy
1959 We encode NAME by compound-text and use "COMPOUND-TEXT" in
1960 text.encoding. But, there are non-internationalized window
1961 managers which don't support that encoding. So, if NAME
1962 contains only ASCII and 8859-1 characters, encode it by
1963 iso-latin-1, and use "STRING" in text.encoding hoping that
1964 such window managers at least analyze this format correctly,
1965 i.e. treat 8-bit bytes as 8859-1 characters.
1967 We may also be able to use "UTF8_STRING" in text.encoding
1968 in the future which can encode all Unicode characters.
1969 But, for the moment, there's no way to know that the
1970 current window manager supports it or not. */
1971 coding_system = Qcompound_text;
1972 text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp);
1973 text.encoding = (stringp ? XA_STRING
1974 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
1975 text.format = 8;
1976 text.nitems = bytes;
1978 if (NILP (f->icon_name))
1980 icon = text;
1982 else
1984 /* See the above comment "Note: Encoding strategy". */
1985 icon.value = x_encode_text (f->icon_name, coding_system, 0,
1986 &bytes, &stringp);
1987 icon.encoding = (stringp ? XA_STRING
1988 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
1989 icon.format = 8;
1990 icon.nitems = bytes;
1992 #ifdef USE_GTK
1993 gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
1994 SDATA (name));
1995 #else /* not USE_GTK */
1996 XSetWMName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &text);
1997 #endif /* not USE_GTK */
1999 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &icon);
2001 if (!NILP (f->icon_name)
2002 && icon.value != (unsigned char *) SDATA (f->icon_name))
2003 xfree (icon.value);
2004 if (text.value != (unsigned char *) SDATA (name))
2005 xfree (text.value);
2007 #else /* not HAVE_X11R4 */
2008 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2009 SDATA (name));
2010 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2011 SDATA (name));
2012 #endif /* not HAVE_X11R4 */
2013 UNBLOCK_INPUT;
2017 /* This function should be called when the user's lisp code has
2018 specified a name for the frame; the name will override any set by the
2019 redisplay code. */
2020 void
2021 x_explicitly_set_name (f, arg, oldval)
2022 FRAME_PTR f;
2023 Lisp_Object arg, oldval;
2025 x_set_name (f, arg, 1);
2028 /* This function should be called by Emacs redisplay code to set the
2029 name; names set this way will never override names set by the user's
2030 lisp code. */
2031 void
2032 x_implicitly_set_name (f, arg, oldval)
2033 FRAME_PTR f;
2034 Lisp_Object arg, oldval;
2036 x_set_name (f, arg, 0);
2039 /* Change the title of frame F to NAME.
2040 If NAME is nil, use the frame name as the title.
2042 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2043 name; if NAME is a string, set F's name to NAME and set
2044 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2046 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2047 suggesting a new name, which lisp code should override; if
2048 F->explicit_name is set, ignore the new name; otherwise, set it. */
2050 void
2051 x_set_title (f, name, old_name)
2052 struct frame *f;
2053 Lisp_Object name, old_name;
2055 /* Don't change the title if it's already NAME. */
2056 if (EQ (name, f->title))
2057 return;
2059 update_mode_lines = 1;
2061 f->title = name;
2063 if (NILP (name))
2064 name = f->name;
2065 else
2066 CHECK_STRING (name);
2068 if (FRAME_X_WINDOW (f))
2070 BLOCK_INPUT;
2071 #ifdef HAVE_X11R4
2073 XTextProperty text, icon;
2074 int bytes, stringp;
2075 Lisp_Object coding_system;
2077 coding_system = Qcompound_text;
2078 /* See the comment "Note: Encoding strategy" in x_set_name. */
2079 text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp);
2080 text.encoding = (stringp ? XA_STRING
2081 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
2082 text.format = 8;
2083 text.nitems = bytes;
2085 if (NILP (f->icon_name))
2087 icon = text;
2089 else
2091 /* See the comment "Note: Encoding strategy" in x_set_name. */
2092 icon.value = x_encode_text (f->icon_name, coding_system, 0,
2093 &bytes, &stringp);
2094 icon.encoding = (stringp ? XA_STRING
2095 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
2096 icon.format = 8;
2097 icon.nitems = bytes;
2100 #ifdef USE_GTK
2101 gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
2102 SDATA (name));
2103 #else /* not USE_GTK */
2104 XSetWMName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &text);
2105 #endif /* not USE_GTK */
2107 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
2108 &icon);
2110 if (!NILP (f->icon_name)
2111 && icon.value != (unsigned char *) SDATA (f->icon_name))
2112 xfree (icon.value);
2113 if (text.value != (unsigned char *) SDATA (name))
2114 xfree (text.value);
2116 #else /* not HAVE_X11R4 */
2117 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2118 SDATA (name));
2119 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2120 SDATA (name));
2121 #endif /* not HAVE_X11R4 */
2122 UNBLOCK_INPUT;
2126 void
2127 x_set_scroll_bar_default_width (f)
2128 struct frame *f;
2130 int wid = FRAME_COLUMN_WIDTH (f);
2132 #ifdef USE_TOOLKIT_SCROLL_BARS
2133 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2134 int width = 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM;
2135 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (width + wid - 1) / wid;
2136 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = width;
2137 #else
2138 /* Make the actual width at least 14 pixels and a multiple of a
2139 character width. */
2140 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid;
2142 /* Use all of that space (aside from required margins) for the
2143 scroll bar. */
2144 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = 0;
2145 #endif
2149 /* Record in frame F the specified or default value according to ALIST
2150 of the parameter named PROP (a Lisp symbol). If no value is
2151 specified for PROP, look for an X default for XPROP on the frame
2152 named NAME. If that is not found either, use the value DEFLT. */
2154 static Lisp_Object
2155 x_default_scroll_bar_color_parameter (f, alist, prop, xprop, xclass,
2156 foreground_p)
2157 struct frame *f;
2158 Lisp_Object alist;
2159 Lisp_Object prop;
2160 char *xprop;
2161 char *xclass;
2162 int foreground_p;
2164 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2165 Lisp_Object tem;
2167 tem = x_get_arg (dpyinfo, alist, prop, xprop, xclass, RES_TYPE_STRING);
2168 if (EQ (tem, Qunbound))
2170 #ifdef USE_TOOLKIT_SCROLL_BARS
2172 /* See if an X resource for the scroll bar color has been
2173 specified. */
2174 tem = display_x_get_resource (dpyinfo,
2175 build_string (foreground_p
2176 ? "foreground"
2177 : "background"),
2178 empty_string,
2179 build_string ("verticalScrollBar"),
2180 empty_string);
2181 if (!STRINGP (tem))
2183 /* If nothing has been specified, scroll bars will use a
2184 toolkit-dependent default. Because these defaults are
2185 difficult to get at without actually creating a scroll
2186 bar, use nil to indicate that no color has been
2187 specified. */
2188 tem = Qnil;
2191 #else /* not USE_TOOLKIT_SCROLL_BARS */
2193 tem = Qnil;
2195 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2198 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2199 return tem;
2204 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2206 Status
2207 XSetWMProtocols (dpy, w, protocols, count)
2208 Display *dpy;
2209 Window w;
2210 Atom *protocols;
2211 int count;
2213 Atom prop;
2214 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
2215 if (prop == None) return False;
2216 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
2217 (unsigned char *) protocols, count);
2218 return True;
2220 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2222 #ifdef USE_X_TOOLKIT
2224 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2225 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2226 already be present because of the toolkit (Motif adds some of them,
2227 for example, but Xt doesn't). */
2229 static void
2230 hack_wm_protocols (f, widget)
2231 FRAME_PTR f;
2232 Widget widget;
2234 Display *dpy = XtDisplay (widget);
2235 Window w = XtWindow (widget);
2236 int need_delete = 1;
2237 int need_focus = 1;
2238 int need_save = 1;
2240 BLOCK_INPUT;
2242 Atom type, *atoms = 0;
2243 int format = 0;
2244 unsigned long nitems = 0;
2245 unsigned long bytes_after;
2247 if ((XGetWindowProperty (dpy, w,
2248 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2249 (long)0, (long)100, False, XA_ATOM,
2250 &type, &format, &nitems, &bytes_after,
2251 (unsigned char **) &atoms)
2252 == Success)
2253 && format == 32 && type == XA_ATOM)
2254 while (nitems > 0)
2256 nitems--;
2257 if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window)
2258 need_delete = 0;
2259 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus)
2260 need_focus = 0;
2261 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
2262 need_save = 0;
2264 if (atoms) XFree ((char *) atoms);
2267 Atom props [10];
2268 int count = 0;
2269 if (need_delete)
2270 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2271 if (need_focus)
2272 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus;
2273 if (need_save)
2274 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2275 if (count)
2276 XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2277 XA_ATOM, 32, PropModeAppend,
2278 (unsigned char *) props, count);
2280 UNBLOCK_INPUT;
2282 #endif
2286 /* Support routines for XIC (X Input Context). */
2288 #ifdef HAVE_X_I18N
2290 static XFontSet xic_create_xfontset P_ ((struct frame *, char *));
2291 static XIMStyle best_xim_style P_ ((XIMStyles *, XIMStyles *));
2294 /* Supported XIM styles, ordered by preference. */
2296 static XIMStyle supported_xim_styles[] =
2298 XIMPreeditPosition | XIMStatusArea,
2299 XIMPreeditPosition | XIMStatusNothing,
2300 XIMPreeditPosition | XIMStatusNone,
2301 XIMPreeditNothing | XIMStatusArea,
2302 XIMPreeditNothing | XIMStatusNothing,
2303 XIMPreeditNothing | XIMStatusNone,
2304 XIMPreeditNone | XIMStatusArea,
2305 XIMPreeditNone | XIMStatusNothing,
2306 XIMPreeditNone | XIMStatusNone,
2311 /* Create an X fontset on frame F with base font name
2312 BASE_FONTNAME.. */
2314 static XFontSet
2315 xic_create_xfontset (f, base_fontname)
2316 struct frame *f;
2317 char *base_fontname;
2319 XFontSet xfs;
2320 char **missing_list;
2321 int missing_count;
2322 char *def_string;
2324 xfs = XCreateFontSet (FRAME_X_DISPLAY (f),
2325 base_fontname, &missing_list,
2326 &missing_count, &def_string);
2327 if (missing_list)
2328 XFreeStringList (missing_list);
2330 /* No need to free def_string. */
2331 return xfs;
2335 /* Value is the best input style, given user preferences USER (already
2336 checked to be supported by Emacs), and styles supported by the
2337 input method XIM. */
2339 static XIMStyle
2340 best_xim_style (user, xim)
2341 XIMStyles *user;
2342 XIMStyles *xim;
2344 int i, j;
2346 for (i = 0; i < user->count_styles; ++i)
2347 for (j = 0; j < xim->count_styles; ++j)
2348 if (user->supported_styles[i] == xim->supported_styles[j])
2349 return user->supported_styles[i];
2351 /* Return the default style. */
2352 return XIMPreeditNothing | XIMStatusNothing;
2355 /* Create XIC for frame F. */
2357 static XIMStyle xic_style;
2359 void
2360 create_frame_xic (f)
2361 struct frame *f;
2363 XIM xim;
2364 XIC xic = NULL;
2365 XFontSet xfs = NULL;
2367 if (FRAME_XIC (f))
2368 return;
2370 xim = FRAME_X_XIM (f);
2371 if (xim)
2373 XRectangle s_area;
2374 XPoint spot;
2375 XVaNestedList preedit_attr;
2376 XVaNestedList status_attr;
2377 char *base_fontname;
2378 int fontset;
2380 s_area.x = 0; s_area.y = 0; s_area.width = 1; s_area.height = 1;
2381 spot.x = 0; spot.y = 1;
2382 /* Create X fontset. */
2383 fontset = FRAME_FONTSET (f);
2384 if (fontset < 0)
2385 base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
2386 else
2388 /* Determine the base fontname from the ASCII font name of
2389 FONTSET. */
2390 char *ascii_font = (char *) SDATA (fontset_ascii (fontset));
2391 char *p = ascii_font;
2392 int i;
2394 for (i = 0; *p; p++)
2395 if (*p == '-') i++;
2396 if (i != 14)
2397 /* As the font name doesn't conform to XLFD, we can't
2398 modify it to get a suitable base fontname for the
2399 frame. */
2400 base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
2401 else
2403 int len = strlen (ascii_font) + 1;
2404 char *p1 = NULL;
2406 for (i = 0, p = ascii_font; i < 8; p++)
2408 if (*p == '-')
2410 i++;
2411 if (i == 3)
2412 p1 = p + 1;
2415 base_fontname = (char *) alloca (len);
2416 bzero (base_fontname, len);
2417 strcpy (base_fontname, "-*-*-");
2418 bcopy (p1, base_fontname + 5, p - p1);
2419 strcat (base_fontname, "*-*-*-*-*-*-*");
2422 xfs = xic_create_xfontset (f, base_fontname);
2424 /* Determine XIC style. */
2425 if (xic_style == 0)
2427 XIMStyles supported_list;
2428 supported_list.count_styles = (sizeof supported_xim_styles
2429 / sizeof supported_xim_styles[0]);
2430 supported_list.supported_styles = supported_xim_styles;
2431 xic_style = best_xim_style (&supported_list,
2432 FRAME_X_XIM_STYLES (f));
2435 preedit_attr = XVaCreateNestedList (0,
2436 XNFontSet, xfs,
2437 XNForeground,
2438 FRAME_FOREGROUND_PIXEL (f),
2439 XNBackground,
2440 FRAME_BACKGROUND_PIXEL (f),
2441 (xic_style & XIMPreeditPosition
2442 ? XNSpotLocation
2443 : NULL),
2444 &spot,
2445 NULL);
2446 status_attr = XVaCreateNestedList (0,
2447 XNArea,
2448 &s_area,
2449 XNFontSet,
2450 xfs,
2451 XNForeground,
2452 FRAME_FOREGROUND_PIXEL (f),
2453 XNBackground,
2454 FRAME_BACKGROUND_PIXEL (f),
2455 NULL);
2457 xic = XCreateIC (xim,
2458 XNInputStyle, xic_style,
2459 XNClientWindow, FRAME_X_WINDOW (f),
2460 XNFocusWindow, FRAME_X_WINDOW (f),
2461 XNStatusAttributes, status_attr,
2462 XNPreeditAttributes, preedit_attr,
2463 NULL);
2464 XFree (preedit_attr);
2465 XFree (status_attr);
2468 FRAME_XIC (f) = xic;
2469 FRAME_XIC_STYLE (f) = xic_style;
2470 FRAME_XIC_FONTSET (f) = xfs;
2474 /* Destroy XIC and free XIC fontset of frame F, if any. */
2476 void
2477 free_frame_xic (f)
2478 struct frame *f;
2480 if (FRAME_XIC (f) == NULL)
2481 return;
2483 XDestroyIC (FRAME_XIC (f));
2484 if (FRAME_XIC_FONTSET (f))
2485 XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
2487 FRAME_XIC (f) = NULL;
2488 FRAME_XIC_FONTSET (f) = NULL;
2492 /* Place preedit area for XIC of window W's frame to specified
2493 pixel position X/Y. X and Y are relative to window W. */
2495 void
2496 xic_set_preeditarea (w, x, y)
2497 struct window *w;
2498 int x, y;
2500 struct frame *f = XFRAME (w->frame);
2501 XVaNestedList attr;
2502 XPoint spot;
2504 spot.x = WINDOW_TO_FRAME_PIXEL_X (w, x) + WINDOW_LEFT_FRINGE_WIDTH (w);
2505 spot.y = WINDOW_TO_FRAME_PIXEL_Y (w, y) + FONT_BASE (FRAME_FONT (f));
2506 attr = XVaCreateNestedList (0, XNSpotLocation, &spot, NULL);
2507 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
2508 XFree (attr);
2512 /* Place status area for XIC in bottom right corner of frame F.. */
2514 void
2515 xic_set_statusarea (f)
2516 struct frame *f;
2518 XIC xic = FRAME_XIC (f);
2519 XVaNestedList attr;
2520 XRectangle area;
2521 XRectangle *needed;
2523 /* Negotiate geometry of status area. If input method has existing
2524 status area, use its current size. */
2525 area.x = area.y = area.width = area.height = 0;
2526 attr = XVaCreateNestedList (0, XNAreaNeeded, &area, NULL);
2527 XSetICValues (xic, XNStatusAttributes, attr, NULL);
2528 XFree (attr);
2530 attr = XVaCreateNestedList (0, XNAreaNeeded, &needed, NULL);
2531 XGetICValues (xic, XNStatusAttributes, attr, NULL);
2532 XFree (attr);
2534 if (needed->width == 0) /* Use XNArea instead of XNAreaNeeded */
2536 attr = XVaCreateNestedList (0, XNArea, &needed, NULL);
2537 XGetICValues (xic, XNStatusAttributes, attr, NULL);
2538 XFree (attr);
2541 area.width = needed->width;
2542 area.height = needed->height;
2543 area.x = FRAME_PIXEL_WIDTH (f) - area.width - FRAME_INTERNAL_BORDER_WIDTH (f);
2544 area.y = (FRAME_PIXEL_HEIGHT (f) - area.height
2545 - FRAME_MENUBAR_HEIGHT (f)
2546 - FRAME_TOOLBAR_HEIGHT (f)
2547 - FRAME_INTERNAL_BORDER_WIDTH (f));
2548 XFree (needed);
2550 attr = XVaCreateNestedList (0, XNArea, &area, NULL);
2551 XSetICValues (xic, XNStatusAttributes, attr, NULL);
2552 XFree (attr);
2556 /* Set X fontset for XIC of frame F, using base font name
2557 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
2559 void
2560 xic_set_xfontset (f, base_fontname)
2561 struct frame *f;
2562 char *base_fontname;
2564 XVaNestedList attr;
2565 XFontSet xfs;
2567 xfs = xic_create_xfontset (f, base_fontname);
2569 attr = XVaCreateNestedList (0, XNFontSet, xfs, NULL);
2570 if (FRAME_XIC_STYLE (f) & XIMPreeditPosition)
2571 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
2572 if (FRAME_XIC_STYLE (f) & XIMStatusArea)
2573 XSetICValues (FRAME_XIC (f), XNStatusAttributes, attr, NULL);
2574 XFree (attr);
2576 if (FRAME_XIC_FONTSET (f))
2577 XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
2578 FRAME_XIC_FONTSET (f) = xfs;
2581 #endif /* HAVE_X_I18N */
2585 #ifdef USE_X_TOOLKIT
2587 /* Create and set up the X widget for frame F. */
2589 static void
2590 x_window (f, window_prompting, minibuffer_only)
2591 struct frame *f;
2592 long window_prompting;
2593 int minibuffer_only;
2595 XClassHint class_hints;
2596 XSetWindowAttributes attributes;
2597 unsigned long attribute_mask;
2598 Widget shell_widget;
2599 Widget pane_widget;
2600 Widget frame_widget;
2601 Arg al [25];
2602 int ac;
2604 BLOCK_INPUT;
2606 /* Use the resource name as the top-level widget name
2607 for looking up resources. Make a non-Lisp copy
2608 for the window manager, so GC relocation won't bother it.
2610 Elsewhere we specify the window name for the window manager. */
2613 char *str = (char *) SDATA (Vx_resource_name);
2614 f->namebuf = (char *) xmalloc (strlen (str) + 1);
2615 strcpy (f->namebuf, str);
2618 ac = 0;
2619 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
2620 XtSetArg (al[ac], XtNinput, 1); ac++;
2621 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2622 XtSetArg (al[ac], XtNborderWidth, f->border_width); ac++;
2623 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
2624 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
2625 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
2626 shell_widget = XtAppCreateShell (f->namebuf, EMACS_CLASS,
2627 applicationShellWidgetClass,
2628 FRAME_X_DISPLAY (f), al, ac);
2630 f->output_data.x->widget = shell_widget;
2631 /* maybe_set_screen_title_format (shell_widget); */
2633 pane_widget = lw_create_widget ("main", "pane", widget_id_tick++,
2634 (widget_value *) NULL,
2635 shell_widget, False,
2636 (lw_callback) NULL,
2637 (lw_callback) NULL,
2638 (lw_callback) NULL,
2639 (lw_callback) NULL);
2641 ac = 0;
2642 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
2643 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
2644 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
2645 XtSetValues (pane_widget, al, ac);
2646 f->output_data.x->column_widget = pane_widget;
2648 /* mappedWhenManaged to false tells to the paned window to not map/unmap
2649 the emacs screen when changing menubar. This reduces flickering. */
2651 ac = 0;
2652 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2653 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
2654 XtSetArg (al[ac], XtNallowResize, 1); ac++;
2655 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
2656 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
2657 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
2658 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
2659 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
2660 frame_widget = XtCreateWidget (f->namebuf, emacsFrameClass, pane_widget,
2661 al, ac);
2663 f->output_data.x->edit_widget = frame_widget;
2665 XtManageChild (frame_widget);
2667 /* Do some needed geometry management. */
2669 int len;
2670 char *tem, shell_position[32];
2671 Arg al[10];
2672 int ac = 0;
2673 int extra_borders = 0;
2674 int menubar_size
2675 = (f->output_data.x->menubar_widget
2676 ? (f->output_data.x->menubar_widget->core.height
2677 + f->output_data.x->menubar_widget->core.border_width)
2678 : 0);
2680 #if 0 /* Experimentally, we now get the right results
2681 for -geometry -0-0 without this. 24 Aug 96, rms. */
2682 if (FRAME_EXTERNAL_MENU_BAR (f))
2684 Dimension ibw = 0;
2685 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
2686 menubar_size += ibw;
2688 #endif
2690 f->output_data.x->menubar_height = menubar_size;
2692 #ifndef USE_LUCID
2693 /* Motif seems to need this amount added to the sizes
2694 specified for the shell widget. The Athena/Lucid widgets don't.
2695 Both conclusions reached experimentally. -- rms. */
2696 XtVaGetValues (f->output_data.x->edit_widget, XtNinternalBorderWidth,
2697 &extra_borders, NULL);
2698 extra_borders *= 2;
2699 #endif
2701 /* Convert our geometry parameters into a geometry string
2702 and specify it.
2703 Note that we do not specify here whether the position
2704 is a user-specified or program-specified one.
2705 We pass that information later, in x_wm_set_size_hints. */
2707 int left = f->left_pos;
2708 int xneg = window_prompting & XNegative;
2709 int top = f->top_pos;
2710 int yneg = window_prompting & YNegative;
2711 if (xneg)
2712 left = -left;
2713 if (yneg)
2714 top = -top;
2716 if (window_prompting & USPosition)
2717 sprintf (shell_position, "=%dx%d%c%d%c%d",
2718 FRAME_PIXEL_WIDTH (f) + extra_borders,
2719 FRAME_PIXEL_HEIGHT (f) + menubar_size + extra_borders,
2720 (xneg ? '-' : '+'), left,
2721 (yneg ? '-' : '+'), top);
2722 else
2724 sprintf (shell_position, "=%dx%d",
2725 FRAME_PIXEL_WIDTH (f) + extra_borders,
2726 FRAME_PIXEL_HEIGHT (f) + menubar_size + extra_borders);
2728 /* Setting x and y when the position is not specified in
2729 the geometry string will set program position in the WM hints.
2730 If Emacs had just one program position, we could set it in
2731 fallback resources, but since each make-frame call can specify
2732 different program positions, this is easier. */
2733 XtSetArg (al[ac], XtNx, left); ac++;
2734 XtSetArg (al[ac], XtNy, top); ac++;
2738 len = strlen (shell_position) + 1;
2739 /* We don't free this because we don't know whether
2740 it is safe to free it while the frame exists.
2741 It isn't worth the trouble of arranging to free it
2742 when the frame is deleted. */
2743 tem = (char *) xmalloc (len);
2744 strncpy (tem, shell_position, len);
2745 XtSetArg (al[ac], XtNgeometry, tem); ac++;
2746 XtSetValues (shell_widget, al, ac);
2749 XtManageChild (pane_widget);
2750 XtRealizeWidget (shell_widget);
2752 FRAME_X_WINDOW (f) = XtWindow (frame_widget);
2754 validate_x_resource_name ();
2756 class_hints.res_name = (char *) SDATA (Vx_resource_name);
2757 class_hints.res_class = (char *) SDATA (Vx_resource_class);
2758 XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
2760 #ifdef HAVE_X_I18N
2761 FRAME_XIC (f) = NULL;
2762 if (use_xim)
2763 create_frame_xic (f);
2764 #endif
2766 f->output_data.x->wm_hints.input = True;
2767 f->output_data.x->wm_hints.flags |= InputHint;
2768 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2769 &f->output_data.x->wm_hints);
2771 hack_wm_protocols (f, shell_widget);
2773 #ifdef HACK_EDITRES
2774 XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
2775 #endif
2777 /* Do a stupid property change to force the server to generate a
2778 PropertyNotify event so that the event_stream server timestamp will
2779 be initialized to something relevant to the time we created the window.
2781 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
2782 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2783 XA_ATOM, 32, PropModeAppend,
2784 (unsigned char*) NULL, 0);
2786 /* Make all the standard events reach the Emacs frame. */
2787 attributes.event_mask = STANDARD_EVENT_SET;
2789 #ifdef HAVE_X_I18N
2790 if (FRAME_XIC (f))
2792 /* XIM server might require some X events. */
2793 unsigned long fevent = NoEventMask;
2794 XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
2795 attributes.event_mask |= fevent;
2797 #endif /* HAVE_X_I18N */
2799 attribute_mask = CWEventMask;
2800 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
2801 attribute_mask, &attributes);
2803 XtMapWidget (frame_widget);
2805 /* x_set_name normally ignores requests to set the name if the
2806 requested name is the same as the current name. This is the one
2807 place where that assumption isn't correct; f->name is set, but
2808 the X server hasn't been told. */
2810 Lisp_Object name;
2811 int explicit = f->explicit_name;
2813 f->explicit_name = 0;
2814 name = f->name;
2815 f->name = Qnil;
2816 x_set_name (f, name, explicit);
2819 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2820 f->output_data.x->text_cursor);
2822 UNBLOCK_INPUT;
2824 /* This is a no-op, except under Motif. Make sure main areas are
2825 set to something reasonable, in case we get an error later. */
2826 lw_set_main_areas (pane_widget, 0, frame_widget);
2829 #else /* not USE_X_TOOLKIT */
2830 #ifdef USE_GTK
2831 void
2832 x_window (f)
2833 FRAME_PTR f;
2835 if (! xg_create_frame_widgets (f))
2836 error ("Unable to create window");
2838 #ifdef HAVE_X_I18N
2839 FRAME_XIC (f) = NULL;
2840 if (use_xim)
2842 BLOCK_INPUT;
2843 create_frame_xic (f);
2844 if (FRAME_XIC (f))
2846 /* XIM server might require some X events. */
2847 unsigned long fevent = NoEventMask;
2848 XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
2850 if (fevent != NoEventMask)
2852 XSetWindowAttributes attributes;
2853 XWindowAttributes wattr;
2854 unsigned long attribute_mask;
2856 XGetWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2857 &wattr);
2858 attributes.event_mask = wattr.your_event_mask | fevent;
2859 attribute_mask = CWEventMask;
2860 XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2861 attribute_mask, &attributes);
2864 UNBLOCK_INPUT;
2866 #endif
2869 #else /*! USE_GTK */
2870 /* Create and set up the X window for frame F. */
2872 void
2873 x_window (f)
2874 struct frame *f;
2877 XClassHint class_hints;
2878 XSetWindowAttributes attributes;
2879 unsigned long attribute_mask;
2881 attributes.background_pixel = f->output_data.x->background_pixel;
2882 attributes.border_pixel = f->output_data.x->border_pixel;
2883 attributes.bit_gravity = StaticGravity;
2884 attributes.backing_store = NotUseful;
2885 attributes.save_under = True;
2886 attributes.event_mask = STANDARD_EVENT_SET;
2887 attributes.colormap = FRAME_X_COLORMAP (f);
2888 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity | CWEventMask
2889 | CWColormap);
2891 BLOCK_INPUT;
2892 FRAME_X_WINDOW (f)
2893 = XCreateWindow (FRAME_X_DISPLAY (f),
2894 f->output_data.x->parent_desc,
2895 f->left_pos,
2896 f->top_pos,
2897 FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f),
2898 f->border_width,
2899 CopyFromParent, /* depth */
2900 InputOutput, /* class */
2901 FRAME_X_VISUAL (f),
2902 attribute_mask, &attributes);
2904 #ifdef HAVE_X_I18N
2905 if (use_xim)
2907 create_frame_xic (f);
2908 if (FRAME_XIC (f))
2910 /* XIM server might require some X events. */
2911 unsigned long fevent = NoEventMask;
2912 XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
2913 attributes.event_mask |= fevent;
2914 attribute_mask = CWEventMask;
2915 XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2916 attribute_mask, &attributes);
2919 #endif /* HAVE_X_I18N */
2921 validate_x_resource_name ();
2923 class_hints.res_name = (char *) SDATA (Vx_resource_name);
2924 class_hints.res_class = (char *) SDATA (Vx_resource_class);
2925 XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
2927 /* The menubar is part of the ordinary display;
2928 it does not count in addition to the height of the window. */
2929 f->output_data.x->menubar_height = 0;
2931 /* This indicates that we use the "Passive Input" input model.
2932 Unless we do this, we don't get the Focus{In,Out} events that we
2933 need to draw the cursor correctly. Accursed bureaucrats.
2934 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
2936 f->output_data.x->wm_hints.input = True;
2937 f->output_data.x->wm_hints.flags |= InputHint;
2938 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2939 &f->output_data.x->wm_hints);
2940 f->output_data.x->wm_hints.icon_pixmap = None;
2942 /* Request "save yourself" and "delete window" commands from wm. */
2944 Atom protocols[2];
2945 protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2946 protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2947 XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
2950 /* x_set_name normally ignores requests to set the name if the
2951 requested name is the same as the current name. This is the one
2952 place where that assumption isn't correct; f->name is set, but
2953 the X server hasn't been told. */
2955 Lisp_Object name;
2956 int explicit = f->explicit_name;
2958 f->explicit_name = 0;
2959 name = f->name;
2960 f->name = Qnil;
2961 x_set_name (f, name, explicit);
2964 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2965 f->output_data.x->text_cursor);
2967 UNBLOCK_INPUT;
2969 if (FRAME_X_WINDOW (f) == 0)
2970 error ("Unable to create window");
2973 #endif /* not USE_GTK */
2974 #endif /* not USE_X_TOOLKIT */
2976 /* Handle the icon stuff for this window. Perhaps later we might
2977 want an x_set_icon_position which can be called interactively as
2978 well. */
2980 static void
2981 x_icon (f, parms)
2982 struct frame *f;
2983 Lisp_Object parms;
2985 Lisp_Object icon_x, icon_y;
2986 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2988 /* Set the position of the icon. Note that twm groups all
2989 icons in an icon window. */
2990 icon_x = x_frame_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
2991 icon_y = x_frame_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
2992 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
2994 CHECK_NUMBER (icon_x);
2995 CHECK_NUMBER (icon_y);
2997 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
2998 error ("Both left and top icon corners of icon must be specified");
3000 BLOCK_INPUT;
3002 if (! EQ (icon_x, Qunbound))
3003 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
3005 /* Start up iconic or window? */
3006 x_wm_set_window_state
3007 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL),
3008 Qicon)
3009 ? IconicState
3010 : NormalState));
3012 x_text_icon (f, (char *) SDATA ((!NILP (f->icon_name)
3013 ? f->icon_name
3014 : f->name)));
3016 UNBLOCK_INPUT;
3019 /* Make the GCs needed for this window, setting the
3020 background, border and mouse colors; also create the
3021 mouse cursor and the gray border tile. */
3023 static char cursor_bits[] =
3025 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
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
3031 static void
3032 x_make_gc (f)
3033 struct frame *f;
3035 XGCValues gc_values;
3037 BLOCK_INPUT;
3039 /* Create the GCs of this frame.
3040 Note that many default values are used. */
3042 /* Normal video */
3043 gc_values.font = FRAME_FONT (f)->fid;
3044 gc_values.foreground = f->output_data.x->foreground_pixel;
3045 gc_values.background = f->output_data.x->background_pixel;
3046 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
3047 f->output_data.x->normal_gc
3048 = XCreateGC (FRAME_X_DISPLAY (f),
3049 FRAME_X_WINDOW (f),
3050 GCLineWidth | GCFont | GCForeground | GCBackground,
3051 &gc_values);
3053 /* Reverse video style. */
3054 gc_values.foreground = f->output_data.x->background_pixel;
3055 gc_values.background = f->output_data.x->foreground_pixel;
3056 f->output_data.x->reverse_gc
3057 = XCreateGC (FRAME_X_DISPLAY (f),
3058 FRAME_X_WINDOW (f),
3059 GCFont | GCForeground | GCBackground | GCLineWidth,
3060 &gc_values);
3062 /* Cursor has cursor-color background, background-color foreground. */
3063 gc_values.foreground = f->output_data.x->background_pixel;
3064 gc_values.background = f->output_data.x->cursor_pixel;
3065 gc_values.fill_style = FillOpaqueStippled;
3066 gc_values.stipple
3067 = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
3068 FRAME_X_DISPLAY_INFO (f)->root_window,
3069 cursor_bits, 16, 16);
3070 f->output_data.x->cursor_gc
3071 = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3072 (GCFont | GCForeground | GCBackground
3073 | GCFillStyle /* | GCStipple */ | GCLineWidth),
3074 &gc_values);
3076 /* Reliefs. */
3077 f->output_data.x->white_relief.gc = 0;
3078 f->output_data.x->black_relief.gc = 0;
3080 /* Create the gray border tile used when the pointer is not in
3081 the frame. Since this depends on the frame's pixel values,
3082 this must be done on a per-frame basis. */
3083 f->output_data.x->border_tile
3084 = (XCreatePixmapFromBitmapData
3085 (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
3086 gray_bits, gray_width, gray_height,
3087 f->output_data.x->foreground_pixel,
3088 f->output_data.x->background_pixel,
3089 DefaultDepth (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f))));
3091 UNBLOCK_INPUT;
3095 /* Free what was was allocated in x_make_gc. */
3097 void
3098 x_free_gcs (f)
3099 struct frame *f;
3101 Display *dpy = FRAME_X_DISPLAY (f);
3103 BLOCK_INPUT;
3105 if (f->output_data.x->normal_gc)
3107 XFreeGC (dpy, f->output_data.x->normal_gc);
3108 f->output_data.x->normal_gc = 0;
3111 if (f->output_data.x->reverse_gc)
3113 XFreeGC (dpy, f->output_data.x->reverse_gc);
3114 f->output_data.x->reverse_gc = 0;
3117 if (f->output_data.x->cursor_gc)
3119 XFreeGC (dpy, f->output_data.x->cursor_gc);
3120 f->output_data.x->cursor_gc = 0;
3123 if (f->output_data.x->border_tile)
3125 XFreePixmap (dpy, f->output_data.x->border_tile);
3126 f->output_data.x->border_tile = 0;
3129 UNBLOCK_INPUT;
3133 /* Handler for signals raised during x_create_frame and
3134 x_create_top_frame. FRAME is the frame which is partially
3135 constructed. */
3137 static Lisp_Object
3138 unwind_create_frame (frame)
3139 Lisp_Object frame;
3141 struct frame *f = XFRAME (frame);
3143 /* If frame is ``official'', nothing to do. */
3144 if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
3146 #if GLYPH_DEBUG
3147 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3148 #endif
3150 x_free_frame_resources (f);
3152 /* Check that reference counts are indeed correct. */
3153 xassert (dpyinfo->reference_count == dpyinfo_refcount);
3154 xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
3155 return Qt;
3158 return Qnil;
3162 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
3163 1, 1, 0,
3164 doc: /* Make a new X window, which is called a "frame" in Emacs terms.
3165 Returns an Emacs frame object.
3166 ALIST is an alist of frame parameters.
3167 If the parameters specify that the frame should not have a minibuffer,
3168 and do not specify a specific minibuffer window to use,
3169 then `default-minibuffer-frame' must be a frame whose minibuffer can
3170 be shared by the new frame.
3172 This function is an internal primitive--use `make-frame' instead. */)
3173 (parms)
3174 Lisp_Object parms;
3176 struct frame *f;
3177 Lisp_Object frame, tem;
3178 Lisp_Object name;
3179 int minibuffer_only = 0;
3180 long window_prompting = 0;
3181 int width, height;
3182 int count = SPECPDL_INDEX ();
3183 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3184 Lisp_Object display;
3185 struct x_display_info *dpyinfo = NULL;
3186 Lisp_Object parent;
3187 struct kboard *kb;
3189 check_x ();
3191 /* Use this general default value to start with
3192 until we know if this frame has a specified name. */
3193 Vx_resource_name = Vinvocation_name;
3195 display = x_get_arg (dpyinfo, parms, Qdisplay, 0, 0, RES_TYPE_STRING);
3196 if (EQ (display, Qunbound))
3197 display = Qnil;
3198 dpyinfo = check_x_display_info (display);
3199 #ifdef MULTI_KBOARD
3200 kb = dpyinfo->kboard;
3201 #else
3202 kb = &the_only_kboard;
3203 #endif
3205 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
3206 if (!STRINGP (name)
3207 && ! EQ (name, Qunbound)
3208 && ! NILP (name))
3209 error ("Invalid frame name--not a string or nil");
3211 if (STRINGP (name))
3212 Vx_resource_name = name;
3214 /* See if parent window is specified. */
3215 parent = x_get_arg (dpyinfo, parms, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
3216 if (EQ (parent, Qunbound))
3217 parent = Qnil;
3218 if (! NILP (parent))
3219 CHECK_NUMBER (parent);
3221 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3222 /* No need to protect DISPLAY because that's not used after passing
3223 it to make_frame_without_minibuffer. */
3224 frame = Qnil;
3225 GCPRO4 (parms, parent, name, frame);
3226 tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
3227 RES_TYPE_SYMBOL);
3228 if (EQ (tem, Qnone) || NILP (tem))
3229 f = make_frame_without_minibuffer (Qnil, kb, display);
3230 else if (EQ (tem, Qonly))
3232 f = make_minibuffer_frame ();
3233 minibuffer_only = 1;
3235 else if (WINDOWP (tem))
3236 f = make_frame_without_minibuffer (tem, kb, display);
3237 else
3238 f = make_frame (1);
3240 XSETFRAME (frame, f);
3242 /* Note that X Windows does support scroll bars. */
3243 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
3245 f->output_method = output_x_window;
3246 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
3247 bzero (f->output_data.x, sizeof (struct x_output));
3248 f->output_data.x->icon_bitmap = -1;
3249 FRAME_FONTSET (f) = -1;
3250 f->output_data.x->scroll_bar_foreground_pixel = -1;
3251 f->output_data.x->scroll_bar_background_pixel = -1;
3252 #ifdef USE_TOOLKIT_SCROLL_BARS
3253 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
3254 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
3255 #endif /* USE_TOOLKIT_SCROLL_BARS */
3256 record_unwind_protect (unwind_create_frame, frame);
3258 f->icon_name
3259 = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
3260 RES_TYPE_STRING);
3261 if (! STRINGP (f->icon_name))
3262 f->icon_name = Qnil;
3264 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
3265 #if GLYPH_DEBUG
3266 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
3267 dpyinfo_refcount = dpyinfo->reference_count;
3268 #endif /* GLYPH_DEBUG */
3269 #ifdef MULTI_KBOARD
3270 FRAME_KBOARD (f) = kb;
3271 #endif
3273 /* These colors will be set anyway later, but it's important
3274 to get the color reference counts right, so initialize them! */
3276 Lisp_Object black;
3277 struct gcpro gcpro1;
3279 /* Function x_decode_color can signal an error. Make
3280 sure to initialize color slots so that we won't try
3281 to free colors we haven't allocated. */
3282 f->output_data.x->foreground_pixel = -1;
3283 f->output_data.x->background_pixel = -1;
3284 f->output_data.x->cursor_pixel = -1;
3285 f->output_data.x->cursor_foreground_pixel = -1;
3286 f->output_data.x->border_pixel = -1;
3287 f->output_data.x->mouse_pixel = -1;
3289 black = build_string ("black");
3290 GCPRO1 (black);
3291 f->output_data.x->foreground_pixel
3292 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3293 f->output_data.x->background_pixel
3294 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3295 f->output_data.x->cursor_pixel
3296 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3297 f->output_data.x->cursor_foreground_pixel
3298 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3299 f->output_data.x->border_pixel
3300 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3301 f->output_data.x->mouse_pixel
3302 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3303 UNGCPRO;
3306 /* Specify the parent under which to make this X window. */
3308 if (!NILP (parent))
3310 f->output_data.x->parent_desc = (Window) XFASTINT (parent);
3311 f->output_data.x->explicit_parent = 1;
3313 else
3315 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3316 f->output_data.x->explicit_parent = 0;
3319 /* Set the name; the functions to which we pass f expect the name to
3320 be set. */
3321 if (EQ (name, Qunbound) || NILP (name))
3323 f->name = build_string (dpyinfo->x_id_name);
3324 f->explicit_name = 0;
3326 else
3328 f->name = name;
3329 f->explicit_name = 1;
3330 /* use the frame's title when getting resources for this frame. */
3331 specbind (Qx_resource_name, name);
3334 /* Extract the window parameters from the supplied values
3335 that are needed to determine window geometry. */
3337 Lisp_Object font;
3339 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
3341 BLOCK_INPUT;
3342 /* First, try whatever font the caller has specified. */
3343 if (STRINGP (font))
3345 tem = Fquery_fontset (font, Qnil);
3346 if (STRINGP (tem))
3347 font = x_new_fontset (f, SDATA (tem));
3348 else
3349 font = x_new_font (f, SDATA (font));
3352 /* Try out a font which we hope has bold and italic variations. */
3353 if (!STRINGP (font))
3354 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
3355 if (!STRINGP (font))
3356 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3357 if (! STRINGP (font))
3358 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3359 if (! STRINGP (font))
3360 /* This was formerly the first thing tried, but it finds too many fonts
3361 and takes too long. */
3362 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3363 /* If those didn't work, look for something which will at least work. */
3364 if (! STRINGP (font))
3365 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3366 UNBLOCK_INPUT;
3367 if (! STRINGP (font))
3368 font = build_string ("fixed");
3370 x_default_parameter (f, parms, Qfont, font,
3371 "font", "Font", RES_TYPE_STRING);
3374 #ifdef USE_LUCID
3375 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3376 whereby it fails to get any font. */
3377 xlwmenu_default_font = FRAME_FONT (f);
3378 #endif
3380 x_default_parameter (f, parms, Qborder_width, make_number (2),
3381 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
3383 /* This defaults to 1 in order to match xterm. We recognize either
3384 internalBorderWidth or internalBorder (which is what xterm calls
3385 it). */
3386 if (NILP (Fassq (Qinternal_border_width, parms)))
3388 Lisp_Object value;
3390 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
3391 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
3392 if (! EQ (value, Qunbound))
3393 parms = Fcons (Fcons (Qinternal_border_width, value),
3394 parms);
3396 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
3397 "internalBorderWidth", "internalBorderWidth",
3398 RES_TYPE_NUMBER);
3399 x_default_parameter (f, parms, Qvertical_scroll_bars, Qleft,
3400 "verticalScrollBars", "ScrollBars",
3401 RES_TYPE_SYMBOL);
3403 /* Also do the stuff which must be set before the window exists. */
3404 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
3405 "foreground", "Foreground", RES_TYPE_STRING);
3406 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
3407 "background", "Background", RES_TYPE_STRING);
3408 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
3409 "pointerColor", "Foreground", RES_TYPE_STRING);
3410 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
3411 "cursorColor", "Foreground", RES_TYPE_STRING);
3412 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
3413 "borderColor", "BorderColor", RES_TYPE_STRING);
3414 x_default_parameter (f, parms, Qscreen_gamma, Qnil,
3415 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
3416 x_default_parameter (f, parms, Qline_spacing, Qnil,
3417 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
3418 x_default_parameter (f, parms, Qleft_fringe, Qnil,
3419 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
3420 x_default_parameter (f, parms, Qright_fringe, Qnil,
3421 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
3423 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_foreground,
3424 "scrollBarForeground",
3425 "ScrollBarForeground", 1);
3426 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_background,
3427 "scrollBarBackground",
3428 "ScrollBarBackground", 0);
3430 /* Init faces before x_default_parameter is called for scroll-bar
3431 parameters because that function calls x_set_scroll_bar_width,
3432 which calls change_frame_size, which calls Fset_window_buffer,
3433 which runs hooks, which call Fvertical_motion. At the end, we
3434 end up in init_iterator with a null face cache, which should not
3435 happen. */
3436 init_frame_faces (f);
3438 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
3439 "menuBar", "MenuBar", RES_TYPE_NUMBER);
3440 x_default_parameter (f, parms, Qtool_bar_lines, make_number (1),
3441 "toolBar", "ToolBar", RES_TYPE_NUMBER);
3442 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
3443 "bufferPredicate", "BufferPredicate",
3444 RES_TYPE_SYMBOL);
3445 x_default_parameter (f, parms, Qtitle, Qnil,
3446 "title", "Title", RES_TYPE_STRING);
3447 x_default_parameter (f, parms, Qwait_for_wm, Qt,
3448 "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN);
3449 x_default_parameter (f, parms, Qfullscreen, Qnil,
3450 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
3452 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3454 /* Compute the size of the X window. */
3455 window_prompting = x_figure_window_size (f, parms, 1);
3457 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
3458 f->no_split = minibuffer_only || EQ (tem, Qt);
3460 /* Create the X widget or window. */
3461 #ifdef USE_X_TOOLKIT
3462 x_window (f, window_prompting, minibuffer_only);
3463 #else
3464 x_window (f);
3465 #endif
3467 x_icon (f, parms);
3468 x_make_gc (f);
3470 /* Now consider the frame official. */
3471 FRAME_X_DISPLAY_INFO (f)->reference_count++;
3472 Vframe_list = Fcons (frame, Vframe_list);
3474 /* We need to do this after creating the X window, so that the
3475 icon-creation functions can say whose icon they're describing. */
3476 x_default_parameter (f, parms, Qicon_type, Qnil,
3477 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
3479 x_default_parameter (f, parms, Qauto_raise, Qnil,
3480 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
3481 x_default_parameter (f, parms, Qauto_lower, Qnil,
3482 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
3483 x_default_parameter (f, parms, Qcursor_type, Qbox,
3484 "cursorType", "CursorType", RES_TYPE_SYMBOL);
3485 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
3486 "scrollBarWidth", "ScrollBarWidth",
3487 RES_TYPE_NUMBER);
3489 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
3490 Change will not be effected unless different from the current
3491 FRAME_LINES (f). */
3492 width = FRAME_COLS (f);
3493 height = FRAME_LINES (f);
3495 SET_FRAME_COLS (f, 0);
3496 FRAME_LINES (f) = 0;
3497 change_frame_size (f, height, width, 1, 0, 0);
3499 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
3500 /* Create the menu bar. */
3501 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
3503 /* If this signals an error, we haven't set size hints for the
3504 frame and we didn't make it visible. */
3505 initialize_frame_menubar (f);
3507 #ifndef USE_GTK
3508 /* This is a no-op, except under Motif where it arranges the
3509 main window for the widgets on it. */
3510 lw_set_main_areas (f->output_data.x->column_widget,
3511 f->output_data.x->menubar_widget,
3512 f->output_data.x->edit_widget);
3513 #endif /* not USE_GTK */
3515 #endif /* USE_X_TOOLKIT || USE_GTK */
3517 /* Tell the server what size and position, etc, we want, and how
3518 badly we want them. This should be done after we have the menu
3519 bar so that its size can be taken into account. */
3520 BLOCK_INPUT;
3521 x_wm_set_size_hint (f, window_prompting, 0);
3522 UNBLOCK_INPUT;
3524 /* Make the window appear on the frame and enable display, unless
3525 the caller says not to. However, with explicit parent, Emacs
3526 cannot control visibility, so don't try. */
3527 if (! f->output_data.x->explicit_parent)
3529 Lisp_Object visibility;
3531 visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
3532 RES_TYPE_SYMBOL);
3533 if (EQ (visibility, Qunbound))
3534 visibility = Qt;
3536 if (EQ (visibility, Qicon))
3537 x_iconify_frame (f);
3538 else if (! NILP (visibility))
3539 x_make_frame_visible (f);
3540 else
3541 /* Must have been Qnil. */
3545 /* Set the WM leader property. GTK does this itself, so this is not
3546 needed when using GTK. */
3547 if (dpyinfo->client_leader_window != 0)
3549 BLOCK_INPUT;
3550 XChangeProperty (FRAME_X_DISPLAY (f),
3551 FRAME_OUTER_WINDOW (f),
3552 dpyinfo->Xatom_wm_client_leader,
3553 XA_WINDOW, 32, PropModeReplace,
3554 (char *) &dpyinfo->client_leader_window, 1);
3555 UNBLOCK_INPUT;
3558 UNGCPRO;
3560 /* Make sure windows on this frame appear in calls to next-window
3561 and similar functions. */
3562 Vwindow_list = Qnil;
3564 return unbind_to (count, frame);
3568 /* FRAME is used only to get a handle on the X display. We don't pass the
3569 display info directly because we're called from frame.c, which doesn't
3570 know about that structure. */
3572 Lisp_Object
3573 x_get_focus_frame (frame)
3574 struct frame *frame;
3576 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
3577 Lisp_Object xfocus;
3578 if (! dpyinfo->x_focus_frame)
3579 return Qnil;
3581 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
3582 return xfocus;
3586 /* In certain situations, when the window manager follows a
3587 click-to-focus policy, there seems to be no way around calling
3588 XSetInputFocus to give another frame the input focus .
3590 In an ideal world, XSetInputFocus should generally be avoided so
3591 that applications don't interfere with the window manager's focus
3592 policy. But I think it's okay to use when it's clearly done
3593 following a user-command. */
3595 DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
3596 doc: /* Set the input focus to FRAME.
3597 FRAME nil means use the selected frame. */)
3598 (frame)
3599 Lisp_Object frame;
3601 struct frame *f = check_x_frame (frame);
3602 Display *dpy = FRAME_X_DISPLAY (f);
3603 int count;
3605 BLOCK_INPUT;
3606 count = x_catch_errors (dpy);
3607 XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3608 RevertToParent, CurrentTime);
3609 x_uncatch_errors (dpy, count);
3610 UNBLOCK_INPUT;
3612 return Qnil;
3616 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
3617 doc: /* Internal function called by `color-defined-p', which see. */)
3618 (color, frame)
3619 Lisp_Object color, frame;
3621 XColor foo;
3622 FRAME_PTR f = check_x_frame (frame);
3624 CHECK_STRING (color);
3626 if (x_defined_color (f, SDATA (color), &foo, 0))
3627 return Qt;
3628 else
3629 return Qnil;
3632 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
3633 doc: /* Internal function called by `color-values', which see. */)
3634 (color, frame)
3635 Lisp_Object color, frame;
3637 XColor foo;
3638 FRAME_PTR f = check_x_frame (frame);
3640 CHECK_STRING (color);
3642 if (x_defined_color (f, SDATA (color), &foo, 0))
3644 Lisp_Object rgb[3];
3646 rgb[0] = make_number (foo.red);
3647 rgb[1] = make_number (foo.green);
3648 rgb[2] = make_number (foo.blue);
3649 return Flist (3, rgb);
3651 else
3652 return Qnil;
3655 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
3656 doc: /* Internal function called by `display-color-p', which see. */)
3657 (display)
3658 Lisp_Object display;
3660 struct x_display_info *dpyinfo = check_x_display_info (display);
3662 if (dpyinfo->n_planes <= 2)
3663 return Qnil;
3665 switch (dpyinfo->visual->class)
3667 case StaticColor:
3668 case PseudoColor:
3669 case TrueColor:
3670 case DirectColor:
3671 return Qt;
3673 default:
3674 return Qnil;
3678 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
3679 0, 1, 0,
3680 doc: /* Return t if the X display supports shades of gray.
3681 Note that color displays do support shades of gray.
3682 The optional argument DISPLAY specifies which display to ask about.
3683 DISPLAY should be either a frame or a display name (a string).
3684 If omitted or nil, that stands for the selected frame's display. */)
3685 (display)
3686 Lisp_Object display;
3688 struct x_display_info *dpyinfo = check_x_display_info (display);
3690 if (dpyinfo->n_planes <= 1)
3691 return Qnil;
3693 switch (dpyinfo->visual->class)
3695 case StaticColor:
3696 case PseudoColor:
3697 case TrueColor:
3698 case DirectColor:
3699 case StaticGray:
3700 case GrayScale:
3701 return Qt;
3703 default:
3704 return Qnil;
3708 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
3709 0, 1, 0,
3710 doc: /* Returns the width in pixels of the X display DISPLAY.
3711 The optional argument DISPLAY specifies which display to ask about.
3712 DISPLAY should be either a frame or a display name (a string).
3713 If omitted or nil, that stands for the selected frame's display. */)
3714 (display)
3715 Lisp_Object display;
3717 struct x_display_info *dpyinfo = check_x_display_info (display);
3719 return make_number (dpyinfo->width);
3722 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
3723 Sx_display_pixel_height, 0, 1, 0,
3724 doc: /* Returns the height in pixels of the X display DISPLAY.
3725 The optional argument DISPLAY specifies which display to ask about.
3726 DISPLAY should be either a frame or a display name (a string).
3727 If omitted or nil, that stands for the selected frame's display. */)
3728 (display)
3729 Lisp_Object display;
3731 struct x_display_info *dpyinfo = check_x_display_info (display);
3733 return make_number (dpyinfo->height);
3736 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
3737 0, 1, 0,
3738 doc: /* Returns the number of bitplanes of the X display DISPLAY.
3739 The optional argument DISPLAY specifies which display to ask about.
3740 DISPLAY should be either a frame or a display name (a string).
3741 If omitted or nil, that stands for the selected frame's display. */)
3742 (display)
3743 Lisp_Object display;
3745 struct x_display_info *dpyinfo = check_x_display_info (display);
3747 return make_number (dpyinfo->n_planes);
3750 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
3751 0, 1, 0,
3752 doc: /* Returns the number of color cells of the X display DISPLAY.
3753 The optional argument DISPLAY specifies which display to ask about.
3754 DISPLAY should be either a frame or a display name (a string).
3755 If omitted or nil, that stands for the selected frame's display. */)
3756 (display)
3757 Lisp_Object display;
3759 struct x_display_info *dpyinfo = check_x_display_info (display);
3761 int nr_planes = DisplayPlanes (dpyinfo->display,
3762 XScreenNumberOfScreen (dpyinfo->screen));
3764 /* Truncate nr_planes to 24 to avoid integer overflow.
3765 Some displays says 32, but only 24 bits are actually significant.
3766 There are only very few and rare video cards that have more than
3767 24 significant bits. Also 24 bits is more than 16 million colors,
3768 it "should be enough for everyone". */
3769 if (nr_planes > 24) nr_planes = 24;
3771 return make_number (1 << nr_planes);
3774 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
3775 Sx_server_max_request_size,
3776 0, 1, 0,
3777 doc: /* Returns the maximum request size of the X server of display DISPLAY.
3778 The optional argument DISPLAY specifies which display to ask about.
3779 DISPLAY should be either a frame or a display name (a string).
3780 If omitted or nil, that stands for the selected frame's display. */)
3781 (display)
3782 Lisp_Object display;
3784 struct x_display_info *dpyinfo = check_x_display_info (display);
3786 return make_number (MAXREQUEST (dpyinfo->display));
3789 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
3790 doc: /* Returns the vendor ID string of the X server of display DISPLAY.
3791 The optional argument DISPLAY specifies which display to ask about.
3792 DISPLAY should be either a frame or a display name (a string).
3793 If omitted or nil, that stands for the selected frame's display. */)
3794 (display)
3795 Lisp_Object display;
3797 struct x_display_info *dpyinfo = check_x_display_info (display);
3798 char *vendor = ServerVendor (dpyinfo->display);
3800 if (! vendor) vendor = "";
3801 return build_string (vendor);
3804 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
3805 doc: /* Returns the version numbers of the X server of display DISPLAY.
3806 The value is a list of three integers: the major and minor
3807 version numbers of the X Protocol in use, and the vendor-specific release
3808 number. See also the function `x-server-vendor'.
3810 The optional argument DISPLAY specifies which display to ask about.
3811 DISPLAY should be either a frame or a display name (a string).
3812 If omitted or nil, that stands for the selected frame's display. */)
3813 (display)
3814 Lisp_Object display;
3816 struct x_display_info *dpyinfo = check_x_display_info (display);
3817 Display *dpy = dpyinfo->display;
3819 return Fcons (make_number (ProtocolVersion (dpy)),
3820 Fcons (make_number (ProtocolRevision (dpy)),
3821 Fcons (make_number (VendorRelease (dpy)), Qnil)));
3824 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
3825 doc: /* Return the number of screens on the X server of display DISPLAY.
3826 The optional argument DISPLAY specifies which display to ask about.
3827 DISPLAY should be either a frame or a display name (a string).
3828 If omitted or nil, that stands for the selected frame's display. */)
3829 (display)
3830 Lisp_Object display;
3832 struct x_display_info *dpyinfo = check_x_display_info (display);
3834 return make_number (ScreenCount (dpyinfo->display));
3837 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
3838 doc: /* Return the height in millimeters of the X display DISPLAY.
3839 The optional argument DISPLAY specifies which display to ask about.
3840 DISPLAY should be either a frame or a display name (a string).
3841 If omitted or nil, that stands for the selected frame's display. */)
3842 (display)
3843 Lisp_Object display;
3845 struct x_display_info *dpyinfo = check_x_display_info (display);
3847 return make_number (HeightMMOfScreen (dpyinfo->screen));
3850 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
3851 doc: /* Return the width in millimeters of the X display DISPLAY.
3852 The optional argument DISPLAY specifies which display to ask about.
3853 DISPLAY should be either a frame or a display name (a string).
3854 If omitted or nil, that stands for the selected frame's display. */)
3855 (display)
3856 Lisp_Object display;
3858 struct x_display_info *dpyinfo = check_x_display_info (display);
3860 return make_number (WidthMMOfScreen (dpyinfo->screen));
3863 DEFUN ("x-display-backing-store", Fx_display_backing_store,
3864 Sx_display_backing_store, 0, 1, 0,
3865 doc: /* Returns an indication of whether X display DISPLAY does backing store.
3866 The value may be `always', `when-mapped', or `not-useful'.
3867 The optional argument DISPLAY specifies which display to ask about.
3868 DISPLAY should be either a frame or a display name (a string).
3869 If omitted or nil, that stands for the selected frame's display. */)
3870 (display)
3871 Lisp_Object display;
3873 struct x_display_info *dpyinfo = check_x_display_info (display);
3874 Lisp_Object result;
3876 switch (DoesBackingStore (dpyinfo->screen))
3878 case Always:
3879 result = intern ("always");
3880 break;
3882 case WhenMapped:
3883 result = intern ("when-mapped");
3884 break;
3886 case NotUseful:
3887 result = intern ("not-useful");
3888 break;
3890 default:
3891 error ("Strange value for BackingStore parameter of screen");
3892 result = Qnil;
3895 return result;
3898 DEFUN ("x-display-visual-class", Fx_display_visual_class,
3899 Sx_display_visual_class, 0, 1, 0,
3900 doc: /* Return the visual class of the X display DISPLAY.
3901 The value is one of the symbols `static-gray', `gray-scale',
3902 `static-color', `pseudo-color', `true-color', or `direct-color'.
3904 The optional argument DISPLAY specifies which display to ask about.
3905 DISPLAY should be either a frame or a display name (a string).
3906 If omitted or nil, that stands for the selected frame's display. */)
3907 (display)
3908 Lisp_Object display;
3910 struct x_display_info *dpyinfo = check_x_display_info (display);
3911 Lisp_Object result;
3913 switch (dpyinfo->visual->class)
3915 case StaticGray:
3916 result = intern ("static-gray");
3917 break;
3918 case GrayScale:
3919 result = intern ("gray-scale");
3920 break;
3921 case StaticColor:
3922 result = intern ("static-color");
3923 break;
3924 case PseudoColor:
3925 result = intern ("pseudo-color");
3926 break;
3927 case TrueColor:
3928 result = intern ("true-color");
3929 break;
3930 case DirectColor:
3931 result = intern ("direct-color");
3932 break;
3933 default:
3934 error ("Display has an unknown visual class");
3935 result = Qnil;
3938 return result;
3941 DEFUN ("x-display-save-under", Fx_display_save_under,
3942 Sx_display_save_under, 0, 1, 0,
3943 doc: /* Returns t if the X display DISPLAY supports the save-under feature.
3944 The optional argument DISPLAY specifies which display to ask about.
3945 DISPLAY should be either a frame or a display name (a string).
3946 If omitted or nil, that stands for the selected frame's display. */)
3947 (display)
3948 Lisp_Object display;
3950 struct x_display_info *dpyinfo = check_x_display_info (display);
3952 if (DoesSaveUnders (dpyinfo->screen) == True)
3953 return Qt;
3954 else
3955 return Qnil;
3959 x_pixel_width (f)
3960 register struct frame *f;
3962 return FRAME_PIXEL_WIDTH (f);
3966 x_pixel_height (f)
3967 register struct frame *f;
3969 return FRAME_PIXEL_HEIGHT (f);
3973 x_char_width (f)
3974 register struct frame *f;
3976 return FRAME_COLUMN_WIDTH (f);
3980 x_char_height (f)
3981 register struct frame *f;
3983 return FRAME_LINE_HEIGHT (f);
3987 x_screen_planes (f)
3988 register struct frame *f;
3990 return FRAME_X_DISPLAY_INFO (f)->n_planes;
3995 /************************************************************************
3996 X Displays
3997 ************************************************************************/
4000 /* Mapping visual names to visuals. */
4002 static struct visual_class
4004 char *name;
4005 int class;
4007 visual_classes[] =
4009 {"StaticGray", StaticGray},
4010 {"GrayScale", GrayScale},
4011 {"StaticColor", StaticColor},
4012 {"PseudoColor", PseudoColor},
4013 {"TrueColor", TrueColor},
4014 {"DirectColor", DirectColor},
4015 {NULL, 0}
4019 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4021 /* Value is the screen number of screen SCR. This is a substitute for
4022 the X function with the same name when that doesn't exist. */
4025 XScreenNumberOfScreen (scr)
4026 register Screen *scr;
4028 Display *dpy = scr->display;
4029 int i;
4031 for (i = 0; i < dpy->nscreens; ++i)
4032 if (scr == dpy->screens + i)
4033 break;
4035 return i;
4038 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4041 /* Select the visual that should be used on display DPYINFO. Set
4042 members of DPYINFO appropriately. Called from x_term_init. */
4044 void
4045 select_visual (dpyinfo)
4046 struct x_display_info *dpyinfo;
4048 Display *dpy = dpyinfo->display;
4049 Screen *screen = dpyinfo->screen;
4050 Lisp_Object value;
4052 /* See if a visual is specified. */
4053 value = display_x_get_resource (dpyinfo,
4054 build_string ("visualClass"),
4055 build_string ("VisualClass"),
4056 Qnil, Qnil);
4057 if (STRINGP (value))
4059 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4060 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4061 depth, a decimal number. NAME is compared with case ignored. */
4062 char *s = (char *) alloca (SBYTES (value) + 1);
4063 char *dash;
4064 int i, class = -1;
4065 XVisualInfo vinfo;
4067 strcpy (s, SDATA (value));
4068 dash = index (s, '-');
4069 if (dash)
4071 dpyinfo->n_planes = atoi (dash + 1);
4072 *dash = '\0';
4074 else
4075 /* We won't find a matching visual with depth 0, so that
4076 an error will be printed below. */
4077 dpyinfo->n_planes = 0;
4079 /* Determine the visual class. */
4080 for (i = 0; visual_classes[i].name; ++i)
4081 if (xstricmp (s, visual_classes[i].name) == 0)
4083 class = visual_classes[i].class;
4084 break;
4087 /* Look up a matching visual for the specified class. */
4088 if (class == -1
4089 || !XMatchVisualInfo (dpy, XScreenNumberOfScreen (screen),
4090 dpyinfo->n_planes, class, &vinfo))
4091 fatal ("Invalid visual specification `%s'", SDATA (value));
4093 dpyinfo->visual = vinfo.visual;
4095 else
4097 int n_visuals;
4098 XVisualInfo *vinfo, vinfo_template;
4100 dpyinfo->visual = DefaultVisualOfScreen (screen);
4102 #ifdef HAVE_X11R4
4103 vinfo_template.visualid = XVisualIDFromVisual (dpyinfo->visual);
4104 #else
4105 vinfo_template.visualid = dpyinfo->visual->visualid;
4106 #endif
4107 vinfo_template.screen = XScreenNumberOfScreen (screen);
4108 vinfo = XGetVisualInfo (dpy, VisualIDMask | VisualScreenMask,
4109 &vinfo_template, &n_visuals);
4110 if (n_visuals != 1)
4111 fatal ("Can't get proper X visual info");
4113 dpyinfo->n_planes = vinfo->depth;
4114 XFree ((char *) vinfo);
4119 /* Return the X display structure for the display named NAME.
4120 Open a new connection if necessary. */
4122 struct x_display_info *
4123 x_display_info_for_name (name)
4124 Lisp_Object name;
4126 Lisp_Object names;
4127 struct x_display_info *dpyinfo;
4129 CHECK_STRING (name);
4131 if (! EQ (Vwindow_system, intern ("x")))
4132 error ("Not using X Windows");
4134 for (dpyinfo = x_display_list, names = x_display_name_list;
4135 dpyinfo;
4136 dpyinfo = dpyinfo->next, names = XCDR (names))
4138 Lisp_Object tem;
4139 tem = Fstring_equal (XCAR (XCAR (names)), name);
4140 if (!NILP (tem))
4141 return dpyinfo;
4144 /* Use this general default value to start with. */
4145 Vx_resource_name = Vinvocation_name;
4147 validate_x_resource_name ();
4149 dpyinfo = x_term_init (name, (char *)0,
4150 (char *) SDATA (Vx_resource_name));
4152 if (dpyinfo == 0)
4153 error ("Cannot connect to X server %s", SDATA (name));
4155 x_in_use = 1;
4156 XSETFASTINT (Vwindow_system_version, 11);
4158 return dpyinfo;
4162 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4163 1, 3, 0,
4164 doc: /* Open a connection to an X server.
4165 DISPLAY is the name of the display to connect to.
4166 Optional second arg XRM-STRING is a string of resources in xrdb format.
4167 If the optional third arg MUST-SUCCEED is non-nil,
4168 terminate Emacs if we can't open the connection. */)
4169 (display, xrm_string, must_succeed)
4170 Lisp_Object display, xrm_string, must_succeed;
4172 unsigned char *xrm_option;
4173 struct x_display_info *dpyinfo;
4175 CHECK_STRING (display);
4176 if (! NILP (xrm_string))
4177 CHECK_STRING (xrm_string);
4179 if (! EQ (Vwindow_system, intern ("x")))
4180 error ("Not using X Windows");
4182 if (! NILP (xrm_string))
4183 xrm_option = (unsigned char *) SDATA (xrm_string);
4184 else
4185 xrm_option = (unsigned char *) 0;
4187 validate_x_resource_name ();
4189 /* This is what opens the connection and sets x_current_display.
4190 This also initializes many symbols, such as those used for input. */
4191 dpyinfo = x_term_init (display, xrm_option,
4192 (char *) SDATA (Vx_resource_name));
4194 if (dpyinfo == 0)
4196 if (!NILP (must_succeed))
4197 fatal ("Cannot connect to X server %s.\n\
4198 Check the DISPLAY environment variable or use `-d'.\n\
4199 Also use the `xauth' program to verify that you have the proper\n\
4200 authorization information needed to connect the X server.\n\
4201 An insecure way to solve the problem may be to use `xhost'.\n",
4202 SDATA (display));
4203 else
4204 error ("Cannot connect to X server %s", SDATA (display));
4207 x_in_use = 1;
4209 XSETFASTINT (Vwindow_system_version, 11);
4210 return Qnil;
4213 DEFUN ("x-close-connection", Fx_close_connection,
4214 Sx_close_connection, 1, 1, 0,
4215 doc: /* Close the connection to DISPLAY's X server.
4216 For DISPLAY, specify either a frame or a display name (a string).
4217 If DISPLAY is nil, that stands for the selected frame's display. */)
4218 (display)
4219 Lisp_Object display;
4221 struct x_display_info *dpyinfo = check_x_display_info (display);
4222 int i;
4224 if (dpyinfo->reference_count > 0)
4225 error ("Display still has frames on it");
4227 BLOCK_INPUT;
4228 /* Free the fonts in the font table. */
4229 for (i = 0; i < dpyinfo->n_fonts; i++)
4230 if (dpyinfo->font_table[i].name)
4232 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
4235 x_destroy_all_bitmaps (dpyinfo);
4236 XSetCloseDownMode (dpyinfo->display, DestroyAll);
4238 #ifdef USE_X_TOOLKIT
4239 XtCloseDisplay (dpyinfo->display);
4240 #else
4241 XCloseDisplay (dpyinfo->display);
4242 #endif
4244 x_delete_display (dpyinfo);
4245 UNBLOCK_INPUT;
4247 return Qnil;
4250 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
4251 doc: /* Return the list of display names that Emacs has connections to. */)
4254 Lisp_Object tail, result;
4256 result = Qnil;
4257 for (tail = x_display_name_list; ! NILP (tail); tail = XCDR (tail))
4258 result = Fcons (XCAR (XCAR (tail)), result);
4260 return result;
4263 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
4264 doc: /* If ON is non-nil, report X errors as soon as the erring request is made.
4265 If ON is nil, allow buffering of requests.
4266 Turning on synchronization prohibits the Xlib routines from buffering
4267 requests and seriously degrades performance, but makes debugging much
4268 easier.
4269 The optional second argument DISPLAY specifies which display to act on.
4270 DISPLAY should be either a frame or a display name (a string).
4271 If DISPLAY is omitted or nil, that stands for the selected frame's display. */)
4272 (on, display)
4273 Lisp_Object display, on;
4275 struct x_display_info *dpyinfo = check_x_display_info (display);
4277 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
4279 return Qnil;
4282 /* Wait for responses to all X commands issued so far for frame F. */
4284 void
4285 x_sync (f)
4286 FRAME_PTR f;
4288 BLOCK_INPUT;
4289 XSync (FRAME_X_DISPLAY (f), False);
4290 UNBLOCK_INPUT;
4294 /***********************************************************************
4295 Image types
4296 ***********************************************************************/
4298 /* Value is the number of elements of vector VECTOR. */
4300 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
4302 /* List of supported image types. Use define_image_type to add new
4303 types. Use lookup_image_type to find a type for a given symbol. */
4305 static struct image_type *image_types;
4307 /* The symbol `xbm' which is used as the type symbol for XBM images. */
4309 Lisp_Object Qxbm;
4311 /* Keywords. */
4313 extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
4314 extern Lisp_Object QCdata, QCtype;
4315 Lisp_Object QCascent, QCmargin, QCrelief;
4316 Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask;
4317 Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask;
4319 /* Other symbols. */
4321 Lisp_Object Qlaplace, Qemboss, Qedge_detection, Qheuristic;
4323 /* Time in seconds after which images should be removed from the cache
4324 if not displayed. */
4326 Lisp_Object Vimage_cache_eviction_delay;
4328 /* Function prototypes. */
4330 static void define_image_type P_ ((struct image_type *type));
4331 static struct image_type *lookup_image_type P_ ((Lisp_Object symbol));
4332 static void image_error P_ ((char *format, Lisp_Object, Lisp_Object));
4333 static void x_laplace P_ ((struct frame *, struct image *));
4334 static void x_emboss P_ ((struct frame *, struct image *));
4335 static int x_build_heuristic_mask P_ ((struct frame *, struct image *,
4336 Lisp_Object));
4339 /* Define a new image type from TYPE. This adds a copy of TYPE to
4340 image_types and adds the symbol *TYPE->type to Vimage_types. */
4342 static void
4343 define_image_type (type)
4344 struct image_type *type;
4346 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
4347 The initialized data segment is read-only. */
4348 struct image_type *p = (struct image_type *) xmalloc (sizeof *p);
4349 bcopy (type, p, sizeof *p);
4350 p->next = image_types;
4351 image_types = p;
4352 Vimage_types = Fcons (*p->type, Vimage_types);
4356 /* Look up image type SYMBOL, and return a pointer to its image_type
4357 structure. Value is null if SYMBOL is not a known image type. */
4359 static INLINE struct image_type *
4360 lookup_image_type (symbol)
4361 Lisp_Object symbol;
4363 struct image_type *type;
4365 for (type = image_types; type; type = type->next)
4366 if (EQ (symbol, *type->type))
4367 break;
4369 return type;
4373 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
4374 valid image specification is a list whose car is the symbol
4375 `image', and whose rest is a property list. The property list must
4376 contain a value for key `:type'. That value must be the name of a
4377 supported image type. The rest of the property list depends on the
4378 image type. */
4381 valid_image_p (object)
4382 Lisp_Object object;
4384 int valid_p = 0;
4386 if (IMAGEP (object))
4388 Lisp_Object tem;
4390 for (tem = XCDR (object); CONSP (tem); tem = XCDR (tem))
4391 if (EQ (XCAR (tem), QCtype))
4393 tem = XCDR (tem);
4394 if (CONSP (tem) && SYMBOLP (XCAR (tem)))
4396 struct image_type *type;
4397 type = lookup_image_type (XCAR (tem));
4398 if (type)
4399 valid_p = type->valid_p (object);
4402 break;
4406 return valid_p;
4410 /* Log error message with format string FORMAT and argument ARG.
4411 Signaling an error, e.g. when an image cannot be loaded, is not a
4412 good idea because this would interrupt redisplay, and the error
4413 message display would lead to another redisplay. This function
4414 therefore simply displays a message. */
4416 static void
4417 image_error (format, arg1, arg2)
4418 char *format;
4419 Lisp_Object arg1, arg2;
4421 add_to_log (format, arg1, arg2);
4426 /***********************************************************************
4427 Image specifications
4428 ***********************************************************************/
4430 enum image_value_type
4432 IMAGE_DONT_CHECK_VALUE_TYPE,
4433 IMAGE_STRING_VALUE,
4434 IMAGE_STRING_OR_NIL_VALUE,
4435 IMAGE_SYMBOL_VALUE,
4436 IMAGE_POSITIVE_INTEGER_VALUE,
4437 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR,
4438 IMAGE_NON_NEGATIVE_INTEGER_VALUE,
4439 IMAGE_ASCENT_VALUE,
4440 IMAGE_INTEGER_VALUE,
4441 IMAGE_FUNCTION_VALUE,
4442 IMAGE_NUMBER_VALUE,
4443 IMAGE_BOOL_VALUE
4446 /* Structure used when parsing image specifications. */
4448 struct image_keyword
4450 /* Name of keyword. */
4451 char *name;
4453 /* The type of value allowed. */
4454 enum image_value_type type;
4456 /* Non-zero means key must be present. */
4457 int mandatory_p;
4459 /* Used to recognize duplicate keywords in a property list. */
4460 int count;
4462 /* The value that was found. */
4463 Lisp_Object value;
4467 static int parse_image_spec P_ ((Lisp_Object, struct image_keyword *,
4468 int, Lisp_Object));
4469 static Lisp_Object image_spec_value P_ ((Lisp_Object, Lisp_Object, int *));
4472 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
4473 has the format (image KEYWORD VALUE ...). One of the keyword/
4474 value pairs must be `:type TYPE'. KEYWORDS is a vector of
4475 image_keywords structures of size NKEYWORDS describing other
4476 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
4478 static int
4479 parse_image_spec (spec, keywords, nkeywords, type)
4480 Lisp_Object spec;
4481 struct image_keyword *keywords;
4482 int nkeywords;
4483 Lisp_Object type;
4485 int i;
4486 Lisp_Object plist;
4488 if (!IMAGEP (spec))
4489 return 0;
4491 plist = XCDR (spec);
4492 while (CONSP (plist))
4494 Lisp_Object key, value;
4496 /* First element of a pair must be a symbol. */
4497 key = XCAR (plist);
4498 plist = XCDR (plist);
4499 if (!SYMBOLP (key))
4500 return 0;
4502 /* There must follow a value. */
4503 if (!CONSP (plist))
4504 return 0;
4505 value = XCAR (plist);
4506 plist = XCDR (plist);
4508 /* Find key in KEYWORDS. Error if not found. */
4509 for (i = 0; i < nkeywords; ++i)
4510 if (strcmp (keywords[i].name, SDATA (SYMBOL_NAME (key))) == 0)
4511 break;
4513 if (i == nkeywords)
4514 continue;
4516 /* Record that we recognized the keyword. If a keywords
4517 was found more than once, it's an error. */
4518 keywords[i].value = value;
4519 ++keywords[i].count;
4521 if (keywords[i].count > 1)
4522 return 0;
4524 /* Check type of value against allowed type. */
4525 switch (keywords[i].type)
4527 case IMAGE_STRING_VALUE:
4528 if (!STRINGP (value))
4529 return 0;
4530 break;
4532 case IMAGE_STRING_OR_NIL_VALUE:
4533 if (!STRINGP (value) && !NILP (value))
4534 return 0;
4535 break;
4537 case IMAGE_SYMBOL_VALUE:
4538 if (!SYMBOLP (value))
4539 return 0;
4540 break;
4542 case IMAGE_POSITIVE_INTEGER_VALUE:
4543 if (!INTEGERP (value) || XINT (value) <= 0)
4544 return 0;
4545 break;
4547 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR:
4548 if (INTEGERP (value) && XINT (value) >= 0)
4549 break;
4550 if (CONSP (value)
4551 && INTEGERP (XCAR (value)) && INTEGERP (XCDR (value))
4552 && XINT (XCAR (value)) >= 0 && XINT (XCDR (value)) >= 0)
4553 break;
4554 return 0;
4556 case IMAGE_ASCENT_VALUE:
4557 if (SYMBOLP (value) && EQ (value, Qcenter))
4558 break;
4559 else if (INTEGERP (value)
4560 && XINT (value) >= 0
4561 && XINT (value) <= 100)
4562 break;
4563 return 0;
4565 case IMAGE_NON_NEGATIVE_INTEGER_VALUE:
4566 if (!INTEGERP (value) || XINT (value) < 0)
4567 return 0;
4568 break;
4570 case IMAGE_DONT_CHECK_VALUE_TYPE:
4571 break;
4573 case IMAGE_FUNCTION_VALUE:
4574 value = indirect_function (value);
4575 if (SUBRP (value)
4576 || COMPILEDP (value)
4577 || (CONSP (value) && EQ (XCAR (value), Qlambda)))
4578 break;
4579 return 0;
4581 case IMAGE_NUMBER_VALUE:
4582 if (!INTEGERP (value) && !FLOATP (value))
4583 return 0;
4584 break;
4586 case IMAGE_INTEGER_VALUE:
4587 if (!INTEGERP (value))
4588 return 0;
4589 break;
4591 case IMAGE_BOOL_VALUE:
4592 if (!NILP (value) && !EQ (value, Qt))
4593 return 0;
4594 break;
4596 default:
4597 abort ();
4598 break;
4601 if (EQ (key, QCtype) && !EQ (type, value))
4602 return 0;
4605 /* Check that all mandatory fields are present. */
4606 for (i = 0; i < nkeywords; ++i)
4607 if (keywords[i].mandatory_p && keywords[i].count == 0)
4608 return 0;
4610 return NILP (plist);
4614 /* Return the value of KEY in image specification SPEC. Value is nil
4615 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
4616 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
4618 static Lisp_Object
4619 image_spec_value (spec, key, found)
4620 Lisp_Object spec, key;
4621 int *found;
4623 Lisp_Object tail;
4625 xassert (valid_image_p (spec));
4627 for (tail = XCDR (spec);
4628 CONSP (tail) && CONSP (XCDR (tail));
4629 tail = XCDR (XCDR (tail)))
4631 if (EQ (XCAR (tail), key))
4633 if (found)
4634 *found = 1;
4635 return XCAR (XCDR (tail));
4639 if (found)
4640 *found = 0;
4641 return Qnil;
4645 DEFUN ("image-size", Fimage_size, Simage_size, 1, 3, 0,
4646 doc: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
4647 PIXELS non-nil means return the size in pixels, otherwise return the
4648 size in canonical character units.
4649 FRAME is the frame on which the image will be displayed. FRAME nil
4650 or omitted means use the selected frame. */)
4651 (spec, pixels, frame)
4652 Lisp_Object spec, pixels, frame;
4654 Lisp_Object size;
4656 size = Qnil;
4657 if (valid_image_p (spec))
4659 struct frame *f = check_x_frame (frame);
4660 int id = lookup_image (f, spec);
4661 struct image *img = IMAGE_FROM_ID (f, id);
4662 int width = img->width + 2 * img->hmargin;
4663 int height = img->height + 2 * img->vmargin;
4665 if (NILP (pixels))
4666 size = Fcons (make_float ((double) width / FRAME_COLUMN_WIDTH (f)),
4667 make_float ((double) height / FRAME_LINE_HEIGHT (f)));
4668 else
4669 size = Fcons (make_number (width), make_number (height));
4671 else
4672 error ("Invalid image specification");
4674 return size;
4678 DEFUN ("image-mask-p", Fimage_mask_p, Simage_mask_p, 1, 2, 0,
4679 doc: /* Return t if image SPEC has a mask bitmap.
4680 FRAME is the frame on which the image will be displayed. FRAME nil
4681 or omitted means use the selected frame. */)
4682 (spec, frame)
4683 Lisp_Object spec, frame;
4685 Lisp_Object mask;
4687 mask = Qnil;
4688 if (valid_image_p (spec))
4690 struct frame *f = check_x_frame (frame);
4691 int id = lookup_image (f, spec);
4692 struct image *img = IMAGE_FROM_ID (f, id);
4693 if (img->mask)
4694 mask = Qt;
4696 else
4697 error ("Invalid image specification");
4699 return mask;
4704 /***********************************************************************
4705 Image type independent image structures
4706 ***********************************************************************/
4708 static struct image *make_image P_ ((Lisp_Object spec, unsigned hash));
4709 static void free_image P_ ((struct frame *f, struct image *img));
4712 /* Allocate and return a new image structure for image specification
4713 SPEC. SPEC has a hash value of HASH. */
4715 static struct image *
4716 make_image (spec, hash)
4717 Lisp_Object spec;
4718 unsigned hash;
4720 struct image *img = (struct image *) xmalloc (sizeof *img);
4722 xassert (valid_image_p (spec));
4723 bzero (img, sizeof *img);
4724 img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
4725 xassert (img->type != NULL);
4726 img->spec = spec;
4727 img->data.lisp_val = Qnil;
4728 img->ascent = DEFAULT_IMAGE_ASCENT;
4729 img->hash = hash;
4730 return img;
4734 /* Free image IMG which was used on frame F, including its resources. */
4736 static void
4737 free_image (f, img)
4738 struct frame *f;
4739 struct image *img;
4741 if (img)
4743 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
4745 /* Remove IMG from the hash table of its cache. */
4746 if (img->prev)
4747 img->prev->next = img->next;
4748 else
4749 c->buckets[img->hash % IMAGE_CACHE_BUCKETS_SIZE] = img->next;
4751 if (img->next)
4752 img->next->prev = img->prev;
4754 c->images[img->id] = NULL;
4756 /* Free resources, then free IMG. */
4757 img->type->free (f, img);
4758 xfree (img);
4763 /* Prepare image IMG for display on frame F. Must be called before
4764 drawing an image. */
4766 void
4767 prepare_image_for_display (f, img)
4768 struct frame *f;
4769 struct image *img;
4771 EMACS_TIME t;
4773 /* We're about to display IMG, so set its timestamp to `now'. */
4774 EMACS_GET_TIME (t);
4775 img->timestamp = EMACS_SECS (t);
4777 /* If IMG doesn't have a pixmap yet, load it now, using the image
4778 type dependent loader function. */
4779 if (img->pixmap == None && !img->load_failed_p)
4780 img->load_failed_p = img->type->load (f, img) == 0;
4784 /* Value is the number of pixels for the ascent of image IMG when
4785 drawn in face FACE. */
4788 image_ascent (img, face)
4789 struct image *img;
4790 struct face *face;
4792 int height = img->height + img->vmargin;
4793 int ascent;
4795 if (img->ascent == CENTERED_IMAGE_ASCENT)
4797 if (face->font)
4798 /* This expression is arranged so that if the image can't be
4799 exactly centered, it will be moved slightly up. This is
4800 because a typical font is `top-heavy' (due to the presence
4801 uppercase letters), so the image placement should err towards
4802 being top-heavy too. It also just generally looks better. */
4803 ascent = (height + face->font->ascent - face->font->descent + 1) / 2;
4804 else
4805 ascent = height / 2;
4807 else
4808 ascent = height * img->ascent / 100.0;
4810 return ascent;
4814 /* Image background colors. */
4816 static unsigned long
4817 four_corners_best (ximg, width, height)
4818 XImage *ximg;
4819 unsigned long width, height;
4821 unsigned long corners[4], best;
4822 int i, best_count;
4824 /* Get the colors at the corners of ximg. */
4825 corners[0] = XGetPixel (ximg, 0, 0);
4826 corners[1] = XGetPixel (ximg, width - 1, 0);
4827 corners[2] = XGetPixel (ximg, width - 1, height - 1);
4828 corners[3] = XGetPixel (ximg, 0, height - 1);
4830 /* Choose the most frequently found color as background. */
4831 for (i = best_count = 0; i < 4; ++i)
4833 int j, n;
4835 for (j = n = 0; j < 4; ++j)
4836 if (corners[i] == corners[j])
4837 ++n;
4839 if (n > best_count)
4840 best = corners[i], best_count = n;
4843 return best;
4846 /* Return the `background' field of IMG. If IMG doesn't have one yet,
4847 it is guessed heuristically. If non-zero, XIMG is an existing XImage
4848 object to use for the heuristic. */
4850 unsigned long
4851 image_background (img, f, ximg)
4852 struct image *img;
4853 struct frame *f;
4854 XImage *ximg;
4856 if (! img->background_valid)
4857 /* IMG doesn't have a background yet, try to guess a reasonable value. */
4859 int free_ximg = !ximg;
4861 if (! ximg)
4862 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
4863 0, 0, img->width, img->height, ~0, ZPixmap);
4865 img->background = four_corners_best (ximg, img->width, img->height);
4867 if (free_ximg)
4868 XDestroyImage (ximg);
4870 img->background_valid = 1;
4873 return img->background;
4876 /* Return the `background_transparent' field of IMG. If IMG doesn't
4877 have one yet, it is guessed heuristically. If non-zero, MASK is an
4878 existing XImage object to use for the heuristic. */
4881 image_background_transparent (img, f, mask)
4882 struct image *img;
4883 struct frame *f;
4884 XImage *mask;
4886 if (! img->background_transparent_valid)
4887 /* IMG doesn't have a background yet, try to guess a reasonable value. */
4889 if (img->mask)
4891 int free_mask = !mask;
4893 if (! mask)
4894 mask = XGetImage (FRAME_X_DISPLAY (f), img->mask,
4895 0, 0, img->width, img->height, ~0, ZPixmap);
4897 img->background_transparent
4898 = !four_corners_best (mask, img->width, img->height);
4900 if (free_mask)
4901 XDestroyImage (mask);
4903 else
4904 img->background_transparent = 0;
4906 img->background_transparent_valid = 1;
4909 return img->background_transparent;
4913 /***********************************************************************
4914 Helper functions for X image types
4915 ***********************************************************************/
4917 static void x_clear_image_1 P_ ((struct frame *, struct image *, int,
4918 int, int));
4919 static void x_clear_image P_ ((struct frame *f, struct image *img));
4920 static unsigned long x_alloc_image_color P_ ((struct frame *f,
4921 struct image *img,
4922 Lisp_Object color_name,
4923 unsigned long dflt));
4926 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
4927 free the pixmap if any. MASK_P non-zero means clear the mask
4928 pixmap if any. COLORS_P non-zero means free colors allocated for
4929 the image, if any. */
4931 static void
4932 x_clear_image_1 (f, img, pixmap_p, mask_p, colors_p)
4933 struct frame *f;
4934 struct image *img;
4935 int pixmap_p, mask_p, colors_p;
4937 if (pixmap_p && img->pixmap)
4939 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
4940 img->pixmap = None;
4941 img->background_valid = 0;
4944 if (mask_p && img->mask)
4946 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
4947 img->mask = None;
4948 img->background_transparent_valid = 0;
4951 if (colors_p && img->ncolors)
4953 x_free_colors (f, img->colors, img->ncolors);
4954 xfree (img->colors);
4955 img->colors = NULL;
4956 img->ncolors = 0;
4960 /* Free X resources of image IMG which is used on frame F. */
4962 static void
4963 x_clear_image (f, img)
4964 struct frame *f;
4965 struct image *img;
4967 BLOCK_INPUT;
4968 x_clear_image_1 (f, img, 1, 1, 1);
4969 UNBLOCK_INPUT;
4973 /* Allocate color COLOR_NAME for image IMG on frame F. If color
4974 cannot be allocated, use DFLT. Add a newly allocated color to
4975 IMG->colors, so that it can be freed again. Value is the pixel
4976 color. */
4978 static unsigned long
4979 x_alloc_image_color (f, img, color_name, dflt)
4980 struct frame *f;
4981 struct image *img;
4982 Lisp_Object color_name;
4983 unsigned long dflt;
4985 XColor color;
4986 unsigned long result;
4988 xassert (STRINGP (color_name));
4990 if (x_defined_color (f, SDATA (color_name), &color, 1))
4992 /* This isn't called frequently so we get away with simply
4993 reallocating the color vector to the needed size, here. */
4994 ++img->ncolors;
4995 img->colors =
4996 (unsigned long *) xrealloc (img->colors,
4997 img->ncolors * sizeof *img->colors);
4998 img->colors[img->ncolors - 1] = color.pixel;
4999 result = color.pixel;
5001 else
5002 result = dflt;
5004 return result;
5009 /***********************************************************************
5010 Image Cache
5011 ***********************************************************************/
5013 static void cache_image P_ ((struct frame *f, struct image *img));
5014 static void postprocess_image P_ ((struct frame *, struct image *));
5017 /* Return a new, initialized image cache that is allocated from the
5018 heap. Call free_image_cache to free an image cache. */
5020 struct image_cache *
5021 make_image_cache ()
5023 struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
5024 int size;
5026 bzero (c, sizeof *c);
5027 c->size = 50;
5028 c->images = (struct image **) xmalloc (c->size * sizeof *c->images);
5029 size = IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
5030 c->buckets = (struct image **) xmalloc (size);
5031 bzero (c->buckets, size);
5032 return c;
5036 /* Free image cache of frame F. Be aware that X frames share images
5037 caches. */
5039 void
5040 free_image_cache (f)
5041 struct frame *f;
5043 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5044 if (c)
5046 int i;
5048 /* Cache should not be referenced by any frame when freed. */
5049 xassert (c->refcount == 0);
5051 for (i = 0; i < c->used; ++i)
5052 free_image (f, c->images[i]);
5053 xfree (c->images);
5054 xfree (c->buckets);
5055 xfree (c);
5056 FRAME_X_IMAGE_CACHE (f) = NULL;
5061 /* Clear image cache of frame F. FORCE_P non-zero means free all
5062 images. FORCE_P zero means clear only images that haven't been
5063 displayed for some time. Should be called from time to time to
5064 reduce the number of loaded images. If image-eviction-seconds is
5065 non-nil, this frees images in the cache which weren't displayed for
5066 at least that many seconds. */
5068 void
5069 clear_image_cache (f, force_p)
5070 struct frame *f;
5071 int force_p;
5073 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5075 if (c && INTEGERP (Vimage_cache_eviction_delay))
5077 EMACS_TIME t;
5078 unsigned long old;
5079 int i, nfreed;
5081 EMACS_GET_TIME (t);
5082 old = EMACS_SECS (t) - XFASTINT (Vimage_cache_eviction_delay);
5084 /* Block input so that we won't be interrupted by a SIGIO
5085 while being in an inconsistent state. */
5086 BLOCK_INPUT;
5088 for (i = nfreed = 0; i < c->used; ++i)
5090 struct image *img = c->images[i];
5091 if (img != NULL
5092 && (force_p || img->timestamp < old))
5094 free_image (f, img);
5095 ++nfreed;
5099 /* We may be clearing the image cache because, for example,
5100 Emacs was iconified for a longer period of time. In that
5101 case, current matrices may still contain references to
5102 images freed above. So, clear these matrices. */
5103 if (nfreed)
5105 Lisp_Object tail, frame;
5107 FOR_EACH_FRAME (tail, frame)
5109 struct frame *f = XFRAME (frame);
5110 if (FRAME_X_P (f)
5111 && FRAME_X_IMAGE_CACHE (f) == c)
5112 clear_current_matrices (f);
5115 ++windows_or_buffers_changed;
5118 UNBLOCK_INPUT;
5123 DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache,
5124 0, 1, 0,
5125 doc: /* Clear the image cache of FRAME.
5126 FRAME nil or omitted means use the selected frame.
5127 FRAME t means clear the image caches of all frames. */)
5128 (frame)
5129 Lisp_Object frame;
5131 if (EQ (frame, Qt))
5133 Lisp_Object tail;
5135 FOR_EACH_FRAME (tail, frame)
5136 if (FRAME_X_P (XFRAME (frame)))
5137 clear_image_cache (XFRAME (frame), 1);
5139 else
5140 clear_image_cache (check_x_frame (frame), 1);
5142 return Qnil;
5146 /* Compute masks and transform image IMG on frame F, as specified
5147 by the image's specification, */
5149 static void
5150 postprocess_image (f, img)
5151 struct frame *f;
5152 struct image *img;
5154 /* Manipulation of the image's mask. */
5155 if (img->pixmap)
5157 Lisp_Object conversion, spec;
5158 Lisp_Object mask;
5160 spec = img->spec;
5162 /* `:heuristic-mask t'
5163 `:mask heuristic'
5164 means build a mask heuristically.
5165 `:heuristic-mask (R G B)'
5166 `:mask (heuristic (R G B))'
5167 means build a mask from color (R G B) in the
5168 image.
5169 `:mask nil'
5170 means remove a mask, if any. */
5172 mask = image_spec_value (spec, QCheuristic_mask, NULL);
5173 if (!NILP (mask))
5174 x_build_heuristic_mask (f, img, mask);
5175 else
5177 int found_p;
5179 mask = image_spec_value (spec, QCmask, &found_p);
5181 if (EQ (mask, Qheuristic))
5182 x_build_heuristic_mask (f, img, Qt);
5183 else if (CONSP (mask)
5184 && EQ (XCAR (mask), Qheuristic))
5186 if (CONSP (XCDR (mask)))
5187 x_build_heuristic_mask (f, img, XCAR (XCDR (mask)));
5188 else
5189 x_build_heuristic_mask (f, img, XCDR (mask));
5191 else if (NILP (mask) && found_p && img->mask)
5193 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
5194 img->mask = None;
5199 /* Should we apply an image transformation algorithm? */
5200 conversion = image_spec_value (spec, QCconversion, NULL);
5201 if (EQ (conversion, Qdisabled))
5202 x_disable_image (f, img);
5203 else if (EQ (conversion, Qlaplace))
5204 x_laplace (f, img);
5205 else if (EQ (conversion, Qemboss))
5206 x_emboss (f, img);
5207 else if (CONSP (conversion)
5208 && EQ (XCAR (conversion), Qedge_detection))
5210 Lisp_Object tem;
5211 tem = XCDR (conversion);
5212 if (CONSP (tem))
5213 x_edge_detection (f, img,
5214 Fplist_get (tem, QCmatrix),
5215 Fplist_get (tem, QCcolor_adjustment));
5221 /* Return the id of image with Lisp specification SPEC on frame F.
5222 SPEC must be a valid Lisp image specification (see valid_image_p). */
5225 lookup_image (f, spec)
5226 struct frame *f;
5227 Lisp_Object spec;
5229 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5230 struct image *img;
5231 int i;
5232 unsigned hash;
5233 struct gcpro gcpro1;
5234 EMACS_TIME now;
5236 /* F must be a window-system frame, and SPEC must be a valid image
5237 specification. */
5238 xassert (FRAME_WINDOW_P (f));
5239 xassert (valid_image_p (spec));
5241 GCPRO1 (spec);
5243 /* Look up SPEC in the hash table of the image cache. */
5244 hash = sxhash (spec, 0);
5245 i = hash % IMAGE_CACHE_BUCKETS_SIZE;
5247 for (img = c->buckets[i]; img; img = img->next)
5248 if (img->hash == hash && !NILP (Fequal (img->spec, spec)))
5249 break;
5251 /* If not found, create a new image and cache it. */
5252 if (img == NULL)
5254 extern Lisp_Object Qpostscript;
5256 BLOCK_INPUT;
5257 img = make_image (spec, hash);
5258 cache_image (f, img);
5259 img->load_failed_p = img->type->load (f, img) == 0;
5261 /* If we can't load the image, and we don't have a width and
5262 height, use some arbitrary width and height so that we can
5263 draw a rectangle for it. */
5264 if (img->load_failed_p)
5266 Lisp_Object value;
5268 value = image_spec_value (spec, QCwidth, NULL);
5269 img->width = (INTEGERP (value)
5270 ? XFASTINT (value) : DEFAULT_IMAGE_WIDTH);
5271 value = image_spec_value (spec, QCheight, NULL);
5272 img->height = (INTEGERP (value)
5273 ? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT);
5275 else
5277 /* Handle image type independent image attributes
5278 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF',
5279 `:background COLOR'. */
5280 Lisp_Object ascent, margin, relief, bg;
5282 ascent = image_spec_value (spec, QCascent, NULL);
5283 if (INTEGERP (ascent))
5284 img->ascent = XFASTINT (ascent);
5285 else if (EQ (ascent, Qcenter))
5286 img->ascent = CENTERED_IMAGE_ASCENT;
5288 margin = image_spec_value (spec, QCmargin, NULL);
5289 if (INTEGERP (margin) && XINT (margin) >= 0)
5290 img->vmargin = img->hmargin = XFASTINT (margin);
5291 else if (CONSP (margin) && INTEGERP (XCAR (margin))
5292 && INTEGERP (XCDR (margin)))
5294 if (XINT (XCAR (margin)) > 0)
5295 img->hmargin = XFASTINT (XCAR (margin));
5296 if (XINT (XCDR (margin)) > 0)
5297 img->vmargin = XFASTINT (XCDR (margin));
5300 relief = image_spec_value (spec, QCrelief, NULL);
5301 if (INTEGERP (relief))
5303 img->relief = XINT (relief);
5304 img->hmargin += abs (img->relief);
5305 img->vmargin += abs (img->relief);
5308 if (! img->background_valid)
5310 bg = image_spec_value (img->spec, QCbackground, NULL);
5311 if (!NILP (bg))
5313 img->background
5314 = x_alloc_image_color (f, img, bg,
5315 FRAME_BACKGROUND_PIXEL (f));
5316 img->background_valid = 1;
5320 /* Do image transformations and compute masks, unless we
5321 don't have the image yet. */
5322 if (!EQ (*img->type->type, Qpostscript))
5323 postprocess_image (f, img);
5326 UNBLOCK_INPUT;
5329 /* We're using IMG, so set its timestamp to `now'. */
5330 EMACS_GET_TIME (now);
5331 img->timestamp = EMACS_SECS (now);
5333 UNGCPRO;
5335 /* Value is the image id. */
5336 return img->id;
5340 /* Cache image IMG in the image cache of frame F. */
5342 static void
5343 cache_image (f, img)
5344 struct frame *f;
5345 struct image *img;
5347 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5348 int i;
5350 /* Find a free slot in c->images. */
5351 for (i = 0; i < c->used; ++i)
5352 if (c->images[i] == NULL)
5353 break;
5355 /* If no free slot found, maybe enlarge c->images. */
5356 if (i == c->used && c->used == c->size)
5358 c->size *= 2;
5359 c->images = (struct image **) xrealloc (c->images,
5360 c->size * sizeof *c->images);
5363 /* Add IMG to c->images, and assign IMG an id. */
5364 c->images[i] = img;
5365 img->id = i;
5366 if (i == c->used)
5367 ++c->used;
5369 /* Add IMG to the cache's hash table. */
5370 i = img->hash % IMAGE_CACHE_BUCKETS_SIZE;
5371 img->next = c->buckets[i];
5372 if (img->next)
5373 img->next->prev = img;
5374 img->prev = NULL;
5375 c->buckets[i] = img;
5379 /* Call FN on every image in the image cache of frame F. Used to mark
5380 Lisp Objects in the image cache. */
5382 void
5383 forall_images_in_image_cache (f, fn)
5384 struct frame *f;
5385 void (*fn) P_ ((struct image *img));
5387 if (FRAME_LIVE_P (f) && FRAME_X_P (f))
5389 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5390 if (c)
5392 int i;
5393 for (i = 0; i < c->used; ++i)
5394 if (c->images[i])
5395 fn (c->images[i]);
5402 /***********************************************************************
5403 X support code
5404 ***********************************************************************/
5406 static int x_create_x_image_and_pixmap P_ ((struct frame *, int, int, int,
5407 XImage **, Pixmap *));
5408 static void x_destroy_x_image P_ ((XImage *));
5409 static void x_put_x_image P_ ((struct frame *, XImage *, Pixmap, int, int));
5412 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
5413 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
5414 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
5415 via xmalloc. Print error messages via image_error if an error
5416 occurs. Value is non-zero if successful. */
5418 static int
5419 x_create_x_image_and_pixmap (f, width, height, depth, ximg, pixmap)
5420 struct frame *f;
5421 int width, height, depth;
5422 XImage **ximg;
5423 Pixmap *pixmap;
5425 Display *display = FRAME_X_DISPLAY (f);
5426 Screen *screen = FRAME_X_SCREEN (f);
5427 Window window = FRAME_X_WINDOW (f);
5429 xassert (interrupt_input_blocked);
5431 if (depth <= 0)
5432 depth = DefaultDepthOfScreen (screen);
5433 *ximg = XCreateImage (display, DefaultVisualOfScreen (screen),
5434 depth, ZPixmap, 0, NULL, width, height,
5435 depth > 16 ? 32 : depth > 8 ? 16 : 8, 0);
5436 if (*ximg == NULL)
5438 image_error ("Unable to allocate X image", Qnil, Qnil);
5439 return 0;
5442 /* Allocate image raster. */
5443 (*ximg)->data = (char *) xmalloc ((*ximg)->bytes_per_line * height);
5445 /* Allocate a pixmap of the same size. */
5446 *pixmap = XCreatePixmap (display, window, width, height, depth);
5447 if (*pixmap == None)
5449 x_destroy_x_image (*ximg);
5450 *ximg = NULL;
5451 image_error ("Unable to create X pixmap", Qnil, Qnil);
5452 return 0;
5455 return 1;
5459 /* Destroy XImage XIMG. Free XIMG->data. */
5461 static void
5462 x_destroy_x_image (ximg)
5463 XImage *ximg;
5465 xassert (interrupt_input_blocked);
5466 if (ximg)
5468 xfree (ximg->data);
5469 ximg->data = NULL;
5470 XDestroyImage (ximg);
5475 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
5476 are width and height of both the image and pixmap. */
5478 static void
5479 x_put_x_image (f, ximg, pixmap, width, height)
5480 struct frame *f;
5481 XImage *ximg;
5482 Pixmap pixmap;
5483 int width, height;
5485 GC gc;
5487 xassert (interrupt_input_blocked);
5488 gc = XCreateGC (FRAME_X_DISPLAY (f), pixmap, 0, NULL);
5489 XPutImage (FRAME_X_DISPLAY (f), pixmap, gc, ximg, 0, 0, 0, 0, width, height);
5490 XFreeGC (FRAME_X_DISPLAY (f), gc);
5495 /***********************************************************************
5496 File Handling
5497 ***********************************************************************/
5499 static Lisp_Object x_find_image_file P_ ((Lisp_Object));
5500 static char *slurp_file P_ ((char *, int *));
5503 /* Find image file FILE. Look in data-directory, then
5504 x-bitmap-file-path. Value is the full name of the file found, or
5505 nil if not found. */
5507 static Lisp_Object
5508 x_find_image_file (file)
5509 Lisp_Object file;
5511 Lisp_Object file_found, search_path;
5512 struct gcpro gcpro1, gcpro2;
5513 int fd;
5515 file_found = Qnil;
5516 search_path = Fcons (Vdata_directory, Vx_bitmap_file_path);
5517 GCPRO2 (file_found, search_path);
5519 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
5520 fd = openp (search_path, file, Qnil, &file_found, Qnil);
5522 if (fd == -1)
5523 file_found = Qnil;
5524 else
5525 close (fd);
5527 UNGCPRO;
5528 return file_found;
5532 /* Read FILE into memory. Value is a pointer to a buffer allocated
5533 with xmalloc holding FILE's contents. Value is null if an error
5534 occurred. *SIZE is set to the size of the file. */
5536 static char *
5537 slurp_file (file, size)
5538 char *file;
5539 int *size;
5541 FILE *fp = NULL;
5542 char *buf = NULL;
5543 struct stat st;
5545 if (stat (file, &st) == 0
5546 && (fp = fopen (file, "r")) != NULL
5547 && (buf = (char *) xmalloc (st.st_size),
5548 fread (buf, 1, st.st_size, fp) == st.st_size))
5550 *size = st.st_size;
5551 fclose (fp);
5553 else
5555 if (fp)
5556 fclose (fp);
5557 if (buf)
5559 xfree (buf);
5560 buf = NULL;
5564 return buf;
5569 /***********************************************************************
5570 XBM images
5571 ***********************************************************************/
5573 static int xbm_scan P_ ((char **, char *, char *, int *));
5574 static int xbm_load P_ ((struct frame *f, struct image *img));
5575 static int xbm_load_image P_ ((struct frame *f, struct image *img,
5576 char *, char *));
5577 static int xbm_image_p P_ ((Lisp_Object object));
5578 static int xbm_read_bitmap_data P_ ((char *, char *, int *, int *,
5579 unsigned char **));
5580 static int xbm_file_p P_ ((Lisp_Object));
5583 /* Indices of image specification fields in xbm_format, below. */
5585 enum xbm_keyword_index
5587 XBM_TYPE,
5588 XBM_FILE,
5589 XBM_WIDTH,
5590 XBM_HEIGHT,
5591 XBM_DATA,
5592 XBM_FOREGROUND,
5593 XBM_BACKGROUND,
5594 XBM_ASCENT,
5595 XBM_MARGIN,
5596 XBM_RELIEF,
5597 XBM_ALGORITHM,
5598 XBM_HEURISTIC_MASK,
5599 XBM_MASK,
5600 XBM_LAST
5603 /* Vector of image_keyword structures describing the format
5604 of valid XBM image specifications. */
5606 static struct image_keyword xbm_format[XBM_LAST] =
5608 {":type", IMAGE_SYMBOL_VALUE, 1},
5609 {":file", IMAGE_STRING_VALUE, 0},
5610 {":width", IMAGE_POSITIVE_INTEGER_VALUE, 0},
5611 {":height", IMAGE_POSITIVE_INTEGER_VALUE, 0},
5612 {":data", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
5613 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
5614 {":background", IMAGE_STRING_OR_NIL_VALUE, 0},
5615 {":ascent", IMAGE_ASCENT_VALUE, 0},
5616 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
5617 {":relief", IMAGE_INTEGER_VALUE, 0},
5618 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
5619 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
5620 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
5623 /* Structure describing the image type XBM. */
5625 static struct image_type xbm_type =
5627 &Qxbm,
5628 xbm_image_p,
5629 xbm_load,
5630 x_clear_image,
5631 NULL
5634 /* Tokens returned from xbm_scan. */
5636 enum xbm_token
5638 XBM_TK_IDENT = 256,
5639 XBM_TK_NUMBER
5643 /* Return non-zero if OBJECT is a valid XBM-type image specification.
5644 A valid specification is a list starting with the symbol `image'
5645 The rest of the list is a property list which must contain an
5646 entry `:type xbm..
5648 If the specification specifies a file to load, it must contain
5649 an entry `:file FILENAME' where FILENAME is a string.
5651 If the specification is for a bitmap loaded from memory it must
5652 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
5653 WIDTH and HEIGHT are integers > 0. DATA may be:
5655 1. a string large enough to hold the bitmap data, i.e. it must
5656 have a size >= (WIDTH + 7) / 8 * HEIGHT
5658 2. a bool-vector of size >= WIDTH * HEIGHT
5660 3. a vector of strings or bool-vectors, one for each line of the
5661 bitmap.
5663 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
5664 may not be specified in this case because they are defined in the
5665 XBM file.
5667 Both the file and data forms may contain the additional entries
5668 `:background COLOR' and `:foreground COLOR'. If not present,
5669 foreground and background of the frame on which the image is
5670 displayed is used. */
5672 static int
5673 xbm_image_p (object)
5674 Lisp_Object object;
5676 struct image_keyword kw[XBM_LAST];
5678 bcopy (xbm_format, kw, sizeof kw);
5679 if (!parse_image_spec (object, kw, XBM_LAST, Qxbm))
5680 return 0;
5682 xassert (EQ (kw[XBM_TYPE].value, Qxbm));
5684 if (kw[XBM_FILE].count)
5686 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_DATA].count)
5687 return 0;
5689 else if (kw[XBM_DATA].count && xbm_file_p (kw[XBM_DATA].value))
5691 /* In-memory XBM file. */
5692 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_FILE].count)
5693 return 0;
5695 else
5697 Lisp_Object data;
5698 int width, height;
5700 /* Entries for `:width', `:height' and `:data' must be present. */
5701 if (!kw[XBM_WIDTH].count
5702 || !kw[XBM_HEIGHT].count
5703 || !kw[XBM_DATA].count)
5704 return 0;
5706 data = kw[XBM_DATA].value;
5707 width = XFASTINT (kw[XBM_WIDTH].value);
5708 height = XFASTINT (kw[XBM_HEIGHT].value);
5710 /* Check type of data, and width and height against contents of
5711 data. */
5712 if (VECTORP (data))
5714 int i;
5716 /* Number of elements of the vector must be >= height. */
5717 if (XVECTOR (data)->size < height)
5718 return 0;
5720 /* Each string or bool-vector in data must be large enough
5721 for one line of the image. */
5722 for (i = 0; i < height; ++i)
5724 Lisp_Object elt = XVECTOR (data)->contents[i];
5726 if (STRINGP (elt))
5728 if (SCHARS (elt)
5729 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR)
5730 return 0;
5732 else if (BOOL_VECTOR_P (elt))
5734 if (XBOOL_VECTOR (elt)->size < width)
5735 return 0;
5737 else
5738 return 0;
5741 else if (STRINGP (data))
5743 if (SCHARS (data)
5744 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR * height)
5745 return 0;
5747 else if (BOOL_VECTOR_P (data))
5749 if (XBOOL_VECTOR (data)->size < width * height)
5750 return 0;
5752 else
5753 return 0;
5756 return 1;
5760 /* Scan a bitmap file. FP is the stream to read from. Value is
5761 either an enumerator from enum xbm_token, or a character for a
5762 single-character token, or 0 at end of file. If scanning an
5763 identifier, store the lexeme of the identifier in SVAL. If
5764 scanning a number, store its value in *IVAL. */
5766 static int
5767 xbm_scan (s, end, sval, ival)
5768 char **s, *end;
5769 char *sval;
5770 int *ival;
5772 int c;
5774 loop:
5776 /* Skip white space. */
5777 while (*s < end && (c = *(*s)++, isspace (c)))
5780 if (*s >= end)
5781 c = 0;
5782 else if (isdigit (c))
5784 int value = 0, digit;
5786 if (c == '0' && *s < end)
5788 c = *(*s)++;
5789 if (c == 'x' || c == 'X')
5791 while (*s < end)
5793 c = *(*s)++;
5794 if (isdigit (c))
5795 digit = c - '0';
5796 else if (c >= 'a' && c <= 'f')
5797 digit = c - 'a' + 10;
5798 else if (c >= 'A' && c <= 'F')
5799 digit = c - 'A' + 10;
5800 else
5801 break;
5802 value = 16 * value + digit;
5805 else if (isdigit (c))
5807 value = c - '0';
5808 while (*s < end
5809 && (c = *(*s)++, isdigit (c)))
5810 value = 8 * value + c - '0';
5813 else
5815 value = c - '0';
5816 while (*s < end
5817 && (c = *(*s)++, isdigit (c)))
5818 value = 10 * value + c - '0';
5821 if (*s < end)
5822 *s = *s - 1;
5823 *ival = value;
5824 c = XBM_TK_NUMBER;
5826 else if (isalpha (c) || c == '_')
5828 *sval++ = c;
5829 while (*s < end
5830 && (c = *(*s)++, (isalnum (c) || c == '_')))
5831 *sval++ = c;
5832 *sval = 0;
5833 if (*s < end)
5834 *s = *s - 1;
5835 c = XBM_TK_IDENT;
5837 else if (c == '/' && **s == '*')
5839 /* C-style comment. */
5840 ++*s;
5841 while (**s && (**s != '*' || *(*s + 1) != '/'))
5842 ++*s;
5843 if (**s)
5845 *s += 2;
5846 goto loop;
5850 return c;
5854 /* Replacement for XReadBitmapFileData which isn't available under old
5855 X versions. CONTENTS is a pointer to a buffer to parse; END is the
5856 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
5857 the image. Return in *DATA the bitmap data allocated with xmalloc.
5858 Value is non-zero if successful. DATA null means just test if
5859 CONTENTS looks like an in-memory XBM file. */
5861 static int
5862 xbm_read_bitmap_data (contents, end, width, height, data)
5863 char *contents, *end;
5864 int *width, *height;
5865 unsigned char **data;
5867 char *s = contents;
5868 char buffer[BUFSIZ];
5869 int padding_p = 0;
5870 int v10 = 0;
5871 int bytes_per_line, i, nbytes;
5872 unsigned char *p;
5873 int value;
5874 int LA1;
5876 #define match() \
5877 LA1 = xbm_scan (&s, end, buffer, &value)
5879 #define expect(TOKEN) \
5880 if (LA1 != (TOKEN)) \
5881 goto failure; \
5882 else \
5883 match ()
5885 #define expect_ident(IDENT) \
5886 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
5887 match (); \
5888 else \
5889 goto failure
5891 *width = *height = -1;
5892 if (data)
5893 *data = NULL;
5894 LA1 = xbm_scan (&s, end, buffer, &value);
5896 /* Parse defines for width, height and hot-spots. */
5897 while (LA1 == '#')
5899 match ();
5900 expect_ident ("define");
5901 expect (XBM_TK_IDENT);
5903 if (LA1 == XBM_TK_NUMBER);
5905 char *p = strrchr (buffer, '_');
5906 p = p ? p + 1 : buffer;
5907 if (strcmp (p, "width") == 0)
5908 *width = value;
5909 else if (strcmp (p, "height") == 0)
5910 *height = value;
5912 expect (XBM_TK_NUMBER);
5915 if (*width < 0 || *height < 0)
5916 goto failure;
5917 else if (data == NULL)
5918 goto success;
5920 /* Parse bits. Must start with `static'. */
5921 expect_ident ("static");
5922 if (LA1 == XBM_TK_IDENT)
5924 if (strcmp (buffer, "unsigned") == 0)
5926 match ();
5927 expect_ident ("char");
5929 else if (strcmp (buffer, "short") == 0)
5931 match ();
5932 v10 = 1;
5933 if (*width % 16 && *width % 16 < 9)
5934 padding_p = 1;
5936 else if (strcmp (buffer, "char") == 0)
5937 match ();
5938 else
5939 goto failure;
5941 else
5942 goto failure;
5944 expect (XBM_TK_IDENT);
5945 expect ('[');
5946 expect (']');
5947 expect ('=');
5948 expect ('{');
5950 bytes_per_line = (*width + 7) / 8 + padding_p;
5951 nbytes = bytes_per_line * *height;
5952 p = *data = (char *) xmalloc (nbytes);
5954 if (v10)
5956 for (i = 0; i < nbytes; i += 2)
5958 int val = value;
5959 expect (XBM_TK_NUMBER);
5961 *p++ = val;
5962 if (!padding_p || ((i + 2) % bytes_per_line))
5963 *p++ = value >> 8;
5965 if (LA1 == ',' || LA1 == '}')
5966 match ();
5967 else
5968 goto failure;
5971 else
5973 for (i = 0; i < nbytes; ++i)
5975 int val = value;
5976 expect (XBM_TK_NUMBER);
5978 *p++ = val;
5980 if (LA1 == ',' || LA1 == '}')
5981 match ();
5982 else
5983 goto failure;
5987 success:
5988 return 1;
5990 failure:
5992 if (data && *data)
5994 xfree (*data);
5995 *data = NULL;
5997 return 0;
5999 #undef match
6000 #undef expect
6001 #undef expect_ident
6005 /* Load XBM image IMG which will be displayed on frame F from buffer
6006 CONTENTS. END is the end of the buffer. Value is non-zero if
6007 successful. */
6009 static int
6010 xbm_load_image (f, img, contents, end)
6011 struct frame *f;
6012 struct image *img;
6013 char *contents, *end;
6015 int rc;
6016 unsigned char *data;
6017 int success_p = 0;
6019 rc = xbm_read_bitmap_data (contents, end, &img->width, &img->height, &data);
6020 if (rc)
6022 int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
6023 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
6024 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
6025 Lisp_Object value;
6027 xassert (img->width > 0 && img->height > 0);
6029 /* Get foreground and background colors, maybe allocate colors. */
6030 value = image_spec_value (img->spec, QCforeground, NULL);
6031 if (!NILP (value))
6032 foreground = x_alloc_image_color (f, img, value, foreground);
6033 value = image_spec_value (img->spec, QCbackground, NULL);
6034 if (!NILP (value))
6036 background = x_alloc_image_color (f, img, value, background);
6037 img->background = background;
6038 img->background_valid = 1;
6041 img->pixmap
6042 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
6043 FRAME_X_WINDOW (f),
6044 data,
6045 img->width, img->height,
6046 foreground, background,
6047 depth);
6048 xfree (data);
6050 if (img->pixmap == None)
6052 x_clear_image (f, img);
6053 image_error ("Unable to create X pixmap for `%s'", img->spec, Qnil);
6055 else
6056 success_p = 1;
6058 else
6059 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
6061 return success_p;
6065 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6067 static int
6068 xbm_file_p (data)
6069 Lisp_Object data;
6071 int w, h;
6072 return (STRINGP (data)
6073 && xbm_read_bitmap_data (SDATA (data),
6074 (SDATA (data)
6075 + SBYTES (data)),
6076 &w, &h, NULL));
6080 /* Fill image IMG which is used on frame F with pixmap data. Value is
6081 non-zero if successful. */
6083 static int
6084 xbm_load (f, img)
6085 struct frame *f;
6086 struct image *img;
6088 int success_p = 0;
6089 Lisp_Object file_name;
6091 xassert (xbm_image_p (img->spec));
6093 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6094 file_name = image_spec_value (img->spec, QCfile, NULL);
6095 if (STRINGP (file_name))
6097 Lisp_Object file;
6098 char *contents;
6099 int size;
6100 struct gcpro gcpro1;
6102 file = x_find_image_file (file_name);
6103 GCPRO1 (file);
6104 if (!STRINGP (file))
6106 image_error ("Cannot find image file `%s'", file_name, Qnil);
6107 UNGCPRO;
6108 return 0;
6111 contents = slurp_file (SDATA (file), &size);
6112 if (contents == NULL)
6114 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
6115 UNGCPRO;
6116 return 0;
6119 success_p = xbm_load_image (f, img, contents, contents + size);
6120 UNGCPRO;
6122 else
6124 struct image_keyword fmt[XBM_LAST];
6125 Lisp_Object data;
6126 int depth;
6127 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
6128 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
6129 char *bits;
6130 int parsed_p;
6131 int in_memory_file_p = 0;
6133 /* See if data looks like an in-memory XBM file. */
6134 data = image_spec_value (img->spec, QCdata, NULL);
6135 in_memory_file_p = xbm_file_p (data);
6137 /* Parse the image specification. */
6138 bcopy (xbm_format, fmt, sizeof fmt);
6139 parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm);
6140 xassert (parsed_p);
6142 /* Get specified width, and height. */
6143 if (!in_memory_file_p)
6145 img->width = XFASTINT (fmt[XBM_WIDTH].value);
6146 img->height = XFASTINT (fmt[XBM_HEIGHT].value);
6147 xassert (img->width > 0 && img->height > 0);
6150 /* Get foreground and background colors, maybe allocate colors. */
6151 if (fmt[XBM_FOREGROUND].count
6152 && STRINGP (fmt[XBM_FOREGROUND].value))
6153 foreground = x_alloc_image_color (f, img, fmt[XBM_FOREGROUND].value,
6154 foreground);
6155 if (fmt[XBM_BACKGROUND].count
6156 && STRINGP (fmt[XBM_BACKGROUND].value))
6157 background = x_alloc_image_color (f, img, fmt[XBM_BACKGROUND].value,
6158 background);
6160 if (in_memory_file_p)
6161 success_p = xbm_load_image (f, img, SDATA (data),
6162 (SDATA (data)
6163 + SBYTES (data)));
6164 else
6166 if (VECTORP (data))
6168 int i;
6169 char *p;
6170 int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
6172 p = bits = (char *) alloca (nbytes * img->height);
6173 for (i = 0; i < img->height; ++i, p += nbytes)
6175 Lisp_Object line = XVECTOR (data)->contents[i];
6176 if (STRINGP (line))
6177 bcopy (SDATA (line), p, nbytes);
6178 else
6179 bcopy (XBOOL_VECTOR (line)->data, p, nbytes);
6182 else if (STRINGP (data))
6183 bits = SDATA (data);
6184 else
6185 bits = XBOOL_VECTOR (data)->data;
6187 /* Create the pixmap. */
6188 depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
6189 img->pixmap
6190 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
6191 FRAME_X_WINDOW (f),
6192 bits,
6193 img->width, img->height,
6194 foreground, background,
6195 depth);
6196 if (img->pixmap)
6197 success_p = 1;
6198 else
6200 image_error ("Unable to create pixmap for XBM image `%s'",
6201 img->spec, Qnil);
6202 x_clear_image (f, img);
6207 return success_p;
6212 /***********************************************************************
6213 XPM images
6214 ***********************************************************************/
6216 #if HAVE_XPM
6218 static int xpm_image_p P_ ((Lisp_Object object));
6219 static int xpm_load P_ ((struct frame *f, struct image *img));
6220 static int xpm_valid_color_symbols_p P_ ((Lisp_Object));
6222 #include "X11/xpm.h"
6224 /* The symbol `xpm' identifying XPM-format images. */
6226 Lisp_Object Qxpm;
6228 /* Indices of image specification fields in xpm_format, below. */
6230 enum xpm_keyword_index
6232 XPM_TYPE,
6233 XPM_FILE,
6234 XPM_DATA,
6235 XPM_ASCENT,
6236 XPM_MARGIN,
6237 XPM_RELIEF,
6238 XPM_ALGORITHM,
6239 XPM_HEURISTIC_MASK,
6240 XPM_MASK,
6241 XPM_COLOR_SYMBOLS,
6242 XPM_BACKGROUND,
6243 XPM_LAST
6246 /* Vector of image_keyword structures describing the format
6247 of valid XPM image specifications. */
6249 static struct image_keyword xpm_format[XPM_LAST] =
6251 {":type", IMAGE_SYMBOL_VALUE, 1},
6252 {":file", IMAGE_STRING_VALUE, 0},
6253 {":data", IMAGE_STRING_VALUE, 0},
6254 {":ascent", IMAGE_ASCENT_VALUE, 0},
6255 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6256 {":relief", IMAGE_INTEGER_VALUE, 0},
6257 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6258 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6259 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6260 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6261 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
6264 /* Structure describing the image type XBM. */
6266 static struct image_type xpm_type =
6268 &Qxpm,
6269 xpm_image_p,
6270 xpm_load,
6271 x_clear_image,
6272 NULL
6276 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
6277 functions for allocating image colors. Our own functions handle
6278 color allocation failures more gracefully than the ones on the XPM
6279 lib. */
6281 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
6282 #define ALLOC_XPM_COLORS
6283 #endif
6285 #ifdef ALLOC_XPM_COLORS
6287 static void xpm_init_color_cache P_ ((struct frame *, XpmAttributes *));
6288 static void xpm_free_color_cache P_ ((void));
6289 static int xpm_lookup_color P_ ((struct frame *, char *, XColor *));
6290 static int xpm_color_bucket P_ ((char *));
6291 static struct xpm_cached_color *xpm_cache_color P_ ((struct frame *, char *,
6292 XColor *, int));
6294 /* An entry in a hash table used to cache color definitions of named
6295 colors. This cache is necessary to speed up XPM image loading in
6296 case we do color allocations ourselves. Without it, we would need
6297 a call to XParseColor per pixel in the image. */
6299 struct xpm_cached_color
6301 /* Next in collision chain. */
6302 struct xpm_cached_color *next;
6304 /* Color definition (RGB and pixel color). */
6305 XColor color;
6307 /* Color name. */
6308 char name[1];
6311 /* The hash table used for the color cache, and its bucket vector
6312 size. */
6314 #define XPM_COLOR_CACHE_BUCKETS 1001
6315 struct xpm_cached_color **xpm_color_cache;
6317 /* Initialize the color cache. */
6319 static void
6320 xpm_init_color_cache (f, attrs)
6321 struct frame *f;
6322 XpmAttributes *attrs;
6324 size_t nbytes = XPM_COLOR_CACHE_BUCKETS * sizeof *xpm_color_cache;
6325 xpm_color_cache = (struct xpm_cached_color **) xmalloc (nbytes);
6326 memset (xpm_color_cache, 0, nbytes);
6327 init_color_table ();
6329 if (attrs->valuemask & XpmColorSymbols)
6331 int i;
6332 XColor color;
6334 for (i = 0; i < attrs->numsymbols; ++i)
6335 if (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
6336 attrs->colorsymbols[i].value, &color))
6338 color.pixel = lookup_rgb_color (f, color.red, color.green,
6339 color.blue);
6340 xpm_cache_color (f, attrs->colorsymbols[i].name, &color, -1);
6346 /* Free the color cache. */
6348 static void
6349 xpm_free_color_cache ()
6351 struct xpm_cached_color *p, *next;
6352 int i;
6354 for (i = 0; i < XPM_COLOR_CACHE_BUCKETS; ++i)
6355 for (p = xpm_color_cache[i]; p; p = next)
6357 next = p->next;
6358 xfree (p);
6361 xfree (xpm_color_cache);
6362 xpm_color_cache = NULL;
6363 free_color_table ();
6367 /* Return the bucket index for color named COLOR_NAME in the color
6368 cache. */
6370 static int
6371 xpm_color_bucket (color_name)
6372 char *color_name;
6374 unsigned h = 0;
6375 char *s;
6377 for (s = color_name; *s; ++s)
6378 h = (h << 2) ^ *s;
6379 return h %= XPM_COLOR_CACHE_BUCKETS;
6383 /* On frame F, cache values COLOR for color with name COLOR_NAME.
6384 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
6385 entry added. */
6387 static struct xpm_cached_color *
6388 xpm_cache_color (f, color_name, color, bucket)
6389 struct frame *f;
6390 char *color_name;
6391 XColor *color;
6392 int bucket;
6394 size_t nbytes;
6395 struct xpm_cached_color *p;
6397 if (bucket < 0)
6398 bucket = xpm_color_bucket (color_name);
6400 nbytes = sizeof *p + strlen (color_name);
6401 p = (struct xpm_cached_color *) xmalloc (nbytes);
6402 strcpy (p->name, color_name);
6403 p->color = *color;
6404 p->next = xpm_color_cache[bucket];
6405 xpm_color_cache[bucket] = p;
6406 return p;
6410 /* Look up color COLOR_NAME for frame F in the color cache. If found,
6411 return the cached definition in *COLOR. Otherwise, make a new
6412 entry in the cache and allocate the color. Value is zero if color
6413 allocation failed. */
6415 static int
6416 xpm_lookup_color (f, color_name, color)
6417 struct frame *f;
6418 char *color_name;
6419 XColor *color;
6421 struct xpm_cached_color *p;
6422 int h = xpm_color_bucket (color_name);
6424 for (p = xpm_color_cache[h]; p; p = p->next)
6425 if (strcmp (p->name, color_name) == 0)
6426 break;
6428 if (p != NULL)
6429 *color = p->color;
6430 else if (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
6431 color_name, color))
6433 color->pixel = lookup_rgb_color (f, color->red, color->green,
6434 color->blue);
6435 p = xpm_cache_color (f, color_name, color, h);
6437 /* You get `opaque' at least from ImageMagick converting pbm to xpm
6438 with transparency, and it's useful. */
6439 else if (strcmp ("opaque", color_name) == 0)
6441 bzero (color, sizeof (XColor)); /* Is this necessary/correct? */
6442 color->pixel = FRAME_FOREGROUND_PIXEL (f);
6443 p = xpm_cache_color (f, color_name, color, h);
6446 return p != NULL;
6450 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
6451 CLOSURE is a pointer to the frame on which we allocate the
6452 color. Return in *COLOR the allocated color. Value is non-zero
6453 if successful. */
6455 static int
6456 xpm_alloc_color (dpy, cmap, color_name, color, closure)
6457 Display *dpy;
6458 Colormap cmap;
6459 char *color_name;
6460 XColor *color;
6461 void *closure;
6463 return xpm_lookup_color ((struct frame *) closure, color_name, color);
6467 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
6468 is a pointer to the frame on which we allocate the color. Value is
6469 non-zero if successful. */
6471 static int
6472 xpm_free_colors (dpy, cmap, pixels, npixels, closure)
6473 Display *dpy;
6474 Colormap cmap;
6475 Pixel *pixels;
6476 int npixels;
6477 void *closure;
6479 return 1;
6482 #endif /* ALLOC_XPM_COLORS */
6485 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
6486 for XPM images. Such a list must consist of conses whose car and
6487 cdr are strings. */
6489 static int
6490 xpm_valid_color_symbols_p (color_symbols)
6491 Lisp_Object color_symbols;
6493 while (CONSP (color_symbols))
6495 Lisp_Object sym = XCAR (color_symbols);
6496 if (!CONSP (sym)
6497 || !STRINGP (XCAR (sym))
6498 || !STRINGP (XCDR (sym)))
6499 break;
6500 color_symbols = XCDR (color_symbols);
6503 return NILP (color_symbols);
6507 /* Value is non-zero if OBJECT is a valid XPM image specification. */
6509 static int
6510 xpm_image_p (object)
6511 Lisp_Object object;
6513 struct image_keyword fmt[XPM_LAST];
6514 bcopy (xpm_format, fmt, sizeof fmt);
6515 return (parse_image_spec (object, fmt, XPM_LAST, Qxpm)
6516 /* Either `:file' or `:data' must be present. */
6517 && fmt[XPM_FILE].count + fmt[XPM_DATA].count == 1
6518 /* Either no `:color-symbols' or it's a list of conses
6519 whose car and cdr are strings. */
6520 && (fmt[XPM_COLOR_SYMBOLS].count == 0
6521 || xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value)));
6525 /* Load image IMG which will be displayed on frame F. Value is
6526 non-zero if successful. */
6528 static int
6529 xpm_load (f, img)
6530 struct frame *f;
6531 struct image *img;
6533 int rc;
6534 XpmAttributes attrs;
6535 Lisp_Object specified_file, color_symbols;
6537 /* Configure the XPM lib. Use the visual of frame F. Allocate
6538 close colors. Return colors allocated. */
6539 bzero (&attrs, sizeof attrs);
6540 attrs.visual = FRAME_X_VISUAL (f);
6541 attrs.colormap = FRAME_X_COLORMAP (f);
6542 attrs.valuemask |= XpmVisual;
6543 attrs.valuemask |= XpmColormap;
6545 #ifdef ALLOC_XPM_COLORS
6546 /* Allocate colors with our own functions which handle
6547 failing color allocation more gracefully. */
6548 attrs.color_closure = f;
6549 attrs.alloc_color = xpm_alloc_color;
6550 attrs.free_colors = xpm_free_colors;
6551 attrs.valuemask |= XpmAllocColor | XpmFreeColors | XpmColorClosure;
6552 #else /* not ALLOC_XPM_COLORS */
6553 /* Let the XPM lib allocate colors. */
6554 attrs.valuemask |= XpmReturnAllocPixels;
6555 #ifdef XpmAllocCloseColors
6556 attrs.alloc_close_colors = 1;
6557 attrs.valuemask |= XpmAllocCloseColors;
6558 #else /* not XpmAllocCloseColors */
6559 attrs.closeness = 600;
6560 attrs.valuemask |= XpmCloseness;
6561 #endif /* not XpmAllocCloseColors */
6562 #endif /* ALLOC_XPM_COLORS */
6564 /* If image specification contains symbolic color definitions, add
6565 these to `attrs'. */
6566 color_symbols = image_spec_value (img->spec, QCcolor_symbols, NULL);
6567 if (CONSP (color_symbols))
6569 Lisp_Object tail;
6570 XpmColorSymbol *xpm_syms;
6571 int i, size;
6573 attrs.valuemask |= XpmColorSymbols;
6575 /* Count number of symbols. */
6576 attrs.numsymbols = 0;
6577 for (tail = color_symbols; CONSP (tail); tail = XCDR (tail))
6578 ++attrs.numsymbols;
6580 /* Allocate an XpmColorSymbol array. */
6581 size = attrs.numsymbols * sizeof *xpm_syms;
6582 xpm_syms = (XpmColorSymbol *) alloca (size);
6583 bzero (xpm_syms, size);
6584 attrs.colorsymbols = xpm_syms;
6586 /* Fill the color symbol array. */
6587 for (tail = color_symbols, i = 0;
6588 CONSP (tail);
6589 ++i, tail = XCDR (tail))
6591 Lisp_Object name = XCAR (XCAR (tail));
6592 Lisp_Object color = XCDR (XCAR (tail));
6593 xpm_syms[i].name = (char *) alloca (SCHARS (name) + 1);
6594 strcpy (xpm_syms[i].name, SDATA (name));
6595 xpm_syms[i].value = (char *) alloca (SCHARS (color) + 1);
6596 strcpy (xpm_syms[i].value, SDATA (color));
6600 /* Create a pixmap for the image, either from a file, or from a
6601 string buffer containing data in the same format as an XPM file. */
6602 #ifdef ALLOC_XPM_COLORS
6603 xpm_init_color_cache (f, &attrs);
6604 #endif
6606 specified_file = image_spec_value (img->spec, QCfile, NULL);
6607 if (STRINGP (specified_file))
6609 Lisp_Object file = x_find_image_file (specified_file);
6610 if (!STRINGP (file))
6612 image_error ("Cannot find image file `%s'", specified_file, Qnil);
6613 return 0;
6616 rc = XpmReadFileToPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
6617 SDATA (file), &img->pixmap, &img->mask,
6618 &attrs);
6620 else
6622 Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL);
6623 rc = XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
6624 SDATA (buffer),
6625 &img->pixmap, &img->mask,
6626 &attrs);
6629 if (rc == XpmSuccess)
6631 #ifdef ALLOC_XPM_COLORS
6632 img->colors = colors_in_color_table (&img->ncolors);
6633 #else /* not ALLOC_XPM_COLORS */
6634 int i;
6636 img->ncolors = attrs.nalloc_pixels;
6637 img->colors = (unsigned long *) xmalloc (img->ncolors
6638 * sizeof *img->colors);
6639 for (i = 0; i < attrs.nalloc_pixels; ++i)
6641 img->colors[i] = attrs.alloc_pixels[i];
6642 #ifdef DEBUG_X_COLORS
6643 register_color (img->colors[i]);
6644 #endif
6646 #endif /* not ALLOC_XPM_COLORS */
6648 img->width = attrs.width;
6649 img->height = attrs.height;
6650 xassert (img->width > 0 && img->height > 0);
6652 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
6653 XpmFreeAttributes (&attrs);
6655 else
6657 switch (rc)
6659 case XpmOpenFailed:
6660 image_error ("Error opening XPM file (%s)", img->spec, Qnil);
6661 break;
6663 case XpmFileInvalid:
6664 image_error ("Invalid XPM file (%s)", img->spec, Qnil);
6665 break;
6667 case XpmNoMemory:
6668 image_error ("Out of memory (%s)", img->spec, Qnil);
6669 break;
6671 case XpmColorFailed:
6672 image_error ("Color allocation error (%s)", img->spec, Qnil);
6673 break;
6675 default:
6676 image_error ("Unknown error (%s)", img->spec, Qnil);
6677 break;
6681 #ifdef ALLOC_XPM_COLORS
6682 xpm_free_color_cache ();
6683 #endif
6684 return rc == XpmSuccess;
6687 #endif /* HAVE_XPM != 0 */
6690 /***********************************************************************
6691 Color table
6692 ***********************************************************************/
6694 /* An entry in the color table mapping an RGB color to a pixel color. */
6696 struct ct_color
6698 int r, g, b;
6699 unsigned long pixel;
6701 /* Next in color table collision list. */
6702 struct ct_color *next;
6705 /* The bucket vector size to use. Must be prime. */
6707 #define CT_SIZE 101
6709 /* Value is a hash of the RGB color given by R, G, and B. */
6711 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
6713 /* The color hash table. */
6715 struct ct_color **ct_table;
6717 /* Number of entries in the color table. */
6719 int ct_colors_allocated;
6721 /* Initialize the color table. */
6723 static void
6724 init_color_table ()
6726 int size = CT_SIZE * sizeof (*ct_table);
6727 ct_table = (struct ct_color **) xmalloc (size);
6728 bzero (ct_table, size);
6729 ct_colors_allocated = 0;
6733 /* Free memory associated with the color table. */
6735 static void
6736 free_color_table ()
6738 int i;
6739 struct ct_color *p, *next;
6741 for (i = 0; i < CT_SIZE; ++i)
6742 for (p = ct_table[i]; p; p = next)
6744 next = p->next;
6745 xfree (p);
6748 xfree (ct_table);
6749 ct_table = NULL;
6753 /* Value is a pixel color for RGB color R, G, B on frame F. If an
6754 entry for that color already is in the color table, return the
6755 pixel color of that entry. Otherwise, allocate a new color for R,
6756 G, B, and make an entry in the color table. */
6758 static unsigned long
6759 lookup_rgb_color (f, r, g, b)
6760 struct frame *f;
6761 int r, g, b;
6763 unsigned hash = CT_HASH_RGB (r, g, b);
6764 int i = hash % CT_SIZE;
6765 struct ct_color *p;
6766 struct x_display_info *dpyinfo;
6768 /* Handle TrueColor visuals specially, which improves performance by
6769 two orders of magnitude. Freeing colors on TrueColor visuals is
6770 a nop, and pixel colors specify RGB values directly. See also
6771 the Xlib spec, chapter 3.1. */
6772 dpyinfo = FRAME_X_DISPLAY_INFO (f);
6773 if (dpyinfo->red_bits > 0)
6775 unsigned long pr, pg, pb;
6777 /* Apply gamma-correction like normal color allocation does. */
6778 if (f->gamma)
6780 XColor color;
6781 color.red = r, color.green = g, color.blue = b;
6782 gamma_correct (f, &color);
6783 r = color.red, g = color.green, b = color.blue;
6786 /* Scale down RGB values to the visual's bits per RGB, and shift
6787 them to the right position in the pixel color. Note that the
6788 original RGB values are 16-bit values, as usual in X. */
6789 pr = (r >> (16 - dpyinfo->red_bits)) << dpyinfo->red_offset;
6790 pg = (g >> (16 - dpyinfo->green_bits)) << dpyinfo->green_offset;
6791 pb = (b >> (16 - dpyinfo->blue_bits)) << dpyinfo->blue_offset;
6793 /* Assemble the pixel color. */
6794 return pr | pg | pb;
6797 for (p = ct_table[i]; p; p = p->next)
6798 if (p->r == r && p->g == g && p->b == b)
6799 break;
6801 if (p == NULL)
6803 XColor color;
6804 Colormap cmap;
6805 int rc;
6807 color.red = r;
6808 color.green = g;
6809 color.blue = b;
6811 cmap = FRAME_X_COLORMAP (f);
6812 rc = x_alloc_nearest_color (f, cmap, &color);
6814 if (rc)
6816 ++ct_colors_allocated;
6818 p = (struct ct_color *) xmalloc (sizeof *p);
6819 p->r = r;
6820 p->g = g;
6821 p->b = b;
6822 p->pixel = color.pixel;
6823 p->next = ct_table[i];
6824 ct_table[i] = p;
6826 else
6827 return FRAME_FOREGROUND_PIXEL (f);
6830 return p->pixel;
6834 /* Look up pixel color PIXEL which is used on frame F in the color
6835 table. If not already present, allocate it. Value is PIXEL. */
6837 static unsigned long
6838 lookup_pixel_color (f, pixel)
6839 struct frame *f;
6840 unsigned long pixel;
6842 int i = pixel % CT_SIZE;
6843 struct ct_color *p;
6845 for (p = ct_table[i]; p; p = p->next)
6846 if (p->pixel == pixel)
6847 break;
6849 if (p == NULL)
6851 XColor color;
6852 Colormap cmap;
6853 int rc;
6855 cmap = FRAME_X_COLORMAP (f);
6856 color.pixel = pixel;
6857 x_query_color (f, &color);
6858 rc = x_alloc_nearest_color (f, cmap, &color);
6860 if (rc)
6862 ++ct_colors_allocated;
6864 p = (struct ct_color *) xmalloc (sizeof *p);
6865 p->r = color.red;
6866 p->g = color.green;
6867 p->b = color.blue;
6868 p->pixel = pixel;
6869 p->next = ct_table[i];
6870 ct_table[i] = p;
6872 else
6873 return FRAME_FOREGROUND_PIXEL (f);
6876 return p->pixel;
6880 /* Value is a vector of all pixel colors contained in the color table,
6881 allocated via xmalloc. Set *N to the number of colors. */
6883 static unsigned long *
6884 colors_in_color_table (n)
6885 int *n;
6887 int i, j;
6888 struct ct_color *p;
6889 unsigned long *colors;
6891 if (ct_colors_allocated == 0)
6893 *n = 0;
6894 colors = NULL;
6896 else
6898 colors = (unsigned long *) xmalloc (ct_colors_allocated
6899 * sizeof *colors);
6900 *n = ct_colors_allocated;
6902 for (i = j = 0; i < CT_SIZE; ++i)
6903 for (p = ct_table[i]; p; p = p->next)
6904 colors[j++] = p->pixel;
6907 return colors;
6912 /***********************************************************************
6913 Algorithms
6914 ***********************************************************************/
6916 static XColor *x_to_xcolors P_ ((struct frame *, struct image *, int));
6917 static void x_from_xcolors P_ ((struct frame *, struct image *, XColor *));
6918 static void x_detect_edges P_ ((struct frame *, struct image *, int[9], int));
6920 /* Non-zero means draw a cross on images having `:conversion
6921 disabled'. */
6923 int cross_disabled_images;
6925 /* Edge detection matrices for different edge-detection
6926 strategies. */
6928 static int emboss_matrix[9] = {
6929 /* x - 1 x x + 1 */
6930 2, -1, 0, /* y - 1 */
6931 -1, 0, 1, /* y */
6932 0, 1, -2 /* y + 1 */
6935 static int laplace_matrix[9] = {
6936 /* x - 1 x x + 1 */
6937 1, 0, 0, /* y - 1 */
6938 0, 0, 0, /* y */
6939 0, 0, -1 /* y + 1 */
6942 /* Value is the intensity of the color whose red/green/blue values
6943 are R, G, and B. */
6945 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
6948 /* On frame F, return an array of XColor structures describing image
6949 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
6950 non-zero means also fill the red/green/blue members of the XColor
6951 structures. Value is a pointer to the array of XColors structures,
6952 allocated with xmalloc; it must be freed by the caller. */
6954 static XColor *
6955 x_to_xcolors (f, img, rgb_p)
6956 struct frame *f;
6957 struct image *img;
6958 int rgb_p;
6960 int x, y;
6961 XColor *colors, *p;
6962 XImage *ximg;
6964 colors = (XColor *) xmalloc (img->width * img->height * sizeof *colors);
6966 /* Get the X image IMG->pixmap. */
6967 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
6968 0, 0, img->width, img->height, ~0, ZPixmap);
6970 /* Fill the `pixel' members of the XColor array. I wished there
6971 were an easy and portable way to circumvent XGetPixel. */
6972 p = colors;
6973 for (y = 0; y < img->height; ++y)
6975 XColor *row = p;
6977 for (x = 0; x < img->width; ++x, ++p)
6978 p->pixel = XGetPixel (ximg, x, y);
6980 if (rgb_p)
6981 x_query_colors (f, row, img->width);
6984 XDestroyImage (ximg);
6985 return colors;
6989 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
6990 RGB members are set. F is the frame on which this all happens.
6991 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
6993 static void
6994 x_from_xcolors (f, img, colors)
6995 struct frame *f;
6996 struct image *img;
6997 XColor *colors;
6999 int x, y;
7000 XImage *oimg;
7001 Pixmap pixmap;
7002 XColor *p;
7004 init_color_table ();
7006 x_create_x_image_and_pixmap (f, img->width, img->height, 0,
7007 &oimg, &pixmap);
7008 p = colors;
7009 for (y = 0; y < img->height; ++y)
7010 for (x = 0; x < img->width; ++x, ++p)
7012 unsigned long pixel;
7013 pixel = lookup_rgb_color (f, p->red, p->green, p->blue);
7014 XPutPixel (oimg, x, y, pixel);
7017 xfree (colors);
7018 x_clear_image_1 (f, img, 1, 0, 1);
7020 x_put_x_image (f, oimg, pixmap, img->width, img->height);
7021 x_destroy_x_image (oimg);
7022 img->pixmap = pixmap;
7023 img->colors = colors_in_color_table (&img->ncolors);
7024 free_color_table ();
7028 /* On frame F, perform edge-detection on image IMG.
7030 MATRIX is a nine-element array specifying the transformation
7031 matrix. See emboss_matrix for an example.
7033 COLOR_ADJUST is a color adjustment added to each pixel of the
7034 outgoing image. */
7036 static void
7037 x_detect_edges (f, img, matrix, color_adjust)
7038 struct frame *f;
7039 struct image *img;
7040 int matrix[9], color_adjust;
7042 XColor *colors = x_to_xcolors (f, img, 1);
7043 XColor *new, *p;
7044 int x, y, i, sum;
7046 for (i = sum = 0; i < 9; ++i)
7047 sum += abs (matrix[i]);
7049 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7051 new = (XColor *) xmalloc (img->width * img->height * sizeof *new);
7053 for (y = 0; y < img->height; ++y)
7055 p = COLOR (new, 0, y);
7056 p->red = p->green = p->blue = 0xffff/2;
7057 p = COLOR (new, img->width - 1, y);
7058 p->red = p->green = p->blue = 0xffff/2;
7061 for (x = 1; x < img->width - 1; ++x)
7063 p = COLOR (new, x, 0);
7064 p->red = p->green = p->blue = 0xffff/2;
7065 p = COLOR (new, x, img->height - 1);
7066 p->red = p->green = p->blue = 0xffff/2;
7069 for (y = 1; y < img->height - 1; ++y)
7071 p = COLOR (new, 1, y);
7073 for (x = 1; x < img->width - 1; ++x, ++p)
7075 int r, g, b, y1, x1;
7077 r = g = b = i = 0;
7078 for (y1 = y - 1; y1 < y + 2; ++y1)
7079 for (x1 = x - 1; x1 < x + 2; ++x1, ++i)
7080 if (matrix[i])
7082 XColor *t = COLOR (colors, x1, y1);
7083 r += matrix[i] * t->red;
7084 g += matrix[i] * t->green;
7085 b += matrix[i] * t->blue;
7088 r = (r / sum + color_adjust) & 0xffff;
7089 g = (g / sum + color_adjust) & 0xffff;
7090 b = (b / sum + color_adjust) & 0xffff;
7091 p->red = p->green = p->blue = COLOR_INTENSITY (r, g, b);
7095 xfree (colors);
7096 x_from_xcolors (f, img, new);
7098 #undef COLOR
7102 /* Perform the pre-defined `emboss' edge-detection on image IMG
7103 on frame F. */
7105 static void
7106 x_emboss (f, img)
7107 struct frame *f;
7108 struct image *img;
7110 x_detect_edges (f, img, emboss_matrix, 0xffff / 2);
7114 /* Perform the pre-defined `laplace' edge-detection on image IMG
7115 on frame F. */
7117 static void
7118 x_laplace (f, img)
7119 struct frame *f;
7120 struct image *img;
7122 x_detect_edges (f, img, laplace_matrix, 45000);
7126 /* Perform edge-detection on image IMG on frame F, with specified
7127 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7129 MATRIX must be either
7131 - a list of at least 9 numbers in row-major form
7132 - a vector of at least 9 numbers
7134 COLOR_ADJUST nil means use a default; otherwise it must be a
7135 number. */
7137 static void
7138 x_edge_detection (f, img, matrix, color_adjust)
7139 struct frame *f;
7140 struct image *img;
7141 Lisp_Object matrix, color_adjust;
7143 int i = 0;
7144 int trans[9];
7146 if (CONSP (matrix))
7148 for (i = 0;
7149 i < 9 && CONSP (matrix) && NUMBERP (XCAR (matrix));
7150 ++i, matrix = XCDR (matrix))
7151 trans[i] = XFLOATINT (XCAR (matrix));
7153 else if (VECTORP (matrix) && ASIZE (matrix) >= 9)
7155 for (i = 0; i < 9 && NUMBERP (AREF (matrix, i)); ++i)
7156 trans[i] = XFLOATINT (AREF (matrix, i));
7159 if (NILP (color_adjust))
7160 color_adjust = make_number (0xffff / 2);
7162 if (i == 9 && NUMBERP (color_adjust))
7163 x_detect_edges (f, img, trans, (int) XFLOATINT (color_adjust));
7167 /* Transform image IMG on frame F so that it looks disabled. */
7169 static void
7170 x_disable_image (f, img)
7171 struct frame *f;
7172 struct image *img;
7174 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
7176 if (dpyinfo->n_planes >= 2)
7178 /* Color (or grayscale). Convert to gray, and equalize. Just
7179 drawing such images with a stipple can look very odd, so
7180 we're using this method instead. */
7181 XColor *colors = x_to_xcolors (f, img, 1);
7182 XColor *p, *end;
7183 const int h = 15000;
7184 const int l = 30000;
7186 for (p = colors, end = colors + img->width * img->height;
7187 p < end;
7188 ++p)
7190 int i = COLOR_INTENSITY (p->red, p->green, p->blue);
7191 int i2 = (0xffff - h - l) * i / 0xffff + l;
7192 p->red = p->green = p->blue = i2;
7195 x_from_xcolors (f, img, colors);
7198 /* Draw a cross over the disabled image, if we must or if we
7199 should. */
7200 if (dpyinfo->n_planes < 2 || cross_disabled_images)
7202 Display *dpy = FRAME_X_DISPLAY (f);
7203 GC gc;
7205 gc = XCreateGC (dpy, img->pixmap, 0, NULL);
7206 XSetForeground (dpy, gc, BLACK_PIX_DEFAULT (f));
7207 XDrawLine (dpy, img->pixmap, gc, 0, 0,
7208 img->width - 1, img->height - 1);
7209 XDrawLine (dpy, img->pixmap, gc, 0, img->height - 1,
7210 img->width - 1, 0);
7211 XFreeGC (dpy, gc);
7213 if (img->mask)
7215 gc = XCreateGC (dpy, img->mask, 0, NULL);
7216 XSetForeground (dpy, gc, WHITE_PIX_DEFAULT (f));
7217 XDrawLine (dpy, img->mask, gc, 0, 0,
7218 img->width - 1, img->height - 1);
7219 XDrawLine (dpy, img->mask, gc, 0, img->height - 1,
7220 img->width - 1, 0);
7221 XFreeGC (dpy, gc);
7227 /* Build a mask for image IMG which is used on frame F. FILE is the
7228 name of an image file, for error messages. HOW determines how to
7229 determine the background color of IMG. If it is a list '(R G B)',
7230 with R, G, and B being integers >= 0, take that as the color of the
7231 background. Otherwise, determine the background color of IMG
7232 heuristically. Value is non-zero if successful. */
7234 static int
7235 x_build_heuristic_mask (f, img, how)
7236 struct frame *f;
7237 struct image *img;
7238 Lisp_Object how;
7240 Display *dpy = FRAME_X_DISPLAY (f);
7241 XImage *ximg, *mask_img;
7242 int x, y, rc, use_img_background;
7243 unsigned long bg = 0;
7245 if (img->mask)
7247 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
7248 img->mask = None;
7249 img->background_transparent_valid = 0;
7252 /* Create an image and pixmap serving as mask. */
7253 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1,
7254 &mask_img, &img->mask);
7255 if (!rc)
7256 return 0;
7258 /* Get the X image of IMG->pixmap. */
7259 ximg = XGetImage (dpy, img->pixmap, 0, 0, img->width, img->height,
7260 ~0, ZPixmap);
7262 /* Determine the background color of ximg. If HOW is `(R G B)'
7263 take that as color. Otherwise, use the image's background color. */
7264 use_img_background = 1;
7266 if (CONSP (how))
7268 int rgb[3], i;
7270 for (i = 0; i < 3 && CONSP (how) && NATNUMP (XCAR (how)); ++i)
7272 rgb[i] = XFASTINT (XCAR (how)) & 0xffff;
7273 how = XCDR (how);
7276 if (i == 3 && NILP (how))
7278 char color_name[30];
7279 sprintf (color_name, "#%04x%04x%04x", rgb[0], rgb[1], rgb[2]);
7280 bg = x_alloc_image_color (f, img, build_string (color_name), 0);
7281 use_img_background = 0;
7285 if (use_img_background)
7286 bg = four_corners_best (ximg, img->width, img->height);
7288 /* Set all bits in mask_img to 1 whose color in ximg is different
7289 from the background color bg. */
7290 for (y = 0; y < img->height; ++y)
7291 for (x = 0; x < img->width; ++x)
7292 XPutPixel (mask_img, x, y, XGetPixel (ximg, x, y) != bg);
7294 /* Fill in the background_transparent field while we have the mask handy. */
7295 image_background_transparent (img, f, mask_img);
7297 /* Put mask_img into img->mask. */
7298 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
7299 x_destroy_x_image (mask_img);
7300 XDestroyImage (ximg);
7302 return 1;
7307 /***********************************************************************
7308 PBM (mono, gray, color)
7309 ***********************************************************************/
7311 static int pbm_image_p P_ ((Lisp_Object object));
7312 static int pbm_load P_ ((struct frame *f, struct image *img));
7313 static int pbm_scan_number P_ ((unsigned char **, unsigned char *));
7315 /* The symbol `pbm' identifying images of this type. */
7317 Lisp_Object Qpbm;
7319 /* Indices of image specification fields in gs_format, below. */
7321 enum pbm_keyword_index
7323 PBM_TYPE,
7324 PBM_FILE,
7325 PBM_DATA,
7326 PBM_ASCENT,
7327 PBM_MARGIN,
7328 PBM_RELIEF,
7329 PBM_ALGORITHM,
7330 PBM_HEURISTIC_MASK,
7331 PBM_MASK,
7332 PBM_FOREGROUND,
7333 PBM_BACKGROUND,
7334 PBM_LAST
7337 /* Vector of image_keyword structures describing the format
7338 of valid user-defined image specifications. */
7340 static struct image_keyword pbm_format[PBM_LAST] =
7342 {":type", IMAGE_SYMBOL_VALUE, 1},
7343 {":file", IMAGE_STRING_VALUE, 0},
7344 {":data", IMAGE_STRING_VALUE, 0},
7345 {":ascent", IMAGE_ASCENT_VALUE, 0},
7346 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
7347 {":relief", IMAGE_INTEGER_VALUE, 0},
7348 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7349 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7350 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7351 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
7352 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
7355 /* Structure describing the image type `pbm'. */
7357 static struct image_type pbm_type =
7359 &Qpbm,
7360 pbm_image_p,
7361 pbm_load,
7362 x_clear_image,
7363 NULL
7367 /* Return non-zero if OBJECT is a valid PBM image specification. */
7369 static int
7370 pbm_image_p (object)
7371 Lisp_Object object;
7373 struct image_keyword fmt[PBM_LAST];
7375 bcopy (pbm_format, fmt, sizeof fmt);
7377 if (!parse_image_spec (object, fmt, PBM_LAST, Qpbm))
7378 return 0;
7380 /* Must specify either :data or :file. */
7381 return fmt[PBM_DATA].count + fmt[PBM_FILE].count == 1;
7385 /* Scan a decimal number from *S and return it. Advance *S while
7386 reading the number. END is the end of the string. Value is -1 at
7387 end of input. */
7389 static int
7390 pbm_scan_number (s, end)
7391 unsigned char **s, *end;
7393 int c = 0, val = -1;
7395 while (*s < end)
7397 /* Skip white-space. */
7398 while (*s < end && (c = *(*s)++, isspace (c)))
7401 if (c == '#')
7403 /* Skip comment to end of line. */
7404 while (*s < end && (c = *(*s)++, c != '\n'))
7407 else if (isdigit (c))
7409 /* Read decimal number. */
7410 val = c - '0';
7411 while (*s < end && (c = *(*s)++, isdigit (c)))
7412 val = 10 * val + c - '0';
7413 break;
7415 else
7416 break;
7419 return val;
7423 /* Load PBM image IMG for use on frame F. */
7425 static int
7426 pbm_load (f, img)
7427 struct frame *f;
7428 struct image *img;
7430 int raw_p, x, y;
7431 int width, height, max_color_idx = 0;
7432 XImage *ximg;
7433 Lisp_Object file, specified_file;
7434 enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type;
7435 struct gcpro gcpro1;
7436 unsigned char *contents = NULL;
7437 unsigned char *end, *p;
7438 int size;
7440 specified_file = image_spec_value (img->spec, QCfile, NULL);
7441 file = Qnil;
7442 GCPRO1 (file);
7444 if (STRINGP (specified_file))
7446 file = x_find_image_file (specified_file);
7447 if (!STRINGP (file))
7449 image_error ("Cannot find image file `%s'", specified_file, Qnil);
7450 UNGCPRO;
7451 return 0;
7454 contents = slurp_file (SDATA (file), &size);
7455 if (contents == NULL)
7457 image_error ("Error reading `%s'", file, Qnil);
7458 UNGCPRO;
7459 return 0;
7462 p = contents;
7463 end = contents + size;
7465 else
7467 Lisp_Object data;
7468 data = image_spec_value (img->spec, QCdata, NULL);
7469 p = SDATA (data);
7470 end = p + SBYTES (data);
7473 /* Check magic number. */
7474 if (end - p < 2 || *p++ != 'P')
7476 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
7477 error:
7478 xfree (contents);
7479 UNGCPRO;
7480 return 0;
7483 switch (*p++)
7485 case '1':
7486 raw_p = 0, type = PBM_MONO;
7487 break;
7489 case '2':
7490 raw_p = 0, type = PBM_GRAY;
7491 break;
7493 case '3':
7494 raw_p = 0, type = PBM_COLOR;
7495 break;
7497 case '4':
7498 raw_p = 1, type = PBM_MONO;
7499 break;
7501 case '5':
7502 raw_p = 1, type = PBM_GRAY;
7503 break;
7505 case '6':
7506 raw_p = 1, type = PBM_COLOR;
7507 break;
7509 default:
7510 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
7511 goto error;
7514 /* Read width, height, maximum color-component. Characters
7515 starting with `#' up to the end of a line are ignored. */
7516 width = pbm_scan_number (&p, end);
7517 height = pbm_scan_number (&p, end);
7519 if (type != PBM_MONO)
7521 max_color_idx = pbm_scan_number (&p, end);
7522 if (raw_p && max_color_idx > 255)
7523 max_color_idx = 255;
7526 if (width < 0
7527 || height < 0
7528 || (type != PBM_MONO && max_color_idx < 0))
7529 goto error;
7531 if (!x_create_x_image_and_pixmap (f, width, height, 0,
7532 &ximg, &img->pixmap))
7533 goto error;
7535 /* Initialize the color hash table. */
7536 init_color_table ();
7538 if (type == PBM_MONO)
7540 int c = 0, g;
7541 struct image_keyword fmt[PBM_LAST];
7542 unsigned long fg = FRAME_FOREGROUND_PIXEL (f);
7543 unsigned long bg = FRAME_BACKGROUND_PIXEL (f);
7545 /* Parse the image specification. */
7546 bcopy (pbm_format, fmt, sizeof fmt);
7547 parse_image_spec (img->spec, fmt, PBM_LAST, Qpbm);
7549 /* Get foreground and background colors, maybe allocate colors. */
7550 if (fmt[PBM_FOREGROUND].count
7551 && STRINGP (fmt[PBM_FOREGROUND].value))
7552 fg = x_alloc_image_color (f, img, fmt[PBM_FOREGROUND].value, fg);
7553 if (fmt[PBM_BACKGROUND].count
7554 && STRINGP (fmt[PBM_BACKGROUND].value))
7556 bg = x_alloc_image_color (f, img, fmt[PBM_BACKGROUND].value, bg);
7557 img->background = bg;
7558 img->background_valid = 1;
7561 for (y = 0; y < height; ++y)
7562 for (x = 0; x < width; ++x)
7564 if (raw_p)
7566 if ((x & 7) == 0)
7567 c = *p++;
7568 g = c & 0x80;
7569 c <<= 1;
7571 else
7572 g = pbm_scan_number (&p, end);
7574 XPutPixel (ximg, x, y, g ? fg : bg);
7577 else
7579 for (y = 0; y < height; ++y)
7580 for (x = 0; x < width; ++x)
7582 int r, g, b;
7584 if (type == PBM_GRAY)
7585 r = g = b = raw_p ? *p++ : pbm_scan_number (&p, end);
7586 else if (raw_p)
7588 r = *p++;
7589 g = *p++;
7590 b = *p++;
7592 else
7594 r = pbm_scan_number (&p, end);
7595 g = pbm_scan_number (&p, end);
7596 b = pbm_scan_number (&p, end);
7599 if (r < 0 || g < 0 || b < 0)
7601 xfree (ximg->data);
7602 ximg->data = NULL;
7603 XDestroyImage (ximg);
7604 image_error ("Invalid pixel value in image `%s'",
7605 img->spec, Qnil);
7606 goto error;
7609 /* RGB values are now in the range 0..max_color_idx.
7610 Scale this to the range 0..0xffff supported by X. */
7611 r = (double) r * 65535 / max_color_idx;
7612 g = (double) g * 65535 / max_color_idx;
7613 b = (double) b * 65535 / max_color_idx;
7614 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
7618 /* Store in IMG->colors the colors allocated for the image, and
7619 free the color table. */
7620 img->colors = colors_in_color_table (&img->ncolors);
7621 free_color_table ();
7623 /* Maybe fill in the background field while we have ximg handy. */
7624 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
7625 IMAGE_BACKGROUND (img, f, ximg);
7627 /* Put the image into a pixmap. */
7628 x_put_x_image (f, ximg, img->pixmap, width, height);
7629 x_destroy_x_image (ximg);
7631 img->width = width;
7632 img->height = height;
7634 UNGCPRO;
7635 xfree (contents);
7636 return 1;
7641 /***********************************************************************
7643 ***********************************************************************/
7645 #if HAVE_PNG
7647 #if defined HAVE_LIBPNG_PNG_H
7648 # include <libpng/png.h>
7649 #else
7650 # include <png.h>
7651 #endif
7653 /* Function prototypes. */
7655 static int png_image_p P_ ((Lisp_Object object));
7656 static int png_load P_ ((struct frame *f, struct image *img));
7658 /* The symbol `png' identifying images of this type. */
7660 Lisp_Object Qpng;
7662 /* Indices of image specification fields in png_format, below. */
7664 enum png_keyword_index
7666 PNG_TYPE,
7667 PNG_DATA,
7668 PNG_FILE,
7669 PNG_ASCENT,
7670 PNG_MARGIN,
7671 PNG_RELIEF,
7672 PNG_ALGORITHM,
7673 PNG_HEURISTIC_MASK,
7674 PNG_MASK,
7675 PNG_BACKGROUND,
7676 PNG_LAST
7679 /* Vector of image_keyword structures describing the format
7680 of valid user-defined image specifications. */
7682 static struct image_keyword png_format[PNG_LAST] =
7684 {":type", IMAGE_SYMBOL_VALUE, 1},
7685 {":data", IMAGE_STRING_VALUE, 0},
7686 {":file", IMAGE_STRING_VALUE, 0},
7687 {":ascent", IMAGE_ASCENT_VALUE, 0},
7688 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
7689 {":relief", IMAGE_INTEGER_VALUE, 0},
7690 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7691 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7692 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7693 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
7696 /* Structure describing the image type `png'. */
7698 static struct image_type png_type =
7700 &Qpng,
7701 png_image_p,
7702 png_load,
7703 x_clear_image,
7704 NULL
7708 /* Return non-zero if OBJECT is a valid PNG image specification. */
7710 static int
7711 png_image_p (object)
7712 Lisp_Object object;
7714 struct image_keyword fmt[PNG_LAST];
7715 bcopy (png_format, fmt, sizeof fmt);
7717 if (!parse_image_spec (object, fmt, PNG_LAST, Qpng))
7718 return 0;
7720 /* Must specify either the :data or :file keyword. */
7721 return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
7725 /* Error and warning handlers installed when the PNG library
7726 is initialized. */
7728 static void
7729 my_png_error (png_ptr, msg)
7730 png_struct *png_ptr;
7731 char *msg;
7733 xassert (png_ptr != NULL);
7734 image_error ("PNG error: %s", build_string (msg), Qnil);
7735 longjmp (png_ptr->jmpbuf, 1);
7739 static void
7740 my_png_warning (png_ptr, msg)
7741 png_struct *png_ptr;
7742 char *msg;
7744 xassert (png_ptr != NULL);
7745 image_error ("PNG warning: %s", build_string (msg), Qnil);
7748 /* Memory source for PNG decoding. */
7750 struct png_memory_storage
7752 unsigned char *bytes; /* The data */
7753 size_t len; /* How big is it? */
7754 int index; /* Where are we? */
7758 /* Function set as reader function when reading PNG image from memory.
7759 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
7760 bytes from the input to DATA. */
7762 static void
7763 png_read_from_memory (png_ptr, data, length)
7764 png_structp png_ptr;
7765 png_bytep data;
7766 png_size_t length;
7768 struct png_memory_storage *tbr
7769 = (struct png_memory_storage *) png_get_io_ptr (png_ptr);
7771 if (length > tbr->len - tbr->index)
7772 png_error (png_ptr, "Read error");
7774 bcopy (tbr->bytes + tbr->index, data, length);
7775 tbr->index = tbr->index + length;
7778 /* Load PNG image IMG for use on frame F. Value is non-zero if
7779 successful. */
7781 static int
7782 png_load (f, img)
7783 struct frame *f;
7784 struct image *img;
7786 Lisp_Object file, specified_file;
7787 Lisp_Object specified_data;
7788 int x, y, i;
7789 XImage *ximg, *mask_img = NULL;
7790 struct gcpro gcpro1;
7791 png_struct *png_ptr = NULL;
7792 png_info *info_ptr = NULL, *end_info = NULL;
7793 FILE *volatile fp = NULL;
7794 png_byte sig[8];
7795 png_byte * volatile pixels = NULL;
7796 png_byte ** volatile rows = NULL;
7797 png_uint_32 width, height;
7798 int bit_depth, color_type, interlace_type;
7799 png_byte channels;
7800 png_uint_32 row_bytes;
7801 int transparent_p;
7802 double screen_gamma;
7803 struct png_memory_storage tbr; /* Data to be read */
7805 /* Find out what file to load. */
7806 specified_file = image_spec_value (img->spec, QCfile, NULL);
7807 specified_data = image_spec_value (img->spec, QCdata, NULL);
7808 file = Qnil;
7809 GCPRO1 (file);
7811 if (NILP (specified_data))
7813 file = x_find_image_file (specified_file);
7814 if (!STRINGP (file))
7816 image_error ("Cannot find image file `%s'", specified_file, Qnil);
7817 UNGCPRO;
7818 return 0;
7821 /* Open the image file. */
7822 fp = fopen (SDATA (file), "rb");
7823 if (!fp)
7825 image_error ("Cannot open image file `%s'", file, Qnil);
7826 UNGCPRO;
7827 fclose (fp);
7828 return 0;
7831 /* Check PNG signature. */
7832 if (fread (sig, 1, sizeof sig, fp) != sizeof sig
7833 || !png_check_sig (sig, sizeof sig))
7835 image_error ("Not a PNG file: `%s'", file, Qnil);
7836 UNGCPRO;
7837 fclose (fp);
7838 return 0;
7841 else
7843 /* Read from memory. */
7844 tbr.bytes = SDATA (specified_data);
7845 tbr.len = SBYTES (specified_data);
7846 tbr.index = 0;
7848 /* Check PNG signature. */
7849 if (tbr.len < sizeof sig
7850 || !png_check_sig (tbr.bytes, sizeof sig))
7852 image_error ("Not a PNG image: `%s'", img->spec, Qnil);
7853 UNGCPRO;
7854 return 0;
7857 /* Need to skip past the signature. */
7858 tbr.bytes += sizeof (sig);
7861 /* Initialize read and info structs for PNG lib. */
7862 png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL,
7863 my_png_error, my_png_warning);
7864 if (!png_ptr)
7866 if (fp) fclose (fp);
7867 UNGCPRO;
7868 return 0;
7871 info_ptr = png_create_info_struct (png_ptr);
7872 if (!info_ptr)
7874 png_destroy_read_struct (&png_ptr, NULL, NULL);
7875 if (fp) fclose (fp);
7876 UNGCPRO;
7877 return 0;
7880 end_info = png_create_info_struct (png_ptr);
7881 if (!end_info)
7883 png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
7884 if (fp) fclose (fp);
7885 UNGCPRO;
7886 return 0;
7889 /* Set error jump-back. We come back here when the PNG library
7890 detects an error. */
7891 if (setjmp (png_ptr->jmpbuf))
7893 error:
7894 if (png_ptr)
7895 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
7896 xfree (pixels);
7897 xfree (rows);
7898 if (fp) fclose (fp);
7899 UNGCPRO;
7900 return 0;
7903 /* Read image info. */
7904 if (!NILP (specified_data))
7905 png_set_read_fn (png_ptr, (void *) &tbr, png_read_from_memory);
7906 else
7907 png_init_io (png_ptr, fp);
7909 png_set_sig_bytes (png_ptr, sizeof sig);
7910 png_read_info (png_ptr, info_ptr);
7911 png_get_IHDR (png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
7912 &interlace_type, NULL, NULL);
7914 /* If image contains simply transparency data, we prefer to
7915 construct a clipping mask. */
7916 if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
7917 transparent_p = 1;
7918 else
7919 transparent_p = 0;
7921 /* This function is easier to write if we only have to handle
7922 one data format: RGB or RGBA with 8 bits per channel. Let's
7923 transform other formats into that format. */
7925 /* Strip more than 8 bits per channel. */
7926 if (bit_depth == 16)
7927 png_set_strip_16 (png_ptr);
7929 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
7930 if available. */
7931 png_set_expand (png_ptr);
7933 /* Convert grayscale images to RGB. */
7934 if (color_type == PNG_COLOR_TYPE_GRAY
7935 || color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
7936 png_set_gray_to_rgb (png_ptr);
7938 screen_gamma = (f->gamma ? 1 / f->gamma / 0.45455 : 2.2);
7940 #if 0 /* Avoid double gamma correction for PNG images. */
7941 { /* Tell the PNG lib to handle gamma correction for us. */
7942 int intent;
7943 double image_gamma;
7944 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
7945 if (png_get_sRGB (png_ptr, info_ptr, &intent))
7946 /* The libpng documentation says this is right in this case. */
7947 png_set_gamma (png_ptr, screen_gamma, 0.45455);
7948 else
7949 #endif
7950 if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
7951 /* Image contains gamma information. */
7952 png_set_gamma (png_ptr, screen_gamma, image_gamma);
7953 else
7954 /* Use the standard default for the image gamma. */
7955 png_set_gamma (png_ptr, screen_gamma, 0.45455);
7957 #endif /* if 0 */
7959 /* Handle alpha channel by combining the image with a background
7960 color. Do this only if a real alpha channel is supplied. For
7961 simple transparency, we prefer a clipping mask. */
7962 if (!transparent_p)
7964 png_color_16 *image_bg;
7965 Lisp_Object specified_bg
7966 = image_spec_value (img->spec, QCbackground, NULL);
7968 if (STRINGP (specified_bg))
7969 /* The user specified `:background', use that. */
7971 XColor color;
7972 if (x_defined_color (f, SDATA (specified_bg), &color, 0))
7974 png_color_16 user_bg;
7976 bzero (&user_bg, sizeof user_bg);
7977 user_bg.red = color.red;
7978 user_bg.green = color.green;
7979 user_bg.blue = color.blue;
7981 png_set_background (png_ptr, &user_bg,
7982 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
7985 else if (png_get_bKGD (png_ptr, info_ptr, &image_bg))
7986 /* Image contains a background color with which to
7987 combine the image. */
7988 png_set_background (png_ptr, image_bg,
7989 PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
7990 else
7992 /* Image does not contain a background color with which
7993 to combine the image data via an alpha channel. Use
7994 the frame's background instead. */
7995 XColor color;
7996 Colormap cmap;
7997 png_color_16 frame_background;
7999 cmap = FRAME_X_COLORMAP (f);
8000 color.pixel = FRAME_BACKGROUND_PIXEL (f);
8001 x_query_color (f, &color);
8003 bzero (&frame_background, sizeof frame_background);
8004 frame_background.red = color.red;
8005 frame_background.green = color.green;
8006 frame_background.blue = color.blue;
8008 png_set_background (png_ptr, &frame_background,
8009 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
8013 /* Update info structure. */
8014 png_read_update_info (png_ptr, info_ptr);
8016 /* Get number of channels. Valid values are 1 for grayscale images
8017 and images with a palette, 2 for grayscale images with transparency
8018 information (alpha channel), 3 for RGB images, and 4 for RGB
8019 images with alpha channel, i.e. RGBA. If conversions above were
8020 sufficient we should only have 3 or 4 channels here. */
8021 channels = png_get_channels (png_ptr, info_ptr);
8022 xassert (channels == 3 || channels == 4);
8024 /* Number of bytes needed for one row of the image. */
8025 row_bytes = png_get_rowbytes (png_ptr, info_ptr);
8027 /* Allocate memory for the image. */
8028 pixels = (png_byte *) xmalloc (row_bytes * height * sizeof *pixels);
8029 rows = (png_byte **) xmalloc (height * sizeof *rows);
8030 for (i = 0; i < height; ++i)
8031 rows[i] = pixels + i * row_bytes;
8033 /* Read the entire image. */
8034 png_read_image (png_ptr, rows);
8035 png_read_end (png_ptr, info_ptr);
8036 if (fp)
8038 fclose (fp);
8039 fp = NULL;
8042 /* Create the X image and pixmap. */
8043 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
8044 &img->pixmap))
8045 goto error;
8047 /* Create an image and pixmap serving as mask if the PNG image
8048 contains an alpha channel. */
8049 if (channels == 4
8050 && !transparent_p
8051 && !x_create_x_image_and_pixmap (f, width, height, 1,
8052 &mask_img, &img->mask))
8054 x_destroy_x_image (ximg);
8055 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
8056 img->pixmap = None;
8057 goto error;
8060 /* Fill the X image and mask from PNG data. */
8061 init_color_table ();
8063 for (y = 0; y < height; ++y)
8065 png_byte *p = rows[y];
8067 for (x = 0; x < width; ++x)
8069 unsigned r, g, b;
8071 r = *p++ << 8;
8072 g = *p++ << 8;
8073 b = *p++ << 8;
8074 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
8076 /* An alpha channel, aka mask channel, associates variable
8077 transparency with an image. Where other image formats
8078 support binary transparency---fully transparent or fully
8079 opaque---PNG allows up to 254 levels of partial transparency.
8080 The PNG library implements partial transparency by combining
8081 the image with a specified background color.
8083 I'm not sure how to handle this here nicely: because the
8084 background on which the image is displayed may change, for
8085 real alpha channel support, it would be necessary to create
8086 a new image for each possible background.
8088 What I'm doing now is that a mask is created if we have
8089 boolean transparency information. Otherwise I'm using
8090 the frame's background color to combine the image with. */
8092 if (channels == 4)
8094 if (mask_img)
8095 XPutPixel (mask_img, x, y, *p > 0);
8096 ++p;
8101 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
8102 /* Set IMG's background color from the PNG image, unless the user
8103 overrode it. */
8105 png_color_16 *bg;
8106 if (png_get_bKGD (png_ptr, info_ptr, &bg))
8108 img->background = lookup_rgb_color (f, bg->red, bg->green, bg->blue);
8109 img->background_valid = 1;
8113 /* Remember colors allocated for this image. */
8114 img->colors = colors_in_color_table (&img->ncolors);
8115 free_color_table ();
8117 /* Clean up. */
8118 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
8119 xfree (rows);
8120 xfree (pixels);
8122 img->width = width;
8123 img->height = height;
8125 /* Maybe fill in the background field while we have ximg handy. */
8126 IMAGE_BACKGROUND (img, f, ximg);
8128 /* Put the image into the pixmap, then free the X image and its buffer. */
8129 x_put_x_image (f, ximg, img->pixmap, width, height);
8130 x_destroy_x_image (ximg);
8132 /* Same for the mask. */
8133 if (mask_img)
8135 /* Fill in the background_transparent field while we have the mask
8136 handy. */
8137 image_background_transparent (img, f, mask_img);
8139 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
8140 x_destroy_x_image (mask_img);
8143 UNGCPRO;
8144 return 1;
8147 #endif /* HAVE_PNG != 0 */
8151 /***********************************************************************
8152 JPEG
8153 ***********************************************************************/
8155 #if HAVE_JPEG
8157 /* Work around a warning about HAVE_STDLIB_H being redefined in
8158 jconfig.h. */
8159 #ifdef HAVE_STDLIB_H
8160 #define HAVE_STDLIB_H_1
8161 #undef HAVE_STDLIB_H
8162 #endif /* HAVE_STLIB_H */
8164 #include <jpeglib.h>
8165 #include <jerror.h>
8166 #include <setjmp.h>
8168 #ifdef HAVE_STLIB_H_1
8169 #define HAVE_STDLIB_H 1
8170 #endif
8172 static int jpeg_image_p P_ ((Lisp_Object object));
8173 static int jpeg_load P_ ((struct frame *f, struct image *img));
8175 /* The symbol `jpeg' identifying images of this type. */
8177 Lisp_Object Qjpeg;
8179 /* Indices of image specification fields in gs_format, below. */
8181 enum jpeg_keyword_index
8183 JPEG_TYPE,
8184 JPEG_DATA,
8185 JPEG_FILE,
8186 JPEG_ASCENT,
8187 JPEG_MARGIN,
8188 JPEG_RELIEF,
8189 JPEG_ALGORITHM,
8190 JPEG_HEURISTIC_MASK,
8191 JPEG_MASK,
8192 JPEG_BACKGROUND,
8193 JPEG_LAST
8196 /* Vector of image_keyword structures describing the format
8197 of valid user-defined image specifications. */
8199 static struct image_keyword jpeg_format[JPEG_LAST] =
8201 {":type", IMAGE_SYMBOL_VALUE, 1},
8202 {":data", IMAGE_STRING_VALUE, 0},
8203 {":file", IMAGE_STRING_VALUE, 0},
8204 {":ascent", IMAGE_ASCENT_VALUE, 0},
8205 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
8206 {":relief", IMAGE_INTEGER_VALUE, 0},
8207 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8208 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8209 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8210 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
8213 /* Structure describing the image type `jpeg'. */
8215 static struct image_type jpeg_type =
8217 &Qjpeg,
8218 jpeg_image_p,
8219 jpeg_load,
8220 x_clear_image,
8221 NULL
8225 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8227 static int
8228 jpeg_image_p (object)
8229 Lisp_Object object;
8231 struct image_keyword fmt[JPEG_LAST];
8233 bcopy (jpeg_format, fmt, sizeof fmt);
8235 if (!parse_image_spec (object, fmt, JPEG_LAST, Qjpeg))
8236 return 0;
8238 /* Must specify either the :data or :file keyword. */
8239 return fmt[JPEG_FILE].count + fmt[JPEG_DATA].count == 1;
8243 struct my_jpeg_error_mgr
8245 struct jpeg_error_mgr pub;
8246 jmp_buf setjmp_buffer;
8250 static void
8251 my_error_exit (cinfo)
8252 j_common_ptr cinfo;
8254 struct my_jpeg_error_mgr *mgr = (struct my_jpeg_error_mgr *) cinfo->err;
8255 longjmp (mgr->setjmp_buffer, 1);
8259 /* Init source method for JPEG data source manager. Called by
8260 jpeg_read_header() before any data is actually read. See
8261 libjpeg.doc from the JPEG lib distribution. */
8263 static void
8264 our_init_source (cinfo)
8265 j_decompress_ptr cinfo;
8270 /* Fill input buffer method for JPEG data source manager. Called
8271 whenever more data is needed. We read the whole image in one step,
8272 so this only adds a fake end of input marker at the end. */
8274 static boolean
8275 our_fill_input_buffer (cinfo)
8276 j_decompress_ptr cinfo;
8278 /* Insert a fake EOI marker. */
8279 struct jpeg_source_mgr *src = cinfo->src;
8280 static JOCTET buffer[2];
8282 buffer[0] = (JOCTET) 0xFF;
8283 buffer[1] = (JOCTET) JPEG_EOI;
8285 src->next_input_byte = buffer;
8286 src->bytes_in_buffer = 2;
8287 return TRUE;
8291 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8292 is the JPEG data source manager. */
8294 static void
8295 our_skip_input_data (cinfo, num_bytes)
8296 j_decompress_ptr cinfo;
8297 long num_bytes;
8299 struct jpeg_source_mgr *src = (struct jpeg_source_mgr *) cinfo->src;
8301 if (src)
8303 if (num_bytes > src->bytes_in_buffer)
8304 ERREXIT (cinfo, JERR_INPUT_EOF);
8306 src->bytes_in_buffer -= num_bytes;
8307 src->next_input_byte += num_bytes;
8312 /* Method to terminate data source. Called by
8313 jpeg_finish_decompress() after all data has been processed. */
8315 static void
8316 our_term_source (cinfo)
8317 j_decompress_ptr cinfo;
8322 /* Set up the JPEG lib for reading an image from DATA which contains
8323 LEN bytes. CINFO is the decompression info structure created for
8324 reading the image. */
8326 static void
8327 jpeg_memory_src (cinfo, data, len)
8328 j_decompress_ptr cinfo;
8329 JOCTET *data;
8330 unsigned int len;
8332 struct jpeg_source_mgr *src;
8334 if (cinfo->src == NULL)
8336 /* First time for this JPEG object? */
8337 cinfo->src = (struct jpeg_source_mgr *)
8338 (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,
8339 sizeof (struct jpeg_source_mgr));
8340 src = (struct jpeg_source_mgr *) cinfo->src;
8341 src->next_input_byte = data;
8344 src = (struct jpeg_source_mgr *) cinfo->src;
8345 src->init_source = our_init_source;
8346 src->fill_input_buffer = our_fill_input_buffer;
8347 src->skip_input_data = our_skip_input_data;
8348 src->resync_to_restart = jpeg_resync_to_restart; /* Use default method. */
8349 src->term_source = our_term_source;
8350 src->bytes_in_buffer = len;
8351 src->next_input_byte = data;
8355 /* Load image IMG for use on frame F. Patterned after example.c
8356 from the JPEG lib. */
8358 static int
8359 jpeg_load (f, img)
8360 struct frame *f;
8361 struct image *img;
8363 struct jpeg_decompress_struct cinfo;
8364 struct my_jpeg_error_mgr mgr;
8365 Lisp_Object file, specified_file;
8366 Lisp_Object specified_data;
8367 FILE * volatile fp = NULL;
8368 JSAMPARRAY buffer;
8369 int row_stride, x, y;
8370 XImage *ximg = NULL;
8371 int rc;
8372 unsigned long *colors;
8373 int width, height;
8374 struct gcpro gcpro1;
8376 /* Open the JPEG file. */
8377 specified_file = image_spec_value (img->spec, QCfile, NULL);
8378 specified_data = image_spec_value (img->spec, QCdata, NULL);
8379 file = Qnil;
8380 GCPRO1 (file);
8382 if (NILP (specified_data))
8384 file = x_find_image_file (specified_file);
8385 if (!STRINGP (file))
8387 image_error ("Cannot find image file `%s'", specified_file, Qnil);
8388 UNGCPRO;
8389 return 0;
8392 fp = fopen (SDATA (file), "r");
8393 if (fp == NULL)
8395 image_error ("Cannot open `%s'", file, Qnil);
8396 UNGCPRO;
8397 return 0;
8401 /* Customize libjpeg's error handling to call my_error_exit when an
8402 error is detected. This function will perform a longjmp. */
8403 cinfo.err = jpeg_std_error (&mgr.pub);
8404 mgr.pub.error_exit = my_error_exit;
8406 if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
8408 if (rc == 1)
8410 /* Called from my_error_exit. Display a JPEG error. */
8411 char buffer[JMSG_LENGTH_MAX];
8412 cinfo.err->format_message ((j_common_ptr) &cinfo, buffer);
8413 image_error ("Error reading JPEG image `%s': %s", img->spec,
8414 build_string (buffer));
8417 /* Close the input file and destroy the JPEG object. */
8418 if (fp)
8419 fclose ((FILE *) fp);
8420 jpeg_destroy_decompress (&cinfo);
8422 /* If we already have an XImage, free that. */
8423 x_destroy_x_image (ximg);
8425 /* Free pixmap and colors. */
8426 x_clear_image (f, img);
8428 UNGCPRO;
8429 return 0;
8432 /* Create the JPEG decompression object. Let it read from fp.
8433 Read the JPEG image header. */
8434 jpeg_create_decompress (&cinfo);
8436 if (NILP (specified_data))
8437 jpeg_stdio_src (&cinfo, (FILE *) fp);
8438 else
8439 jpeg_memory_src (&cinfo, SDATA (specified_data),
8440 SBYTES (specified_data));
8442 jpeg_read_header (&cinfo, TRUE);
8444 /* Customize decompression so that color quantization will be used.
8445 Start decompression. */
8446 cinfo.quantize_colors = TRUE;
8447 jpeg_start_decompress (&cinfo);
8448 width = img->width = cinfo.output_width;
8449 height = img->height = cinfo.output_height;
8451 /* Create X image and pixmap. */
8452 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
8453 longjmp (mgr.setjmp_buffer, 2);
8455 /* Allocate colors. When color quantization is used,
8456 cinfo.actual_number_of_colors has been set with the number of
8457 colors generated, and cinfo.colormap is a two-dimensional array
8458 of color indices in the range 0..cinfo.actual_number_of_colors.
8459 No more than 255 colors will be generated. */
8461 int i, ir, ig, ib;
8463 if (cinfo.out_color_components > 2)
8464 ir = 0, ig = 1, ib = 2;
8465 else if (cinfo.out_color_components > 1)
8466 ir = 0, ig = 1, ib = 0;
8467 else
8468 ir = 0, ig = 0, ib = 0;
8470 /* Use the color table mechanism because it handles colors that
8471 cannot be allocated nicely. Such colors will be replaced with
8472 a default color, and we don't have to care about which colors
8473 can be freed safely, and which can't. */
8474 init_color_table ();
8475 colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
8476 * sizeof *colors);
8478 for (i = 0; i < cinfo.actual_number_of_colors; ++i)
8480 /* Multiply RGB values with 255 because X expects RGB values
8481 in the range 0..0xffff. */
8482 int r = cinfo.colormap[ir][i] << 8;
8483 int g = cinfo.colormap[ig][i] << 8;
8484 int b = cinfo.colormap[ib][i] << 8;
8485 colors[i] = lookup_rgb_color (f, r, g, b);
8488 /* Remember those colors actually allocated. */
8489 img->colors = colors_in_color_table (&img->ncolors);
8490 free_color_table ();
8493 /* Read pixels. */
8494 row_stride = width * cinfo.output_components;
8495 buffer = cinfo.mem->alloc_sarray ((j_common_ptr) &cinfo, JPOOL_IMAGE,
8496 row_stride, 1);
8497 for (y = 0; y < height; ++y)
8499 jpeg_read_scanlines (&cinfo, buffer, 1);
8500 for (x = 0; x < cinfo.output_width; ++x)
8501 XPutPixel (ximg, x, y, colors[buffer[0][x]]);
8504 /* Clean up. */
8505 jpeg_finish_decompress (&cinfo);
8506 jpeg_destroy_decompress (&cinfo);
8507 if (fp)
8508 fclose ((FILE *) fp);
8510 /* Maybe fill in the background field while we have ximg handy. */
8511 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
8512 IMAGE_BACKGROUND (img, f, ximg);
8514 /* Put the image into the pixmap. */
8515 x_put_x_image (f, ximg, img->pixmap, width, height);
8516 x_destroy_x_image (ximg);
8517 UNGCPRO;
8518 return 1;
8521 #endif /* HAVE_JPEG */
8525 /***********************************************************************
8526 TIFF
8527 ***********************************************************************/
8529 #if HAVE_TIFF
8531 #include <tiffio.h>
8533 static int tiff_image_p P_ ((Lisp_Object object));
8534 static int tiff_load P_ ((struct frame *f, struct image *img));
8536 /* The symbol `tiff' identifying images of this type. */
8538 Lisp_Object Qtiff;
8540 /* Indices of image specification fields in tiff_format, below. */
8542 enum tiff_keyword_index
8544 TIFF_TYPE,
8545 TIFF_DATA,
8546 TIFF_FILE,
8547 TIFF_ASCENT,
8548 TIFF_MARGIN,
8549 TIFF_RELIEF,
8550 TIFF_ALGORITHM,
8551 TIFF_HEURISTIC_MASK,
8552 TIFF_MASK,
8553 TIFF_BACKGROUND,
8554 TIFF_LAST
8557 /* Vector of image_keyword structures describing the format
8558 of valid user-defined image specifications. */
8560 static struct image_keyword tiff_format[TIFF_LAST] =
8562 {":type", IMAGE_SYMBOL_VALUE, 1},
8563 {":data", IMAGE_STRING_VALUE, 0},
8564 {":file", IMAGE_STRING_VALUE, 0},
8565 {":ascent", IMAGE_ASCENT_VALUE, 0},
8566 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
8567 {":relief", IMAGE_INTEGER_VALUE, 0},
8568 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8569 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8570 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8571 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
8574 /* Structure describing the image type `tiff'. */
8576 static struct image_type tiff_type =
8578 &Qtiff,
8579 tiff_image_p,
8580 tiff_load,
8581 x_clear_image,
8582 NULL
8586 /* Return non-zero if OBJECT is a valid TIFF image specification. */
8588 static int
8589 tiff_image_p (object)
8590 Lisp_Object object;
8592 struct image_keyword fmt[TIFF_LAST];
8593 bcopy (tiff_format, fmt, sizeof fmt);
8595 if (!parse_image_spec (object, fmt, TIFF_LAST, Qtiff))
8596 return 0;
8598 /* Must specify either the :data or :file keyword. */
8599 return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
8603 /* Reading from a memory buffer for TIFF images Based on the PNG
8604 memory source, but we have to provide a lot of extra functions.
8605 Blah.
8607 We really only need to implement read and seek, but I am not
8608 convinced that the TIFF library is smart enough not to destroy
8609 itself if we only hand it the function pointers we need to
8610 override. */
8612 typedef struct
8614 unsigned char *bytes;
8615 size_t len;
8616 int index;
8618 tiff_memory_source;
8621 static size_t
8622 tiff_read_from_memory (data, buf, size)
8623 thandle_t data;
8624 tdata_t buf;
8625 tsize_t size;
8627 tiff_memory_source *src = (tiff_memory_source *) data;
8629 if (size > src->len - src->index)
8630 return (size_t) -1;
8631 bcopy (src->bytes + src->index, buf, size);
8632 src->index += size;
8633 return size;
8637 static size_t
8638 tiff_write_from_memory (data, buf, size)
8639 thandle_t data;
8640 tdata_t buf;
8641 tsize_t size;
8643 return (size_t) -1;
8647 static toff_t
8648 tiff_seek_in_memory (data, off, whence)
8649 thandle_t data;
8650 toff_t off;
8651 int whence;
8653 tiff_memory_source *src = (tiff_memory_source *) data;
8654 int idx;
8656 switch (whence)
8658 case SEEK_SET: /* Go from beginning of source. */
8659 idx = off;
8660 break;
8662 case SEEK_END: /* Go from end of source. */
8663 idx = src->len + off;
8664 break;
8666 case SEEK_CUR: /* Go from current position. */
8667 idx = src->index + off;
8668 break;
8670 default: /* Invalid `whence'. */
8671 return -1;
8674 if (idx > src->len || idx < 0)
8675 return -1;
8677 src->index = idx;
8678 return src->index;
8682 static int
8683 tiff_close_memory (data)
8684 thandle_t data;
8686 /* NOOP */
8687 return 0;
8691 static int
8692 tiff_mmap_memory (data, pbase, psize)
8693 thandle_t data;
8694 tdata_t *pbase;
8695 toff_t *psize;
8697 /* It is already _IN_ memory. */
8698 return 0;
8702 static void
8703 tiff_unmap_memory (data, base, size)
8704 thandle_t data;
8705 tdata_t base;
8706 toff_t size;
8708 /* We don't need to do this. */
8712 static toff_t
8713 tiff_size_of_memory (data)
8714 thandle_t data;
8716 return ((tiff_memory_source *) data)->len;
8720 static void
8721 tiff_error_handler (title, format, ap)
8722 const char *title, *format;
8723 va_list ap;
8725 char buf[512];
8726 int len;
8728 len = sprintf (buf, "TIFF error: %s ", title);
8729 vsprintf (buf + len, format, ap);
8730 add_to_log (buf, Qnil, Qnil);
8734 static void
8735 tiff_warning_handler (title, format, ap)
8736 const char *title, *format;
8737 va_list ap;
8739 char buf[512];
8740 int len;
8742 len = sprintf (buf, "TIFF warning: %s ", title);
8743 vsprintf (buf + len, format, ap);
8744 add_to_log (buf, Qnil, Qnil);
8748 /* Load TIFF image IMG for use on frame F. Value is non-zero if
8749 successful. */
8751 static int
8752 tiff_load (f, img)
8753 struct frame *f;
8754 struct image *img;
8756 Lisp_Object file, specified_file;
8757 Lisp_Object specified_data;
8758 TIFF *tiff;
8759 int width, height, x, y;
8760 uint32 *buf;
8761 int rc;
8762 XImage *ximg;
8763 struct gcpro gcpro1;
8764 tiff_memory_source memsrc;
8766 specified_file = image_spec_value (img->spec, QCfile, NULL);
8767 specified_data = image_spec_value (img->spec, QCdata, NULL);
8768 file = Qnil;
8769 GCPRO1 (file);
8771 TIFFSetErrorHandler (tiff_error_handler);
8772 TIFFSetWarningHandler (tiff_warning_handler);
8774 if (NILP (specified_data))
8776 /* Read from a file */
8777 file = x_find_image_file (specified_file);
8778 if (!STRINGP (file))
8780 image_error ("Cannot find image file `%s'", file, Qnil);
8781 UNGCPRO;
8782 return 0;
8785 /* Try to open the image file. */
8786 tiff = TIFFOpen (SDATA (file), "r");
8787 if (tiff == NULL)
8789 image_error ("Cannot open `%s'", file, Qnil);
8790 UNGCPRO;
8791 return 0;
8794 else
8796 /* Memory source! */
8797 memsrc.bytes = SDATA (specified_data);
8798 memsrc.len = SBYTES (specified_data);
8799 memsrc.index = 0;
8801 tiff = TIFFClientOpen ("memory_source", "r", &memsrc,
8802 (TIFFReadWriteProc) tiff_read_from_memory,
8803 (TIFFReadWriteProc) tiff_write_from_memory,
8804 tiff_seek_in_memory,
8805 tiff_close_memory,
8806 tiff_size_of_memory,
8807 tiff_mmap_memory,
8808 tiff_unmap_memory);
8810 if (!tiff)
8812 image_error ("Cannot open memory source for `%s'", img->spec, Qnil);
8813 UNGCPRO;
8814 return 0;
8818 /* Get width and height of the image, and allocate a raster buffer
8819 of width x height 32-bit values. */
8820 TIFFGetField (tiff, TIFFTAG_IMAGEWIDTH, &width);
8821 TIFFGetField (tiff, TIFFTAG_IMAGELENGTH, &height);
8822 buf = (uint32 *) xmalloc (width * height * sizeof *buf);
8824 rc = TIFFReadRGBAImage (tiff, width, height, buf, 0);
8825 TIFFClose (tiff);
8826 if (!rc)
8828 image_error ("Error reading TIFF image `%s'", img->spec, Qnil);
8829 xfree (buf);
8830 UNGCPRO;
8831 return 0;
8834 /* Create the X image and pixmap. */
8835 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
8837 xfree (buf);
8838 UNGCPRO;
8839 return 0;
8842 /* Initialize the color table. */
8843 init_color_table ();
8845 /* Process the pixel raster. Origin is in the lower-left corner. */
8846 for (y = 0; y < height; ++y)
8848 uint32 *row = buf + y * width;
8850 for (x = 0; x < width; ++x)
8852 uint32 abgr = row[x];
8853 int r = TIFFGetR (abgr) << 8;
8854 int g = TIFFGetG (abgr) << 8;
8855 int b = TIFFGetB (abgr) << 8;
8856 XPutPixel (ximg, x, height - 1 - y, lookup_rgb_color (f, r, g, b));
8860 /* Remember the colors allocated for the image. Free the color table. */
8861 img->colors = colors_in_color_table (&img->ncolors);
8862 free_color_table ();
8864 img->width = width;
8865 img->height = height;
8867 /* Maybe fill in the background field while we have ximg handy. */
8868 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
8869 IMAGE_BACKGROUND (img, f, ximg);
8871 /* Put the image into the pixmap, then free the X image and its buffer. */
8872 x_put_x_image (f, ximg, img->pixmap, width, height);
8873 x_destroy_x_image (ximg);
8874 xfree (buf);
8876 UNGCPRO;
8877 return 1;
8880 #endif /* HAVE_TIFF != 0 */
8884 /***********************************************************************
8886 ***********************************************************************/
8888 #if HAVE_GIF
8890 #include <gif_lib.h>
8892 static int gif_image_p P_ ((Lisp_Object object));
8893 static int gif_load P_ ((struct frame *f, struct image *img));
8895 /* The symbol `gif' identifying images of this type. */
8897 Lisp_Object Qgif;
8899 /* Indices of image specification fields in gif_format, below. */
8901 enum gif_keyword_index
8903 GIF_TYPE,
8904 GIF_DATA,
8905 GIF_FILE,
8906 GIF_ASCENT,
8907 GIF_MARGIN,
8908 GIF_RELIEF,
8909 GIF_ALGORITHM,
8910 GIF_HEURISTIC_MASK,
8911 GIF_MASK,
8912 GIF_IMAGE,
8913 GIF_BACKGROUND,
8914 GIF_LAST
8917 /* Vector of image_keyword structures describing the format
8918 of valid user-defined image specifications. */
8920 static struct image_keyword gif_format[GIF_LAST] =
8922 {":type", IMAGE_SYMBOL_VALUE, 1},
8923 {":data", IMAGE_STRING_VALUE, 0},
8924 {":file", IMAGE_STRING_VALUE, 0},
8925 {":ascent", IMAGE_ASCENT_VALUE, 0},
8926 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
8927 {":relief", IMAGE_INTEGER_VALUE, 0},
8928 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8929 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8930 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8931 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8932 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
8935 /* Structure describing the image type `gif'. */
8937 static struct image_type gif_type =
8939 &Qgif,
8940 gif_image_p,
8941 gif_load,
8942 x_clear_image,
8943 NULL
8947 /* Return non-zero if OBJECT is a valid GIF image specification. */
8949 static int
8950 gif_image_p (object)
8951 Lisp_Object object;
8953 struct image_keyword fmt[GIF_LAST];
8954 bcopy (gif_format, fmt, sizeof fmt);
8956 if (!parse_image_spec (object, fmt, GIF_LAST, Qgif))
8957 return 0;
8959 /* Must specify either the :data or :file keyword. */
8960 return fmt[GIF_FILE].count + fmt[GIF_DATA].count == 1;
8964 /* Reading a GIF image from memory
8965 Based on the PNG memory stuff to a certain extent. */
8967 typedef struct
8969 unsigned char *bytes;
8970 size_t len;
8971 int index;
8973 gif_memory_source;
8976 /* Make the current memory source available to gif_read_from_memory.
8977 It's done this way because not all versions of libungif support
8978 a UserData field in the GifFileType structure. */
8979 static gif_memory_source *current_gif_memory_src;
8981 static int
8982 gif_read_from_memory (file, buf, len)
8983 GifFileType *file;
8984 GifByteType *buf;
8985 int len;
8987 gif_memory_source *src = current_gif_memory_src;
8989 if (len > src->len - src->index)
8990 return -1;
8992 bcopy (src->bytes + src->index, buf, len);
8993 src->index += len;
8994 return len;
8998 /* Load GIF image IMG for use on frame F. Value is non-zero if
8999 successful. */
9001 static int
9002 gif_load (f, img)
9003 struct frame *f;
9004 struct image *img;
9006 Lisp_Object file, specified_file;
9007 Lisp_Object specified_data;
9008 int rc, width, height, x, y, i;
9009 XImage *ximg;
9010 ColorMapObject *gif_color_map;
9011 unsigned long pixel_colors[256];
9012 GifFileType *gif;
9013 struct gcpro gcpro1;
9014 Lisp_Object image;
9015 int ino, image_left, image_top, image_width, image_height;
9016 gif_memory_source memsrc;
9017 unsigned char *raster;
9019 specified_file = image_spec_value (img->spec, QCfile, NULL);
9020 specified_data = image_spec_value (img->spec, QCdata, NULL);
9021 file = Qnil;
9022 GCPRO1 (file);
9024 if (NILP (specified_data))
9026 file = x_find_image_file (specified_file);
9027 if (!STRINGP (file))
9029 image_error ("Cannot find image file `%s'", specified_file, Qnil);
9030 UNGCPRO;
9031 return 0;
9034 /* Open the GIF file. */
9035 gif = DGifOpenFileName (SDATA (file));
9036 if (gif == NULL)
9038 image_error ("Cannot open `%s'", file, Qnil);
9039 UNGCPRO;
9040 return 0;
9043 else
9045 /* Read from memory! */
9046 current_gif_memory_src = &memsrc;
9047 memsrc.bytes = SDATA (specified_data);
9048 memsrc.len = SBYTES (specified_data);
9049 memsrc.index = 0;
9051 gif = DGifOpen (&memsrc, gif_read_from_memory);
9052 if (!gif)
9054 image_error ("Cannot open memory source `%s'", img->spec, Qnil);
9055 UNGCPRO;
9056 return 0;
9060 /* Read entire contents. */
9061 rc = DGifSlurp (gif);
9062 if (rc == GIF_ERROR)
9064 image_error ("Error reading `%s'", img->spec, Qnil);
9065 DGifCloseFile (gif);
9066 UNGCPRO;
9067 return 0;
9070 image = image_spec_value (img->spec, QCindex, NULL);
9071 ino = INTEGERP (image) ? XFASTINT (image) : 0;
9072 if (ino >= gif->ImageCount)
9074 image_error ("Invalid image number `%s' in image `%s'",
9075 image, img->spec);
9076 DGifCloseFile (gif);
9077 UNGCPRO;
9078 return 0;
9081 width = img->width = max (gif->SWidth, gif->Image.Left + gif->Image.Width);
9082 height = img->height = max (gif->SHeight, gif->Image.Top + gif->Image.Height);
9084 /* Create the X image and pixmap. */
9085 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
9087 DGifCloseFile (gif);
9088 UNGCPRO;
9089 return 0;
9092 /* Allocate colors. */
9093 gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap;
9094 if (!gif_color_map)
9095 gif_color_map = gif->SColorMap;
9096 init_color_table ();
9097 bzero (pixel_colors, sizeof pixel_colors);
9099 for (i = 0; i < gif_color_map->ColorCount; ++i)
9101 int r = gif_color_map->Colors[i].Red << 8;
9102 int g = gif_color_map->Colors[i].Green << 8;
9103 int b = gif_color_map->Colors[i].Blue << 8;
9104 pixel_colors[i] = lookup_rgb_color (f, r, g, b);
9107 img->colors = colors_in_color_table (&img->ncolors);
9108 free_color_table ();
9110 /* Clear the part of the screen image that are not covered by
9111 the image from the GIF file. Full animated GIF support
9112 requires more than can be done here (see the gif89 spec,
9113 disposal methods). Let's simply assume that the part
9114 not covered by a sub-image is in the frame's background color. */
9115 image_top = gif->SavedImages[ino].ImageDesc.Top;
9116 image_left = gif->SavedImages[ino].ImageDesc.Left;
9117 image_width = gif->SavedImages[ino].ImageDesc.Width;
9118 image_height = gif->SavedImages[ino].ImageDesc.Height;
9120 for (y = 0; y < image_top; ++y)
9121 for (x = 0; x < width; ++x)
9122 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9124 for (y = image_top + image_height; y < height; ++y)
9125 for (x = 0; x < width; ++x)
9126 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9128 for (y = image_top; y < image_top + image_height; ++y)
9130 for (x = 0; x < image_left; ++x)
9131 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9132 for (x = image_left + image_width; x < width; ++x)
9133 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9136 /* Read the GIF image into the X image. We use a local variable
9137 `raster' here because RasterBits below is a char *, and invites
9138 problems with bytes >= 0x80. */
9139 raster = (unsigned char *) gif->SavedImages[ino].RasterBits;
9141 if (gif->SavedImages[ino].ImageDesc.Interlace)
9143 static int interlace_start[] = {0, 4, 2, 1};
9144 static int interlace_increment[] = {8, 8, 4, 2};
9145 int pass;
9146 int row = interlace_start[0];
9148 pass = 0;
9150 for (y = 0; y < image_height; y++)
9152 if (row >= image_height)
9154 row = interlace_start[++pass];
9155 while (row >= image_height)
9156 row = interlace_start[++pass];
9159 for (x = 0; x < image_width; x++)
9161 int i = raster[(y * image_width) + x];
9162 XPutPixel (ximg, x + image_left, row + image_top,
9163 pixel_colors[i]);
9166 row += interlace_increment[pass];
9169 else
9171 for (y = 0; y < image_height; ++y)
9172 for (x = 0; x < image_width; ++x)
9174 int i = raster[y * image_width + x];
9175 XPutPixel (ximg, x + image_left, y + image_top, pixel_colors[i]);
9179 DGifCloseFile (gif);
9181 /* Maybe fill in the background field while we have ximg handy. */
9182 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
9183 IMAGE_BACKGROUND (img, f, ximg);
9185 /* Put the image into the pixmap, then free the X image and its buffer. */
9186 x_put_x_image (f, ximg, img->pixmap, width, height);
9187 x_destroy_x_image (ximg);
9189 UNGCPRO;
9190 return 1;
9193 #endif /* HAVE_GIF != 0 */
9197 /***********************************************************************
9198 Ghostscript
9199 ***********************************************************************/
9201 static int gs_image_p P_ ((Lisp_Object object));
9202 static int gs_load P_ ((struct frame *f, struct image *img));
9203 static void gs_clear_image P_ ((struct frame *f, struct image *img));
9205 /* The symbol `postscript' identifying images of this type. */
9207 Lisp_Object Qpostscript;
9209 /* Keyword symbols. */
9211 Lisp_Object QCloader, QCbounding_box, QCpt_width, QCpt_height;
9213 /* Indices of image specification fields in gs_format, below. */
9215 enum gs_keyword_index
9217 GS_TYPE,
9218 GS_PT_WIDTH,
9219 GS_PT_HEIGHT,
9220 GS_FILE,
9221 GS_LOADER,
9222 GS_BOUNDING_BOX,
9223 GS_ASCENT,
9224 GS_MARGIN,
9225 GS_RELIEF,
9226 GS_ALGORITHM,
9227 GS_HEURISTIC_MASK,
9228 GS_MASK,
9229 GS_BACKGROUND,
9230 GS_LAST
9233 /* Vector of image_keyword structures describing the format
9234 of valid user-defined image specifications. */
9236 static struct image_keyword gs_format[GS_LAST] =
9238 {":type", IMAGE_SYMBOL_VALUE, 1},
9239 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE, 1},
9240 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE, 1},
9241 {":file", IMAGE_STRING_VALUE, 1},
9242 {":loader", IMAGE_FUNCTION_VALUE, 0},
9243 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE, 1},
9244 {":ascent", IMAGE_ASCENT_VALUE, 0},
9245 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
9246 {":relief", IMAGE_INTEGER_VALUE, 0},
9247 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9248 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9249 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9250 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
9253 /* Structure describing the image type `ghostscript'. */
9255 static struct image_type gs_type =
9257 &Qpostscript,
9258 gs_image_p,
9259 gs_load,
9260 gs_clear_image,
9261 NULL
9265 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9267 static void
9268 gs_clear_image (f, img)
9269 struct frame *f;
9270 struct image *img;
9272 /* IMG->data.ptr_val may contain a recorded colormap. */
9273 xfree (img->data.ptr_val);
9274 x_clear_image (f, img);
9278 /* Return non-zero if OBJECT is a valid Ghostscript image
9279 specification. */
9281 static int
9282 gs_image_p (object)
9283 Lisp_Object object;
9285 struct image_keyword fmt[GS_LAST];
9286 Lisp_Object tem;
9287 int i;
9289 bcopy (gs_format, fmt, sizeof fmt);
9291 if (!parse_image_spec (object, fmt, GS_LAST, Qpostscript))
9292 return 0;
9294 /* Bounding box must be a list or vector containing 4 integers. */
9295 tem = fmt[GS_BOUNDING_BOX].value;
9296 if (CONSP (tem))
9298 for (i = 0; i < 4; ++i, tem = XCDR (tem))
9299 if (!CONSP (tem) || !INTEGERP (XCAR (tem)))
9300 return 0;
9301 if (!NILP (tem))
9302 return 0;
9304 else if (VECTORP (tem))
9306 if (XVECTOR (tem)->size != 4)
9307 return 0;
9308 for (i = 0; i < 4; ++i)
9309 if (!INTEGERP (XVECTOR (tem)->contents[i]))
9310 return 0;
9312 else
9313 return 0;
9315 return 1;
9319 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9320 if successful. */
9322 static int
9323 gs_load (f, img)
9324 struct frame *f;
9325 struct image *img;
9327 char buffer[100];
9328 Lisp_Object window_and_pixmap_id = Qnil, loader, pt_height, pt_width;
9329 struct gcpro gcpro1, gcpro2;
9330 Lisp_Object frame;
9331 double in_width, in_height;
9332 Lisp_Object pixel_colors = Qnil;
9334 /* Compute pixel size of pixmap needed from the given size in the
9335 image specification. Sizes in the specification are in pt. 1 pt
9336 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9337 info. */
9338 pt_width = image_spec_value (img->spec, QCpt_width, NULL);
9339 in_width = XFASTINT (pt_width) / 72.0;
9340 img->width = in_width * FRAME_X_DISPLAY_INFO (f)->resx;
9341 pt_height = image_spec_value (img->spec, QCpt_height, NULL);
9342 in_height = XFASTINT (pt_height) / 72.0;
9343 img->height = in_height * FRAME_X_DISPLAY_INFO (f)->resy;
9345 /* Create the pixmap. */
9346 xassert (img->pixmap == None);
9347 img->pixmap = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9348 img->width, img->height,
9349 DefaultDepthOfScreen (FRAME_X_SCREEN (f)));
9351 if (!img->pixmap)
9353 image_error ("Unable to create pixmap for `%s'", img->spec, Qnil);
9354 return 0;
9357 /* Call the loader to fill the pixmap. It returns a process object
9358 if successful. We do not record_unwind_protect here because
9359 other places in redisplay like calling window scroll functions
9360 don't either. Let the Lisp loader use `unwind-protect' instead. */
9361 GCPRO2 (window_and_pixmap_id, pixel_colors);
9363 sprintf (buffer, "%lu %lu",
9364 (unsigned long) FRAME_X_WINDOW (f),
9365 (unsigned long) img->pixmap);
9366 window_and_pixmap_id = build_string (buffer);
9368 sprintf (buffer, "%lu %lu",
9369 FRAME_FOREGROUND_PIXEL (f),
9370 FRAME_BACKGROUND_PIXEL (f));
9371 pixel_colors = build_string (buffer);
9373 XSETFRAME (frame, f);
9374 loader = image_spec_value (img->spec, QCloader, NULL);
9375 if (NILP (loader))
9376 loader = intern ("gs-load-image");
9378 img->data.lisp_val = call6 (loader, frame, img->spec,
9379 make_number (img->width),
9380 make_number (img->height),
9381 window_and_pixmap_id,
9382 pixel_colors);
9383 UNGCPRO;
9384 return PROCESSP (img->data.lisp_val);
9388 /* Kill the Ghostscript process that was started to fill PIXMAP on
9389 frame F. Called from XTread_socket when receiving an event
9390 telling Emacs that Ghostscript has finished drawing. */
9392 void
9393 x_kill_gs_process (pixmap, f)
9394 Pixmap pixmap;
9395 struct frame *f;
9397 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
9398 int class, i;
9399 struct image *img;
9401 /* Find the image containing PIXMAP. */
9402 for (i = 0; i < c->used; ++i)
9403 if (c->images[i]->pixmap == pixmap)
9404 break;
9406 /* Should someone in between have cleared the image cache, for
9407 instance, give up. */
9408 if (i == c->used)
9409 return;
9411 /* Kill the GS process. We should have found PIXMAP in the image
9412 cache and its image should contain a process object. */
9413 img = c->images[i];
9414 xassert (PROCESSP (img->data.lisp_val));
9415 Fkill_process (img->data.lisp_val, Qnil);
9416 img->data.lisp_val = Qnil;
9418 /* On displays with a mutable colormap, figure out the colors
9419 allocated for the image by looking at the pixels of an XImage for
9420 img->pixmap. */
9421 class = FRAME_X_VISUAL (f)->class;
9422 if (class != StaticColor && class != StaticGray && class != TrueColor)
9424 XImage *ximg;
9426 BLOCK_INPUT;
9428 /* Try to get an XImage for img->pixmep. */
9429 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
9430 0, 0, img->width, img->height, ~0, ZPixmap);
9431 if (ximg)
9433 int x, y;
9435 /* Initialize the color table. */
9436 init_color_table ();
9438 /* For each pixel of the image, look its color up in the
9439 color table. After having done so, the color table will
9440 contain an entry for each color used by the image. */
9441 for (y = 0; y < img->height; ++y)
9442 for (x = 0; x < img->width; ++x)
9444 unsigned long pixel = XGetPixel (ximg, x, y);
9445 lookup_pixel_color (f, pixel);
9448 /* Record colors in the image. Free color table and XImage. */
9449 img->colors = colors_in_color_table (&img->ncolors);
9450 free_color_table ();
9451 XDestroyImage (ximg);
9453 #if 0 /* This doesn't seem to be the case. If we free the colors
9454 here, we get a BadAccess later in x_clear_image when
9455 freeing the colors. */
9456 /* We have allocated colors once, but Ghostscript has also
9457 allocated colors on behalf of us. So, to get the
9458 reference counts right, free them once. */
9459 if (img->ncolors)
9460 x_free_colors (f, img->colors, img->ncolors);
9461 #endif
9463 else
9464 image_error ("Cannot get X image of `%s'; colors will not be freed",
9465 img->spec, Qnil);
9467 UNBLOCK_INPUT;
9470 /* Now that we have the pixmap, compute mask and transform the
9471 image if requested. */
9472 BLOCK_INPUT;
9473 postprocess_image (f, img);
9474 UNBLOCK_INPUT;
9479 /***********************************************************************
9480 Window properties
9481 ***********************************************************************/
9483 DEFUN ("x-change-window-property", Fx_change_window_property,
9484 Sx_change_window_property, 2, 6, 0,
9485 doc: /* Change window property PROP to VALUE on the X window of FRAME.
9486 PROP must be a string.
9487 VALUE may be a string or a list of conses, numbers and/or strings.
9488 If an element in the list is a string, it is converted to
9489 an Atom and the value of the Atom is used. If an element is a cons,
9490 it is converted to a 32 bit number where the car is the 16 top bits and the
9491 cdr is the lower 16 bits.
9492 FRAME nil or omitted means use the selected frame.
9493 If TYPE is given and non-nil, it is the name of the type of VALUE.
9494 If TYPE is not given or nil, the type is STRING.
9495 FORMAT gives the size in bits of each element if VALUE is a list.
9496 It must be one of 8, 16 or 32.
9497 If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
9498 If OUTER_P is non-nil, the property is changed for the outer X window of
9499 FRAME. Default is to change on the edit X window.
9501 Value is VALUE. */)
9502 (prop, value, frame, type, format, outer_p)
9503 Lisp_Object prop, value, frame, type, format, outer_p;
9505 struct frame *f = check_x_frame (frame);
9506 Atom prop_atom;
9507 Atom target_type = XA_STRING;
9508 int element_format = 8;
9509 unsigned char *data;
9510 int nelements;
9511 Window w;
9513 CHECK_STRING (prop);
9515 if (! NILP (format))
9517 CHECK_NUMBER (format);
9518 element_format = XFASTINT (format);
9520 if (element_format != 8 && element_format != 16
9521 && element_format != 32)
9522 error ("FORMAT must be one of 8, 16 or 32");
9525 if (CONSP (value))
9527 nelements = x_check_property_data (value);
9528 if (nelements == -1)
9529 error ("Bad data in VALUE, must be number, string or cons");
9531 if (element_format == 8)
9532 data = (unsigned char *) xmalloc (nelements);
9533 else if (element_format == 16)
9534 data = (unsigned char *) xmalloc (nelements*2);
9535 else
9536 data = (unsigned char *) xmalloc (nelements*4);
9538 x_fill_property_data (FRAME_X_DISPLAY (f), value, data, element_format);
9540 else
9542 CHECK_STRING (value);
9543 data = SDATA (value);
9544 nelements = SCHARS (value);
9547 BLOCK_INPUT;
9548 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
9549 if (! NILP (type))
9551 CHECK_STRING (type);
9552 target_type = XInternAtom (FRAME_X_DISPLAY (f), SDATA (type), False);
9555 if (! NILP (outer_p)) w = FRAME_OUTER_WINDOW (f);
9556 else w = FRAME_X_WINDOW (f);
9558 XChangeProperty (FRAME_X_DISPLAY (f), w,
9559 prop_atom, target_type, element_format, PropModeReplace,
9560 data, nelements);
9562 if (CONSP (value)) xfree (data);
9564 /* Make sure the property is set when we return. */
9565 XFlush (FRAME_X_DISPLAY (f));
9566 UNBLOCK_INPUT;
9568 return value;
9572 DEFUN ("x-delete-window-property", Fx_delete_window_property,
9573 Sx_delete_window_property, 1, 2, 0,
9574 doc: /* Remove window property PROP from X window of FRAME.
9575 FRAME nil or omitted means use the selected frame. Value is PROP. */)
9576 (prop, frame)
9577 Lisp_Object prop, frame;
9579 struct frame *f = check_x_frame (frame);
9580 Atom prop_atom;
9582 CHECK_STRING (prop);
9583 BLOCK_INPUT;
9584 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
9585 XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), prop_atom);
9587 /* Make sure the property is removed when we return. */
9588 XFlush (FRAME_X_DISPLAY (f));
9589 UNBLOCK_INPUT;
9591 return prop;
9595 DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
9596 1, 6, 0,
9597 doc: /* Value is the value of window property PROP on FRAME.
9598 If FRAME is nil or omitted, use the selected frame.
9599 If TYPE is nil or omitted, get the property as a string. Otherwise TYPE
9600 is the name of the Atom that denotes the type expected.
9601 If SOURCE is non-nil, get the property on that window instead of from
9602 FRAME. The number 0 denotes the root window.
9603 If DELETE_P is non-nil, delete the property after retreiving it.
9604 If VECTOR_RET_P is non-nil, don't return a string but a vector of values.
9606 Value is nil if FRAME hasn't a property with name PROP or if PROP has
9607 no value of TYPE. */)
9608 (prop, frame, type, source, delete_p, vector_ret_p)
9609 Lisp_Object prop, frame, type, source, delete_p, vector_ret_p;
9611 struct frame *f = check_x_frame (frame);
9612 Atom prop_atom;
9613 int rc;
9614 Lisp_Object prop_value = Qnil;
9615 char *tmp_data = NULL;
9616 Atom actual_type;
9617 Atom target_type = XA_STRING;
9618 int actual_format;
9619 unsigned long actual_size, bytes_remaining;
9620 Window target_window = FRAME_X_WINDOW (f);
9621 struct gcpro gcpro1;
9623 GCPRO1 (prop_value);
9624 CHECK_STRING (prop);
9626 if (! NILP (source))
9628 if (NUMBERP (source))
9630 if (FLOATP (source))
9631 target_window = (Window) XFLOAT (source);
9632 else
9633 target_window = XFASTINT (source);
9635 if (target_window == 0)
9636 target_window = FRAME_X_DISPLAY_INFO (f)->root_window;
9638 else if (CONSP (source))
9639 target_window = cons_to_long (source);
9642 BLOCK_INPUT;
9643 if (STRINGP (type))
9645 if (strcmp ("AnyPropertyType", SDATA (type)) == 0)
9646 target_type = AnyPropertyType;
9647 else
9648 target_type = XInternAtom (FRAME_X_DISPLAY (f), SDATA (type), False);
9651 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
9652 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), target_window,
9653 prop_atom, 0, 0, False, target_type,
9654 &actual_type, &actual_format, &actual_size,
9655 &bytes_remaining, (unsigned char **) &tmp_data);
9656 if (rc == Success)
9658 int size = bytes_remaining;
9660 XFree (tmp_data);
9661 tmp_data = NULL;
9663 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), target_window,
9664 prop_atom, 0, bytes_remaining,
9665 ! NILP (delete_p), target_type,
9666 &actual_type, &actual_format,
9667 &actual_size, &bytes_remaining,
9668 (unsigned char **) &tmp_data);
9669 if (rc == Success && tmp_data)
9671 if (NILP (vector_ret_p))
9672 prop_value = make_string (tmp_data, size);
9673 else
9674 prop_value = x_property_data_to_lisp (f,
9675 (unsigned char *) tmp_data,
9676 actual_type,
9677 actual_format,
9678 actual_size);
9681 if (tmp_data) XFree (tmp_data);
9684 UNBLOCK_INPUT;
9685 UNGCPRO;
9686 return prop_value;
9691 /***********************************************************************
9692 Busy cursor
9693 ***********************************************************************/
9695 /* If non-null, an asynchronous timer that, when it expires, displays
9696 an hourglass cursor on all frames. */
9698 static struct atimer *hourglass_atimer;
9700 /* Non-zero means an hourglass cursor is currently shown. */
9702 static int hourglass_shown_p;
9704 /* Number of seconds to wait before displaying an hourglass cursor. */
9706 static Lisp_Object Vhourglass_delay;
9708 /* Default number of seconds to wait before displaying an hourglass
9709 cursor. */
9711 #define DEFAULT_HOURGLASS_DELAY 1
9713 /* Function prototypes. */
9715 static void show_hourglass P_ ((struct atimer *));
9716 static void hide_hourglass P_ ((void));
9719 /* Cancel a currently active hourglass timer, and start a new one. */
9721 void
9722 start_hourglass ()
9724 EMACS_TIME delay;
9725 int secs, usecs = 0;
9727 cancel_hourglass ();
9729 if (INTEGERP (Vhourglass_delay)
9730 && XINT (Vhourglass_delay) > 0)
9731 secs = XFASTINT (Vhourglass_delay);
9732 else if (FLOATP (Vhourglass_delay)
9733 && XFLOAT_DATA (Vhourglass_delay) > 0)
9735 Lisp_Object tem;
9736 tem = Ftruncate (Vhourglass_delay, Qnil);
9737 secs = XFASTINT (tem);
9738 usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
9740 else
9741 secs = DEFAULT_HOURGLASS_DELAY;
9743 EMACS_SET_SECS_USECS (delay, secs, usecs);
9744 hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
9745 show_hourglass, NULL);
9749 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
9750 shown. */
9752 void
9753 cancel_hourglass ()
9755 if (hourglass_atimer)
9757 cancel_atimer (hourglass_atimer);
9758 hourglass_atimer = NULL;
9761 if (hourglass_shown_p)
9762 hide_hourglass ();
9766 /* Timer function of hourglass_atimer. TIMER is equal to
9767 hourglass_atimer.
9769 Display an hourglass pointer on all frames by mapping the frames'
9770 hourglass_window. Set the hourglass_p flag in the frames'
9771 output_data.x structure to indicate that an hourglass cursor is
9772 shown on the frames. */
9774 static void
9775 show_hourglass (timer)
9776 struct atimer *timer;
9778 /* The timer implementation will cancel this timer automatically
9779 after this function has run. Set hourglass_atimer to null
9780 so that we know the timer doesn't have to be canceled. */
9781 hourglass_atimer = NULL;
9783 if (!hourglass_shown_p)
9785 Lisp_Object rest, frame;
9787 BLOCK_INPUT;
9789 FOR_EACH_FRAME (rest, frame)
9791 struct frame *f = XFRAME (frame);
9793 if (FRAME_LIVE_P (f) && FRAME_X_P (f) && FRAME_X_DISPLAY (f))
9795 Display *dpy = FRAME_X_DISPLAY (f);
9797 #ifdef USE_X_TOOLKIT
9798 if (f->output_data.x->widget)
9799 #else
9800 if (FRAME_OUTER_WINDOW (f))
9801 #endif
9803 f->output_data.x->hourglass_p = 1;
9805 if (!f->output_data.x->hourglass_window)
9807 unsigned long mask = CWCursor;
9808 XSetWindowAttributes attrs;
9810 attrs.cursor = f->output_data.x->hourglass_cursor;
9812 f->output_data.x->hourglass_window
9813 = XCreateWindow (dpy, FRAME_OUTER_WINDOW (f),
9814 0, 0, 32000, 32000, 0, 0,
9815 InputOnly,
9816 CopyFromParent,
9817 mask, &attrs);
9820 XMapRaised (dpy, f->output_data.x->hourglass_window);
9821 XFlush (dpy);
9826 hourglass_shown_p = 1;
9827 UNBLOCK_INPUT;
9832 /* Hide the hourglass pointer on all frames, if it is currently
9833 shown. */
9835 static void
9836 hide_hourglass ()
9838 if (hourglass_shown_p)
9840 Lisp_Object rest, frame;
9842 BLOCK_INPUT;
9843 FOR_EACH_FRAME (rest, frame)
9845 struct frame *f = XFRAME (frame);
9847 if (FRAME_X_P (f)
9848 /* Watch out for newly created frames. */
9849 && f->output_data.x->hourglass_window)
9851 XUnmapWindow (FRAME_X_DISPLAY (f),
9852 f->output_data.x->hourglass_window);
9853 /* Sync here because XTread_socket looks at the
9854 hourglass_p flag that is reset to zero below. */
9855 XSync (FRAME_X_DISPLAY (f), False);
9856 f->output_data.x->hourglass_p = 0;
9860 hourglass_shown_p = 0;
9861 UNBLOCK_INPUT;
9867 /***********************************************************************
9868 Tool tips
9869 ***********************************************************************/
9871 static Lisp_Object x_create_tip_frame P_ ((struct x_display_info *,
9872 Lisp_Object, Lisp_Object));
9873 static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
9874 Lisp_Object, int, int, int *, int *));
9876 /* The frame of a currently visible tooltip. */
9878 Lisp_Object tip_frame;
9880 /* If non-nil, a timer started that hides the last tooltip when it
9881 fires. */
9883 Lisp_Object tip_timer;
9884 Window tip_window;
9886 /* If non-nil, a vector of 3 elements containing the last args
9887 with which x-show-tip was called. See there. */
9889 Lisp_Object last_show_tip_args;
9891 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
9893 Lisp_Object Vx_max_tooltip_size;
9896 static Lisp_Object
9897 unwind_create_tip_frame (frame)
9898 Lisp_Object frame;
9900 Lisp_Object deleted;
9902 deleted = unwind_create_frame (frame);
9903 if (EQ (deleted, Qt))
9905 tip_window = None;
9906 tip_frame = Qnil;
9909 return deleted;
9913 /* Create a frame for a tooltip on the display described by DPYINFO.
9914 PARMS is a list of frame parameters. TEXT is the string to
9915 display in the tip frame. Value is the frame.
9917 Note that functions called here, esp. x_default_parameter can
9918 signal errors, for instance when a specified color name is
9919 undefined. We have to make sure that we're in a consistent state
9920 when this happens. */
9922 static Lisp_Object
9923 x_create_tip_frame (dpyinfo, parms, text)
9924 struct x_display_info *dpyinfo;
9925 Lisp_Object parms, text;
9927 struct frame *f;
9928 Lisp_Object frame, tem;
9929 Lisp_Object name;
9930 long window_prompting = 0;
9931 int width, height;
9932 int count = SPECPDL_INDEX ();
9933 struct gcpro gcpro1, gcpro2, gcpro3;
9934 struct kboard *kb;
9935 int face_change_count_before = face_change_count;
9936 Lisp_Object buffer;
9937 struct buffer *old_buffer;
9939 check_x ();
9941 /* Use this general default value to start with until we know if
9942 this frame has a specified name. */
9943 Vx_resource_name = Vinvocation_name;
9945 #ifdef MULTI_KBOARD
9946 kb = dpyinfo->kboard;
9947 #else
9948 kb = &the_only_kboard;
9949 #endif
9951 /* Get the name of the frame to use for resource lookup. */
9952 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
9953 if (!STRINGP (name)
9954 && !EQ (name, Qunbound)
9955 && !NILP (name))
9956 error ("Invalid frame name--not a string or nil");
9957 Vx_resource_name = name;
9959 frame = Qnil;
9960 GCPRO3 (parms, name, frame);
9961 f = make_frame (1);
9962 XSETFRAME (frame, f);
9964 buffer = Fget_buffer_create (build_string (" *tip*"));
9965 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil);
9966 old_buffer = current_buffer;
9967 set_buffer_internal_1 (XBUFFER (buffer));
9968 current_buffer->truncate_lines = Qnil;
9969 Ferase_buffer ();
9970 Finsert (1, &text);
9971 set_buffer_internal_1 (old_buffer);
9973 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
9974 record_unwind_protect (unwind_create_tip_frame, frame);
9976 /* By setting the output method, we're essentially saying that
9977 the frame is live, as per FRAME_LIVE_P. If we get a signal
9978 from this point on, x_destroy_window might screw up reference
9979 counts etc. */
9980 f->output_method = output_x_window;
9981 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
9982 bzero (f->output_data.x, sizeof (struct x_output));
9983 f->output_data.x->icon_bitmap = -1;
9984 FRAME_FONTSET (f) = -1;
9985 f->output_data.x->scroll_bar_foreground_pixel = -1;
9986 f->output_data.x->scroll_bar_background_pixel = -1;
9987 #ifdef USE_TOOLKIT_SCROLL_BARS
9988 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
9989 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
9990 #endif /* USE_TOOLKIT_SCROLL_BARS */
9991 f->icon_name = Qnil;
9992 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
9993 #if GLYPH_DEBUG
9994 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
9995 dpyinfo_refcount = dpyinfo->reference_count;
9996 #endif /* GLYPH_DEBUG */
9997 #ifdef MULTI_KBOARD
9998 FRAME_KBOARD (f) = kb;
9999 #endif
10000 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
10001 f->output_data.x->explicit_parent = 0;
10003 /* These colors will be set anyway later, but it's important
10004 to get the color reference counts right, so initialize them! */
10006 Lisp_Object black;
10007 struct gcpro gcpro1;
10009 black = build_string ("black");
10010 GCPRO1 (black);
10011 f->output_data.x->foreground_pixel
10012 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10013 f->output_data.x->background_pixel
10014 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10015 f->output_data.x->cursor_pixel
10016 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10017 f->output_data.x->cursor_foreground_pixel
10018 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10019 f->output_data.x->border_pixel
10020 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10021 f->output_data.x->mouse_pixel
10022 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10023 UNGCPRO;
10026 /* Set the name; the functions to which we pass f expect the name to
10027 be set. */
10028 if (EQ (name, Qunbound) || NILP (name))
10030 f->name = build_string (dpyinfo->x_id_name);
10031 f->explicit_name = 0;
10033 else
10035 f->name = name;
10036 f->explicit_name = 1;
10037 /* use the frame's title when getting resources for this frame. */
10038 specbind (Qx_resource_name, name);
10041 /* Extract the window parameters from the supplied values that are
10042 needed to determine window geometry. */
10044 Lisp_Object font;
10046 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
10048 BLOCK_INPUT;
10049 /* First, try whatever font the caller has specified. */
10050 if (STRINGP (font))
10052 tem = Fquery_fontset (font, Qnil);
10053 if (STRINGP (tem))
10054 font = x_new_fontset (f, SDATA (tem));
10055 else
10056 font = x_new_font (f, SDATA (font));
10059 /* Try out a font which we hope has bold and italic variations. */
10060 if (!STRINGP (font))
10061 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10062 if (!STRINGP (font))
10063 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10064 if (! STRINGP (font))
10065 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10066 if (! STRINGP (font))
10067 /* This was formerly the first thing tried, but it finds too many fonts
10068 and takes too long. */
10069 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10070 /* If those didn't work, look for something which will at least work. */
10071 if (! STRINGP (font))
10072 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10073 UNBLOCK_INPUT;
10074 if (! STRINGP (font))
10075 font = build_string ("fixed");
10077 x_default_parameter (f, parms, Qfont, font,
10078 "font", "Font", RES_TYPE_STRING);
10081 x_default_parameter (f, parms, Qborder_width, make_number (2),
10082 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
10084 /* This defaults to 2 in order to match xterm. We recognize either
10085 internalBorderWidth or internalBorder (which is what xterm calls
10086 it). */
10087 if (NILP (Fassq (Qinternal_border_width, parms)))
10089 Lisp_Object value;
10091 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
10092 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
10093 if (! EQ (value, Qunbound))
10094 parms = Fcons (Fcons (Qinternal_border_width, value),
10095 parms);
10098 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
10099 "internalBorderWidth", "internalBorderWidth",
10100 RES_TYPE_NUMBER);
10102 /* Also do the stuff which must be set before the window exists. */
10103 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
10104 "foreground", "Foreground", RES_TYPE_STRING);
10105 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
10106 "background", "Background", RES_TYPE_STRING);
10107 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
10108 "pointerColor", "Foreground", RES_TYPE_STRING);
10109 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
10110 "cursorColor", "Foreground", RES_TYPE_STRING);
10111 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
10112 "borderColor", "BorderColor", RES_TYPE_STRING);
10114 /* Init faces before x_default_parameter is called for scroll-bar
10115 parameters because that function calls x_set_scroll_bar_width,
10116 which calls change_frame_size, which calls Fset_window_buffer,
10117 which runs hooks, which call Fvertical_motion. At the end, we
10118 end up in init_iterator with a null face cache, which should not
10119 happen. */
10120 init_frame_faces (f);
10122 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
10124 window_prompting = x_figure_window_size (f, parms, 0);
10127 XSetWindowAttributes attrs;
10128 unsigned long mask;
10130 BLOCK_INPUT;
10131 mask = CWBackPixel | CWOverrideRedirect | CWEventMask;
10132 if (DoesSaveUnders (dpyinfo->screen))
10133 mask |= CWSaveUnder;
10135 /* Window managers look at the override-redirect flag to determine
10136 whether or net to give windows a decoration (Xlib spec, chapter
10137 3.2.8). */
10138 attrs.override_redirect = True;
10139 attrs.save_under = True;
10140 attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f);
10141 /* Arrange for getting MapNotify and UnmapNotify events. */
10142 attrs.event_mask = StructureNotifyMask;
10143 tip_window
10144 = FRAME_X_WINDOW (f)
10145 = XCreateWindow (FRAME_X_DISPLAY (f),
10146 FRAME_X_DISPLAY_INFO (f)->root_window,
10147 /* x, y, width, height */
10148 0, 0, 1, 1,
10149 /* Border. */
10151 CopyFromParent, InputOutput, CopyFromParent,
10152 mask, &attrs);
10153 UNBLOCK_INPUT;
10156 x_make_gc (f);
10158 x_default_parameter (f, parms, Qauto_raise, Qnil,
10159 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
10160 x_default_parameter (f, parms, Qauto_lower, Qnil,
10161 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
10162 x_default_parameter (f, parms, Qcursor_type, Qbox,
10163 "cursorType", "CursorType", RES_TYPE_SYMBOL);
10165 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
10166 Change will not be effected unless different from the current
10167 FRAME_LINES (f). */
10168 width = FRAME_COLS (f);
10169 height = FRAME_LINES (f);
10170 SET_FRAME_COLS (f, 0);
10171 FRAME_LINES (f) = 0;
10172 change_frame_size (f, height, width, 1, 0, 0);
10174 /* Add `tooltip' frame parameter's default value. */
10175 if (NILP (Fframe_parameter (frame, intern ("tooltip"))))
10176 Fmodify_frame_parameters (frame, Fcons (Fcons (intern ("tooltip"), Qt),
10177 Qnil));
10179 /* Set up faces after all frame parameters are known. This call
10180 also merges in face attributes specified for new frames.
10182 Frame parameters may be changed if .Xdefaults contains
10183 specifications for the default font. For example, if there is an
10184 `Emacs.default.attributeBackground: pink', the `background-color'
10185 attribute of the frame get's set, which let's the internal border
10186 of the tooltip frame appear in pink. Prevent this. */
10188 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
10190 /* Set tip_frame here, so that */
10191 tip_frame = frame;
10192 call1 (Qface_set_after_frame_default, frame);
10194 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
10195 Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
10196 Qnil));
10199 f->no_split = 1;
10201 UNGCPRO;
10203 /* It is now ok to make the frame official even if we get an error
10204 below. And the frame needs to be on Vframe_list or making it
10205 visible won't work. */
10206 Vframe_list = Fcons (frame, Vframe_list);
10208 /* Now that the frame is official, it counts as a reference to
10209 its display. */
10210 FRAME_X_DISPLAY_INFO (f)->reference_count++;
10212 /* Setting attributes of faces of the tooltip frame from resources
10213 and similar will increment face_change_count, which leads to the
10214 clearing of all current matrices. Since this isn't necessary
10215 here, avoid it by resetting face_change_count to the value it
10216 had before we created the tip frame. */
10217 face_change_count = face_change_count_before;
10219 /* Discard the unwind_protect. */
10220 return unbind_to (count, frame);
10224 /* Compute where to display tip frame F. PARMS is the list of frame
10225 parameters for F. DX and DY are specified offsets from the current
10226 location of the mouse. WIDTH and HEIGHT are the width and height
10227 of the tooltip. Return coordinates relative to the root window of
10228 the display in *ROOT_X, and *ROOT_Y. */
10230 static void
10231 compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
10232 struct frame *f;
10233 Lisp_Object parms, dx, dy;
10234 int width, height;
10235 int *root_x, *root_y;
10237 Lisp_Object left, top;
10238 int win_x, win_y;
10239 Window root, child;
10240 unsigned pmask;
10242 /* User-specified position? */
10243 left = Fcdr (Fassq (Qleft, parms));
10244 top = Fcdr (Fassq (Qtop, parms));
10246 /* Move the tooltip window where the mouse pointer is. Resize and
10247 show it. */
10248 if (!INTEGERP (left) || !INTEGERP (top))
10250 BLOCK_INPUT;
10251 XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
10252 &root, &child, root_x, root_y, &win_x, &win_y, &pmask);
10253 UNBLOCK_INPUT;
10256 if (INTEGERP (top))
10257 *root_y = XINT (top);
10258 else if (*root_y + XINT (dy) - height < 0)
10259 *root_y -= XINT (dy);
10260 else
10262 *root_y -= height;
10263 *root_y += XINT (dy);
10266 if (INTEGERP (left))
10267 *root_x = XINT (left);
10268 else if (*root_x + XINT (dx) + width <= FRAME_X_DISPLAY_INFO (f)->width)
10269 /* It fits to the right of the pointer. */
10270 *root_x += XINT (dx);
10271 else if (width + XINT (dx) <= *root_x)
10272 /* It fits to the left of the pointer. */
10273 *root_x -= width + XINT (dx);
10274 else
10275 /* Put it left-justified on the screen--it ought to fit that way. */
10276 *root_x = 0;
10280 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
10281 doc: /* Show STRING in a "tooltip" window on frame FRAME.
10282 A tooltip window is a small X window displaying a string.
10284 FRAME nil or omitted means use the selected frame.
10286 PARMS is an optional list of frame parameters which can be used to
10287 change the tooltip's appearance.
10289 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
10290 means use the default timeout of 5 seconds.
10292 If the list of frame parameters PARAMS contains a `left' parameters,
10293 the tooltip is displayed at that x-position. Otherwise it is
10294 displayed at the mouse position, with offset DX added (default is 5 if
10295 DX isn't specified). Likewise for the y-position; if a `top' frame
10296 parameter is specified, it determines the y-position of the tooltip
10297 window, otherwise it is displayed at the mouse position, with offset
10298 DY added (default is -10).
10300 A tooltip's maximum size is specified by `x-max-tooltip-size'.
10301 Text larger than the specified size is clipped. */)
10302 (string, frame, parms, timeout, dx, dy)
10303 Lisp_Object string, frame, parms, timeout, dx, dy;
10305 struct frame *f;
10306 struct window *w;
10307 int root_x, root_y;
10308 struct buffer *old_buffer;
10309 struct text_pos pos;
10310 int i, width, height;
10311 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
10312 int old_windows_or_buffers_changed = windows_or_buffers_changed;
10313 int count = SPECPDL_INDEX ();
10315 specbind (Qinhibit_redisplay, Qt);
10317 GCPRO4 (string, parms, frame, timeout);
10319 CHECK_STRING (string);
10320 f = check_x_frame (frame);
10321 if (NILP (timeout))
10322 timeout = make_number (5);
10323 else
10324 CHECK_NATNUM (timeout);
10326 if (NILP (dx))
10327 dx = make_number (5);
10328 else
10329 CHECK_NUMBER (dx);
10331 if (NILP (dy))
10332 dy = make_number (-10);
10333 else
10334 CHECK_NUMBER (dy);
10336 if (NILP (last_show_tip_args))
10337 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
10339 if (!NILP (tip_frame))
10341 Lisp_Object last_string = AREF (last_show_tip_args, 0);
10342 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
10343 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
10345 if (EQ (frame, last_frame)
10346 && !NILP (Fequal (last_string, string))
10347 && !NILP (Fequal (last_parms, parms)))
10349 struct frame *f = XFRAME (tip_frame);
10351 /* Only DX and DY have changed. */
10352 if (!NILP (tip_timer))
10354 Lisp_Object timer = tip_timer;
10355 tip_timer = Qnil;
10356 call1 (Qcancel_timer, timer);
10359 BLOCK_INPUT;
10360 compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f),
10361 FRAME_PIXEL_HEIGHT (f), &root_x, &root_y);
10362 XMoveWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10363 root_x, root_y);
10364 UNBLOCK_INPUT;
10365 goto start_timer;
10369 /* Hide a previous tip, if any. */
10370 Fx_hide_tip ();
10372 ASET (last_show_tip_args, 0, string);
10373 ASET (last_show_tip_args, 1, frame);
10374 ASET (last_show_tip_args, 2, parms);
10376 /* Add default values to frame parameters. */
10377 if (NILP (Fassq (Qname, parms)))
10378 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
10379 if (NILP (Fassq (Qinternal_border_width, parms)))
10380 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
10381 if (NILP (Fassq (Qborder_width, parms)))
10382 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
10383 if (NILP (Fassq (Qborder_color, parms)))
10384 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
10385 if (NILP (Fassq (Qbackground_color, parms)))
10386 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
10387 parms);
10389 /* Create a frame for the tooltip, and record it in the global
10390 variable tip_frame. */
10391 frame = x_create_tip_frame (FRAME_X_DISPLAY_INFO (f), parms, string);
10392 f = XFRAME (frame);
10394 /* Set up the frame's root window. */
10395 w = XWINDOW (FRAME_ROOT_WINDOW (f));
10396 w->left_col = w->top_line = make_number (0);
10398 if (CONSP (Vx_max_tooltip_size)
10399 && INTEGERP (XCAR (Vx_max_tooltip_size))
10400 && XINT (XCAR (Vx_max_tooltip_size)) > 0
10401 && INTEGERP (XCDR (Vx_max_tooltip_size))
10402 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
10404 w->total_cols = XCAR (Vx_max_tooltip_size);
10405 w->total_lines = XCDR (Vx_max_tooltip_size);
10407 else
10409 w->total_cols = make_number (80);
10410 w->total_lines = make_number (40);
10413 FRAME_TOTAL_COLS (f) = XINT (w->total_cols);
10414 adjust_glyphs (f);
10415 w->pseudo_window_p = 1;
10417 /* Display the tooltip text in a temporary buffer. */
10418 old_buffer = current_buffer;
10419 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
10420 current_buffer->truncate_lines = Qnil;
10421 clear_glyph_matrix (w->desired_matrix);
10422 clear_glyph_matrix (w->current_matrix);
10423 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
10424 try_window (FRAME_ROOT_WINDOW (f), pos);
10426 /* Compute width and height of the tooltip. */
10427 width = height = 0;
10428 for (i = 0; i < w->desired_matrix->nrows; ++i)
10430 struct glyph_row *row = &w->desired_matrix->rows[i];
10431 struct glyph *last;
10432 int row_width;
10434 /* Stop at the first empty row at the end. */
10435 if (!row->enabled_p || !row->displays_text_p)
10436 break;
10438 /* Let the row go over the full width of the frame. */
10439 row->full_width_p = 1;
10441 /* There's a glyph at the end of rows that is used to place
10442 the cursor there. Don't include the width of this glyph. */
10443 if (row->used[TEXT_AREA])
10445 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
10446 row_width = row->pixel_width - last->pixel_width;
10448 else
10449 row_width = row->pixel_width;
10451 height += row->height;
10452 width = max (width, row_width);
10455 /* Add the frame's internal border to the width and height the X
10456 window should have. */
10457 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
10458 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
10460 /* Move the tooltip window where the mouse pointer is. Resize and
10461 show it. */
10462 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
10464 BLOCK_INPUT;
10465 XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10466 root_x, root_y, width, height);
10467 XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
10468 UNBLOCK_INPUT;
10470 /* Draw into the window. */
10471 w->must_be_updated_p = 1;
10472 update_single_window (w, 1);
10474 /* Restore original current buffer. */
10475 set_buffer_internal_1 (old_buffer);
10476 windows_or_buffers_changed = old_windows_or_buffers_changed;
10478 start_timer:
10479 /* Let the tip disappear after timeout seconds. */
10480 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
10481 intern ("x-hide-tip"));
10483 UNGCPRO;
10484 return unbind_to (count, Qnil);
10488 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
10489 doc: /* Hide the current tooltip window, if there is any.
10490 Value is t if tooltip was open, nil otherwise. */)
10493 int count;
10494 Lisp_Object deleted, frame, timer;
10495 struct gcpro gcpro1, gcpro2;
10497 /* Return quickly if nothing to do. */
10498 if (NILP (tip_timer) && NILP (tip_frame))
10499 return Qnil;
10501 frame = tip_frame;
10502 timer = tip_timer;
10503 GCPRO2 (frame, timer);
10504 tip_frame = tip_timer = deleted = Qnil;
10506 count = SPECPDL_INDEX ();
10507 specbind (Qinhibit_redisplay, Qt);
10508 specbind (Qinhibit_quit, Qt);
10510 if (!NILP (timer))
10511 call1 (Qcancel_timer, timer);
10513 if (FRAMEP (frame))
10515 Fdelete_frame (frame, Qnil);
10516 deleted = Qt;
10518 #ifdef USE_LUCID
10519 /* Bloodcurdling hack alert: The Lucid menu bar widget's
10520 redisplay procedure is not called when a tip frame over menu
10521 items is unmapped. Redisplay the menu manually... */
10523 struct frame *f = SELECTED_FRAME ();
10524 Widget w = f->output_data.x->menubar_widget;
10525 extern void xlwmenu_redisplay P_ ((Widget));
10527 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f)->screen)
10528 && w != NULL)
10530 BLOCK_INPUT;
10531 xlwmenu_redisplay (w);
10532 UNBLOCK_INPUT;
10535 #endif /* USE_LUCID */
10538 UNGCPRO;
10539 return unbind_to (count, deleted);
10544 /***********************************************************************
10545 File selection dialog
10546 ***********************************************************************/
10548 #ifdef USE_MOTIF
10550 /* Callback for "OK" and "Cancel" on file selection dialog. */
10552 static void
10553 file_dialog_cb (widget, client_data, call_data)
10554 Widget widget;
10555 XtPointer call_data, client_data;
10557 int *result = (int *) client_data;
10558 XmAnyCallbackStruct *cb = (XmAnyCallbackStruct *) call_data;
10559 *result = cb->reason;
10563 /* Callback for unmapping a file selection dialog. This is used to
10564 capture the case where a dialog is closed via a window manager's
10565 closer button, for example. Using a XmNdestroyCallback didn't work
10566 in this case. */
10568 static void
10569 file_dialog_unmap_cb (widget, client_data, call_data)
10570 Widget widget;
10571 XtPointer call_data, client_data;
10573 int *result = (int *) client_data;
10574 *result = XmCR_CANCEL;
10578 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
10579 doc: /* Read file name, prompting with PROMPT in directory DIR.
10580 Use a file selection dialog.
10581 Select DEFAULT-FILENAME in the dialog's file selection box, if
10582 specified. Don't let the user enter a file name in the file
10583 selection dialog's entry field, if MUSTMATCH is non-nil. */)
10584 (prompt, dir, default_filename, mustmatch)
10585 Lisp_Object prompt, dir, default_filename, mustmatch;
10587 int result;
10588 struct frame *f = SELECTED_FRAME ();
10589 Lisp_Object file = Qnil;
10590 Widget dialog, text, list, help;
10591 Arg al[10];
10592 int ac = 0;
10593 extern XtAppContext Xt_app_con;
10594 XmString dir_xmstring, pattern_xmstring;
10595 int count = SPECPDL_INDEX ();
10596 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
10598 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
10599 CHECK_STRING (prompt);
10600 CHECK_STRING (dir);
10602 /* Prevent redisplay. */
10603 specbind (Qinhibit_redisplay, Qt);
10605 BLOCK_INPUT;
10607 /* Create the dialog with PROMPT as title, using DIR as initial
10608 directory and using "*" as pattern. */
10609 dir = Fexpand_file_name (dir, Qnil);
10610 dir_xmstring = XmStringCreateLocalized (SDATA (dir));
10611 pattern_xmstring = XmStringCreateLocalized ("*");
10613 XtSetArg (al[ac], XmNtitle, SDATA (prompt)); ++ac;
10614 XtSetArg (al[ac], XmNdirectory, dir_xmstring); ++ac;
10615 XtSetArg (al[ac], XmNpattern, pattern_xmstring); ++ac;
10616 XtSetArg (al[ac], XmNresizePolicy, XmRESIZE_GROW); ++ac;
10617 XtSetArg (al[ac], XmNdialogStyle, XmDIALOG_APPLICATION_MODAL); ++ac;
10618 dialog = XmCreateFileSelectionDialog (f->output_data.x->widget,
10619 "fsb", al, ac);
10620 XmStringFree (dir_xmstring);
10621 XmStringFree (pattern_xmstring);
10623 /* Add callbacks for OK and Cancel. */
10624 XtAddCallback (dialog, XmNokCallback, file_dialog_cb,
10625 (XtPointer) &result);
10626 XtAddCallback (dialog, XmNcancelCallback, file_dialog_cb,
10627 (XtPointer) &result);
10628 XtAddCallback (dialog, XmNunmapCallback, file_dialog_unmap_cb,
10629 (XtPointer) &result);
10631 /* Disable the help button since we can't display help. */
10632 help = XmFileSelectionBoxGetChild (dialog, XmDIALOG_HELP_BUTTON);
10633 XtSetSensitive (help, False);
10635 /* Mark OK button as default. */
10636 XtVaSetValues (XmFileSelectionBoxGetChild (dialog, XmDIALOG_OK_BUTTON),
10637 XmNshowAsDefault, True, NULL);
10639 /* If MUSTMATCH is non-nil, disable the file entry field of the
10640 dialog, so that the user must select a file from the files list
10641 box. We can't remove it because we wouldn't have a way to get at
10642 the result file name, then. */
10643 text = XmFileSelectionBoxGetChild (dialog, XmDIALOG_TEXT);
10644 if (!NILP (mustmatch))
10646 Widget label;
10647 label = XmFileSelectionBoxGetChild (dialog, XmDIALOG_SELECTION_LABEL);
10648 XtSetSensitive (text, False);
10649 XtSetSensitive (label, False);
10652 /* Manage the dialog, so that list boxes get filled. */
10653 XtManageChild (dialog);
10655 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
10656 must include the path for this to work. */
10657 list = XmFileSelectionBoxGetChild (dialog, XmDIALOG_LIST);
10658 if (STRINGP (default_filename))
10660 XmString default_xmstring;
10661 int item_pos;
10663 default_xmstring
10664 = XmStringCreateLocalized (SDATA (default_filename));
10666 if (!XmListItemExists (list, default_xmstring))
10668 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10669 XmListAddItem (list, default_xmstring, 0);
10670 item_pos = 0;
10672 else
10673 item_pos = XmListItemPos (list, default_xmstring);
10674 XmStringFree (default_xmstring);
10676 /* Select the item and scroll it into view. */
10677 XmListSelectPos (list, item_pos, True);
10678 XmListSetPos (list, item_pos);
10681 /* Process events until the user presses Cancel or OK. */
10682 result = 0;
10683 while (result == 0)
10685 XEvent event;
10686 XtAppNextEvent (Xt_app_con, &event);
10687 (void) x_dispatch_event (&event, FRAME_X_DISPLAY (f) );
10690 /* Get the result. */
10691 if (result == XmCR_OK)
10693 XmString text;
10694 String data;
10696 XtVaGetValues (dialog, XmNtextString, &text, NULL);
10697 XmStringGetLtoR (text, XmFONTLIST_DEFAULT_TAG, &data);
10698 XmStringFree (text);
10699 file = build_string (data);
10700 XtFree (data);
10702 else
10703 file = Qnil;
10705 /* Clean up. */
10706 XtUnmanageChild (dialog);
10707 XtDestroyWidget (dialog);
10708 UNBLOCK_INPUT;
10709 UNGCPRO;
10711 /* Make "Cancel" equivalent to C-g. */
10712 if (NILP (file))
10713 Fsignal (Qquit, Qnil);
10715 return unbind_to (count, file);
10718 #endif /* USE_MOTIF */
10720 #ifdef USE_GTK
10722 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
10723 "Read file name, prompting with PROMPT in directory DIR.\n\
10724 Use a file selection dialog.\n\
10725 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
10726 specified. Don't let the user enter a file name in the file\n\
10727 selection dialog's entry field, if MUSTMATCH is non-nil.")
10728 (prompt, dir, default_filename, mustmatch)
10729 Lisp_Object prompt, dir, default_filename, mustmatch;
10731 FRAME_PTR f = SELECTED_FRAME ();
10732 char *fn;
10733 Lisp_Object file = Qnil;
10734 int count = specpdl_ptr - specpdl;
10735 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
10736 char *cdef_file;
10738 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
10739 CHECK_STRING (prompt);
10740 CHECK_STRING (dir);
10742 /* Prevent redisplay. */
10743 specbind (Qinhibit_redisplay, Qt);
10745 BLOCK_INPUT;
10747 if (STRINGP (default_filename))
10748 cdef_file = SDATA (default_filename);
10749 else
10750 cdef_file = SDATA (dir);
10752 fn = xg_get_file_name (f, SDATA (prompt), cdef_file, ! NILP (mustmatch));
10754 if (fn)
10756 file = build_string (fn);
10757 xfree (fn);
10760 UNBLOCK_INPUT;
10761 UNGCPRO;
10763 /* Make "Cancel" equivalent to C-g. */
10764 if (NILP (file))
10765 Fsignal (Qquit, Qnil);
10767 return unbind_to (count, file);
10770 #endif /* USE_GTK */
10773 /***********************************************************************
10774 Keyboard
10775 ***********************************************************************/
10777 #ifdef HAVE_XKBGETKEYBOARD
10778 #include <X11/XKBlib.h>
10779 #include <X11/keysym.h>
10780 #endif
10782 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p,
10783 Sx_backspace_delete_keys_p, 0, 1, 0,
10784 doc: /* Check if both Backspace and Delete keys are on the keyboard of FRAME.
10785 FRAME nil means use the selected frame.
10786 Value is t if we know that both keys are present, and are mapped to the
10787 usual X keysyms. */)
10788 (frame)
10789 Lisp_Object frame;
10791 #ifdef HAVE_XKBGETKEYBOARD
10792 XkbDescPtr kb;
10793 struct frame *f = check_x_frame (frame);
10794 Display *dpy = FRAME_X_DISPLAY (f);
10795 Lisp_Object have_keys;
10796 int major, minor, op, event, error;
10798 BLOCK_INPUT;
10800 /* Check library version in case we're dynamically linked. */
10801 major = XkbMajorVersion;
10802 minor = XkbMinorVersion;
10803 if (!XkbLibraryVersion (&major, &minor))
10805 UNBLOCK_INPUT;
10806 return Qnil;
10809 /* Check that the server supports XKB. */
10810 major = XkbMajorVersion;
10811 minor = XkbMinorVersion;
10812 if (!XkbQueryExtension (dpy, &op, &event, &error, &major, &minor))
10814 UNBLOCK_INPUT;
10815 return Qnil;
10818 have_keys = Qnil;
10819 kb = XkbGetMap (dpy, XkbAllMapComponentsMask, XkbUseCoreKbd);
10820 if (kb)
10822 int delete_keycode = 0, backspace_keycode = 0, i;
10824 if (XkbGetNames (dpy, XkbAllNamesMask, kb) == Success)
10826 for (i = kb->min_key_code;
10827 (i < kb->max_key_code
10828 && (delete_keycode == 0 || backspace_keycode == 0));
10829 ++i)
10831 /* The XKB symbolic key names can be seen most easily in
10832 the PS file generated by `xkbprint -label name
10833 $DISPLAY'. */
10834 if (bcmp ("DELE", kb->names->keys[i].name, 4) == 0)
10835 delete_keycode = i;
10836 else if (bcmp ("BKSP", kb->names->keys[i].name, 4) == 0)
10837 backspace_keycode = i;
10840 XkbFreeNames (kb, 0, True);
10843 XkbFreeClientMap (kb, 0, True);
10845 if (delete_keycode
10846 && backspace_keycode
10847 && XKeysymToKeycode (dpy, XK_Delete) == delete_keycode
10848 && XKeysymToKeycode (dpy, XK_BackSpace) == backspace_keycode)
10849 have_keys = Qt;
10851 UNBLOCK_INPUT;
10852 return have_keys;
10853 #else /* not HAVE_XKBGETKEYBOARD */
10854 return Qnil;
10855 #endif /* not HAVE_XKBGETKEYBOARD */
10860 /***********************************************************************
10861 Initialization
10862 ***********************************************************************/
10864 /* Keep this list in the same order as frame_parms in frame.c.
10865 Use 0 for unsupported frame parameters. */
10867 frame_parm_handler x_frame_parm_handlers[] =
10869 x_set_autoraise,
10870 x_set_autolower,
10871 x_set_background_color,
10872 x_set_border_color,
10873 x_set_border_width,
10874 x_set_cursor_color,
10875 x_set_cursor_type,
10876 x_set_font,
10877 x_set_foreground_color,
10878 x_set_icon_name,
10879 x_set_icon_type,
10880 x_set_internal_border_width,
10881 x_set_menu_bar_lines,
10882 x_set_mouse_color,
10883 x_explicitly_set_name,
10884 x_set_scroll_bar_width,
10885 x_set_title,
10886 x_set_unsplittable,
10887 x_set_vertical_scroll_bars,
10888 x_set_visibility,
10889 x_set_tool_bar_lines,
10890 x_set_scroll_bar_foreground,
10891 x_set_scroll_bar_background,
10892 x_set_screen_gamma,
10893 x_set_line_spacing,
10894 x_set_fringe_width,
10895 x_set_fringe_width,
10896 x_set_wait_for_wm,
10897 x_set_fullscreen,
10900 void
10901 syms_of_xfns ()
10903 /* This is zero if not using X windows. */
10904 x_in_use = 0;
10906 /* The section below is built by the lisp expression at the top of the file,
10907 just above where these variables are declared. */
10908 /*&&& init symbols here &&&*/
10909 Qnone = intern ("none");
10910 staticpro (&Qnone);
10911 Qsuppress_icon = intern ("suppress-icon");
10912 staticpro (&Qsuppress_icon);
10913 Qundefined_color = intern ("undefined-color");
10914 staticpro (&Qundefined_color);
10915 Qcenter = intern ("center");
10916 staticpro (&Qcenter);
10917 Qcompound_text = intern ("compound-text");
10918 staticpro (&Qcompound_text);
10919 Qcancel_timer = intern ("cancel-timer");
10920 staticpro (&Qcancel_timer);
10921 /* This is the end of symbol initialization. */
10923 /* Text property `display' should be nonsticky by default. */
10924 Vtext_property_default_nonsticky
10925 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
10928 Qlaplace = intern ("laplace");
10929 staticpro (&Qlaplace);
10930 Qemboss = intern ("emboss");
10931 staticpro (&Qemboss);
10932 Qedge_detection = intern ("edge-detection");
10933 staticpro (&Qedge_detection);
10934 Qheuristic = intern ("heuristic");
10935 staticpro (&Qheuristic);
10936 QCmatrix = intern (":matrix");
10937 staticpro (&QCmatrix);
10938 QCcolor_adjustment = intern (":color-adjustment");
10939 staticpro (&QCcolor_adjustment);
10940 QCmask = intern (":mask");
10941 staticpro (&QCmask);
10943 Fput (Qundefined_color, Qerror_conditions,
10944 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
10945 Fput (Qundefined_color, Qerror_message,
10946 build_string ("Undefined color"));
10948 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images,
10949 doc: /* Non-nil means always draw a cross over disabled images.
10950 Disabled images are those having an `:conversion disabled' property.
10951 A cross is always drawn on black & white displays. */);
10952 cross_disabled_images = 0;
10954 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
10955 doc: /* List of directories to search for window system bitmap files. */);
10956 Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
10958 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
10959 doc: /* The shape of the pointer when over text.
10960 Changing the value does not affect existing frames
10961 unless you set the mouse color. */);
10962 Vx_pointer_shape = Qnil;
10964 #if 0 /* This doesn't really do anything. */
10965 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
10966 doc: /* The shape of the pointer when not over text.
10967 This variable takes effect when you create a new frame
10968 or when you set the mouse color. */);
10969 #endif
10970 Vx_nontext_pointer_shape = Qnil;
10972 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
10973 doc: /* The shape of the pointer when Emacs is busy.
10974 This variable takes effect when you create a new frame
10975 or when you set the mouse color. */);
10976 Vx_hourglass_pointer_shape = Qnil;
10978 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
10979 doc: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
10980 display_hourglass_p = 1;
10982 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
10983 doc: /* *Seconds to wait before displaying an hourglass pointer.
10984 Value must be an integer or float. */);
10985 Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
10987 #if 0 /* This doesn't really do anything. */
10988 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
10989 doc: /* The shape of the pointer when over the mode line.
10990 This variable takes effect when you create a new frame
10991 or when you set the mouse color. */);
10992 #endif
10993 Vx_mode_pointer_shape = Qnil;
10995 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
10996 &Vx_sensitive_text_pointer_shape,
10997 doc: /* The shape of the pointer when over mouse-sensitive text.
10998 This variable takes effect when you create a new frame
10999 or when you set the mouse color. */);
11000 Vx_sensitive_text_pointer_shape = Qnil;
11002 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
11003 &Vx_window_horizontal_drag_shape,
11004 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
11005 This variable takes effect when you create a new frame
11006 or when you set the mouse color. */);
11007 Vx_window_horizontal_drag_shape = Qnil;
11009 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
11010 doc: /* A string indicating the foreground color of the cursor box. */);
11011 Vx_cursor_fore_pixel = Qnil;
11013 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
11014 doc: /* Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).
11015 Text larger than this is clipped. */);
11016 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
11018 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
11019 doc: /* Non-nil if no X window manager is in use.
11020 Emacs doesn't try to figure this out; this is always nil
11021 unless you set it to something else. */);
11022 /* We don't have any way to find this out, so set it to nil
11023 and maybe the user would like to set it to t. */
11024 Vx_no_window_manager = Qnil;
11026 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11027 &Vx_pixel_size_width_font_regexp,
11028 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
11030 Since Emacs gets width of a font matching with this regexp from
11031 PIXEL_SIZE field of the name, font finding mechanism gets faster for
11032 such a font. This is especially effective for such large fonts as
11033 Chinese, Japanese, and Korean. */);
11034 Vx_pixel_size_width_font_regexp = Qnil;
11036 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay,
11037 doc: /* Time after which cached images are removed from the cache.
11038 When an image has not been displayed this many seconds, remove it
11039 from the image cache. Value must be an integer or nil with nil
11040 meaning don't clear the cache. */);
11041 Vimage_cache_eviction_delay = make_number (30 * 60);
11043 #ifdef USE_X_TOOLKIT
11044 Fprovide (intern ("x-toolkit"), Qnil);
11045 #ifdef USE_MOTIF
11046 Fprovide (intern ("motif"), Qnil);
11048 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string,
11049 doc: /* Version info for LessTif/Motif. */);
11050 Vmotif_version_string = build_string (XmVERSION_STRING);
11051 #endif /* USE_MOTIF */
11052 #endif /* USE_X_TOOLKIT */
11054 #ifdef USE_GTK
11055 Fprovide (intern ("gtk"), Qnil);
11057 DEFVAR_LISP ("gtk-version-string", &Vgtk_version_string,
11058 doc: /* Version info for GTK+. */);
11060 char gtk_version[40];
11061 g_snprintf (gtk_version, sizeof (gtk_version), "%u.%u.%u",
11062 GTK_MAJOR_VERSION, GTK_MINOR_VERSION, GTK_MICRO_VERSION);
11063 Vgtk_version_string = build_string (gtk_version);
11065 #endif /* USE_GTK */
11067 /* X window properties. */
11068 defsubr (&Sx_change_window_property);
11069 defsubr (&Sx_delete_window_property);
11070 defsubr (&Sx_window_property);
11072 defsubr (&Sxw_display_color_p);
11073 defsubr (&Sx_display_grayscale_p);
11074 defsubr (&Sxw_color_defined_p);
11075 defsubr (&Sxw_color_values);
11076 defsubr (&Sx_server_max_request_size);
11077 defsubr (&Sx_server_vendor);
11078 defsubr (&Sx_server_version);
11079 defsubr (&Sx_display_pixel_width);
11080 defsubr (&Sx_display_pixel_height);
11081 defsubr (&Sx_display_mm_width);
11082 defsubr (&Sx_display_mm_height);
11083 defsubr (&Sx_display_screens);
11084 defsubr (&Sx_display_planes);
11085 defsubr (&Sx_display_color_cells);
11086 defsubr (&Sx_display_visual_class);
11087 defsubr (&Sx_display_backing_store);
11088 defsubr (&Sx_display_save_under);
11089 defsubr (&Sx_create_frame);
11090 defsubr (&Sx_open_connection);
11091 defsubr (&Sx_close_connection);
11092 defsubr (&Sx_display_list);
11093 defsubr (&Sx_synchronize);
11094 defsubr (&Sx_focus_frame);
11095 defsubr (&Sx_backspace_delete_keys_p);
11097 /* Setting callback functions for fontset handler. */
11098 get_font_info_func = x_get_font_info;
11100 #if 0 /* This function pointer doesn't seem to be used anywhere.
11101 And the pointer assigned has the wrong type, anyway. */
11102 list_fonts_func = x_list_fonts;
11103 #endif
11105 load_font_func = x_load_font;
11106 find_ccl_program_func = x_find_ccl_program;
11107 query_font_func = x_query_font;
11108 set_frame_fontset_func = x_set_font;
11109 check_window_system_func = check_x;
11111 /* Images. */
11112 Qxbm = intern ("xbm");
11113 staticpro (&Qxbm);
11114 QCconversion = intern (":conversion");
11115 staticpro (&QCconversion);
11116 QCheuristic_mask = intern (":heuristic-mask");
11117 staticpro (&QCheuristic_mask);
11118 QCcolor_symbols = intern (":color-symbols");
11119 staticpro (&QCcolor_symbols);
11120 QCascent = intern (":ascent");
11121 staticpro (&QCascent);
11122 QCmargin = intern (":margin");
11123 staticpro (&QCmargin);
11124 QCrelief = intern (":relief");
11125 staticpro (&QCrelief);
11126 Qpostscript = intern ("postscript");
11127 staticpro (&Qpostscript);
11128 QCloader = intern (":loader");
11129 staticpro (&QCloader);
11130 QCbounding_box = intern (":bounding-box");
11131 staticpro (&QCbounding_box);
11132 QCpt_width = intern (":pt-width");
11133 staticpro (&QCpt_width);
11134 QCpt_height = intern (":pt-height");
11135 staticpro (&QCpt_height);
11136 QCindex = intern (":index");
11137 staticpro (&QCindex);
11138 Qpbm = intern ("pbm");
11139 staticpro (&Qpbm);
11141 #if HAVE_XPM
11142 Qxpm = intern ("xpm");
11143 staticpro (&Qxpm);
11144 #endif
11146 #if HAVE_JPEG
11147 Qjpeg = intern ("jpeg");
11148 staticpro (&Qjpeg);
11149 #endif
11151 #if HAVE_TIFF
11152 Qtiff = intern ("tiff");
11153 staticpro (&Qtiff);
11154 #endif
11156 #if HAVE_GIF
11157 Qgif = intern ("gif");
11158 staticpro (&Qgif);
11159 #endif
11161 #if HAVE_PNG
11162 Qpng = intern ("png");
11163 staticpro (&Qpng);
11164 #endif
11166 defsubr (&Sclear_image_cache);
11167 defsubr (&Simage_size);
11168 defsubr (&Simage_mask_p);
11170 hourglass_atimer = NULL;
11171 hourglass_shown_p = 0;
11173 defsubr (&Sx_show_tip);
11174 defsubr (&Sx_hide_tip);
11175 tip_timer = Qnil;
11176 staticpro (&tip_timer);
11177 tip_frame = Qnil;
11178 staticpro (&tip_frame);
11180 last_show_tip_args = Qnil;
11181 staticpro (&last_show_tip_args);
11183 #ifdef USE_MOTIF
11184 defsubr (&Sx_file_dialog);
11185 #endif
11189 void
11190 init_xfns ()
11192 image_types = NULL;
11193 Vimage_types = Qnil;
11195 define_image_type (&xbm_type);
11196 define_image_type (&gs_type);
11197 define_image_type (&pbm_type);
11199 #if HAVE_XPM
11200 define_image_type (&xpm_type);
11201 #endif
11203 #if HAVE_JPEG
11204 define_image_type (&jpeg_type);
11205 #endif
11207 #if HAVE_TIFF
11208 define_image_type (&tiff_type);
11209 #endif
11211 #if HAVE_GIF
11212 define_image_type (&gif_type);
11213 #endif
11215 #if HAVE_PNG
11216 define_image_type (&png_type);
11217 #endif
11220 #endif /* HAVE_X_WINDOWS */
11222 /* arch-tag: 55040d02-5485-4d58-8b22-95a7a05f3288
11223 (do not change this comment) */