(do_check_ram_size): Don't hardcode the lisp address space size.
[emacs.git] / src / xfns.c
blobe940b16eba1dafcf0b45cf73638d96e971179531
1 /* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 01, 02, 03
3 Free Software Foundation.
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 int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
778 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
780 if (!(id > 0))
781 return -1;
783 pixmap = x_bitmap_pixmap (f, id);
784 width = x_bitmap_width (f, id);
785 height = x_bitmap_height (f, id);
787 BLOCK_INPUT;
788 ximg = XGetImage (FRAME_X_DISPLAY (f), pixmap, 0, 0, width, height,
789 ~0, ZPixmap);
791 if (!ximg)
793 UNBLOCK_INPUT;
794 return -1;
797 result = x_create_x_image_and_pixmap (f, width, height, 1, &mask_img, &mask);
799 UNBLOCK_INPUT;
800 if (!result)
802 XDestroyImage (ximg);
803 return -1;
806 bg = four_corners_best (ximg, width, height);
808 for (y = 0; y < ximg->height; ++y)
810 for (x = 0; x < ximg->width; ++x)
812 xp = x != ximg->width - 1 ? x + 1 : 0;
813 xm = x != 0 ? x - 1 : ximg->width - 1;
814 yp = y != ximg->height - 1 ? y + 1 : 0;
815 ym = y != 0 ? y - 1 : ximg->height - 1;
816 if (XGetPixel (ximg, x, y) == bg
817 && XGetPixel (ximg, x, yp) == bg
818 && XGetPixel (ximg, x, ym) == bg
819 && XGetPixel (ximg, xp, y) == bg
820 && XGetPixel (ximg, xp, yp) == bg
821 && XGetPixel (ximg, xp, ym) == bg
822 && XGetPixel (ximg, xm, y) == bg
823 && XGetPixel (ximg, xm, yp) == bg
824 && XGetPixel (ximg, xm, ym) == bg)
825 XPutPixel (mask_img, x, y, 0);
826 else
827 XPutPixel (mask_img, x, y, 1);
831 xassert (interrupt_input_blocked);
832 gc = XCreateGC (FRAME_X_DISPLAY (f), mask, 0, NULL);
833 XPutImage (FRAME_X_DISPLAY (f), mask, gc, mask_img, 0, 0, 0, 0,
834 width, height);
835 XFreeGC (FRAME_X_DISPLAY (f), gc);
837 dpyinfo->bitmaps[id - 1].have_mask = 1;
838 dpyinfo->bitmaps[id - 1].mask = mask;
840 XDestroyImage (ximg);
841 x_destroy_x_image (mask_img);
843 return 0;
846 static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
847 static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
848 static void x_disable_image P_ ((struct frame *, struct image *));
850 void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
851 static void x_set_wait_for_wm P_ ((struct frame *, Lisp_Object, Lisp_Object));
852 void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
853 void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
854 void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
855 void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
856 void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
857 void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
858 void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
859 void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
860 void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
861 void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
862 void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
863 void x_set_scroll_bar_foreground P_ ((struct frame *, Lisp_Object,
864 Lisp_Object));
865 void x_set_scroll_bar_background P_ ((struct frame *, Lisp_Object,
866 Lisp_Object));
867 static Lisp_Object x_default_scroll_bar_color_parameter P_ ((struct frame *,
868 Lisp_Object,
869 Lisp_Object,
870 char *, char *,
871 int));
872 static void x_edge_detection P_ ((struct frame *, struct image *, Lisp_Object,
873 Lisp_Object));
874 static void init_color_table P_ ((void));
875 static void free_color_table P_ ((void));
876 static unsigned long *colors_in_color_table P_ ((int *n));
877 static unsigned long lookup_rgb_color P_ ((struct frame *f, int r, int g, int b));
878 static unsigned long lookup_pixel_color P_ ((struct frame *f, unsigned long p));
884 /* Store the screen positions of frame F into XPTR and YPTR.
885 These are the positions of the containing window manager window,
886 not Emacs's own window. */
888 void
889 x_real_positions (f, xptr, yptr)
890 FRAME_PTR f;
891 int *xptr, *yptr;
893 int win_x, win_y, outer_x, outer_y;
894 int real_x = 0, real_y = 0;
895 int had_errors = 0;
896 Window win = f->output_data.x->parent_desc;
898 int count;
900 BLOCK_INPUT;
902 count = x_catch_errors (FRAME_X_DISPLAY (f));
904 if (win == FRAME_X_DISPLAY_INFO (f)->root_window)
905 win = FRAME_OUTER_WINDOW (f);
907 /* This loop traverses up the containment tree until we hit the root
908 window. Window managers may intersect many windows between our window
909 and the root window. The window we find just before the root window
910 should be the outer WM window. */
911 for (;;)
913 Window wm_window, rootw;
914 Window *tmp_children;
915 unsigned int tmp_nchildren;
916 int success;
918 success = XQueryTree (FRAME_X_DISPLAY (f), win, &rootw,
919 &wm_window, &tmp_children, &tmp_nchildren);
921 had_errors = x_had_errors_p (FRAME_X_DISPLAY (f));
923 /* Don't free tmp_children if XQueryTree failed. */
924 if (! success)
925 break;
927 XFree ((char *) tmp_children);
929 if (wm_window == rootw || had_errors)
930 break;
932 win = wm_window;
935 if (! had_errors)
937 int ign;
938 Window child, rootw;
940 /* Get the real coordinates for the WM window upper left corner */
941 XGetGeometry (FRAME_X_DISPLAY (f), win,
942 &rootw, &real_x, &real_y, &ign, &ign, &ign, &ign);
944 /* Translate real coordinates to coordinates relative to our
945 window. For our window, the upper left corner is 0, 0.
946 Since the upper left corner of the WM window is outside
947 our window, win_x and win_y will be negative:
949 ------------------ ---> x
950 | title |
951 | ----------------- v y
952 | | our window
954 XTranslateCoordinates (FRAME_X_DISPLAY (f),
956 /* From-window, to-window. */
957 FRAME_X_DISPLAY_INFO (f)->root_window,
958 FRAME_X_WINDOW (f),
960 /* From-position, to-position. */
961 real_x, real_y, &win_x, &win_y,
963 /* Child of win. */
964 &child);
966 if (FRAME_X_WINDOW (f) == FRAME_OUTER_WINDOW (f))
968 outer_x = win_x;
969 outer_y = win_y;
971 else
973 XTranslateCoordinates (FRAME_X_DISPLAY (f),
975 /* From-window, to-window. */
976 FRAME_X_DISPLAY_INFO (f)->root_window,
977 FRAME_OUTER_WINDOW (f),
979 /* From-position, to-position. */
980 real_x, real_y, &outer_x, &outer_y,
982 /* Child of win. */
983 &child);
986 had_errors = x_had_errors_p (FRAME_X_DISPLAY (f));
989 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
991 UNBLOCK_INPUT;
993 if (had_errors) return;
995 f->x_pixels_diff = -win_x;
996 f->y_pixels_diff = -win_y;
998 FRAME_X_OUTPUT (f)->x_pixels_outer_diff = -outer_x;
999 FRAME_X_OUTPUT (f)->y_pixels_outer_diff = -outer_y;
1001 *xptr = real_x;
1002 *yptr = real_y;
1008 /* Gamma-correct COLOR on frame F. */
1010 void
1011 gamma_correct (f, color)
1012 struct frame *f;
1013 XColor *color;
1015 if (f->gamma)
1017 color->red = pow (color->red / 65535.0, f->gamma) * 65535.0 + 0.5;
1018 color->green = pow (color->green / 65535.0, f->gamma) * 65535.0 + 0.5;
1019 color->blue = pow (color->blue / 65535.0, f->gamma) * 65535.0 + 0.5;
1024 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1025 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1026 allocate the color. Value is zero if COLOR_NAME is invalid, or
1027 no color could be allocated. */
1030 x_defined_color (f, color_name, color, alloc_p)
1031 struct frame *f;
1032 char *color_name;
1033 XColor *color;
1034 int alloc_p;
1036 int success_p;
1037 Display *dpy = FRAME_X_DISPLAY (f);
1038 Colormap cmap = FRAME_X_COLORMAP (f);
1040 BLOCK_INPUT;
1041 success_p = XParseColor (dpy, cmap, color_name, color);
1042 if (success_p && alloc_p)
1043 success_p = x_alloc_nearest_color (f, cmap, color);
1044 UNBLOCK_INPUT;
1046 return success_p;
1050 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1051 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1052 Signal an error if color can't be allocated. */
1055 x_decode_color (f, color_name, mono_color)
1056 FRAME_PTR f;
1057 Lisp_Object color_name;
1058 int mono_color;
1060 XColor cdef;
1062 CHECK_STRING (color_name);
1064 #if 0 /* Don't do this. It's wrong when we're not using the default
1065 colormap, it makes freeing difficult, and it's probably not
1066 an important optimization. */
1067 if (strcmp (SDATA (color_name), "black") == 0)
1068 return BLACK_PIX_DEFAULT (f);
1069 else if (strcmp (SDATA (color_name), "white") == 0)
1070 return WHITE_PIX_DEFAULT (f);
1071 #endif
1073 /* Return MONO_COLOR for monochrome frames. */
1074 if (FRAME_X_DISPLAY_INFO (f)->n_planes == 1)
1075 return mono_color;
1077 /* x_defined_color is responsible for coping with failures
1078 by looking for a near-miss. */
1079 if (x_defined_color (f, SDATA (color_name), &cdef, 1))
1080 return cdef.pixel;
1082 Fsignal (Qerror, Fcons (build_string ("Undefined color"),
1083 Fcons (color_name, Qnil)));
1084 return 0;
1089 /* Change the `wait-for-wm' frame parameter of frame F. OLD_VALUE is
1090 the previous value of that parameter, NEW_VALUE is the new value.
1091 See also the comment of wait_for_wm in struct x_output. */
1093 static void
1094 x_set_wait_for_wm (f, new_value, old_value)
1095 struct frame *f;
1096 Lisp_Object new_value, old_value;
1098 f->output_data.x->wait_for_wm = !NILP (new_value);
1101 #ifdef USE_GTK
1103 static Lisp_Object x_find_image_file P_ ((Lisp_Object file));
1105 /* Set icon from FILE for frame F. By using GTK functions the icon
1106 may be any format that GdkPixbuf knows about, i.e. not just bitmaps. */
1109 xg_set_icon (f, file)
1110 FRAME_PTR f;
1111 Lisp_Object file;
1113 struct gcpro gcpro1;
1114 int result = 0;
1115 Lisp_Object found;
1117 GCPRO1 (found);
1119 found = x_find_image_file (file);
1121 if (! NILP (found))
1123 GdkPixbuf *pixbuf;
1124 GError *err = NULL;
1125 char *filename;
1127 filename = SDATA (found);
1128 BLOCK_INPUT;
1130 pixbuf = gdk_pixbuf_new_from_file (filename, &err);
1132 if (pixbuf)
1134 gtk_window_set_icon (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
1135 pixbuf);
1136 g_object_unref (pixbuf);
1138 result = 1;
1140 else
1141 g_error_free (err);
1143 UNBLOCK_INPUT;
1146 UNGCPRO;
1147 return result;
1149 #endif /* USE_GTK */
1152 /* Functions called only from `x_set_frame_param'
1153 to set individual parameters.
1155 If FRAME_X_WINDOW (f) is 0,
1156 the frame is being created and its X-window does not exist yet.
1157 In that case, just record the parameter's new value
1158 in the standard place; do not attempt to change the window. */
1160 void
1161 x_set_foreground_color (f, arg, oldval)
1162 struct frame *f;
1163 Lisp_Object arg, oldval;
1165 struct x_output *x = f->output_data.x;
1166 unsigned long fg, old_fg;
1168 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1169 old_fg = x->foreground_pixel;
1170 x->foreground_pixel = fg;
1172 if (FRAME_X_WINDOW (f) != 0)
1174 Display *dpy = FRAME_X_DISPLAY (f);
1176 BLOCK_INPUT;
1177 XSetForeground (dpy, x->normal_gc, fg);
1178 XSetBackground (dpy, x->reverse_gc, fg);
1180 if (x->cursor_pixel == old_fg)
1182 unload_color (f, x->cursor_pixel);
1183 x->cursor_pixel = x_copy_color (f, fg);
1184 XSetBackground (dpy, x->cursor_gc, x->cursor_pixel);
1187 UNBLOCK_INPUT;
1189 update_face_from_frame_parameter (f, Qforeground_color, arg);
1191 if (FRAME_VISIBLE_P (f))
1192 redraw_frame (f);
1195 unload_color (f, old_fg);
1198 void
1199 x_set_background_color (f, arg, oldval)
1200 struct frame *f;
1201 Lisp_Object arg, oldval;
1203 struct x_output *x = f->output_data.x;
1204 unsigned long bg;
1206 bg = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1207 unload_color (f, x->background_pixel);
1208 x->background_pixel = bg;
1210 if (FRAME_X_WINDOW (f) != 0)
1212 Display *dpy = FRAME_X_DISPLAY (f);
1214 BLOCK_INPUT;
1215 XSetBackground (dpy, x->normal_gc, bg);
1216 XSetForeground (dpy, x->reverse_gc, bg);
1217 XSetWindowBackground (dpy, FRAME_X_WINDOW (f), bg);
1218 XSetForeground (dpy, x->cursor_gc, bg);
1220 #ifdef USE_GTK
1221 xg_set_background_color (f, bg);
1222 #endif
1224 #ifndef USE_TOOLKIT_SCROLL_BARS /* Turns out to be annoying with
1225 toolkit scroll bars. */
1227 Lisp_Object bar;
1228 for (bar = FRAME_SCROLL_BARS (f);
1229 !NILP (bar);
1230 bar = XSCROLL_BAR (bar)->next)
1232 Window window = SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar));
1233 XSetWindowBackground (dpy, window, bg);
1236 #endif /* USE_TOOLKIT_SCROLL_BARS */
1238 UNBLOCK_INPUT;
1239 update_face_from_frame_parameter (f, Qbackground_color, arg);
1241 if (FRAME_VISIBLE_P (f))
1242 redraw_frame (f);
1246 void
1247 x_set_mouse_color (f, arg, oldval)
1248 struct frame *f;
1249 Lisp_Object arg, oldval;
1251 struct x_output *x = f->output_data.x;
1252 Display *dpy = FRAME_X_DISPLAY (f);
1253 Cursor cursor, nontext_cursor, mode_cursor, hand_cursor;
1254 Cursor hourglass_cursor, horizontal_drag_cursor;
1255 int count;
1256 unsigned long pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1257 unsigned long mask_color = x->background_pixel;
1259 /* Don't let pointers be invisible. */
1260 if (mask_color == pixel)
1262 x_free_colors (f, &pixel, 1);
1263 pixel = x_copy_color (f, x->foreground_pixel);
1266 unload_color (f, x->mouse_pixel);
1267 x->mouse_pixel = pixel;
1269 BLOCK_INPUT;
1271 /* It's not okay to crash if the user selects a screwy cursor. */
1272 count = x_catch_errors (dpy);
1274 if (!NILP (Vx_pointer_shape))
1276 CHECK_NUMBER (Vx_pointer_shape);
1277 cursor = XCreateFontCursor (dpy, XINT (Vx_pointer_shape));
1279 else
1280 cursor = XCreateFontCursor (dpy, XC_xterm);
1281 x_check_errors (dpy, "bad text pointer cursor: %s");
1283 if (!NILP (Vx_nontext_pointer_shape))
1285 CHECK_NUMBER (Vx_nontext_pointer_shape);
1286 nontext_cursor
1287 = XCreateFontCursor (dpy, XINT (Vx_nontext_pointer_shape));
1289 else
1290 nontext_cursor = XCreateFontCursor (dpy, XC_left_ptr);
1291 x_check_errors (dpy, "bad nontext pointer cursor: %s");
1293 if (!NILP (Vx_hourglass_pointer_shape))
1295 CHECK_NUMBER (Vx_hourglass_pointer_shape);
1296 hourglass_cursor
1297 = XCreateFontCursor (dpy, XINT (Vx_hourglass_pointer_shape));
1299 else
1300 hourglass_cursor = XCreateFontCursor (dpy, XC_watch);
1301 x_check_errors (dpy, "bad hourglass pointer cursor: %s");
1303 if (!NILP (Vx_mode_pointer_shape))
1305 CHECK_NUMBER (Vx_mode_pointer_shape);
1306 mode_cursor = XCreateFontCursor (dpy, XINT (Vx_mode_pointer_shape));
1308 else
1309 mode_cursor = XCreateFontCursor (dpy, XC_xterm);
1310 x_check_errors (dpy, "bad modeline pointer cursor: %s");
1312 if (!NILP (Vx_sensitive_text_pointer_shape))
1314 CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
1315 hand_cursor
1316 = XCreateFontCursor (dpy, XINT (Vx_sensitive_text_pointer_shape));
1318 else
1319 hand_cursor = XCreateFontCursor (dpy, XC_hand2);
1321 if (!NILP (Vx_window_horizontal_drag_shape))
1323 CHECK_NUMBER (Vx_window_horizontal_drag_shape);
1324 horizontal_drag_cursor
1325 = XCreateFontCursor (dpy, XINT (Vx_window_horizontal_drag_shape));
1327 else
1328 horizontal_drag_cursor
1329 = XCreateFontCursor (dpy, XC_sb_h_double_arrow);
1331 /* Check and report errors with the above calls. */
1332 x_check_errors (dpy, "can't set cursor shape: %s");
1333 x_uncatch_errors (dpy, count);
1336 XColor fore_color, back_color;
1338 fore_color.pixel = x->mouse_pixel;
1339 x_query_color (f, &fore_color);
1340 back_color.pixel = mask_color;
1341 x_query_color (f, &back_color);
1343 XRecolorCursor (dpy, cursor, &fore_color, &back_color);
1344 XRecolorCursor (dpy, nontext_cursor, &fore_color, &back_color);
1345 XRecolorCursor (dpy, mode_cursor, &fore_color, &back_color);
1346 XRecolorCursor (dpy, hand_cursor, &fore_color, &back_color);
1347 XRecolorCursor (dpy, hourglass_cursor, &fore_color, &back_color);
1348 XRecolorCursor (dpy, horizontal_drag_cursor, &fore_color, &back_color);
1351 if (FRAME_X_WINDOW (f) != 0)
1352 XDefineCursor (dpy, FRAME_X_WINDOW (f), cursor);
1354 if (cursor != x->text_cursor
1355 && x->text_cursor != 0)
1356 XFreeCursor (dpy, x->text_cursor);
1357 x->text_cursor = cursor;
1359 if (nontext_cursor != x->nontext_cursor
1360 && x->nontext_cursor != 0)
1361 XFreeCursor (dpy, x->nontext_cursor);
1362 x->nontext_cursor = nontext_cursor;
1364 if (hourglass_cursor != x->hourglass_cursor
1365 && x->hourglass_cursor != 0)
1366 XFreeCursor (dpy, x->hourglass_cursor);
1367 x->hourglass_cursor = hourglass_cursor;
1369 if (mode_cursor != x->modeline_cursor
1370 && x->modeline_cursor != 0)
1371 XFreeCursor (dpy, f->output_data.x->modeline_cursor);
1372 x->modeline_cursor = mode_cursor;
1374 if (hand_cursor != x->hand_cursor
1375 && x->hand_cursor != 0)
1376 XFreeCursor (dpy, x->hand_cursor);
1377 x->hand_cursor = hand_cursor;
1379 if (horizontal_drag_cursor != x->horizontal_drag_cursor
1380 && x->horizontal_drag_cursor != 0)
1381 XFreeCursor (dpy, x->horizontal_drag_cursor);
1382 x->horizontal_drag_cursor = horizontal_drag_cursor;
1384 XFlush (dpy);
1385 UNBLOCK_INPUT;
1387 update_face_from_frame_parameter (f, Qmouse_color, arg);
1390 void
1391 x_set_cursor_color (f, arg, oldval)
1392 struct frame *f;
1393 Lisp_Object arg, oldval;
1395 unsigned long fore_pixel, pixel;
1396 int fore_pixel_allocated_p = 0, pixel_allocated_p = 0;
1397 struct x_output *x = f->output_data.x;
1399 if (!NILP (Vx_cursor_fore_pixel))
1401 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1402 WHITE_PIX_DEFAULT (f));
1403 fore_pixel_allocated_p = 1;
1405 else
1406 fore_pixel = x->background_pixel;
1408 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1409 pixel_allocated_p = 1;
1411 /* Make sure that the cursor color differs from the background color. */
1412 if (pixel == x->background_pixel)
1414 if (pixel_allocated_p)
1416 x_free_colors (f, &pixel, 1);
1417 pixel_allocated_p = 0;
1420 pixel = x->mouse_pixel;
1421 if (pixel == fore_pixel)
1423 if (fore_pixel_allocated_p)
1425 x_free_colors (f, &fore_pixel, 1);
1426 fore_pixel_allocated_p = 0;
1428 fore_pixel = x->background_pixel;
1432 unload_color (f, x->cursor_foreground_pixel);
1433 if (!fore_pixel_allocated_p)
1434 fore_pixel = x_copy_color (f, fore_pixel);
1435 x->cursor_foreground_pixel = fore_pixel;
1437 unload_color (f, x->cursor_pixel);
1438 if (!pixel_allocated_p)
1439 pixel = x_copy_color (f, pixel);
1440 x->cursor_pixel = pixel;
1442 if (FRAME_X_WINDOW (f) != 0)
1444 BLOCK_INPUT;
1445 XSetBackground (FRAME_X_DISPLAY (f), x->cursor_gc, x->cursor_pixel);
1446 XSetForeground (FRAME_X_DISPLAY (f), x->cursor_gc, fore_pixel);
1447 UNBLOCK_INPUT;
1449 if (FRAME_VISIBLE_P (f))
1451 x_update_cursor (f, 0);
1452 x_update_cursor (f, 1);
1456 update_face_from_frame_parameter (f, Qcursor_color, arg);
1459 /* Set the border-color of frame F to pixel value PIX.
1460 Note that this does not fully take effect if done before
1461 F has an x-window. */
1463 void
1464 x_set_border_pixel (f, pix)
1465 struct frame *f;
1466 int pix;
1468 unload_color (f, f->output_data.x->border_pixel);
1469 f->output_data.x->border_pixel = pix;
1471 if (FRAME_X_WINDOW (f) != 0 && f->border_width > 0)
1473 BLOCK_INPUT;
1474 XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1475 (unsigned long)pix);
1476 UNBLOCK_INPUT;
1478 if (FRAME_VISIBLE_P (f))
1479 redraw_frame (f);
1483 /* Set the border-color of frame F to value described by ARG.
1484 ARG can be a string naming a color.
1485 The border-color is used for the border that is drawn by the X server.
1486 Note that this does not fully take effect if done before
1487 F has an x-window; it must be redone when the window is created.
1489 Note: this is done in two routines because of the way X10 works.
1491 Note: under X11, this is normally the province of the window manager,
1492 and so emacs' border colors may be overridden. */
1494 void
1495 x_set_border_color (f, arg, oldval)
1496 struct frame *f;
1497 Lisp_Object arg, oldval;
1499 int pix;
1501 CHECK_STRING (arg);
1502 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1503 x_set_border_pixel (f, pix);
1504 update_face_from_frame_parameter (f, Qborder_color, arg);
1508 void
1509 x_set_cursor_type (f, arg, oldval)
1510 FRAME_PTR f;
1511 Lisp_Object arg, oldval;
1513 set_frame_cursor_types (f, arg);
1515 /* Make sure the cursor gets redrawn. */
1516 cursor_type_changed = 1;
1519 void
1520 x_set_icon_type (f, arg, oldval)
1521 struct frame *f;
1522 Lisp_Object arg, oldval;
1524 int result;
1526 if (STRINGP (arg))
1528 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1529 return;
1531 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1532 return;
1534 BLOCK_INPUT;
1535 if (NILP (arg))
1536 result = x_text_icon (f,
1537 (char *) SDATA ((!NILP (f->icon_name)
1538 ? f->icon_name
1539 : f->name)));
1540 else
1541 result = x_bitmap_icon (f, arg);
1543 if (result)
1545 UNBLOCK_INPUT;
1546 error ("No icon window available");
1549 XFlush (FRAME_X_DISPLAY (f));
1550 UNBLOCK_INPUT;
1553 void
1554 x_set_icon_name (f, arg, oldval)
1555 struct frame *f;
1556 Lisp_Object arg, oldval;
1558 int result;
1560 if (STRINGP (arg))
1562 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1563 return;
1565 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1566 return;
1568 f->icon_name = arg;
1570 if (f->output_data.x->icon_bitmap != 0)
1571 return;
1573 BLOCK_INPUT;
1575 result = x_text_icon (f,
1576 (char *) SDATA ((!NILP (f->icon_name)
1577 ? f->icon_name
1578 : !NILP (f->title)
1579 ? f->title
1580 : f->name)));
1582 if (result)
1584 UNBLOCK_INPUT;
1585 error ("No icon window available");
1588 XFlush (FRAME_X_DISPLAY (f));
1589 UNBLOCK_INPUT;
1593 void
1594 x_set_menu_bar_lines (f, value, oldval)
1595 struct frame *f;
1596 Lisp_Object value, oldval;
1598 int nlines;
1599 #ifndef USE_X_TOOLKIT
1600 int olines = FRAME_MENU_BAR_LINES (f);
1601 #endif
1603 /* Right now, menu bars don't work properly in minibuf-only frames;
1604 most of the commands try to apply themselves to the minibuffer
1605 frame itself, and get an error because you can't switch buffers
1606 in or split the minibuffer window. */
1607 if (FRAME_MINIBUF_ONLY_P (f))
1608 return;
1610 if (INTEGERP (value))
1611 nlines = XINT (value);
1612 else
1613 nlines = 0;
1615 /* Make sure we redisplay all windows in this frame. */
1616 windows_or_buffers_changed++;
1618 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
1619 FRAME_MENU_BAR_LINES (f) = 0;
1620 if (nlines)
1622 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1623 if (FRAME_X_P (f) && f->output_data.x->menubar_widget == 0)
1624 /* Make sure next redisplay shows the menu bar. */
1625 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1627 else
1629 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1630 free_frame_menubar (f);
1631 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1632 if (FRAME_X_P (f))
1633 f->output_data.x->menubar_widget = 0;
1635 #else /* not USE_X_TOOLKIT && not USE_GTK */
1636 FRAME_MENU_BAR_LINES (f) = nlines;
1637 change_window_heights (f->root_window, nlines - olines);
1638 #endif /* not USE_X_TOOLKIT */
1639 adjust_glyphs (f);
1643 /* Set the number of lines used for the tool bar of frame F to VALUE.
1644 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1645 is the old number of tool bar lines. This function changes the
1646 height of all windows on frame F to match the new tool bar height.
1647 The frame's height doesn't change. */
1649 void
1650 x_set_tool_bar_lines (f, value, oldval)
1651 struct frame *f;
1652 Lisp_Object value, oldval;
1654 int delta, nlines, root_height;
1655 Lisp_Object root_window;
1657 /* Treat tool bars like menu bars. */
1658 if (FRAME_MINIBUF_ONLY_P (f))
1659 return;
1661 /* Use VALUE only if an integer >= 0. */
1662 if (INTEGERP (value) && XINT (value) >= 0)
1663 nlines = XFASTINT (value);
1664 else
1665 nlines = 0;
1667 #ifdef USE_GTK
1668 FRAME_TOOL_BAR_LINES (f) = 0;
1669 if (nlines)
1671 FRAME_EXTERNAL_TOOL_BAR (f) = 1;
1672 if (FRAME_X_P (f) && f->output_data.x->toolbar_widget == 0)
1673 /* Make sure next redisplay shows the tool bar. */
1674 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1675 update_frame_tool_bar (f);
1677 else
1679 if (FRAME_EXTERNAL_TOOL_BAR (f))
1680 free_frame_tool_bar (f);
1681 FRAME_EXTERNAL_TOOL_BAR (f) = 0;
1684 return;
1685 #endif
1687 /* Make sure we redisplay all windows in this frame. */
1688 ++windows_or_buffers_changed;
1690 delta = nlines - FRAME_TOOL_BAR_LINES (f);
1692 /* Don't resize the tool-bar to more than we have room for. */
1693 root_window = FRAME_ROOT_WINDOW (f);
1694 root_height = WINDOW_TOTAL_LINES (XWINDOW (root_window));
1695 if (root_height - delta < 1)
1697 delta = root_height - 1;
1698 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
1701 FRAME_TOOL_BAR_LINES (f) = nlines;
1702 change_window_heights (root_window, delta);
1703 adjust_glyphs (f);
1705 /* We also have to make sure that the internal border at the top of
1706 the frame, below the menu bar or tool bar, is redrawn when the
1707 tool bar disappears. This is so because the internal border is
1708 below the tool bar if one is displayed, but is below the menu bar
1709 if there isn't a tool bar. The tool bar draws into the area
1710 below the menu bar. */
1711 if (FRAME_X_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
1713 updating_frame = f;
1714 clear_frame ();
1715 clear_current_matrices (f);
1716 updating_frame = NULL;
1719 /* If the tool bar gets smaller, the internal border below it
1720 has to be cleared. It was formerly part of the display
1721 of the larger tool bar, and updating windows won't clear it. */
1722 if (delta < 0)
1724 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
1725 int width = FRAME_PIXEL_WIDTH (f);
1726 int y = nlines * FRAME_LINE_HEIGHT (f);
1728 BLOCK_INPUT;
1729 x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1730 0, y, width, height, False);
1731 UNBLOCK_INPUT;
1733 if (WINDOWP (f->tool_bar_window))
1734 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
1739 /* Set the foreground color for scroll bars on frame F to VALUE.
1740 VALUE should be a string, a color name. If it isn't a string or
1741 isn't a valid color name, do nothing. OLDVAL is the old value of
1742 the frame parameter. */
1744 void
1745 x_set_scroll_bar_foreground (f, value, oldval)
1746 struct frame *f;
1747 Lisp_Object value, oldval;
1749 unsigned long pixel;
1751 if (STRINGP (value))
1752 pixel = x_decode_color (f, value, BLACK_PIX_DEFAULT (f));
1753 else
1754 pixel = -1;
1756 if (f->output_data.x->scroll_bar_foreground_pixel != -1)
1757 unload_color (f, f->output_data.x->scroll_bar_foreground_pixel);
1759 f->output_data.x->scroll_bar_foreground_pixel = pixel;
1760 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
1762 /* Remove all scroll bars because they have wrong colors. */
1763 if (condemn_scroll_bars_hook)
1764 (*condemn_scroll_bars_hook) (f);
1765 if (judge_scroll_bars_hook)
1766 (*judge_scroll_bars_hook) (f);
1768 update_face_from_frame_parameter (f, Qscroll_bar_foreground, value);
1769 redraw_frame (f);
1774 /* Set the background color for scroll bars on frame F to VALUE VALUE
1775 should be a string, a color name. If it isn't a string or isn't a
1776 valid color name, do nothing. OLDVAL is the old value of the frame
1777 parameter. */
1779 void
1780 x_set_scroll_bar_background (f, value, oldval)
1781 struct frame *f;
1782 Lisp_Object value, oldval;
1784 unsigned long pixel;
1786 if (STRINGP (value))
1787 pixel = x_decode_color (f, value, WHITE_PIX_DEFAULT (f));
1788 else
1789 pixel = -1;
1791 if (f->output_data.x->scroll_bar_background_pixel != -1)
1792 unload_color (f, f->output_data.x->scroll_bar_background_pixel);
1794 #ifdef USE_TOOLKIT_SCROLL_BARS
1795 /* Scrollbar shadow colors. */
1796 if (f->output_data.x->scroll_bar_top_shadow_pixel != -1)
1798 unload_color (f, f->output_data.x->scroll_bar_top_shadow_pixel);
1799 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
1801 if (f->output_data.x->scroll_bar_bottom_shadow_pixel != -1)
1803 unload_color (f, f->output_data.x->scroll_bar_bottom_shadow_pixel);
1804 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
1806 #endif /* USE_TOOLKIT_SCROLL_BARS */
1808 f->output_data.x->scroll_bar_background_pixel = pixel;
1809 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
1811 /* Remove all scroll bars because they have wrong colors. */
1812 if (condemn_scroll_bars_hook)
1813 (*condemn_scroll_bars_hook) (f);
1814 if (judge_scroll_bars_hook)
1815 (*judge_scroll_bars_hook) (f);
1817 update_face_from_frame_parameter (f, Qscroll_bar_background, value);
1818 redraw_frame (f);
1823 /* Encode Lisp string STRING as a text in a format appropriate for
1824 XICCC (X Inter Client Communication Conventions).
1826 If STRING contains only ASCII characters, do no conversion and
1827 return the string data of STRING. Otherwise, encode the text by
1828 CODING_SYSTEM, and return a newly allocated memory area which
1829 should be freed by `xfree' by a caller.
1831 SELECTIONP non-zero means the string is being encoded for an X
1832 selection, so it is safe to run pre-write conversions (which
1833 may run Lisp code).
1835 Store the byte length of resulting text in *TEXT_BYTES.
1837 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
1838 which means that the `encoding' of the result can be `STRING'.
1839 Otherwise store 0 in *STRINGP, which means that the `encoding' of
1840 the result should be `COMPOUND_TEXT'. */
1842 unsigned char *
1843 x_encode_text (string, coding_system, selectionp, text_bytes, stringp)
1844 Lisp_Object string, coding_system;
1845 int *text_bytes, *stringp;
1846 int selectionp;
1848 unsigned char *str = SDATA (string);
1849 int chars = SCHARS (string);
1850 int bytes = SBYTES (string);
1851 int charset_info;
1852 int bufsize;
1853 unsigned char *buf;
1854 struct coding_system coding;
1855 extern Lisp_Object Qcompound_text_with_extensions;
1857 charset_info = find_charset_in_text (str, chars, bytes, NULL, Qnil);
1858 if (charset_info == 0)
1860 /* No multibyte character in OBJ. We need not encode it. */
1861 *text_bytes = bytes;
1862 *stringp = 1;
1863 return str;
1866 setup_coding_system (coding_system, &coding);
1867 if (selectionp
1868 && SYMBOLP (coding.pre_write_conversion)
1869 && !NILP (Ffboundp (coding.pre_write_conversion)))
1871 string = run_pre_post_conversion_on_str (string, &coding, 1);
1872 str = SDATA (string);
1873 chars = SCHARS (string);
1874 bytes = SBYTES (string);
1876 coding.src_multibyte = 1;
1877 coding.dst_multibyte = 0;
1878 coding.mode |= CODING_MODE_LAST_BLOCK;
1879 if (coding.type == coding_type_iso2022)
1880 coding.flags |= CODING_FLAG_ISO_SAFE;
1881 /* We suppress producing escape sequences for composition. */
1882 coding.composing = COMPOSITION_DISABLED;
1883 bufsize = encoding_buffer_size (&coding, bytes);
1884 buf = (unsigned char *) xmalloc (bufsize);
1885 encode_coding (&coding, str, buf, bytes, bufsize);
1886 *text_bytes = coding.produced;
1887 *stringp = (charset_info == 1
1888 || (!EQ (coding_system, Qcompound_text)
1889 && !EQ (coding_system, Qcompound_text_with_extensions)));
1890 return buf;
1894 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1895 x_id_name.
1897 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1898 name; if NAME is a string, set F's name to NAME and set
1899 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1901 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1902 suggesting a new name, which lisp code should override; if
1903 F->explicit_name is set, ignore the new name; otherwise, set it. */
1905 void
1906 x_set_name (f, name, explicit)
1907 struct frame *f;
1908 Lisp_Object name;
1909 int explicit;
1911 /* Make sure that requests from lisp code override requests from
1912 Emacs redisplay code. */
1913 if (explicit)
1915 /* If we're switching from explicit to implicit, we had better
1916 update the mode lines and thereby update the title. */
1917 if (f->explicit_name && NILP (name))
1918 update_mode_lines = 1;
1920 f->explicit_name = ! NILP (name);
1922 else if (f->explicit_name)
1923 return;
1925 /* If NAME is nil, set the name to the x_id_name. */
1926 if (NILP (name))
1928 /* Check for no change needed in this very common case
1929 before we do any consing. */
1930 if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name,
1931 SDATA (f->name)))
1932 return;
1933 name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name);
1935 else
1936 CHECK_STRING (name);
1938 /* Don't change the name if it's already NAME. */
1939 if (! NILP (Fstring_equal (name, f->name)))
1940 return;
1942 f->name = name;
1944 /* For setting the frame title, the title parameter should override
1945 the name parameter. */
1946 if (! NILP (f->title))
1947 name = f->title;
1949 if (FRAME_X_WINDOW (f))
1951 BLOCK_INPUT;
1952 #ifdef HAVE_X11R4
1954 XTextProperty text, icon;
1955 int bytes, stringp;
1956 Lisp_Object coding_system;
1958 /* Note: Encoding strategy
1960 We encode NAME by compound-text and use "COMPOUND-TEXT" in
1961 text.encoding. But, there are non-internationalized window
1962 managers which don't support that encoding. So, if NAME
1963 contains only ASCII and 8859-1 characters, encode it by
1964 iso-latin-1, and use "STRING" in text.encoding hoping that
1965 such window managers at least analyze this format correctly,
1966 i.e. treat 8-bit bytes as 8859-1 characters.
1968 We may also be able to use "UTF8_STRING" in text.encoding
1969 in the future which can encode all Unicode characters.
1970 But, for the moment, there's no way to know that the
1971 current window manager supports it or not. */
1972 coding_system = Qcompound_text;
1973 text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp);
1974 text.encoding = (stringp ? XA_STRING
1975 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
1976 text.format = 8;
1977 text.nitems = bytes;
1979 if (NILP (f->icon_name))
1981 icon = text;
1983 else
1985 /* See the above comment "Note: Encoding strategy". */
1986 icon.value = x_encode_text (f->icon_name, coding_system, 0,
1987 &bytes, &stringp);
1988 icon.encoding = (stringp ? XA_STRING
1989 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
1990 icon.format = 8;
1991 icon.nitems = bytes;
1993 #ifdef USE_GTK
1994 gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
1995 SDATA (name));
1996 #else /* not USE_GTK */
1997 XSetWMName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &text);
1998 #endif /* not USE_GTK */
2000 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &icon);
2002 if (!NILP (f->icon_name)
2003 && icon.value != (unsigned char *) SDATA (f->icon_name))
2004 xfree (icon.value);
2005 if (text.value != (unsigned char *) SDATA (name))
2006 xfree (text.value);
2008 #else /* not HAVE_X11R4 */
2009 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2010 SDATA (name));
2011 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2012 SDATA (name));
2013 #endif /* not HAVE_X11R4 */
2014 UNBLOCK_INPUT;
2018 /* This function should be called when the user's lisp code has
2019 specified a name for the frame; the name will override any set by the
2020 redisplay code. */
2021 void
2022 x_explicitly_set_name (f, arg, oldval)
2023 FRAME_PTR f;
2024 Lisp_Object arg, oldval;
2026 x_set_name (f, arg, 1);
2029 /* This function should be called by Emacs redisplay code to set the
2030 name; names set this way will never override names set by the user's
2031 lisp code. */
2032 void
2033 x_implicitly_set_name (f, arg, oldval)
2034 FRAME_PTR f;
2035 Lisp_Object arg, oldval;
2037 x_set_name (f, arg, 0);
2040 /* Change the title of frame F to NAME.
2041 If NAME is nil, use the frame name as the title.
2043 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2044 name; if NAME is a string, set F's name to NAME and set
2045 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2047 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2048 suggesting a new name, which lisp code should override; if
2049 F->explicit_name is set, ignore the new name; otherwise, set it. */
2051 void
2052 x_set_title (f, name, old_name)
2053 struct frame *f;
2054 Lisp_Object name, old_name;
2056 /* Don't change the title if it's already NAME. */
2057 if (EQ (name, f->title))
2058 return;
2060 update_mode_lines = 1;
2062 f->title = name;
2064 if (NILP (name))
2065 name = f->name;
2066 else
2067 CHECK_STRING (name);
2069 if (FRAME_X_WINDOW (f))
2071 BLOCK_INPUT;
2072 #ifdef HAVE_X11R4
2074 XTextProperty text, icon;
2075 int bytes, stringp;
2076 Lisp_Object coding_system;
2078 coding_system = Qcompound_text;
2079 /* See the comment "Note: Encoding strategy" in x_set_name. */
2080 text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp);
2081 text.encoding = (stringp ? XA_STRING
2082 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
2083 text.format = 8;
2084 text.nitems = bytes;
2086 if (NILP (f->icon_name))
2088 icon = text;
2090 else
2092 /* See the comment "Note: Encoding strategy" in x_set_name. */
2093 icon.value = x_encode_text (f->icon_name, coding_system, 0,
2094 &bytes, &stringp);
2095 icon.encoding = (stringp ? XA_STRING
2096 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
2097 icon.format = 8;
2098 icon.nitems = bytes;
2101 #ifdef USE_GTK
2102 gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
2103 SDATA (name));
2104 #else /* not USE_GTK */
2105 XSetWMName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &text);
2106 #endif /* not USE_GTK */
2108 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
2109 &icon);
2111 if (!NILP (f->icon_name)
2112 && icon.value != (unsigned char *) SDATA (f->icon_name))
2113 xfree (icon.value);
2114 if (text.value != (unsigned char *) SDATA (name))
2115 xfree (text.value);
2117 #else /* not HAVE_X11R4 */
2118 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2119 SDATA (name));
2120 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2121 SDATA (name));
2122 #endif /* not HAVE_X11R4 */
2123 UNBLOCK_INPUT;
2127 void
2128 x_set_scroll_bar_default_width (f)
2129 struct frame *f;
2131 int wid = FRAME_COLUMN_WIDTH (f);
2133 #ifdef USE_TOOLKIT_SCROLL_BARS
2134 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2135 int width = 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM;
2136 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (width + wid - 1) / wid;
2137 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = width;
2138 #else
2139 /* Make the actual width at least 14 pixels and a multiple of a
2140 character width. */
2141 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid;
2143 /* Use all of that space (aside from required margins) for the
2144 scroll bar. */
2145 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = 0;
2146 #endif
2150 /* Record in frame F the specified or default value according to ALIST
2151 of the parameter named PROP (a Lisp symbol). If no value is
2152 specified for PROP, look for an X default for XPROP on the frame
2153 named NAME. If that is not found either, use the value DEFLT. */
2155 static Lisp_Object
2156 x_default_scroll_bar_color_parameter (f, alist, prop, xprop, xclass,
2157 foreground_p)
2158 struct frame *f;
2159 Lisp_Object alist;
2160 Lisp_Object prop;
2161 char *xprop;
2162 char *xclass;
2163 int foreground_p;
2165 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2166 Lisp_Object tem;
2168 tem = x_get_arg (dpyinfo, alist, prop, xprop, xclass, RES_TYPE_STRING);
2169 if (EQ (tem, Qunbound))
2171 #ifdef USE_TOOLKIT_SCROLL_BARS
2173 /* See if an X resource for the scroll bar color has been
2174 specified. */
2175 tem = display_x_get_resource (dpyinfo,
2176 build_string (foreground_p
2177 ? "foreground"
2178 : "background"),
2179 empty_string,
2180 build_string ("verticalScrollBar"),
2181 empty_string);
2182 if (!STRINGP (tem))
2184 /* If nothing has been specified, scroll bars will use a
2185 toolkit-dependent default. Because these defaults are
2186 difficult to get at without actually creating a scroll
2187 bar, use nil to indicate that no color has been
2188 specified. */
2189 tem = Qnil;
2192 #else /* not USE_TOOLKIT_SCROLL_BARS */
2194 tem = Qnil;
2196 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2199 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2200 return tem;
2205 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2207 Status
2208 XSetWMProtocols (dpy, w, protocols, count)
2209 Display *dpy;
2210 Window w;
2211 Atom *protocols;
2212 int count;
2214 Atom prop;
2215 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
2216 if (prop == None) return False;
2217 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
2218 (unsigned char *) protocols, count);
2219 return True;
2221 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2223 #ifdef USE_X_TOOLKIT
2225 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2226 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2227 already be present because of the toolkit (Motif adds some of them,
2228 for example, but Xt doesn't). */
2230 static void
2231 hack_wm_protocols (f, widget)
2232 FRAME_PTR f;
2233 Widget widget;
2235 Display *dpy = XtDisplay (widget);
2236 Window w = XtWindow (widget);
2237 int need_delete = 1;
2238 int need_focus = 1;
2239 int need_save = 1;
2241 BLOCK_INPUT;
2243 Atom type, *atoms = 0;
2244 int format = 0;
2245 unsigned long nitems = 0;
2246 unsigned long bytes_after;
2248 if ((XGetWindowProperty (dpy, w,
2249 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2250 (long)0, (long)100, False, XA_ATOM,
2251 &type, &format, &nitems, &bytes_after,
2252 (unsigned char **) &atoms)
2253 == Success)
2254 && format == 32 && type == XA_ATOM)
2255 while (nitems > 0)
2257 nitems--;
2258 if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window)
2259 need_delete = 0;
2260 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus)
2261 need_focus = 0;
2262 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
2263 need_save = 0;
2265 if (atoms) XFree ((char *) atoms);
2268 Atom props [10];
2269 int count = 0;
2270 if (need_delete)
2271 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2272 if (need_focus)
2273 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus;
2274 if (need_save)
2275 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2276 if (count)
2277 XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2278 XA_ATOM, 32, PropModeAppend,
2279 (unsigned char *) props, count);
2281 UNBLOCK_INPUT;
2283 #endif
2287 /* Support routines for XIC (X Input Context). */
2289 #ifdef HAVE_X_I18N
2291 static XFontSet xic_create_xfontset P_ ((struct frame *, char *));
2292 static XIMStyle best_xim_style P_ ((XIMStyles *, XIMStyles *));
2295 /* Supported XIM styles, ordered by preference. */
2297 static XIMStyle supported_xim_styles[] =
2299 XIMPreeditPosition | XIMStatusArea,
2300 XIMPreeditPosition | XIMStatusNothing,
2301 XIMPreeditPosition | XIMStatusNone,
2302 XIMPreeditNothing | XIMStatusArea,
2303 XIMPreeditNothing | XIMStatusNothing,
2304 XIMPreeditNothing | XIMStatusNone,
2305 XIMPreeditNone | XIMStatusArea,
2306 XIMPreeditNone | XIMStatusNothing,
2307 XIMPreeditNone | XIMStatusNone,
2312 /* Create an X fontset on frame F with base font name
2313 BASE_FONTNAME.. */
2315 static XFontSet
2316 xic_create_xfontset (f, base_fontname)
2317 struct frame *f;
2318 char *base_fontname;
2320 XFontSet xfs;
2321 char **missing_list;
2322 int missing_count;
2323 char *def_string;
2325 xfs = XCreateFontSet (FRAME_X_DISPLAY (f),
2326 base_fontname, &missing_list,
2327 &missing_count, &def_string);
2328 if (missing_list)
2329 XFreeStringList (missing_list);
2331 /* No need to free def_string. */
2332 return xfs;
2336 /* Value is the best input style, given user preferences USER (already
2337 checked to be supported by Emacs), and styles supported by the
2338 input method XIM. */
2340 static XIMStyle
2341 best_xim_style (user, xim)
2342 XIMStyles *user;
2343 XIMStyles *xim;
2345 int i, j;
2347 for (i = 0; i < user->count_styles; ++i)
2348 for (j = 0; j < xim->count_styles; ++j)
2349 if (user->supported_styles[i] == xim->supported_styles[j])
2350 return user->supported_styles[i];
2352 /* Return the default style. */
2353 return XIMPreeditNothing | XIMStatusNothing;
2356 /* Create XIC for frame F. */
2358 static XIMStyle xic_style;
2360 void
2361 create_frame_xic (f)
2362 struct frame *f;
2364 XIM xim;
2365 XIC xic = NULL;
2366 XFontSet xfs = NULL;
2368 if (FRAME_XIC (f))
2369 return;
2371 xim = FRAME_X_XIM (f);
2372 if (xim)
2374 XRectangle s_area;
2375 XPoint spot;
2376 XVaNestedList preedit_attr;
2377 XVaNestedList status_attr;
2378 char *base_fontname;
2379 int fontset;
2381 s_area.x = 0; s_area.y = 0; s_area.width = 1; s_area.height = 1;
2382 spot.x = 0; spot.y = 1;
2383 /* Create X fontset. */
2384 fontset = FRAME_FONTSET (f);
2385 if (fontset < 0)
2386 base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
2387 else
2389 /* Determine the base fontname from the ASCII font name of
2390 FONTSET. */
2391 char *ascii_font = (char *) SDATA (fontset_ascii (fontset));
2392 char *p = ascii_font;
2393 int i;
2395 for (i = 0; *p; p++)
2396 if (*p == '-') i++;
2397 if (i != 14)
2398 /* As the font name doesn't conform to XLFD, we can't
2399 modify it to get a suitable base fontname for the
2400 frame. */
2401 base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
2402 else
2404 int len = strlen (ascii_font) + 1;
2405 char *p1 = NULL;
2407 for (i = 0, p = ascii_font; i < 8; p++)
2409 if (*p == '-')
2411 i++;
2412 if (i == 3)
2413 p1 = p + 1;
2416 base_fontname = (char *) alloca (len);
2417 bzero (base_fontname, len);
2418 strcpy (base_fontname, "-*-*-");
2419 bcopy (p1, base_fontname + 5, p - p1);
2420 strcat (base_fontname, "*-*-*-*-*-*-*");
2423 xfs = xic_create_xfontset (f, base_fontname);
2425 /* Determine XIC style. */
2426 if (xic_style == 0)
2428 XIMStyles supported_list;
2429 supported_list.count_styles = (sizeof supported_xim_styles
2430 / sizeof supported_xim_styles[0]);
2431 supported_list.supported_styles = supported_xim_styles;
2432 xic_style = best_xim_style (&supported_list,
2433 FRAME_X_XIM_STYLES (f));
2436 preedit_attr = XVaCreateNestedList (0,
2437 XNFontSet, xfs,
2438 XNForeground,
2439 FRAME_FOREGROUND_PIXEL (f),
2440 XNBackground,
2441 FRAME_BACKGROUND_PIXEL (f),
2442 (xic_style & XIMPreeditPosition
2443 ? XNSpotLocation
2444 : NULL),
2445 &spot,
2446 NULL);
2447 status_attr = XVaCreateNestedList (0,
2448 XNArea,
2449 &s_area,
2450 XNFontSet,
2451 xfs,
2452 XNForeground,
2453 FRAME_FOREGROUND_PIXEL (f),
2454 XNBackground,
2455 FRAME_BACKGROUND_PIXEL (f),
2456 NULL);
2458 xic = XCreateIC (xim,
2459 XNInputStyle, xic_style,
2460 XNClientWindow, FRAME_X_WINDOW (f),
2461 XNFocusWindow, FRAME_X_WINDOW (f),
2462 XNStatusAttributes, status_attr,
2463 XNPreeditAttributes, preedit_attr,
2464 NULL);
2465 XFree (preedit_attr);
2466 XFree (status_attr);
2469 FRAME_XIC (f) = xic;
2470 FRAME_XIC_STYLE (f) = xic_style;
2471 FRAME_XIC_FONTSET (f) = xfs;
2475 /* Destroy XIC and free XIC fontset of frame F, if any. */
2477 void
2478 free_frame_xic (f)
2479 struct frame *f;
2481 if (FRAME_XIC (f) == NULL)
2482 return;
2484 XDestroyIC (FRAME_XIC (f));
2485 if (FRAME_XIC_FONTSET (f))
2486 XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
2488 FRAME_XIC (f) = NULL;
2489 FRAME_XIC_FONTSET (f) = NULL;
2493 /* Place preedit area for XIC of window W's frame to specified
2494 pixel position X/Y. X and Y are relative to window W. */
2496 void
2497 xic_set_preeditarea (w, x, y)
2498 struct window *w;
2499 int x, y;
2501 struct frame *f = XFRAME (w->frame);
2502 XVaNestedList attr;
2503 XPoint spot;
2505 spot.x = WINDOW_TO_FRAME_PIXEL_X (w, x) + WINDOW_LEFT_FRINGE_WIDTH (w);
2506 spot.y = WINDOW_TO_FRAME_PIXEL_Y (w, y) + FONT_BASE (FRAME_FONT (f));
2507 attr = XVaCreateNestedList (0, XNSpotLocation, &spot, NULL);
2508 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
2509 XFree (attr);
2513 /* Place status area for XIC in bottom right corner of frame F.. */
2515 void
2516 xic_set_statusarea (f)
2517 struct frame *f;
2519 XIC xic = FRAME_XIC (f);
2520 XVaNestedList attr;
2521 XRectangle area;
2522 XRectangle *needed;
2524 /* Negotiate geometry of status area. If input method has existing
2525 status area, use its current size. */
2526 area.x = area.y = area.width = area.height = 0;
2527 attr = XVaCreateNestedList (0, XNAreaNeeded, &area, NULL);
2528 XSetICValues (xic, XNStatusAttributes, attr, NULL);
2529 XFree (attr);
2531 attr = XVaCreateNestedList (0, XNAreaNeeded, &needed, NULL);
2532 XGetICValues (xic, XNStatusAttributes, attr, NULL);
2533 XFree (attr);
2535 if (needed->width == 0) /* Use XNArea instead of XNAreaNeeded */
2537 attr = XVaCreateNestedList (0, XNArea, &needed, NULL);
2538 XGetICValues (xic, XNStatusAttributes, attr, NULL);
2539 XFree (attr);
2542 area.width = needed->width;
2543 area.height = needed->height;
2544 area.x = FRAME_PIXEL_WIDTH (f) - area.width - FRAME_INTERNAL_BORDER_WIDTH (f);
2545 area.y = (FRAME_PIXEL_HEIGHT (f) - area.height
2546 - FRAME_MENUBAR_HEIGHT (f)
2547 - FRAME_TOOLBAR_HEIGHT (f)
2548 - FRAME_INTERNAL_BORDER_WIDTH (f));
2549 XFree (needed);
2551 attr = XVaCreateNestedList (0, XNArea, &area, NULL);
2552 XSetICValues (xic, XNStatusAttributes, attr, NULL);
2553 XFree (attr);
2557 /* Set X fontset for XIC of frame F, using base font name
2558 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
2560 void
2561 xic_set_xfontset (f, base_fontname)
2562 struct frame *f;
2563 char *base_fontname;
2565 XVaNestedList attr;
2566 XFontSet xfs;
2568 xfs = xic_create_xfontset (f, base_fontname);
2570 attr = XVaCreateNestedList (0, XNFontSet, xfs, NULL);
2571 if (FRAME_XIC_STYLE (f) & XIMPreeditPosition)
2572 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
2573 if (FRAME_XIC_STYLE (f) & XIMStatusArea)
2574 XSetICValues (FRAME_XIC (f), XNStatusAttributes, attr, NULL);
2575 XFree (attr);
2577 if (FRAME_XIC_FONTSET (f))
2578 XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
2579 FRAME_XIC_FONTSET (f) = xfs;
2582 #endif /* HAVE_X_I18N */
2586 #ifdef USE_X_TOOLKIT
2588 /* Create and set up the X widget for frame F. */
2590 static void
2591 x_window (f, window_prompting, minibuffer_only)
2592 struct frame *f;
2593 long window_prompting;
2594 int minibuffer_only;
2596 XClassHint class_hints;
2597 XSetWindowAttributes attributes;
2598 unsigned long attribute_mask;
2599 Widget shell_widget;
2600 Widget pane_widget;
2601 Widget frame_widget;
2602 Arg al [25];
2603 int ac;
2605 BLOCK_INPUT;
2607 /* Use the resource name as the top-level widget name
2608 for looking up resources. Make a non-Lisp copy
2609 for the window manager, so GC relocation won't bother it.
2611 Elsewhere we specify the window name for the window manager. */
2614 char *str = (char *) SDATA (Vx_resource_name);
2615 f->namebuf = (char *) xmalloc (strlen (str) + 1);
2616 strcpy (f->namebuf, str);
2619 ac = 0;
2620 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
2621 XtSetArg (al[ac], XtNinput, 1); ac++;
2622 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2623 XtSetArg (al[ac], XtNborderWidth, f->border_width); ac++;
2624 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
2625 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
2626 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
2627 shell_widget = XtAppCreateShell (f->namebuf, EMACS_CLASS,
2628 applicationShellWidgetClass,
2629 FRAME_X_DISPLAY (f), al, ac);
2631 f->output_data.x->widget = shell_widget;
2632 /* maybe_set_screen_title_format (shell_widget); */
2634 pane_widget = lw_create_widget ("main", "pane", widget_id_tick++,
2635 (widget_value *) NULL,
2636 shell_widget, False,
2637 (lw_callback) NULL,
2638 (lw_callback) NULL,
2639 (lw_callback) NULL,
2640 (lw_callback) NULL);
2642 ac = 0;
2643 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
2644 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
2645 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
2646 XtSetValues (pane_widget, al, ac);
2647 f->output_data.x->column_widget = pane_widget;
2649 /* mappedWhenManaged to false tells to the paned window to not map/unmap
2650 the emacs screen when changing menubar. This reduces flickering. */
2652 ac = 0;
2653 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2654 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
2655 XtSetArg (al[ac], XtNallowResize, 1); ac++;
2656 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
2657 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
2658 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
2659 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
2660 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
2661 frame_widget = XtCreateWidget (f->namebuf, emacsFrameClass, pane_widget,
2662 al, ac);
2664 f->output_data.x->edit_widget = frame_widget;
2666 XtManageChild (frame_widget);
2668 /* Do some needed geometry management. */
2670 int len;
2671 char *tem, shell_position[32];
2672 Arg al[10];
2673 int ac = 0;
2674 int extra_borders = 0;
2675 int menubar_size
2676 = (f->output_data.x->menubar_widget
2677 ? (f->output_data.x->menubar_widget->core.height
2678 + f->output_data.x->menubar_widget->core.border_width)
2679 : 0);
2681 #if 0 /* Experimentally, we now get the right results
2682 for -geometry -0-0 without this. 24 Aug 96, rms. */
2683 if (FRAME_EXTERNAL_MENU_BAR (f))
2685 Dimension ibw = 0;
2686 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
2687 menubar_size += ibw;
2689 #endif
2691 f->output_data.x->menubar_height = menubar_size;
2693 #ifndef USE_LUCID
2694 /* Motif seems to need this amount added to the sizes
2695 specified for the shell widget. The Athena/Lucid widgets don't.
2696 Both conclusions reached experimentally. -- rms. */
2697 XtVaGetValues (f->output_data.x->edit_widget, XtNinternalBorderWidth,
2698 &extra_borders, NULL);
2699 extra_borders *= 2;
2700 #endif
2702 /* Convert our geometry parameters into a geometry string
2703 and specify it.
2704 Note that we do not specify here whether the position
2705 is a user-specified or program-specified one.
2706 We pass that information later, in x_wm_set_size_hints. */
2708 int left = f->left_pos;
2709 int xneg = window_prompting & XNegative;
2710 int top = f->top_pos;
2711 int yneg = window_prompting & YNegative;
2712 if (xneg)
2713 left = -left;
2714 if (yneg)
2715 top = -top;
2717 if (window_prompting & USPosition)
2718 sprintf (shell_position, "=%dx%d%c%d%c%d",
2719 FRAME_PIXEL_WIDTH (f) + extra_borders,
2720 FRAME_PIXEL_HEIGHT (f) + menubar_size + extra_borders,
2721 (xneg ? '-' : '+'), left,
2722 (yneg ? '-' : '+'), top);
2723 else
2725 sprintf (shell_position, "=%dx%d",
2726 FRAME_PIXEL_WIDTH (f) + extra_borders,
2727 FRAME_PIXEL_HEIGHT (f) + menubar_size + extra_borders);
2729 /* Setting x and y when the position is not specified in
2730 the geometry string will set program position in the WM hints.
2731 If Emacs had just one program position, we could set it in
2732 fallback resources, but since each make-frame call can specify
2733 different program positions, this is easier. */
2734 XtSetArg (al[ac], XtNx, left); ac++;
2735 XtSetArg (al[ac], XtNy, top); ac++;
2739 len = strlen (shell_position) + 1;
2740 /* We don't free this because we don't know whether
2741 it is safe to free it while the frame exists.
2742 It isn't worth the trouble of arranging to free it
2743 when the frame is deleted. */
2744 tem = (char *) xmalloc (len);
2745 strncpy (tem, shell_position, len);
2746 XtSetArg (al[ac], XtNgeometry, tem); ac++;
2747 XtSetValues (shell_widget, al, ac);
2750 XtManageChild (pane_widget);
2751 XtRealizeWidget (shell_widget);
2753 FRAME_X_WINDOW (f) = XtWindow (frame_widget);
2755 validate_x_resource_name ();
2757 class_hints.res_name = (char *) SDATA (Vx_resource_name);
2758 class_hints.res_class = (char *) SDATA (Vx_resource_class);
2759 XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
2761 #ifdef HAVE_X_I18N
2762 FRAME_XIC (f) = NULL;
2763 if (use_xim)
2764 create_frame_xic (f);
2765 #endif
2767 f->output_data.x->wm_hints.input = True;
2768 f->output_data.x->wm_hints.flags |= InputHint;
2769 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2770 &f->output_data.x->wm_hints);
2772 hack_wm_protocols (f, shell_widget);
2774 #ifdef HACK_EDITRES
2775 XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
2776 #endif
2778 /* Do a stupid property change to force the server to generate a
2779 PropertyNotify event so that the event_stream server timestamp will
2780 be initialized to something relevant to the time we created the window.
2782 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
2783 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2784 XA_ATOM, 32, PropModeAppend,
2785 (unsigned char*) NULL, 0);
2787 /* Make all the standard events reach the Emacs frame. */
2788 attributes.event_mask = STANDARD_EVENT_SET;
2790 #ifdef HAVE_X_I18N
2791 if (FRAME_XIC (f))
2793 /* XIM server might require some X events. */
2794 unsigned long fevent = NoEventMask;
2795 XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
2796 attributes.event_mask |= fevent;
2798 #endif /* HAVE_X_I18N */
2800 attribute_mask = CWEventMask;
2801 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
2802 attribute_mask, &attributes);
2804 XtMapWidget (frame_widget);
2806 /* x_set_name normally ignores requests to set the name if the
2807 requested name is the same as the current name. This is the one
2808 place where that assumption isn't correct; f->name is set, but
2809 the X server hasn't been told. */
2811 Lisp_Object name;
2812 int explicit = f->explicit_name;
2814 f->explicit_name = 0;
2815 name = f->name;
2816 f->name = Qnil;
2817 x_set_name (f, name, explicit);
2820 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2821 f->output_data.x->text_cursor);
2823 UNBLOCK_INPUT;
2825 /* This is a no-op, except under Motif. Make sure main areas are
2826 set to something reasonable, in case we get an error later. */
2827 lw_set_main_areas (pane_widget, 0, frame_widget);
2830 #else /* not USE_X_TOOLKIT */
2831 #ifdef USE_GTK
2832 void
2833 x_window (f)
2834 FRAME_PTR f;
2836 if (! xg_create_frame_widgets (f))
2837 error ("Unable to create window");
2839 #ifdef HAVE_X_I18N
2840 FRAME_XIC (f) = NULL;
2841 if (use_xim)
2843 BLOCK_INPUT;
2844 create_frame_xic (f);
2845 if (FRAME_XIC (f))
2847 /* XIM server might require some X events. */
2848 unsigned long fevent = NoEventMask;
2849 XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
2851 if (fevent != NoEventMask)
2853 XSetWindowAttributes attributes;
2854 XWindowAttributes wattr;
2855 unsigned long attribute_mask;
2857 XGetWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2858 &wattr);
2859 attributes.event_mask = wattr.your_event_mask | fevent;
2860 attribute_mask = CWEventMask;
2861 XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2862 attribute_mask, &attributes);
2865 UNBLOCK_INPUT;
2867 #endif
2870 #else /*! USE_GTK */
2871 /* Create and set up the X window for frame F. */
2873 void
2874 x_window (f)
2875 struct frame *f;
2878 XClassHint class_hints;
2879 XSetWindowAttributes attributes;
2880 unsigned long attribute_mask;
2882 attributes.background_pixel = f->output_data.x->background_pixel;
2883 attributes.border_pixel = f->output_data.x->border_pixel;
2884 attributes.bit_gravity = StaticGravity;
2885 attributes.backing_store = NotUseful;
2886 attributes.save_under = True;
2887 attributes.event_mask = STANDARD_EVENT_SET;
2888 attributes.colormap = FRAME_X_COLORMAP (f);
2889 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity | CWEventMask
2890 | CWColormap);
2892 BLOCK_INPUT;
2893 FRAME_X_WINDOW (f)
2894 = XCreateWindow (FRAME_X_DISPLAY (f),
2895 f->output_data.x->parent_desc,
2896 f->left_pos,
2897 f->top_pos,
2898 FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f),
2899 f->border_width,
2900 CopyFromParent, /* depth */
2901 InputOutput, /* class */
2902 FRAME_X_VISUAL (f),
2903 attribute_mask, &attributes);
2905 #ifdef HAVE_X_I18N
2906 if (use_xim)
2908 create_frame_xic (f);
2909 if (FRAME_XIC (f))
2911 /* XIM server might require some X events. */
2912 unsigned long fevent = NoEventMask;
2913 XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
2914 attributes.event_mask |= fevent;
2915 attribute_mask = CWEventMask;
2916 XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2917 attribute_mask, &attributes);
2920 #endif /* HAVE_X_I18N */
2922 validate_x_resource_name ();
2924 class_hints.res_name = (char *) SDATA (Vx_resource_name);
2925 class_hints.res_class = (char *) SDATA (Vx_resource_class);
2926 XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
2928 /* The menubar is part of the ordinary display;
2929 it does not count in addition to the height of the window. */
2930 f->output_data.x->menubar_height = 0;
2932 /* This indicates that we use the "Passive Input" input model.
2933 Unless we do this, we don't get the Focus{In,Out} events that we
2934 need to draw the cursor correctly. Accursed bureaucrats.
2935 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
2937 f->output_data.x->wm_hints.input = True;
2938 f->output_data.x->wm_hints.flags |= InputHint;
2939 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2940 &f->output_data.x->wm_hints);
2941 f->output_data.x->wm_hints.icon_pixmap = None;
2943 /* Request "save yourself" and "delete window" commands from wm. */
2945 Atom protocols[2];
2946 protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2947 protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2948 XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
2951 /* x_set_name normally ignores requests to set the name if the
2952 requested name is the same as the current name. This is the one
2953 place where that assumption isn't correct; f->name is set, but
2954 the X server hasn't been told. */
2956 Lisp_Object name;
2957 int explicit = f->explicit_name;
2959 f->explicit_name = 0;
2960 name = f->name;
2961 f->name = Qnil;
2962 x_set_name (f, name, explicit);
2965 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2966 f->output_data.x->text_cursor);
2968 UNBLOCK_INPUT;
2970 if (FRAME_X_WINDOW (f) == 0)
2971 error ("Unable to create window");
2974 #endif /* not USE_GTK */
2975 #endif /* not USE_X_TOOLKIT */
2977 /* Handle the icon stuff for this window. Perhaps later we might
2978 want an x_set_icon_position which can be called interactively as
2979 well. */
2981 static void
2982 x_icon (f, parms)
2983 struct frame *f;
2984 Lisp_Object parms;
2986 Lisp_Object icon_x, icon_y;
2987 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2989 /* Set the position of the icon. Note that twm groups all
2990 icons in an icon window. */
2991 icon_x = x_frame_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
2992 icon_y = x_frame_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
2993 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
2995 CHECK_NUMBER (icon_x);
2996 CHECK_NUMBER (icon_y);
2998 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
2999 error ("Both left and top icon corners of icon must be specified");
3001 BLOCK_INPUT;
3003 if (! EQ (icon_x, Qunbound))
3004 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
3006 /* Start up iconic or window? */
3007 x_wm_set_window_state
3008 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL),
3009 Qicon)
3010 ? IconicState
3011 : NormalState));
3013 x_text_icon (f, (char *) SDATA ((!NILP (f->icon_name)
3014 ? f->icon_name
3015 : f->name)));
3017 UNBLOCK_INPUT;
3020 /* Make the GCs needed for this window, setting the
3021 background, border and mouse colors; also create the
3022 mouse cursor and the gray border tile. */
3024 static char cursor_bits[] =
3026 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3027 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3028 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3029 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3032 static void
3033 x_make_gc (f)
3034 struct frame *f;
3036 XGCValues gc_values;
3038 BLOCK_INPUT;
3040 /* Create the GCs of this frame.
3041 Note that many default values are used. */
3043 /* Normal video */
3044 gc_values.font = FRAME_FONT (f)->fid;
3045 gc_values.foreground = f->output_data.x->foreground_pixel;
3046 gc_values.background = f->output_data.x->background_pixel;
3047 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
3048 f->output_data.x->normal_gc
3049 = XCreateGC (FRAME_X_DISPLAY (f),
3050 FRAME_X_WINDOW (f),
3051 GCLineWidth | GCFont | GCForeground | GCBackground,
3052 &gc_values);
3054 /* Reverse video style. */
3055 gc_values.foreground = f->output_data.x->background_pixel;
3056 gc_values.background = f->output_data.x->foreground_pixel;
3057 f->output_data.x->reverse_gc
3058 = XCreateGC (FRAME_X_DISPLAY (f),
3059 FRAME_X_WINDOW (f),
3060 GCFont | GCForeground | GCBackground | GCLineWidth,
3061 &gc_values);
3063 /* Cursor has cursor-color background, background-color foreground. */
3064 gc_values.foreground = f->output_data.x->background_pixel;
3065 gc_values.background = f->output_data.x->cursor_pixel;
3066 gc_values.fill_style = FillOpaqueStippled;
3067 gc_values.stipple
3068 = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
3069 FRAME_X_DISPLAY_INFO (f)->root_window,
3070 cursor_bits, 16, 16);
3071 f->output_data.x->cursor_gc
3072 = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3073 (GCFont | GCForeground | GCBackground
3074 | GCFillStyle /* | GCStipple */ | GCLineWidth),
3075 &gc_values);
3077 /* Reliefs. */
3078 f->output_data.x->white_relief.gc = 0;
3079 f->output_data.x->black_relief.gc = 0;
3081 /* Create the gray border tile used when the pointer is not in
3082 the frame. Since this depends on the frame's pixel values,
3083 this must be done on a per-frame basis. */
3084 f->output_data.x->border_tile
3085 = (XCreatePixmapFromBitmapData
3086 (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
3087 gray_bits, gray_width, gray_height,
3088 f->output_data.x->foreground_pixel,
3089 f->output_data.x->background_pixel,
3090 DefaultDepth (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f))));
3092 UNBLOCK_INPUT;
3096 /* Free what was was allocated in x_make_gc. */
3098 void
3099 x_free_gcs (f)
3100 struct frame *f;
3102 Display *dpy = FRAME_X_DISPLAY (f);
3104 BLOCK_INPUT;
3106 if (f->output_data.x->normal_gc)
3108 XFreeGC (dpy, f->output_data.x->normal_gc);
3109 f->output_data.x->normal_gc = 0;
3112 if (f->output_data.x->reverse_gc)
3114 XFreeGC (dpy, f->output_data.x->reverse_gc);
3115 f->output_data.x->reverse_gc = 0;
3118 if (f->output_data.x->cursor_gc)
3120 XFreeGC (dpy, f->output_data.x->cursor_gc);
3121 f->output_data.x->cursor_gc = 0;
3124 if (f->output_data.x->border_tile)
3126 XFreePixmap (dpy, f->output_data.x->border_tile);
3127 f->output_data.x->border_tile = 0;
3130 UNBLOCK_INPUT;
3134 /* Handler for signals raised during x_create_frame and
3135 x_create_top_frame. FRAME is the frame which is partially
3136 constructed. */
3138 static Lisp_Object
3139 unwind_create_frame (frame)
3140 Lisp_Object frame;
3142 struct frame *f = XFRAME (frame);
3144 /* If frame is ``official'', nothing to do. */
3145 if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
3147 #if GLYPH_DEBUG
3148 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3149 #endif
3151 x_free_frame_resources (f);
3153 /* Check that reference counts are indeed correct. */
3154 xassert (dpyinfo->reference_count == dpyinfo_refcount);
3155 xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
3156 return Qt;
3159 return Qnil;
3163 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
3164 1, 1, 0,
3165 doc: /* Make a new X window, which is called a "frame" in Emacs terms.
3166 Returns an Emacs frame object.
3167 ALIST is an alist of frame parameters.
3168 If the parameters specify that the frame should not have a minibuffer,
3169 and do not specify a specific minibuffer window to use,
3170 then `default-minibuffer-frame' must be a frame whose minibuffer can
3171 be shared by the new frame.
3173 This function is an internal primitive--use `make-frame' instead. */)
3174 (parms)
3175 Lisp_Object parms;
3177 struct frame *f;
3178 Lisp_Object frame, tem;
3179 Lisp_Object name;
3180 int minibuffer_only = 0;
3181 long window_prompting = 0;
3182 int width, height;
3183 int count = SPECPDL_INDEX ();
3184 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3185 Lisp_Object display;
3186 struct x_display_info *dpyinfo = NULL;
3187 Lisp_Object parent;
3188 struct kboard *kb;
3190 check_x ();
3192 /* Use this general default value to start with
3193 until we know if this frame has a specified name. */
3194 Vx_resource_name = Vinvocation_name;
3196 display = x_get_arg (dpyinfo, parms, Qdisplay, 0, 0, RES_TYPE_STRING);
3197 if (EQ (display, Qunbound))
3198 display = Qnil;
3199 dpyinfo = check_x_display_info (display);
3200 #ifdef MULTI_KBOARD
3201 kb = dpyinfo->kboard;
3202 #else
3203 kb = &the_only_kboard;
3204 #endif
3206 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
3207 if (!STRINGP (name)
3208 && ! EQ (name, Qunbound)
3209 && ! NILP (name))
3210 error ("Invalid frame name--not a string or nil");
3212 if (STRINGP (name))
3213 Vx_resource_name = name;
3215 /* See if parent window is specified. */
3216 parent = x_get_arg (dpyinfo, parms, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
3217 if (EQ (parent, Qunbound))
3218 parent = Qnil;
3219 if (! NILP (parent))
3220 CHECK_NUMBER (parent);
3222 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3223 /* No need to protect DISPLAY because that's not used after passing
3224 it to make_frame_without_minibuffer. */
3225 frame = Qnil;
3226 GCPRO4 (parms, parent, name, frame);
3227 tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
3228 RES_TYPE_SYMBOL);
3229 if (EQ (tem, Qnone) || NILP (tem))
3230 f = make_frame_without_minibuffer (Qnil, kb, display);
3231 else if (EQ (tem, Qonly))
3233 f = make_minibuffer_frame ();
3234 minibuffer_only = 1;
3236 else if (WINDOWP (tem))
3237 f = make_frame_without_minibuffer (tem, kb, display);
3238 else
3239 f = make_frame (1);
3241 XSETFRAME (frame, f);
3243 /* Note that X Windows does support scroll bars. */
3244 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
3246 f->output_method = output_x_window;
3247 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
3248 bzero (f->output_data.x, sizeof (struct x_output));
3249 f->output_data.x->icon_bitmap = -1;
3250 FRAME_FONTSET (f) = -1;
3251 f->output_data.x->scroll_bar_foreground_pixel = -1;
3252 f->output_data.x->scroll_bar_background_pixel = -1;
3253 #ifdef USE_TOOLKIT_SCROLL_BARS
3254 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
3255 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
3256 #endif /* USE_TOOLKIT_SCROLL_BARS */
3257 record_unwind_protect (unwind_create_frame, frame);
3259 f->icon_name
3260 = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
3261 RES_TYPE_STRING);
3262 if (! STRINGP (f->icon_name))
3263 f->icon_name = Qnil;
3265 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
3266 #if GLYPH_DEBUG
3267 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
3268 dpyinfo_refcount = dpyinfo->reference_count;
3269 #endif /* GLYPH_DEBUG */
3270 #ifdef MULTI_KBOARD
3271 FRAME_KBOARD (f) = kb;
3272 #endif
3274 /* These colors will be set anyway later, but it's important
3275 to get the color reference counts right, so initialize them! */
3277 Lisp_Object black;
3278 struct gcpro gcpro1;
3280 /* Function x_decode_color can signal an error. Make
3281 sure to initialize color slots so that we won't try
3282 to free colors we haven't allocated. */
3283 f->output_data.x->foreground_pixel = -1;
3284 f->output_data.x->background_pixel = -1;
3285 f->output_data.x->cursor_pixel = -1;
3286 f->output_data.x->cursor_foreground_pixel = -1;
3287 f->output_data.x->border_pixel = -1;
3288 f->output_data.x->mouse_pixel = -1;
3290 black = build_string ("black");
3291 GCPRO1 (black);
3292 f->output_data.x->foreground_pixel
3293 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3294 f->output_data.x->background_pixel
3295 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3296 f->output_data.x->cursor_pixel
3297 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3298 f->output_data.x->cursor_foreground_pixel
3299 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3300 f->output_data.x->border_pixel
3301 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3302 f->output_data.x->mouse_pixel
3303 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3304 UNGCPRO;
3307 /* Specify the parent under which to make this X window. */
3309 if (!NILP (parent))
3311 f->output_data.x->parent_desc = (Window) XFASTINT (parent);
3312 f->output_data.x->explicit_parent = 1;
3314 else
3316 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3317 f->output_data.x->explicit_parent = 0;
3320 /* Set the name; the functions to which we pass f expect the name to
3321 be set. */
3322 if (EQ (name, Qunbound) || NILP (name))
3324 f->name = build_string (dpyinfo->x_id_name);
3325 f->explicit_name = 0;
3327 else
3329 f->name = name;
3330 f->explicit_name = 1;
3331 /* use the frame's title when getting resources for this frame. */
3332 specbind (Qx_resource_name, name);
3335 /* Extract the window parameters from the supplied values
3336 that are needed to determine window geometry. */
3338 Lisp_Object font;
3340 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
3342 BLOCK_INPUT;
3343 /* First, try whatever font the caller has specified. */
3344 if (STRINGP (font))
3346 tem = Fquery_fontset (font, Qnil);
3347 if (STRINGP (tem))
3348 font = x_new_fontset (f, SDATA (tem));
3349 else
3350 font = x_new_font (f, SDATA (font));
3353 /* Try out a font which we hope has bold and italic variations. */
3354 if (!STRINGP (font))
3355 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
3356 if (!STRINGP (font))
3357 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3358 if (! STRINGP (font))
3359 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3360 if (! STRINGP (font))
3361 /* This was formerly the first thing tried, but it finds too many fonts
3362 and takes too long. */
3363 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3364 /* If those didn't work, look for something which will at least work. */
3365 if (! STRINGP (font))
3366 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3367 UNBLOCK_INPUT;
3368 if (! STRINGP (font))
3369 font = build_string ("fixed");
3371 x_default_parameter (f, parms, Qfont, font,
3372 "font", "Font", RES_TYPE_STRING);
3375 #ifdef USE_LUCID
3376 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3377 whereby it fails to get any font. */
3378 xlwmenu_default_font = FRAME_FONT (f);
3379 #endif
3381 x_default_parameter (f, parms, Qborder_width, make_number (2),
3382 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
3384 /* This defaults to 1 in order to match xterm. We recognize either
3385 internalBorderWidth or internalBorder (which is what xterm calls
3386 it). */
3387 if (NILP (Fassq (Qinternal_border_width, parms)))
3389 Lisp_Object value;
3391 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
3392 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
3393 if (! EQ (value, Qunbound))
3394 parms = Fcons (Fcons (Qinternal_border_width, value),
3395 parms);
3397 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
3398 "internalBorderWidth", "internalBorderWidth",
3399 RES_TYPE_NUMBER);
3400 x_default_parameter (f, parms, Qvertical_scroll_bars, Qleft,
3401 "verticalScrollBars", "ScrollBars",
3402 RES_TYPE_SYMBOL);
3404 /* Also do the stuff which must be set before the window exists. */
3405 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
3406 "foreground", "Foreground", RES_TYPE_STRING);
3407 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
3408 "background", "Background", RES_TYPE_STRING);
3409 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
3410 "pointerColor", "Foreground", RES_TYPE_STRING);
3411 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
3412 "cursorColor", "Foreground", RES_TYPE_STRING);
3413 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
3414 "borderColor", "BorderColor", RES_TYPE_STRING);
3415 x_default_parameter (f, parms, Qscreen_gamma, Qnil,
3416 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
3417 x_default_parameter (f, parms, Qline_spacing, Qnil,
3418 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
3419 x_default_parameter (f, parms, Qleft_fringe, Qnil,
3420 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
3421 x_default_parameter (f, parms, Qright_fringe, Qnil,
3422 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
3424 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_foreground,
3425 "scrollBarForeground",
3426 "ScrollBarForeground", 1);
3427 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_background,
3428 "scrollBarBackground",
3429 "ScrollBarBackground", 0);
3431 /* Init faces before x_default_parameter is called for scroll-bar
3432 parameters because that function calls x_set_scroll_bar_width,
3433 which calls change_frame_size, which calls Fset_window_buffer,
3434 which runs hooks, which call Fvertical_motion. At the end, we
3435 end up in init_iterator with a null face cache, which should not
3436 happen. */
3437 init_frame_faces (f);
3439 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
3440 "menuBar", "MenuBar", RES_TYPE_NUMBER);
3441 x_default_parameter (f, parms, Qtool_bar_lines, make_number (1),
3442 "toolBar", "ToolBar", RES_TYPE_NUMBER);
3443 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
3444 "bufferPredicate", "BufferPredicate",
3445 RES_TYPE_SYMBOL);
3446 x_default_parameter (f, parms, Qtitle, Qnil,
3447 "title", "Title", RES_TYPE_STRING);
3448 x_default_parameter (f, parms, Qwait_for_wm, Qt,
3449 "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN);
3450 x_default_parameter (f, parms, Qfullscreen, Qnil,
3451 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
3453 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3455 /* Compute the size of the X window. */
3456 window_prompting = x_figure_window_size (f, parms, 1);
3458 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
3459 f->no_split = minibuffer_only || EQ (tem, Qt);
3461 /* Create the X widget or window. */
3462 #ifdef USE_X_TOOLKIT
3463 x_window (f, window_prompting, minibuffer_only);
3464 #else
3465 x_window (f);
3466 #endif
3468 x_icon (f, parms);
3469 x_make_gc (f);
3471 /* Now consider the frame official. */
3472 FRAME_X_DISPLAY_INFO (f)->reference_count++;
3473 Vframe_list = Fcons (frame, Vframe_list);
3475 /* We need to do this after creating the X window, so that the
3476 icon-creation functions can say whose icon they're describing. */
3477 x_default_parameter (f, parms, Qicon_type, Qnil,
3478 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
3480 x_default_parameter (f, parms, Qauto_raise, Qnil,
3481 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
3482 x_default_parameter (f, parms, Qauto_lower, Qnil,
3483 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
3484 x_default_parameter (f, parms, Qcursor_type, Qbox,
3485 "cursorType", "CursorType", RES_TYPE_SYMBOL);
3486 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
3487 "scrollBarWidth", "ScrollBarWidth",
3488 RES_TYPE_NUMBER);
3490 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
3491 Change will not be effected unless different from the current
3492 FRAME_LINES (f). */
3493 width = FRAME_COLS (f);
3494 height = FRAME_LINES (f);
3496 SET_FRAME_COLS (f, 0);
3497 FRAME_LINES (f) = 0;
3498 change_frame_size (f, height, width, 1, 0, 0);
3500 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
3501 /* Create the menu bar. */
3502 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
3504 /* If this signals an error, we haven't set size hints for the
3505 frame and we didn't make it visible. */
3506 initialize_frame_menubar (f);
3508 #ifndef USE_GTK
3509 /* This is a no-op, except under Motif where it arranges the
3510 main window for the widgets on it. */
3511 lw_set_main_areas (f->output_data.x->column_widget,
3512 f->output_data.x->menubar_widget,
3513 f->output_data.x->edit_widget);
3514 #endif /* not USE_GTK */
3516 #endif /* USE_X_TOOLKIT || USE_GTK */
3518 /* Tell the server what size and position, etc, we want, and how
3519 badly we want them. This should be done after we have the menu
3520 bar so that its size can be taken into account. */
3521 BLOCK_INPUT;
3522 x_wm_set_size_hint (f, window_prompting, 0);
3523 UNBLOCK_INPUT;
3525 /* Make the window appear on the frame and enable display, unless
3526 the caller says not to. However, with explicit parent, Emacs
3527 cannot control visibility, so don't try. */
3528 if (! f->output_data.x->explicit_parent)
3530 Lisp_Object visibility;
3532 visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
3533 RES_TYPE_SYMBOL);
3534 if (EQ (visibility, Qunbound))
3535 visibility = Qt;
3537 if (EQ (visibility, Qicon))
3538 x_iconify_frame (f);
3539 else if (! NILP (visibility))
3540 x_make_frame_visible (f);
3541 else
3542 /* Must have been Qnil. */
3546 /* Set the WM leader property. GTK does this itself, so this is not
3547 needed when using GTK. */
3548 if (dpyinfo->client_leader_window != 0)
3550 BLOCK_INPUT;
3551 XChangeProperty (FRAME_X_DISPLAY (f),
3552 FRAME_OUTER_WINDOW (f),
3553 dpyinfo->Xatom_wm_client_leader,
3554 XA_WINDOW, 32, PropModeReplace,
3555 (char *) &dpyinfo->client_leader_window, 1);
3556 UNBLOCK_INPUT;
3559 UNGCPRO;
3561 /* Make sure windows on this frame appear in calls to next-window
3562 and similar functions. */
3563 Vwindow_list = Qnil;
3565 return unbind_to (count, frame);
3569 /* FRAME is used only to get a handle on the X display. We don't pass the
3570 display info directly because we're called from frame.c, which doesn't
3571 know about that structure. */
3573 Lisp_Object
3574 x_get_focus_frame (frame)
3575 struct frame *frame;
3577 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
3578 Lisp_Object xfocus;
3579 if (! dpyinfo->x_focus_frame)
3580 return Qnil;
3582 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
3583 return xfocus;
3587 /* In certain situations, when the window manager follows a
3588 click-to-focus policy, there seems to be no way around calling
3589 XSetInputFocus to give another frame the input focus .
3591 In an ideal world, XSetInputFocus should generally be avoided so
3592 that applications don't interfere with the window manager's focus
3593 policy. But I think it's okay to use when it's clearly done
3594 following a user-command. */
3596 DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
3597 doc: /* Set the input focus to FRAME.
3598 FRAME nil means use the selected frame. */)
3599 (frame)
3600 Lisp_Object frame;
3602 struct frame *f = check_x_frame (frame);
3603 Display *dpy = FRAME_X_DISPLAY (f);
3604 int count;
3606 BLOCK_INPUT;
3607 count = x_catch_errors (dpy);
3608 XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3609 RevertToParent, CurrentTime);
3610 x_uncatch_errors (dpy, count);
3611 UNBLOCK_INPUT;
3613 return Qnil;
3617 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
3618 doc: /* Internal function called by `color-defined-p', which see. */)
3619 (color, frame)
3620 Lisp_Object color, frame;
3622 XColor foo;
3623 FRAME_PTR f = check_x_frame (frame);
3625 CHECK_STRING (color);
3627 if (x_defined_color (f, SDATA (color), &foo, 0))
3628 return Qt;
3629 else
3630 return Qnil;
3633 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
3634 doc: /* Internal function called by `color-values', which see. */)
3635 (color, frame)
3636 Lisp_Object color, frame;
3638 XColor foo;
3639 FRAME_PTR f = check_x_frame (frame);
3641 CHECK_STRING (color);
3643 if (x_defined_color (f, SDATA (color), &foo, 0))
3645 Lisp_Object rgb[3];
3647 rgb[0] = make_number (foo.red);
3648 rgb[1] = make_number (foo.green);
3649 rgb[2] = make_number (foo.blue);
3650 return Flist (3, rgb);
3652 else
3653 return Qnil;
3656 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
3657 doc: /* Internal function called by `display-color-p', which see. */)
3658 (display)
3659 Lisp_Object display;
3661 struct x_display_info *dpyinfo = check_x_display_info (display);
3663 if (dpyinfo->n_planes <= 2)
3664 return Qnil;
3666 switch (dpyinfo->visual->class)
3668 case StaticColor:
3669 case PseudoColor:
3670 case TrueColor:
3671 case DirectColor:
3672 return Qt;
3674 default:
3675 return Qnil;
3679 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
3680 0, 1, 0,
3681 doc: /* Return t if the X display supports shades of gray.
3682 Note that color displays do support shades of gray.
3683 The optional argument DISPLAY specifies which display to ask about.
3684 DISPLAY should be either a frame or a display name (a string).
3685 If omitted or nil, that stands for the selected frame's display. */)
3686 (display)
3687 Lisp_Object display;
3689 struct x_display_info *dpyinfo = check_x_display_info (display);
3691 if (dpyinfo->n_planes <= 1)
3692 return Qnil;
3694 switch (dpyinfo->visual->class)
3696 case StaticColor:
3697 case PseudoColor:
3698 case TrueColor:
3699 case DirectColor:
3700 case StaticGray:
3701 case GrayScale:
3702 return Qt;
3704 default:
3705 return Qnil;
3709 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
3710 0, 1, 0,
3711 doc: /* Returns the width in pixels of the X display DISPLAY.
3712 The optional argument DISPLAY specifies which display to ask about.
3713 DISPLAY should be either a frame or a display name (a string).
3714 If omitted or nil, that stands for the selected frame's display. */)
3715 (display)
3716 Lisp_Object display;
3718 struct x_display_info *dpyinfo = check_x_display_info (display);
3720 return make_number (dpyinfo->width);
3723 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
3724 Sx_display_pixel_height, 0, 1, 0,
3725 doc: /* Returns the height in pixels of the X display DISPLAY.
3726 The optional argument DISPLAY specifies which display to ask about.
3727 DISPLAY should be either a frame or a display name (a string).
3728 If omitted or nil, that stands for the selected frame's display. */)
3729 (display)
3730 Lisp_Object display;
3732 struct x_display_info *dpyinfo = check_x_display_info (display);
3734 return make_number (dpyinfo->height);
3737 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
3738 0, 1, 0,
3739 doc: /* Returns the number of bitplanes of the X display DISPLAY.
3740 The optional argument DISPLAY specifies which display to ask about.
3741 DISPLAY should be either a frame or a display name (a string).
3742 If omitted or nil, that stands for the selected frame's display. */)
3743 (display)
3744 Lisp_Object display;
3746 struct x_display_info *dpyinfo = check_x_display_info (display);
3748 return make_number (dpyinfo->n_planes);
3751 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
3752 0, 1, 0,
3753 doc: /* Returns the number of color cells of the X display DISPLAY.
3754 The optional argument DISPLAY specifies which display to ask about.
3755 DISPLAY should be either a frame or a display name (a string).
3756 If omitted or nil, that stands for the selected frame's display. */)
3757 (display)
3758 Lisp_Object display;
3760 struct x_display_info *dpyinfo = check_x_display_info (display);
3762 return make_number (DisplayCells (dpyinfo->display,
3763 XScreenNumberOfScreen (dpyinfo->screen)));
3766 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
3767 Sx_server_max_request_size,
3768 0, 1, 0,
3769 doc: /* Returns the maximum request size of the X server of display DISPLAY.
3770 The optional argument DISPLAY specifies which display to ask about.
3771 DISPLAY should be either a frame or a display name (a string).
3772 If omitted or nil, that stands for the selected frame's display. */)
3773 (display)
3774 Lisp_Object display;
3776 struct x_display_info *dpyinfo = check_x_display_info (display);
3778 return make_number (MAXREQUEST (dpyinfo->display));
3781 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
3782 doc: /* Returns the vendor ID string of the X server of display DISPLAY.
3783 The optional argument DISPLAY specifies which display to ask about.
3784 DISPLAY should be either a frame or a display name (a string).
3785 If omitted or nil, that stands for the selected frame's display. */)
3786 (display)
3787 Lisp_Object display;
3789 struct x_display_info *dpyinfo = check_x_display_info (display);
3790 char *vendor = ServerVendor (dpyinfo->display);
3792 if (! vendor) vendor = "";
3793 return build_string (vendor);
3796 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
3797 doc: /* Returns the version numbers of the X server of display DISPLAY.
3798 The value is a list of three integers: the major and minor
3799 version numbers of the X Protocol in use, and the vendor-specific release
3800 number. See also the function `x-server-vendor'.
3802 The optional argument DISPLAY specifies which display to ask about.
3803 DISPLAY should be either a frame or a display name (a string).
3804 If omitted or nil, that stands for the selected frame's display. */)
3805 (display)
3806 Lisp_Object display;
3808 struct x_display_info *dpyinfo = check_x_display_info (display);
3809 Display *dpy = dpyinfo->display;
3811 return Fcons (make_number (ProtocolVersion (dpy)),
3812 Fcons (make_number (ProtocolRevision (dpy)),
3813 Fcons (make_number (VendorRelease (dpy)), Qnil)));
3816 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
3817 doc: /* Return the number of screens on the X server of display DISPLAY.
3818 The optional argument DISPLAY specifies which display to ask about.
3819 DISPLAY should be either a frame or a display name (a string).
3820 If omitted or nil, that stands for the selected frame's display. */)
3821 (display)
3822 Lisp_Object display;
3824 struct x_display_info *dpyinfo = check_x_display_info (display);
3826 return make_number (ScreenCount (dpyinfo->display));
3829 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
3830 doc: /* Return the height in millimeters of the X display DISPLAY.
3831 The optional argument DISPLAY specifies which display to ask about.
3832 DISPLAY should be either a frame or a display name (a string).
3833 If omitted or nil, that stands for the selected frame's display. */)
3834 (display)
3835 Lisp_Object display;
3837 struct x_display_info *dpyinfo = check_x_display_info (display);
3839 return make_number (HeightMMOfScreen (dpyinfo->screen));
3842 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
3843 doc: /* Return the width in millimeters of the X display DISPLAY.
3844 The optional argument DISPLAY specifies which display to ask about.
3845 DISPLAY should be either a frame or a display name (a string).
3846 If omitted or nil, that stands for the selected frame's display. */)
3847 (display)
3848 Lisp_Object display;
3850 struct x_display_info *dpyinfo = check_x_display_info (display);
3852 return make_number (WidthMMOfScreen (dpyinfo->screen));
3855 DEFUN ("x-display-backing-store", Fx_display_backing_store,
3856 Sx_display_backing_store, 0, 1, 0,
3857 doc: /* Returns an indication of whether X display DISPLAY does backing store.
3858 The value may be `always', `when-mapped', or `not-useful'.
3859 The optional argument DISPLAY specifies which display to ask about.
3860 DISPLAY should be either a frame or a display name (a string).
3861 If omitted or nil, that stands for the selected frame's display. */)
3862 (display)
3863 Lisp_Object display;
3865 struct x_display_info *dpyinfo = check_x_display_info (display);
3866 Lisp_Object result;
3868 switch (DoesBackingStore (dpyinfo->screen))
3870 case Always:
3871 result = intern ("always");
3872 break;
3874 case WhenMapped:
3875 result = intern ("when-mapped");
3876 break;
3878 case NotUseful:
3879 result = intern ("not-useful");
3880 break;
3882 default:
3883 error ("Strange value for BackingStore parameter of screen");
3884 result = Qnil;
3887 return result;
3890 DEFUN ("x-display-visual-class", Fx_display_visual_class,
3891 Sx_display_visual_class, 0, 1, 0,
3892 doc: /* Return the visual class of the X display DISPLAY.
3893 The value is one of the symbols `static-gray', `gray-scale',
3894 `static-color', `pseudo-color', `true-color', or `direct-color'.
3896 The optional argument DISPLAY specifies which display to ask about.
3897 DISPLAY should be either a frame or a display name (a string).
3898 If omitted or nil, that stands for the selected frame's display. */)
3899 (display)
3900 Lisp_Object display;
3902 struct x_display_info *dpyinfo = check_x_display_info (display);
3903 Lisp_Object result;
3905 switch (dpyinfo->visual->class)
3907 case StaticGray:
3908 result = intern ("static-gray");
3909 break;
3910 case GrayScale:
3911 result = intern ("gray-scale");
3912 break;
3913 case StaticColor:
3914 result = intern ("static-color");
3915 break;
3916 case PseudoColor:
3917 result = intern ("pseudo-color");
3918 break;
3919 case TrueColor:
3920 result = intern ("true-color");
3921 break;
3922 case DirectColor:
3923 result = intern ("direct-color");
3924 break;
3925 default:
3926 error ("Display has an unknown visual class");
3927 result = Qnil;
3930 return result;
3933 DEFUN ("x-display-save-under", Fx_display_save_under,
3934 Sx_display_save_under, 0, 1, 0,
3935 doc: /* Returns t if the X display DISPLAY supports the save-under feature.
3936 The optional argument DISPLAY specifies which display to ask about.
3937 DISPLAY should be either a frame or a display name (a string).
3938 If omitted or nil, that stands for the selected frame's display. */)
3939 (display)
3940 Lisp_Object display;
3942 struct x_display_info *dpyinfo = check_x_display_info (display);
3944 if (DoesSaveUnders (dpyinfo->screen) == True)
3945 return Qt;
3946 else
3947 return Qnil;
3951 x_pixel_width (f)
3952 register struct frame *f;
3954 return FRAME_PIXEL_WIDTH (f);
3958 x_pixel_height (f)
3959 register struct frame *f;
3961 return FRAME_PIXEL_HEIGHT (f);
3965 x_char_width (f)
3966 register struct frame *f;
3968 return FRAME_COLUMN_WIDTH (f);
3972 x_char_height (f)
3973 register struct frame *f;
3975 return FRAME_LINE_HEIGHT (f);
3979 x_screen_planes (f)
3980 register struct frame *f;
3982 return FRAME_X_DISPLAY_INFO (f)->n_planes;
3987 /************************************************************************
3988 X Displays
3989 ************************************************************************/
3992 /* Mapping visual names to visuals. */
3994 static struct visual_class
3996 char *name;
3997 int class;
3999 visual_classes[] =
4001 {"StaticGray", StaticGray},
4002 {"GrayScale", GrayScale},
4003 {"StaticColor", StaticColor},
4004 {"PseudoColor", PseudoColor},
4005 {"TrueColor", TrueColor},
4006 {"DirectColor", DirectColor},
4007 {NULL, 0}
4011 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4013 /* Value is the screen number of screen SCR. This is a substitute for
4014 the X function with the same name when that doesn't exist. */
4017 XScreenNumberOfScreen (scr)
4018 register Screen *scr;
4020 Display *dpy = scr->display;
4021 int i;
4023 for (i = 0; i < dpy->nscreens; ++i)
4024 if (scr == dpy->screens + i)
4025 break;
4027 return i;
4030 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4033 /* Select the visual that should be used on display DPYINFO. Set
4034 members of DPYINFO appropriately. Called from x_term_init. */
4036 void
4037 select_visual (dpyinfo)
4038 struct x_display_info *dpyinfo;
4040 Display *dpy = dpyinfo->display;
4041 Screen *screen = dpyinfo->screen;
4042 Lisp_Object value;
4044 /* See if a visual is specified. */
4045 value = display_x_get_resource (dpyinfo,
4046 build_string ("visualClass"),
4047 build_string ("VisualClass"),
4048 Qnil, Qnil);
4049 if (STRINGP (value))
4051 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4052 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4053 depth, a decimal number. NAME is compared with case ignored. */
4054 char *s = (char *) alloca (SBYTES (value) + 1);
4055 char *dash;
4056 int i, class = -1;
4057 XVisualInfo vinfo;
4059 strcpy (s, SDATA (value));
4060 dash = index (s, '-');
4061 if (dash)
4063 dpyinfo->n_planes = atoi (dash + 1);
4064 *dash = '\0';
4066 else
4067 /* We won't find a matching visual with depth 0, so that
4068 an error will be printed below. */
4069 dpyinfo->n_planes = 0;
4071 /* Determine the visual class. */
4072 for (i = 0; visual_classes[i].name; ++i)
4073 if (xstricmp (s, visual_classes[i].name) == 0)
4075 class = visual_classes[i].class;
4076 break;
4079 /* Look up a matching visual for the specified class. */
4080 if (class == -1
4081 || !XMatchVisualInfo (dpy, XScreenNumberOfScreen (screen),
4082 dpyinfo->n_planes, class, &vinfo))
4083 fatal ("Invalid visual specification `%s'", SDATA (value));
4085 dpyinfo->visual = vinfo.visual;
4087 else
4089 int n_visuals;
4090 XVisualInfo *vinfo, vinfo_template;
4092 dpyinfo->visual = DefaultVisualOfScreen (screen);
4094 #ifdef HAVE_X11R4
4095 vinfo_template.visualid = XVisualIDFromVisual (dpyinfo->visual);
4096 #else
4097 vinfo_template.visualid = dpyinfo->visual->visualid;
4098 #endif
4099 vinfo_template.screen = XScreenNumberOfScreen (screen);
4100 vinfo = XGetVisualInfo (dpy, VisualIDMask | VisualScreenMask,
4101 &vinfo_template, &n_visuals);
4102 if (n_visuals != 1)
4103 fatal ("Can't get proper X visual info");
4105 dpyinfo->n_planes = vinfo->depth;
4106 XFree ((char *) vinfo);
4111 /* Return the X display structure for the display named NAME.
4112 Open a new connection if necessary. */
4114 struct x_display_info *
4115 x_display_info_for_name (name)
4116 Lisp_Object name;
4118 Lisp_Object names;
4119 struct x_display_info *dpyinfo;
4121 CHECK_STRING (name);
4123 if (! EQ (Vwindow_system, intern ("x")))
4124 error ("Not using X Windows");
4126 for (dpyinfo = x_display_list, names = x_display_name_list;
4127 dpyinfo;
4128 dpyinfo = dpyinfo->next, names = XCDR (names))
4130 Lisp_Object tem;
4131 tem = Fstring_equal (XCAR (XCAR (names)), name);
4132 if (!NILP (tem))
4133 return dpyinfo;
4136 /* Use this general default value to start with. */
4137 Vx_resource_name = Vinvocation_name;
4139 validate_x_resource_name ();
4141 dpyinfo = x_term_init (name, (char *)0,
4142 (char *) SDATA (Vx_resource_name));
4144 if (dpyinfo == 0)
4145 error ("Cannot connect to X server %s", SDATA (name));
4147 x_in_use = 1;
4148 XSETFASTINT (Vwindow_system_version, 11);
4150 return dpyinfo;
4154 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4155 1, 3, 0,
4156 doc: /* Open a connection to an X server.
4157 DISPLAY is the name of the display to connect to.
4158 Optional second arg XRM-STRING is a string of resources in xrdb format.
4159 If the optional third arg MUST-SUCCEED is non-nil,
4160 terminate Emacs if we can't open the connection. */)
4161 (display, xrm_string, must_succeed)
4162 Lisp_Object display, xrm_string, must_succeed;
4164 unsigned char *xrm_option;
4165 struct x_display_info *dpyinfo;
4167 CHECK_STRING (display);
4168 if (! NILP (xrm_string))
4169 CHECK_STRING (xrm_string);
4171 if (! EQ (Vwindow_system, intern ("x")))
4172 error ("Not using X Windows");
4174 if (! NILP (xrm_string))
4175 xrm_option = (unsigned char *) SDATA (xrm_string);
4176 else
4177 xrm_option = (unsigned char *) 0;
4179 validate_x_resource_name ();
4181 /* This is what opens the connection and sets x_current_display.
4182 This also initializes many symbols, such as those used for input. */
4183 dpyinfo = x_term_init (display, xrm_option,
4184 (char *) SDATA (Vx_resource_name));
4186 if (dpyinfo == 0)
4188 if (!NILP (must_succeed))
4189 fatal ("Cannot connect to X server %s.\n\
4190 Check the DISPLAY environment variable or use `-d'.\n\
4191 Also use the `xauth' program to verify that you have the proper\n\
4192 authorization information needed to connect the X server.\n\
4193 An insecure way to solve the problem may be to use `xhost'.\n",
4194 SDATA (display));
4195 else
4196 error ("Cannot connect to X server %s", SDATA (display));
4199 x_in_use = 1;
4201 XSETFASTINT (Vwindow_system_version, 11);
4202 return Qnil;
4205 DEFUN ("x-close-connection", Fx_close_connection,
4206 Sx_close_connection, 1, 1, 0,
4207 doc: /* Close the connection to DISPLAY's X server.
4208 For DISPLAY, specify either a frame or a display name (a string).
4209 If DISPLAY is nil, that stands for the selected frame's display. */)
4210 (display)
4211 Lisp_Object display;
4213 struct x_display_info *dpyinfo = check_x_display_info (display);
4214 int i;
4216 if (dpyinfo->reference_count > 0)
4217 error ("Display still has frames on it");
4219 BLOCK_INPUT;
4220 /* Free the fonts in the font table. */
4221 for (i = 0; i < dpyinfo->n_fonts; i++)
4222 if (dpyinfo->font_table[i].name)
4224 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
4227 x_destroy_all_bitmaps (dpyinfo);
4228 XSetCloseDownMode (dpyinfo->display, DestroyAll);
4230 #ifdef USE_X_TOOLKIT
4231 XtCloseDisplay (dpyinfo->display);
4232 #else
4233 XCloseDisplay (dpyinfo->display);
4234 #endif
4236 x_delete_display (dpyinfo);
4237 UNBLOCK_INPUT;
4239 return Qnil;
4242 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
4243 doc: /* Return the list of display names that Emacs has connections to. */)
4246 Lisp_Object tail, result;
4248 result = Qnil;
4249 for (tail = x_display_name_list; ! NILP (tail); tail = XCDR (tail))
4250 result = Fcons (XCAR (XCAR (tail)), result);
4252 return result;
4255 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
4256 doc: /* If ON is non-nil, report X errors as soon as the erring request is made.
4257 If ON is nil, allow buffering of requests.
4258 Turning on synchronization prohibits the Xlib routines from buffering
4259 requests and seriously degrades performance, but makes debugging much
4260 easier.
4261 The optional second argument DISPLAY specifies which display to act on.
4262 DISPLAY should be either a frame or a display name (a string).
4263 If DISPLAY is omitted or nil, that stands for the selected frame's display. */)
4264 (on, display)
4265 Lisp_Object display, on;
4267 struct x_display_info *dpyinfo = check_x_display_info (display);
4269 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
4271 return Qnil;
4274 /* Wait for responses to all X commands issued so far for frame F. */
4276 void
4277 x_sync (f)
4278 FRAME_PTR f;
4280 BLOCK_INPUT;
4281 XSync (FRAME_X_DISPLAY (f), False);
4282 UNBLOCK_INPUT;
4286 /***********************************************************************
4287 General X functions exposed to Elisp.
4288 ***********************************************************************/
4290 DEFUN ("x-send-client-message", Fx_send_client_event,
4291 Sx_send_client_message, 6, 6, 0,
4292 doc: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
4294 For DISPLAY, specify either a frame or a display name (a string).
4295 If DISPLAY is nil, that stands for the selected frame's display.
4296 DEST may be an integer, in which case it is a Window id. The value 0 may
4297 be used to send to the root window of the DISPLAY.
4298 If DEST is a frame the event is sent to the outer window of that frame.
4299 Nil means the currently selected frame.
4300 If DEST is the string "PointerWindow" the event is sent to the window that
4301 contains the pointer. If DEST is the string "InputFocus" the event is
4302 sent to the window that has the input focus.
4303 FROM is the frame sending the event. Use nil for currently selected frame.
4304 MESSAGE-TYPE is the name of an Atom as a string.
4305 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
4306 bits. VALUES is a list of integer and/or strings containing the values to
4307 send. If a value is a string, it is converted to an Atom and the value of
4308 the Atom is sent. If more values than fits into the event is given,
4309 the excessive values are ignored. */)
4310 (display, dest, from, message_type, format, values)
4311 Lisp_Object display, dest, from, message_type, format, values;
4313 struct x_display_info *dpyinfo = check_x_display_info (display);
4314 Window wdest;
4315 XEvent event;
4316 Lisp_Object cons;
4317 int i;
4318 int max_nr_values = (int) sizeof (event.xclient.data.b);
4319 struct frame *f = check_x_frame (from);
4321 CHECK_STRING (message_type);
4322 CHECK_NUMBER (format);
4323 CHECK_CONS (values);
4325 for (cons = values; CONSP (cons); cons = XCDR (cons))
4327 Lisp_Object o = XCAR (cons);
4329 if (! INTEGERP (o) && ! STRINGP (o))
4330 error ("Bad data in VALUES, must be integer or string");
4333 event.xclient.type = ClientMessage;
4334 event.xclient.format = XFASTINT (format);
4336 if (event.xclient.format != 8 && event.xclient.format != 16
4337 && event.xclient.format != 32)
4338 error ("FORMAT must be one of 8, 16 or 32");
4339 if (event.xclient.format == 16) max_nr_values /= 2;
4340 if (event.xclient.format == 32) max_nr_values /= 4;
4342 if (FRAMEP (dest) || NILP (dest))
4344 struct frame *fdest = check_x_frame (dest);
4345 wdest = FRAME_OUTER_WINDOW (fdest);
4347 else if (STRINGP (dest))
4349 if (strcmp (SDATA (dest), "PointerWindow") == 0)
4350 wdest = PointerWindow;
4351 else if (strcmp (SDATA (dest), "InputFocus") == 0)
4352 wdest = InputFocus;
4353 else
4354 error ("DEST as a string must be one of PointerWindow or InputFocus");
4356 else
4358 CHECK_NUMBER (dest);
4359 wdest = (Window) XFASTINT (dest);
4360 if (wdest == 0) wdest = dpyinfo->root_window;
4363 BLOCK_INPUT;
4364 for (cons = values, i = 0;
4365 CONSP (cons) && i < max_nr_values;
4366 cons = XCDR (cons), ++i)
4368 Lisp_Object o = XCAR (cons);
4369 long val;
4371 if (INTEGERP (o))
4372 val = XINT (o);
4373 else if (STRINGP (o))
4374 val = XInternAtom (dpyinfo->display, SDATA (o), False);
4376 if (event.xclient.format == 8)
4377 event.xclient.data.b[i] = (char) val;
4378 else if (event.xclient.format == 16)
4379 event.xclient.data.s[i] = (short) val;
4380 else
4381 event.xclient.data.l[i] = val;
4384 for ( ; i < max_nr_values; ++i)
4385 if (event.xclient.format == 8)
4386 event.xclient.data.b[i] = 0;
4387 else if (event.xclient.format == 16)
4388 event.xclient.data.s[i] = 0;
4389 else
4390 event.xclient.data.l[i] = 0;
4392 event.xclient.message_type
4393 = XInternAtom (dpyinfo->display, SDATA (message_type), False);
4394 event.xclient.display = dpyinfo->display;
4395 event.xclient.window = FRAME_OUTER_WINDOW (f);
4397 XSendEvent (dpyinfo->display, wdest, False, 0xffff, &event);
4399 XFlush (dpyinfo->display);
4400 UNBLOCK_INPUT;
4402 return Qnil;
4405 /***********************************************************************
4406 Image types
4407 ***********************************************************************/
4409 /* Value is the number of elements of vector VECTOR. */
4411 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
4413 /* List of supported image types. Use define_image_type to add new
4414 types. Use lookup_image_type to find a type for a given symbol. */
4416 static struct image_type *image_types;
4418 /* The symbol `xbm' which is used as the type symbol for XBM images. */
4420 Lisp_Object Qxbm;
4422 /* Keywords. */
4424 extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
4425 extern Lisp_Object QCdata, QCtype;
4426 Lisp_Object QCascent, QCmargin, QCrelief;
4427 Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask;
4428 Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask;
4430 /* Other symbols. */
4432 Lisp_Object Qlaplace, Qemboss, Qedge_detection, Qheuristic;
4434 /* Time in seconds after which images should be removed from the cache
4435 if not displayed. */
4437 Lisp_Object Vimage_cache_eviction_delay;
4439 /* Function prototypes. */
4441 static void define_image_type P_ ((struct image_type *type));
4442 static struct image_type *lookup_image_type P_ ((Lisp_Object symbol));
4443 static void image_error P_ ((char *format, Lisp_Object, Lisp_Object));
4444 static void x_laplace P_ ((struct frame *, struct image *));
4445 static void x_emboss P_ ((struct frame *, struct image *));
4446 static int x_build_heuristic_mask P_ ((struct frame *, struct image *,
4447 Lisp_Object));
4450 /* Define a new image type from TYPE. This adds a copy of TYPE to
4451 image_types and adds the symbol *TYPE->type to Vimage_types. */
4453 static void
4454 define_image_type (type)
4455 struct image_type *type;
4457 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
4458 The initialized data segment is read-only. */
4459 struct image_type *p = (struct image_type *) xmalloc (sizeof *p);
4460 bcopy (type, p, sizeof *p);
4461 p->next = image_types;
4462 image_types = p;
4463 Vimage_types = Fcons (*p->type, Vimage_types);
4467 /* Look up image type SYMBOL, and return a pointer to its image_type
4468 structure. Value is null if SYMBOL is not a known image type. */
4470 static INLINE struct image_type *
4471 lookup_image_type (symbol)
4472 Lisp_Object symbol;
4474 struct image_type *type;
4476 for (type = image_types; type; type = type->next)
4477 if (EQ (symbol, *type->type))
4478 break;
4480 return type;
4484 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
4485 valid image specification is a list whose car is the symbol
4486 `image', and whose rest is a property list. The property list must
4487 contain a value for key `:type'. That value must be the name of a
4488 supported image type. The rest of the property list depends on the
4489 image type. */
4492 valid_image_p (object)
4493 Lisp_Object object;
4495 int valid_p = 0;
4497 if (IMAGEP (object))
4499 Lisp_Object tem;
4501 for (tem = XCDR (object); CONSP (tem); tem = XCDR (tem))
4502 if (EQ (XCAR (tem), QCtype))
4504 tem = XCDR (tem);
4505 if (CONSP (tem) && SYMBOLP (XCAR (tem)))
4507 struct image_type *type;
4508 type = lookup_image_type (XCAR (tem));
4509 if (type)
4510 valid_p = type->valid_p (object);
4513 break;
4517 return valid_p;
4521 /* Log error message with format string FORMAT and argument ARG.
4522 Signaling an error, e.g. when an image cannot be loaded, is not a
4523 good idea because this would interrupt redisplay, and the error
4524 message display would lead to another redisplay. This function
4525 therefore simply displays a message. */
4527 static void
4528 image_error (format, arg1, arg2)
4529 char *format;
4530 Lisp_Object arg1, arg2;
4532 add_to_log (format, arg1, arg2);
4537 /***********************************************************************
4538 Image specifications
4539 ***********************************************************************/
4541 enum image_value_type
4543 IMAGE_DONT_CHECK_VALUE_TYPE,
4544 IMAGE_STRING_VALUE,
4545 IMAGE_STRING_OR_NIL_VALUE,
4546 IMAGE_SYMBOL_VALUE,
4547 IMAGE_POSITIVE_INTEGER_VALUE,
4548 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR,
4549 IMAGE_NON_NEGATIVE_INTEGER_VALUE,
4550 IMAGE_ASCENT_VALUE,
4551 IMAGE_INTEGER_VALUE,
4552 IMAGE_FUNCTION_VALUE,
4553 IMAGE_NUMBER_VALUE,
4554 IMAGE_BOOL_VALUE
4557 /* Structure used when parsing image specifications. */
4559 struct image_keyword
4561 /* Name of keyword. */
4562 char *name;
4564 /* The type of value allowed. */
4565 enum image_value_type type;
4567 /* Non-zero means key must be present. */
4568 int mandatory_p;
4570 /* Used to recognize duplicate keywords in a property list. */
4571 int count;
4573 /* The value that was found. */
4574 Lisp_Object value;
4578 static int parse_image_spec P_ ((Lisp_Object, struct image_keyword *,
4579 int, Lisp_Object));
4580 static Lisp_Object image_spec_value P_ ((Lisp_Object, Lisp_Object, int *));
4583 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
4584 has the format (image KEYWORD VALUE ...). One of the keyword/
4585 value pairs must be `:type TYPE'. KEYWORDS is a vector of
4586 image_keywords structures of size NKEYWORDS describing other
4587 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
4589 static int
4590 parse_image_spec (spec, keywords, nkeywords, type)
4591 Lisp_Object spec;
4592 struct image_keyword *keywords;
4593 int nkeywords;
4594 Lisp_Object type;
4596 int i;
4597 Lisp_Object plist;
4599 if (!IMAGEP (spec))
4600 return 0;
4602 plist = XCDR (spec);
4603 while (CONSP (plist))
4605 Lisp_Object key, value;
4607 /* First element of a pair must be a symbol. */
4608 key = XCAR (plist);
4609 plist = XCDR (plist);
4610 if (!SYMBOLP (key))
4611 return 0;
4613 /* There must follow a value. */
4614 if (!CONSP (plist))
4615 return 0;
4616 value = XCAR (plist);
4617 plist = XCDR (plist);
4619 /* Find key in KEYWORDS. Error if not found. */
4620 for (i = 0; i < nkeywords; ++i)
4621 if (strcmp (keywords[i].name, SDATA (SYMBOL_NAME (key))) == 0)
4622 break;
4624 if (i == nkeywords)
4625 continue;
4627 /* Record that we recognized the keyword. If a keywords
4628 was found more than once, it's an error. */
4629 keywords[i].value = value;
4630 ++keywords[i].count;
4632 if (keywords[i].count > 1)
4633 return 0;
4635 /* Check type of value against allowed type. */
4636 switch (keywords[i].type)
4638 case IMAGE_STRING_VALUE:
4639 if (!STRINGP (value))
4640 return 0;
4641 break;
4643 case IMAGE_STRING_OR_NIL_VALUE:
4644 if (!STRINGP (value) && !NILP (value))
4645 return 0;
4646 break;
4648 case IMAGE_SYMBOL_VALUE:
4649 if (!SYMBOLP (value))
4650 return 0;
4651 break;
4653 case IMAGE_POSITIVE_INTEGER_VALUE:
4654 if (!INTEGERP (value) || XINT (value) <= 0)
4655 return 0;
4656 break;
4658 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR:
4659 if (INTEGERP (value) && XINT (value) >= 0)
4660 break;
4661 if (CONSP (value)
4662 && INTEGERP (XCAR (value)) && INTEGERP (XCDR (value))
4663 && XINT (XCAR (value)) >= 0 && XINT (XCDR (value)) >= 0)
4664 break;
4665 return 0;
4667 case IMAGE_ASCENT_VALUE:
4668 if (SYMBOLP (value) && EQ (value, Qcenter))
4669 break;
4670 else if (INTEGERP (value)
4671 && XINT (value) >= 0
4672 && XINT (value) <= 100)
4673 break;
4674 return 0;
4676 case IMAGE_NON_NEGATIVE_INTEGER_VALUE:
4677 if (!INTEGERP (value) || XINT (value) < 0)
4678 return 0;
4679 break;
4681 case IMAGE_DONT_CHECK_VALUE_TYPE:
4682 break;
4684 case IMAGE_FUNCTION_VALUE:
4685 value = indirect_function (value);
4686 if (SUBRP (value)
4687 || COMPILEDP (value)
4688 || (CONSP (value) && EQ (XCAR (value), Qlambda)))
4689 break;
4690 return 0;
4692 case IMAGE_NUMBER_VALUE:
4693 if (!INTEGERP (value) && !FLOATP (value))
4694 return 0;
4695 break;
4697 case IMAGE_INTEGER_VALUE:
4698 if (!INTEGERP (value))
4699 return 0;
4700 break;
4702 case IMAGE_BOOL_VALUE:
4703 if (!NILP (value) && !EQ (value, Qt))
4704 return 0;
4705 break;
4707 default:
4708 abort ();
4709 break;
4712 if (EQ (key, QCtype) && !EQ (type, value))
4713 return 0;
4716 /* Check that all mandatory fields are present. */
4717 for (i = 0; i < nkeywords; ++i)
4718 if (keywords[i].mandatory_p && keywords[i].count == 0)
4719 return 0;
4721 return NILP (plist);
4725 /* Return the value of KEY in image specification SPEC. Value is nil
4726 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
4727 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
4729 static Lisp_Object
4730 image_spec_value (spec, key, found)
4731 Lisp_Object spec, key;
4732 int *found;
4734 Lisp_Object tail;
4736 xassert (valid_image_p (spec));
4738 for (tail = XCDR (spec);
4739 CONSP (tail) && CONSP (XCDR (tail));
4740 tail = XCDR (XCDR (tail)))
4742 if (EQ (XCAR (tail), key))
4744 if (found)
4745 *found = 1;
4746 return XCAR (XCDR (tail));
4750 if (found)
4751 *found = 0;
4752 return Qnil;
4756 DEFUN ("image-size", Fimage_size, Simage_size, 1, 3, 0,
4757 doc: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
4758 PIXELS non-nil means return the size in pixels, otherwise return the
4759 size in canonical character units.
4760 FRAME is the frame on which the image will be displayed. FRAME nil
4761 or omitted means use the selected frame. */)
4762 (spec, pixels, frame)
4763 Lisp_Object spec, pixels, frame;
4765 Lisp_Object size;
4767 size = Qnil;
4768 if (valid_image_p (spec))
4770 struct frame *f = check_x_frame (frame);
4771 int id = lookup_image (f, spec);
4772 struct image *img = IMAGE_FROM_ID (f, id);
4773 int width = img->width + 2 * img->hmargin;
4774 int height = img->height + 2 * img->vmargin;
4776 if (NILP (pixels))
4777 size = Fcons (make_float ((double) width / FRAME_COLUMN_WIDTH (f)),
4778 make_float ((double) height / FRAME_LINE_HEIGHT (f)));
4779 else
4780 size = Fcons (make_number (width), make_number (height));
4782 else
4783 error ("Invalid image specification");
4785 return size;
4789 DEFUN ("image-mask-p", Fimage_mask_p, Simage_mask_p, 1, 2, 0,
4790 doc: /* Return t if image SPEC has a mask bitmap.
4791 FRAME is the frame on which the image will be displayed. FRAME nil
4792 or omitted means use the selected frame. */)
4793 (spec, frame)
4794 Lisp_Object spec, frame;
4796 Lisp_Object mask;
4798 mask = Qnil;
4799 if (valid_image_p (spec))
4801 struct frame *f = check_x_frame (frame);
4802 int id = lookup_image (f, spec);
4803 struct image *img = IMAGE_FROM_ID (f, id);
4804 if (img->mask)
4805 mask = Qt;
4807 else
4808 error ("Invalid image specification");
4810 return mask;
4815 /***********************************************************************
4816 Image type independent image structures
4817 ***********************************************************************/
4819 static struct image *make_image P_ ((Lisp_Object spec, unsigned hash));
4820 static void free_image P_ ((struct frame *f, struct image *img));
4823 /* Allocate and return a new image structure for image specification
4824 SPEC. SPEC has a hash value of HASH. */
4826 static struct image *
4827 make_image (spec, hash)
4828 Lisp_Object spec;
4829 unsigned hash;
4831 struct image *img = (struct image *) xmalloc (sizeof *img);
4833 xassert (valid_image_p (spec));
4834 bzero (img, sizeof *img);
4835 img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
4836 xassert (img->type != NULL);
4837 img->spec = spec;
4838 img->data.lisp_val = Qnil;
4839 img->ascent = DEFAULT_IMAGE_ASCENT;
4840 img->hash = hash;
4841 return img;
4845 /* Free image IMG which was used on frame F, including its resources. */
4847 static void
4848 free_image (f, img)
4849 struct frame *f;
4850 struct image *img;
4852 if (img)
4854 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
4856 /* Remove IMG from the hash table of its cache. */
4857 if (img->prev)
4858 img->prev->next = img->next;
4859 else
4860 c->buckets[img->hash % IMAGE_CACHE_BUCKETS_SIZE] = img->next;
4862 if (img->next)
4863 img->next->prev = img->prev;
4865 c->images[img->id] = NULL;
4867 /* Free resources, then free IMG. */
4868 img->type->free (f, img);
4869 xfree (img);
4874 /* Prepare image IMG for display on frame F. Must be called before
4875 drawing an image. */
4877 void
4878 prepare_image_for_display (f, img)
4879 struct frame *f;
4880 struct image *img;
4882 EMACS_TIME t;
4884 /* We're about to display IMG, so set its timestamp to `now'. */
4885 EMACS_GET_TIME (t);
4886 img->timestamp = EMACS_SECS (t);
4888 /* If IMG doesn't have a pixmap yet, load it now, using the image
4889 type dependent loader function. */
4890 if (img->pixmap == None && !img->load_failed_p)
4891 img->load_failed_p = img->type->load (f, img) == 0;
4895 /* Value is the number of pixels for the ascent of image IMG when
4896 drawn in face FACE. */
4899 image_ascent (img, face)
4900 struct image *img;
4901 struct face *face;
4903 int height = img->height + img->vmargin;
4904 int ascent;
4906 if (img->ascent == CENTERED_IMAGE_ASCENT)
4908 if (face->font)
4909 /* This expression is arranged so that if the image can't be
4910 exactly centered, it will be moved slightly up. This is
4911 because a typical font is `top-heavy' (due to the presence
4912 uppercase letters), so the image placement should err towards
4913 being top-heavy too. It also just generally looks better. */
4914 ascent = (height + face->font->ascent - face->font->descent + 1) / 2;
4915 else
4916 ascent = height / 2;
4918 else
4919 ascent = height * img->ascent / 100.0;
4921 return ascent;
4925 /* Image background colors. */
4927 static unsigned long
4928 four_corners_best (ximg, width, height)
4929 XImage *ximg;
4930 unsigned long width, height;
4932 unsigned long corners[4], best;
4933 int i, best_count;
4935 /* Get the colors at the corners of ximg. */
4936 corners[0] = XGetPixel (ximg, 0, 0);
4937 corners[1] = XGetPixel (ximg, width - 1, 0);
4938 corners[2] = XGetPixel (ximg, width - 1, height - 1);
4939 corners[3] = XGetPixel (ximg, 0, height - 1);
4941 /* Choose the most frequently found color as background. */
4942 for (i = best_count = 0; i < 4; ++i)
4944 int j, n;
4946 for (j = n = 0; j < 4; ++j)
4947 if (corners[i] == corners[j])
4948 ++n;
4950 if (n > best_count)
4951 best = corners[i], best_count = n;
4954 return best;
4957 /* Return the `background' field of IMG. If IMG doesn't have one yet,
4958 it is guessed heuristically. If non-zero, XIMG is an existing XImage
4959 object to use for the heuristic. */
4961 unsigned long
4962 image_background (img, f, ximg)
4963 struct image *img;
4964 struct frame *f;
4965 XImage *ximg;
4967 if (! img->background_valid)
4968 /* IMG doesn't have a background yet, try to guess a reasonable value. */
4970 int free_ximg = !ximg;
4972 if (! ximg)
4973 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
4974 0, 0, img->width, img->height, ~0, ZPixmap);
4976 img->background = four_corners_best (ximg, img->width, img->height);
4978 if (free_ximg)
4979 XDestroyImage (ximg);
4981 img->background_valid = 1;
4984 return img->background;
4987 /* Return the `background_transparent' field of IMG. If IMG doesn't
4988 have one yet, it is guessed heuristically. If non-zero, MASK is an
4989 existing XImage object to use for the heuristic. */
4992 image_background_transparent (img, f, mask)
4993 struct image *img;
4994 struct frame *f;
4995 XImage *mask;
4997 if (! img->background_transparent_valid)
4998 /* IMG doesn't have a background yet, try to guess a reasonable value. */
5000 if (img->mask)
5002 int free_mask = !mask;
5004 if (! mask)
5005 mask = XGetImage (FRAME_X_DISPLAY (f), img->mask,
5006 0, 0, img->width, img->height, ~0, ZPixmap);
5008 img->background_transparent
5009 = !four_corners_best (mask, img->width, img->height);
5011 if (free_mask)
5012 XDestroyImage (mask);
5014 else
5015 img->background_transparent = 0;
5017 img->background_transparent_valid = 1;
5020 return img->background_transparent;
5024 /***********************************************************************
5025 Helper functions for X image types
5026 ***********************************************************************/
5028 static void x_clear_image_1 P_ ((struct frame *, struct image *, int,
5029 int, int));
5030 static void x_clear_image P_ ((struct frame *f, struct image *img));
5031 static unsigned long x_alloc_image_color P_ ((struct frame *f,
5032 struct image *img,
5033 Lisp_Object color_name,
5034 unsigned long dflt));
5037 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5038 free the pixmap if any. MASK_P non-zero means clear the mask
5039 pixmap if any. COLORS_P non-zero means free colors allocated for
5040 the image, if any. */
5042 static void
5043 x_clear_image_1 (f, img, pixmap_p, mask_p, colors_p)
5044 struct frame *f;
5045 struct image *img;
5046 int pixmap_p, mask_p, colors_p;
5048 if (pixmap_p && img->pixmap)
5050 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
5051 img->pixmap = None;
5052 img->background_valid = 0;
5055 if (mask_p && img->mask)
5057 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
5058 img->mask = None;
5059 img->background_transparent_valid = 0;
5062 if (colors_p && img->ncolors)
5064 x_free_colors (f, img->colors, img->ncolors);
5065 xfree (img->colors);
5066 img->colors = NULL;
5067 img->ncolors = 0;
5071 /* Free X resources of image IMG which is used on frame F. */
5073 static void
5074 x_clear_image (f, img)
5075 struct frame *f;
5076 struct image *img;
5078 BLOCK_INPUT;
5079 x_clear_image_1 (f, img, 1, 1, 1);
5080 UNBLOCK_INPUT;
5084 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5085 cannot be allocated, use DFLT. Add a newly allocated color to
5086 IMG->colors, so that it can be freed again. Value is the pixel
5087 color. */
5089 static unsigned long
5090 x_alloc_image_color (f, img, color_name, dflt)
5091 struct frame *f;
5092 struct image *img;
5093 Lisp_Object color_name;
5094 unsigned long dflt;
5096 XColor color;
5097 unsigned long result;
5099 xassert (STRINGP (color_name));
5101 if (x_defined_color (f, SDATA (color_name), &color, 1))
5103 /* This isn't called frequently so we get away with simply
5104 reallocating the color vector to the needed size, here. */
5105 ++img->ncolors;
5106 img->colors =
5107 (unsigned long *) xrealloc (img->colors,
5108 img->ncolors * sizeof *img->colors);
5109 img->colors[img->ncolors - 1] = color.pixel;
5110 result = color.pixel;
5112 else
5113 result = dflt;
5115 return result;
5120 /***********************************************************************
5121 Image Cache
5122 ***********************************************************************/
5124 static void cache_image P_ ((struct frame *f, struct image *img));
5125 static void postprocess_image P_ ((struct frame *, struct image *));
5128 /* Return a new, initialized image cache that is allocated from the
5129 heap. Call free_image_cache to free an image cache. */
5131 struct image_cache *
5132 make_image_cache ()
5134 struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
5135 int size;
5137 bzero (c, sizeof *c);
5138 c->size = 50;
5139 c->images = (struct image **) xmalloc (c->size * sizeof *c->images);
5140 size = IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
5141 c->buckets = (struct image **) xmalloc (size);
5142 bzero (c->buckets, size);
5143 return c;
5147 /* Free image cache of frame F. Be aware that X frames share images
5148 caches. */
5150 void
5151 free_image_cache (f)
5152 struct frame *f;
5154 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5155 if (c)
5157 int i;
5159 /* Cache should not be referenced by any frame when freed. */
5160 xassert (c->refcount == 0);
5162 for (i = 0; i < c->used; ++i)
5163 free_image (f, c->images[i]);
5164 xfree (c->images);
5165 xfree (c->buckets);
5166 xfree (c);
5167 FRAME_X_IMAGE_CACHE (f) = NULL;
5172 /* Clear image cache of frame F. FORCE_P non-zero means free all
5173 images. FORCE_P zero means clear only images that haven't been
5174 displayed for some time. Should be called from time to time to
5175 reduce the number of loaded images. If image-eviction-seconds is
5176 non-nil, this frees images in the cache which weren't displayed for
5177 at least that many seconds. */
5179 void
5180 clear_image_cache (f, force_p)
5181 struct frame *f;
5182 int force_p;
5184 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5186 if (c && INTEGERP (Vimage_cache_eviction_delay))
5188 EMACS_TIME t;
5189 unsigned long old;
5190 int i, nfreed;
5192 EMACS_GET_TIME (t);
5193 old = EMACS_SECS (t) - XFASTINT (Vimage_cache_eviction_delay);
5195 /* Block input so that we won't be interrupted by a SIGIO
5196 while being in an inconsistent state. */
5197 BLOCK_INPUT;
5199 for (i = nfreed = 0; i < c->used; ++i)
5201 struct image *img = c->images[i];
5202 if (img != NULL
5203 && (force_p || img->timestamp < old))
5205 free_image (f, img);
5206 ++nfreed;
5210 /* We may be clearing the image cache because, for example,
5211 Emacs was iconified for a longer period of time. In that
5212 case, current matrices may still contain references to
5213 images freed above. So, clear these matrices. */
5214 if (nfreed)
5216 Lisp_Object tail, frame;
5218 FOR_EACH_FRAME (tail, frame)
5220 struct frame *f = XFRAME (frame);
5221 if (FRAME_X_P (f)
5222 && FRAME_X_IMAGE_CACHE (f) == c)
5223 clear_current_matrices (f);
5226 ++windows_or_buffers_changed;
5229 UNBLOCK_INPUT;
5234 DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache,
5235 0, 1, 0,
5236 doc: /* Clear the image cache of FRAME.
5237 FRAME nil or omitted means use the selected frame.
5238 FRAME t means clear the image caches of all frames. */)
5239 (frame)
5240 Lisp_Object frame;
5242 if (EQ (frame, Qt))
5244 Lisp_Object tail;
5246 FOR_EACH_FRAME (tail, frame)
5247 if (FRAME_X_P (XFRAME (frame)))
5248 clear_image_cache (XFRAME (frame), 1);
5250 else
5251 clear_image_cache (check_x_frame (frame), 1);
5253 return Qnil;
5257 /* Compute masks and transform image IMG on frame F, as specified
5258 by the image's specification, */
5260 static void
5261 postprocess_image (f, img)
5262 struct frame *f;
5263 struct image *img;
5265 /* Manipulation of the image's mask. */
5266 if (img->pixmap)
5268 Lisp_Object conversion, spec;
5269 Lisp_Object mask;
5271 spec = img->spec;
5273 /* `:heuristic-mask t'
5274 `:mask heuristic'
5275 means build a mask heuristically.
5276 `:heuristic-mask (R G B)'
5277 `:mask (heuristic (R G B))'
5278 means build a mask from color (R G B) in the
5279 image.
5280 `:mask nil'
5281 means remove a mask, if any. */
5283 mask = image_spec_value (spec, QCheuristic_mask, NULL);
5284 if (!NILP (mask))
5285 x_build_heuristic_mask (f, img, mask);
5286 else
5288 int found_p;
5290 mask = image_spec_value (spec, QCmask, &found_p);
5292 if (EQ (mask, Qheuristic))
5293 x_build_heuristic_mask (f, img, Qt);
5294 else if (CONSP (mask)
5295 && EQ (XCAR (mask), Qheuristic))
5297 if (CONSP (XCDR (mask)))
5298 x_build_heuristic_mask (f, img, XCAR (XCDR (mask)));
5299 else
5300 x_build_heuristic_mask (f, img, XCDR (mask));
5302 else if (NILP (mask) && found_p && img->mask)
5304 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
5305 img->mask = None;
5310 /* Should we apply an image transformation algorithm? */
5311 conversion = image_spec_value (spec, QCconversion, NULL);
5312 if (EQ (conversion, Qdisabled))
5313 x_disable_image (f, img);
5314 else if (EQ (conversion, Qlaplace))
5315 x_laplace (f, img);
5316 else if (EQ (conversion, Qemboss))
5317 x_emboss (f, img);
5318 else if (CONSP (conversion)
5319 && EQ (XCAR (conversion), Qedge_detection))
5321 Lisp_Object tem;
5322 tem = XCDR (conversion);
5323 if (CONSP (tem))
5324 x_edge_detection (f, img,
5325 Fplist_get (tem, QCmatrix),
5326 Fplist_get (tem, QCcolor_adjustment));
5332 /* Return the id of image with Lisp specification SPEC on frame F.
5333 SPEC must be a valid Lisp image specification (see valid_image_p). */
5336 lookup_image (f, spec)
5337 struct frame *f;
5338 Lisp_Object spec;
5340 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5341 struct image *img;
5342 int i;
5343 unsigned hash;
5344 struct gcpro gcpro1;
5345 EMACS_TIME now;
5347 /* F must be a window-system frame, and SPEC must be a valid image
5348 specification. */
5349 xassert (FRAME_WINDOW_P (f));
5350 xassert (valid_image_p (spec));
5352 GCPRO1 (spec);
5354 /* Look up SPEC in the hash table of the image cache. */
5355 hash = sxhash (spec, 0);
5356 i = hash % IMAGE_CACHE_BUCKETS_SIZE;
5358 for (img = c->buckets[i]; img; img = img->next)
5359 if (img->hash == hash && !NILP (Fequal (img->spec, spec)))
5360 break;
5362 /* If not found, create a new image and cache it. */
5363 if (img == NULL)
5365 extern Lisp_Object Qpostscript;
5367 BLOCK_INPUT;
5368 img = make_image (spec, hash);
5369 cache_image (f, img);
5370 img->load_failed_p = img->type->load (f, img) == 0;
5372 /* If we can't load the image, and we don't have a width and
5373 height, use some arbitrary width and height so that we can
5374 draw a rectangle for it. */
5375 if (img->load_failed_p)
5377 Lisp_Object value;
5379 value = image_spec_value (spec, QCwidth, NULL);
5380 img->width = (INTEGERP (value)
5381 ? XFASTINT (value) : DEFAULT_IMAGE_WIDTH);
5382 value = image_spec_value (spec, QCheight, NULL);
5383 img->height = (INTEGERP (value)
5384 ? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT);
5386 else
5388 /* Handle image type independent image attributes
5389 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF',
5390 `:background COLOR'. */
5391 Lisp_Object ascent, margin, relief, bg;
5393 ascent = image_spec_value (spec, QCascent, NULL);
5394 if (INTEGERP (ascent))
5395 img->ascent = XFASTINT (ascent);
5396 else if (EQ (ascent, Qcenter))
5397 img->ascent = CENTERED_IMAGE_ASCENT;
5399 margin = image_spec_value (spec, QCmargin, NULL);
5400 if (INTEGERP (margin) && XINT (margin) >= 0)
5401 img->vmargin = img->hmargin = XFASTINT (margin);
5402 else if (CONSP (margin) && INTEGERP (XCAR (margin))
5403 && INTEGERP (XCDR (margin)))
5405 if (XINT (XCAR (margin)) > 0)
5406 img->hmargin = XFASTINT (XCAR (margin));
5407 if (XINT (XCDR (margin)) > 0)
5408 img->vmargin = XFASTINT (XCDR (margin));
5411 relief = image_spec_value (spec, QCrelief, NULL);
5412 if (INTEGERP (relief))
5414 img->relief = XINT (relief);
5415 img->hmargin += abs (img->relief);
5416 img->vmargin += abs (img->relief);
5419 if (! img->background_valid)
5421 bg = image_spec_value (img->spec, QCbackground, NULL);
5422 if (!NILP (bg))
5424 img->background
5425 = x_alloc_image_color (f, img, bg,
5426 FRAME_BACKGROUND_PIXEL (f));
5427 img->background_valid = 1;
5431 /* Do image transformations and compute masks, unless we
5432 don't have the image yet. */
5433 if (!EQ (*img->type->type, Qpostscript))
5434 postprocess_image (f, img);
5437 UNBLOCK_INPUT;
5438 xassert (!interrupt_input_blocked);
5441 /* We're using IMG, so set its timestamp to `now'. */
5442 EMACS_GET_TIME (now);
5443 img->timestamp = EMACS_SECS (now);
5445 UNGCPRO;
5447 /* Value is the image id. */
5448 return img->id;
5452 /* Cache image IMG in the image cache of frame F. */
5454 static void
5455 cache_image (f, img)
5456 struct frame *f;
5457 struct image *img;
5459 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5460 int i;
5462 /* Find a free slot in c->images. */
5463 for (i = 0; i < c->used; ++i)
5464 if (c->images[i] == NULL)
5465 break;
5467 /* If no free slot found, maybe enlarge c->images. */
5468 if (i == c->used && c->used == c->size)
5470 c->size *= 2;
5471 c->images = (struct image **) xrealloc (c->images,
5472 c->size * sizeof *c->images);
5475 /* Add IMG to c->images, and assign IMG an id. */
5476 c->images[i] = img;
5477 img->id = i;
5478 if (i == c->used)
5479 ++c->used;
5481 /* Add IMG to the cache's hash table. */
5482 i = img->hash % IMAGE_CACHE_BUCKETS_SIZE;
5483 img->next = c->buckets[i];
5484 if (img->next)
5485 img->next->prev = img;
5486 img->prev = NULL;
5487 c->buckets[i] = img;
5491 /* Call FN on every image in the image cache of frame F. Used to mark
5492 Lisp Objects in the image cache. */
5494 void
5495 forall_images_in_image_cache (f, fn)
5496 struct frame *f;
5497 void (*fn) P_ ((struct image *img));
5499 if (FRAME_LIVE_P (f) && FRAME_X_P (f))
5501 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5502 if (c)
5504 int i;
5505 for (i = 0; i < c->used; ++i)
5506 if (c->images[i])
5507 fn (c->images[i]);
5514 /***********************************************************************
5515 X support code
5516 ***********************************************************************/
5518 static int x_create_x_image_and_pixmap P_ ((struct frame *, int, int, int,
5519 XImage **, Pixmap *));
5520 static void x_destroy_x_image P_ ((XImage *));
5521 static void x_put_x_image P_ ((struct frame *, XImage *, Pixmap, int, int));
5524 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
5525 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
5526 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
5527 via xmalloc. Print error messages via image_error if an error
5528 occurs. Value is non-zero if successful. */
5530 static int
5531 x_create_x_image_and_pixmap (f, width, height, depth, ximg, pixmap)
5532 struct frame *f;
5533 int width, height, depth;
5534 XImage **ximg;
5535 Pixmap *pixmap;
5537 Display *display = FRAME_X_DISPLAY (f);
5538 Screen *screen = FRAME_X_SCREEN (f);
5539 Window window = FRAME_X_WINDOW (f);
5541 xassert (interrupt_input_blocked);
5543 if (depth <= 0)
5544 depth = DefaultDepthOfScreen (screen);
5545 *ximg = XCreateImage (display, DefaultVisualOfScreen (screen),
5546 depth, ZPixmap, 0, NULL, width, height,
5547 depth > 16 ? 32 : depth > 8 ? 16 : 8, 0);
5548 if (*ximg == NULL)
5550 image_error ("Unable to allocate X image", Qnil, Qnil);
5551 return 0;
5554 /* Allocate image raster. */
5555 (*ximg)->data = (char *) xmalloc ((*ximg)->bytes_per_line * height);
5557 /* Allocate a pixmap of the same size. */
5558 *pixmap = XCreatePixmap (display, window, width, height, depth);
5559 if (*pixmap == None)
5561 x_destroy_x_image (*ximg);
5562 *ximg = NULL;
5563 image_error ("Unable to create X pixmap", Qnil, Qnil);
5564 return 0;
5567 return 1;
5571 /* Destroy XImage XIMG. Free XIMG->data. */
5573 static void
5574 x_destroy_x_image (ximg)
5575 XImage *ximg;
5577 xassert (interrupt_input_blocked);
5578 if (ximg)
5580 xfree (ximg->data);
5581 ximg->data = NULL;
5582 XDestroyImage (ximg);
5587 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
5588 are width and height of both the image and pixmap. */
5590 static void
5591 x_put_x_image (f, ximg, pixmap, width, height)
5592 struct frame *f;
5593 XImage *ximg;
5594 Pixmap pixmap;
5595 int width, height;
5597 GC gc;
5599 xassert (interrupt_input_blocked);
5600 gc = XCreateGC (FRAME_X_DISPLAY (f), pixmap, 0, NULL);
5601 XPutImage (FRAME_X_DISPLAY (f), pixmap, gc, ximg, 0, 0, 0, 0, width, height);
5602 XFreeGC (FRAME_X_DISPLAY (f), gc);
5607 /***********************************************************************
5608 File Handling
5609 ***********************************************************************/
5611 static Lisp_Object x_find_image_file P_ ((Lisp_Object));
5612 static char *slurp_file P_ ((char *, int *));
5615 /* Find image file FILE. Look in data-directory, then
5616 x-bitmap-file-path. Value is the full name of the file found, or
5617 nil if not found. */
5619 static Lisp_Object
5620 x_find_image_file (file)
5621 Lisp_Object file;
5623 Lisp_Object file_found, search_path;
5624 struct gcpro gcpro1, gcpro2;
5625 int fd;
5627 file_found = Qnil;
5628 search_path = Fcons (Vdata_directory, Vx_bitmap_file_path);
5629 GCPRO2 (file_found, search_path);
5631 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
5632 fd = openp (search_path, file, Qnil, &file_found, Qnil);
5634 if (fd == -1)
5635 file_found = Qnil;
5636 else
5637 close (fd);
5639 UNGCPRO;
5640 return file_found;
5644 /* Read FILE into memory. Value is a pointer to a buffer allocated
5645 with xmalloc holding FILE's contents. Value is null if an error
5646 occurred. *SIZE is set to the size of the file. */
5648 static char *
5649 slurp_file (file, size)
5650 char *file;
5651 int *size;
5653 FILE *fp = NULL;
5654 char *buf = NULL;
5655 struct stat st;
5657 if (stat (file, &st) == 0
5658 && (fp = fopen (file, "r")) != NULL
5659 && (buf = (char *) xmalloc (st.st_size),
5660 fread (buf, 1, st.st_size, fp) == st.st_size))
5662 *size = st.st_size;
5663 fclose (fp);
5665 else
5667 if (fp)
5668 fclose (fp);
5669 if (buf)
5671 xfree (buf);
5672 buf = NULL;
5676 return buf;
5681 /***********************************************************************
5682 XBM images
5683 ***********************************************************************/
5685 static int xbm_scan P_ ((char **, char *, char *, int *));
5686 static int xbm_load P_ ((struct frame *f, struct image *img));
5687 static int xbm_load_image P_ ((struct frame *f, struct image *img,
5688 char *, char *));
5689 static int xbm_image_p P_ ((Lisp_Object object));
5690 static int xbm_read_bitmap_data P_ ((char *, char *, int *, int *,
5691 unsigned char **));
5692 static int xbm_file_p P_ ((Lisp_Object));
5695 /* Indices of image specification fields in xbm_format, below. */
5697 enum xbm_keyword_index
5699 XBM_TYPE,
5700 XBM_FILE,
5701 XBM_WIDTH,
5702 XBM_HEIGHT,
5703 XBM_DATA,
5704 XBM_FOREGROUND,
5705 XBM_BACKGROUND,
5706 XBM_ASCENT,
5707 XBM_MARGIN,
5708 XBM_RELIEF,
5709 XBM_ALGORITHM,
5710 XBM_HEURISTIC_MASK,
5711 XBM_MASK,
5712 XBM_LAST
5715 /* Vector of image_keyword structures describing the format
5716 of valid XBM image specifications. */
5718 static struct image_keyword xbm_format[XBM_LAST] =
5720 {":type", IMAGE_SYMBOL_VALUE, 1},
5721 {":file", IMAGE_STRING_VALUE, 0},
5722 {":width", IMAGE_POSITIVE_INTEGER_VALUE, 0},
5723 {":height", IMAGE_POSITIVE_INTEGER_VALUE, 0},
5724 {":data", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
5725 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
5726 {":background", IMAGE_STRING_OR_NIL_VALUE, 0},
5727 {":ascent", IMAGE_ASCENT_VALUE, 0},
5728 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
5729 {":relief", IMAGE_INTEGER_VALUE, 0},
5730 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
5731 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
5732 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
5735 /* Structure describing the image type XBM. */
5737 static struct image_type xbm_type =
5739 &Qxbm,
5740 xbm_image_p,
5741 xbm_load,
5742 x_clear_image,
5743 NULL
5746 /* Tokens returned from xbm_scan. */
5748 enum xbm_token
5750 XBM_TK_IDENT = 256,
5751 XBM_TK_NUMBER
5755 /* Return non-zero if OBJECT is a valid XBM-type image specification.
5756 A valid specification is a list starting with the symbol `image'
5757 The rest of the list is a property list which must contain an
5758 entry `:type xbm..
5760 If the specification specifies a file to load, it must contain
5761 an entry `:file FILENAME' where FILENAME is a string.
5763 If the specification is for a bitmap loaded from memory it must
5764 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
5765 WIDTH and HEIGHT are integers > 0. DATA may be:
5767 1. a string large enough to hold the bitmap data, i.e. it must
5768 have a size >= (WIDTH + 7) / 8 * HEIGHT
5770 2. a bool-vector of size >= WIDTH * HEIGHT
5772 3. a vector of strings or bool-vectors, one for each line of the
5773 bitmap.
5775 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
5776 may not be specified in this case because they are defined in the
5777 XBM file.
5779 Both the file and data forms may contain the additional entries
5780 `:background COLOR' and `:foreground COLOR'. If not present,
5781 foreground and background of the frame on which the image is
5782 displayed is used. */
5784 static int
5785 xbm_image_p (object)
5786 Lisp_Object object;
5788 struct image_keyword kw[XBM_LAST];
5790 bcopy (xbm_format, kw, sizeof kw);
5791 if (!parse_image_spec (object, kw, XBM_LAST, Qxbm))
5792 return 0;
5794 xassert (EQ (kw[XBM_TYPE].value, Qxbm));
5796 if (kw[XBM_FILE].count)
5798 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_DATA].count)
5799 return 0;
5801 else if (kw[XBM_DATA].count && xbm_file_p (kw[XBM_DATA].value))
5803 /* In-memory XBM file. */
5804 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_FILE].count)
5805 return 0;
5807 else
5809 Lisp_Object data;
5810 int width, height;
5812 /* Entries for `:width', `:height' and `:data' must be present. */
5813 if (!kw[XBM_WIDTH].count
5814 || !kw[XBM_HEIGHT].count
5815 || !kw[XBM_DATA].count)
5816 return 0;
5818 data = kw[XBM_DATA].value;
5819 width = XFASTINT (kw[XBM_WIDTH].value);
5820 height = XFASTINT (kw[XBM_HEIGHT].value);
5822 /* Check type of data, and width and height against contents of
5823 data. */
5824 if (VECTORP (data))
5826 int i;
5828 /* Number of elements of the vector must be >= height. */
5829 if (XVECTOR (data)->size < height)
5830 return 0;
5832 /* Each string or bool-vector in data must be large enough
5833 for one line of the image. */
5834 for (i = 0; i < height; ++i)
5836 Lisp_Object elt = XVECTOR (data)->contents[i];
5838 if (STRINGP (elt))
5840 if (SCHARS (elt)
5841 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR)
5842 return 0;
5844 else if (BOOL_VECTOR_P (elt))
5846 if (XBOOL_VECTOR (elt)->size < width)
5847 return 0;
5849 else
5850 return 0;
5853 else if (STRINGP (data))
5855 if (SCHARS (data)
5856 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR * height)
5857 return 0;
5859 else if (BOOL_VECTOR_P (data))
5861 if (XBOOL_VECTOR (data)->size < width * height)
5862 return 0;
5864 else
5865 return 0;
5868 return 1;
5872 /* Scan a bitmap file. FP is the stream to read from. Value is
5873 either an enumerator from enum xbm_token, or a character for a
5874 single-character token, or 0 at end of file. If scanning an
5875 identifier, store the lexeme of the identifier in SVAL. If
5876 scanning a number, store its value in *IVAL. */
5878 static int
5879 xbm_scan (s, end, sval, ival)
5880 char **s, *end;
5881 char *sval;
5882 int *ival;
5884 int c;
5886 loop:
5888 /* Skip white space. */
5889 while (*s < end && (c = *(*s)++, isspace (c)))
5892 if (*s >= end)
5893 c = 0;
5894 else if (isdigit (c))
5896 int value = 0, digit;
5898 if (c == '0' && *s < end)
5900 c = *(*s)++;
5901 if (c == 'x' || c == 'X')
5903 while (*s < end)
5905 c = *(*s)++;
5906 if (isdigit (c))
5907 digit = c - '0';
5908 else if (c >= 'a' && c <= 'f')
5909 digit = c - 'a' + 10;
5910 else if (c >= 'A' && c <= 'F')
5911 digit = c - 'A' + 10;
5912 else
5913 break;
5914 value = 16 * value + digit;
5917 else if (isdigit (c))
5919 value = c - '0';
5920 while (*s < end
5921 && (c = *(*s)++, isdigit (c)))
5922 value = 8 * value + c - '0';
5925 else
5927 value = c - '0';
5928 while (*s < end
5929 && (c = *(*s)++, isdigit (c)))
5930 value = 10 * value + c - '0';
5933 if (*s < end)
5934 *s = *s - 1;
5935 *ival = value;
5936 c = XBM_TK_NUMBER;
5938 else if (isalpha (c) || c == '_')
5940 *sval++ = c;
5941 while (*s < end
5942 && (c = *(*s)++, (isalnum (c) || c == '_')))
5943 *sval++ = c;
5944 *sval = 0;
5945 if (*s < end)
5946 *s = *s - 1;
5947 c = XBM_TK_IDENT;
5949 else if (c == '/' && **s == '*')
5951 /* C-style comment. */
5952 ++*s;
5953 while (**s && (**s != '*' || *(*s + 1) != '/'))
5954 ++*s;
5955 if (**s)
5957 *s += 2;
5958 goto loop;
5962 return c;
5966 /* Replacement for XReadBitmapFileData which isn't available under old
5967 X versions. CONTENTS is a pointer to a buffer to parse; END is the
5968 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
5969 the image. Return in *DATA the bitmap data allocated with xmalloc.
5970 Value is non-zero if successful. DATA null means just test if
5971 CONTENTS looks like an in-memory XBM file. */
5973 static int
5974 xbm_read_bitmap_data (contents, end, width, height, data)
5975 char *contents, *end;
5976 int *width, *height;
5977 unsigned char **data;
5979 char *s = contents;
5980 char buffer[BUFSIZ];
5981 int padding_p = 0;
5982 int v10 = 0;
5983 int bytes_per_line, i, nbytes;
5984 unsigned char *p;
5985 int value;
5986 int LA1;
5988 #define match() \
5989 LA1 = xbm_scan (&s, end, buffer, &value)
5991 #define expect(TOKEN) \
5992 if (LA1 != (TOKEN)) \
5993 goto failure; \
5994 else \
5995 match ()
5997 #define expect_ident(IDENT) \
5998 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
5999 match (); \
6000 else \
6001 goto failure
6003 *width = *height = -1;
6004 if (data)
6005 *data = NULL;
6006 LA1 = xbm_scan (&s, end, buffer, &value);
6008 /* Parse defines for width, height and hot-spots. */
6009 while (LA1 == '#')
6011 match ();
6012 expect_ident ("define");
6013 expect (XBM_TK_IDENT);
6015 if (LA1 == XBM_TK_NUMBER);
6017 char *p = strrchr (buffer, '_');
6018 p = p ? p + 1 : buffer;
6019 if (strcmp (p, "width") == 0)
6020 *width = value;
6021 else if (strcmp (p, "height") == 0)
6022 *height = value;
6024 expect (XBM_TK_NUMBER);
6027 if (*width < 0 || *height < 0)
6028 goto failure;
6029 else if (data == NULL)
6030 goto success;
6032 /* Parse bits. Must start with `static'. */
6033 expect_ident ("static");
6034 if (LA1 == XBM_TK_IDENT)
6036 if (strcmp (buffer, "unsigned") == 0)
6038 match ();
6039 expect_ident ("char");
6041 else if (strcmp (buffer, "short") == 0)
6043 match ();
6044 v10 = 1;
6045 if (*width % 16 && *width % 16 < 9)
6046 padding_p = 1;
6048 else if (strcmp (buffer, "char") == 0)
6049 match ();
6050 else
6051 goto failure;
6053 else
6054 goto failure;
6056 expect (XBM_TK_IDENT);
6057 expect ('[');
6058 expect (']');
6059 expect ('=');
6060 expect ('{');
6062 bytes_per_line = (*width + 7) / 8 + padding_p;
6063 nbytes = bytes_per_line * *height;
6064 p = *data = (char *) xmalloc (nbytes);
6066 if (v10)
6068 for (i = 0; i < nbytes; i += 2)
6070 int val = value;
6071 expect (XBM_TK_NUMBER);
6073 *p++ = val;
6074 if (!padding_p || ((i + 2) % bytes_per_line))
6075 *p++ = value >> 8;
6077 if (LA1 == ',' || LA1 == '}')
6078 match ();
6079 else
6080 goto failure;
6083 else
6085 for (i = 0; i < nbytes; ++i)
6087 int val = value;
6088 expect (XBM_TK_NUMBER);
6090 *p++ = val;
6092 if (LA1 == ',' || LA1 == '}')
6093 match ();
6094 else
6095 goto failure;
6099 success:
6100 return 1;
6102 failure:
6104 if (data && *data)
6106 xfree (*data);
6107 *data = NULL;
6109 return 0;
6111 #undef match
6112 #undef expect
6113 #undef expect_ident
6117 /* Load XBM image IMG which will be displayed on frame F from buffer
6118 CONTENTS. END is the end of the buffer. Value is non-zero if
6119 successful. */
6121 static int
6122 xbm_load_image (f, img, contents, end)
6123 struct frame *f;
6124 struct image *img;
6125 char *contents, *end;
6127 int rc;
6128 unsigned char *data;
6129 int success_p = 0;
6131 rc = xbm_read_bitmap_data (contents, end, &img->width, &img->height, &data);
6132 if (rc)
6134 int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
6135 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
6136 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
6137 Lisp_Object value;
6139 xassert (img->width > 0 && img->height > 0);
6141 /* Get foreground and background colors, maybe allocate colors. */
6142 value = image_spec_value (img->spec, QCforeground, NULL);
6143 if (!NILP (value))
6144 foreground = x_alloc_image_color (f, img, value, foreground);
6145 value = image_spec_value (img->spec, QCbackground, NULL);
6146 if (!NILP (value))
6148 background = x_alloc_image_color (f, img, value, background);
6149 img->background = background;
6150 img->background_valid = 1;
6153 img->pixmap
6154 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
6155 FRAME_X_WINDOW (f),
6156 data,
6157 img->width, img->height,
6158 foreground, background,
6159 depth);
6160 xfree (data);
6162 if (img->pixmap == None)
6164 x_clear_image (f, img);
6165 image_error ("Unable to create X pixmap for `%s'", img->spec, Qnil);
6167 else
6168 success_p = 1;
6170 else
6171 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
6173 return success_p;
6177 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6179 static int
6180 xbm_file_p (data)
6181 Lisp_Object data;
6183 int w, h;
6184 return (STRINGP (data)
6185 && xbm_read_bitmap_data (SDATA (data),
6186 (SDATA (data)
6187 + SBYTES (data)),
6188 &w, &h, NULL));
6192 /* Fill image IMG which is used on frame F with pixmap data. Value is
6193 non-zero if successful. */
6195 static int
6196 xbm_load (f, img)
6197 struct frame *f;
6198 struct image *img;
6200 int success_p = 0;
6201 Lisp_Object file_name;
6203 xassert (xbm_image_p (img->spec));
6205 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6206 file_name = image_spec_value (img->spec, QCfile, NULL);
6207 if (STRINGP (file_name))
6209 Lisp_Object file;
6210 char *contents;
6211 int size;
6212 struct gcpro gcpro1;
6214 file = x_find_image_file (file_name);
6215 GCPRO1 (file);
6216 if (!STRINGP (file))
6218 image_error ("Cannot find image file `%s'", file_name, Qnil);
6219 UNGCPRO;
6220 return 0;
6223 contents = slurp_file (SDATA (file), &size);
6224 if (contents == NULL)
6226 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
6227 UNGCPRO;
6228 return 0;
6231 success_p = xbm_load_image (f, img, contents, contents + size);
6232 UNGCPRO;
6234 else
6236 struct image_keyword fmt[XBM_LAST];
6237 Lisp_Object data;
6238 int depth;
6239 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
6240 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
6241 char *bits;
6242 int parsed_p;
6243 int in_memory_file_p = 0;
6245 /* See if data looks like an in-memory XBM file. */
6246 data = image_spec_value (img->spec, QCdata, NULL);
6247 in_memory_file_p = xbm_file_p (data);
6249 /* Parse the image specification. */
6250 bcopy (xbm_format, fmt, sizeof fmt);
6251 parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm);
6252 xassert (parsed_p);
6254 /* Get specified width, and height. */
6255 if (!in_memory_file_p)
6257 img->width = XFASTINT (fmt[XBM_WIDTH].value);
6258 img->height = XFASTINT (fmt[XBM_HEIGHT].value);
6259 xassert (img->width > 0 && img->height > 0);
6262 /* Get foreground and background colors, maybe allocate colors. */
6263 if (fmt[XBM_FOREGROUND].count
6264 && STRINGP (fmt[XBM_FOREGROUND].value))
6265 foreground = x_alloc_image_color (f, img, fmt[XBM_FOREGROUND].value,
6266 foreground);
6267 if (fmt[XBM_BACKGROUND].count
6268 && STRINGP (fmt[XBM_BACKGROUND].value))
6269 background = x_alloc_image_color (f, img, fmt[XBM_BACKGROUND].value,
6270 background);
6272 if (in_memory_file_p)
6273 success_p = xbm_load_image (f, img, SDATA (data),
6274 (SDATA (data)
6275 + SBYTES (data)));
6276 else
6278 if (VECTORP (data))
6280 int i;
6281 char *p;
6282 int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
6284 p = bits = (char *) alloca (nbytes * img->height);
6285 for (i = 0; i < img->height; ++i, p += nbytes)
6287 Lisp_Object line = XVECTOR (data)->contents[i];
6288 if (STRINGP (line))
6289 bcopy (SDATA (line), p, nbytes);
6290 else
6291 bcopy (XBOOL_VECTOR (line)->data, p, nbytes);
6294 else if (STRINGP (data))
6295 bits = SDATA (data);
6296 else
6297 bits = XBOOL_VECTOR (data)->data;
6299 /* Create the pixmap. */
6300 depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
6301 img->pixmap
6302 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
6303 FRAME_X_WINDOW (f),
6304 bits,
6305 img->width, img->height,
6306 foreground, background,
6307 depth);
6308 if (img->pixmap)
6309 success_p = 1;
6310 else
6312 image_error ("Unable to create pixmap for XBM image `%s'",
6313 img->spec, Qnil);
6314 x_clear_image (f, img);
6319 return success_p;
6324 /***********************************************************************
6325 XPM images
6326 ***********************************************************************/
6328 #if HAVE_XPM
6330 static int xpm_image_p P_ ((Lisp_Object object));
6331 static int xpm_load P_ ((struct frame *f, struct image *img));
6332 static int xpm_valid_color_symbols_p P_ ((Lisp_Object));
6334 #include "X11/xpm.h"
6336 /* The symbol `xpm' identifying XPM-format images. */
6338 Lisp_Object Qxpm;
6340 /* Indices of image specification fields in xpm_format, below. */
6342 enum xpm_keyword_index
6344 XPM_TYPE,
6345 XPM_FILE,
6346 XPM_DATA,
6347 XPM_ASCENT,
6348 XPM_MARGIN,
6349 XPM_RELIEF,
6350 XPM_ALGORITHM,
6351 XPM_HEURISTIC_MASK,
6352 XPM_MASK,
6353 XPM_COLOR_SYMBOLS,
6354 XPM_BACKGROUND,
6355 XPM_LAST
6358 /* Vector of image_keyword structures describing the format
6359 of valid XPM image specifications. */
6361 static struct image_keyword xpm_format[XPM_LAST] =
6363 {":type", IMAGE_SYMBOL_VALUE, 1},
6364 {":file", IMAGE_STRING_VALUE, 0},
6365 {":data", IMAGE_STRING_VALUE, 0},
6366 {":ascent", IMAGE_ASCENT_VALUE, 0},
6367 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6368 {":relief", IMAGE_INTEGER_VALUE, 0},
6369 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6370 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6371 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6372 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6373 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
6376 /* Structure describing the image type XBM. */
6378 static struct image_type xpm_type =
6380 &Qxpm,
6381 xpm_image_p,
6382 xpm_load,
6383 x_clear_image,
6384 NULL
6388 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
6389 functions for allocating image colors. Our own functions handle
6390 color allocation failures more gracefully than the ones on the XPM
6391 lib. */
6393 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
6394 #define ALLOC_XPM_COLORS
6395 #endif
6397 #ifdef ALLOC_XPM_COLORS
6399 static void xpm_init_color_cache P_ ((struct frame *, XpmAttributes *));
6400 static void xpm_free_color_cache P_ ((void));
6401 static int xpm_lookup_color P_ ((struct frame *, char *, XColor *));
6402 static int xpm_color_bucket P_ ((char *));
6403 static struct xpm_cached_color *xpm_cache_color P_ ((struct frame *, char *,
6404 XColor *, int));
6406 /* An entry in a hash table used to cache color definitions of named
6407 colors. This cache is necessary to speed up XPM image loading in
6408 case we do color allocations ourselves. Without it, we would need
6409 a call to XParseColor per pixel in the image. */
6411 struct xpm_cached_color
6413 /* Next in collision chain. */
6414 struct xpm_cached_color *next;
6416 /* Color definition (RGB and pixel color). */
6417 XColor color;
6419 /* Color name. */
6420 char name[1];
6423 /* The hash table used for the color cache, and its bucket vector
6424 size. */
6426 #define XPM_COLOR_CACHE_BUCKETS 1001
6427 struct xpm_cached_color **xpm_color_cache;
6429 /* Initialize the color cache. */
6431 static void
6432 xpm_init_color_cache (f, attrs)
6433 struct frame *f;
6434 XpmAttributes *attrs;
6436 size_t nbytes = XPM_COLOR_CACHE_BUCKETS * sizeof *xpm_color_cache;
6437 xpm_color_cache = (struct xpm_cached_color **) xmalloc (nbytes);
6438 memset (xpm_color_cache, 0, nbytes);
6439 init_color_table ();
6441 if (attrs->valuemask & XpmColorSymbols)
6443 int i;
6444 XColor color;
6446 for (i = 0; i < attrs->numsymbols; ++i)
6447 if (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
6448 attrs->colorsymbols[i].value, &color))
6450 color.pixel = lookup_rgb_color (f, color.red, color.green,
6451 color.blue);
6452 xpm_cache_color (f, attrs->colorsymbols[i].name, &color, -1);
6458 /* Free the color cache. */
6460 static void
6461 xpm_free_color_cache ()
6463 struct xpm_cached_color *p, *next;
6464 int i;
6466 for (i = 0; i < XPM_COLOR_CACHE_BUCKETS; ++i)
6467 for (p = xpm_color_cache[i]; p; p = next)
6469 next = p->next;
6470 xfree (p);
6473 xfree (xpm_color_cache);
6474 xpm_color_cache = NULL;
6475 free_color_table ();
6479 /* Return the bucket index for color named COLOR_NAME in the color
6480 cache. */
6482 static int
6483 xpm_color_bucket (color_name)
6484 char *color_name;
6486 unsigned h = 0;
6487 char *s;
6489 for (s = color_name; *s; ++s)
6490 h = (h << 2) ^ *s;
6491 return h %= XPM_COLOR_CACHE_BUCKETS;
6495 /* On frame F, cache values COLOR for color with name COLOR_NAME.
6496 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
6497 entry added. */
6499 static struct xpm_cached_color *
6500 xpm_cache_color (f, color_name, color, bucket)
6501 struct frame *f;
6502 char *color_name;
6503 XColor *color;
6504 int bucket;
6506 size_t nbytes;
6507 struct xpm_cached_color *p;
6509 if (bucket < 0)
6510 bucket = xpm_color_bucket (color_name);
6512 nbytes = sizeof *p + strlen (color_name);
6513 p = (struct xpm_cached_color *) xmalloc (nbytes);
6514 strcpy (p->name, color_name);
6515 p->color = *color;
6516 p->next = xpm_color_cache[bucket];
6517 xpm_color_cache[bucket] = p;
6518 return p;
6522 /* Look up color COLOR_NAME for frame F in the color cache. If found,
6523 return the cached definition in *COLOR. Otherwise, make a new
6524 entry in the cache and allocate the color. Value is zero if color
6525 allocation failed. */
6527 static int
6528 xpm_lookup_color (f, color_name, color)
6529 struct frame *f;
6530 char *color_name;
6531 XColor *color;
6533 struct xpm_cached_color *p;
6534 int h = xpm_color_bucket (color_name);
6536 for (p = xpm_color_cache[h]; p; p = p->next)
6537 if (strcmp (p->name, color_name) == 0)
6538 break;
6540 if (p != NULL)
6541 *color = p->color;
6542 else if (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
6543 color_name, color))
6545 color->pixel = lookup_rgb_color (f, color->red, color->green,
6546 color->blue);
6547 p = xpm_cache_color (f, color_name, color, h);
6549 /* You get `opaque' at least from ImageMagick converting pbm to xpm
6550 with transparency, and it's useful. */
6551 else if (strcmp ("opaque", color_name) == 0)
6553 bzero (color, sizeof (XColor)); /* Is this necessary/correct? */
6554 color->pixel = FRAME_FOREGROUND_PIXEL (f);
6555 p = xpm_cache_color (f, color_name, color, h);
6558 return p != NULL;
6562 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
6563 CLOSURE is a pointer to the frame on which we allocate the
6564 color. Return in *COLOR the allocated color. Value is non-zero
6565 if successful. */
6567 static int
6568 xpm_alloc_color (dpy, cmap, color_name, color, closure)
6569 Display *dpy;
6570 Colormap cmap;
6571 char *color_name;
6572 XColor *color;
6573 void *closure;
6575 return xpm_lookup_color ((struct frame *) closure, color_name, color);
6579 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
6580 is a pointer to the frame on which we allocate the color. Value is
6581 non-zero if successful. */
6583 static int
6584 xpm_free_colors (dpy, cmap, pixels, npixels, closure)
6585 Display *dpy;
6586 Colormap cmap;
6587 Pixel *pixels;
6588 int npixels;
6589 void *closure;
6591 return 1;
6594 #endif /* ALLOC_XPM_COLORS */
6597 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
6598 for XPM images. Such a list must consist of conses whose car and
6599 cdr are strings. */
6601 static int
6602 xpm_valid_color_symbols_p (color_symbols)
6603 Lisp_Object color_symbols;
6605 while (CONSP (color_symbols))
6607 Lisp_Object sym = XCAR (color_symbols);
6608 if (!CONSP (sym)
6609 || !STRINGP (XCAR (sym))
6610 || !STRINGP (XCDR (sym)))
6611 break;
6612 color_symbols = XCDR (color_symbols);
6615 return NILP (color_symbols);
6619 /* Value is non-zero if OBJECT is a valid XPM image specification. */
6621 static int
6622 xpm_image_p (object)
6623 Lisp_Object object;
6625 struct image_keyword fmt[XPM_LAST];
6626 bcopy (xpm_format, fmt, sizeof fmt);
6627 return (parse_image_spec (object, fmt, XPM_LAST, Qxpm)
6628 /* Either `:file' or `:data' must be present. */
6629 && fmt[XPM_FILE].count + fmt[XPM_DATA].count == 1
6630 /* Either no `:color-symbols' or it's a list of conses
6631 whose car and cdr are strings. */
6632 && (fmt[XPM_COLOR_SYMBOLS].count == 0
6633 || xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value)));
6637 /* Load image IMG which will be displayed on frame F. Value is
6638 non-zero if successful. */
6640 static int
6641 xpm_load (f, img)
6642 struct frame *f;
6643 struct image *img;
6645 int rc;
6646 XpmAttributes attrs;
6647 Lisp_Object specified_file, color_symbols;
6649 /* Configure the XPM lib. Use the visual of frame F. Allocate
6650 close colors. Return colors allocated. */
6651 bzero (&attrs, sizeof attrs);
6652 attrs.visual = FRAME_X_VISUAL (f);
6653 attrs.colormap = FRAME_X_COLORMAP (f);
6654 attrs.valuemask |= XpmVisual;
6655 attrs.valuemask |= XpmColormap;
6657 #ifdef ALLOC_XPM_COLORS
6658 /* Allocate colors with our own functions which handle
6659 failing color allocation more gracefully. */
6660 attrs.color_closure = f;
6661 attrs.alloc_color = xpm_alloc_color;
6662 attrs.free_colors = xpm_free_colors;
6663 attrs.valuemask |= XpmAllocColor | XpmFreeColors | XpmColorClosure;
6664 #else /* not ALLOC_XPM_COLORS */
6665 /* Let the XPM lib allocate colors. */
6666 attrs.valuemask |= XpmReturnAllocPixels;
6667 #ifdef XpmAllocCloseColors
6668 attrs.alloc_close_colors = 1;
6669 attrs.valuemask |= XpmAllocCloseColors;
6670 #else /* not XpmAllocCloseColors */
6671 attrs.closeness = 600;
6672 attrs.valuemask |= XpmCloseness;
6673 #endif /* not XpmAllocCloseColors */
6674 #endif /* ALLOC_XPM_COLORS */
6676 /* If image specification contains symbolic color definitions, add
6677 these to `attrs'. */
6678 color_symbols = image_spec_value (img->spec, QCcolor_symbols, NULL);
6679 if (CONSP (color_symbols))
6681 Lisp_Object tail;
6682 XpmColorSymbol *xpm_syms;
6683 int i, size;
6685 attrs.valuemask |= XpmColorSymbols;
6687 /* Count number of symbols. */
6688 attrs.numsymbols = 0;
6689 for (tail = color_symbols; CONSP (tail); tail = XCDR (tail))
6690 ++attrs.numsymbols;
6692 /* Allocate an XpmColorSymbol array. */
6693 size = attrs.numsymbols * sizeof *xpm_syms;
6694 xpm_syms = (XpmColorSymbol *) alloca (size);
6695 bzero (xpm_syms, size);
6696 attrs.colorsymbols = xpm_syms;
6698 /* Fill the color symbol array. */
6699 for (tail = color_symbols, i = 0;
6700 CONSP (tail);
6701 ++i, tail = XCDR (tail))
6703 Lisp_Object name = XCAR (XCAR (tail));
6704 Lisp_Object color = XCDR (XCAR (tail));
6705 xpm_syms[i].name = (char *) alloca (SCHARS (name) + 1);
6706 strcpy (xpm_syms[i].name, SDATA (name));
6707 xpm_syms[i].value = (char *) alloca (SCHARS (color) + 1);
6708 strcpy (xpm_syms[i].value, SDATA (color));
6712 /* Create a pixmap for the image, either from a file, or from a
6713 string buffer containing data in the same format as an XPM file. */
6714 #ifdef ALLOC_XPM_COLORS
6715 xpm_init_color_cache (f, &attrs);
6716 #endif
6718 specified_file = image_spec_value (img->spec, QCfile, NULL);
6719 if (STRINGP (specified_file))
6721 Lisp_Object file = x_find_image_file (specified_file);
6722 if (!STRINGP (file))
6724 image_error ("Cannot find image file `%s'", specified_file, Qnil);
6725 return 0;
6728 rc = XpmReadFileToPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
6729 SDATA (file), &img->pixmap, &img->mask,
6730 &attrs);
6732 else
6734 Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL);
6735 rc = XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
6736 SDATA (buffer),
6737 &img->pixmap, &img->mask,
6738 &attrs);
6741 if (rc == XpmSuccess)
6743 #ifdef ALLOC_XPM_COLORS
6744 img->colors = colors_in_color_table (&img->ncolors);
6745 #else /* not ALLOC_XPM_COLORS */
6746 int i;
6748 img->ncolors = attrs.nalloc_pixels;
6749 img->colors = (unsigned long *) xmalloc (img->ncolors
6750 * sizeof *img->colors);
6751 for (i = 0; i < attrs.nalloc_pixels; ++i)
6753 img->colors[i] = attrs.alloc_pixels[i];
6754 #ifdef DEBUG_X_COLORS
6755 register_color (img->colors[i]);
6756 #endif
6758 #endif /* not ALLOC_XPM_COLORS */
6760 img->width = attrs.width;
6761 img->height = attrs.height;
6762 xassert (img->width > 0 && img->height > 0);
6764 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
6765 XpmFreeAttributes (&attrs);
6767 else
6769 switch (rc)
6771 case XpmOpenFailed:
6772 image_error ("Error opening XPM file (%s)", img->spec, Qnil);
6773 break;
6775 case XpmFileInvalid:
6776 image_error ("Invalid XPM file (%s)", img->spec, Qnil);
6777 break;
6779 case XpmNoMemory:
6780 image_error ("Out of memory (%s)", img->spec, Qnil);
6781 break;
6783 case XpmColorFailed:
6784 image_error ("Color allocation error (%s)", img->spec, Qnil);
6785 break;
6787 default:
6788 image_error ("Unknown error (%s)", img->spec, Qnil);
6789 break;
6793 #ifdef ALLOC_XPM_COLORS
6794 xpm_free_color_cache ();
6795 #endif
6796 return rc == XpmSuccess;
6799 #endif /* HAVE_XPM != 0 */
6802 /***********************************************************************
6803 Color table
6804 ***********************************************************************/
6806 /* An entry in the color table mapping an RGB color to a pixel color. */
6808 struct ct_color
6810 int r, g, b;
6811 unsigned long pixel;
6813 /* Next in color table collision list. */
6814 struct ct_color *next;
6817 /* The bucket vector size to use. Must be prime. */
6819 #define CT_SIZE 101
6821 /* Value is a hash of the RGB color given by R, G, and B. */
6823 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
6825 /* The color hash table. */
6827 struct ct_color **ct_table;
6829 /* Number of entries in the color table. */
6831 int ct_colors_allocated;
6833 /* Initialize the color table. */
6835 static void
6836 init_color_table ()
6838 int size = CT_SIZE * sizeof (*ct_table);
6839 ct_table = (struct ct_color **) xmalloc (size);
6840 bzero (ct_table, size);
6841 ct_colors_allocated = 0;
6845 /* Free memory associated with the color table. */
6847 static void
6848 free_color_table ()
6850 int i;
6851 struct ct_color *p, *next;
6853 for (i = 0; i < CT_SIZE; ++i)
6854 for (p = ct_table[i]; p; p = next)
6856 next = p->next;
6857 xfree (p);
6860 xfree (ct_table);
6861 ct_table = NULL;
6865 /* Value is a pixel color for RGB color R, G, B on frame F. If an
6866 entry for that color already is in the color table, return the
6867 pixel color of that entry. Otherwise, allocate a new color for R,
6868 G, B, and make an entry in the color table. */
6870 static unsigned long
6871 lookup_rgb_color (f, r, g, b)
6872 struct frame *f;
6873 int r, g, b;
6875 unsigned hash = CT_HASH_RGB (r, g, b);
6876 int i = hash % CT_SIZE;
6877 struct ct_color *p;
6878 struct x_display_info *dpyinfo;
6880 /* Handle TrueColor visuals specially, which improves performance by
6881 two orders of magnitude. Freeing colors on TrueColor visuals is
6882 a nop, and pixel colors specify RGB values directly. See also
6883 the Xlib spec, chapter 3.1. */
6884 dpyinfo = FRAME_X_DISPLAY_INFO (f);
6885 if (dpyinfo->red_bits > 0)
6887 unsigned long pr, pg, pb;
6889 /* Apply gamma-correction like normal color allocation does. */
6890 if (f->gamma)
6892 XColor color;
6893 color.red = r, color.green = g, color.blue = b;
6894 gamma_correct (f, &color);
6895 r = color.red, g = color.green, b = color.blue;
6898 /* Scale down RGB values to the visual's bits per RGB, and shift
6899 them to the right position in the pixel color. Note that the
6900 original RGB values are 16-bit values, as usual in X. */
6901 pr = (r >> (16 - dpyinfo->red_bits)) << dpyinfo->red_offset;
6902 pg = (g >> (16 - dpyinfo->green_bits)) << dpyinfo->green_offset;
6903 pb = (b >> (16 - dpyinfo->blue_bits)) << dpyinfo->blue_offset;
6905 /* Assemble the pixel color. */
6906 return pr | pg | pb;
6909 for (p = ct_table[i]; p; p = p->next)
6910 if (p->r == r && p->g == g && p->b == b)
6911 break;
6913 if (p == NULL)
6915 XColor color;
6916 Colormap cmap;
6917 int rc;
6919 color.red = r;
6920 color.green = g;
6921 color.blue = b;
6923 cmap = FRAME_X_COLORMAP (f);
6924 rc = x_alloc_nearest_color (f, cmap, &color);
6926 if (rc)
6928 ++ct_colors_allocated;
6930 p = (struct ct_color *) xmalloc (sizeof *p);
6931 p->r = r;
6932 p->g = g;
6933 p->b = b;
6934 p->pixel = color.pixel;
6935 p->next = ct_table[i];
6936 ct_table[i] = p;
6938 else
6939 return FRAME_FOREGROUND_PIXEL (f);
6942 return p->pixel;
6946 /* Look up pixel color PIXEL which is used on frame F in the color
6947 table. If not already present, allocate it. Value is PIXEL. */
6949 static unsigned long
6950 lookup_pixel_color (f, pixel)
6951 struct frame *f;
6952 unsigned long pixel;
6954 int i = pixel % CT_SIZE;
6955 struct ct_color *p;
6957 for (p = ct_table[i]; p; p = p->next)
6958 if (p->pixel == pixel)
6959 break;
6961 if (p == NULL)
6963 XColor color;
6964 Colormap cmap;
6965 int rc;
6967 cmap = FRAME_X_COLORMAP (f);
6968 color.pixel = pixel;
6969 x_query_color (f, &color);
6970 rc = x_alloc_nearest_color (f, cmap, &color);
6972 if (rc)
6974 ++ct_colors_allocated;
6976 p = (struct ct_color *) xmalloc (sizeof *p);
6977 p->r = color.red;
6978 p->g = color.green;
6979 p->b = color.blue;
6980 p->pixel = pixel;
6981 p->next = ct_table[i];
6982 ct_table[i] = p;
6984 else
6985 return FRAME_FOREGROUND_PIXEL (f);
6988 return p->pixel;
6992 /* Value is a vector of all pixel colors contained in the color table,
6993 allocated via xmalloc. Set *N to the number of colors. */
6995 static unsigned long *
6996 colors_in_color_table (n)
6997 int *n;
6999 int i, j;
7000 struct ct_color *p;
7001 unsigned long *colors;
7003 if (ct_colors_allocated == 0)
7005 *n = 0;
7006 colors = NULL;
7008 else
7010 colors = (unsigned long *) xmalloc (ct_colors_allocated
7011 * sizeof *colors);
7012 *n = ct_colors_allocated;
7014 for (i = j = 0; i < CT_SIZE; ++i)
7015 for (p = ct_table[i]; p; p = p->next)
7016 colors[j++] = p->pixel;
7019 return colors;
7024 /***********************************************************************
7025 Algorithms
7026 ***********************************************************************/
7028 static XColor *x_to_xcolors P_ ((struct frame *, struct image *, int));
7029 static void x_from_xcolors P_ ((struct frame *, struct image *, XColor *));
7030 static void x_detect_edges P_ ((struct frame *, struct image *, int[9], int));
7032 /* Non-zero means draw a cross on images having `:conversion
7033 disabled'. */
7035 int cross_disabled_images;
7037 /* Edge detection matrices for different edge-detection
7038 strategies. */
7040 static int emboss_matrix[9] = {
7041 /* x - 1 x x + 1 */
7042 2, -1, 0, /* y - 1 */
7043 -1, 0, 1, /* y */
7044 0, 1, -2 /* y + 1 */
7047 static int laplace_matrix[9] = {
7048 /* x - 1 x x + 1 */
7049 1, 0, 0, /* y - 1 */
7050 0, 0, 0, /* y */
7051 0, 0, -1 /* y + 1 */
7054 /* Value is the intensity of the color whose red/green/blue values
7055 are R, G, and B. */
7057 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7060 /* On frame F, return an array of XColor structures describing image
7061 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7062 non-zero means also fill the red/green/blue members of the XColor
7063 structures. Value is a pointer to the array of XColors structures,
7064 allocated with xmalloc; it must be freed by the caller. */
7066 static XColor *
7067 x_to_xcolors (f, img, rgb_p)
7068 struct frame *f;
7069 struct image *img;
7070 int rgb_p;
7072 int x, y;
7073 XColor *colors, *p;
7074 XImage *ximg;
7076 colors = (XColor *) xmalloc (img->width * img->height * sizeof *colors);
7078 /* Get the X image IMG->pixmap. */
7079 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
7080 0, 0, img->width, img->height, ~0, ZPixmap);
7082 /* Fill the `pixel' members of the XColor array. I wished there
7083 were an easy and portable way to circumvent XGetPixel. */
7084 p = colors;
7085 for (y = 0; y < img->height; ++y)
7087 XColor *row = p;
7089 for (x = 0; x < img->width; ++x, ++p)
7090 p->pixel = XGetPixel (ximg, x, y);
7092 if (rgb_p)
7093 x_query_colors (f, row, img->width);
7096 XDestroyImage (ximg);
7097 return colors;
7101 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7102 RGB members are set. F is the frame on which this all happens.
7103 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7105 static void
7106 x_from_xcolors (f, img, colors)
7107 struct frame *f;
7108 struct image *img;
7109 XColor *colors;
7111 int x, y;
7112 XImage *oimg;
7113 Pixmap pixmap;
7114 XColor *p;
7116 init_color_table ();
7118 x_create_x_image_and_pixmap (f, img->width, img->height, 0,
7119 &oimg, &pixmap);
7120 p = colors;
7121 for (y = 0; y < img->height; ++y)
7122 for (x = 0; x < img->width; ++x, ++p)
7124 unsigned long pixel;
7125 pixel = lookup_rgb_color (f, p->red, p->green, p->blue);
7126 XPutPixel (oimg, x, y, pixel);
7129 xfree (colors);
7130 x_clear_image_1 (f, img, 1, 0, 1);
7132 x_put_x_image (f, oimg, pixmap, img->width, img->height);
7133 x_destroy_x_image (oimg);
7134 img->pixmap = pixmap;
7135 img->colors = colors_in_color_table (&img->ncolors);
7136 free_color_table ();
7140 /* On frame F, perform edge-detection on image IMG.
7142 MATRIX is a nine-element array specifying the transformation
7143 matrix. See emboss_matrix for an example.
7145 COLOR_ADJUST is a color adjustment added to each pixel of the
7146 outgoing image. */
7148 static void
7149 x_detect_edges (f, img, matrix, color_adjust)
7150 struct frame *f;
7151 struct image *img;
7152 int matrix[9], color_adjust;
7154 XColor *colors = x_to_xcolors (f, img, 1);
7155 XColor *new, *p;
7156 int x, y, i, sum;
7158 for (i = sum = 0; i < 9; ++i)
7159 sum += abs (matrix[i]);
7161 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7163 new = (XColor *) xmalloc (img->width * img->height * sizeof *new);
7165 for (y = 0; y < img->height; ++y)
7167 p = COLOR (new, 0, y);
7168 p->red = p->green = p->blue = 0xffff/2;
7169 p = COLOR (new, img->width - 1, y);
7170 p->red = p->green = p->blue = 0xffff/2;
7173 for (x = 1; x < img->width - 1; ++x)
7175 p = COLOR (new, x, 0);
7176 p->red = p->green = p->blue = 0xffff/2;
7177 p = COLOR (new, x, img->height - 1);
7178 p->red = p->green = p->blue = 0xffff/2;
7181 for (y = 1; y < img->height - 1; ++y)
7183 p = COLOR (new, 1, y);
7185 for (x = 1; x < img->width - 1; ++x, ++p)
7187 int r, g, b, y1, x1;
7189 r = g = b = i = 0;
7190 for (y1 = y - 1; y1 < y + 2; ++y1)
7191 for (x1 = x - 1; x1 < x + 2; ++x1, ++i)
7192 if (matrix[i])
7194 XColor *t = COLOR (colors, x1, y1);
7195 r += matrix[i] * t->red;
7196 g += matrix[i] * t->green;
7197 b += matrix[i] * t->blue;
7200 r = (r / sum + color_adjust) & 0xffff;
7201 g = (g / sum + color_adjust) & 0xffff;
7202 b = (b / sum + color_adjust) & 0xffff;
7203 p->red = p->green = p->blue = COLOR_INTENSITY (r, g, b);
7207 xfree (colors);
7208 x_from_xcolors (f, img, new);
7210 #undef COLOR
7214 /* Perform the pre-defined `emboss' edge-detection on image IMG
7215 on frame F. */
7217 static void
7218 x_emboss (f, img)
7219 struct frame *f;
7220 struct image *img;
7222 x_detect_edges (f, img, emboss_matrix, 0xffff / 2);
7226 /* Perform the pre-defined `laplace' edge-detection on image IMG
7227 on frame F. */
7229 static void
7230 x_laplace (f, img)
7231 struct frame *f;
7232 struct image *img;
7234 x_detect_edges (f, img, laplace_matrix, 45000);
7238 /* Perform edge-detection on image IMG on frame F, with specified
7239 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7241 MATRIX must be either
7243 - a list of at least 9 numbers in row-major form
7244 - a vector of at least 9 numbers
7246 COLOR_ADJUST nil means use a default; otherwise it must be a
7247 number. */
7249 static void
7250 x_edge_detection (f, img, matrix, color_adjust)
7251 struct frame *f;
7252 struct image *img;
7253 Lisp_Object matrix, color_adjust;
7255 int i = 0;
7256 int trans[9];
7258 if (CONSP (matrix))
7260 for (i = 0;
7261 i < 9 && CONSP (matrix) && NUMBERP (XCAR (matrix));
7262 ++i, matrix = XCDR (matrix))
7263 trans[i] = XFLOATINT (XCAR (matrix));
7265 else if (VECTORP (matrix) && ASIZE (matrix) >= 9)
7267 for (i = 0; i < 9 && NUMBERP (AREF (matrix, i)); ++i)
7268 trans[i] = XFLOATINT (AREF (matrix, i));
7271 if (NILP (color_adjust))
7272 color_adjust = make_number (0xffff / 2);
7274 if (i == 9 && NUMBERP (color_adjust))
7275 x_detect_edges (f, img, trans, (int) XFLOATINT (color_adjust));
7279 /* Transform image IMG on frame F so that it looks disabled. */
7281 static void
7282 x_disable_image (f, img)
7283 struct frame *f;
7284 struct image *img;
7286 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
7288 if (dpyinfo->n_planes >= 2)
7290 /* Color (or grayscale). Convert to gray, and equalize. Just
7291 drawing such images with a stipple can look very odd, so
7292 we're using this method instead. */
7293 XColor *colors = x_to_xcolors (f, img, 1);
7294 XColor *p, *end;
7295 const int h = 15000;
7296 const int l = 30000;
7298 for (p = colors, end = colors + img->width * img->height;
7299 p < end;
7300 ++p)
7302 int i = COLOR_INTENSITY (p->red, p->green, p->blue);
7303 int i2 = (0xffff - h - l) * i / 0xffff + l;
7304 p->red = p->green = p->blue = i2;
7307 x_from_xcolors (f, img, colors);
7310 /* Draw a cross over the disabled image, if we must or if we
7311 should. */
7312 if (dpyinfo->n_planes < 2 || cross_disabled_images)
7314 Display *dpy = FRAME_X_DISPLAY (f);
7315 GC gc;
7317 gc = XCreateGC (dpy, img->pixmap, 0, NULL);
7318 XSetForeground (dpy, gc, BLACK_PIX_DEFAULT (f));
7319 XDrawLine (dpy, img->pixmap, gc, 0, 0,
7320 img->width - 1, img->height - 1);
7321 XDrawLine (dpy, img->pixmap, gc, 0, img->height - 1,
7322 img->width - 1, 0);
7323 XFreeGC (dpy, gc);
7325 if (img->mask)
7327 gc = XCreateGC (dpy, img->mask, 0, NULL);
7328 XSetForeground (dpy, gc, WHITE_PIX_DEFAULT (f));
7329 XDrawLine (dpy, img->mask, gc, 0, 0,
7330 img->width - 1, img->height - 1);
7331 XDrawLine (dpy, img->mask, gc, 0, img->height - 1,
7332 img->width - 1, 0);
7333 XFreeGC (dpy, gc);
7339 /* Build a mask for image IMG which is used on frame F. FILE is the
7340 name of an image file, for error messages. HOW determines how to
7341 determine the background color of IMG. If it is a list '(R G B)',
7342 with R, G, and B being integers >= 0, take that as the color of the
7343 background. Otherwise, determine the background color of IMG
7344 heuristically. Value is non-zero if successful. */
7346 static int
7347 x_build_heuristic_mask (f, img, how)
7348 struct frame *f;
7349 struct image *img;
7350 Lisp_Object how;
7352 Display *dpy = FRAME_X_DISPLAY (f);
7353 XImage *ximg, *mask_img;
7354 int x, y, rc, use_img_background;
7355 unsigned long bg = 0;
7357 if (img->mask)
7359 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
7360 img->mask = None;
7361 img->background_transparent_valid = 0;
7364 /* Create an image and pixmap serving as mask. */
7365 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1,
7366 &mask_img, &img->mask);
7367 if (!rc)
7368 return 0;
7370 /* Get the X image of IMG->pixmap. */
7371 ximg = XGetImage (dpy, img->pixmap, 0, 0, img->width, img->height,
7372 ~0, ZPixmap);
7374 /* Determine the background color of ximg. If HOW is `(R G B)'
7375 take that as color. Otherwise, use the image's background color. */
7376 use_img_background = 1;
7378 if (CONSP (how))
7380 int rgb[3], i;
7382 for (i = 0; i < 3 && CONSP (how) && NATNUMP (XCAR (how)); ++i)
7384 rgb[i] = XFASTINT (XCAR (how)) & 0xffff;
7385 how = XCDR (how);
7388 if (i == 3 && NILP (how))
7390 char color_name[30];
7391 sprintf (color_name, "#%04x%04x%04x", rgb[0], rgb[1], rgb[2]);
7392 bg = x_alloc_image_color (f, img, build_string (color_name), 0);
7393 use_img_background = 0;
7397 if (use_img_background)
7398 bg = four_corners_best (ximg, img->width, img->height);
7400 /* Set all bits in mask_img to 1 whose color in ximg is different
7401 from the background color bg. */
7402 for (y = 0; y < img->height; ++y)
7403 for (x = 0; x < img->width; ++x)
7404 XPutPixel (mask_img, x, y, XGetPixel (ximg, x, y) != bg);
7406 /* Fill in the background_transparent field while we have the mask handy. */
7407 image_background_transparent (img, f, mask_img);
7409 /* Put mask_img into img->mask. */
7410 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
7411 x_destroy_x_image (mask_img);
7412 XDestroyImage (ximg);
7414 return 1;
7419 /***********************************************************************
7420 PBM (mono, gray, color)
7421 ***********************************************************************/
7423 static int pbm_image_p P_ ((Lisp_Object object));
7424 static int pbm_load P_ ((struct frame *f, struct image *img));
7425 static int pbm_scan_number P_ ((unsigned char **, unsigned char *));
7427 /* The symbol `pbm' identifying images of this type. */
7429 Lisp_Object Qpbm;
7431 /* Indices of image specification fields in gs_format, below. */
7433 enum pbm_keyword_index
7435 PBM_TYPE,
7436 PBM_FILE,
7437 PBM_DATA,
7438 PBM_ASCENT,
7439 PBM_MARGIN,
7440 PBM_RELIEF,
7441 PBM_ALGORITHM,
7442 PBM_HEURISTIC_MASK,
7443 PBM_MASK,
7444 PBM_FOREGROUND,
7445 PBM_BACKGROUND,
7446 PBM_LAST
7449 /* Vector of image_keyword structures describing the format
7450 of valid user-defined image specifications. */
7452 static struct image_keyword pbm_format[PBM_LAST] =
7454 {":type", IMAGE_SYMBOL_VALUE, 1},
7455 {":file", IMAGE_STRING_VALUE, 0},
7456 {":data", IMAGE_STRING_VALUE, 0},
7457 {":ascent", IMAGE_ASCENT_VALUE, 0},
7458 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
7459 {":relief", IMAGE_INTEGER_VALUE, 0},
7460 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7461 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7462 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7463 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
7464 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
7467 /* Structure describing the image type `pbm'. */
7469 static struct image_type pbm_type =
7471 &Qpbm,
7472 pbm_image_p,
7473 pbm_load,
7474 x_clear_image,
7475 NULL
7479 /* Return non-zero if OBJECT is a valid PBM image specification. */
7481 static int
7482 pbm_image_p (object)
7483 Lisp_Object object;
7485 struct image_keyword fmt[PBM_LAST];
7487 bcopy (pbm_format, fmt, sizeof fmt);
7489 if (!parse_image_spec (object, fmt, PBM_LAST, Qpbm))
7490 return 0;
7492 /* Must specify either :data or :file. */
7493 return fmt[PBM_DATA].count + fmt[PBM_FILE].count == 1;
7497 /* Scan a decimal number from *S and return it. Advance *S while
7498 reading the number. END is the end of the string. Value is -1 at
7499 end of input. */
7501 static int
7502 pbm_scan_number (s, end)
7503 unsigned char **s, *end;
7505 int c = 0, val = -1;
7507 while (*s < end)
7509 /* Skip white-space. */
7510 while (*s < end && (c = *(*s)++, isspace (c)))
7513 if (c == '#')
7515 /* Skip comment to end of line. */
7516 while (*s < end && (c = *(*s)++, c != '\n'))
7519 else if (isdigit (c))
7521 /* Read decimal number. */
7522 val = c - '0';
7523 while (*s < end && (c = *(*s)++, isdigit (c)))
7524 val = 10 * val + c - '0';
7525 break;
7527 else
7528 break;
7531 return val;
7535 /* Load PBM image IMG for use on frame F. */
7537 static int
7538 pbm_load (f, img)
7539 struct frame *f;
7540 struct image *img;
7542 int raw_p, x, y;
7543 int width, height, max_color_idx = 0;
7544 XImage *ximg;
7545 Lisp_Object file, specified_file;
7546 enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type;
7547 struct gcpro gcpro1;
7548 unsigned char *contents = NULL;
7549 unsigned char *end, *p;
7550 int size;
7552 specified_file = image_spec_value (img->spec, QCfile, NULL);
7553 file = Qnil;
7554 GCPRO1 (file);
7556 if (STRINGP (specified_file))
7558 file = x_find_image_file (specified_file);
7559 if (!STRINGP (file))
7561 image_error ("Cannot find image file `%s'", specified_file, Qnil);
7562 UNGCPRO;
7563 return 0;
7566 contents = slurp_file (SDATA (file), &size);
7567 if (contents == NULL)
7569 image_error ("Error reading `%s'", file, Qnil);
7570 UNGCPRO;
7571 return 0;
7574 p = contents;
7575 end = contents + size;
7577 else
7579 Lisp_Object data;
7580 data = image_spec_value (img->spec, QCdata, NULL);
7581 p = SDATA (data);
7582 end = p + SBYTES (data);
7585 /* Check magic number. */
7586 if (end - p < 2 || *p++ != 'P')
7588 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
7589 error:
7590 xfree (contents);
7591 UNGCPRO;
7592 return 0;
7595 switch (*p++)
7597 case '1':
7598 raw_p = 0, type = PBM_MONO;
7599 break;
7601 case '2':
7602 raw_p = 0, type = PBM_GRAY;
7603 break;
7605 case '3':
7606 raw_p = 0, type = PBM_COLOR;
7607 break;
7609 case '4':
7610 raw_p = 1, type = PBM_MONO;
7611 break;
7613 case '5':
7614 raw_p = 1, type = PBM_GRAY;
7615 break;
7617 case '6':
7618 raw_p = 1, type = PBM_COLOR;
7619 break;
7621 default:
7622 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
7623 goto error;
7626 /* Read width, height, maximum color-component. Characters
7627 starting with `#' up to the end of a line are ignored. */
7628 width = pbm_scan_number (&p, end);
7629 height = pbm_scan_number (&p, end);
7631 if (type != PBM_MONO)
7633 max_color_idx = pbm_scan_number (&p, end);
7634 if (raw_p && max_color_idx > 255)
7635 max_color_idx = 255;
7638 if (width < 0
7639 || height < 0
7640 || (type != PBM_MONO && max_color_idx < 0))
7641 goto error;
7643 if (!x_create_x_image_and_pixmap (f, width, height, 0,
7644 &ximg, &img->pixmap))
7645 goto error;
7647 /* Initialize the color hash table. */
7648 init_color_table ();
7650 if (type == PBM_MONO)
7652 int c = 0, g;
7653 struct image_keyword fmt[PBM_LAST];
7654 unsigned long fg = FRAME_FOREGROUND_PIXEL (f);
7655 unsigned long bg = FRAME_BACKGROUND_PIXEL (f);
7657 /* Parse the image specification. */
7658 bcopy (pbm_format, fmt, sizeof fmt);
7659 parse_image_spec (img->spec, fmt, PBM_LAST, Qpbm);
7661 /* Get foreground and background colors, maybe allocate colors. */
7662 if (fmt[PBM_FOREGROUND].count
7663 && STRINGP (fmt[PBM_FOREGROUND].value))
7664 fg = x_alloc_image_color (f, img, fmt[PBM_FOREGROUND].value, fg);
7665 if (fmt[PBM_BACKGROUND].count
7666 && STRINGP (fmt[PBM_BACKGROUND].value))
7668 bg = x_alloc_image_color (f, img, fmt[PBM_BACKGROUND].value, bg);
7669 img->background = bg;
7670 img->background_valid = 1;
7673 for (y = 0; y < height; ++y)
7674 for (x = 0; x < width; ++x)
7676 if (raw_p)
7678 if ((x & 7) == 0)
7679 c = *p++;
7680 g = c & 0x80;
7681 c <<= 1;
7683 else
7684 g = pbm_scan_number (&p, end);
7686 XPutPixel (ximg, x, y, g ? fg : bg);
7689 else
7691 for (y = 0; y < height; ++y)
7692 for (x = 0; x < width; ++x)
7694 int r, g, b;
7696 if (type == PBM_GRAY)
7697 r = g = b = raw_p ? *p++ : pbm_scan_number (&p, end);
7698 else if (raw_p)
7700 r = *p++;
7701 g = *p++;
7702 b = *p++;
7704 else
7706 r = pbm_scan_number (&p, end);
7707 g = pbm_scan_number (&p, end);
7708 b = pbm_scan_number (&p, end);
7711 if (r < 0 || g < 0 || b < 0)
7713 xfree (ximg->data);
7714 ximg->data = NULL;
7715 XDestroyImage (ximg);
7716 image_error ("Invalid pixel value in image `%s'",
7717 img->spec, Qnil);
7718 goto error;
7721 /* RGB values are now in the range 0..max_color_idx.
7722 Scale this to the range 0..0xffff supported by X. */
7723 r = (double) r * 65535 / max_color_idx;
7724 g = (double) g * 65535 / max_color_idx;
7725 b = (double) b * 65535 / max_color_idx;
7726 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
7730 /* Store in IMG->colors the colors allocated for the image, and
7731 free the color table. */
7732 img->colors = colors_in_color_table (&img->ncolors);
7733 free_color_table ();
7735 /* Maybe fill in the background field while we have ximg handy. */
7736 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
7737 IMAGE_BACKGROUND (img, f, ximg);
7739 /* Put the image into a pixmap. */
7740 x_put_x_image (f, ximg, img->pixmap, width, height);
7741 x_destroy_x_image (ximg);
7743 img->width = width;
7744 img->height = height;
7746 UNGCPRO;
7747 xfree (contents);
7748 return 1;
7753 /***********************************************************************
7755 ***********************************************************************/
7757 #if HAVE_PNG
7759 #if defined HAVE_LIBPNG_PNG_H
7760 # include <libpng/png.h>
7761 #else
7762 # include <png.h>
7763 #endif
7765 /* Function prototypes. */
7767 static int png_image_p P_ ((Lisp_Object object));
7768 static int png_load P_ ((struct frame *f, struct image *img));
7770 /* The symbol `png' identifying images of this type. */
7772 Lisp_Object Qpng;
7774 /* Indices of image specification fields in png_format, below. */
7776 enum png_keyword_index
7778 PNG_TYPE,
7779 PNG_DATA,
7780 PNG_FILE,
7781 PNG_ASCENT,
7782 PNG_MARGIN,
7783 PNG_RELIEF,
7784 PNG_ALGORITHM,
7785 PNG_HEURISTIC_MASK,
7786 PNG_MASK,
7787 PNG_BACKGROUND,
7788 PNG_LAST
7791 /* Vector of image_keyword structures describing the format
7792 of valid user-defined image specifications. */
7794 static struct image_keyword png_format[PNG_LAST] =
7796 {":type", IMAGE_SYMBOL_VALUE, 1},
7797 {":data", IMAGE_STRING_VALUE, 0},
7798 {":file", IMAGE_STRING_VALUE, 0},
7799 {":ascent", IMAGE_ASCENT_VALUE, 0},
7800 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
7801 {":relief", IMAGE_INTEGER_VALUE, 0},
7802 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7803 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7804 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7805 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
7808 /* Structure describing the image type `png'. */
7810 static struct image_type png_type =
7812 &Qpng,
7813 png_image_p,
7814 png_load,
7815 x_clear_image,
7816 NULL
7820 /* Return non-zero if OBJECT is a valid PNG image specification. */
7822 static int
7823 png_image_p (object)
7824 Lisp_Object object;
7826 struct image_keyword fmt[PNG_LAST];
7827 bcopy (png_format, fmt, sizeof fmt);
7829 if (!parse_image_spec (object, fmt, PNG_LAST, Qpng))
7830 return 0;
7832 /* Must specify either the :data or :file keyword. */
7833 return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
7837 /* Error and warning handlers installed when the PNG library
7838 is initialized. */
7840 static void
7841 my_png_error (png_ptr, msg)
7842 png_struct *png_ptr;
7843 char *msg;
7845 xassert (png_ptr != NULL);
7846 image_error ("PNG error: %s", build_string (msg), Qnil);
7847 longjmp (png_ptr->jmpbuf, 1);
7851 static void
7852 my_png_warning (png_ptr, msg)
7853 png_struct *png_ptr;
7854 char *msg;
7856 xassert (png_ptr != NULL);
7857 image_error ("PNG warning: %s", build_string (msg), Qnil);
7860 /* Memory source for PNG decoding. */
7862 struct png_memory_storage
7864 unsigned char *bytes; /* The data */
7865 size_t len; /* How big is it? */
7866 int index; /* Where are we? */
7870 /* Function set as reader function when reading PNG image from memory.
7871 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
7872 bytes from the input to DATA. */
7874 static void
7875 png_read_from_memory (png_ptr, data, length)
7876 png_structp png_ptr;
7877 png_bytep data;
7878 png_size_t length;
7880 struct png_memory_storage *tbr
7881 = (struct png_memory_storage *) png_get_io_ptr (png_ptr);
7883 if (length > tbr->len - tbr->index)
7884 png_error (png_ptr, "Read error");
7886 bcopy (tbr->bytes + tbr->index, data, length);
7887 tbr->index = tbr->index + length;
7890 /* Load PNG image IMG for use on frame F. Value is non-zero if
7891 successful. */
7893 static int
7894 png_load (f, img)
7895 struct frame *f;
7896 struct image *img;
7898 Lisp_Object file, specified_file;
7899 Lisp_Object specified_data;
7900 int x, y, i;
7901 XImage *ximg, *mask_img = NULL;
7902 struct gcpro gcpro1;
7903 png_struct *png_ptr = NULL;
7904 png_info *info_ptr = NULL, *end_info = NULL;
7905 FILE *volatile fp = NULL;
7906 png_byte sig[8];
7907 png_byte * volatile pixels = NULL;
7908 png_byte ** volatile rows = NULL;
7909 png_uint_32 width, height;
7910 int bit_depth, color_type, interlace_type;
7911 png_byte channels;
7912 png_uint_32 row_bytes;
7913 int transparent_p;
7914 double screen_gamma;
7915 struct png_memory_storage tbr; /* Data to be read */
7917 /* Find out what file to load. */
7918 specified_file = image_spec_value (img->spec, QCfile, NULL);
7919 specified_data = image_spec_value (img->spec, QCdata, NULL);
7920 file = Qnil;
7921 GCPRO1 (file);
7923 if (NILP (specified_data))
7925 file = x_find_image_file (specified_file);
7926 if (!STRINGP (file))
7928 image_error ("Cannot find image file `%s'", specified_file, Qnil);
7929 UNGCPRO;
7930 return 0;
7933 /* Open the image file. */
7934 fp = fopen (SDATA (file), "rb");
7935 if (!fp)
7937 image_error ("Cannot open image file `%s'", file, Qnil);
7938 UNGCPRO;
7939 fclose (fp);
7940 return 0;
7943 /* Check PNG signature. */
7944 if (fread (sig, 1, sizeof sig, fp) != sizeof sig
7945 || !png_check_sig (sig, sizeof sig))
7947 image_error ("Not a PNG file: `%s'", file, Qnil);
7948 UNGCPRO;
7949 fclose (fp);
7950 return 0;
7953 else
7955 /* Read from memory. */
7956 tbr.bytes = SDATA (specified_data);
7957 tbr.len = SBYTES (specified_data);
7958 tbr.index = 0;
7960 /* Check PNG signature. */
7961 if (tbr.len < sizeof sig
7962 || !png_check_sig (tbr.bytes, sizeof sig))
7964 image_error ("Not a PNG image: `%s'", img->spec, Qnil);
7965 UNGCPRO;
7966 return 0;
7969 /* Need to skip past the signature. */
7970 tbr.bytes += sizeof (sig);
7973 /* Initialize read and info structs for PNG lib. */
7974 png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL,
7975 my_png_error, my_png_warning);
7976 if (!png_ptr)
7978 if (fp) fclose (fp);
7979 UNGCPRO;
7980 return 0;
7983 info_ptr = png_create_info_struct (png_ptr);
7984 if (!info_ptr)
7986 png_destroy_read_struct (&png_ptr, NULL, NULL);
7987 if (fp) fclose (fp);
7988 UNGCPRO;
7989 return 0;
7992 end_info = png_create_info_struct (png_ptr);
7993 if (!end_info)
7995 png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
7996 if (fp) fclose (fp);
7997 UNGCPRO;
7998 return 0;
8001 /* Set error jump-back. We come back here when the PNG library
8002 detects an error. */
8003 if (setjmp (png_ptr->jmpbuf))
8005 error:
8006 if (png_ptr)
8007 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
8008 xfree (pixels);
8009 xfree (rows);
8010 if (fp) fclose (fp);
8011 UNGCPRO;
8012 return 0;
8015 /* Read image info. */
8016 if (!NILP (specified_data))
8017 png_set_read_fn (png_ptr, (void *) &tbr, png_read_from_memory);
8018 else
8019 png_init_io (png_ptr, fp);
8021 png_set_sig_bytes (png_ptr, sizeof sig);
8022 png_read_info (png_ptr, info_ptr);
8023 png_get_IHDR (png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
8024 &interlace_type, NULL, NULL);
8026 /* If image contains simply transparency data, we prefer to
8027 construct a clipping mask. */
8028 if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
8029 transparent_p = 1;
8030 else
8031 transparent_p = 0;
8033 /* This function is easier to write if we only have to handle
8034 one data format: RGB or RGBA with 8 bits per channel. Let's
8035 transform other formats into that format. */
8037 /* Strip more than 8 bits per channel. */
8038 if (bit_depth == 16)
8039 png_set_strip_16 (png_ptr);
8041 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8042 if available. */
8043 png_set_expand (png_ptr);
8045 /* Convert grayscale images to RGB. */
8046 if (color_type == PNG_COLOR_TYPE_GRAY
8047 || color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
8048 png_set_gray_to_rgb (png_ptr);
8050 screen_gamma = (f->gamma ? 1 / f->gamma / 0.45455 : 2.2);
8052 #if 0 /* Avoid double gamma correction for PNG images. */
8053 { /* Tell the PNG lib to handle gamma correction for us. */
8054 int intent;
8055 double image_gamma;
8056 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8057 if (png_get_sRGB (png_ptr, info_ptr, &intent))
8058 /* The libpng documentation says this is right in this case. */
8059 png_set_gamma (png_ptr, screen_gamma, 0.45455);
8060 else
8061 #endif
8062 if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
8063 /* Image contains gamma information. */
8064 png_set_gamma (png_ptr, screen_gamma, image_gamma);
8065 else
8066 /* Use the standard default for the image gamma. */
8067 png_set_gamma (png_ptr, screen_gamma, 0.45455);
8069 #endif /* if 0 */
8071 /* Handle alpha channel by combining the image with a background
8072 color. Do this only if a real alpha channel is supplied. For
8073 simple transparency, we prefer a clipping mask. */
8074 if (!transparent_p)
8076 png_color_16 *image_bg;
8077 Lisp_Object specified_bg
8078 = image_spec_value (img->spec, QCbackground, NULL);
8080 if (STRINGP (specified_bg))
8081 /* The user specified `:background', use that. */
8083 XColor color;
8084 if (x_defined_color (f, SDATA (specified_bg), &color, 0))
8086 png_color_16 user_bg;
8088 bzero (&user_bg, sizeof user_bg);
8089 user_bg.red = color.red;
8090 user_bg.green = color.green;
8091 user_bg.blue = color.blue;
8093 png_set_background (png_ptr, &user_bg,
8094 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
8097 else if (png_get_bKGD (png_ptr, info_ptr, &image_bg))
8098 /* Image contains a background color with which to
8099 combine the image. */
8100 png_set_background (png_ptr, image_bg,
8101 PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
8102 else
8104 /* Image does not contain a background color with which
8105 to combine the image data via an alpha channel. Use
8106 the frame's background instead. */
8107 XColor color;
8108 Colormap cmap;
8109 png_color_16 frame_background;
8111 cmap = FRAME_X_COLORMAP (f);
8112 color.pixel = FRAME_BACKGROUND_PIXEL (f);
8113 x_query_color (f, &color);
8115 bzero (&frame_background, sizeof frame_background);
8116 frame_background.red = color.red;
8117 frame_background.green = color.green;
8118 frame_background.blue = color.blue;
8120 png_set_background (png_ptr, &frame_background,
8121 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
8125 /* Update info structure. */
8126 png_read_update_info (png_ptr, info_ptr);
8128 /* Get number of channels. Valid values are 1 for grayscale images
8129 and images with a palette, 2 for grayscale images with transparency
8130 information (alpha channel), 3 for RGB images, and 4 for RGB
8131 images with alpha channel, i.e. RGBA. If conversions above were
8132 sufficient we should only have 3 or 4 channels here. */
8133 channels = png_get_channels (png_ptr, info_ptr);
8134 xassert (channels == 3 || channels == 4);
8136 /* Number of bytes needed for one row of the image. */
8137 row_bytes = png_get_rowbytes (png_ptr, info_ptr);
8139 /* Allocate memory for the image. */
8140 pixels = (png_byte *) xmalloc (row_bytes * height * sizeof *pixels);
8141 rows = (png_byte **) xmalloc (height * sizeof *rows);
8142 for (i = 0; i < height; ++i)
8143 rows[i] = pixels + i * row_bytes;
8145 /* Read the entire image. */
8146 png_read_image (png_ptr, rows);
8147 png_read_end (png_ptr, info_ptr);
8148 if (fp)
8150 fclose (fp);
8151 fp = NULL;
8154 /* Create the X image and pixmap. */
8155 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
8156 &img->pixmap))
8157 goto error;
8159 /* Create an image and pixmap serving as mask if the PNG image
8160 contains an alpha channel. */
8161 if (channels == 4
8162 && !transparent_p
8163 && !x_create_x_image_and_pixmap (f, width, height, 1,
8164 &mask_img, &img->mask))
8166 x_destroy_x_image (ximg);
8167 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
8168 img->pixmap = None;
8169 goto error;
8172 /* Fill the X image and mask from PNG data. */
8173 init_color_table ();
8175 for (y = 0; y < height; ++y)
8177 png_byte *p = rows[y];
8179 for (x = 0; x < width; ++x)
8181 unsigned r, g, b;
8183 r = *p++ << 8;
8184 g = *p++ << 8;
8185 b = *p++ << 8;
8186 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
8188 /* An alpha channel, aka mask channel, associates variable
8189 transparency with an image. Where other image formats
8190 support binary transparency---fully transparent or fully
8191 opaque---PNG allows up to 254 levels of partial transparency.
8192 The PNG library implements partial transparency by combining
8193 the image with a specified background color.
8195 I'm not sure how to handle this here nicely: because the
8196 background on which the image is displayed may change, for
8197 real alpha channel support, it would be necessary to create
8198 a new image for each possible background.
8200 What I'm doing now is that a mask is created if we have
8201 boolean transparency information. Otherwise I'm using
8202 the frame's background color to combine the image with. */
8204 if (channels == 4)
8206 if (mask_img)
8207 XPutPixel (mask_img, x, y, *p > 0);
8208 ++p;
8213 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
8214 /* Set IMG's background color from the PNG image, unless the user
8215 overrode it. */
8217 png_color_16 *bg;
8218 if (png_get_bKGD (png_ptr, info_ptr, &bg))
8220 img->background = lookup_rgb_color (f, bg->red, bg->green, bg->blue);
8221 img->background_valid = 1;
8225 /* Remember colors allocated for this image. */
8226 img->colors = colors_in_color_table (&img->ncolors);
8227 free_color_table ();
8229 /* Clean up. */
8230 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
8231 xfree (rows);
8232 xfree (pixels);
8234 img->width = width;
8235 img->height = height;
8237 /* Maybe fill in the background field while we have ximg handy. */
8238 IMAGE_BACKGROUND (img, f, ximg);
8240 /* Put the image into the pixmap, then free the X image and its buffer. */
8241 x_put_x_image (f, ximg, img->pixmap, width, height);
8242 x_destroy_x_image (ximg);
8244 /* Same for the mask. */
8245 if (mask_img)
8247 /* Fill in the background_transparent field while we have the mask
8248 handy. */
8249 image_background_transparent (img, f, mask_img);
8251 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
8252 x_destroy_x_image (mask_img);
8255 UNGCPRO;
8256 return 1;
8259 #endif /* HAVE_PNG != 0 */
8263 /***********************************************************************
8264 JPEG
8265 ***********************************************************************/
8267 #if HAVE_JPEG
8269 /* Work around a warning about HAVE_STDLIB_H being redefined in
8270 jconfig.h. */
8271 #ifdef HAVE_STDLIB_H
8272 #define HAVE_STDLIB_H_1
8273 #undef HAVE_STDLIB_H
8274 #endif /* HAVE_STLIB_H */
8276 #include <jpeglib.h>
8277 #include <jerror.h>
8278 #include <setjmp.h>
8280 #ifdef HAVE_STLIB_H_1
8281 #define HAVE_STDLIB_H 1
8282 #endif
8284 static int jpeg_image_p P_ ((Lisp_Object object));
8285 static int jpeg_load P_ ((struct frame *f, struct image *img));
8287 /* The symbol `jpeg' identifying images of this type. */
8289 Lisp_Object Qjpeg;
8291 /* Indices of image specification fields in gs_format, below. */
8293 enum jpeg_keyword_index
8295 JPEG_TYPE,
8296 JPEG_DATA,
8297 JPEG_FILE,
8298 JPEG_ASCENT,
8299 JPEG_MARGIN,
8300 JPEG_RELIEF,
8301 JPEG_ALGORITHM,
8302 JPEG_HEURISTIC_MASK,
8303 JPEG_MASK,
8304 JPEG_BACKGROUND,
8305 JPEG_LAST
8308 /* Vector of image_keyword structures describing the format
8309 of valid user-defined image specifications. */
8311 static struct image_keyword jpeg_format[JPEG_LAST] =
8313 {":type", IMAGE_SYMBOL_VALUE, 1},
8314 {":data", IMAGE_STRING_VALUE, 0},
8315 {":file", IMAGE_STRING_VALUE, 0},
8316 {":ascent", IMAGE_ASCENT_VALUE, 0},
8317 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
8318 {":relief", IMAGE_INTEGER_VALUE, 0},
8319 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8320 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8321 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8322 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
8325 /* Structure describing the image type `jpeg'. */
8327 static struct image_type jpeg_type =
8329 &Qjpeg,
8330 jpeg_image_p,
8331 jpeg_load,
8332 x_clear_image,
8333 NULL
8337 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8339 static int
8340 jpeg_image_p (object)
8341 Lisp_Object object;
8343 struct image_keyword fmt[JPEG_LAST];
8345 bcopy (jpeg_format, fmt, sizeof fmt);
8347 if (!parse_image_spec (object, fmt, JPEG_LAST, Qjpeg))
8348 return 0;
8350 /* Must specify either the :data or :file keyword. */
8351 return fmt[JPEG_FILE].count + fmt[JPEG_DATA].count == 1;
8355 struct my_jpeg_error_mgr
8357 struct jpeg_error_mgr pub;
8358 jmp_buf setjmp_buffer;
8362 static void
8363 my_error_exit (cinfo)
8364 j_common_ptr cinfo;
8366 struct my_jpeg_error_mgr *mgr = (struct my_jpeg_error_mgr *) cinfo->err;
8367 longjmp (mgr->setjmp_buffer, 1);
8371 /* Init source method for JPEG data source manager. Called by
8372 jpeg_read_header() before any data is actually read. See
8373 libjpeg.doc from the JPEG lib distribution. */
8375 static void
8376 our_init_source (cinfo)
8377 j_decompress_ptr cinfo;
8382 /* Fill input buffer method for JPEG data source manager. Called
8383 whenever more data is needed. We read the whole image in one step,
8384 so this only adds a fake end of input marker at the end. */
8386 static boolean
8387 our_fill_input_buffer (cinfo)
8388 j_decompress_ptr cinfo;
8390 /* Insert a fake EOI marker. */
8391 struct jpeg_source_mgr *src = cinfo->src;
8392 static JOCTET buffer[2];
8394 buffer[0] = (JOCTET) 0xFF;
8395 buffer[1] = (JOCTET) JPEG_EOI;
8397 src->next_input_byte = buffer;
8398 src->bytes_in_buffer = 2;
8399 return TRUE;
8403 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8404 is the JPEG data source manager. */
8406 static void
8407 our_skip_input_data (cinfo, num_bytes)
8408 j_decompress_ptr cinfo;
8409 long num_bytes;
8411 struct jpeg_source_mgr *src = (struct jpeg_source_mgr *) cinfo->src;
8413 if (src)
8415 if (num_bytes > src->bytes_in_buffer)
8416 ERREXIT (cinfo, JERR_INPUT_EOF);
8418 src->bytes_in_buffer -= num_bytes;
8419 src->next_input_byte += num_bytes;
8424 /* Method to terminate data source. Called by
8425 jpeg_finish_decompress() after all data has been processed. */
8427 static void
8428 our_term_source (cinfo)
8429 j_decompress_ptr cinfo;
8434 /* Set up the JPEG lib for reading an image from DATA which contains
8435 LEN bytes. CINFO is the decompression info structure created for
8436 reading the image. */
8438 static void
8439 jpeg_memory_src (cinfo, data, len)
8440 j_decompress_ptr cinfo;
8441 JOCTET *data;
8442 unsigned int len;
8444 struct jpeg_source_mgr *src;
8446 if (cinfo->src == NULL)
8448 /* First time for this JPEG object? */
8449 cinfo->src = (struct jpeg_source_mgr *)
8450 (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,
8451 sizeof (struct jpeg_source_mgr));
8452 src = (struct jpeg_source_mgr *) cinfo->src;
8453 src->next_input_byte = data;
8456 src = (struct jpeg_source_mgr *) cinfo->src;
8457 src->init_source = our_init_source;
8458 src->fill_input_buffer = our_fill_input_buffer;
8459 src->skip_input_data = our_skip_input_data;
8460 src->resync_to_restart = jpeg_resync_to_restart; /* Use default method. */
8461 src->term_source = our_term_source;
8462 src->bytes_in_buffer = len;
8463 src->next_input_byte = data;
8467 /* Load image IMG for use on frame F. Patterned after example.c
8468 from the JPEG lib. */
8470 static int
8471 jpeg_load (f, img)
8472 struct frame *f;
8473 struct image *img;
8475 struct jpeg_decompress_struct cinfo;
8476 struct my_jpeg_error_mgr mgr;
8477 Lisp_Object file, specified_file;
8478 Lisp_Object specified_data;
8479 FILE * volatile fp = NULL;
8480 JSAMPARRAY buffer;
8481 int row_stride, x, y;
8482 XImage *ximg = NULL;
8483 int rc;
8484 unsigned long *colors;
8485 int width, height;
8486 struct gcpro gcpro1;
8488 /* Open the JPEG file. */
8489 specified_file = image_spec_value (img->spec, QCfile, NULL);
8490 specified_data = image_spec_value (img->spec, QCdata, NULL);
8491 file = Qnil;
8492 GCPRO1 (file);
8494 if (NILP (specified_data))
8496 file = x_find_image_file (specified_file);
8497 if (!STRINGP (file))
8499 image_error ("Cannot find image file `%s'", specified_file, Qnil);
8500 UNGCPRO;
8501 return 0;
8504 fp = fopen (SDATA (file), "r");
8505 if (fp == NULL)
8507 image_error ("Cannot open `%s'", file, Qnil);
8508 UNGCPRO;
8509 return 0;
8513 /* Customize libjpeg's error handling to call my_error_exit when an
8514 error is detected. This function will perform a longjmp. */
8515 cinfo.err = jpeg_std_error (&mgr.pub);
8516 mgr.pub.error_exit = my_error_exit;
8518 if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
8520 if (rc == 1)
8522 /* Called from my_error_exit. Display a JPEG error. */
8523 char buffer[JMSG_LENGTH_MAX];
8524 cinfo.err->format_message ((j_common_ptr) &cinfo, buffer);
8525 image_error ("Error reading JPEG image `%s': %s", img->spec,
8526 build_string (buffer));
8529 /* Close the input file and destroy the JPEG object. */
8530 if (fp)
8531 fclose ((FILE *) fp);
8532 jpeg_destroy_decompress (&cinfo);
8534 /* If we already have an XImage, free that. */
8535 x_destroy_x_image (ximg);
8537 /* Free pixmap and colors. */
8538 x_clear_image (f, img);
8540 UNGCPRO;
8541 return 0;
8544 /* Create the JPEG decompression object. Let it read from fp.
8545 Read the JPEG image header. */
8546 jpeg_create_decompress (&cinfo);
8548 if (NILP (specified_data))
8549 jpeg_stdio_src (&cinfo, (FILE *) fp);
8550 else
8551 jpeg_memory_src (&cinfo, SDATA (specified_data),
8552 SBYTES (specified_data));
8554 jpeg_read_header (&cinfo, TRUE);
8556 /* Customize decompression so that color quantization will be used.
8557 Start decompression. */
8558 cinfo.quantize_colors = TRUE;
8559 jpeg_start_decompress (&cinfo);
8560 width = img->width = cinfo.output_width;
8561 height = img->height = cinfo.output_height;
8563 /* Create X image and pixmap. */
8564 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
8565 longjmp (mgr.setjmp_buffer, 2);
8567 /* Allocate colors. When color quantization is used,
8568 cinfo.actual_number_of_colors has been set with the number of
8569 colors generated, and cinfo.colormap is a two-dimensional array
8570 of color indices in the range 0..cinfo.actual_number_of_colors.
8571 No more than 255 colors will be generated. */
8573 int i, ir, ig, ib;
8575 if (cinfo.out_color_components > 2)
8576 ir = 0, ig = 1, ib = 2;
8577 else if (cinfo.out_color_components > 1)
8578 ir = 0, ig = 1, ib = 0;
8579 else
8580 ir = 0, ig = 0, ib = 0;
8582 /* Use the color table mechanism because it handles colors that
8583 cannot be allocated nicely. Such colors will be replaced with
8584 a default color, and we don't have to care about which colors
8585 can be freed safely, and which can't. */
8586 init_color_table ();
8587 colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
8588 * sizeof *colors);
8590 for (i = 0; i < cinfo.actual_number_of_colors; ++i)
8592 /* Multiply RGB values with 255 because X expects RGB values
8593 in the range 0..0xffff. */
8594 int r = cinfo.colormap[ir][i] << 8;
8595 int g = cinfo.colormap[ig][i] << 8;
8596 int b = cinfo.colormap[ib][i] << 8;
8597 colors[i] = lookup_rgb_color (f, r, g, b);
8600 /* Remember those colors actually allocated. */
8601 img->colors = colors_in_color_table (&img->ncolors);
8602 free_color_table ();
8605 /* Read pixels. */
8606 row_stride = width * cinfo.output_components;
8607 buffer = cinfo.mem->alloc_sarray ((j_common_ptr) &cinfo, JPOOL_IMAGE,
8608 row_stride, 1);
8609 for (y = 0; y < height; ++y)
8611 jpeg_read_scanlines (&cinfo, buffer, 1);
8612 for (x = 0; x < cinfo.output_width; ++x)
8613 XPutPixel (ximg, x, y, colors[buffer[0][x]]);
8616 /* Clean up. */
8617 jpeg_finish_decompress (&cinfo);
8618 jpeg_destroy_decompress (&cinfo);
8619 if (fp)
8620 fclose ((FILE *) fp);
8622 /* Maybe fill in the background field while we have ximg handy. */
8623 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
8624 IMAGE_BACKGROUND (img, f, ximg);
8626 /* Put the image into the pixmap. */
8627 x_put_x_image (f, ximg, img->pixmap, width, height);
8628 x_destroy_x_image (ximg);
8629 UNGCPRO;
8630 return 1;
8633 #endif /* HAVE_JPEG */
8637 /***********************************************************************
8638 TIFF
8639 ***********************************************************************/
8641 #if HAVE_TIFF
8643 #include <tiffio.h>
8645 static int tiff_image_p P_ ((Lisp_Object object));
8646 static int tiff_load P_ ((struct frame *f, struct image *img));
8648 /* The symbol `tiff' identifying images of this type. */
8650 Lisp_Object Qtiff;
8652 /* Indices of image specification fields in tiff_format, below. */
8654 enum tiff_keyword_index
8656 TIFF_TYPE,
8657 TIFF_DATA,
8658 TIFF_FILE,
8659 TIFF_ASCENT,
8660 TIFF_MARGIN,
8661 TIFF_RELIEF,
8662 TIFF_ALGORITHM,
8663 TIFF_HEURISTIC_MASK,
8664 TIFF_MASK,
8665 TIFF_BACKGROUND,
8666 TIFF_LAST
8669 /* Vector of image_keyword structures describing the format
8670 of valid user-defined image specifications. */
8672 static struct image_keyword tiff_format[TIFF_LAST] =
8674 {":type", IMAGE_SYMBOL_VALUE, 1},
8675 {":data", IMAGE_STRING_VALUE, 0},
8676 {":file", IMAGE_STRING_VALUE, 0},
8677 {":ascent", IMAGE_ASCENT_VALUE, 0},
8678 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
8679 {":relief", IMAGE_INTEGER_VALUE, 0},
8680 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8681 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8682 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8683 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
8686 /* Structure describing the image type `tiff'. */
8688 static struct image_type tiff_type =
8690 &Qtiff,
8691 tiff_image_p,
8692 tiff_load,
8693 x_clear_image,
8694 NULL
8698 /* Return non-zero if OBJECT is a valid TIFF image specification. */
8700 static int
8701 tiff_image_p (object)
8702 Lisp_Object object;
8704 struct image_keyword fmt[TIFF_LAST];
8705 bcopy (tiff_format, fmt, sizeof fmt);
8707 if (!parse_image_spec (object, fmt, TIFF_LAST, Qtiff))
8708 return 0;
8710 /* Must specify either the :data or :file keyword. */
8711 return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
8715 /* Reading from a memory buffer for TIFF images Based on the PNG
8716 memory source, but we have to provide a lot of extra functions.
8717 Blah.
8719 We really only need to implement read and seek, but I am not
8720 convinced that the TIFF library is smart enough not to destroy
8721 itself if we only hand it the function pointers we need to
8722 override. */
8724 typedef struct
8726 unsigned char *bytes;
8727 size_t len;
8728 int index;
8730 tiff_memory_source;
8733 static size_t
8734 tiff_read_from_memory (data, buf, size)
8735 thandle_t data;
8736 tdata_t buf;
8737 tsize_t size;
8739 tiff_memory_source *src = (tiff_memory_source *) data;
8741 if (size > src->len - src->index)
8742 return (size_t) -1;
8743 bcopy (src->bytes + src->index, buf, size);
8744 src->index += size;
8745 return size;
8749 static size_t
8750 tiff_write_from_memory (data, buf, size)
8751 thandle_t data;
8752 tdata_t buf;
8753 tsize_t size;
8755 return (size_t) -1;
8759 static toff_t
8760 tiff_seek_in_memory (data, off, whence)
8761 thandle_t data;
8762 toff_t off;
8763 int whence;
8765 tiff_memory_source *src = (tiff_memory_source *) data;
8766 int idx;
8768 switch (whence)
8770 case SEEK_SET: /* Go from beginning of source. */
8771 idx = off;
8772 break;
8774 case SEEK_END: /* Go from end of source. */
8775 idx = src->len + off;
8776 break;
8778 case SEEK_CUR: /* Go from current position. */
8779 idx = src->index + off;
8780 break;
8782 default: /* Invalid `whence'. */
8783 return -1;
8786 if (idx > src->len || idx < 0)
8787 return -1;
8789 src->index = idx;
8790 return src->index;
8794 static int
8795 tiff_close_memory (data)
8796 thandle_t data;
8798 /* NOOP */
8799 return 0;
8803 static int
8804 tiff_mmap_memory (data, pbase, psize)
8805 thandle_t data;
8806 tdata_t *pbase;
8807 toff_t *psize;
8809 /* It is already _IN_ memory. */
8810 return 0;
8814 static void
8815 tiff_unmap_memory (data, base, size)
8816 thandle_t data;
8817 tdata_t base;
8818 toff_t size;
8820 /* We don't need to do this. */
8824 static toff_t
8825 tiff_size_of_memory (data)
8826 thandle_t data;
8828 return ((tiff_memory_source *) data)->len;
8832 static void
8833 tiff_error_handler (title, format, ap)
8834 const char *title, *format;
8835 va_list ap;
8837 char buf[512];
8838 int len;
8840 len = sprintf (buf, "TIFF error: %s ", title);
8841 vsprintf (buf + len, format, ap);
8842 add_to_log (buf, Qnil, Qnil);
8846 static void
8847 tiff_warning_handler (title, format, ap)
8848 const char *title, *format;
8849 va_list ap;
8851 char buf[512];
8852 int len;
8854 len = sprintf (buf, "TIFF warning: %s ", title);
8855 vsprintf (buf + len, format, ap);
8856 add_to_log (buf, Qnil, Qnil);
8860 /* Load TIFF image IMG for use on frame F. Value is non-zero if
8861 successful. */
8863 static int
8864 tiff_load (f, img)
8865 struct frame *f;
8866 struct image *img;
8868 Lisp_Object file, specified_file;
8869 Lisp_Object specified_data;
8870 TIFF *tiff;
8871 int width, height, x, y;
8872 uint32 *buf;
8873 int rc;
8874 XImage *ximg;
8875 struct gcpro gcpro1;
8876 tiff_memory_source memsrc;
8878 specified_file = image_spec_value (img->spec, QCfile, NULL);
8879 specified_data = image_spec_value (img->spec, QCdata, NULL);
8880 file = Qnil;
8881 GCPRO1 (file);
8883 TIFFSetErrorHandler (tiff_error_handler);
8884 TIFFSetWarningHandler (tiff_warning_handler);
8886 if (NILP (specified_data))
8888 /* Read from a file */
8889 file = x_find_image_file (specified_file);
8890 if (!STRINGP (file))
8892 image_error ("Cannot find image file `%s'", file, Qnil);
8893 UNGCPRO;
8894 return 0;
8897 /* Try to open the image file. */
8898 tiff = TIFFOpen (SDATA (file), "r");
8899 if (tiff == NULL)
8901 image_error ("Cannot open `%s'", file, Qnil);
8902 UNGCPRO;
8903 return 0;
8906 else
8908 /* Memory source! */
8909 memsrc.bytes = SDATA (specified_data);
8910 memsrc.len = SBYTES (specified_data);
8911 memsrc.index = 0;
8913 tiff = TIFFClientOpen ("memory_source", "r", &memsrc,
8914 (TIFFReadWriteProc) tiff_read_from_memory,
8915 (TIFFReadWriteProc) tiff_write_from_memory,
8916 tiff_seek_in_memory,
8917 tiff_close_memory,
8918 tiff_size_of_memory,
8919 tiff_mmap_memory,
8920 tiff_unmap_memory);
8922 if (!tiff)
8924 image_error ("Cannot open memory source for `%s'", img->spec, Qnil);
8925 UNGCPRO;
8926 return 0;
8930 /* Get width and height of the image, and allocate a raster buffer
8931 of width x height 32-bit values. */
8932 TIFFGetField (tiff, TIFFTAG_IMAGEWIDTH, &width);
8933 TIFFGetField (tiff, TIFFTAG_IMAGELENGTH, &height);
8934 buf = (uint32 *) xmalloc (width * height * sizeof *buf);
8936 rc = TIFFReadRGBAImage (tiff, width, height, buf, 0);
8937 TIFFClose (tiff);
8938 if (!rc)
8940 image_error ("Error reading TIFF image `%s'", img->spec, Qnil);
8941 xfree (buf);
8942 UNGCPRO;
8943 return 0;
8946 /* Create the X image and pixmap. */
8947 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
8949 xfree (buf);
8950 UNGCPRO;
8951 return 0;
8954 /* Initialize the color table. */
8955 init_color_table ();
8957 /* Process the pixel raster. Origin is in the lower-left corner. */
8958 for (y = 0; y < height; ++y)
8960 uint32 *row = buf + y * width;
8962 for (x = 0; x < width; ++x)
8964 uint32 abgr = row[x];
8965 int r = TIFFGetR (abgr) << 8;
8966 int g = TIFFGetG (abgr) << 8;
8967 int b = TIFFGetB (abgr) << 8;
8968 XPutPixel (ximg, x, height - 1 - y, lookup_rgb_color (f, r, g, b));
8972 /* Remember the colors allocated for the image. Free the color table. */
8973 img->colors = colors_in_color_table (&img->ncolors);
8974 free_color_table ();
8976 img->width = width;
8977 img->height = height;
8979 /* Maybe fill in the background field while we have ximg handy. */
8980 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
8981 IMAGE_BACKGROUND (img, f, ximg);
8983 /* Put the image into the pixmap, then free the X image and its buffer. */
8984 x_put_x_image (f, ximg, img->pixmap, width, height);
8985 x_destroy_x_image (ximg);
8986 xfree (buf);
8988 UNGCPRO;
8989 return 1;
8992 #endif /* HAVE_TIFF != 0 */
8996 /***********************************************************************
8998 ***********************************************************************/
9000 #if HAVE_GIF
9002 #include <gif_lib.h>
9004 static int gif_image_p P_ ((Lisp_Object object));
9005 static int gif_load P_ ((struct frame *f, struct image *img));
9007 /* The symbol `gif' identifying images of this type. */
9009 Lisp_Object Qgif;
9011 /* Indices of image specification fields in gif_format, below. */
9013 enum gif_keyword_index
9015 GIF_TYPE,
9016 GIF_DATA,
9017 GIF_FILE,
9018 GIF_ASCENT,
9019 GIF_MARGIN,
9020 GIF_RELIEF,
9021 GIF_ALGORITHM,
9022 GIF_HEURISTIC_MASK,
9023 GIF_MASK,
9024 GIF_IMAGE,
9025 GIF_BACKGROUND,
9026 GIF_LAST
9029 /* Vector of image_keyword structures describing the format
9030 of valid user-defined image specifications. */
9032 static struct image_keyword gif_format[GIF_LAST] =
9034 {":type", IMAGE_SYMBOL_VALUE, 1},
9035 {":data", IMAGE_STRING_VALUE, 0},
9036 {":file", IMAGE_STRING_VALUE, 0},
9037 {":ascent", IMAGE_ASCENT_VALUE, 0},
9038 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
9039 {":relief", IMAGE_INTEGER_VALUE, 0},
9040 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9041 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9042 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9043 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
9044 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
9047 /* Structure describing the image type `gif'. */
9049 static struct image_type gif_type =
9051 &Qgif,
9052 gif_image_p,
9053 gif_load,
9054 x_clear_image,
9055 NULL
9059 /* Return non-zero if OBJECT is a valid GIF image specification. */
9061 static int
9062 gif_image_p (object)
9063 Lisp_Object object;
9065 struct image_keyword fmt[GIF_LAST];
9066 bcopy (gif_format, fmt, sizeof fmt);
9068 if (!parse_image_spec (object, fmt, GIF_LAST, Qgif))
9069 return 0;
9071 /* Must specify either the :data or :file keyword. */
9072 return fmt[GIF_FILE].count + fmt[GIF_DATA].count == 1;
9076 /* Reading a GIF image from memory
9077 Based on the PNG memory stuff to a certain extent. */
9079 typedef struct
9081 unsigned char *bytes;
9082 size_t len;
9083 int index;
9085 gif_memory_source;
9088 /* Make the current memory source available to gif_read_from_memory.
9089 It's done this way because not all versions of libungif support
9090 a UserData field in the GifFileType structure. */
9091 static gif_memory_source *current_gif_memory_src;
9093 static int
9094 gif_read_from_memory (file, buf, len)
9095 GifFileType *file;
9096 GifByteType *buf;
9097 int len;
9099 gif_memory_source *src = current_gif_memory_src;
9101 if (len > src->len - src->index)
9102 return -1;
9104 bcopy (src->bytes + src->index, buf, len);
9105 src->index += len;
9106 return len;
9110 /* Load GIF image IMG for use on frame F. Value is non-zero if
9111 successful. */
9113 static int
9114 gif_load (f, img)
9115 struct frame *f;
9116 struct image *img;
9118 Lisp_Object file, specified_file;
9119 Lisp_Object specified_data;
9120 int rc, width, height, x, y, i;
9121 XImage *ximg;
9122 ColorMapObject *gif_color_map;
9123 unsigned long pixel_colors[256];
9124 GifFileType *gif;
9125 struct gcpro gcpro1;
9126 Lisp_Object image;
9127 int ino, image_left, image_top, image_width, image_height;
9128 gif_memory_source memsrc;
9129 unsigned char *raster;
9131 specified_file = image_spec_value (img->spec, QCfile, NULL);
9132 specified_data = image_spec_value (img->spec, QCdata, NULL);
9133 file = Qnil;
9134 GCPRO1 (file);
9136 if (NILP (specified_data))
9138 file = x_find_image_file (specified_file);
9139 if (!STRINGP (file))
9141 image_error ("Cannot find image file `%s'", specified_file, Qnil);
9142 UNGCPRO;
9143 return 0;
9146 /* Open the GIF file. */
9147 gif = DGifOpenFileName (SDATA (file));
9148 if (gif == NULL)
9150 image_error ("Cannot open `%s'", file, Qnil);
9151 UNGCPRO;
9152 return 0;
9155 else
9157 /* Read from memory! */
9158 current_gif_memory_src = &memsrc;
9159 memsrc.bytes = SDATA (specified_data);
9160 memsrc.len = SBYTES (specified_data);
9161 memsrc.index = 0;
9163 gif = DGifOpen (&memsrc, gif_read_from_memory);
9164 if (!gif)
9166 image_error ("Cannot open memory source `%s'", img->spec, Qnil);
9167 UNGCPRO;
9168 return 0;
9172 /* Read entire contents. */
9173 rc = DGifSlurp (gif);
9174 if (rc == GIF_ERROR)
9176 image_error ("Error reading `%s'", img->spec, Qnil);
9177 DGifCloseFile (gif);
9178 UNGCPRO;
9179 return 0;
9182 image = image_spec_value (img->spec, QCindex, NULL);
9183 ino = INTEGERP (image) ? XFASTINT (image) : 0;
9184 if (ino >= gif->ImageCount)
9186 image_error ("Invalid image number `%s' in image `%s'",
9187 image, img->spec);
9188 DGifCloseFile (gif);
9189 UNGCPRO;
9190 return 0;
9193 width = img->width = max (gif->SWidth, gif->Image.Left + gif->Image.Width);
9194 height = img->height = max (gif->SHeight, gif->Image.Top + gif->Image.Height);
9196 /* Create the X image and pixmap. */
9197 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
9199 DGifCloseFile (gif);
9200 UNGCPRO;
9201 return 0;
9204 /* Allocate colors. */
9205 gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap;
9206 if (!gif_color_map)
9207 gif_color_map = gif->SColorMap;
9208 init_color_table ();
9209 bzero (pixel_colors, sizeof pixel_colors);
9211 for (i = 0; i < gif_color_map->ColorCount; ++i)
9213 int r = gif_color_map->Colors[i].Red << 8;
9214 int g = gif_color_map->Colors[i].Green << 8;
9215 int b = gif_color_map->Colors[i].Blue << 8;
9216 pixel_colors[i] = lookup_rgb_color (f, r, g, b);
9219 img->colors = colors_in_color_table (&img->ncolors);
9220 free_color_table ();
9222 /* Clear the part of the screen image that are not covered by
9223 the image from the GIF file. Full animated GIF support
9224 requires more than can be done here (see the gif89 spec,
9225 disposal methods). Let's simply assume that the part
9226 not covered by a sub-image is in the frame's background color. */
9227 image_top = gif->SavedImages[ino].ImageDesc.Top;
9228 image_left = gif->SavedImages[ino].ImageDesc.Left;
9229 image_width = gif->SavedImages[ino].ImageDesc.Width;
9230 image_height = gif->SavedImages[ino].ImageDesc.Height;
9232 for (y = 0; y < image_top; ++y)
9233 for (x = 0; x < width; ++x)
9234 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9236 for (y = image_top + image_height; y < height; ++y)
9237 for (x = 0; x < width; ++x)
9238 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9240 for (y = image_top; y < image_top + image_height; ++y)
9242 for (x = 0; x < image_left; ++x)
9243 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9244 for (x = image_left + image_width; x < width; ++x)
9245 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9248 /* Read the GIF image into the X image. We use a local variable
9249 `raster' here because RasterBits below is a char *, and invites
9250 problems with bytes >= 0x80. */
9251 raster = (unsigned char *) gif->SavedImages[ino].RasterBits;
9253 if (gif->SavedImages[ino].ImageDesc.Interlace)
9255 static int interlace_start[] = {0, 4, 2, 1};
9256 static int interlace_increment[] = {8, 8, 4, 2};
9257 int pass;
9258 int row = interlace_start[0];
9260 pass = 0;
9262 for (y = 0; y < image_height; y++)
9264 if (row >= image_height)
9266 row = interlace_start[++pass];
9267 while (row >= image_height)
9268 row = interlace_start[++pass];
9271 for (x = 0; x < image_width; x++)
9273 int i = raster[(y * image_width) + x];
9274 XPutPixel (ximg, x + image_left, row + image_top,
9275 pixel_colors[i]);
9278 row += interlace_increment[pass];
9281 else
9283 for (y = 0; y < image_height; ++y)
9284 for (x = 0; x < image_width; ++x)
9286 int i = raster[y * image_width + x];
9287 XPutPixel (ximg, x + image_left, y + image_top, pixel_colors[i]);
9291 DGifCloseFile (gif);
9293 /* Maybe fill in the background field while we have ximg handy. */
9294 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
9295 IMAGE_BACKGROUND (img, f, ximg);
9297 /* Put the image into the pixmap, then free the X image and its buffer. */
9298 x_put_x_image (f, ximg, img->pixmap, width, height);
9299 x_destroy_x_image (ximg);
9301 UNGCPRO;
9302 return 1;
9305 #endif /* HAVE_GIF != 0 */
9309 /***********************************************************************
9310 Ghostscript
9311 ***********************************************************************/
9313 static int gs_image_p P_ ((Lisp_Object object));
9314 static int gs_load P_ ((struct frame *f, struct image *img));
9315 static void gs_clear_image P_ ((struct frame *f, struct image *img));
9317 /* The symbol `postscript' identifying images of this type. */
9319 Lisp_Object Qpostscript;
9321 /* Keyword symbols. */
9323 Lisp_Object QCloader, QCbounding_box, QCpt_width, QCpt_height;
9325 /* Indices of image specification fields in gs_format, below. */
9327 enum gs_keyword_index
9329 GS_TYPE,
9330 GS_PT_WIDTH,
9331 GS_PT_HEIGHT,
9332 GS_FILE,
9333 GS_LOADER,
9334 GS_BOUNDING_BOX,
9335 GS_ASCENT,
9336 GS_MARGIN,
9337 GS_RELIEF,
9338 GS_ALGORITHM,
9339 GS_HEURISTIC_MASK,
9340 GS_MASK,
9341 GS_BACKGROUND,
9342 GS_LAST
9345 /* Vector of image_keyword structures describing the format
9346 of valid user-defined image specifications. */
9348 static struct image_keyword gs_format[GS_LAST] =
9350 {":type", IMAGE_SYMBOL_VALUE, 1},
9351 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE, 1},
9352 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE, 1},
9353 {":file", IMAGE_STRING_VALUE, 1},
9354 {":loader", IMAGE_FUNCTION_VALUE, 0},
9355 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE, 1},
9356 {":ascent", IMAGE_ASCENT_VALUE, 0},
9357 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
9358 {":relief", IMAGE_INTEGER_VALUE, 0},
9359 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9360 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9361 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9362 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
9365 /* Structure describing the image type `ghostscript'. */
9367 static struct image_type gs_type =
9369 &Qpostscript,
9370 gs_image_p,
9371 gs_load,
9372 gs_clear_image,
9373 NULL
9377 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9379 static void
9380 gs_clear_image (f, img)
9381 struct frame *f;
9382 struct image *img;
9384 /* IMG->data.ptr_val may contain a recorded colormap. */
9385 xfree (img->data.ptr_val);
9386 x_clear_image (f, img);
9390 /* Return non-zero if OBJECT is a valid Ghostscript image
9391 specification. */
9393 static int
9394 gs_image_p (object)
9395 Lisp_Object object;
9397 struct image_keyword fmt[GS_LAST];
9398 Lisp_Object tem;
9399 int i;
9401 bcopy (gs_format, fmt, sizeof fmt);
9403 if (!parse_image_spec (object, fmt, GS_LAST, Qpostscript))
9404 return 0;
9406 /* Bounding box must be a list or vector containing 4 integers. */
9407 tem = fmt[GS_BOUNDING_BOX].value;
9408 if (CONSP (tem))
9410 for (i = 0; i < 4; ++i, tem = XCDR (tem))
9411 if (!CONSP (tem) || !INTEGERP (XCAR (tem)))
9412 return 0;
9413 if (!NILP (tem))
9414 return 0;
9416 else if (VECTORP (tem))
9418 if (XVECTOR (tem)->size != 4)
9419 return 0;
9420 for (i = 0; i < 4; ++i)
9421 if (!INTEGERP (XVECTOR (tem)->contents[i]))
9422 return 0;
9424 else
9425 return 0;
9427 return 1;
9431 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9432 if successful. */
9434 static int
9435 gs_load (f, img)
9436 struct frame *f;
9437 struct image *img;
9439 char buffer[100];
9440 Lisp_Object window_and_pixmap_id = Qnil, loader, pt_height, pt_width;
9441 struct gcpro gcpro1, gcpro2;
9442 Lisp_Object frame;
9443 double in_width, in_height;
9444 Lisp_Object pixel_colors = Qnil;
9446 /* Compute pixel size of pixmap needed from the given size in the
9447 image specification. Sizes in the specification are in pt. 1 pt
9448 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9449 info. */
9450 pt_width = image_spec_value (img->spec, QCpt_width, NULL);
9451 in_width = XFASTINT (pt_width) / 72.0;
9452 img->width = in_width * FRAME_X_DISPLAY_INFO (f)->resx;
9453 pt_height = image_spec_value (img->spec, QCpt_height, NULL);
9454 in_height = XFASTINT (pt_height) / 72.0;
9455 img->height = in_height * FRAME_X_DISPLAY_INFO (f)->resy;
9457 /* Create the pixmap. */
9458 xassert (img->pixmap == None);
9459 img->pixmap = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9460 img->width, img->height,
9461 DefaultDepthOfScreen (FRAME_X_SCREEN (f)));
9463 if (!img->pixmap)
9465 image_error ("Unable to create pixmap for `%s'", img->spec, Qnil);
9466 return 0;
9469 /* Call the loader to fill the pixmap. It returns a process object
9470 if successful. We do not record_unwind_protect here because
9471 other places in redisplay like calling window scroll functions
9472 don't either. Let the Lisp loader use `unwind-protect' instead. */
9473 GCPRO2 (window_and_pixmap_id, pixel_colors);
9475 sprintf (buffer, "%lu %lu",
9476 (unsigned long) FRAME_X_WINDOW (f),
9477 (unsigned long) img->pixmap);
9478 window_and_pixmap_id = build_string (buffer);
9480 sprintf (buffer, "%lu %lu",
9481 FRAME_FOREGROUND_PIXEL (f),
9482 FRAME_BACKGROUND_PIXEL (f));
9483 pixel_colors = build_string (buffer);
9485 XSETFRAME (frame, f);
9486 loader = image_spec_value (img->spec, QCloader, NULL);
9487 if (NILP (loader))
9488 loader = intern ("gs-load-image");
9490 img->data.lisp_val = call6 (loader, frame, img->spec,
9491 make_number (img->width),
9492 make_number (img->height),
9493 window_and_pixmap_id,
9494 pixel_colors);
9495 UNGCPRO;
9496 return PROCESSP (img->data.lisp_val);
9500 /* Kill the Ghostscript process that was started to fill PIXMAP on
9501 frame F. Called from XTread_socket when receiving an event
9502 telling Emacs that Ghostscript has finished drawing. */
9504 void
9505 x_kill_gs_process (pixmap, f)
9506 Pixmap pixmap;
9507 struct frame *f;
9509 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
9510 int class, i;
9511 struct image *img;
9513 /* Find the image containing PIXMAP. */
9514 for (i = 0; i < c->used; ++i)
9515 if (c->images[i]->pixmap == pixmap)
9516 break;
9518 /* Should someone in between have cleared the image cache, for
9519 instance, give up. */
9520 if (i == c->used)
9521 return;
9523 /* Kill the GS process. We should have found PIXMAP in the image
9524 cache and its image should contain a process object. */
9525 img = c->images[i];
9526 xassert (PROCESSP (img->data.lisp_val));
9527 Fkill_process (img->data.lisp_val, Qnil);
9528 img->data.lisp_val = Qnil;
9530 /* On displays with a mutable colormap, figure out the colors
9531 allocated for the image by looking at the pixels of an XImage for
9532 img->pixmap. */
9533 class = FRAME_X_VISUAL (f)->class;
9534 if (class != StaticColor && class != StaticGray && class != TrueColor)
9536 XImage *ximg;
9538 BLOCK_INPUT;
9540 /* Try to get an XImage for img->pixmep. */
9541 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
9542 0, 0, img->width, img->height, ~0, ZPixmap);
9543 if (ximg)
9545 int x, y;
9547 /* Initialize the color table. */
9548 init_color_table ();
9550 /* For each pixel of the image, look its color up in the
9551 color table. After having done so, the color table will
9552 contain an entry for each color used by the image. */
9553 for (y = 0; y < img->height; ++y)
9554 for (x = 0; x < img->width; ++x)
9556 unsigned long pixel = XGetPixel (ximg, x, y);
9557 lookup_pixel_color (f, pixel);
9560 /* Record colors in the image. Free color table and XImage. */
9561 img->colors = colors_in_color_table (&img->ncolors);
9562 free_color_table ();
9563 XDestroyImage (ximg);
9565 #if 0 /* This doesn't seem to be the case. If we free the colors
9566 here, we get a BadAccess later in x_clear_image when
9567 freeing the colors. */
9568 /* We have allocated colors once, but Ghostscript has also
9569 allocated colors on behalf of us. So, to get the
9570 reference counts right, free them once. */
9571 if (img->ncolors)
9572 x_free_colors (f, img->colors, img->ncolors);
9573 #endif
9575 else
9576 image_error ("Cannot get X image of `%s'; colors will not be freed",
9577 img->spec, Qnil);
9579 UNBLOCK_INPUT;
9582 /* Now that we have the pixmap, compute mask and transform the
9583 image if requested. */
9584 BLOCK_INPUT;
9585 postprocess_image (f, img);
9586 UNBLOCK_INPUT;
9591 /***********************************************************************
9592 Window properties
9593 ***********************************************************************/
9595 DEFUN ("x-change-window-property", Fx_change_window_property,
9596 Sx_change_window_property, 2, 3, 0,
9597 doc: /* Change window property PROP to VALUE on the X window of FRAME.
9598 PROP and VALUE must be strings. FRAME nil or omitted means use the
9599 selected frame. Value is VALUE. */)
9600 (prop, value, frame)
9601 Lisp_Object frame, prop, value;
9603 struct frame *f = check_x_frame (frame);
9604 Atom prop_atom;
9606 CHECK_STRING (prop);
9607 CHECK_STRING (value);
9609 BLOCK_INPUT;
9610 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
9611 XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9612 prop_atom, XA_STRING, 8, PropModeReplace,
9613 SDATA (value), SCHARS (value));
9615 /* Make sure the property is set when we return. */
9616 XFlush (FRAME_X_DISPLAY (f));
9617 UNBLOCK_INPUT;
9619 return value;
9623 DEFUN ("x-delete-window-property", Fx_delete_window_property,
9624 Sx_delete_window_property, 1, 2, 0,
9625 doc: /* Remove window property PROP from X window of FRAME.
9626 FRAME nil or omitted means use the selected frame. Value is PROP. */)
9627 (prop, frame)
9628 Lisp_Object prop, frame;
9630 struct frame *f = check_x_frame (frame);
9631 Atom prop_atom;
9633 CHECK_STRING (prop);
9634 BLOCK_INPUT;
9635 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
9636 XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), prop_atom);
9638 /* Make sure the property is removed when we return. */
9639 XFlush (FRAME_X_DISPLAY (f));
9640 UNBLOCK_INPUT;
9642 return prop;
9646 DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
9647 1, 2, 0,
9648 doc: /* Value is the value of window property PROP on FRAME.
9649 If FRAME is nil or omitted, use the selected frame. Value is nil
9650 if FRAME hasn't a property with name PROP or if PROP has no string
9651 value. */)
9652 (prop, frame)
9653 Lisp_Object prop, frame;
9655 struct frame *f = check_x_frame (frame);
9656 Atom prop_atom;
9657 int rc;
9658 Lisp_Object prop_value = Qnil;
9659 char *tmp_data = NULL;
9660 Atom actual_type;
9661 int actual_format;
9662 unsigned long actual_size, bytes_remaining;
9664 CHECK_STRING (prop);
9665 BLOCK_INPUT;
9666 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
9667 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9668 prop_atom, 0, 0, False, XA_STRING,
9669 &actual_type, &actual_format, &actual_size,
9670 &bytes_remaining, (unsigned char **) &tmp_data);
9671 if (rc == Success)
9673 int size = bytes_remaining;
9675 XFree (tmp_data);
9676 tmp_data = NULL;
9678 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9679 prop_atom, 0, bytes_remaining,
9680 False, XA_STRING,
9681 &actual_type, &actual_format,
9682 &actual_size, &bytes_remaining,
9683 (unsigned char **) &tmp_data);
9684 if (rc == Success && tmp_data)
9685 prop_value = make_string (tmp_data, size);
9687 XFree (tmp_data);
9690 UNBLOCK_INPUT;
9691 return prop_value;
9696 /***********************************************************************
9697 Busy cursor
9698 ***********************************************************************/
9700 /* If non-null, an asynchronous timer that, when it expires, displays
9701 an hourglass cursor on all frames. */
9703 static struct atimer *hourglass_atimer;
9705 /* Non-zero means an hourglass cursor is currently shown. */
9707 static int hourglass_shown_p;
9709 /* Number of seconds to wait before displaying an hourglass cursor. */
9711 static Lisp_Object Vhourglass_delay;
9713 /* Default number of seconds to wait before displaying an hourglass
9714 cursor. */
9716 #define DEFAULT_HOURGLASS_DELAY 1
9718 /* Function prototypes. */
9720 static void show_hourglass P_ ((struct atimer *));
9721 static void hide_hourglass P_ ((void));
9724 /* Cancel a currently active hourglass timer, and start a new one. */
9726 void
9727 start_hourglass ()
9729 EMACS_TIME delay;
9730 int secs, usecs = 0;
9732 cancel_hourglass ();
9734 if (INTEGERP (Vhourglass_delay)
9735 && XINT (Vhourglass_delay) > 0)
9736 secs = XFASTINT (Vhourglass_delay);
9737 else if (FLOATP (Vhourglass_delay)
9738 && XFLOAT_DATA (Vhourglass_delay) > 0)
9740 Lisp_Object tem;
9741 tem = Ftruncate (Vhourglass_delay, Qnil);
9742 secs = XFASTINT (tem);
9743 usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
9745 else
9746 secs = DEFAULT_HOURGLASS_DELAY;
9748 EMACS_SET_SECS_USECS (delay, secs, usecs);
9749 hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
9750 show_hourglass, NULL);
9754 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
9755 shown. */
9757 void
9758 cancel_hourglass ()
9760 if (hourglass_atimer)
9762 cancel_atimer (hourglass_atimer);
9763 hourglass_atimer = NULL;
9766 if (hourglass_shown_p)
9767 hide_hourglass ();
9771 /* Timer function of hourglass_atimer. TIMER is equal to
9772 hourglass_atimer.
9774 Display an hourglass pointer on all frames by mapping the frames'
9775 hourglass_window. Set the hourglass_p flag in the frames'
9776 output_data.x structure to indicate that an hourglass cursor is
9777 shown on the frames. */
9779 static void
9780 show_hourglass (timer)
9781 struct atimer *timer;
9783 /* The timer implementation will cancel this timer automatically
9784 after this function has run. Set hourglass_atimer to null
9785 so that we know the timer doesn't have to be canceled. */
9786 hourglass_atimer = NULL;
9788 if (!hourglass_shown_p)
9790 Lisp_Object rest, frame;
9792 BLOCK_INPUT;
9794 FOR_EACH_FRAME (rest, frame)
9796 struct frame *f = XFRAME (frame);
9798 if (FRAME_LIVE_P (f) && FRAME_X_P (f) && FRAME_X_DISPLAY (f))
9800 Display *dpy = FRAME_X_DISPLAY (f);
9802 #ifdef USE_X_TOOLKIT
9803 if (f->output_data.x->widget)
9804 #else
9805 if (FRAME_OUTER_WINDOW (f))
9806 #endif
9808 f->output_data.x->hourglass_p = 1;
9810 if (!f->output_data.x->hourglass_window)
9812 unsigned long mask = CWCursor;
9813 XSetWindowAttributes attrs;
9815 attrs.cursor = f->output_data.x->hourglass_cursor;
9817 f->output_data.x->hourglass_window
9818 = XCreateWindow (dpy, FRAME_OUTER_WINDOW (f),
9819 0, 0, 32000, 32000, 0, 0,
9820 InputOnly,
9821 CopyFromParent,
9822 mask, &attrs);
9825 XMapRaised (dpy, f->output_data.x->hourglass_window);
9826 XFlush (dpy);
9831 hourglass_shown_p = 1;
9832 UNBLOCK_INPUT;
9837 /* Hide the hourglass pointer on all frames, if it is currently
9838 shown. */
9840 static void
9841 hide_hourglass ()
9843 if (hourglass_shown_p)
9845 Lisp_Object rest, frame;
9847 BLOCK_INPUT;
9848 FOR_EACH_FRAME (rest, frame)
9850 struct frame *f = XFRAME (frame);
9852 if (FRAME_X_P (f)
9853 /* Watch out for newly created frames. */
9854 && f->output_data.x->hourglass_window)
9856 XUnmapWindow (FRAME_X_DISPLAY (f),
9857 f->output_data.x->hourglass_window);
9858 /* Sync here because XTread_socket looks at the
9859 hourglass_p flag that is reset to zero below. */
9860 XSync (FRAME_X_DISPLAY (f), False);
9861 f->output_data.x->hourglass_p = 0;
9865 hourglass_shown_p = 0;
9866 UNBLOCK_INPUT;
9872 /***********************************************************************
9873 Tool tips
9874 ***********************************************************************/
9876 static Lisp_Object x_create_tip_frame P_ ((struct x_display_info *,
9877 Lisp_Object, Lisp_Object));
9878 static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
9879 Lisp_Object, int, int, int *, int *));
9881 /* The frame of a currently visible tooltip. */
9883 Lisp_Object tip_frame;
9885 /* If non-nil, a timer started that hides the last tooltip when it
9886 fires. */
9888 Lisp_Object tip_timer;
9889 Window tip_window;
9891 /* If non-nil, a vector of 3 elements containing the last args
9892 with which x-show-tip was called. See there. */
9894 Lisp_Object last_show_tip_args;
9896 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
9898 Lisp_Object Vx_max_tooltip_size;
9901 static Lisp_Object
9902 unwind_create_tip_frame (frame)
9903 Lisp_Object frame;
9905 Lisp_Object deleted;
9907 deleted = unwind_create_frame (frame);
9908 if (EQ (deleted, Qt))
9910 tip_window = None;
9911 tip_frame = Qnil;
9914 return deleted;
9918 /* Create a frame for a tooltip on the display described by DPYINFO.
9919 PARMS is a list of frame parameters. TEXT is the string to
9920 display in the tip frame. Value is the frame.
9922 Note that functions called here, esp. x_default_parameter can
9923 signal errors, for instance when a specified color name is
9924 undefined. We have to make sure that we're in a consistent state
9925 when this happens. */
9927 static Lisp_Object
9928 x_create_tip_frame (dpyinfo, parms, text)
9929 struct x_display_info *dpyinfo;
9930 Lisp_Object parms, text;
9932 struct frame *f;
9933 Lisp_Object frame, tem;
9934 Lisp_Object name;
9935 long window_prompting = 0;
9936 int width, height;
9937 int count = SPECPDL_INDEX ();
9938 struct gcpro gcpro1, gcpro2, gcpro3;
9939 struct kboard *kb;
9940 int face_change_count_before = face_change_count;
9941 Lisp_Object buffer;
9942 struct buffer *old_buffer;
9944 check_x ();
9946 /* Use this general default value to start with until we know if
9947 this frame has a specified name. */
9948 Vx_resource_name = Vinvocation_name;
9950 #ifdef MULTI_KBOARD
9951 kb = dpyinfo->kboard;
9952 #else
9953 kb = &the_only_kboard;
9954 #endif
9956 /* Get the name of the frame to use for resource lookup. */
9957 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
9958 if (!STRINGP (name)
9959 && !EQ (name, Qunbound)
9960 && !NILP (name))
9961 error ("Invalid frame name--not a string or nil");
9962 Vx_resource_name = name;
9964 frame = Qnil;
9965 GCPRO3 (parms, name, frame);
9966 f = make_frame (1);
9967 XSETFRAME (frame, f);
9969 buffer = Fget_buffer_create (build_string (" *tip*"));
9970 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil);
9971 old_buffer = current_buffer;
9972 set_buffer_internal_1 (XBUFFER (buffer));
9973 current_buffer->truncate_lines = Qnil;
9974 Ferase_buffer ();
9975 Finsert (1, &text);
9976 set_buffer_internal_1 (old_buffer);
9978 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
9979 record_unwind_protect (unwind_create_tip_frame, frame);
9981 /* By setting the output method, we're essentially saying that
9982 the frame is live, as per FRAME_LIVE_P. If we get a signal
9983 from this point on, x_destroy_window might screw up reference
9984 counts etc. */
9985 f->output_method = output_x_window;
9986 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
9987 bzero (f->output_data.x, sizeof (struct x_output));
9988 f->output_data.x->icon_bitmap = -1;
9989 FRAME_FONTSET (f) = -1;
9990 f->output_data.x->scroll_bar_foreground_pixel = -1;
9991 f->output_data.x->scroll_bar_background_pixel = -1;
9992 #ifdef USE_TOOLKIT_SCROLL_BARS
9993 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
9994 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
9995 #endif /* USE_TOOLKIT_SCROLL_BARS */
9996 f->icon_name = Qnil;
9997 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
9998 #if GLYPH_DEBUG
9999 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
10000 dpyinfo_refcount = dpyinfo->reference_count;
10001 #endif /* GLYPH_DEBUG */
10002 #ifdef MULTI_KBOARD
10003 FRAME_KBOARD (f) = kb;
10004 #endif
10005 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
10006 f->output_data.x->explicit_parent = 0;
10008 /* These colors will be set anyway later, but it's important
10009 to get the color reference counts right, so initialize them! */
10011 Lisp_Object black;
10012 struct gcpro gcpro1;
10014 black = build_string ("black");
10015 GCPRO1 (black);
10016 f->output_data.x->foreground_pixel
10017 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10018 f->output_data.x->background_pixel
10019 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10020 f->output_data.x->cursor_pixel
10021 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10022 f->output_data.x->cursor_foreground_pixel
10023 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10024 f->output_data.x->border_pixel
10025 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10026 f->output_data.x->mouse_pixel
10027 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10028 UNGCPRO;
10031 /* Set the name; the functions to which we pass f expect the name to
10032 be set. */
10033 if (EQ (name, Qunbound) || NILP (name))
10035 f->name = build_string (dpyinfo->x_id_name);
10036 f->explicit_name = 0;
10038 else
10040 f->name = name;
10041 f->explicit_name = 1;
10042 /* use the frame's title when getting resources for this frame. */
10043 specbind (Qx_resource_name, name);
10046 /* Extract the window parameters from the supplied values that are
10047 needed to determine window geometry. */
10049 Lisp_Object font;
10051 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
10053 BLOCK_INPUT;
10054 /* First, try whatever font the caller has specified. */
10055 if (STRINGP (font))
10057 tem = Fquery_fontset (font, Qnil);
10058 if (STRINGP (tem))
10059 font = x_new_fontset (f, SDATA (tem));
10060 else
10061 font = x_new_font (f, SDATA (font));
10064 /* Try out a font which we hope has bold and italic variations. */
10065 if (!STRINGP (font))
10066 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10067 if (!STRINGP (font))
10068 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10069 if (! STRINGP (font))
10070 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10071 if (! STRINGP (font))
10072 /* This was formerly the first thing tried, but it finds too many fonts
10073 and takes too long. */
10074 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10075 /* If those didn't work, look for something which will at least work. */
10076 if (! STRINGP (font))
10077 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10078 UNBLOCK_INPUT;
10079 if (! STRINGP (font))
10080 font = build_string ("fixed");
10082 x_default_parameter (f, parms, Qfont, font,
10083 "font", "Font", RES_TYPE_STRING);
10086 x_default_parameter (f, parms, Qborder_width, make_number (2),
10087 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
10089 /* This defaults to 2 in order to match xterm. We recognize either
10090 internalBorderWidth or internalBorder (which is what xterm calls
10091 it). */
10092 if (NILP (Fassq (Qinternal_border_width, parms)))
10094 Lisp_Object value;
10096 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
10097 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
10098 if (! EQ (value, Qunbound))
10099 parms = Fcons (Fcons (Qinternal_border_width, value),
10100 parms);
10103 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
10104 "internalBorderWidth", "internalBorderWidth",
10105 RES_TYPE_NUMBER);
10107 /* Also do the stuff which must be set before the window exists. */
10108 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
10109 "foreground", "Foreground", RES_TYPE_STRING);
10110 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
10111 "background", "Background", RES_TYPE_STRING);
10112 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
10113 "pointerColor", "Foreground", RES_TYPE_STRING);
10114 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
10115 "cursorColor", "Foreground", RES_TYPE_STRING);
10116 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
10117 "borderColor", "BorderColor", RES_TYPE_STRING);
10119 /* Init faces before x_default_parameter is called for scroll-bar
10120 parameters because that function calls x_set_scroll_bar_width,
10121 which calls change_frame_size, which calls Fset_window_buffer,
10122 which runs hooks, which call Fvertical_motion. At the end, we
10123 end up in init_iterator with a null face cache, which should not
10124 happen. */
10125 init_frame_faces (f);
10127 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
10129 window_prompting = x_figure_window_size (f, parms, 0);
10132 XSetWindowAttributes attrs;
10133 unsigned long mask;
10135 BLOCK_INPUT;
10136 mask = CWBackPixel | CWOverrideRedirect | CWEventMask;
10137 if (DoesSaveUnders (dpyinfo->screen))
10138 mask |= CWSaveUnder;
10140 /* Window managers look at the override-redirect flag to determine
10141 whether or net to give windows a decoration (Xlib spec, chapter
10142 3.2.8). */
10143 attrs.override_redirect = True;
10144 attrs.save_under = True;
10145 attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f);
10146 /* Arrange for getting MapNotify and UnmapNotify events. */
10147 attrs.event_mask = StructureNotifyMask;
10148 tip_window
10149 = FRAME_X_WINDOW (f)
10150 = XCreateWindow (FRAME_X_DISPLAY (f),
10151 FRAME_X_DISPLAY_INFO (f)->root_window,
10152 /* x, y, width, height */
10153 0, 0, 1, 1,
10154 /* Border. */
10156 CopyFromParent, InputOutput, CopyFromParent,
10157 mask, &attrs);
10158 UNBLOCK_INPUT;
10161 x_make_gc (f);
10163 x_default_parameter (f, parms, Qauto_raise, Qnil,
10164 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
10165 x_default_parameter (f, parms, Qauto_lower, Qnil,
10166 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
10167 x_default_parameter (f, parms, Qcursor_type, Qbox,
10168 "cursorType", "CursorType", RES_TYPE_SYMBOL);
10170 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
10171 Change will not be effected unless different from the current
10172 FRAME_LINES (f). */
10173 width = FRAME_COLS (f);
10174 height = FRAME_LINES (f);
10175 SET_FRAME_COLS (f, 0);
10176 FRAME_LINES (f) = 0;
10177 change_frame_size (f, height, width, 1, 0, 0);
10179 /* Add `tooltip' frame parameter's default value. */
10180 if (NILP (Fframe_parameter (frame, intern ("tooltip"))))
10181 Fmodify_frame_parameters (frame, Fcons (Fcons (intern ("tooltip"), Qt),
10182 Qnil));
10184 /* Set up faces after all frame parameters are known. This call
10185 also merges in face attributes specified for new frames.
10187 Frame parameters may be changed if .Xdefaults contains
10188 specifications for the default font. For example, if there is an
10189 `Emacs.default.attributeBackground: pink', the `background-color'
10190 attribute of the frame get's set, which let's the internal border
10191 of the tooltip frame appear in pink. Prevent this. */
10193 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
10195 /* Set tip_frame here, so that */
10196 tip_frame = frame;
10197 call1 (Qface_set_after_frame_default, frame);
10199 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
10200 Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
10201 Qnil));
10204 f->no_split = 1;
10206 UNGCPRO;
10208 /* It is now ok to make the frame official even if we get an error
10209 below. And the frame needs to be on Vframe_list or making it
10210 visible won't work. */
10211 Vframe_list = Fcons (frame, Vframe_list);
10213 /* Now that the frame is official, it counts as a reference to
10214 its display. */
10215 FRAME_X_DISPLAY_INFO (f)->reference_count++;
10217 /* Setting attributes of faces of the tooltip frame from resources
10218 and similar will increment face_change_count, which leads to the
10219 clearing of all current matrices. Since this isn't necessary
10220 here, avoid it by resetting face_change_count to the value it
10221 had before we created the tip frame. */
10222 face_change_count = face_change_count_before;
10224 /* Discard the unwind_protect. */
10225 return unbind_to (count, frame);
10229 /* Compute where to display tip frame F. PARMS is the list of frame
10230 parameters for F. DX and DY are specified offsets from the current
10231 location of the mouse. WIDTH and HEIGHT are the width and height
10232 of the tooltip. Return coordinates relative to the root window of
10233 the display in *ROOT_X, and *ROOT_Y. */
10235 static void
10236 compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
10237 struct frame *f;
10238 Lisp_Object parms, dx, dy;
10239 int width, height;
10240 int *root_x, *root_y;
10242 Lisp_Object left, top;
10243 int win_x, win_y;
10244 Window root, child;
10245 unsigned pmask;
10247 /* User-specified position? */
10248 left = Fcdr (Fassq (Qleft, parms));
10249 top = Fcdr (Fassq (Qtop, parms));
10251 /* Move the tooltip window where the mouse pointer is. Resize and
10252 show it. */
10253 if (!INTEGERP (left) || !INTEGERP (top))
10255 BLOCK_INPUT;
10256 XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
10257 &root, &child, root_x, root_y, &win_x, &win_y, &pmask);
10258 UNBLOCK_INPUT;
10261 if (INTEGERP (top))
10262 *root_y = XINT (top);
10263 else if (*root_y + XINT (dy) - height < 0)
10264 *root_y -= XINT (dy);
10265 else
10267 *root_y -= height;
10268 *root_y += XINT (dy);
10271 if (INTEGERP (left))
10272 *root_x = XINT (left);
10273 else if (*root_x + XINT (dx) + width <= FRAME_X_DISPLAY_INFO (f)->width)
10274 /* It fits to the right of the pointer. */
10275 *root_x += XINT (dx);
10276 else if (width + XINT (dx) <= *root_x)
10277 /* It fits to the left of the pointer. */
10278 *root_x -= width + XINT (dx);
10279 else
10280 /* Put it left-justified on the screen--it ought to fit that way. */
10281 *root_x = 0;
10285 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
10286 doc: /* Show STRING in a "tooltip" window on frame FRAME.
10287 A tooltip window is a small X window displaying a string.
10289 FRAME nil or omitted means use the selected frame.
10291 PARMS is an optional list of frame parameters which can be used to
10292 change the tooltip's appearance.
10294 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
10295 means use the default timeout of 5 seconds.
10297 If the list of frame parameters PARAMS contains a `left' parameters,
10298 the tooltip is displayed at that x-position. Otherwise it is
10299 displayed at the mouse position, with offset DX added (default is 5 if
10300 DX isn't specified). Likewise for the y-position; if a `top' frame
10301 parameter is specified, it determines the y-position of the tooltip
10302 window, otherwise it is displayed at the mouse position, with offset
10303 DY added (default is -10).
10305 A tooltip's maximum size is specified by `x-max-tooltip-size'.
10306 Text larger than the specified size is clipped. */)
10307 (string, frame, parms, timeout, dx, dy)
10308 Lisp_Object string, frame, parms, timeout, dx, dy;
10310 struct frame *f;
10311 struct window *w;
10312 int root_x, root_y;
10313 struct buffer *old_buffer;
10314 struct text_pos pos;
10315 int i, width, height;
10316 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
10317 int old_windows_or_buffers_changed = windows_or_buffers_changed;
10318 int count = SPECPDL_INDEX ();
10320 specbind (Qinhibit_redisplay, Qt);
10322 GCPRO4 (string, parms, frame, timeout);
10324 CHECK_STRING (string);
10325 f = check_x_frame (frame);
10326 if (NILP (timeout))
10327 timeout = make_number (5);
10328 else
10329 CHECK_NATNUM (timeout);
10331 if (NILP (dx))
10332 dx = make_number (5);
10333 else
10334 CHECK_NUMBER (dx);
10336 if (NILP (dy))
10337 dy = make_number (-10);
10338 else
10339 CHECK_NUMBER (dy);
10341 if (NILP (last_show_tip_args))
10342 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
10344 if (!NILP (tip_frame))
10346 Lisp_Object last_string = AREF (last_show_tip_args, 0);
10347 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
10348 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
10350 if (EQ (frame, last_frame)
10351 && !NILP (Fequal (last_string, string))
10352 && !NILP (Fequal (last_parms, parms)))
10354 struct frame *f = XFRAME (tip_frame);
10356 /* Only DX and DY have changed. */
10357 if (!NILP (tip_timer))
10359 Lisp_Object timer = tip_timer;
10360 tip_timer = Qnil;
10361 call1 (Qcancel_timer, timer);
10364 BLOCK_INPUT;
10365 compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f),
10366 FRAME_PIXEL_HEIGHT (f), &root_x, &root_y);
10367 XMoveWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10368 root_x, root_y);
10369 UNBLOCK_INPUT;
10370 goto start_timer;
10374 /* Hide a previous tip, if any. */
10375 Fx_hide_tip ();
10377 ASET (last_show_tip_args, 0, string);
10378 ASET (last_show_tip_args, 1, frame);
10379 ASET (last_show_tip_args, 2, parms);
10381 /* Add default values to frame parameters. */
10382 if (NILP (Fassq (Qname, parms)))
10383 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
10384 if (NILP (Fassq (Qinternal_border_width, parms)))
10385 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
10386 if (NILP (Fassq (Qborder_width, parms)))
10387 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
10388 if (NILP (Fassq (Qborder_color, parms)))
10389 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
10390 if (NILP (Fassq (Qbackground_color, parms)))
10391 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
10392 parms);
10394 /* Create a frame for the tooltip, and record it in the global
10395 variable tip_frame. */
10396 frame = x_create_tip_frame (FRAME_X_DISPLAY_INFO (f), parms, string);
10397 f = XFRAME (frame);
10399 /* Set up the frame's root window. */
10400 w = XWINDOW (FRAME_ROOT_WINDOW (f));
10401 w->left_col = w->top_line = make_number (0);
10403 if (CONSP (Vx_max_tooltip_size)
10404 && INTEGERP (XCAR (Vx_max_tooltip_size))
10405 && XINT (XCAR (Vx_max_tooltip_size)) > 0
10406 && INTEGERP (XCDR (Vx_max_tooltip_size))
10407 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
10409 w->total_cols = XCAR (Vx_max_tooltip_size);
10410 w->total_lines = XCDR (Vx_max_tooltip_size);
10412 else
10414 w->total_cols = make_number (80);
10415 w->total_lines = make_number (40);
10418 FRAME_TOTAL_COLS (f) = XINT (w->total_cols);
10419 adjust_glyphs (f);
10420 w->pseudo_window_p = 1;
10422 /* Display the tooltip text in a temporary buffer. */
10423 old_buffer = current_buffer;
10424 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
10425 current_buffer->truncate_lines = Qnil;
10426 clear_glyph_matrix (w->desired_matrix);
10427 clear_glyph_matrix (w->current_matrix);
10428 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
10429 try_window (FRAME_ROOT_WINDOW (f), pos);
10431 /* Compute width and height of the tooltip. */
10432 width = height = 0;
10433 for (i = 0; i < w->desired_matrix->nrows; ++i)
10435 struct glyph_row *row = &w->desired_matrix->rows[i];
10436 struct glyph *last;
10437 int row_width;
10439 /* Stop at the first empty row at the end. */
10440 if (!row->enabled_p || !row->displays_text_p)
10441 break;
10443 /* Let the row go over the full width of the frame. */
10444 row->full_width_p = 1;
10446 /* There's a glyph at the end of rows that is used to place
10447 the cursor there. Don't include the width of this glyph. */
10448 if (row->used[TEXT_AREA])
10450 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
10451 row_width = row->pixel_width - last->pixel_width;
10453 else
10454 row_width = row->pixel_width;
10456 height += row->height;
10457 width = max (width, row_width);
10460 /* Add the frame's internal border to the width and height the X
10461 window should have. */
10462 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
10463 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
10465 /* Move the tooltip window where the mouse pointer is. Resize and
10466 show it. */
10467 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
10469 BLOCK_INPUT;
10470 XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10471 root_x, root_y, width, height);
10472 XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
10473 UNBLOCK_INPUT;
10475 /* Draw into the window. */
10476 w->must_be_updated_p = 1;
10477 update_single_window (w, 1);
10479 /* Restore original current buffer. */
10480 set_buffer_internal_1 (old_buffer);
10481 windows_or_buffers_changed = old_windows_or_buffers_changed;
10483 start_timer:
10484 /* Let the tip disappear after timeout seconds. */
10485 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
10486 intern ("x-hide-tip"));
10488 UNGCPRO;
10489 return unbind_to (count, Qnil);
10493 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
10494 doc: /* Hide the current tooltip window, if there is any.
10495 Value is t if tooltip was open, nil otherwise. */)
10498 int count;
10499 Lisp_Object deleted, frame, timer;
10500 struct gcpro gcpro1, gcpro2;
10502 /* Return quickly if nothing to do. */
10503 if (NILP (tip_timer) && NILP (tip_frame))
10504 return Qnil;
10506 frame = tip_frame;
10507 timer = tip_timer;
10508 GCPRO2 (frame, timer);
10509 tip_frame = tip_timer = deleted = Qnil;
10511 count = SPECPDL_INDEX ();
10512 specbind (Qinhibit_redisplay, Qt);
10513 specbind (Qinhibit_quit, Qt);
10515 if (!NILP (timer))
10516 call1 (Qcancel_timer, timer);
10518 if (FRAMEP (frame))
10520 Fdelete_frame (frame, Qnil);
10521 deleted = Qt;
10523 #ifdef USE_LUCID
10524 /* Bloodcurdling hack alert: The Lucid menu bar widget's
10525 redisplay procedure is not called when a tip frame over menu
10526 items is unmapped. Redisplay the menu manually... */
10528 struct frame *f = SELECTED_FRAME ();
10529 Widget w = f->output_data.x->menubar_widget;
10530 extern void xlwmenu_redisplay P_ ((Widget));
10532 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f)->screen)
10533 && w != NULL)
10535 BLOCK_INPUT;
10536 xlwmenu_redisplay (w);
10537 UNBLOCK_INPUT;
10540 #endif /* USE_LUCID */
10543 UNGCPRO;
10544 return unbind_to (count, deleted);
10549 /***********************************************************************
10550 File selection dialog
10551 ***********************************************************************/
10553 #ifdef USE_MOTIF
10555 /* Callback for "OK" and "Cancel" on file selection dialog. */
10557 static void
10558 file_dialog_cb (widget, client_data, call_data)
10559 Widget widget;
10560 XtPointer call_data, client_data;
10562 int *result = (int *) client_data;
10563 XmAnyCallbackStruct *cb = (XmAnyCallbackStruct *) call_data;
10564 *result = cb->reason;
10568 /* Callback for unmapping a file selection dialog. This is used to
10569 capture the case where a dialog is closed via a window manager's
10570 closer button, for example. Using a XmNdestroyCallback didn't work
10571 in this case. */
10573 static void
10574 file_dialog_unmap_cb (widget, client_data, call_data)
10575 Widget widget;
10576 XtPointer call_data, client_data;
10578 int *result = (int *) client_data;
10579 *result = XmCR_CANCEL;
10583 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
10584 doc: /* Read file name, prompting with PROMPT in directory DIR.
10585 Use a file selection dialog.
10586 Select DEFAULT-FILENAME in the dialog's file selection box, if
10587 specified. Don't let the user enter a file name in the file
10588 selection dialog's entry field, if MUSTMATCH is non-nil. */)
10589 (prompt, dir, default_filename, mustmatch)
10590 Lisp_Object prompt, dir, default_filename, mustmatch;
10592 int result;
10593 struct frame *f = SELECTED_FRAME ();
10594 Lisp_Object file = Qnil;
10595 Widget dialog, text, list, help;
10596 Arg al[10];
10597 int ac = 0;
10598 extern XtAppContext Xt_app_con;
10599 XmString dir_xmstring, pattern_xmstring;
10600 int count = SPECPDL_INDEX ();
10601 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
10603 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
10604 CHECK_STRING (prompt);
10605 CHECK_STRING (dir);
10607 /* Prevent redisplay. */
10608 specbind (Qinhibit_redisplay, Qt);
10610 BLOCK_INPUT;
10612 /* Create the dialog with PROMPT as title, using DIR as initial
10613 directory and using "*" as pattern. */
10614 dir = Fexpand_file_name (dir, Qnil);
10615 dir_xmstring = XmStringCreateLocalized (SDATA (dir));
10616 pattern_xmstring = XmStringCreateLocalized ("*");
10618 XtSetArg (al[ac], XmNtitle, SDATA (prompt)); ++ac;
10619 XtSetArg (al[ac], XmNdirectory, dir_xmstring); ++ac;
10620 XtSetArg (al[ac], XmNpattern, pattern_xmstring); ++ac;
10621 XtSetArg (al[ac], XmNresizePolicy, XmRESIZE_GROW); ++ac;
10622 XtSetArg (al[ac], XmNdialogStyle, XmDIALOG_APPLICATION_MODAL); ++ac;
10623 dialog = XmCreateFileSelectionDialog (f->output_data.x->widget,
10624 "fsb", al, ac);
10625 XmStringFree (dir_xmstring);
10626 XmStringFree (pattern_xmstring);
10628 /* Add callbacks for OK and Cancel. */
10629 XtAddCallback (dialog, XmNokCallback, file_dialog_cb,
10630 (XtPointer) &result);
10631 XtAddCallback (dialog, XmNcancelCallback, file_dialog_cb,
10632 (XtPointer) &result);
10633 XtAddCallback (dialog, XmNunmapCallback, file_dialog_unmap_cb,
10634 (XtPointer) &result);
10636 /* Disable the help button since we can't display help. */
10637 help = XmFileSelectionBoxGetChild (dialog, XmDIALOG_HELP_BUTTON);
10638 XtSetSensitive (help, False);
10640 /* Mark OK button as default. */
10641 XtVaSetValues (XmFileSelectionBoxGetChild (dialog, XmDIALOG_OK_BUTTON),
10642 XmNshowAsDefault, True, NULL);
10644 /* If MUSTMATCH is non-nil, disable the file entry field of the
10645 dialog, so that the user must select a file from the files list
10646 box. We can't remove it because we wouldn't have a way to get at
10647 the result file name, then. */
10648 text = XmFileSelectionBoxGetChild (dialog, XmDIALOG_TEXT);
10649 if (!NILP (mustmatch))
10651 Widget label;
10652 label = XmFileSelectionBoxGetChild (dialog, XmDIALOG_SELECTION_LABEL);
10653 XtSetSensitive (text, False);
10654 XtSetSensitive (label, False);
10657 /* Manage the dialog, so that list boxes get filled. */
10658 XtManageChild (dialog);
10660 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
10661 must include the path for this to work. */
10662 list = XmFileSelectionBoxGetChild (dialog, XmDIALOG_LIST);
10663 if (STRINGP (default_filename))
10665 XmString default_xmstring;
10666 int item_pos;
10668 default_xmstring
10669 = XmStringCreateLocalized (SDATA (default_filename));
10671 if (!XmListItemExists (list, default_xmstring))
10673 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10674 XmListAddItem (list, default_xmstring, 0);
10675 item_pos = 0;
10677 else
10678 item_pos = XmListItemPos (list, default_xmstring);
10679 XmStringFree (default_xmstring);
10681 /* Select the item and scroll it into view. */
10682 XmListSelectPos (list, item_pos, True);
10683 XmListSetPos (list, item_pos);
10686 /* Process events until the user presses Cancel or OK. */
10687 result = 0;
10688 while (result == 0)
10690 XEvent event;
10691 XtAppNextEvent (Xt_app_con, &event);
10692 (void) x_dispatch_event (&event, FRAME_X_DISPLAY (f) );
10695 /* Get the result. */
10696 if (result == XmCR_OK)
10698 XmString text;
10699 String data;
10701 XtVaGetValues (dialog, XmNtextString, &text, NULL);
10702 XmStringGetLtoR (text, XmFONTLIST_DEFAULT_TAG, &data);
10703 XmStringFree (text);
10704 file = build_string (data);
10705 XtFree (data);
10707 else
10708 file = Qnil;
10710 /* Clean up. */
10711 XtUnmanageChild (dialog);
10712 XtDestroyWidget (dialog);
10713 UNBLOCK_INPUT;
10714 UNGCPRO;
10716 /* Make "Cancel" equivalent to C-g. */
10717 if (NILP (file))
10718 Fsignal (Qquit, Qnil);
10720 return unbind_to (count, file);
10723 #endif /* USE_MOTIF */
10725 #ifdef USE_GTK
10727 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
10728 "Read file name, prompting with PROMPT in directory DIR.\n\
10729 Use a file selection dialog.\n\
10730 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
10731 specified. Don't let the user enter a file name in the file\n\
10732 selection dialog's entry field, if MUSTMATCH is non-nil.")
10733 (prompt, dir, default_filename, mustmatch)
10734 Lisp_Object prompt, dir, default_filename, mustmatch;
10736 FRAME_PTR f = SELECTED_FRAME ();
10737 char *fn;
10738 Lisp_Object file = Qnil;
10739 int count = specpdl_ptr - specpdl;
10740 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
10741 char *cdef_file;
10742 char *cprompt;
10744 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
10745 CHECK_STRING (prompt);
10746 CHECK_STRING (dir);
10748 /* Prevent redisplay. */
10749 specbind (Qinhibit_redisplay, Qt);
10751 BLOCK_INPUT;
10753 if (STRINGP (default_filename))
10754 cdef_file = SDATA (default_filename);
10755 else
10756 cdef_file = SDATA (dir);
10758 fn = xg_get_file_name (f, SDATA (prompt), cdef_file, ! NILP (mustmatch));
10760 if (fn)
10762 file = build_string (fn);
10763 xfree (fn);
10766 UNBLOCK_INPUT;
10767 UNGCPRO;
10769 /* Make "Cancel" equivalent to C-g. */
10770 if (NILP (file))
10771 Fsignal (Qquit, Qnil);
10773 return unbind_to (count, file);
10776 #endif /* USE_GTK */
10779 /***********************************************************************
10780 Keyboard
10781 ***********************************************************************/
10783 #ifdef HAVE_XKBGETKEYBOARD
10784 #include <X11/XKBlib.h>
10785 #include <X11/keysym.h>
10786 #endif
10788 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p,
10789 Sx_backspace_delete_keys_p, 0, 1, 0,
10790 doc: /* Check if both Backspace and Delete keys are on the keyboard of FRAME.
10791 FRAME nil means use the selected frame.
10792 Value is t if we know that both keys are present, and are mapped to the
10793 usual X keysyms. */)
10794 (frame)
10795 Lisp_Object frame;
10797 #ifdef HAVE_XKBGETKEYBOARD
10798 XkbDescPtr kb;
10799 struct frame *f = check_x_frame (frame);
10800 Display *dpy = FRAME_X_DISPLAY (f);
10801 Lisp_Object have_keys;
10802 int major, minor, op, event, error;
10804 BLOCK_INPUT;
10806 /* Check library version in case we're dynamically linked. */
10807 major = XkbMajorVersion;
10808 minor = XkbMinorVersion;
10809 if (!XkbLibraryVersion (&major, &minor))
10811 UNBLOCK_INPUT;
10812 return Qnil;
10815 /* Check that the server supports XKB. */
10816 major = XkbMajorVersion;
10817 minor = XkbMinorVersion;
10818 if (!XkbQueryExtension (dpy, &op, &event, &error, &major, &minor))
10820 UNBLOCK_INPUT;
10821 return Qnil;
10824 have_keys = Qnil;
10825 kb = XkbGetMap (dpy, XkbAllMapComponentsMask, XkbUseCoreKbd);
10826 if (kb)
10828 int delete_keycode = 0, backspace_keycode = 0, i;
10830 if (XkbGetNames (dpy, XkbAllNamesMask, kb) == Success)
10832 for (i = kb->min_key_code;
10833 (i < kb->max_key_code
10834 && (delete_keycode == 0 || backspace_keycode == 0));
10835 ++i)
10837 /* The XKB symbolic key names can be seen most easily in
10838 the PS file generated by `xkbprint -label name
10839 $DISPLAY'. */
10840 if (bcmp ("DELE", kb->names->keys[i].name, 4) == 0)
10841 delete_keycode = i;
10842 else if (bcmp ("BKSP", kb->names->keys[i].name, 4) == 0)
10843 backspace_keycode = i;
10846 XkbFreeNames (kb, 0, True);
10849 XkbFreeClientMap (kb, 0, True);
10851 if (delete_keycode
10852 && backspace_keycode
10853 && XKeysymToKeycode (dpy, XK_Delete) == delete_keycode
10854 && XKeysymToKeycode (dpy, XK_BackSpace) == backspace_keycode)
10855 have_keys = Qt;
10857 UNBLOCK_INPUT;
10858 return have_keys;
10859 #else /* not HAVE_XKBGETKEYBOARD */
10860 return Qnil;
10861 #endif /* not HAVE_XKBGETKEYBOARD */
10866 /***********************************************************************
10867 Initialization
10868 ***********************************************************************/
10870 /* Keep this list in the same order as frame_parms in frame.c.
10871 Use 0 for unsupported frame parameters. */
10873 frame_parm_handler x_frame_parm_handlers[] =
10875 x_set_autoraise,
10876 x_set_autolower,
10877 x_set_background_color,
10878 x_set_border_color,
10879 x_set_border_width,
10880 x_set_cursor_color,
10881 x_set_cursor_type,
10882 x_set_font,
10883 x_set_foreground_color,
10884 x_set_icon_name,
10885 x_set_icon_type,
10886 x_set_internal_border_width,
10887 x_set_menu_bar_lines,
10888 x_set_mouse_color,
10889 x_explicitly_set_name,
10890 x_set_scroll_bar_width,
10891 x_set_title,
10892 x_set_unsplittable,
10893 x_set_vertical_scroll_bars,
10894 x_set_visibility,
10895 x_set_tool_bar_lines,
10896 x_set_scroll_bar_foreground,
10897 x_set_scroll_bar_background,
10898 x_set_screen_gamma,
10899 x_set_line_spacing,
10900 x_set_fringe_width,
10901 x_set_fringe_width,
10902 x_set_wait_for_wm,
10903 x_set_fullscreen,
10906 void
10907 syms_of_xfns ()
10909 /* This is zero if not using X windows. */
10910 x_in_use = 0;
10912 /* The section below is built by the lisp expression at the top of the file,
10913 just above where these variables are declared. */
10914 /*&&& init symbols here &&&*/
10915 Qnone = intern ("none");
10916 staticpro (&Qnone);
10917 Qsuppress_icon = intern ("suppress-icon");
10918 staticpro (&Qsuppress_icon);
10919 Qundefined_color = intern ("undefined-color");
10920 staticpro (&Qundefined_color);
10921 Qcenter = intern ("center");
10922 staticpro (&Qcenter);
10923 Qcompound_text = intern ("compound-text");
10924 staticpro (&Qcompound_text);
10925 Qcancel_timer = intern ("cancel-timer");
10926 staticpro (&Qcancel_timer);
10927 /* This is the end of symbol initialization. */
10929 /* Text property `display' should be nonsticky by default. */
10930 Vtext_property_default_nonsticky
10931 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
10934 Qlaplace = intern ("laplace");
10935 staticpro (&Qlaplace);
10936 Qemboss = intern ("emboss");
10937 staticpro (&Qemboss);
10938 Qedge_detection = intern ("edge-detection");
10939 staticpro (&Qedge_detection);
10940 Qheuristic = intern ("heuristic");
10941 staticpro (&Qheuristic);
10942 QCmatrix = intern (":matrix");
10943 staticpro (&QCmatrix);
10944 QCcolor_adjustment = intern (":color-adjustment");
10945 staticpro (&QCcolor_adjustment);
10946 QCmask = intern (":mask");
10947 staticpro (&QCmask);
10949 Fput (Qundefined_color, Qerror_conditions,
10950 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
10951 Fput (Qundefined_color, Qerror_message,
10952 build_string ("Undefined color"));
10954 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images,
10955 doc: /* Non-nil means always draw a cross over disabled images.
10956 Disabled images are those having an `:conversion disabled' property.
10957 A cross is always drawn on black & white displays. */);
10958 cross_disabled_images = 0;
10960 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
10961 doc: /* List of directories to search for window system bitmap files. */);
10962 Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
10964 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
10965 doc: /* The shape of the pointer when over text.
10966 Changing the value does not affect existing frames
10967 unless you set the mouse color. */);
10968 Vx_pointer_shape = Qnil;
10970 #if 0 /* This doesn't really do anything. */
10971 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
10972 doc: /* The shape of the pointer when not over text.
10973 This variable takes effect when you create a new frame
10974 or when you set the mouse color. */);
10975 #endif
10976 Vx_nontext_pointer_shape = Qnil;
10978 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
10979 doc: /* The shape of the pointer when Emacs is busy.
10980 This variable takes effect when you create a new frame
10981 or when you set the mouse color. */);
10982 Vx_hourglass_pointer_shape = Qnil;
10984 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
10985 doc: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
10986 display_hourglass_p = 1;
10988 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
10989 doc: /* *Seconds to wait before displaying an hourglass pointer.
10990 Value must be an integer or float. */);
10991 Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
10993 #if 0 /* This doesn't really do anything. */
10994 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
10995 doc: /* The shape of the pointer when over the mode line.
10996 This variable takes effect when you create a new frame
10997 or when you set the mouse color. */);
10998 #endif
10999 Vx_mode_pointer_shape = Qnil;
11001 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11002 &Vx_sensitive_text_pointer_shape,
11003 doc: /* The shape of the pointer when over mouse-sensitive text.
11004 This variable takes effect when you create a new frame
11005 or when you set the mouse color. */);
11006 Vx_sensitive_text_pointer_shape = Qnil;
11008 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
11009 &Vx_window_horizontal_drag_shape,
11010 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
11011 This variable takes effect when you create a new frame
11012 or when you set the mouse color. */);
11013 Vx_window_horizontal_drag_shape = Qnil;
11015 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
11016 doc: /* A string indicating the foreground color of the cursor box. */);
11017 Vx_cursor_fore_pixel = Qnil;
11019 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
11020 doc: /* Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).
11021 Text larger than this is clipped. */);
11022 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
11024 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
11025 doc: /* Non-nil if no X window manager is in use.
11026 Emacs doesn't try to figure this out; this is always nil
11027 unless you set it to something else. */);
11028 /* We don't have any way to find this out, so set it to nil
11029 and maybe the user would like to set it to t. */
11030 Vx_no_window_manager = Qnil;
11032 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11033 &Vx_pixel_size_width_font_regexp,
11034 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
11036 Since Emacs gets width of a font matching with this regexp from
11037 PIXEL_SIZE field of the name, font finding mechanism gets faster for
11038 such a font. This is especially effective for such large fonts as
11039 Chinese, Japanese, and Korean. */);
11040 Vx_pixel_size_width_font_regexp = Qnil;
11042 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay,
11043 doc: /* Time after which cached images are removed from the cache.
11044 When an image has not been displayed this many seconds, remove it
11045 from the image cache. Value must be an integer or nil with nil
11046 meaning don't clear the cache. */);
11047 Vimage_cache_eviction_delay = make_number (30 * 60);
11049 #ifdef USE_X_TOOLKIT
11050 Fprovide (intern ("x-toolkit"), Qnil);
11051 #ifdef USE_MOTIF
11052 Fprovide (intern ("motif"), Qnil);
11054 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string,
11055 doc: /* Version info for LessTif/Motif. */);
11056 Vmotif_version_string = build_string (XmVERSION_STRING);
11057 #endif /* USE_MOTIF */
11058 #endif /* USE_X_TOOLKIT */
11060 #ifdef USE_GTK
11061 Fprovide (intern ("gtk"), Qnil);
11063 DEFVAR_LISP ("gtk-version-string", &Vgtk_version_string,
11064 doc: /* Version info for GTK+. */);
11066 char gtk_version[40];
11067 g_snprintf (gtk_version, sizeof (gtk_version), "%u.%u.%u",
11068 GTK_MAJOR_VERSION, GTK_MINOR_VERSION, GTK_MICRO_VERSION);
11069 Vgtk_version_string = build_string (gtk_version);
11071 #endif /* USE_GTK */
11073 /* X window properties. */
11074 defsubr (&Sx_change_window_property);
11075 defsubr (&Sx_delete_window_property);
11076 defsubr (&Sx_window_property);
11078 defsubr (&Sxw_display_color_p);
11079 defsubr (&Sx_display_grayscale_p);
11080 defsubr (&Sxw_color_defined_p);
11081 defsubr (&Sxw_color_values);
11082 defsubr (&Sx_server_max_request_size);
11083 defsubr (&Sx_server_vendor);
11084 defsubr (&Sx_server_version);
11085 defsubr (&Sx_display_pixel_width);
11086 defsubr (&Sx_display_pixel_height);
11087 defsubr (&Sx_display_mm_width);
11088 defsubr (&Sx_display_mm_height);
11089 defsubr (&Sx_display_screens);
11090 defsubr (&Sx_display_planes);
11091 defsubr (&Sx_display_color_cells);
11092 defsubr (&Sx_display_visual_class);
11093 defsubr (&Sx_display_backing_store);
11094 defsubr (&Sx_display_save_under);
11095 defsubr (&Sx_create_frame);
11096 defsubr (&Sx_open_connection);
11097 defsubr (&Sx_close_connection);
11098 defsubr (&Sx_display_list);
11099 defsubr (&Sx_synchronize);
11100 defsubr (&Sx_send_client_message);
11101 defsubr (&Sx_focus_frame);
11102 defsubr (&Sx_backspace_delete_keys_p);
11104 /* Setting callback functions for fontset handler. */
11105 get_font_info_func = x_get_font_info;
11107 #if 0 /* This function pointer doesn't seem to be used anywhere.
11108 And the pointer assigned has the wrong type, anyway. */
11109 list_fonts_func = x_list_fonts;
11110 #endif
11112 load_font_func = x_load_font;
11113 find_ccl_program_func = x_find_ccl_program;
11114 query_font_func = x_query_font;
11115 set_frame_fontset_func = x_set_font;
11116 check_window_system_func = check_x;
11118 /* Images. */
11119 Qxbm = intern ("xbm");
11120 staticpro (&Qxbm);
11121 QCconversion = intern (":conversion");
11122 staticpro (&QCconversion);
11123 QCheuristic_mask = intern (":heuristic-mask");
11124 staticpro (&QCheuristic_mask);
11125 QCcolor_symbols = intern (":color-symbols");
11126 staticpro (&QCcolor_symbols);
11127 QCascent = intern (":ascent");
11128 staticpro (&QCascent);
11129 QCmargin = intern (":margin");
11130 staticpro (&QCmargin);
11131 QCrelief = intern (":relief");
11132 staticpro (&QCrelief);
11133 Qpostscript = intern ("postscript");
11134 staticpro (&Qpostscript);
11135 QCloader = intern (":loader");
11136 staticpro (&QCloader);
11137 QCbounding_box = intern (":bounding-box");
11138 staticpro (&QCbounding_box);
11139 QCpt_width = intern (":pt-width");
11140 staticpro (&QCpt_width);
11141 QCpt_height = intern (":pt-height");
11142 staticpro (&QCpt_height);
11143 QCindex = intern (":index");
11144 staticpro (&QCindex);
11145 Qpbm = intern ("pbm");
11146 staticpro (&Qpbm);
11148 #if HAVE_XPM
11149 Qxpm = intern ("xpm");
11150 staticpro (&Qxpm);
11151 #endif
11153 #if HAVE_JPEG
11154 Qjpeg = intern ("jpeg");
11155 staticpro (&Qjpeg);
11156 #endif
11158 #if HAVE_TIFF
11159 Qtiff = intern ("tiff");
11160 staticpro (&Qtiff);
11161 #endif
11163 #if HAVE_GIF
11164 Qgif = intern ("gif");
11165 staticpro (&Qgif);
11166 #endif
11168 #if HAVE_PNG
11169 Qpng = intern ("png");
11170 staticpro (&Qpng);
11171 #endif
11173 defsubr (&Sclear_image_cache);
11174 defsubr (&Simage_size);
11175 defsubr (&Simage_mask_p);
11177 hourglass_atimer = NULL;
11178 hourglass_shown_p = 0;
11180 defsubr (&Sx_show_tip);
11181 defsubr (&Sx_hide_tip);
11182 tip_timer = Qnil;
11183 staticpro (&tip_timer);
11184 tip_frame = Qnil;
11185 staticpro (&tip_frame);
11187 last_show_tip_args = Qnil;
11188 staticpro (&last_show_tip_args);
11190 #ifdef USE_MOTIF
11191 defsubr (&Sx_file_dialog);
11192 #endif
11196 void
11197 init_xfns ()
11199 image_types = NULL;
11200 Vimage_types = Qnil;
11202 define_image_type (&xbm_type);
11203 define_image_type (&gs_type);
11204 define_image_type (&pbm_type);
11206 #if HAVE_XPM
11207 define_image_type (&xpm_type);
11208 #endif
11210 #if HAVE_JPEG
11211 define_image_type (&jpeg_type);
11212 #endif
11214 #if HAVE_TIFF
11215 define_image_type (&tiff_type);
11216 #endif
11218 #if HAVE_GIF
11219 define_image_type (&gif_type);
11220 #endif
11222 #if HAVE_PNG
11223 define_image_type (&png_type);
11224 #endif
11227 #endif /* HAVE_X_WINDOWS */
11229 /* arch-tag: 55040d02-5485-4d58-8b22-95a7a05f3288
11230 (do not change this comment) */