Remove tear off capability for GTK popup menus.
[emacs.git] / src / xfns.c
blobb188ee3a43d78fb95378ce5c2acc94a0dcfad428
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 (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 (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 (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 (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 (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 x_check_errors (dpy, "bad nontext pointer cursor: %s");
1304 if (!NILP (Vx_mode_pointer_shape))
1306 CHECK_NUMBER (Vx_mode_pointer_shape);
1307 mode_cursor = XCreateFontCursor (dpy, XINT (Vx_mode_pointer_shape));
1309 else
1310 mode_cursor = XCreateFontCursor (dpy, XC_xterm);
1311 x_check_errors (dpy, "bad modeline pointer cursor: %s");
1313 if (!NILP (Vx_sensitive_text_pointer_shape))
1315 CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
1316 hand_cursor
1317 = XCreateFontCursor (dpy, XINT (Vx_sensitive_text_pointer_shape));
1319 else
1320 hand_cursor = XCreateFontCursor (dpy, XC_hand2);
1322 if (!NILP (Vx_window_horizontal_drag_shape))
1324 CHECK_NUMBER (Vx_window_horizontal_drag_shape);
1325 horizontal_drag_cursor
1326 = XCreateFontCursor (dpy, XINT (Vx_window_horizontal_drag_shape));
1328 else
1329 horizontal_drag_cursor
1330 = XCreateFontCursor (dpy, XC_sb_h_double_arrow);
1332 /* Check and report errors with the above calls. */
1333 x_check_errors (dpy, "can't set cursor shape: %s");
1334 x_uncatch_errors (dpy, count);
1337 XColor fore_color, back_color;
1339 fore_color.pixel = x->mouse_pixel;
1340 x_query_color (f, &fore_color);
1341 back_color.pixel = mask_color;
1342 x_query_color (f, &back_color);
1344 XRecolorCursor (dpy, cursor, &fore_color, &back_color);
1345 XRecolorCursor (dpy, nontext_cursor, &fore_color, &back_color);
1346 XRecolorCursor (dpy, mode_cursor, &fore_color, &back_color);
1347 XRecolorCursor (dpy, hand_cursor, &fore_color, &back_color);
1348 XRecolorCursor (dpy, hourglass_cursor, &fore_color, &back_color);
1349 XRecolorCursor (dpy, horizontal_drag_cursor, &fore_color, &back_color);
1352 if (FRAME_X_WINDOW (f) != 0)
1353 XDefineCursor (dpy, FRAME_X_WINDOW (f), cursor);
1355 if (cursor != x->text_cursor
1356 && x->text_cursor != 0)
1357 XFreeCursor (dpy, x->text_cursor);
1358 x->text_cursor = cursor;
1360 if (nontext_cursor != x->nontext_cursor
1361 && x->nontext_cursor != 0)
1362 XFreeCursor (dpy, x->nontext_cursor);
1363 x->nontext_cursor = nontext_cursor;
1365 if (hourglass_cursor != x->hourglass_cursor
1366 && x->hourglass_cursor != 0)
1367 XFreeCursor (dpy, x->hourglass_cursor);
1368 x->hourglass_cursor = hourglass_cursor;
1370 if (mode_cursor != x->modeline_cursor
1371 && x->modeline_cursor != 0)
1372 XFreeCursor (dpy, f->output_data.x->modeline_cursor);
1373 x->modeline_cursor = mode_cursor;
1375 if (hand_cursor != x->hand_cursor
1376 && x->hand_cursor != 0)
1377 XFreeCursor (dpy, x->hand_cursor);
1378 x->hand_cursor = hand_cursor;
1380 if (horizontal_drag_cursor != x->horizontal_drag_cursor
1381 && x->horizontal_drag_cursor != 0)
1382 XFreeCursor (dpy, x->horizontal_drag_cursor);
1383 x->horizontal_drag_cursor = horizontal_drag_cursor;
1385 XFlush (dpy);
1386 UNBLOCK_INPUT;
1388 update_face_from_frame_parameter (f, Qmouse_color, arg);
1391 void
1392 x_set_cursor_color (f, arg, oldval)
1393 struct frame *f;
1394 Lisp_Object arg, oldval;
1396 unsigned long fore_pixel, pixel;
1397 int fore_pixel_allocated_p = 0, pixel_allocated_p = 0;
1398 struct x_output *x = f->output_data.x;
1400 if (!NILP (Vx_cursor_fore_pixel))
1402 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1403 WHITE_PIX_DEFAULT (f));
1404 fore_pixel_allocated_p = 1;
1406 else
1407 fore_pixel = x->background_pixel;
1409 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1410 pixel_allocated_p = 1;
1412 /* Make sure that the cursor color differs from the background color. */
1413 if (pixel == x->background_pixel)
1415 if (pixel_allocated_p)
1417 x_free_colors (f, &pixel, 1);
1418 pixel_allocated_p = 0;
1421 pixel = x->mouse_pixel;
1422 if (pixel == fore_pixel)
1424 if (fore_pixel_allocated_p)
1426 x_free_colors (f, &fore_pixel, 1);
1427 fore_pixel_allocated_p = 0;
1429 fore_pixel = x->background_pixel;
1433 unload_color (f, x->cursor_foreground_pixel);
1434 if (!fore_pixel_allocated_p)
1435 fore_pixel = x_copy_color (f, fore_pixel);
1436 x->cursor_foreground_pixel = fore_pixel;
1438 unload_color (f, x->cursor_pixel);
1439 if (!pixel_allocated_p)
1440 pixel = x_copy_color (f, pixel);
1441 x->cursor_pixel = pixel;
1443 if (FRAME_X_WINDOW (f) != 0)
1445 BLOCK_INPUT;
1446 XSetBackground (FRAME_X_DISPLAY (f), x->cursor_gc, x->cursor_pixel);
1447 XSetForeground (FRAME_X_DISPLAY (f), x->cursor_gc, fore_pixel);
1448 UNBLOCK_INPUT;
1450 if (FRAME_VISIBLE_P (f))
1452 x_update_cursor (f, 0);
1453 x_update_cursor (f, 1);
1457 update_face_from_frame_parameter (f, Qcursor_color, arg);
1460 /* Set the border-color of frame F to pixel value PIX.
1461 Note that this does not fully take effect if done before
1462 F has an x-window. */
1464 void
1465 x_set_border_pixel (f, pix)
1466 struct frame *f;
1467 int pix;
1469 unload_color (f, f->output_data.x->border_pixel);
1470 f->output_data.x->border_pixel = pix;
1472 if (FRAME_X_WINDOW (f) != 0 && f->border_width > 0)
1474 BLOCK_INPUT;
1475 XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1476 (unsigned long)pix);
1477 UNBLOCK_INPUT;
1479 if (FRAME_VISIBLE_P (f))
1480 redraw_frame (f);
1484 /* Set the border-color of frame F to value described by ARG.
1485 ARG can be a string naming a color.
1486 The border-color is used for the border that is drawn by the X server.
1487 Note that this does not fully take effect if done before
1488 F has an x-window; it must be redone when the window is created.
1490 Note: this is done in two routines because of the way X10 works.
1492 Note: under X11, this is normally the province of the window manager,
1493 and so emacs' border colors may be overridden. */
1495 void
1496 x_set_border_color (f, arg, oldval)
1497 struct frame *f;
1498 Lisp_Object arg, oldval;
1500 int pix;
1502 CHECK_STRING (arg);
1503 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1504 x_set_border_pixel (f, pix);
1505 update_face_from_frame_parameter (f, Qborder_color, arg);
1509 void
1510 x_set_cursor_type (f, arg, oldval)
1511 FRAME_PTR f;
1512 Lisp_Object arg, oldval;
1514 set_frame_cursor_types (f, arg);
1516 /* Make sure the cursor gets redrawn. */
1517 cursor_type_changed = 1;
1520 void
1521 x_set_icon_type (f, arg, oldval)
1522 struct frame *f;
1523 Lisp_Object arg, oldval;
1525 int result;
1527 if (STRINGP (arg))
1529 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1530 return;
1532 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1533 return;
1535 BLOCK_INPUT;
1536 if (NILP (arg))
1537 result = x_text_icon (f,
1538 (char *) SDATA ((!NILP (f->icon_name)
1539 ? f->icon_name
1540 : f->name)));
1541 else
1542 result = x_bitmap_icon (f, arg);
1544 if (result)
1546 UNBLOCK_INPUT;
1547 error ("No icon window available");
1550 XFlush (FRAME_X_DISPLAY (f));
1551 UNBLOCK_INPUT;
1554 void
1555 x_set_icon_name (f, arg, oldval)
1556 struct frame *f;
1557 Lisp_Object arg, oldval;
1559 int result;
1561 if (STRINGP (arg))
1563 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1564 return;
1566 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1567 return;
1569 f->icon_name = arg;
1571 if (f->output_data.x->icon_bitmap != 0)
1572 return;
1574 BLOCK_INPUT;
1576 result = x_text_icon (f,
1577 (char *) SDATA ((!NILP (f->icon_name)
1578 ? f->icon_name
1579 : !NILP (f->title)
1580 ? f->title
1581 : f->name)));
1583 if (result)
1585 UNBLOCK_INPUT;
1586 error ("No icon window available");
1589 XFlush (FRAME_X_DISPLAY (f));
1590 UNBLOCK_INPUT;
1594 void
1595 x_set_menu_bar_lines (f, value, oldval)
1596 struct frame *f;
1597 Lisp_Object value, oldval;
1599 int nlines;
1600 #ifndef USE_X_TOOLKIT
1601 int olines = FRAME_MENU_BAR_LINES (f);
1602 #endif
1604 /* Right now, menu bars don't work properly in minibuf-only frames;
1605 most of the commands try to apply themselves to the minibuffer
1606 frame itself, and get an error because you can't switch buffers
1607 in or split the minibuffer window. */
1608 if (FRAME_MINIBUF_ONLY_P (f))
1609 return;
1611 if (INTEGERP (value))
1612 nlines = XINT (value);
1613 else
1614 nlines = 0;
1616 /* Make sure we redisplay all windows in this frame. */
1617 windows_or_buffers_changed++;
1619 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
1620 FRAME_MENU_BAR_LINES (f) = 0;
1621 if (nlines)
1623 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1624 if (FRAME_X_P (f) && f->output_data.x->menubar_widget == 0)
1625 /* Make sure next redisplay shows the menu bar. */
1626 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1628 else
1630 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1631 free_frame_menubar (f);
1632 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1633 if (FRAME_X_P (f))
1634 f->output_data.x->menubar_widget = 0;
1636 #else /* not USE_X_TOOLKIT && not USE_GTK */
1637 FRAME_MENU_BAR_LINES (f) = nlines;
1638 change_window_heights (f->root_window, nlines - olines);
1639 #endif /* not USE_X_TOOLKIT */
1640 adjust_glyphs (f);
1644 /* Set the number of lines used for the tool bar of frame F to VALUE.
1645 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1646 is the old number of tool bar lines. This function changes the
1647 height of all windows on frame F to match the new tool bar height.
1648 The frame's height doesn't change. */
1650 void
1651 x_set_tool_bar_lines (f, value, oldval)
1652 struct frame *f;
1653 Lisp_Object value, oldval;
1655 int delta, nlines, root_height;
1656 Lisp_Object root_window;
1658 /* Treat tool bars like menu bars. */
1659 if (FRAME_MINIBUF_ONLY_P (f))
1660 return;
1662 /* Use VALUE only if an integer >= 0. */
1663 if (INTEGERP (value) && XINT (value) >= 0)
1664 nlines = XFASTINT (value);
1665 else
1666 nlines = 0;
1668 #ifdef USE_GTK
1669 FRAME_TOOL_BAR_LINES (f) = 0;
1670 if (nlines)
1672 FRAME_EXTERNAL_TOOL_BAR (f) = 1;
1673 if (FRAME_X_P (f) && f->output_data.x->toolbar_widget == 0)
1674 /* Make sure next redisplay shows the tool bar. */
1675 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1676 update_frame_tool_bar (f);
1678 else
1680 if (FRAME_EXTERNAL_TOOL_BAR (f))
1681 free_frame_tool_bar (f);
1682 FRAME_EXTERNAL_TOOL_BAR (f) = 0;
1685 return;
1686 #endif
1688 /* Make sure we redisplay all windows in this frame. */
1689 ++windows_or_buffers_changed;
1691 delta = nlines - FRAME_TOOL_BAR_LINES (f);
1693 /* Don't resize the tool-bar to more than we have room for. */
1694 root_window = FRAME_ROOT_WINDOW (f);
1695 root_height = WINDOW_TOTAL_LINES (XWINDOW (root_window));
1696 if (root_height - delta < 1)
1698 delta = root_height - 1;
1699 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
1702 FRAME_TOOL_BAR_LINES (f) = nlines;
1703 change_window_heights (root_window, delta);
1704 adjust_glyphs (f);
1706 /* We also have to make sure that the internal border at the top of
1707 the frame, below the menu bar or tool bar, is redrawn when the
1708 tool bar disappears. This is so because the internal border is
1709 below the tool bar if one is displayed, but is below the menu bar
1710 if there isn't a tool bar. The tool bar draws into the area
1711 below the menu bar. */
1712 if (FRAME_X_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
1714 updating_frame = f;
1715 clear_frame ();
1716 clear_current_matrices (f);
1717 updating_frame = NULL;
1720 /* If the tool bar gets smaller, the internal border below it
1721 has to be cleared. It was formerly part of the display
1722 of the larger tool bar, and updating windows won't clear it. */
1723 if (delta < 0)
1725 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
1726 int width = FRAME_PIXEL_WIDTH (f);
1727 int y = nlines * FRAME_LINE_HEIGHT (f);
1729 BLOCK_INPUT;
1730 x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1731 0, y, width, height, False);
1732 UNBLOCK_INPUT;
1734 if (WINDOWP (f->tool_bar_window))
1735 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
1740 /* Set the foreground color for scroll bars on frame F to VALUE.
1741 VALUE should be a string, a color name. If it isn't a string or
1742 isn't a valid color name, do nothing. OLDVAL is the old value of
1743 the frame parameter. */
1745 void
1746 x_set_scroll_bar_foreground (f, value, oldval)
1747 struct frame *f;
1748 Lisp_Object value, oldval;
1750 unsigned long pixel;
1752 if (STRINGP (value))
1753 pixel = x_decode_color (f, value, BLACK_PIX_DEFAULT (f));
1754 else
1755 pixel = -1;
1757 if (f->output_data.x->scroll_bar_foreground_pixel != -1)
1758 unload_color (f, f->output_data.x->scroll_bar_foreground_pixel);
1760 f->output_data.x->scroll_bar_foreground_pixel = pixel;
1761 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
1763 /* Remove all scroll bars because they have wrong colors. */
1764 if (condemn_scroll_bars_hook)
1765 (*condemn_scroll_bars_hook) (f);
1766 if (judge_scroll_bars_hook)
1767 (*judge_scroll_bars_hook) (f);
1769 update_face_from_frame_parameter (f, Qscroll_bar_foreground, value);
1770 redraw_frame (f);
1775 /* Set the background color for scroll bars on frame F to VALUE VALUE
1776 should be a string, a color name. If it isn't a string or isn't a
1777 valid color name, do nothing. OLDVAL is the old value of the frame
1778 parameter. */
1780 void
1781 x_set_scroll_bar_background (f, value, oldval)
1782 struct frame *f;
1783 Lisp_Object value, oldval;
1785 unsigned long pixel;
1787 if (STRINGP (value))
1788 pixel = x_decode_color (f, value, WHITE_PIX_DEFAULT (f));
1789 else
1790 pixel = -1;
1792 if (f->output_data.x->scroll_bar_background_pixel != -1)
1793 unload_color (f, f->output_data.x->scroll_bar_background_pixel);
1795 #ifdef USE_TOOLKIT_SCROLL_BARS
1796 /* Scrollbar shadow colors. */
1797 if (f->output_data.x->scroll_bar_top_shadow_pixel != -1)
1799 unload_color (f, f->output_data.x->scroll_bar_top_shadow_pixel);
1800 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
1802 if (f->output_data.x->scroll_bar_bottom_shadow_pixel != -1)
1804 unload_color (f, f->output_data.x->scroll_bar_bottom_shadow_pixel);
1805 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
1807 #endif /* USE_TOOLKIT_SCROLL_BARS */
1809 f->output_data.x->scroll_bar_background_pixel = pixel;
1810 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
1812 /* Remove all scroll bars because they have wrong colors. */
1813 if (condemn_scroll_bars_hook)
1814 (*condemn_scroll_bars_hook) (f);
1815 if (judge_scroll_bars_hook)
1816 (*judge_scroll_bars_hook) (f);
1818 update_face_from_frame_parameter (f, Qscroll_bar_background, value);
1819 redraw_frame (f);
1824 /* Encode Lisp string STRING as a text in a format appropriate for
1825 XICCC (X Inter Client Communication Conventions).
1827 If STRING contains only ASCII characters, do no conversion and
1828 return the string data of STRING. Otherwise, encode the text by
1829 CODING_SYSTEM, and return a newly allocated memory area which
1830 should be freed by `xfree' by a caller.
1832 SELECTIONP non-zero means the string is being encoded for an X
1833 selection, so it is safe to run pre-write conversions (which
1834 may run Lisp code).
1836 Store the byte length of resulting text in *TEXT_BYTES.
1838 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
1839 which means that the `encoding' of the result can be `STRING'.
1840 Otherwise store 0 in *STRINGP, which means that the `encoding' of
1841 the result should be `COMPOUND_TEXT'. */
1843 unsigned char *
1844 x_encode_text (string, coding_system, selectionp, text_bytes, stringp)
1845 Lisp_Object string, coding_system;
1846 int *text_bytes, *stringp;
1847 int selectionp;
1849 unsigned char *str = SDATA (string);
1850 int chars = SCHARS (string);
1851 int bytes = SBYTES (string);
1852 int charset_info;
1853 int bufsize;
1854 unsigned char *buf;
1855 struct coding_system coding;
1856 extern Lisp_Object Qcompound_text_with_extensions;
1858 charset_info = find_charset_in_text (str, chars, bytes, NULL, Qnil);
1859 if (charset_info == 0)
1861 /* No multibyte character in OBJ. We need not encode it. */
1862 *text_bytes = bytes;
1863 *stringp = 1;
1864 return str;
1867 setup_coding_system (coding_system, &coding);
1868 if (selectionp
1869 && SYMBOLP (coding.pre_write_conversion)
1870 && !NILP (Ffboundp (coding.pre_write_conversion)))
1872 string = run_pre_post_conversion_on_str (string, &coding, 1);
1873 str = SDATA (string);
1874 chars = SCHARS (string);
1875 bytes = SBYTES (string);
1877 coding.src_multibyte = 1;
1878 coding.dst_multibyte = 0;
1879 coding.mode |= CODING_MODE_LAST_BLOCK;
1880 if (coding.type == coding_type_iso2022)
1881 coding.flags |= CODING_FLAG_ISO_SAFE;
1882 /* We suppress producing escape sequences for composition. */
1883 coding.composing = COMPOSITION_DISABLED;
1884 bufsize = encoding_buffer_size (&coding, bytes);
1885 buf = (unsigned char *) xmalloc (bufsize);
1886 encode_coding (&coding, str, buf, bytes, bufsize);
1887 *text_bytes = coding.produced;
1888 *stringp = (charset_info == 1
1889 || (!EQ (coding_system, Qcompound_text)
1890 && !EQ (coding_system, Qcompound_text_with_extensions)));
1891 return buf;
1895 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1896 x_id_name.
1898 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1899 name; if NAME is a string, set F's name to NAME and set
1900 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1902 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1903 suggesting a new name, which lisp code should override; if
1904 F->explicit_name is set, ignore the new name; otherwise, set it. */
1906 void
1907 x_set_name (f, name, explicit)
1908 struct frame *f;
1909 Lisp_Object name;
1910 int explicit;
1912 /* Make sure that requests from lisp code override requests from
1913 Emacs redisplay code. */
1914 if (explicit)
1916 /* If we're switching from explicit to implicit, we had better
1917 update the mode lines and thereby update the title. */
1918 if (f->explicit_name && NILP (name))
1919 update_mode_lines = 1;
1921 f->explicit_name = ! NILP (name);
1923 else if (f->explicit_name)
1924 return;
1926 /* If NAME is nil, set the name to the x_id_name. */
1927 if (NILP (name))
1929 /* Check for no change needed in this very common case
1930 before we do any consing. */
1931 if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name,
1932 SDATA (f->name)))
1933 return;
1934 name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name);
1936 else
1937 CHECK_STRING (name);
1939 /* Don't change the name if it's already NAME. */
1940 if (! NILP (Fstring_equal (name, f->name)))
1941 return;
1943 f->name = name;
1945 /* For setting the frame title, the title parameter should override
1946 the name parameter. */
1947 if (! NILP (f->title))
1948 name = f->title;
1950 if (FRAME_X_WINDOW (f))
1952 BLOCK_INPUT;
1953 #ifdef HAVE_X11R4
1955 XTextProperty text, icon;
1956 int bytes, stringp;
1957 Lisp_Object coding_system;
1959 /* Note: Encoding strategy
1961 We encode NAME by compound-text and use "COMPOUND-TEXT" in
1962 text.encoding. But, there are non-internationalized window
1963 managers which don't support that encoding. So, if NAME
1964 contains only ASCII and 8859-1 characters, encode it by
1965 iso-latin-1, and use "STRING" in text.encoding hoping that
1966 such window managers at least analyze this format correctly,
1967 i.e. treat 8-bit bytes as 8859-1 characters.
1969 We may also be able to use "UTF8_STRING" in text.encoding
1970 in the future which can encode all Unicode characters.
1971 But, for the moment, there's no way to know that the
1972 current window manager supports it or not. */
1973 coding_system = Qcompound_text;
1974 text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp);
1975 text.encoding = (stringp ? XA_STRING
1976 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
1977 text.format = 8;
1978 text.nitems = bytes;
1980 if (NILP (f->icon_name))
1982 icon = text;
1984 else
1986 /* See the above comment "Note: Encoding strategy". */
1987 icon.value = x_encode_text (f->icon_name, coding_system, 0,
1988 &bytes, &stringp);
1989 icon.encoding = (stringp ? XA_STRING
1990 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
1991 icon.format = 8;
1992 icon.nitems = bytes;
1994 #ifdef USE_GTK
1995 gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
1996 SDATA (name));
1997 #else /* not USE_GTK */
1998 XSetWMName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &text);
1999 #endif /* not USE_GTK */
2001 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &icon);
2003 if (!NILP (f->icon_name)
2004 && icon.value != (unsigned char *) SDATA (f->icon_name))
2005 xfree (icon.value);
2006 if (text.value != (unsigned char *) SDATA (name))
2007 xfree (text.value);
2009 #else /* not HAVE_X11R4 */
2010 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2011 SDATA (name));
2012 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2013 SDATA (name));
2014 #endif /* not HAVE_X11R4 */
2015 UNBLOCK_INPUT;
2019 /* This function should be called when the user's lisp code has
2020 specified a name for the frame; the name will override any set by the
2021 redisplay code. */
2022 void
2023 x_explicitly_set_name (f, arg, oldval)
2024 FRAME_PTR f;
2025 Lisp_Object arg, oldval;
2027 x_set_name (f, arg, 1);
2030 /* This function should be called by Emacs redisplay code to set the
2031 name; names set this way will never override names set by the user's
2032 lisp code. */
2033 void
2034 x_implicitly_set_name (f, arg, oldval)
2035 FRAME_PTR f;
2036 Lisp_Object arg, oldval;
2038 x_set_name (f, arg, 0);
2041 /* Change the title of frame F to NAME.
2042 If NAME is nil, use the frame name as the title.
2044 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2045 name; if NAME is a string, set F's name to NAME and set
2046 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2048 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2049 suggesting a new name, which lisp code should override; if
2050 F->explicit_name is set, ignore the new name; otherwise, set it. */
2052 void
2053 x_set_title (f, name, old_name)
2054 struct frame *f;
2055 Lisp_Object name, old_name;
2057 /* Don't change the title if it's already NAME. */
2058 if (EQ (name, f->title))
2059 return;
2061 update_mode_lines = 1;
2063 f->title = name;
2065 if (NILP (name))
2066 name = f->name;
2067 else
2068 CHECK_STRING (name);
2070 if (FRAME_X_WINDOW (f))
2072 BLOCK_INPUT;
2073 #ifdef HAVE_X11R4
2075 XTextProperty text, icon;
2076 int bytes, stringp;
2077 Lisp_Object coding_system;
2079 coding_system = Qcompound_text;
2080 /* See the comment "Note: Encoding strategy" in x_set_name. */
2081 text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp);
2082 text.encoding = (stringp ? XA_STRING
2083 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
2084 text.format = 8;
2085 text.nitems = bytes;
2087 if (NILP (f->icon_name))
2089 icon = text;
2091 else
2093 /* See the comment "Note: Encoding strategy" in x_set_name. */
2094 icon.value = x_encode_text (f->icon_name, coding_system, 0,
2095 &bytes, &stringp);
2096 icon.encoding = (stringp ? XA_STRING
2097 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
2098 icon.format = 8;
2099 icon.nitems = bytes;
2102 #ifdef USE_GTK
2103 gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
2104 SDATA (name));
2105 #else /* not USE_GTK */
2106 XSetWMName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &text);
2107 #endif /* not USE_GTK */
2109 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
2110 &icon);
2112 if (!NILP (f->icon_name)
2113 && icon.value != (unsigned char *) SDATA (f->icon_name))
2114 xfree (icon.value);
2115 if (text.value != (unsigned char *) SDATA (name))
2116 xfree (text.value);
2118 #else /* not HAVE_X11R4 */
2119 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2120 SDATA (name));
2121 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2122 SDATA (name));
2123 #endif /* not HAVE_X11R4 */
2124 UNBLOCK_INPUT;
2128 void
2129 x_set_scroll_bar_default_width (f)
2130 struct frame *f;
2132 int wid = FRAME_COLUMN_WIDTH (f);
2134 #ifdef USE_TOOLKIT_SCROLL_BARS
2135 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2136 int width = 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM;
2137 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (width + wid - 1) / wid;
2138 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = width;
2139 #else
2140 /* Make the actual width at least 14 pixels and a multiple of a
2141 character width. */
2142 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid;
2144 /* Use all of that space (aside from required margins) for the
2145 scroll bar. */
2146 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = 0;
2147 #endif
2151 /* Record in frame F the specified or default value according to ALIST
2152 of the parameter named PROP (a Lisp symbol). If no value is
2153 specified for PROP, look for an X default for XPROP on the frame
2154 named NAME. If that is not found either, use the value DEFLT. */
2156 static Lisp_Object
2157 x_default_scroll_bar_color_parameter (f, alist, prop, xprop, xclass,
2158 foreground_p)
2159 struct frame *f;
2160 Lisp_Object alist;
2161 Lisp_Object prop;
2162 char *xprop;
2163 char *xclass;
2164 int foreground_p;
2166 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2167 Lisp_Object tem;
2169 tem = x_get_arg (dpyinfo, alist, prop, xprop, xclass, RES_TYPE_STRING);
2170 if (EQ (tem, Qunbound))
2172 #ifdef USE_TOOLKIT_SCROLL_BARS
2174 /* See if an X resource for the scroll bar color has been
2175 specified. */
2176 tem = display_x_get_resource (dpyinfo,
2177 build_string (foreground_p
2178 ? "foreground"
2179 : "background"),
2180 empty_string,
2181 build_string ("verticalScrollBar"),
2182 empty_string);
2183 if (!STRINGP (tem))
2185 /* If nothing has been specified, scroll bars will use a
2186 toolkit-dependent default. Because these defaults are
2187 difficult to get at without actually creating a scroll
2188 bar, use nil to indicate that no color has been
2189 specified. */
2190 tem = Qnil;
2193 #else /* not USE_TOOLKIT_SCROLL_BARS */
2195 tem = Qnil;
2197 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2200 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2201 return tem;
2206 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2208 Status
2209 XSetWMProtocols (dpy, w, protocols, count)
2210 Display *dpy;
2211 Window w;
2212 Atom *protocols;
2213 int count;
2215 Atom prop;
2216 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
2217 if (prop == None) return False;
2218 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
2219 (unsigned char *) protocols, count);
2220 return True;
2222 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2224 #ifdef USE_X_TOOLKIT
2226 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2227 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2228 already be present because of the toolkit (Motif adds some of them,
2229 for example, but Xt doesn't). */
2231 static void
2232 hack_wm_protocols (f, widget)
2233 FRAME_PTR f;
2234 Widget widget;
2236 Display *dpy = XtDisplay (widget);
2237 Window w = XtWindow (widget);
2238 int need_delete = 1;
2239 int need_focus = 1;
2240 int need_save = 1;
2242 BLOCK_INPUT;
2244 Atom type, *atoms = 0;
2245 int format = 0;
2246 unsigned long nitems = 0;
2247 unsigned long bytes_after;
2249 if ((XGetWindowProperty (dpy, w,
2250 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2251 (long)0, (long)100, False, XA_ATOM,
2252 &type, &format, &nitems, &bytes_after,
2253 (unsigned char **) &atoms)
2254 == Success)
2255 && format == 32 && type == XA_ATOM)
2256 while (nitems > 0)
2258 nitems--;
2259 if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window)
2260 need_delete = 0;
2261 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus)
2262 need_focus = 0;
2263 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
2264 need_save = 0;
2266 if (atoms) XFree ((char *) atoms);
2269 Atom props [10];
2270 int count = 0;
2271 if (need_delete)
2272 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2273 if (need_focus)
2274 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus;
2275 if (need_save)
2276 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2277 if (count)
2278 XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2279 XA_ATOM, 32, PropModeAppend,
2280 (unsigned char *) props, count);
2282 UNBLOCK_INPUT;
2284 #endif
2288 /* Support routines for XIC (X Input Context). */
2290 #ifdef HAVE_X_I18N
2292 static XFontSet xic_create_xfontset P_ ((struct frame *, char *));
2293 static XIMStyle best_xim_style P_ ((XIMStyles *, XIMStyles *));
2296 /* Supported XIM styles, ordered by preference. */
2298 static XIMStyle supported_xim_styles[] =
2300 XIMPreeditPosition | XIMStatusArea,
2301 XIMPreeditPosition | XIMStatusNothing,
2302 XIMPreeditPosition | XIMStatusNone,
2303 XIMPreeditNothing | XIMStatusArea,
2304 XIMPreeditNothing | XIMStatusNothing,
2305 XIMPreeditNothing | XIMStatusNone,
2306 XIMPreeditNone | XIMStatusArea,
2307 XIMPreeditNone | XIMStatusNothing,
2308 XIMPreeditNone | XIMStatusNone,
2313 /* Create an X fontset on frame F with base font name
2314 BASE_FONTNAME.. */
2316 static XFontSet
2317 xic_create_xfontset (f, base_fontname)
2318 struct frame *f;
2319 char *base_fontname;
2321 XFontSet xfs;
2322 char **missing_list;
2323 int missing_count;
2324 char *def_string;
2326 xfs = XCreateFontSet (FRAME_X_DISPLAY (f),
2327 base_fontname, &missing_list,
2328 &missing_count, &def_string);
2329 if (missing_list)
2330 XFreeStringList (missing_list);
2332 /* No need to free def_string. */
2333 return xfs;
2337 /* Value is the best input style, given user preferences USER (already
2338 checked to be supported by Emacs), and styles supported by the
2339 input method XIM. */
2341 static XIMStyle
2342 best_xim_style (user, xim)
2343 XIMStyles *user;
2344 XIMStyles *xim;
2346 int i, j;
2348 for (i = 0; i < user->count_styles; ++i)
2349 for (j = 0; j < xim->count_styles; ++j)
2350 if (user->supported_styles[i] == xim->supported_styles[j])
2351 return user->supported_styles[i];
2353 /* Return the default style. */
2354 return XIMPreeditNothing | XIMStatusNothing;
2357 /* Create XIC for frame F. */
2359 static XIMStyle xic_style;
2361 void
2362 create_frame_xic (f)
2363 struct frame *f;
2365 XIM xim;
2366 XIC xic = NULL;
2367 XFontSet xfs = NULL;
2369 if (FRAME_XIC (f))
2370 return;
2372 xim = FRAME_X_XIM (f);
2373 if (xim)
2375 XRectangle s_area;
2376 XPoint spot;
2377 XVaNestedList preedit_attr;
2378 XVaNestedList status_attr;
2379 char *base_fontname;
2380 int fontset;
2382 s_area.x = 0; s_area.y = 0; s_area.width = 1; s_area.height = 1;
2383 spot.x = 0; spot.y = 1;
2384 /* Create X fontset. */
2385 fontset = FRAME_FONTSET (f);
2386 if (fontset < 0)
2387 base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
2388 else
2390 /* Determine the base fontname from the ASCII font name of
2391 FONTSET. */
2392 char *ascii_font = (char *) SDATA (fontset_ascii (fontset));
2393 char *p = ascii_font;
2394 int i;
2396 for (i = 0; *p; p++)
2397 if (*p == '-') i++;
2398 if (i != 14)
2399 /* As the font name doesn't conform to XLFD, we can't
2400 modify it to get a suitable base fontname for the
2401 frame. */
2402 base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
2403 else
2405 int len = strlen (ascii_font) + 1;
2406 char *p1 = NULL;
2408 for (i = 0, p = ascii_font; i < 8; p++)
2410 if (*p == '-')
2412 i++;
2413 if (i == 3)
2414 p1 = p + 1;
2417 base_fontname = (char *) alloca (len);
2418 bzero (base_fontname, len);
2419 strcpy (base_fontname, "-*-*-");
2420 bcopy (p1, base_fontname + 5, p - p1);
2421 strcat (base_fontname, "*-*-*-*-*-*-*");
2424 xfs = xic_create_xfontset (f, base_fontname);
2426 /* Determine XIC style. */
2427 if (xic_style == 0)
2429 XIMStyles supported_list;
2430 supported_list.count_styles = (sizeof supported_xim_styles
2431 / sizeof supported_xim_styles[0]);
2432 supported_list.supported_styles = supported_xim_styles;
2433 xic_style = best_xim_style (&supported_list,
2434 FRAME_X_XIM_STYLES (f));
2437 preedit_attr = XVaCreateNestedList (0,
2438 XNFontSet, xfs,
2439 XNForeground,
2440 FRAME_FOREGROUND_PIXEL (f),
2441 XNBackground,
2442 FRAME_BACKGROUND_PIXEL (f),
2443 (xic_style & XIMPreeditPosition
2444 ? XNSpotLocation
2445 : NULL),
2446 &spot,
2447 NULL);
2448 status_attr = XVaCreateNestedList (0,
2449 XNArea,
2450 &s_area,
2451 XNFontSet,
2452 xfs,
2453 XNForeground,
2454 FRAME_FOREGROUND_PIXEL (f),
2455 XNBackground,
2456 FRAME_BACKGROUND_PIXEL (f),
2457 NULL);
2459 xic = XCreateIC (xim,
2460 XNInputStyle, xic_style,
2461 XNClientWindow, FRAME_X_WINDOW(f),
2462 XNFocusWindow, FRAME_X_WINDOW(f),
2463 XNStatusAttributes, status_attr,
2464 XNPreeditAttributes, preedit_attr,
2465 NULL);
2466 XFree (preedit_attr);
2467 XFree (status_attr);
2470 FRAME_XIC (f) = xic;
2471 FRAME_XIC_STYLE (f) = xic_style;
2472 FRAME_XIC_FONTSET (f) = xfs;
2476 /* Destroy XIC and free XIC fontset of frame F, if any. */
2478 void
2479 free_frame_xic (f)
2480 struct frame *f;
2482 if (FRAME_XIC (f) == NULL)
2483 return;
2485 XDestroyIC (FRAME_XIC (f));
2486 if (FRAME_XIC_FONTSET (f))
2487 XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
2489 FRAME_XIC (f) = NULL;
2490 FRAME_XIC_FONTSET (f) = NULL;
2494 /* Place preedit area for XIC of window W's frame to specified
2495 pixel position X/Y. X and Y are relative to window W. */
2497 void
2498 xic_set_preeditarea (w, x, y)
2499 struct window *w;
2500 int x, y;
2502 struct frame *f = XFRAME (w->frame);
2503 XVaNestedList attr;
2504 XPoint spot;
2506 spot.x = WINDOW_TO_FRAME_PIXEL_X (w, x) + WINDOW_LEFT_FRINGE_WIDTH (w);
2507 spot.y = WINDOW_TO_FRAME_PIXEL_Y (w, y) + FONT_BASE (FRAME_FONT (f));
2508 attr = XVaCreateNestedList (0, XNSpotLocation, &spot, NULL);
2509 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
2510 XFree (attr);
2514 /* Place status area for XIC in bottom right corner of frame F.. */
2516 void
2517 xic_set_statusarea (f)
2518 struct frame *f;
2520 XIC xic = FRAME_XIC (f);
2521 XVaNestedList attr;
2522 XRectangle area;
2523 XRectangle *needed;
2525 /* Negotiate geometry of status area. If input method has existing
2526 status area, use its current size. */
2527 area.x = area.y = area.width = area.height = 0;
2528 attr = XVaCreateNestedList (0, XNAreaNeeded, &area, NULL);
2529 XSetICValues (xic, XNStatusAttributes, attr, NULL);
2530 XFree (attr);
2532 attr = XVaCreateNestedList (0, XNAreaNeeded, &needed, NULL);
2533 XGetICValues (xic, XNStatusAttributes, attr, NULL);
2534 XFree (attr);
2536 if (needed->width == 0) /* Use XNArea instead of XNAreaNeeded */
2538 attr = XVaCreateNestedList (0, XNArea, &needed, NULL);
2539 XGetICValues (xic, XNStatusAttributes, attr, NULL);
2540 XFree (attr);
2543 area.width = needed->width;
2544 area.height = needed->height;
2545 area.x = FRAME_PIXEL_WIDTH (f) - area.width - FRAME_INTERNAL_BORDER_WIDTH (f);
2546 area.y = (FRAME_PIXEL_HEIGHT (f) - area.height
2547 - FRAME_MENUBAR_HEIGHT (f)
2548 - FRAME_TOOLBAR_HEIGHT (f)
2549 - FRAME_INTERNAL_BORDER_WIDTH (f));
2550 XFree (needed);
2552 attr = XVaCreateNestedList (0, XNArea, &area, NULL);
2553 XSetICValues(xic, XNStatusAttributes, attr, NULL);
2554 XFree (attr);
2558 /* Set X fontset for XIC of frame F, using base font name
2559 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
2561 void
2562 xic_set_xfontset (f, base_fontname)
2563 struct frame *f;
2564 char *base_fontname;
2566 XVaNestedList attr;
2567 XFontSet xfs;
2569 xfs = xic_create_xfontset (f, base_fontname);
2571 attr = XVaCreateNestedList (0, XNFontSet, xfs, NULL);
2572 if (FRAME_XIC_STYLE (f) & XIMPreeditPosition)
2573 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
2574 if (FRAME_XIC_STYLE (f) & XIMStatusArea)
2575 XSetICValues (FRAME_XIC (f), XNStatusAttributes, attr, NULL);
2576 XFree (attr);
2578 if (FRAME_XIC_FONTSET (f))
2579 XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
2580 FRAME_XIC_FONTSET (f) = xfs;
2583 #endif /* HAVE_X_I18N */
2587 #ifdef USE_X_TOOLKIT
2589 /* Create and set up the X widget for frame F. */
2591 static void
2592 x_window (f, window_prompting, minibuffer_only)
2593 struct frame *f;
2594 long window_prompting;
2595 int minibuffer_only;
2597 XClassHint class_hints;
2598 XSetWindowAttributes attributes;
2599 unsigned long attribute_mask;
2600 Widget shell_widget;
2601 Widget pane_widget;
2602 Widget frame_widget;
2603 Arg al [25];
2604 int ac;
2606 BLOCK_INPUT;
2608 /* Use the resource name as the top-level widget name
2609 for looking up resources. Make a non-Lisp copy
2610 for the window manager, so GC relocation won't bother it.
2612 Elsewhere we specify the window name for the window manager. */
2615 char *str = (char *) SDATA (Vx_resource_name);
2616 f->namebuf = (char *) xmalloc (strlen (str) + 1);
2617 strcpy (f->namebuf, str);
2620 ac = 0;
2621 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
2622 XtSetArg (al[ac], XtNinput, 1); ac++;
2623 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2624 XtSetArg (al[ac], XtNborderWidth, f->border_width); ac++;
2625 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
2626 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
2627 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
2628 shell_widget = XtAppCreateShell (f->namebuf, EMACS_CLASS,
2629 applicationShellWidgetClass,
2630 FRAME_X_DISPLAY (f), al, ac);
2632 f->output_data.x->widget = shell_widget;
2633 /* maybe_set_screen_title_format (shell_widget); */
2635 pane_widget = lw_create_widget ("main", "pane", widget_id_tick++,
2636 (widget_value *) NULL,
2637 shell_widget, False,
2638 (lw_callback) NULL,
2639 (lw_callback) NULL,
2640 (lw_callback) NULL,
2641 (lw_callback) NULL);
2643 ac = 0;
2644 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
2645 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
2646 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
2647 XtSetValues (pane_widget, al, ac);
2648 f->output_data.x->column_widget = pane_widget;
2650 /* mappedWhenManaged to false tells to the paned window to not map/unmap
2651 the emacs screen when changing menubar. This reduces flickering. */
2653 ac = 0;
2654 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2655 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
2656 XtSetArg (al[ac], XtNallowResize, 1); ac++;
2657 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
2658 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
2659 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
2660 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
2661 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
2662 frame_widget = XtCreateWidget (f->namebuf, emacsFrameClass, pane_widget,
2663 al, ac);
2665 f->output_data.x->edit_widget = frame_widget;
2667 XtManageChild (frame_widget);
2669 /* Do some needed geometry management. */
2671 int len;
2672 char *tem, shell_position[32];
2673 Arg al[2];
2674 int ac = 0;
2675 int extra_borders = 0;
2676 int menubar_size
2677 = (f->output_data.x->menubar_widget
2678 ? (f->output_data.x->menubar_widget->core.height
2679 + f->output_data.x->menubar_widget->core.border_width)
2680 : 0);
2682 #if 0 /* Experimentally, we now get the right results
2683 for -geometry -0-0 without this. 24 Aug 96, rms. */
2684 if (FRAME_EXTERNAL_MENU_BAR (f))
2686 Dimension ibw = 0;
2687 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
2688 menubar_size += ibw;
2690 #endif
2692 f->output_data.x->menubar_height = menubar_size;
2694 #ifndef USE_LUCID
2695 /* Motif seems to need this amount added to the sizes
2696 specified for the shell widget. The Athena/Lucid widgets don't.
2697 Both conclusions reached experimentally. -- rms. */
2698 XtVaGetValues (f->output_data.x->edit_widget, XtNinternalBorderWidth,
2699 &extra_borders, NULL);
2700 extra_borders *= 2;
2701 #endif
2703 /* Convert our geometry parameters into a geometry string
2704 and specify it.
2705 Note that we do not specify here whether the position
2706 is a user-specified or program-specified one.
2707 We pass that information later, in x_wm_set_size_hints. */
2709 int left = f->left_pos;
2710 int xneg = window_prompting & XNegative;
2711 int top = f->top_pos;
2712 int yneg = window_prompting & YNegative;
2713 if (xneg)
2714 left = -left;
2715 if (yneg)
2716 top = -top;
2718 if (window_prompting & USPosition)
2719 sprintf (shell_position, "=%dx%d%c%d%c%d",
2720 FRAME_PIXEL_WIDTH (f) + extra_borders,
2721 FRAME_PIXEL_HEIGHT (f) + menubar_size + extra_borders,
2722 (xneg ? '-' : '+'), left,
2723 (yneg ? '-' : '+'), top);
2724 else
2725 sprintf (shell_position, "=%dx%d",
2726 FRAME_PIXEL_WIDTH (f) + extra_borders,
2727 FRAME_PIXEL_HEIGHT (f) + menubar_size + extra_borders);
2730 len = strlen (shell_position) + 1;
2731 /* We don't free this because we don't know whether
2732 it is safe to free it while the frame exists.
2733 It isn't worth the trouble of arranging to free it
2734 when the frame is deleted. */
2735 tem = (char *) xmalloc (len);
2736 strncpy (tem, shell_position, len);
2737 XtSetArg (al[ac], XtNgeometry, tem); ac++;
2738 XtSetValues (shell_widget, al, ac);
2741 XtManageChild (pane_widget);
2742 XtRealizeWidget (shell_widget);
2744 FRAME_X_WINDOW (f) = XtWindow (frame_widget);
2746 validate_x_resource_name ();
2748 class_hints.res_name = (char *) SDATA (Vx_resource_name);
2749 class_hints.res_class = (char *) SDATA (Vx_resource_class);
2750 XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
2752 #ifdef HAVE_X_I18N
2753 FRAME_XIC (f) = NULL;
2754 if (use_xim)
2755 create_frame_xic (f);
2756 #endif
2758 f->output_data.x->wm_hints.input = True;
2759 f->output_data.x->wm_hints.flags |= InputHint;
2760 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2761 &f->output_data.x->wm_hints);
2763 hack_wm_protocols (f, shell_widget);
2765 #ifdef HACK_EDITRES
2766 XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
2767 #endif
2769 /* Do a stupid property change to force the server to generate a
2770 PropertyNotify event so that the event_stream server timestamp will
2771 be initialized to something relevant to the time we created the window.
2773 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
2774 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2775 XA_ATOM, 32, PropModeAppend,
2776 (unsigned char*) NULL, 0);
2778 /* Make all the standard events reach the Emacs frame. */
2779 attributes.event_mask = STANDARD_EVENT_SET;
2781 #ifdef HAVE_X_I18N
2782 if (FRAME_XIC (f))
2784 /* XIM server might require some X events. */
2785 unsigned long fevent = NoEventMask;
2786 XGetICValues(FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
2787 attributes.event_mask |= fevent;
2789 #endif /* HAVE_X_I18N */
2791 attribute_mask = CWEventMask;
2792 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
2793 attribute_mask, &attributes);
2795 XtMapWidget (frame_widget);
2797 /* x_set_name normally ignores requests to set the name if the
2798 requested name is the same as the current name. This is the one
2799 place where that assumption isn't correct; f->name is set, but
2800 the X server hasn't been told. */
2802 Lisp_Object name;
2803 int explicit = f->explicit_name;
2805 f->explicit_name = 0;
2806 name = f->name;
2807 f->name = Qnil;
2808 x_set_name (f, name, explicit);
2811 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2812 f->output_data.x->text_cursor);
2814 UNBLOCK_INPUT;
2816 /* This is a no-op, except under Motif. Make sure main areas are
2817 set to something reasonable, in case we get an error later. */
2818 lw_set_main_areas (pane_widget, 0, frame_widget);
2821 #else /* not USE_X_TOOLKIT */
2822 #ifdef USE_GTK
2823 void
2824 x_window (f)
2825 FRAME_PTR f;
2827 if (! xg_create_frame_widgets (f))
2828 error ("Unable to create window");
2830 #ifdef HAVE_X_I18N
2831 FRAME_XIC (f) = NULL;
2832 if (use_xim)
2834 BLOCK_INPUT;
2835 create_frame_xic (f);
2836 if (FRAME_XIC (f))
2838 /* XIM server might require some X events. */
2839 unsigned long fevent = NoEventMask;
2840 XGetICValues(FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
2842 if (fevent != NoEventMask)
2844 XSetWindowAttributes attributes;
2845 XWindowAttributes wattr;
2846 unsigned long attribute_mask;
2848 XGetWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2849 &wattr);
2850 attributes.event_mask = wattr.your_event_mask | fevent;
2851 attribute_mask = CWEventMask;
2852 XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2853 attribute_mask, &attributes);
2856 UNBLOCK_INPUT;
2858 #endif
2861 #else /*! USE_GTK */
2862 /* Create and set up the X window for frame F. */
2864 void
2865 x_window (f)
2866 struct frame *f;
2869 XClassHint class_hints;
2870 XSetWindowAttributes attributes;
2871 unsigned long attribute_mask;
2873 attributes.background_pixel = f->output_data.x->background_pixel;
2874 attributes.border_pixel = f->output_data.x->border_pixel;
2875 attributes.bit_gravity = StaticGravity;
2876 attributes.backing_store = NotUseful;
2877 attributes.save_under = True;
2878 attributes.event_mask = STANDARD_EVENT_SET;
2879 attributes.colormap = FRAME_X_COLORMAP (f);
2880 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity | CWEventMask
2881 | CWColormap);
2883 BLOCK_INPUT;
2884 FRAME_X_WINDOW (f)
2885 = XCreateWindow (FRAME_X_DISPLAY (f),
2886 f->output_data.x->parent_desc,
2887 f->left_pos,
2888 f->top_pos,
2889 FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f),
2890 f->border_width,
2891 CopyFromParent, /* depth */
2892 InputOutput, /* class */
2893 FRAME_X_VISUAL (f),
2894 attribute_mask, &attributes);
2896 #ifdef HAVE_X_I18N
2897 if (use_xim)
2899 create_frame_xic (f);
2900 if (FRAME_XIC (f))
2902 /* XIM server might require some X events. */
2903 unsigned long fevent = NoEventMask;
2904 XGetICValues(FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
2905 attributes.event_mask |= fevent;
2906 attribute_mask = CWEventMask;
2907 XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2908 attribute_mask, &attributes);
2911 #endif /* HAVE_X_I18N */
2913 validate_x_resource_name ();
2915 class_hints.res_name = (char *) SDATA (Vx_resource_name);
2916 class_hints.res_class = (char *) SDATA (Vx_resource_class);
2917 XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
2919 /* The menubar is part of the ordinary display;
2920 it does not count in addition to the height of the window. */
2921 f->output_data.x->menubar_height = 0;
2923 /* This indicates that we use the "Passive Input" input model.
2924 Unless we do this, we don't get the Focus{In,Out} events that we
2925 need to draw the cursor correctly. Accursed bureaucrats.
2926 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
2928 f->output_data.x->wm_hints.input = True;
2929 f->output_data.x->wm_hints.flags |= InputHint;
2930 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2931 &f->output_data.x->wm_hints);
2932 f->output_data.x->wm_hints.icon_pixmap = None;
2934 /* Request "save yourself" and "delete window" commands from wm. */
2936 Atom protocols[2];
2937 protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2938 protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2939 XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
2942 /* x_set_name normally ignores requests to set the name if the
2943 requested name is the same as the current name. This is the one
2944 place where that assumption isn't correct; f->name is set, but
2945 the X server hasn't been told. */
2947 Lisp_Object name;
2948 int explicit = f->explicit_name;
2950 f->explicit_name = 0;
2951 name = f->name;
2952 f->name = Qnil;
2953 x_set_name (f, name, explicit);
2956 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2957 f->output_data.x->text_cursor);
2959 UNBLOCK_INPUT;
2961 if (FRAME_X_WINDOW (f) == 0)
2962 error ("Unable to create window");
2965 #endif /* not USE_GTK */
2966 #endif /* not USE_X_TOOLKIT */
2968 /* Handle the icon stuff for this window. Perhaps later we might
2969 want an x_set_icon_position which can be called interactively as
2970 well. */
2972 static void
2973 x_icon (f, parms)
2974 struct frame *f;
2975 Lisp_Object parms;
2977 Lisp_Object icon_x, icon_y;
2978 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2980 /* Set the position of the icon. Note that twm groups all
2981 icons in an icon window. */
2982 icon_x = x_frame_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
2983 icon_y = x_frame_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
2984 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
2986 CHECK_NUMBER (icon_x);
2987 CHECK_NUMBER (icon_y);
2989 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
2990 error ("Both left and top icon corners of icon must be specified");
2992 BLOCK_INPUT;
2994 if (! EQ (icon_x, Qunbound))
2995 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
2997 /* Start up iconic or window? */
2998 x_wm_set_window_state
2999 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL),
3000 Qicon)
3001 ? IconicState
3002 : NormalState));
3004 x_text_icon (f, (char *) SDATA ((!NILP (f->icon_name)
3005 ? f->icon_name
3006 : f->name)));
3008 UNBLOCK_INPUT;
3011 /* Make the GCs needed for this window, setting the
3012 background, border and mouse colors; also create the
3013 mouse cursor and the gray border tile. */
3015 static char cursor_bits[] =
3017 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3018 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3019 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3020 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3023 static void
3024 x_make_gc (f)
3025 struct frame *f;
3027 XGCValues gc_values;
3029 BLOCK_INPUT;
3031 /* Create the GCs of this frame.
3032 Note that many default values are used. */
3034 /* Normal video */
3035 gc_values.font = FRAME_FONT (f)->fid;
3036 gc_values.foreground = f->output_data.x->foreground_pixel;
3037 gc_values.background = f->output_data.x->background_pixel;
3038 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
3039 f->output_data.x->normal_gc
3040 = XCreateGC (FRAME_X_DISPLAY (f),
3041 FRAME_X_WINDOW (f),
3042 GCLineWidth | GCFont | GCForeground | GCBackground,
3043 &gc_values);
3045 /* Reverse video style. */
3046 gc_values.foreground = f->output_data.x->background_pixel;
3047 gc_values.background = f->output_data.x->foreground_pixel;
3048 f->output_data.x->reverse_gc
3049 = XCreateGC (FRAME_X_DISPLAY (f),
3050 FRAME_X_WINDOW (f),
3051 GCFont | GCForeground | GCBackground | GCLineWidth,
3052 &gc_values);
3054 /* Cursor has cursor-color background, background-color foreground. */
3055 gc_values.foreground = f->output_data.x->background_pixel;
3056 gc_values.background = f->output_data.x->cursor_pixel;
3057 gc_values.fill_style = FillOpaqueStippled;
3058 gc_values.stipple
3059 = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
3060 FRAME_X_DISPLAY_INFO (f)->root_window,
3061 cursor_bits, 16, 16);
3062 f->output_data.x->cursor_gc
3063 = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3064 (GCFont | GCForeground | GCBackground
3065 | GCFillStyle /* | GCStipple */ | GCLineWidth),
3066 &gc_values);
3068 /* Reliefs. */
3069 f->output_data.x->white_relief.gc = 0;
3070 f->output_data.x->black_relief.gc = 0;
3072 /* Create the gray border tile used when the pointer is not in
3073 the frame. Since this depends on the frame's pixel values,
3074 this must be done on a per-frame basis. */
3075 f->output_data.x->border_tile
3076 = (XCreatePixmapFromBitmapData
3077 (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
3078 gray_bits, gray_width, gray_height,
3079 f->output_data.x->foreground_pixel,
3080 f->output_data.x->background_pixel,
3081 DefaultDepth (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f))));
3083 UNBLOCK_INPUT;
3087 /* Free what was was allocated in x_make_gc. */
3089 void
3090 x_free_gcs (f)
3091 struct frame *f;
3093 Display *dpy = FRAME_X_DISPLAY (f);
3095 BLOCK_INPUT;
3097 if (f->output_data.x->normal_gc)
3099 XFreeGC (dpy, f->output_data.x->normal_gc);
3100 f->output_data.x->normal_gc = 0;
3103 if (f->output_data.x->reverse_gc)
3105 XFreeGC (dpy, f->output_data.x->reverse_gc);
3106 f->output_data.x->reverse_gc = 0;
3109 if (f->output_data.x->cursor_gc)
3111 XFreeGC (dpy, f->output_data.x->cursor_gc);
3112 f->output_data.x->cursor_gc = 0;
3115 if (f->output_data.x->border_tile)
3117 XFreePixmap (dpy, f->output_data.x->border_tile);
3118 f->output_data.x->border_tile = 0;
3121 UNBLOCK_INPUT;
3125 /* Handler for signals raised during x_create_frame and
3126 x_create_top_frame. FRAME is the frame which is partially
3127 constructed. */
3129 static Lisp_Object
3130 unwind_create_frame (frame)
3131 Lisp_Object frame;
3133 struct frame *f = XFRAME (frame);
3135 /* If frame is ``official'', nothing to do. */
3136 if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
3138 #if GLYPH_DEBUG
3139 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3140 #endif
3142 x_free_frame_resources (f);
3144 /* Check that reference counts are indeed correct. */
3145 xassert (dpyinfo->reference_count == dpyinfo_refcount);
3146 xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
3147 return Qt;
3150 return Qnil;
3154 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
3155 1, 1, 0,
3156 doc: /* Make a new X window, which is called a "frame" in Emacs terms.
3157 Returns an Emacs frame object.
3158 ALIST is an alist of frame parameters.
3159 If the parameters specify that the frame should not have a minibuffer,
3160 and do not specify a specific minibuffer window to use,
3161 then `default-minibuffer-frame' must be a frame whose minibuffer can
3162 be shared by the new frame.
3164 This function is an internal primitive--use `make-frame' instead. */)
3165 (parms)
3166 Lisp_Object parms;
3168 struct frame *f;
3169 Lisp_Object frame, tem;
3170 Lisp_Object name;
3171 int minibuffer_only = 0;
3172 long window_prompting = 0;
3173 int width, height;
3174 int count = SPECPDL_INDEX ();
3175 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3176 Lisp_Object display;
3177 struct x_display_info *dpyinfo = NULL;
3178 Lisp_Object parent;
3179 struct kboard *kb;
3181 check_x ();
3183 /* Use this general default value to start with
3184 until we know if this frame has a specified name. */
3185 Vx_resource_name = Vinvocation_name;
3187 display = x_get_arg (dpyinfo, parms, Qdisplay, 0, 0, RES_TYPE_STRING);
3188 if (EQ (display, Qunbound))
3189 display = Qnil;
3190 dpyinfo = check_x_display_info (display);
3191 #ifdef MULTI_KBOARD
3192 kb = dpyinfo->kboard;
3193 #else
3194 kb = &the_only_kboard;
3195 #endif
3197 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
3198 if (!STRINGP (name)
3199 && ! EQ (name, Qunbound)
3200 && ! NILP (name))
3201 error ("Invalid frame name--not a string or nil");
3203 if (STRINGP (name))
3204 Vx_resource_name = name;
3206 /* See if parent window is specified. */
3207 parent = x_get_arg (dpyinfo, parms, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
3208 if (EQ (parent, Qunbound))
3209 parent = Qnil;
3210 if (! NILP (parent))
3211 CHECK_NUMBER (parent);
3213 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3214 /* No need to protect DISPLAY because that's not used after passing
3215 it to make_frame_without_minibuffer. */
3216 frame = Qnil;
3217 GCPRO4 (parms, parent, name, frame);
3218 tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
3219 RES_TYPE_SYMBOL);
3220 if (EQ (tem, Qnone) || NILP (tem))
3221 f = make_frame_without_minibuffer (Qnil, kb, display);
3222 else if (EQ (tem, Qonly))
3224 f = make_minibuffer_frame ();
3225 minibuffer_only = 1;
3227 else if (WINDOWP (tem))
3228 f = make_frame_without_minibuffer (tem, kb, display);
3229 else
3230 f = make_frame (1);
3232 XSETFRAME (frame, f);
3234 /* Note that X Windows does support scroll bars. */
3235 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
3237 f->output_method = output_x_window;
3238 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
3239 bzero (f->output_data.x, sizeof (struct x_output));
3240 f->output_data.x->icon_bitmap = -1;
3241 FRAME_FONTSET (f) = -1;
3242 f->output_data.x->scroll_bar_foreground_pixel = -1;
3243 f->output_data.x->scroll_bar_background_pixel = -1;
3244 #ifdef USE_TOOLKIT_SCROLL_BARS
3245 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
3246 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
3247 #endif /* USE_TOOLKIT_SCROLL_BARS */
3248 record_unwind_protect (unwind_create_frame, frame);
3250 f->icon_name
3251 = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
3252 RES_TYPE_STRING);
3253 if (! STRINGP (f->icon_name))
3254 f->icon_name = Qnil;
3256 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
3257 #if GLYPH_DEBUG
3258 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
3259 dpyinfo_refcount = dpyinfo->reference_count;
3260 #endif /* GLYPH_DEBUG */
3261 #ifdef MULTI_KBOARD
3262 FRAME_KBOARD (f) = kb;
3263 #endif
3265 /* These colors will be set anyway later, but it's important
3266 to get the color reference counts right, so initialize them! */
3268 Lisp_Object black;
3269 struct gcpro gcpro1;
3271 /* Function x_decode_color can signal an error. Make
3272 sure to initialize color slots so that we won't try
3273 to free colors we haven't allocated. */
3274 f->output_data.x->foreground_pixel = -1;
3275 f->output_data.x->background_pixel = -1;
3276 f->output_data.x->cursor_pixel = -1;
3277 f->output_data.x->cursor_foreground_pixel = -1;
3278 f->output_data.x->border_pixel = -1;
3279 f->output_data.x->mouse_pixel = -1;
3281 black = build_string ("black");
3282 GCPRO1 (black);
3283 f->output_data.x->foreground_pixel
3284 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3285 f->output_data.x->background_pixel
3286 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3287 f->output_data.x->cursor_pixel
3288 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3289 f->output_data.x->cursor_foreground_pixel
3290 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3291 f->output_data.x->border_pixel
3292 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3293 f->output_data.x->mouse_pixel
3294 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3295 UNGCPRO;
3298 /* Specify the parent under which to make this X window. */
3300 if (!NILP (parent))
3302 f->output_data.x->parent_desc = (Window) XFASTINT (parent);
3303 f->output_data.x->explicit_parent = 1;
3305 else
3307 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3308 f->output_data.x->explicit_parent = 0;
3311 /* Set the name; the functions to which we pass f expect the name to
3312 be set. */
3313 if (EQ (name, Qunbound) || NILP (name))
3315 f->name = build_string (dpyinfo->x_id_name);
3316 f->explicit_name = 0;
3318 else
3320 f->name = name;
3321 f->explicit_name = 1;
3322 /* use the frame's title when getting resources for this frame. */
3323 specbind (Qx_resource_name, name);
3326 /* Extract the window parameters from the supplied values
3327 that are needed to determine window geometry. */
3329 Lisp_Object font;
3331 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
3333 BLOCK_INPUT;
3334 /* First, try whatever font the caller has specified. */
3335 if (STRINGP (font))
3337 tem = Fquery_fontset (font, Qnil);
3338 if (STRINGP (tem))
3339 font = x_new_fontset (f, SDATA (tem));
3340 else
3341 font = x_new_font (f, SDATA (font));
3344 /* Try out a font which we hope has bold and italic variations. */
3345 if (!STRINGP (font))
3346 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
3347 if (!STRINGP (font))
3348 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3349 if (! STRINGP (font))
3350 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3351 if (! STRINGP (font))
3352 /* This was formerly the first thing tried, but it finds too many fonts
3353 and takes too long. */
3354 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3355 /* If those didn't work, look for something which will at least work. */
3356 if (! STRINGP (font))
3357 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3358 UNBLOCK_INPUT;
3359 if (! STRINGP (font))
3360 font = build_string ("fixed");
3362 x_default_parameter (f, parms, Qfont, font,
3363 "font", "Font", RES_TYPE_STRING);
3366 #ifdef USE_LUCID
3367 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3368 whereby it fails to get any font. */
3369 xlwmenu_default_font = FRAME_FONT (f);
3370 #endif
3372 x_default_parameter (f, parms, Qborder_width, make_number (2),
3373 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
3375 /* This defaults to 1 in order to match xterm. We recognize either
3376 internalBorderWidth or internalBorder (which is what xterm calls
3377 it). */
3378 if (NILP (Fassq (Qinternal_border_width, parms)))
3380 Lisp_Object value;
3382 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
3383 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
3384 if (! EQ (value, Qunbound))
3385 parms = Fcons (Fcons (Qinternal_border_width, value),
3386 parms);
3388 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
3389 "internalBorderWidth", "internalBorderWidth",
3390 RES_TYPE_NUMBER);
3391 x_default_parameter (f, parms, Qvertical_scroll_bars, Qleft,
3392 "verticalScrollBars", "ScrollBars",
3393 RES_TYPE_SYMBOL);
3395 /* Also do the stuff which must be set before the window exists. */
3396 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
3397 "foreground", "Foreground", RES_TYPE_STRING);
3398 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
3399 "background", "Background", RES_TYPE_STRING);
3400 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
3401 "pointerColor", "Foreground", RES_TYPE_STRING);
3402 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
3403 "cursorColor", "Foreground", RES_TYPE_STRING);
3404 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
3405 "borderColor", "BorderColor", RES_TYPE_STRING);
3406 x_default_parameter (f, parms, Qscreen_gamma, Qnil,
3407 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
3408 x_default_parameter (f, parms, Qline_spacing, Qnil,
3409 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
3410 x_default_parameter (f, parms, Qleft_fringe, Qnil,
3411 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
3412 x_default_parameter (f, parms, Qright_fringe, Qnil,
3413 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
3415 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_foreground,
3416 "scrollBarForeground",
3417 "ScrollBarForeground", 1);
3418 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_background,
3419 "scrollBarBackground",
3420 "ScrollBarBackground", 0);
3422 /* Init faces before x_default_parameter is called for scroll-bar
3423 parameters because that function calls x_set_scroll_bar_width,
3424 which calls change_frame_size, which calls Fset_window_buffer,
3425 which runs hooks, which call Fvertical_motion. At the end, we
3426 end up in init_iterator with a null face cache, which should not
3427 happen. */
3428 init_frame_faces (f);
3430 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
3431 "menuBar", "MenuBar", RES_TYPE_NUMBER);
3432 x_default_parameter (f, parms, Qtool_bar_lines, make_number (1),
3433 "toolBar", "ToolBar", RES_TYPE_NUMBER);
3434 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
3435 "bufferPredicate", "BufferPredicate",
3436 RES_TYPE_SYMBOL);
3437 x_default_parameter (f, parms, Qtitle, Qnil,
3438 "title", "Title", RES_TYPE_STRING);
3439 x_default_parameter (f, parms, Qwait_for_wm, Qt,
3440 "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN);
3441 x_default_parameter (f, parms, Qfullscreen, Qnil,
3442 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
3444 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3446 /* Compute the size of the X window. */
3447 window_prompting = x_figure_window_size (f, parms, 1);
3449 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
3450 f->no_split = minibuffer_only || EQ (tem, Qt);
3452 /* Create the X widget or window. */
3453 #ifdef USE_X_TOOLKIT
3454 x_window (f, window_prompting, minibuffer_only);
3455 #else
3456 x_window (f);
3457 #endif
3459 x_icon (f, parms);
3460 x_make_gc (f);
3462 /* Now consider the frame official. */
3463 FRAME_X_DISPLAY_INFO (f)->reference_count++;
3464 Vframe_list = Fcons (frame, Vframe_list);
3466 /* We need to do this after creating the X window, so that the
3467 icon-creation functions can say whose icon they're describing. */
3468 x_default_parameter (f, parms, Qicon_type, Qnil,
3469 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
3471 x_default_parameter (f, parms, Qauto_raise, Qnil,
3472 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
3473 x_default_parameter (f, parms, Qauto_lower, Qnil,
3474 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
3475 x_default_parameter (f, parms, Qcursor_type, Qbox,
3476 "cursorType", "CursorType", RES_TYPE_SYMBOL);
3477 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
3478 "scrollBarWidth", "ScrollBarWidth",
3479 RES_TYPE_NUMBER);
3481 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
3482 Change will not be effected unless different from the current
3483 FRAME_LINES (f). */
3484 width = FRAME_COLS (f);
3485 height = FRAME_LINES (f);
3487 SET_FRAME_COLS (f, 0);
3488 FRAME_LINES (f) = 0;
3489 change_frame_size (f, height, width, 1, 0, 0);
3491 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
3492 /* Create the menu bar. */
3493 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
3495 /* If this signals an error, we haven't set size hints for the
3496 frame and we didn't make it visible. */
3497 initialize_frame_menubar (f);
3499 #ifndef USE_GTK
3500 /* This is a no-op, except under Motif where it arranges the
3501 main window for the widgets on it. */
3502 lw_set_main_areas (f->output_data.x->column_widget,
3503 f->output_data.x->menubar_widget,
3504 f->output_data.x->edit_widget);
3505 #endif /* not USE_GTK */
3507 #endif /* USE_X_TOOLKIT || USE_GTK */
3509 /* Tell the server what size and position, etc, we want, and how
3510 badly we want them. This should be done after we have the menu
3511 bar so that its size can be taken into account. */
3512 BLOCK_INPUT;
3513 x_wm_set_size_hint (f, window_prompting, 0);
3514 UNBLOCK_INPUT;
3516 /* Make the window appear on the frame and enable display, unless
3517 the caller says not to. However, with explicit parent, Emacs
3518 cannot control visibility, so don't try. */
3519 if (! f->output_data.x->explicit_parent)
3521 Lisp_Object visibility;
3523 visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
3524 RES_TYPE_SYMBOL);
3525 if (EQ (visibility, Qunbound))
3526 visibility = Qt;
3528 if (EQ (visibility, Qicon))
3529 x_iconify_frame (f);
3530 else if (! NILP (visibility))
3531 x_make_frame_visible (f);
3532 else
3533 /* Must have been Qnil. */
3537 /* Set the WM leader property. GTK does this itself, so this is not
3538 needed when using GTK. */
3539 if (dpyinfo->client_leader_window != 0)
3541 BLOCK_INPUT;
3542 XChangeProperty (FRAME_X_DISPLAY (f),
3543 FRAME_OUTER_WINDOW (f),
3544 dpyinfo->Xatom_wm_client_leader,
3545 XA_WINDOW, 32, PropModeReplace,
3546 (char *) &dpyinfo->client_leader_window, 1);
3547 UNBLOCK_INPUT;
3550 UNGCPRO;
3552 /* Make sure windows on this frame appear in calls to next-window
3553 and similar functions. */
3554 Vwindow_list = Qnil;
3556 return unbind_to (count, frame);
3560 /* FRAME is used only to get a handle on the X display. We don't pass the
3561 display info directly because we're called from frame.c, which doesn't
3562 know about that structure. */
3564 Lisp_Object
3565 x_get_focus_frame (frame)
3566 struct frame *frame;
3568 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
3569 Lisp_Object xfocus;
3570 if (! dpyinfo->x_focus_frame)
3571 return Qnil;
3573 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
3574 return xfocus;
3578 /* In certain situations, when the window manager follows a
3579 click-to-focus policy, there seems to be no way around calling
3580 XSetInputFocus to give another frame the input focus .
3582 In an ideal world, XSetInputFocus should generally be avoided so
3583 that applications don't interfere with the window manager's focus
3584 policy. But I think it's okay to use when it's clearly done
3585 following a user-command. */
3587 DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
3588 doc: /* Set the input focus to FRAME.
3589 FRAME nil means use the selected frame. */)
3590 (frame)
3591 Lisp_Object frame;
3593 struct frame *f = check_x_frame (frame);
3594 Display *dpy = FRAME_X_DISPLAY (f);
3595 int count;
3597 BLOCK_INPUT;
3598 count = x_catch_errors (dpy);
3599 XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3600 RevertToParent, CurrentTime);
3601 x_uncatch_errors (dpy, count);
3602 UNBLOCK_INPUT;
3604 return Qnil;
3608 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
3609 doc: /* Internal function called by `color-defined-p', which see. */)
3610 (color, frame)
3611 Lisp_Object color, frame;
3613 XColor foo;
3614 FRAME_PTR f = check_x_frame (frame);
3616 CHECK_STRING (color);
3618 if (x_defined_color (f, SDATA (color), &foo, 0))
3619 return Qt;
3620 else
3621 return Qnil;
3624 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
3625 doc: /* Internal function called by `color-values', which see. */)
3626 (color, frame)
3627 Lisp_Object color, frame;
3629 XColor foo;
3630 FRAME_PTR f = check_x_frame (frame);
3632 CHECK_STRING (color);
3634 if (x_defined_color (f, SDATA (color), &foo, 0))
3636 Lisp_Object rgb[3];
3638 rgb[0] = make_number (foo.red);
3639 rgb[1] = make_number (foo.green);
3640 rgb[2] = make_number (foo.blue);
3641 return Flist (3, rgb);
3643 else
3644 return Qnil;
3647 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
3648 doc: /* Internal function called by `display-color-p', which see. */)
3649 (display)
3650 Lisp_Object display;
3652 struct x_display_info *dpyinfo = check_x_display_info (display);
3654 if (dpyinfo->n_planes <= 2)
3655 return Qnil;
3657 switch (dpyinfo->visual->class)
3659 case StaticColor:
3660 case PseudoColor:
3661 case TrueColor:
3662 case DirectColor:
3663 return Qt;
3665 default:
3666 return Qnil;
3670 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
3671 0, 1, 0,
3672 doc: /* Return t if the X display supports shades of gray.
3673 Note that color displays do support shades of gray.
3674 The optional argument DISPLAY specifies which display to ask about.
3675 DISPLAY should be either a frame or a display name (a string).
3676 If omitted or nil, that stands for the selected frame's display. */)
3677 (display)
3678 Lisp_Object display;
3680 struct x_display_info *dpyinfo = check_x_display_info (display);
3682 if (dpyinfo->n_planes <= 1)
3683 return Qnil;
3685 switch (dpyinfo->visual->class)
3687 case StaticColor:
3688 case PseudoColor:
3689 case TrueColor:
3690 case DirectColor:
3691 case StaticGray:
3692 case GrayScale:
3693 return Qt;
3695 default:
3696 return Qnil;
3700 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
3701 0, 1, 0,
3702 doc: /* Returns the width in pixels of the X display DISPLAY.
3703 The optional argument DISPLAY specifies which display to ask about.
3704 DISPLAY should be either a frame or a display name (a string).
3705 If omitted or nil, that stands for the selected frame's display. */)
3706 (display)
3707 Lisp_Object display;
3709 struct x_display_info *dpyinfo = check_x_display_info (display);
3711 return make_number (dpyinfo->width);
3714 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
3715 Sx_display_pixel_height, 0, 1, 0,
3716 doc: /* Returns the height in pixels of the X display DISPLAY.
3717 The optional argument DISPLAY specifies which display to ask about.
3718 DISPLAY should be either a frame or a display name (a string).
3719 If omitted or nil, that stands for the selected frame's display. */)
3720 (display)
3721 Lisp_Object display;
3723 struct x_display_info *dpyinfo = check_x_display_info (display);
3725 return make_number (dpyinfo->height);
3728 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
3729 0, 1, 0,
3730 doc: /* Returns the number of bitplanes of the X display DISPLAY.
3731 The optional argument DISPLAY specifies which display to ask about.
3732 DISPLAY should be either a frame or a display name (a string).
3733 If omitted or nil, that stands for the selected frame's display. */)
3734 (display)
3735 Lisp_Object display;
3737 struct x_display_info *dpyinfo = check_x_display_info (display);
3739 return make_number (dpyinfo->n_planes);
3742 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
3743 0, 1, 0,
3744 doc: /* Returns the number of color cells of the X display DISPLAY.
3745 The optional argument DISPLAY specifies which display to ask about.
3746 DISPLAY should be either a frame or a display name (a string).
3747 If omitted or nil, that stands for the selected frame's display. */)
3748 (display)
3749 Lisp_Object display;
3751 struct x_display_info *dpyinfo = check_x_display_info (display);
3753 return make_number (DisplayCells (dpyinfo->display,
3754 XScreenNumberOfScreen (dpyinfo->screen)));
3757 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
3758 Sx_server_max_request_size,
3759 0, 1, 0,
3760 doc: /* Returns the maximum request size of the X server of display DISPLAY.
3761 The optional argument DISPLAY specifies which display to ask about.
3762 DISPLAY should be either a frame or a display name (a string).
3763 If omitted or nil, that stands for the selected frame's display. */)
3764 (display)
3765 Lisp_Object display;
3767 struct x_display_info *dpyinfo = check_x_display_info (display);
3769 return make_number (MAXREQUEST (dpyinfo->display));
3772 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
3773 doc: /* Returns the vendor ID string of the X server of display DISPLAY.
3774 The optional argument DISPLAY specifies which display to ask about.
3775 DISPLAY should be either a frame or a display name (a string).
3776 If omitted or nil, that stands for the selected frame's display. */)
3777 (display)
3778 Lisp_Object display;
3780 struct x_display_info *dpyinfo = check_x_display_info (display);
3781 char *vendor = ServerVendor (dpyinfo->display);
3783 if (! vendor) vendor = "";
3784 return build_string (vendor);
3787 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
3788 doc: /* Returns the version numbers of the X server of display DISPLAY.
3789 The value is a list of three integers: the major and minor
3790 version numbers of the X Protocol in use, and the vendor-specific release
3791 number. See also the function `x-server-vendor'.
3793 The optional argument DISPLAY specifies which display to ask about.
3794 DISPLAY should be either a frame or a display name (a string).
3795 If omitted or nil, that stands for the selected frame's display. */)
3796 (display)
3797 Lisp_Object display;
3799 struct x_display_info *dpyinfo = check_x_display_info (display);
3800 Display *dpy = dpyinfo->display;
3802 return Fcons (make_number (ProtocolVersion (dpy)),
3803 Fcons (make_number (ProtocolRevision (dpy)),
3804 Fcons (make_number (VendorRelease (dpy)), Qnil)));
3807 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
3808 doc: /* Return the number of screens on the X server of display DISPLAY.
3809 The optional argument DISPLAY specifies which display to ask about.
3810 DISPLAY should be either a frame or a display name (a string).
3811 If omitted or nil, that stands for the selected frame's display. */)
3812 (display)
3813 Lisp_Object display;
3815 struct x_display_info *dpyinfo = check_x_display_info (display);
3817 return make_number (ScreenCount (dpyinfo->display));
3820 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
3821 doc: /* Return the height in millimeters of the X display DISPLAY.
3822 The optional argument DISPLAY specifies which display to ask about.
3823 DISPLAY should be either a frame or a display name (a string).
3824 If omitted or nil, that stands for the selected frame's display. */)
3825 (display)
3826 Lisp_Object display;
3828 struct x_display_info *dpyinfo = check_x_display_info (display);
3830 return make_number (HeightMMOfScreen (dpyinfo->screen));
3833 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
3834 doc: /* Return the width in millimeters of the X display DISPLAY.
3835 The optional argument DISPLAY specifies which display to ask about.
3836 DISPLAY should be either a frame or a display name (a string).
3837 If omitted or nil, that stands for the selected frame's display. */)
3838 (display)
3839 Lisp_Object display;
3841 struct x_display_info *dpyinfo = check_x_display_info (display);
3843 return make_number (WidthMMOfScreen (dpyinfo->screen));
3846 DEFUN ("x-display-backing-store", Fx_display_backing_store,
3847 Sx_display_backing_store, 0, 1, 0,
3848 doc: /* Returns an indication of whether X display DISPLAY does backing store.
3849 The value may be `always', `when-mapped', or `not-useful'.
3850 The optional argument DISPLAY specifies which display to ask about.
3851 DISPLAY should be either a frame or a display name (a string).
3852 If omitted or nil, that stands for the selected frame's display. */)
3853 (display)
3854 Lisp_Object display;
3856 struct x_display_info *dpyinfo = check_x_display_info (display);
3857 Lisp_Object result;
3859 switch (DoesBackingStore (dpyinfo->screen))
3861 case Always:
3862 result = intern ("always");
3863 break;
3865 case WhenMapped:
3866 result = intern ("when-mapped");
3867 break;
3869 case NotUseful:
3870 result = intern ("not-useful");
3871 break;
3873 default:
3874 error ("Strange value for BackingStore parameter of screen");
3875 result = Qnil;
3878 return result;
3881 DEFUN ("x-display-visual-class", Fx_display_visual_class,
3882 Sx_display_visual_class, 0, 1, 0,
3883 doc: /* Return the visual class of the X display DISPLAY.
3884 The value is one of the symbols `static-gray', `gray-scale',
3885 `static-color', `pseudo-color', `true-color', or `direct-color'.
3887 The optional argument DISPLAY specifies which display to ask about.
3888 DISPLAY should be either a frame or a display name (a string).
3889 If omitted or nil, that stands for the selected frame's display. */)
3890 (display)
3891 Lisp_Object display;
3893 struct x_display_info *dpyinfo = check_x_display_info (display);
3894 Lisp_Object result;
3896 switch (dpyinfo->visual->class)
3898 case StaticGray:
3899 result = intern ("static-gray");
3900 break;
3901 case GrayScale:
3902 result = intern ("gray-scale");
3903 break;
3904 case StaticColor:
3905 result = intern ("static-color");
3906 break;
3907 case PseudoColor:
3908 result = intern ("pseudo-color");
3909 break;
3910 case TrueColor:
3911 result = intern ("true-color");
3912 break;
3913 case DirectColor:
3914 result = intern ("direct-color");
3915 break;
3916 default:
3917 error ("Display has an unknown visual class");
3918 result = Qnil;
3921 return result;
3924 DEFUN ("x-display-save-under", Fx_display_save_under,
3925 Sx_display_save_under, 0, 1, 0,
3926 doc: /* Returns t if the X display DISPLAY supports the save-under feature.
3927 The optional argument DISPLAY specifies which display to ask about.
3928 DISPLAY should be either a frame or a display name (a string).
3929 If omitted or nil, that stands for the selected frame's display. */)
3930 (display)
3931 Lisp_Object display;
3933 struct x_display_info *dpyinfo = check_x_display_info (display);
3935 if (DoesSaveUnders (dpyinfo->screen) == True)
3936 return Qt;
3937 else
3938 return Qnil;
3942 x_pixel_width (f)
3943 register struct frame *f;
3945 return FRAME_PIXEL_WIDTH (f);
3949 x_pixel_height (f)
3950 register struct frame *f;
3952 return FRAME_PIXEL_HEIGHT (f);
3956 x_char_width (f)
3957 register struct frame *f;
3959 return FRAME_COLUMN_WIDTH (f);
3963 x_char_height (f)
3964 register struct frame *f;
3966 return FRAME_LINE_HEIGHT (f);
3970 x_screen_planes (f)
3971 register struct frame *f;
3973 return FRAME_X_DISPLAY_INFO (f)->n_planes;
3978 /************************************************************************
3979 X Displays
3980 ************************************************************************/
3983 /* Mapping visual names to visuals. */
3985 static struct visual_class
3987 char *name;
3988 int class;
3990 visual_classes[] =
3992 {"StaticGray", StaticGray},
3993 {"GrayScale", GrayScale},
3994 {"StaticColor", StaticColor},
3995 {"PseudoColor", PseudoColor},
3996 {"TrueColor", TrueColor},
3997 {"DirectColor", DirectColor},
3998 {NULL, 0}
4002 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4004 /* Value is the screen number of screen SCR. This is a substitute for
4005 the X function with the same name when that doesn't exist. */
4008 XScreenNumberOfScreen (scr)
4009 register Screen *scr;
4011 Display *dpy = scr->display;
4012 int i;
4014 for (i = 0; i < dpy->nscreens; ++i)
4015 if (scr == dpy->screens + i)
4016 break;
4018 return i;
4021 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4024 /* Select the visual that should be used on display DPYINFO. Set
4025 members of DPYINFO appropriately. Called from x_term_init. */
4027 void
4028 select_visual (dpyinfo)
4029 struct x_display_info *dpyinfo;
4031 Display *dpy = dpyinfo->display;
4032 Screen *screen = dpyinfo->screen;
4033 Lisp_Object value;
4035 /* See if a visual is specified. */
4036 value = display_x_get_resource (dpyinfo,
4037 build_string ("visualClass"),
4038 build_string ("VisualClass"),
4039 Qnil, Qnil);
4040 if (STRINGP (value))
4042 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4043 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4044 depth, a decimal number. NAME is compared with case ignored. */
4045 char *s = (char *) alloca (SBYTES (value) + 1);
4046 char *dash;
4047 int i, class = -1;
4048 XVisualInfo vinfo;
4050 strcpy (s, SDATA (value));
4051 dash = index (s, '-');
4052 if (dash)
4054 dpyinfo->n_planes = atoi (dash + 1);
4055 *dash = '\0';
4057 else
4058 /* We won't find a matching visual with depth 0, so that
4059 an error will be printed below. */
4060 dpyinfo->n_planes = 0;
4062 /* Determine the visual class. */
4063 for (i = 0; visual_classes[i].name; ++i)
4064 if (xstricmp (s, visual_classes[i].name) == 0)
4066 class = visual_classes[i].class;
4067 break;
4070 /* Look up a matching visual for the specified class. */
4071 if (class == -1
4072 || !XMatchVisualInfo (dpy, XScreenNumberOfScreen (screen),
4073 dpyinfo->n_planes, class, &vinfo))
4074 fatal ("Invalid visual specification `%s'", SDATA (value));
4076 dpyinfo->visual = vinfo.visual;
4078 else
4080 int n_visuals;
4081 XVisualInfo *vinfo, vinfo_template;
4083 dpyinfo->visual = DefaultVisualOfScreen (screen);
4085 #ifdef HAVE_X11R4
4086 vinfo_template.visualid = XVisualIDFromVisual (dpyinfo->visual);
4087 #else
4088 vinfo_template.visualid = dpyinfo->visual->visualid;
4089 #endif
4090 vinfo_template.screen = XScreenNumberOfScreen (screen);
4091 vinfo = XGetVisualInfo (dpy, VisualIDMask | VisualScreenMask,
4092 &vinfo_template, &n_visuals);
4093 if (n_visuals != 1)
4094 fatal ("Can't get proper X visual info");
4096 dpyinfo->n_planes = vinfo->depth;
4097 XFree ((char *) vinfo);
4102 /* Return the X display structure for the display named NAME.
4103 Open a new connection if necessary. */
4105 struct x_display_info *
4106 x_display_info_for_name (name)
4107 Lisp_Object name;
4109 Lisp_Object names;
4110 struct x_display_info *dpyinfo;
4112 CHECK_STRING (name);
4114 if (! EQ (Vwindow_system, intern ("x")))
4115 error ("Not using X Windows");
4117 for (dpyinfo = x_display_list, names = x_display_name_list;
4118 dpyinfo;
4119 dpyinfo = dpyinfo->next, names = XCDR (names))
4121 Lisp_Object tem;
4122 tem = Fstring_equal (XCAR (XCAR (names)), name);
4123 if (!NILP (tem))
4124 return dpyinfo;
4127 /* Use this general default value to start with. */
4128 Vx_resource_name = Vinvocation_name;
4130 validate_x_resource_name ();
4132 dpyinfo = x_term_init (name, (char *)0,
4133 (char *) SDATA (Vx_resource_name));
4135 if (dpyinfo == 0)
4136 error ("Cannot connect to X server %s", SDATA (name));
4138 x_in_use = 1;
4139 XSETFASTINT (Vwindow_system_version, 11);
4141 return dpyinfo;
4145 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4146 1, 3, 0,
4147 doc: /* Open a connection to an X server.
4148 DISPLAY is the name of the display to connect to.
4149 Optional second arg XRM-STRING is a string of resources in xrdb format.
4150 If the optional third arg MUST-SUCCEED is non-nil,
4151 terminate Emacs if we can't open the connection. */)
4152 (display, xrm_string, must_succeed)
4153 Lisp_Object display, xrm_string, must_succeed;
4155 unsigned char *xrm_option;
4156 struct x_display_info *dpyinfo;
4158 CHECK_STRING (display);
4159 if (! NILP (xrm_string))
4160 CHECK_STRING (xrm_string);
4162 if (! EQ (Vwindow_system, intern ("x")))
4163 error ("Not using X Windows");
4165 if (! NILP (xrm_string))
4166 xrm_option = (unsigned char *) SDATA (xrm_string);
4167 else
4168 xrm_option = (unsigned char *) 0;
4170 validate_x_resource_name ();
4172 /* This is what opens the connection and sets x_current_display.
4173 This also initializes many symbols, such as those used for input. */
4174 dpyinfo = x_term_init (display, xrm_option,
4175 (char *) SDATA (Vx_resource_name));
4177 if (dpyinfo == 0)
4179 if (!NILP (must_succeed))
4180 fatal ("Cannot connect to X server %s.\n\
4181 Check the DISPLAY environment variable or use `-d'.\n\
4182 Also use the `xauth' program to verify that you have the proper\n\
4183 authorization information needed to connect the X server.\n\
4184 An insecure way to solve the problem may be to use `xhost'.\n",
4185 SDATA (display));
4186 else
4187 error ("Cannot connect to X server %s", SDATA (display));
4190 x_in_use = 1;
4192 XSETFASTINT (Vwindow_system_version, 11);
4193 return Qnil;
4196 DEFUN ("x-close-connection", Fx_close_connection,
4197 Sx_close_connection, 1, 1, 0,
4198 doc: /* Close the connection to DISPLAY's X server.
4199 For DISPLAY, specify either a frame or a display name (a string).
4200 If DISPLAY is nil, that stands for the selected frame's display. */)
4201 (display)
4202 Lisp_Object display;
4204 struct x_display_info *dpyinfo = check_x_display_info (display);
4205 int i;
4207 if (dpyinfo->reference_count > 0)
4208 error ("Display still has frames on it");
4210 BLOCK_INPUT;
4211 /* Free the fonts in the font table. */
4212 for (i = 0; i < dpyinfo->n_fonts; i++)
4213 if (dpyinfo->font_table[i].name)
4215 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
4218 x_destroy_all_bitmaps (dpyinfo);
4219 XSetCloseDownMode (dpyinfo->display, DestroyAll);
4221 #ifdef USE_X_TOOLKIT
4222 XtCloseDisplay (dpyinfo->display);
4223 #else
4224 XCloseDisplay (dpyinfo->display);
4225 #endif
4227 x_delete_display (dpyinfo);
4228 UNBLOCK_INPUT;
4230 return Qnil;
4233 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
4234 doc: /* Return the list of display names that Emacs has connections to. */)
4237 Lisp_Object tail, result;
4239 result = Qnil;
4240 for (tail = x_display_name_list; ! NILP (tail); tail = XCDR (tail))
4241 result = Fcons (XCAR (XCAR (tail)), result);
4243 return result;
4246 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
4247 doc: /* If ON is non-nil, report X errors as soon as the erring request is made.
4248 If ON is nil, allow buffering of requests.
4249 Turning on synchronization prohibits the Xlib routines from buffering
4250 requests and seriously degrades performance, but makes debugging much
4251 easier.
4252 The optional second argument DISPLAY specifies which display to act on.
4253 DISPLAY should be either a frame or a display name (a string).
4254 If DISPLAY is omitted or nil, that stands for the selected frame's display. */)
4255 (on, display)
4256 Lisp_Object display, on;
4258 struct x_display_info *dpyinfo = check_x_display_info (display);
4260 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
4262 return Qnil;
4265 /* Wait for responses to all X commands issued so far for frame F. */
4267 void
4268 x_sync (f)
4269 FRAME_PTR f;
4271 BLOCK_INPUT;
4272 XSync (FRAME_X_DISPLAY (f), False);
4273 UNBLOCK_INPUT;
4277 /***********************************************************************
4278 General X functions exposed to Elisp.
4279 ***********************************************************************/
4281 DEFUN ("x-send-client-message", Fx_send_client_event,
4282 Sx_send_client_message, 6, 6, 0,
4283 doc: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
4285 For DISPLAY, specify either a frame or a display name (a string).
4286 If DISPLAY is nil, that stands for the selected frame's display.
4287 DEST may be an integer, in which case it is a Window id. The value 0 may
4288 be used to send to the root window of the DISPLAY.
4289 If DEST is a frame the event is sent to the outer window of that frame.
4290 Nil means the currently selected frame.
4291 If DEST is the string "PointerWindow" the event is sent to the window that
4292 contains the pointer. If DEST is the string "InputFocus" the event is
4293 sent to the window that has the input focus.
4294 FROM is the frame sending the event. Use nil for currently selected frame.
4295 MESSAGE-TYPE is the name of an Atom as a string.
4296 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
4297 bits. VALUES is a list of integer and/or strings containing the values to
4298 send. If a value is a string, it is converted to an Atom and the value of
4299 the Atom is sent. If more values than fits into the event is given,
4300 the excessive values are ignored. */)
4301 (display, dest, from, message_type, format, values)
4302 Lisp_Object display, dest, from, message_type, format, values;
4304 struct x_display_info *dpyinfo = check_x_display_info (display);
4305 Window wdest;
4306 XEvent event;
4307 Lisp_Object cons;
4308 int i;
4309 int max_nr_values = (int) sizeof (event.xclient.data.b);
4310 struct frame *f = check_x_frame (from);
4312 CHECK_STRING (message_type);
4313 CHECK_NUMBER (format);
4314 CHECK_CONS (values);
4316 for (cons = values; CONSP (cons); cons = XCDR (cons))
4318 Lisp_Object o = XCAR (cons);
4320 if (! INTEGERP (o) && ! STRINGP (o))
4321 error ("Bad data in VALUES, must be integer or string");
4324 event.xclient.type = ClientMessage;
4325 event.xclient.format = XFASTINT (format);
4327 if (event.xclient.format != 8 && event.xclient.format != 16
4328 && event.xclient.format != 32)
4329 error ("FORMAT must be one of 8, 16 or 32");
4330 if (event.xclient.format == 16) max_nr_values /= 2;
4331 if (event.xclient.format == 32) max_nr_values /= 4;
4333 if (FRAMEP (dest) || NILP (dest))
4335 struct frame *fdest = check_x_frame (dest);
4336 wdest = FRAME_OUTER_WINDOW (fdest);
4338 else if (STRINGP (dest))
4340 if (strcmp (SDATA (dest), "PointerWindow") == 0)
4341 wdest = PointerWindow;
4342 else if (strcmp (SDATA (dest), "InputFocus") == 0)
4343 wdest = InputFocus;
4344 else
4345 error ("DEST as a string must be one of PointerWindow or InputFocus");
4347 else
4349 CHECK_NUMBER (dest);
4350 wdest = (Window) XFASTINT (dest);
4351 if (wdest == 0) wdest = dpyinfo->root_window;
4354 BLOCK_INPUT;
4355 for (cons = values, i = 0;
4356 CONSP (cons) && i < max_nr_values;
4357 cons = XCDR (cons), ++i)
4359 Lisp_Object o = XCAR (cons);
4360 long val;
4362 if (INTEGERP (o))
4363 val = XINT (o);
4364 else if (STRINGP (o))
4365 val = XInternAtom (dpyinfo->display, SDATA (o), False);
4367 if (event.xclient.format == 8)
4368 event.xclient.data.b[i] = (char) val;
4369 else if (event.xclient.format == 16)
4370 event.xclient.data.s[i] = (short) val;
4371 else
4372 event.xclient.data.l[i] = val;
4375 for ( ; i < max_nr_values; ++i)
4376 if (event.xclient.format == 8)
4377 event.xclient.data.b[i] = 0;
4378 else if (event.xclient.format == 16)
4379 event.xclient.data.s[i] = 0;
4380 else
4381 event.xclient.data.l[i] = 0;
4383 event.xclient.message_type
4384 = XInternAtom (dpyinfo->display, SDATA (message_type), False);
4385 event.xclient.display = dpyinfo->display;
4386 event.xclient.window = FRAME_OUTER_WINDOW (f);
4388 XSendEvent (dpyinfo->display, wdest, False, 0xffff, &event);
4390 XFlush (dpyinfo->display);
4391 UNBLOCK_INPUT;
4393 return Qnil;
4396 /***********************************************************************
4397 Image types
4398 ***********************************************************************/
4400 /* Value is the number of elements of vector VECTOR. */
4402 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
4404 /* List of supported image types. Use define_image_type to add new
4405 types. Use lookup_image_type to find a type for a given symbol. */
4407 static struct image_type *image_types;
4409 /* The symbol `image' which is the car of the lists used to represent
4410 images in Lisp. */
4412 extern Lisp_Object Qimage;
4414 /* The symbol `xbm' which is used as the type symbol for XBM images. */
4416 Lisp_Object Qxbm;
4418 /* Keywords. */
4420 extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
4421 extern Lisp_Object QCdata, QCtype;
4422 Lisp_Object QCascent, QCmargin, QCrelief;
4423 Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask;
4424 Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask;
4426 /* Other symbols. */
4428 Lisp_Object Qlaplace, Qemboss, Qedge_detection, Qheuristic;
4430 /* Time in seconds after which images should be removed from the cache
4431 if not displayed. */
4433 Lisp_Object Vimage_cache_eviction_delay;
4435 /* Function prototypes. */
4437 static void define_image_type P_ ((struct image_type *type));
4438 static struct image_type *lookup_image_type P_ ((Lisp_Object symbol));
4439 static void image_error P_ ((char *format, Lisp_Object, Lisp_Object));
4440 static void x_laplace P_ ((struct frame *, struct image *));
4441 static void x_emboss P_ ((struct frame *, struct image *));
4442 static int x_build_heuristic_mask P_ ((struct frame *, struct image *,
4443 Lisp_Object));
4446 /* Define a new image type from TYPE. This adds a copy of TYPE to
4447 image_types and adds the symbol *TYPE->type to Vimage_types. */
4449 static void
4450 define_image_type (type)
4451 struct image_type *type;
4453 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
4454 The initialized data segment is read-only. */
4455 struct image_type *p = (struct image_type *) xmalloc (sizeof *p);
4456 bcopy (type, p, sizeof *p);
4457 p->next = image_types;
4458 image_types = p;
4459 Vimage_types = Fcons (*p->type, Vimage_types);
4463 /* Look up image type SYMBOL, and return a pointer to its image_type
4464 structure. Value is null if SYMBOL is not a known image type. */
4466 static INLINE struct image_type *
4467 lookup_image_type (symbol)
4468 Lisp_Object symbol;
4470 struct image_type *type;
4472 for (type = image_types; type; type = type->next)
4473 if (EQ (symbol, *type->type))
4474 break;
4476 return type;
4480 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
4481 valid image specification is a list whose car is the symbol
4482 `image', and whose rest is a property list. The property list must
4483 contain a value for key `:type'. That value must be the name of a
4484 supported image type. The rest of the property list depends on the
4485 image type. */
4488 valid_image_p (object)
4489 Lisp_Object object;
4491 int valid_p = 0;
4493 if (CONSP (object) && EQ (XCAR (object), Qimage))
4495 Lisp_Object tem;
4497 for (tem = XCDR (object); CONSP (tem); tem = XCDR (tem))
4498 if (EQ (XCAR (tem), QCtype))
4500 tem = XCDR (tem);
4501 if (CONSP (tem) && SYMBOLP (XCAR (tem)))
4503 struct image_type *type;
4504 type = lookup_image_type (XCAR (tem));
4505 if (type)
4506 valid_p = type->valid_p (object);
4509 break;
4513 return valid_p;
4517 /* Log error message with format string FORMAT and argument ARG.
4518 Signaling an error, e.g. when an image cannot be loaded, is not a
4519 good idea because this would interrupt redisplay, and the error
4520 message display would lead to another redisplay. This function
4521 therefore simply displays a message. */
4523 static void
4524 image_error (format, arg1, arg2)
4525 char *format;
4526 Lisp_Object arg1, arg2;
4528 add_to_log (format, arg1, arg2);
4533 /***********************************************************************
4534 Image specifications
4535 ***********************************************************************/
4537 enum image_value_type
4539 IMAGE_DONT_CHECK_VALUE_TYPE,
4540 IMAGE_STRING_VALUE,
4541 IMAGE_STRING_OR_NIL_VALUE,
4542 IMAGE_SYMBOL_VALUE,
4543 IMAGE_POSITIVE_INTEGER_VALUE,
4544 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR,
4545 IMAGE_NON_NEGATIVE_INTEGER_VALUE,
4546 IMAGE_ASCENT_VALUE,
4547 IMAGE_INTEGER_VALUE,
4548 IMAGE_FUNCTION_VALUE,
4549 IMAGE_NUMBER_VALUE,
4550 IMAGE_BOOL_VALUE
4553 /* Structure used when parsing image specifications. */
4555 struct image_keyword
4557 /* Name of keyword. */
4558 char *name;
4560 /* The type of value allowed. */
4561 enum image_value_type type;
4563 /* Non-zero means key must be present. */
4564 int mandatory_p;
4566 /* Used to recognize duplicate keywords in a property list. */
4567 int count;
4569 /* The value that was found. */
4570 Lisp_Object value;
4574 static int parse_image_spec P_ ((Lisp_Object, struct image_keyword *,
4575 int, Lisp_Object));
4576 static Lisp_Object image_spec_value P_ ((Lisp_Object, Lisp_Object, int *));
4579 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
4580 has the format (image KEYWORD VALUE ...). One of the keyword/
4581 value pairs must be `:type TYPE'. KEYWORDS is a vector of
4582 image_keywords structures of size NKEYWORDS describing other
4583 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
4585 static int
4586 parse_image_spec (spec, keywords, nkeywords, type)
4587 Lisp_Object spec;
4588 struct image_keyword *keywords;
4589 int nkeywords;
4590 Lisp_Object type;
4592 int i;
4593 Lisp_Object plist;
4595 if (!CONSP (spec) || !EQ (XCAR (spec), Qimage))
4596 return 0;
4598 plist = XCDR (spec);
4599 while (CONSP (plist))
4601 Lisp_Object key, value;
4603 /* First element of a pair must be a symbol. */
4604 key = XCAR (plist);
4605 plist = XCDR (plist);
4606 if (!SYMBOLP (key))
4607 return 0;
4609 /* There must follow a value. */
4610 if (!CONSP (plist))
4611 return 0;
4612 value = XCAR (plist);
4613 plist = XCDR (plist);
4615 /* Find key in KEYWORDS. Error if not found. */
4616 for (i = 0; i < nkeywords; ++i)
4617 if (strcmp (keywords[i].name, SDATA (SYMBOL_NAME (key))) == 0)
4618 break;
4620 if (i == nkeywords)
4621 continue;
4623 /* Record that we recognized the keyword. If a keywords
4624 was found more than once, it's an error. */
4625 keywords[i].value = value;
4626 ++keywords[i].count;
4628 if (keywords[i].count > 1)
4629 return 0;
4631 /* Check type of value against allowed type. */
4632 switch (keywords[i].type)
4634 case IMAGE_STRING_VALUE:
4635 if (!STRINGP (value))
4636 return 0;
4637 break;
4639 case IMAGE_STRING_OR_NIL_VALUE:
4640 if (!STRINGP (value) && !NILP (value))
4641 return 0;
4642 break;
4644 case IMAGE_SYMBOL_VALUE:
4645 if (!SYMBOLP (value))
4646 return 0;
4647 break;
4649 case IMAGE_POSITIVE_INTEGER_VALUE:
4650 if (!INTEGERP (value) || XINT (value) <= 0)
4651 return 0;
4652 break;
4654 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR:
4655 if (INTEGERP (value) && XINT (value) >= 0)
4656 break;
4657 if (CONSP (value)
4658 && INTEGERP (XCAR (value)) && INTEGERP (XCDR (value))
4659 && XINT (XCAR (value)) >= 0 && XINT (XCDR (value)) >= 0)
4660 break;
4661 return 0;
4663 case IMAGE_ASCENT_VALUE:
4664 if (SYMBOLP (value) && EQ (value, Qcenter))
4665 break;
4666 else if (INTEGERP (value)
4667 && XINT (value) >= 0
4668 && XINT (value) <= 100)
4669 break;
4670 return 0;
4672 case IMAGE_NON_NEGATIVE_INTEGER_VALUE:
4673 if (!INTEGERP (value) || XINT (value) < 0)
4674 return 0;
4675 break;
4677 case IMAGE_DONT_CHECK_VALUE_TYPE:
4678 break;
4680 case IMAGE_FUNCTION_VALUE:
4681 value = indirect_function (value);
4682 if (SUBRP (value)
4683 || COMPILEDP (value)
4684 || (CONSP (value) && EQ (XCAR (value), Qlambda)))
4685 break;
4686 return 0;
4688 case IMAGE_NUMBER_VALUE:
4689 if (!INTEGERP (value) && !FLOATP (value))
4690 return 0;
4691 break;
4693 case IMAGE_INTEGER_VALUE:
4694 if (!INTEGERP (value))
4695 return 0;
4696 break;
4698 case IMAGE_BOOL_VALUE:
4699 if (!NILP (value) && !EQ (value, Qt))
4700 return 0;
4701 break;
4703 default:
4704 abort ();
4705 break;
4708 if (EQ (key, QCtype) && !EQ (type, value))
4709 return 0;
4712 /* Check that all mandatory fields are present. */
4713 for (i = 0; i < nkeywords; ++i)
4714 if (keywords[i].mandatory_p && keywords[i].count == 0)
4715 return 0;
4717 return NILP (plist);
4721 /* Return the value of KEY in image specification SPEC. Value is nil
4722 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
4723 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
4725 static Lisp_Object
4726 image_spec_value (spec, key, found)
4727 Lisp_Object spec, key;
4728 int *found;
4730 Lisp_Object tail;
4732 xassert (valid_image_p (spec));
4734 for (tail = XCDR (spec);
4735 CONSP (tail) && CONSP (XCDR (tail));
4736 tail = XCDR (XCDR (tail)))
4738 if (EQ (XCAR (tail), key))
4740 if (found)
4741 *found = 1;
4742 return XCAR (XCDR (tail));
4746 if (found)
4747 *found = 0;
4748 return Qnil;
4752 DEFUN ("image-size", Fimage_size, Simage_size, 1, 3, 0,
4753 doc: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
4754 PIXELS non-nil means return the size in pixels, otherwise return the
4755 size in canonical character units.
4756 FRAME is the frame on which the image will be displayed. FRAME nil
4757 or omitted means use the selected frame. */)
4758 (spec, pixels, frame)
4759 Lisp_Object spec, pixels, frame;
4761 Lisp_Object size;
4763 size = Qnil;
4764 if (valid_image_p (spec))
4766 struct frame *f = check_x_frame (frame);
4767 int id = lookup_image (f, spec);
4768 struct image *img = IMAGE_FROM_ID (f, id);
4769 int width = img->width + 2 * img->hmargin;
4770 int height = img->height + 2 * img->vmargin;
4772 if (NILP (pixels))
4773 size = Fcons (make_float ((double) width / FRAME_COLUMN_WIDTH (f)),
4774 make_float ((double) height / FRAME_LINE_HEIGHT (f)));
4775 else
4776 size = Fcons (make_number (width), make_number (height));
4778 else
4779 error ("Invalid image specification");
4781 return size;
4785 DEFUN ("image-mask-p", Fimage_mask_p, Simage_mask_p, 1, 2, 0,
4786 doc: /* Return t if image SPEC has a mask bitmap.
4787 FRAME is the frame on which the image will be displayed. FRAME nil
4788 or omitted means use the selected frame. */)
4789 (spec, frame)
4790 Lisp_Object spec, frame;
4792 Lisp_Object mask;
4794 mask = Qnil;
4795 if (valid_image_p (spec))
4797 struct frame *f = check_x_frame (frame);
4798 int id = lookup_image (f, spec);
4799 struct image *img = IMAGE_FROM_ID (f, id);
4800 if (img->mask)
4801 mask = Qt;
4803 else
4804 error ("Invalid image specification");
4806 return mask;
4811 /***********************************************************************
4812 Image type independent image structures
4813 ***********************************************************************/
4815 static struct image *make_image P_ ((Lisp_Object spec, unsigned hash));
4816 static void free_image P_ ((struct frame *f, struct image *img));
4819 /* Allocate and return a new image structure for image specification
4820 SPEC. SPEC has a hash value of HASH. */
4822 static struct image *
4823 make_image (spec, hash)
4824 Lisp_Object spec;
4825 unsigned hash;
4827 struct image *img = (struct image *) xmalloc (sizeof *img);
4829 xassert (valid_image_p (spec));
4830 bzero (img, sizeof *img);
4831 img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
4832 xassert (img->type != NULL);
4833 img->spec = spec;
4834 img->data.lisp_val = Qnil;
4835 img->ascent = DEFAULT_IMAGE_ASCENT;
4836 img->hash = hash;
4837 return img;
4841 /* Free image IMG which was used on frame F, including its resources. */
4843 static void
4844 free_image (f, img)
4845 struct frame *f;
4846 struct image *img;
4848 if (img)
4850 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
4852 /* Remove IMG from the hash table of its cache. */
4853 if (img->prev)
4854 img->prev->next = img->next;
4855 else
4856 c->buckets[img->hash % IMAGE_CACHE_BUCKETS_SIZE] = img->next;
4858 if (img->next)
4859 img->next->prev = img->prev;
4861 c->images[img->id] = NULL;
4863 /* Free resources, then free IMG. */
4864 img->type->free (f, img);
4865 xfree (img);
4870 /* Prepare image IMG for display on frame F. Must be called before
4871 drawing an image. */
4873 void
4874 prepare_image_for_display (f, img)
4875 struct frame *f;
4876 struct image *img;
4878 EMACS_TIME t;
4880 /* We're about to display IMG, so set its timestamp to `now'. */
4881 EMACS_GET_TIME (t);
4882 img->timestamp = EMACS_SECS (t);
4884 /* If IMG doesn't have a pixmap yet, load it now, using the image
4885 type dependent loader function. */
4886 if (img->pixmap == None && !img->load_failed_p)
4887 img->load_failed_p = img->type->load (f, img) == 0;
4891 /* Value is the number of pixels for the ascent of image IMG when
4892 drawn in face FACE. */
4895 image_ascent (img, face)
4896 struct image *img;
4897 struct face *face;
4899 int height = img->height + img->vmargin;
4900 int ascent;
4902 if (img->ascent == CENTERED_IMAGE_ASCENT)
4904 if (face->font)
4905 /* This expression is arranged so that if the image can't be
4906 exactly centered, it will be moved slightly up. This is
4907 because a typical font is `top-heavy' (due to the presence
4908 uppercase letters), so the image placement should err towards
4909 being top-heavy too. It also just generally looks better. */
4910 ascent = (height + face->font->ascent - face->font->descent + 1) / 2;
4911 else
4912 ascent = height / 2;
4914 else
4915 ascent = height * img->ascent / 100.0;
4917 return ascent;
4921 /* Image background colors. */
4923 static unsigned long
4924 four_corners_best (ximg, width, height)
4925 XImage *ximg;
4926 unsigned long width, height;
4928 unsigned long corners[4], best;
4929 int i, best_count;
4931 /* Get the colors at the corners of ximg. */
4932 corners[0] = XGetPixel (ximg, 0, 0);
4933 corners[1] = XGetPixel (ximg, width - 1, 0);
4934 corners[2] = XGetPixel (ximg, width - 1, height - 1);
4935 corners[3] = XGetPixel (ximg, 0, height - 1);
4937 /* Choose the most frequently found color as background. */
4938 for (i = best_count = 0; i < 4; ++i)
4940 int j, n;
4942 for (j = n = 0; j < 4; ++j)
4943 if (corners[i] == corners[j])
4944 ++n;
4946 if (n > best_count)
4947 best = corners[i], best_count = n;
4950 return best;
4953 /* Return the `background' field of IMG. If IMG doesn't have one yet,
4954 it is guessed heuristically. If non-zero, XIMG is an existing XImage
4955 object to use for the heuristic. */
4957 unsigned long
4958 image_background (img, f, ximg)
4959 struct image *img;
4960 struct frame *f;
4961 XImage *ximg;
4963 if (! img->background_valid)
4964 /* IMG doesn't have a background yet, try to guess a reasonable value. */
4966 int free_ximg = !ximg;
4968 if (! ximg)
4969 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
4970 0, 0, img->width, img->height, ~0, ZPixmap);
4972 img->background = four_corners_best (ximg, img->width, img->height);
4974 if (free_ximg)
4975 XDestroyImage (ximg);
4977 img->background_valid = 1;
4980 return img->background;
4983 /* Return the `background_transparent' field of IMG. If IMG doesn't
4984 have one yet, it is guessed heuristically. If non-zero, MASK is an
4985 existing XImage object to use for the heuristic. */
4988 image_background_transparent (img, f, mask)
4989 struct image *img;
4990 struct frame *f;
4991 XImage *mask;
4993 if (! img->background_transparent_valid)
4994 /* IMG doesn't have a background yet, try to guess a reasonable value. */
4996 if (img->mask)
4998 int free_mask = !mask;
5000 if (! mask)
5001 mask = XGetImage (FRAME_X_DISPLAY (f), img->mask,
5002 0, 0, img->width, img->height, ~0, ZPixmap);
5004 img->background_transparent
5005 = !four_corners_best (mask, img->width, img->height);
5007 if (free_mask)
5008 XDestroyImage (mask);
5010 else
5011 img->background_transparent = 0;
5013 img->background_transparent_valid = 1;
5016 return img->background_transparent;
5020 /***********************************************************************
5021 Helper functions for X image types
5022 ***********************************************************************/
5024 static void x_clear_image_1 P_ ((struct frame *, struct image *, int,
5025 int, int));
5026 static void x_clear_image P_ ((struct frame *f, struct image *img));
5027 static unsigned long x_alloc_image_color P_ ((struct frame *f,
5028 struct image *img,
5029 Lisp_Object color_name,
5030 unsigned long dflt));
5033 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5034 free the pixmap if any. MASK_P non-zero means clear the mask
5035 pixmap if any. COLORS_P non-zero means free colors allocated for
5036 the image, if any. */
5038 static void
5039 x_clear_image_1 (f, img, pixmap_p, mask_p, colors_p)
5040 struct frame *f;
5041 struct image *img;
5042 int pixmap_p, mask_p, colors_p;
5044 if (pixmap_p && img->pixmap)
5046 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
5047 img->pixmap = None;
5048 img->background_valid = 0;
5051 if (mask_p && img->mask)
5053 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
5054 img->mask = None;
5055 img->background_transparent_valid = 0;
5058 if (colors_p && img->ncolors)
5060 x_free_colors (f, img->colors, img->ncolors);
5061 xfree (img->colors);
5062 img->colors = NULL;
5063 img->ncolors = 0;
5067 /* Free X resources of image IMG which is used on frame F. */
5069 static void
5070 x_clear_image (f, img)
5071 struct frame *f;
5072 struct image *img;
5074 BLOCK_INPUT;
5075 x_clear_image_1 (f, img, 1, 1, 1);
5076 UNBLOCK_INPUT;
5080 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5081 cannot be allocated, use DFLT. Add a newly allocated color to
5082 IMG->colors, so that it can be freed again. Value is the pixel
5083 color. */
5085 static unsigned long
5086 x_alloc_image_color (f, img, color_name, dflt)
5087 struct frame *f;
5088 struct image *img;
5089 Lisp_Object color_name;
5090 unsigned long dflt;
5092 XColor color;
5093 unsigned long result;
5095 xassert (STRINGP (color_name));
5097 if (x_defined_color (f, SDATA (color_name), &color, 1))
5099 /* This isn't called frequently so we get away with simply
5100 reallocating the color vector to the needed size, here. */
5101 ++img->ncolors;
5102 img->colors =
5103 (unsigned long *) xrealloc (img->colors,
5104 img->ncolors * sizeof *img->colors);
5105 img->colors[img->ncolors - 1] = color.pixel;
5106 result = color.pixel;
5108 else
5109 result = dflt;
5111 return result;
5116 /***********************************************************************
5117 Image Cache
5118 ***********************************************************************/
5120 static void cache_image P_ ((struct frame *f, struct image *img));
5121 static void postprocess_image P_ ((struct frame *, struct image *));
5124 /* Return a new, initialized image cache that is allocated from the
5125 heap. Call free_image_cache to free an image cache. */
5127 struct image_cache *
5128 make_image_cache ()
5130 struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
5131 int size;
5133 bzero (c, sizeof *c);
5134 c->size = 50;
5135 c->images = (struct image **) xmalloc (c->size * sizeof *c->images);
5136 size = IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
5137 c->buckets = (struct image **) xmalloc (size);
5138 bzero (c->buckets, size);
5139 return c;
5143 /* Free image cache of frame F. Be aware that X frames share images
5144 caches. */
5146 void
5147 free_image_cache (f)
5148 struct frame *f;
5150 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5151 if (c)
5153 int i;
5155 /* Cache should not be referenced by any frame when freed. */
5156 xassert (c->refcount == 0);
5158 for (i = 0; i < c->used; ++i)
5159 free_image (f, c->images[i]);
5160 xfree (c->images);
5161 xfree (c->buckets);
5162 xfree (c);
5163 FRAME_X_IMAGE_CACHE (f) = NULL;
5168 /* Clear image cache of frame F. FORCE_P non-zero means free all
5169 images. FORCE_P zero means clear only images that haven't been
5170 displayed for some time. Should be called from time to time to
5171 reduce the number of loaded images. If image-eviction-seconds is
5172 non-nil, this frees images in the cache which weren't displayed for
5173 at least that many seconds. */
5175 void
5176 clear_image_cache (f, force_p)
5177 struct frame *f;
5178 int force_p;
5180 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5182 if (c && INTEGERP (Vimage_cache_eviction_delay))
5184 EMACS_TIME t;
5185 unsigned long old;
5186 int i, nfreed;
5188 EMACS_GET_TIME (t);
5189 old = EMACS_SECS (t) - XFASTINT (Vimage_cache_eviction_delay);
5191 /* Block input so that we won't be interrupted by a SIGIO
5192 while being in an inconsistent state. */
5193 BLOCK_INPUT;
5195 for (i = nfreed = 0; i < c->used; ++i)
5197 struct image *img = c->images[i];
5198 if (img != NULL
5199 && (force_p || img->timestamp < old))
5201 free_image (f, img);
5202 ++nfreed;
5206 /* We may be clearing the image cache because, for example,
5207 Emacs was iconified for a longer period of time. In that
5208 case, current matrices may still contain references to
5209 images freed above. So, clear these matrices. */
5210 if (nfreed)
5212 Lisp_Object tail, frame;
5214 FOR_EACH_FRAME (tail, frame)
5216 struct frame *f = XFRAME (frame);
5217 if (FRAME_X_P (f)
5218 && FRAME_X_IMAGE_CACHE (f) == c)
5219 clear_current_matrices (f);
5222 ++windows_or_buffers_changed;
5225 UNBLOCK_INPUT;
5230 DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache,
5231 0, 1, 0,
5232 doc: /* Clear the image cache of FRAME.
5233 FRAME nil or omitted means use the selected frame.
5234 FRAME t means clear the image caches of all frames. */)
5235 (frame)
5236 Lisp_Object frame;
5238 if (EQ (frame, Qt))
5240 Lisp_Object tail;
5242 FOR_EACH_FRAME (tail, frame)
5243 if (FRAME_X_P (XFRAME (frame)))
5244 clear_image_cache (XFRAME (frame), 1);
5246 else
5247 clear_image_cache (check_x_frame (frame), 1);
5249 return Qnil;
5253 /* Compute masks and transform image IMG on frame F, as specified
5254 by the image's specification, */
5256 static void
5257 postprocess_image (f, img)
5258 struct frame *f;
5259 struct image *img;
5261 /* Manipulation of the image's mask. */
5262 if (img->pixmap)
5264 Lisp_Object conversion, spec;
5265 Lisp_Object mask;
5267 spec = img->spec;
5269 /* `:heuristic-mask t'
5270 `:mask heuristic'
5271 means build a mask heuristically.
5272 `:heuristic-mask (R G B)'
5273 `:mask (heuristic (R G B))'
5274 means build a mask from color (R G B) in the
5275 image.
5276 `:mask nil'
5277 means remove a mask, if any. */
5279 mask = image_spec_value (spec, QCheuristic_mask, NULL);
5280 if (!NILP (mask))
5281 x_build_heuristic_mask (f, img, mask);
5282 else
5284 int found_p;
5286 mask = image_spec_value (spec, QCmask, &found_p);
5288 if (EQ (mask, Qheuristic))
5289 x_build_heuristic_mask (f, img, Qt);
5290 else if (CONSP (mask)
5291 && EQ (XCAR (mask), Qheuristic))
5293 if (CONSP (XCDR (mask)))
5294 x_build_heuristic_mask (f, img, XCAR (XCDR (mask)));
5295 else
5296 x_build_heuristic_mask (f, img, XCDR (mask));
5298 else if (NILP (mask) && found_p && img->mask)
5300 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
5301 img->mask = None;
5306 /* Should we apply an image transformation algorithm? */
5307 conversion = image_spec_value (spec, QCconversion, NULL);
5308 if (EQ (conversion, Qdisabled))
5309 x_disable_image (f, img);
5310 else if (EQ (conversion, Qlaplace))
5311 x_laplace (f, img);
5312 else if (EQ (conversion, Qemboss))
5313 x_emboss (f, img);
5314 else if (CONSP (conversion)
5315 && EQ (XCAR (conversion), Qedge_detection))
5317 Lisp_Object tem;
5318 tem = XCDR (conversion);
5319 if (CONSP (tem))
5320 x_edge_detection (f, img,
5321 Fplist_get (tem, QCmatrix),
5322 Fplist_get (tem, QCcolor_adjustment));
5328 /* Return the id of image with Lisp specification SPEC on frame F.
5329 SPEC must be a valid Lisp image specification (see valid_image_p). */
5332 lookup_image (f, spec)
5333 struct frame *f;
5334 Lisp_Object spec;
5336 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5337 struct image *img;
5338 int i;
5339 unsigned hash;
5340 struct gcpro gcpro1;
5341 EMACS_TIME now;
5343 /* F must be a window-system frame, and SPEC must be a valid image
5344 specification. */
5345 xassert (FRAME_WINDOW_P (f));
5346 xassert (valid_image_p (spec));
5348 GCPRO1 (spec);
5350 /* Look up SPEC in the hash table of the image cache. */
5351 hash = sxhash (spec, 0);
5352 i = hash % IMAGE_CACHE_BUCKETS_SIZE;
5354 for (img = c->buckets[i]; img; img = img->next)
5355 if (img->hash == hash && !NILP (Fequal (img->spec, spec)))
5356 break;
5358 /* If not found, create a new image and cache it. */
5359 if (img == NULL)
5361 extern Lisp_Object Qpostscript;
5363 BLOCK_INPUT;
5364 img = make_image (spec, hash);
5365 cache_image (f, img);
5366 img->load_failed_p = img->type->load (f, img) == 0;
5368 /* If we can't load the image, and we don't have a width and
5369 height, use some arbitrary width and height so that we can
5370 draw a rectangle for it. */
5371 if (img->load_failed_p)
5373 Lisp_Object value;
5375 value = image_spec_value (spec, QCwidth, NULL);
5376 img->width = (INTEGERP (value)
5377 ? XFASTINT (value) : DEFAULT_IMAGE_WIDTH);
5378 value = image_spec_value (spec, QCheight, NULL);
5379 img->height = (INTEGERP (value)
5380 ? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT);
5382 else
5384 /* Handle image type independent image attributes
5385 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF',
5386 `:background COLOR'. */
5387 Lisp_Object ascent, margin, relief, bg;
5389 ascent = image_spec_value (spec, QCascent, NULL);
5390 if (INTEGERP (ascent))
5391 img->ascent = XFASTINT (ascent);
5392 else if (EQ (ascent, Qcenter))
5393 img->ascent = CENTERED_IMAGE_ASCENT;
5395 margin = image_spec_value (spec, QCmargin, NULL);
5396 if (INTEGERP (margin) && XINT (margin) >= 0)
5397 img->vmargin = img->hmargin = XFASTINT (margin);
5398 else if (CONSP (margin) && INTEGERP (XCAR (margin))
5399 && INTEGERP (XCDR (margin)))
5401 if (XINT (XCAR (margin)) > 0)
5402 img->hmargin = XFASTINT (XCAR (margin));
5403 if (XINT (XCDR (margin)) > 0)
5404 img->vmargin = XFASTINT (XCDR (margin));
5407 relief = image_spec_value (spec, QCrelief, NULL);
5408 if (INTEGERP (relief))
5410 img->relief = XINT (relief);
5411 img->hmargin += abs (img->relief);
5412 img->vmargin += abs (img->relief);
5415 if (! img->background_valid)
5417 bg = image_spec_value (img->spec, QCbackground, NULL);
5418 if (!NILP (bg))
5420 img->background
5421 = x_alloc_image_color (f, img, bg,
5422 FRAME_BACKGROUND_PIXEL (f));
5423 img->background_valid = 1;
5427 /* Do image transformations and compute masks, unless we
5428 don't have the image yet. */
5429 if (!EQ (*img->type->type, Qpostscript))
5430 postprocess_image (f, img);
5433 UNBLOCK_INPUT;
5434 xassert (!interrupt_input_blocked);
5437 /* We're using IMG, so set its timestamp to `now'. */
5438 EMACS_GET_TIME (now);
5439 img->timestamp = EMACS_SECS (now);
5441 UNGCPRO;
5443 /* Value is the image id. */
5444 return img->id;
5448 /* Cache image IMG in the image cache of frame F. */
5450 static void
5451 cache_image (f, img)
5452 struct frame *f;
5453 struct image *img;
5455 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5456 int i;
5458 /* Find a free slot in c->images. */
5459 for (i = 0; i < c->used; ++i)
5460 if (c->images[i] == NULL)
5461 break;
5463 /* If no free slot found, maybe enlarge c->images. */
5464 if (i == c->used && c->used == c->size)
5466 c->size *= 2;
5467 c->images = (struct image **) xrealloc (c->images,
5468 c->size * sizeof *c->images);
5471 /* Add IMG to c->images, and assign IMG an id. */
5472 c->images[i] = img;
5473 img->id = i;
5474 if (i == c->used)
5475 ++c->used;
5477 /* Add IMG to the cache's hash table. */
5478 i = img->hash % IMAGE_CACHE_BUCKETS_SIZE;
5479 img->next = c->buckets[i];
5480 if (img->next)
5481 img->next->prev = img;
5482 img->prev = NULL;
5483 c->buckets[i] = img;
5487 /* Call FN on every image in the image cache of frame F. Used to mark
5488 Lisp Objects in the image cache. */
5490 void
5491 forall_images_in_image_cache (f, fn)
5492 struct frame *f;
5493 void (*fn) P_ ((struct image *img));
5495 if (FRAME_LIVE_P (f) && FRAME_X_P (f))
5497 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5498 if (c)
5500 int i;
5501 for (i = 0; i < c->used; ++i)
5502 if (c->images[i])
5503 fn (c->images[i]);
5510 /***********************************************************************
5511 X support code
5512 ***********************************************************************/
5514 static int x_create_x_image_and_pixmap P_ ((struct frame *, int, int, int,
5515 XImage **, Pixmap *));
5516 static void x_destroy_x_image P_ ((XImage *));
5517 static void x_put_x_image P_ ((struct frame *, XImage *, Pixmap, int, int));
5520 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
5521 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
5522 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
5523 via xmalloc. Print error messages via image_error if an error
5524 occurs. Value is non-zero if successful. */
5526 static int
5527 x_create_x_image_and_pixmap (f, width, height, depth, ximg, pixmap)
5528 struct frame *f;
5529 int width, height, depth;
5530 XImage **ximg;
5531 Pixmap *pixmap;
5533 Display *display = FRAME_X_DISPLAY (f);
5534 Screen *screen = FRAME_X_SCREEN (f);
5535 Window window = FRAME_X_WINDOW (f);
5537 xassert (interrupt_input_blocked);
5539 if (depth <= 0)
5540 depth = DefaultDepthOfScreen (screen);
5541 *ximg = XCreateImage (display, DefaultVisualOfScreen (screen),
5542 depth, ZPixmap, 0, NULL, width, height,
5543 depth > 16 ? 32 : depth > 8 ? 16 : 8, 0);
5544 if (*ximg == NULL)
5546 image_error ("Unable to allocate X image", Qnil, Qnil);
5547 return 0;
5550 /* Allocate image raster. */
5551 (*ximg)->data = (char *) xmalloc ((*ximg)->bytes_per_line * height);
5553 /* Allocate a pixmap of the same size. */
5554 *pixmap = XCreatePixmap (display, window, width, height, depth);
5555 if (*pixmap == None)
5557 x_destroy_x_image (*ximg);
5558 *ximg = NULL;
5559 image_error ("Unable to create X pixmap", Qnil, Qnil);
5560 return 0;
5563 return 1;
5567 /* Destroy XImage XIMG. Free XIMG->data. */
5569 static void
5570 x_destroy_x_image (ximg)
5571 XImage *ximg;
5573 xassert (interrupt_input_blocked);
5574 if (ximg)
5576 xfree (ximg->data);
5577 ximg->data = NULL;
5578 XDestroyImage (ximg);
5583 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
5584 are width and height of both the image and pixmap. */
5586 static void
5587 x_put_x_image (f, ximg, pixmap, width, height)
5588 struct frame *f;
5589 XImage *ximg;
5590 Pixmap pixmap;
5591 int width, height;
5593 GC gc;
5595 xassert (interrupt_input_blocked);
5596 gc = XCreateGC (FRAME_X_DISPLAY (f), pixmap, 0, NULL);
5597 XPutImage (FRAME_X_DISPLAY (f), pixmap, gc, ximg, 0, 0, 0, 0, width, height);
5598 XFreeGC (FRAME_X_DISPLAY (f), gc);
5603 /***********************************************************************
5604 File Handling
5605 ***********************************************************************/
5607 static Lisp_Object x_find_image_file P_ ((Lisp_Object));
5608 static char *slurp_file P_ ((char *, int *));
5611 /* Find image file FILE. Look in data-directory, then
5612 x-bitmap-file-path. Value is the full name of the file found, or
5613 nil if not found. */
5615 static Lisp_Object
5616 x_find_image_file (file)
5617 Lisp_Object file;
5619 Lisp_Object file_found, search_path;
5620 struct gcpro gcpro1, gcpro2;
5621 int fd;
5623 file_found = Qnil;
5624 search_path = Fcons (Vdata_directory, Vx_bitmap_file_path);
5625 GCPRO2 (file_found, search_path);
5627 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
5628 fd = openp (search_path, file, Qnil, &file_found, Qnil);
5630 if (fd == -1)
5631 file_found = Qnil;
5632 else
5633 close (fd);
5635 UNGCPRO;
5636 return file_found;
5640 /* Read FILE into memory. Value is a pointer to a buffer allocated
5641 with xmalloc holding FILE's contents. Value is null if an error
5642 occurred. *SIZE is set to the size of the file. */
5644 static char *
5645 slurp_file (file, size)
5646 char *file;
5647 int *size;
5649 FILE *fp = NULL;
5650 char *buf = NULL;
5651 struct stat st;
5653 if (stat (file, &st) == 0
5654 && (fp = fopen (file, "r")) != NULL
5655 && (buf = (char *) xmalloc (st.st_size),
5656 fread (buf, 1, st.st_size, fp) == st.st_size))
5658 *size = st.st_size;
5659 fclose (fp);
5661 else
5663 if (fp)
5664 fclose (fp);
5665 if (buf)
5667 xfree (buf);
5668 buf = NULL;
5672 return buf;
5677 /***********************************************************************
5678 XBM images
5679 ***********************************************************************/
5681 static int xbm_scan P_ ((char **, char *, char *, int *));
5682 static int xbm_load P_ ((struct frame *f, struct image *img));
5683 static int xbm_load_image P_ ((struct frame *f, struct image *img,
5684 char *, char *));
5685 static int xbm_image_p P_ ((Lisp_Object object));
5686 static int xbm_read_bitmap_data P_ ((char *, char *, int *, int *,
5687 unsigned char **));
5688 static int xbm_file_p P_ ((Lisp_Object));
5691 /* Indices of image specification fields in xbm_format, below. */
5693 enum xbm_keyword_index
5695 XBM_TYPE,
5696 XBM_FILE,
5697 XBM_WIDTH,
5698 XBM_HEIGHT,
5699 XBM_DATA,
5700 XBM_FOREGROUND,
5701 XBM_BACKGROUND,
5702 XBM_ASCENT,
5703 XBM_MARGIN,
5704 XBM_RELIEF,
5705 XBM_ALGORITHM,
5706 XBM_HEURISTIC_MASK,
5707 XBM_MASK,
5708 XBM_LAST
5711 /* Vector of image_keyword structures describing the format
5712 of valid XBM image specifications. */
5714 static struct image_keyword xbm_format[XBM_LAST] =
5716 {":type", IMAGE_SYMBOL_VALUE, 1},
5717 {":file", IMAGE_STRING_VALUE, 0},
5718 {":width", IMAGE_POSITIVE_INTEGER_VALUE, 0},
5719 {":height", IMAGE_POSITIVE_INTEGER_VALUE, 0},
5720 {":data", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
5721 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
5722 {":background", IMAGE_STRING_OR_NIL_VALUE, 0},
5723 {":ascent", IMAGE_ASCENT_VALUE, 0},
5724 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
5725 {":relief", IMAGE_INTEGER_VALUE, 0},
5726 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
5727 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
5728 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
5731 /* Structure describing the image type XBM. */
5733 static struct image_type xbm_type =
5735 &Qxbm,
5736 xbm_image_p,
5737 xbm_load,
5738 x_clear_image,
5739 NULL
5742 /* Tokens returned from xbm_scan. */
5744 enum xbm_token
5746 XBM_TK_IDENT = 256,
5747 XBM_TK_NUMBER
5751 /* Return non-zero if OBJECT is a valid XBM-type image specification.
5752 A valid specification is a list starting with the symbol `image'
5753 The rest of the list is a property list which must contain an
5754 entry `:type xbm..
5756 If the specification specifies a file to load, it must contain
5757 an entry `:file FILENAME' where FILENAME is a string.
5759 If the specification is for a bitmap loaded from memory it must
5760 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
5761 WIDTH and HEIGHT are integers > 0. DATA may be:
5763 1. a string large enough to hold the bitmap data, i.e. it must
5764 have a size >= (WIDTH + 7) / 8 * HEIGHT
5766 2. a bool-vector of size >= WIDTH * HEIGHT
5768 3. a vector of strings or bool-vectors, one for each line of the
5769 bitmap.
5771 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
5772 may not be specified in this case because they are defined in the
5773 XBM file.
5775 Both the file and data forms may contain the additional entries
5776 `:background COLOR' and `:foreground COLOR'. If not present,
5777 foreground and background of the frame on which the image is
5778 displayed is used. */
5780 static int
5781 xbm_image_p (object)
5782 Lisp_Object object;
5784 struct image_keyword kw[XBM_LAST];
5786 bcopy (xbm_format, kw, sizeof kw);
5787 if (!parse_image_spec (object, kw, XBM_LAST, Qxbm))
5788 return 0;
5790 xassert (EQ (kw[XBM_TYPE].value, Qxbm));
5792 if (kw[XBM_FILE].count)
5794 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_DATA].count)
5795 return 0;
5797 else if (kw[XBM_DATA].count && xbm_file_p (kw[XBM_DATA].value))
5799 /* In-memory XBM file. */
5800 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_FILE].count)
5801 return 0;
5803 else
5805 Lisp_Object data;
5806 int width, height;
5808 /* Entries for `:width', `:height' and `:data' must be present. */
5809 if (!kw[XBM_WIDTH].count
5810 || !kw[XBM_HEIGHT].count
5811 || !kw[XBM_DATA].count)
5812 return 0;
5814 data = kw[XBM_DATA].value;
5815 width = XFASTINT (kw[XBM_WIDTH].value);
5816 height = XFASTINT (kw[XBM_HEIGHT].value);
5818 /* Check type of data, and width and height against contents of
5819 data. */
5820 if (VECTORP (data))
5822 int i;
5824 /* Number of elements of the vector must be >= height. */
5825 if (XVECTOR (data)->size < height)
5826 return 0;
5828 /* Each string or bool-vector in data must be large enough
5829 for one line of the image. */
5830 for (i = 0; i < height; ++i)
5832 Lisp_Object elt = XVECTOR (data)->contents[i];
5834 if (STRINGP (elt))
5836 if (SCHARS (elt)
5837 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR)
5838 return 0;
5840 else if (BOOL_VECTOR_P (elt))
5842 if (XBOOL_VECTOR (elt)->size < width)
5843 return 0;
5845 else
5846 return 0;
5849 else if (STRINGP (data))
5851 if (SCHARS (data)
5852 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR * height)
5853 return 0;
5855 else if (BOOL_VECTOR_P (data))
5857 if (XBOOL_VECTOR (data)->size < width * height)
5858 return 0;
5860 else
5861 return 0;
5864 return 1;
5868 /* Scan a bitmap file. FP is the stream to read from. Value is
5869 either an enumerator from enum xbm_token, or a character for a
5870 single-character token, or 0 at end of file. If scanning an
5871 identifier, store the lexeme of the identifier in SVAL. If
5872 scanning a number, store its value in *IVAL. */
5874 static int
5875 xbm_scan (s, end, sval, ival)
5876 char **s, *end;
5877 char *sval;
5878 int *ival;
5880 int c;
5882 loop:
5884 /* Skip white space. */
5885 while (*s < end && (c = *(*s)++, isspace (c)))
5888 if (*s >= end)
5889 c = 0;
5890 else if (isdigit (c))
5892 int value = 0, digit;
5894 if (c == '0' && *s < end)
5896 c = *(*s)++;
5897 if (c == 'x' || c == 'X')
5899 while (*s < end)
5901 c = *(*s)++;
5902 if (isdigit (c))
5903 digit = c - '0';
5904 else if (c >= 'a' && c <= 'f')
5905 digit = c - 'a' + 10;
5906 else if (c >= 'A' && c <= 'F')
5907 digit = c - 'A' + 10;
5908 else
5909 break;
5910 value = 16 * value + digit;
5913 else if (isdigit (c))
5915 value = c - '0';
5916 while (*s < end
5917 && (c = *(*s)++, isdigit (c)))
5918 value = 8 * value + c - '0';
5921 else
5923 value = c - '0';
5924 while (*s < end
5925 && (c = *(*s)++, isdigit (c)))
5926 value = 10 * value + c - '0';
5929 if (*s < end)
5930 *s = *s - 1;
5931 *ival = value;
5932 c = XBM_TK_NUMBER;
5934 else if (isalpha (c) || c == '_')
5936 *sval++ = c;
5937 while (*s < end
5938 && (c = *(*s)++, (isalnum (c) || c == '_')))
5939 *sval++ = c;
5940 *sval = 0;
5941 if (*s < end)
5942 *s = *s - 1;
5943 c = XBM_TK_IDENT;
5945 else if (c == '/' && **s == '*')
5947 /* C-style comment. */
5948 ++*s;
5949 while (**s && (**s != '*' || *(*s + 1) != '/'))
5950 ++*s;
5951 if (**s)
5953 *s += 2;
5954 goto loop;
5958 return c;
5962 /* Replacement for XReadBitmapFileData which isn't available under old
5963 X versions. CONTENTS is a pointer to a buffer to parse; END is the
5964 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
5965 the image. Return in *DATA the bitmap data allocated with xmalloc.
5966 Value is non-zero if successful. DATA null means just test if
5967 CONTENTS looks like an in-memory XBM file. */
5969 static int
5970 xbm_read_bitmap_data (contents, end, width, height, data)
5971 char *contents, *end;
5972 int *width, *height;
5973 unsigned char **data;
5975 char *s = contents;
5976 char buffer[BUFSIZ];
5977 int padding_p = 0;
5978 int v10 = 0;
5979 int bytes_per_line, i, nbytes;
5980 unsigned char *p;
5981 int value;
5982 int LA1;
5984 #define match() \
5985 LA1 = xbm_scan (&s, end, buffer, &value)
5987 #define expect(TOKEN) \
5988 if (LA1 != (TOKEN)) \
5989 goto failure; \
5990 else \
5991 match ()
5993 #define expect_ident(IDENT) \
5994 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
5995 match (); \
5996 else \
5997 goto failure
5999 *width = *height = -1;
6000 if (data)
6001 *data = NULL;
6002 LA1 = xbm_scan (&s, end, buffer, &value);
6004 /* Parse defines for width, height and hot-spots. */
6005 while (LA1 == '#')
6007 match ();
6008 expect_ident ("define");
6009 expect (XBM_TK_IDENT);
6011 if (LA1 == XBM_TK_NUMBER);
6013 char *p = strrchr (buffer, '_');
6014 p = p ? p + 1 : buffer;
6015 if (strcmp (p, "width") == 0)
6016 *width = value;
6017 else if (strcmp (p, "height") == 0)
6018 *height = value;
6020 expect (XBM_TK_NUMBER);
6023 if (*width < 0 || *height < 0)
6024 goto failure;
6025 else if (data == NULL)
6026 goto success;
6028 /* Parse bits. Must start with `static'. */
6029 expect_ident ("static");
6030 if (LA1 == XBM_TK_IDENT)
6032 if (strcmp (buffer, "unsigned") == 0)
6034 match ();
6035 expect_ident ("char");
6037 else if (strcmp (buffer, "short") == 0)
6039 match ();
6040 v10 = 1;
6041 if (*width % 16 && *width % 16 < 9)
6042 padding_p = 1;
6044 else if (strcmp (buffer, "char") == 0)
6045 match ();
6046 else
6047 goto failure;
6049 else
6050 goto failure;
6052 expect (XBM_TK_IDENT);
6053 expect ('[');
6054 expect (']');
6055 expect ('=');
6056 expect ('{');
6058 bytes_per_line = (*width + 7) / 8 + padding_p;
6059 nbytes = bytes_per_line * *height;
6060 p = *data = (char *) xmalloc (nbytes);
6062 if (v10)
6064 for (i = 0; i < nbytes; i += 2)
6066 int val = value;
6067 expect (XBM_TK_NUMBER);
6069 *p++ = val;
6070 if (!padding_p || ((i + 2) % bytes_per_line))
6071 *p++ = value >> 8;
6073 if (LA1 == ',' || LA1 == '}')
6074 match ();
6075 else
6076 goto failure;
6079 else
6081 for (i = 0; i < nbytes; ++i)
6083 int val = value;
6084 expect (XBM_TK_NUMBER);
6086 *p++ = val;
6088 if (LA1 == ',' || LA1 == '}')
6089 match ();
6090 else
6091 goto failure;
6095 success:
6096 return 1;
6098 failure:
6100 if (data && *data)
6102 xfree (*data);
6103 *data = NULL;
6105 return 0;
6107 #undef match
6108 #undef expect
6109 #undef expect_ident
6113 /* Load XBM image IMG which will be displayed on frame F from buffer
6114 CONTENTS. END is the end of the buffer. Value is non-zero if
6115 successful. */
6117 static int
6118 xbm_load_image (f, img, contents, end)
6119 struct frame *f;
6120 struct image *img;
6121 char *contents, *end;
6123 int rc;
6124 unsigned char *data;
6125 int success_p = 0;
6127 rc = xbm_read_bitmap_data (contents, end, &img->width, &img->height, &data);
6128 if (rc)
6130 int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
6131 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
6132 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
6133 Lisp_Object value;
6135 xassert (img->width > 0 && img->height > 0);
6137 /* Get foreground and background colors, maybe allocate colors. */
6138 value = image_spec_value (img->spec, QCforeground, NULL);
6139 if (!NILP (value))
6140 foreground = x_alloc_image_color (f, img, value, foreground);
6141 value = image_spec_value (img->spec, QCbackground, NULL);
6142 if (!NILP (value))
6144 background = x_alloc_image_color (f, img, value, background);
6145 img->background = background;
6146 img->background_valid = 1;
6149 img->pixmap
6150 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
6151 FRAME_X_WINDOW (f),
6152 data,
6153 img->width, img->height,
6154 foreground, background,
6155 depth);
6156 xfree (data);
6158 if (img->pixmap == None)
6160 x_clear_image (f, img);
6161 image_error ("Unable to create X pixmap for `%s'", img->spec, Qnil);
6163 else
6164 success_p = 1;
6166 else
6167 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
6169 return success_p;
6173 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6175 static int
6176 xbm_file_p (data)
6177 Lisp_Object data;
6179 int w, h;
6180 return (STRINGP (data)
6181 && xbm_read_bitmap_data (SDATA (data),
6182 (SDATA (data)
6183 + SBYTES (data)),
6184 &w, &h, NULL));
6188 /* Fill image IMG which is used on frame F with pixmap data. Value is
6189 non-zero if successful. */
6191 static int
6192 xbm_load (f, img)
6193 struct frame *f;
6194 struct image *img;
6196 int success_p = 0;
6197 Lisp_Object file_name;
6199 xassert (xbm_image_p (img->spec));
6201 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6202 file_name = image_spec_value (img->spec, QCfile, NULL);
6203 if (STRINGP (file_name))
6205 Lisp_Object file;
6206 char *contents;
6207 int size;
6208 struct gcpro gcpro1;
6210 file = x_find_image_file (file_name);
6211 GCPRO1 (file);
6212 if (!STRINGP (file))
6214 image_error ("Cannot find image file `%s'", file_name, Qnil);
6215 UNGCPRO;
6216 return 0;
6219 contents = slurp_file (SDATA (file), &size);
6220 if (contents == NULL)
6222 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
6223 UNGCPRO;
6224 return 0;
6227 success_p = xbm_load_image (f, img, contents, contents + size);
6228 UNGCPRO;
6230 else
6232 struct image_keyword fmt[XBM_LAST];
6233 Lisp_Object data;
6234 int depth;
6235 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
6236 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
6237 char *bits;
6238 int parsed_p;
6239 int in_memory_file_p = 0;
6241 /* See if data looks like an in-memory XBM file. */
6242 data = image_spec_value (img->spec, QCdata, NULL);
6243 in_memory_file_p = xbm_file_p (data);
6245 /* Parse the image specification. */
6246 bcopy (xbm_format, fmt, sizeof fmt);
6247 parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm);
6248 xassert (parsed_p);
6250 /* Get specified width, and height. */
6251 if (!in_memory_file_p)
6253 img->width = XFASTINT (fmt[XBM_WIDTH].value);
6254 img->height = XFASTINT (fmt[XBM_HEIGHT].value);
6255 xassert (img->width > 0 && img->height > 0);
6258 /* Get foreground and background colors, maybe allocate colors. */
6259 if (fmt[XBM_FOREGROUND].count
6260 && STRINGP (fmt[XBM_FOREGROUND].value))
6261 foreground = x_alloc_image_color (f, img, fmt[XBM_FOREGROUND].value,
6262 foreground);
6263 if (fmt[XBM_BACKGROUND].count
6264 && STRINGP (fmt[XBM_BACKGROUND].value))
6265 background = x_alloc_image_color (f, img, fmt[XBM_BACKGROUND].value,
6266 background);
6268 if (in_memory_file_p)
6269 success_p = xbm_load_image (f, img, SDATA (data),
6270 (SDATA (data)
6271 + SBYTES (data)));
6272 else
6274 if (VECTORP (data))
6276 int i;
6277 char *p;
6278 int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
6280 p = bits = (char *) alloca (nbytes * img->height);
6281 for (i = 0; i < img->height; ++i, p += nbytes)
6283 Lisp_Object line = XVECTOR (data)->contents[i];
6284 if (STRINGP (line))
6285 bcopy (SDATA (line), p, nbytes);
6286 else
6287 bcopy (XBOOL_VECTOR (line)->data, p, nbytes);
6290 else if (STRINGP (data))
6291 bits = SDATA (data);
6292 else
6293 bits = XBOOL_VECTOR (data)->data;
6295 /* Create the pixmap. */
6296 depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
6297 img->pixmap
6298 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
6299 FRAME_X_WINDOW (f),
6300 bits,
6301 img->width, img->height,
6302 foreground, background,
6303 depth);
6304 if (img->pixmap)
6305 success_p = 1;
6306 else
6308 image_error ("Unable to create pixmap for XBM image `%s'",
6309 img->spec, Qnil);
6310 x_clear_image (f, img);
6315 return success_p;
6320 /***********************************************************************
6321 XPM images
6322 ***********************************************************************/
6324 #if HAVE_XPM
6326 static int xpm_image_p P_ ((Lisp_Object object));
6327 static int xpm_load P_ ((struct frame *f, struct image *img));
6328 static int xpm_valid_color_symbols_p P_ ((Lisp_Object));
6330 #include "X11/xpm.h"
6332 /* The symbol `xpm' identifying XPM-format images. */
6334 Lisp_Object Qxpm;
6336 /* Indices of image specification fields in xpm_format, below. */
6338 enum xpm_keyword_index
6340 XPM_TYPE,
6341 XPM_FILE,
6342 XPM_DATA,
6343 XPM_ASCENT,
6344 XPM_MARGIN,
6345 XPM_RELIEF,
6346 XPM_ALGORITHM,
6347 XPM_HEURISTIC_MASK,
6348 XPM_MASK,
6349 XPM_COLOR_SYMBOLS,
6350 XPM_BACKGROUND,
6351 XPM_LAST
6354 /* Vector of image_keyword structures describing the format
6355 of valid XPM image specifications. */
6357 static struct image_keyword xpm_format[XPM_LAST] =
6359 {":type", IMAGE_SYMBOL_VALUE, 1},
6360 {":file", IMAGE_STRING_VALUE, 0},
6361 {":data", IMAGE_STRING_VALUE, 0},
6362 {":ascent", IMAGE_ASCENT_VALUE, 0},
6363 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6364 {":relief", IMAGE_INTEGER_VALUE, 0},
6365 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6366 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6367 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6368 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6369 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
6372 /* Structure describing the image type XBM. */
6374 static struct image_type xpm_type =
6376 &Qxpm,
6377 xpm_image_p,
6378 xpm_load,
6379 x_clear_image,
6380 NULL
6384 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
6385 functions for allocating image colors. Our own functions handle
6386 color allocation failures more gracefully than the ones on the XPM
6387 lib. */
6389 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
6390 #define ALLOC_XPM_COLORS
6391 #endif
6393 #ifdef ALLOC_XPM_COLORS
6395 static void xpm_init_color_cache P_ ((struct frame *, XpmAttributes *));
6396 static void xpm_free_color_cache P_ ((void));
6397 static int xpm_lookup_color P_ ((struct frame *, char *, XColor *));
6398 static int xpm_color_bucket P_ ((char *));
6399 static struct xpm_cached_color *xpm_cache_color P_ ((struct frame *, char *,
6400 XColor *, int));
6402 /* An entry in a hash table used to cache color definitions of named
6403 colors. This cache is necessary to speed up XPM image loading in
6404 case we do color allocations ourselves. Without it, we would need
6405 a call to XParseColor per pixel in the image. */
6407 struct xpm_cached_color
6409 /* Next in collision chain. */
6410 struct xpm_cached_color *next;
6412 /* Color definition (RGB and pixel color). */
6413 XColor color;
6415 /* Color name. */
6416 char name[1];
6419 /* The hash table used for the color cache, and its bucket vector
6420 size. */
6422 #define XPM_COLOR_CACHE_BUCKETS 1001
6423 struct xpm_cached_color **xpm_color_cache;
6425 /* Initialize the color cache. */
6427 static void
6428 xpm_init_color_cache (f, attrs)
6429 struct frame *f;
6430 XpmAttributes *attrs;
6432 size_t nbytes = XPM_COLOR_CACHE_BUCKETS * sizeof *xpm_color_cache;
6433 xpm_color_cache = (struct xpm_cached_color **) xmalloc (nbytes);
6434 memset (xpm_color_cache, 0, nbytes);
6435 init_color_table ();
6437 if (attrs->valuemask & XpmColorSymbols)
6439 int i;
6440 XColor color;
6442 for (i = 0; i < attrs->numsymbols; ++i)
6443 if (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
6444 attrs->colorsymbols[i].value, &color))
6446 color.pixel = lookup_rgb_color (f, color.red, color.green,
6447 color.blue);
6448 xpm_cache_color (f, attrs->colorsymbols[i].name, &color, -1);
6454 /* Free the color cache. */
6456 static void
6457 xpm_free_color_cache ()
6459 struct xpm_cached_color *p, *next;
6460 int i;
6462 for (i = 0; i < XPM_COLOR_CACHE_BUCKETS; ++i)
6463 for (p = xpm_color_cache[i]; p; p = next)
6465 next = p->next;
6466 xfree (p);
6469 xfree (xpm_color_cache);
6470 xpm_color_cache = NULL;
6471 free_color_table ();
6475 /* Return the bucket index for color named COLOR_NAME in the color
6476 cache. */
6478 static int
6479 xpm_color_bucket (color_name)
6480 char *color_name;
6482 unsigned h = 0;
6483 char *s;
6485 for (s = color_name; *s; ++s)
6486 h = (h << 2) ^ *s;
6487 return h %= XPM_COLOR_CACHE_BUCKETS;
6491 /* On frame F, cache values COLOR for color with name COLOR_NAME.
6492 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
6493 entry added. */
6495 static struct xpm_cached_color *
6496 xpm_cache_color (f, color_name, color, bucket)
6497 struct frame *f;
6498 char *color_name;
6499 XColor *color;
6500 int bucket;
6502 size_t nbytes;
6503 struct xpm_cached_color *p;
6505 if (bucket < 0)
6506 bucket = xpm_color_bucket (color_name);
6508 nbytes = sizeof *p + strlen (color_name);
6509 p = (struct xpm_cached_color *) xmalloc (nbytes);
6510 strcpy (p->name, color_name);
6511 p->color = *color;
6512 p->next = xpm_color_cache[bucket];
6513 xpm_color_cache[bucket] = p;
6514 return p;
6518 /* Look up color COLOR_NAME for frame F in the color cache. If found,
6519 return the cached definition in *COLOR. Otherwise, make a new
6520 entry in the cache and allocate the color. Value is zero if color
6521 allocation failed. */
6523 static int
6524 xpm_lookup_color (f, color_name, color)
6525 struct frame *f;
6526 char *color_name;
6527 XColor *color;
6529 struct xpm_cached_color *p;
6530 int h = xpm_color_bucket (color_name);
6532 for (p = xpm_color_cache[h]; p; p = p->next)
6533 if (strcmp (p->name, color_name) == 0)
6534 break;
6536 if (p != NULL)
6537 *color = p->color;
6538 else if (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
6539 color_name, color))
6541 color->pixel = lookup_rgb_color (f, color->red, color->green,
6542 color->blue);
6543 p = xpm_cache_color (f, color_name, color, h);
6545 /* You get `opaque' at least from ImageMagick converting pbm to xpm
6546 with transparency, and it's useful. */
6547 else if (strcmp ("opaque", color_name) == 0)
6549 bzero (color, sizeof (XColor)); /* Is this necessary/correct? */
6550 color->pixel = FRAME_FOREGROUND_PIXEL (f);
6551 p = xpm_cache_color (f, color_name, color, h);
6554 return p != NULL;
6558 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
6559 CLOSURE is a pointer to the frame on which we allocate the
6560 color. Return in *COLOR the allocated color. Value is non-zero
6561 if successful. */
6563 static int
6564 xpm_alloc_color (dpy, cmap, color_name, color, closure)
6565 Display *dpy;
6566 Colormap cmap;
6567 char *color_name;
6568 XColor *color;
6569 void *closure;
6571 return xpm_lookup_color ((struct frame *) closure, color_name, color);
6575 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
6576 is a pointer to the frame on which we allocate the color. Value is
6577 non-zero if successful. */
6579 static int
6580 xpm_free_colors (dpy, cmap, pixels, npixels, closure)
6581 Display *dpy;
6582 Colormap cmap;
6583 Pixel *pixels;
6584 int npixels;
6585 void *closure;
6587 return 1;
6590 #endif /* ALLOC_XPM_COLORS */
6593 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
6594 for XPM images. Such a list must consist of conses whose car and
6595 cdr are strings. */
6597 static int
6598 xpm_valid_color_symbols_p (color_symbols)
6599 Lisp_Object color_symbols;
6601 while (CONSP (color_symbols))
6603 Lisp_Object sym = XCAR (color_symbols);
6604 if (!CONSP (sym)
6605 || !STRINGP (XCAR (sym))
6606 || !STRINGP (XCDR (sym)))
6607 break;
6608 color_symbols = XCDR (color_symbols);
6611 return NILP (color_symbols);
6615 /* Value is non-zero if OBJECT is a valid XPM image specification. */
6617 static int
6618 xpm_image_p (object)
6619 Lisp_Object object;
6621 struct image_keyword fmt[XPM_LAST];
6622 bcopy (xpm_format, fmt, sizeof fmt);
6623 return (parse_image_spec (object, fmt, XPM_LAST, Qxpm)
6624 /* Either `:file' or `:data' must be present. */
6625 && fmt[XPM_FILE].count + fmt[XPM_DATA].count == 1
6626 /* Either no `:color-symbols' or it's a list of conses
6627 whose car and cdr are strings. */
6628 && (fmt[XPM_COLOR_SYMBOLS].count == 0
6629 || xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value)));
6633 /* Load image IMG which will be displayed on frame F. Value is
6634 non-zero if successful. */
6636 static int
6637 xpm_load (f, img)
6638 struct frame *f;
6639 struct image *img;
6641 int rc;
6642 XpmAttributes attrs;
6643 Lisp_Object specified_file, color_symbols;
6645 /* Configure the XPM lib. Use the visual of frame F. Allocate
6646 close colors. Return colors allocated. */
6647 bzero (&attrs, sizeof attrs);
6648 attrs.visual = FRAME_X_VISUAL (f);
6649 attrs.colormap = FRAME_X_COLORMAP (f);
6650 attrs.valuemask |= XpmVisual;
6651 attrs.valuemask |= XpmColormap;
6653 #ifdef ALLOC_XPM_COLORS
6654 /* Allocate colors with our own functions which handle
6655 failing color allocation more gracefully. */
6656 attrs.color_closure = f;
6657 attrs.alloc_color = xpm_alloc_color;
6658 attrs.free_colors = xpm_free_colors;
6659 attrs.valuemask |= XpmAllocColor | XpmFreeColors | XpmColorClosure;
6660 #else /* not ALLOC_XPM_COLORS */
6661 /* Let the XPM lib allocate colors. */
6662 attrs.valuemask |= XpmReturnAllocPixels;
6663 #ifdef XpmAllocCloseColors
6664 attrs.alloc_close_colors = 1;
6665 attrs.valuemask |= XpmAllocCloseColors;
6666 #else /* not XpmAllocCloseColors */
6667 attrs.closeness = 600;
6668 attrs.valuemask |= XpmCloseness;
6669 #endif /* not XpmAllocCloseColors */
6670 #endif /* ALLOC_XPM_COLORS */
6672 /* If image specification contains symbolic color definitions, add
6673 these to `attrs'. */
6674 color_symbols = image_spec_value (img->spec, QCcolor_symbols, NULL);
6675 if (CONSP (color_symbols))
6677 Lisp_Object tail;
6678 XpmColorSymbol *xpm_syms;
6679 int i, size;
6681 attrs.valuemask |= XpmColorSymbols;
6683 /* Count number of symbols. */
6684 attrs.numsymbols = 0;
6685 for (tail = color_symbols; CONSP (tail); tail = XCDR (tail))
6686 ++attrs.numsymbols;
6688 /* Allocate an XpmColorSymbol array. */
6689 size = attrs.numsymbols * sizeof *xpm_syms;
6690 xpm_syms = (XpmColorSymbol *) alloca (size);
6691 bzero (xpm_syms, size);
6692 attrs.colorsymbols = xpm_syms;
6694 /* Fill the color symbol array. */
6695 for (tail = color_symbols, i = 0;
6696 CONSP (tail);
6697 ++i, tail = XCDR (tail))
6699 Lisp_Object name = XCAR (XCAR (tail));
6700 Lisp_Object color = XCDR (XCAR (tail));
6701 xpm_syms[i].name = (char *) alloca (SCHARS (name) + 1);
6702 strcpy (xpm_syms[i].name, SDATA (name));
6703 xpm_syms[i].value = (char *) alloca (SCHARS (color) + 1);
6704 strcpy (xpm_syms[i].value, SDATA (color));
6708 /* Create a pixmap for the image, either from a file, or from a
6709 string buffer containing data in the same format as an XPM file. */
6710 #ifdef ALLOC_XPM_COLORS
6711 xpm_init_color_cache (f, &attrs);
6712 #endif
6714 specified_file = image_spec_value (img->spec, QCfile, NULL);
6715 if (STRINGP (specified_file))
6717 Lisp_Object file = x_find_image_file (specified_file);
6718 if (!STRINGP (file))
6720 image_error ("Cannot find image file `%s'", specified_file, Qnil);
6721 return 0;
6724 rc = XpmReadFileToPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
6725 SDATA (file), &img->pixmap, &img->mask,
6726 &attrs);
6728 else
6730 Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL);
6731 rc = XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
6732 SDATA (buffer),
6733 &img->pixmap, &img->mask,
6734 &attrs);
6737 if (rc == XpmSuccess)
6739 #ifdef ALLOC_XPM_COLORS
6740 img->colors = colors_in_color_table (&img->ncolors);
6741 #else /* not ALLOC_XPM_COLORS */
6742 int i;
6744 img->ncolors = attrs.nalloc_pixels;
6745 img->colors = (unsigned long *) xmalloc (img->ncolors
6746 * sizeof *img->colors);
6747 for (i = 0; i < attrs.nalloc_pixels; ++i)
6749 img->colors[i] = attrs.alloc_pixels[i];
6750 #ifdef DEBUG_X_COLORS
6751 register_color (img->colors[i]);
6752 #endif
6754 #endif /* not ALLOC_XPM_COLORS */
6756 img->width = attrs.width;
6757 img->height = attrs.height;
6758 xassert (img->width > 0 && img->height > 0);
6760 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
6761 XpmFreeAttributes (&attrs);
6763 else
6765 switch (rc)
6767 case XpmOpenFailed:
6768 image_error ("Error opening XPM file (%s)", img->spec, Qnil);
6769 break;
6771 case XpmFileInvalid:
6772 image_error ("Invalid XPM file (%s)", img->spec, Qnil);
6773 break;
6775 case XpmNoMemory:
6776 image_error ("Out of memory (%s)", img->spec, Qnil);
6777 break;
6779 case XpmColorFailed:
6780 image_error ("Color allocation error (%s)", img->spec, Qnil);
6781 break;
6783 default:
6784 image_error ("Unknown error (%s)", img->spec, Qnil);
6785 break;
6789 #ifdef ALLOC_XPM_COLORS
6790 xpm_free_color_cache ();
6791 #endif
6792 return rc == XpmSuccess;
6795 #endif /* HAVE_XPM != 0 */
6798 /***********************************************************************
6799 Color table
6800 ***********************************************************************/
6802 /* An entry in the color table mapping an RGB color to a pixel color. */
6804 struct ct_color
6806 int r, g, b;
6807 unsigned long pixel;
6809 /* Next in color table collision list. */
6810 struct ct_color *next;
6813 /* The bucket vector size to use. Must be prime. */
6815 #define CT_SIZE 101
6817 /* Value is a hash of the RGB color given by R, G, and B. */
6819 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
6821 /* The color hash table. */
6823 struct ct_color **ct_table;
6825 /* Number of entries in the color table. */
6827 int ct_colors_allocated;
6829 /* Initialize the color table. */
6831 static void
6832 init_color_table ()
6834 int size = CT_SIZE * sizeof (*ct_table);
6835 ct_table = (struct ct_color **) xmalloc (size);
6836 bzero (ct_table, size);
6837 ct_colors_allocated = 0;
6841 /* Free memory associated with the color table. */
6843 static void
6844 free_color_table ()
6846 int i;
6847 struct ct_color *p, *next;
6849 for (i = 0; i < CT_SIZE; ++i)
6850 for (p = ct_table[i]; p; p = next)
6852 next = p->next;
6853 xfree (p);
6856 xfree (ct_table);
6857 ct_table = NULL;
6861 /* Value is a pixel color for RGB color R, G, B on frame F. If an
6862 entry for that color already is in the color table, return the
6863 pixel color of that entry. Otherwise, allocate a new color for R,
6864 G, B, and make an entry in the color table. */
6866 static unsigned long
6867 lookup_rgb_color (f, r, g, b)
6868 struct frame *f;
6869 int r, g, b;
6871 unsigned hash = CT_HASH_RGB (r, g, b);
6872 int i = hash % CT_SIZE;
6873 struct ct_color *p;
6874 struct x_display_info *dpyinfo;
6876 /* Handle TrueColor visuals specially, which improves performance by
6877 two orders of magnitude. Freeing colors on TrueColor visuals is
6878 a nop, and pixel colors specify RGB values directly. See also
6879 the Xlib spec, chapter 3.1. */
6880 dpyinfo = FRAME_X_DISPLAY_INFO (f);
6881 if (dpyinfo->red_bits > 0)
6883 unsigned long pr, pg, pb;
6885 /* Apply gamma-correction like normal color allocation does. */
6886 if (f->gamma)
6888 XColor color;
6889 color.red = r, color.green = g, color.blue = b;
6890 gamma_correct (f, &color);
6891 r = color.red, g = color.green, b = color.blue;
6894 /* Scale down RGB values to the visual's bits per RGB, and shift
6895 them to the right position in the pixel color. Note that the
6896 original RGB values are 16-bit values, as usual in X. */
6897 pr = (r >> (16 - dpyinfo->red_bits)) << dpyinfo->red_offset;
6898 pg = (g >> (16 - dpyinfo->green_bits)) << dpyinfo->green_offset;
6899 pb = (b >> (16 - dpyinfo->blue_bits)) << dpyinfo->blue_offset;
6901 /* Assemble the pixel color. */
6902 return pr | pg | pb;
6905 for (p = ct_table[i]; p; p = p->next)
6906 if (p->r == r && p->g == g && p->b == b)
6907 break;
6909 if (p == NULL)
6911 XColor color;
6912 Colormap cmap;
6913 int rc;
6915 color.red = r;
6916 color.green = g;
6917 color.blue = b;
6919 cmap = FRAME_X_COLORMAP (f);
6920 rc = x_alloc_nearest_color (f, cmap, &color);
6922 if (rc)
6924 ++ct_colors_allocated;
6926 p = (struct ct_color *) xmalloc (sizeof *p);
6927 p->r = r;
6928 p->g = g;
6929 p->b = b;
6930 p->pixel = color.pixel;
6931 p->next = ct_table[i];
6932 ct_table[i] = p;
6934 else
6935 return FRAME_FOREGROUND_PIXEL (f);
6938 return p->pixel;
6942 /* Look up pixel color PIXEL which is used on frame F in the color
6943 table. If not already present, allocate it. Value is PIXEL. */
6945 static unsigned long
6946 lookup_pixel_color (f, pixel)
6947 struct frame *f;
6948 unsigned long pixel;
6950 int i = pixel % CT_SIZE;
6951 struct ct_color *p;
6953 for (p = ct_table[i]; p; p = p->next)
6954 if (p->pixel == pixel)
6955 break;
6957 if (p == NULL)
6959 XColor color;
6960 Colormap cmap;
6961 int rc;
6963 cmap = FRAME_X_COLORMAP (f);
6964 color.pixel = pixel;
6965 x_query_color (f, &color);
6966 rc = x_alloc_nearest_color (f, cmap, &color);
6968 if (rc)
6970 ++ct_colors_allocated;
6972 p = (struct ct_color *) xmalloc (sizeof *p);
6973 p->r = color.red;
6974 p->g = color.green;
6975 p->b = color.blue;
6976 p->pixel = pixel;
6977 p->next = ct_table[i];
6978 ct_table[i] = p;
6980 else
6981 return FRAME_FOREGROUND_PIXEL (f);
6984 return p->pixel;
6988 /* Value is a vector of all pixel colors contained in the color table,
6989 allocated via xmalloc. Set *N to the number of colors. */
6991 static unsigned long *
6992 colors_in_color_table (n)
6993 int *n;
6995 int i, j;
6996 struct ct_color *p;
6997 unsigned long *colors;
6999 if (ct_colors_allocated == 0)
7001 *n = 0;
7002 colors = NULL;
7004 else
7006 colors = (unsigned long *) xmalloc (ct_colors_allocated
7007 * sizeof *colors);
7008 *n = ct_colors_allocated;
7010 for (i = j = 0; i < CT_SIZE; ++i)
7011 for (p = ct_table[i]; p; p = p->next)
7012 colors[j++] = p->pixel;
7015 return colors;
7020 /***********************************************************************
7021 Algorithms
7022 ***********************************************************************/
7024 static XColor *x_to_xcolors P_ ((struct frame *, struct image *, int));
7025 static void x_from_xcolors P_ ((struct frame *, struct image *, XColor *));
7026 static void x_detect_edges P_ ((struct frame *, struct image *, int[9], int));
7028 /* Non-zero means draw a cross on images having `:conversion
7029 disabled'. */
7031 int cross_disabled_images;
7033 /* Edge detection matrices for different edge-detection
7034 strategies. */
7036 static int emboss_matrix[9] = {
7037 /* x - 1 x x + 1 */
7038 2, -1, 0, /* y - 1 */
7039 -1, 0, 1, /* y */
7040 0, 1, -2 /* y + 1 */
7043 static int laplace_matrix[9] = {
7044 /* x - 1 x x + 1 */
7045 1, 0, 0, /* y - 1 */
7046 0, 0, 0, /* y */
7047 0, 0, -1 /* y + 1 */
7050 /* Value is the intensity of the color whose red/green/blue values
7051 are R, G, and B. */
7053 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7056 /* On frame F, return an array of XColor structures describing image
7057 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7058 non-zero means also fill the red/green/blue members of the XColor
7059 structures. Value is a pointer to the array of XColors structures,
7060 allocated with xmalloc; it must be freed by the caller. */
7062 static XColor *
7063 x_to_xcolors (f, img, rgb_p)
7064 struct frame *f;
7065 struct image *img;
7066 int rgb_p;
7068 int x, y;
7069 XColor *colors, *p;
7070 XImage *ximg;
7072 colors = (XColor *) xmalloc (img->width * img->height * sizeof *colors);
7074 /* Get the X image IMG->pixmap. */
7075 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
7076 0, 0, img->width, img->height, ~0, ZPixmap);
7078 /* Fill the `pixel' members of the XColor array. I wished there
7079 were an easy and portable way to circumvent XGetPixel. */
7080 p = colors;
7081 for (y = 0; y < img->height; ++y)
7083 XColor *row = p;
7085 for (x = 0; x < img->width; ++x, ++p)
7086 p->pixel = XGetPixel (ximg, x, y);
7088 if (rgb_p)
7089 x_query_colors (f, row, img->width);
7092 XDestroyImage (ximg);
7093 return colors;
7097 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7098 RGB members are set. F is the frame on which this all happens.
7099 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7101 static void
7102 x_from_xcolors (f, img, colors)
7103 struct frame *f;
7104 struct image *img;
7105 XColor *colors;
7107 int x, y;
7108 XImage *oimg;
7109 Pixmap pixmap;
7110 XColor *p;
7112 init_color_table ();
7114 x_create_x_image_and_pixmap (f, img->width, img->height, 0,
7115 &oimg, &pixmap);
7116 p = colors;
7117 for (y = 0; y < img->height; ++y)
7118 for (x = 0; x < img->width; ++x, ++p)
7120 unsigned long pixel;
7121 pixel = lookup_rgb_color (f, p->red, p->green, p->blue);
7122 XPutPixel (oimg, x, y, pixel);
7125 xfree (colors);
7126 x_clear_image_1 (f, img, 1, 0, 1);
7128 x_put_x_image (f, oimg, pixmap, img->width, img->height);
7129 x_destroy_x_image (oimg);
7130 img->pixmap = pixmap;
7131 img->colors = colors_in_color_table (&img->ncolors);
7132 free_color_table ();
7136 /* On frame F, perform edge-detection on image IMG.
7138 MATRIX is a nine-element array specifying the transformation
7139 matrix. See emboss_matrix for an example.
7141 COLOR_ADJUST is a color adjustment added to each pixel of the
7142 outgoing image. */
7144 static void
7145 x_detect_edges (f, img, matrix, color_adjust)
7146 struct frame *f;
7147 struct image *img;
7148 int matrix[9], color_adjust;
7150 XColor *colors = x_to_xcolors (f, img, 1);
7151 XColor *new, *p;
7152 int x, y, i, sum;
7154 for (i = sum = 0; i < 9; ++i)
7155 sum += abs (matrix[i]);
7157 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7159 new = (XColor *) xmalloc (img->width * img->height * sizeof *new);
7161 for (y = 0; y < img->height; ++y)
7163 p = COLOR (new, 0, y);
7164 p->red = p->green = p->blue = 0xffff/2;
7165 p = COLOR (new, img->width - 1, y);
7166 p->red = p->green = p->blue = 0xffff/2;
7169 for (x = 1; x < img->width - 1; ++x)
7171 p = COLOR (new, x, 0);
7172 p->red = p->green = p->blue = 0xffff/2;
7173 p = COLOR (new, x, img->height - 1);
7174 p->red = p->green = p->blue = 0xffff/2;
7177 for (y = 1; y < img->height - 1; ++y)
7179 p = COLOR (new, 1, y);
7181 for (x = 1; x < img->width - 1; ++x, ++p)
7183 int r, g, b, y1, x1;
7185 r = g = b = i = 0;
7186 for (y1 = y - 1; y1 < y + 2; ++y1)
7187 for (x1 = x - 1; x1 < x + 2; ++x1, ++i)
7188 if (matrix[i])
7190 XColor *t = COLOR (colors, x1, y1);
7191 r += matrix[i] * t->red;
7192 g += matrix[i] * t->green;
7193 b += matrix[i] * t->blue;
7196 r = (r / sum + color_adjust) & 0xffff;
7197 g = (g / sum + color_adjust) & 0xffff;
7198 b = (b / sum + color_adjust) & 0xffff;
7199 p->red = p->green = p->blue = COLOR_INTENSITY (r, g, b);
7203 xfree (colors);
7204 x_from_xcolors (f, img, new);
7206 #undef COLOR
7210 /* Perform the pre-defined `emboss' edge-detection on image IMG
7211 on frame F. */
7213 static void
7214 x_emboss (f, img)
7215 struct frame *f;
7216 struct image *img;
7218 x_detect_edges (f, img, emboss_matrix, 0xffff / 2);
7222 /* Perform the pre-defined `laplace' edge-detection on image IMG
7223 on frame F. */
7225 static void
7226 x_laplace (f, img)
7227 struct frame *f;
7228 struct image *img;
7230 x_detect_edges (f, img, laplace_matrix, 45000);
7234 /* Perform edge-detection on image IMG on frame F, with specified
7235 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7237 MATRIX must be either
7239 - a list of at least 9 numbers in row-major form
7240 - a vector of at least 9 numbers
7242 COLOR_ADJUST nil means use a default; otherwise it must be a
7243 number. */
7245 static void
7246 x_edge_detection (f, img, matrix, color_adjust)
7247 struct frame *f;
7248 struct image *img;
7249 Lisp_Object matrix, color_adjust;
7251 int i = 0;
7252 int trans[9];
7254 if (CONSP (matrix))
7256 for (i = 0;
7257 i < 9 && CONSP (matrix) && NUMBERP (XCAR (matrix));
7258 ++i, matrix = XCDR (matrix))
7259 trans[i] = XFLOATINT (XCAR (matrix));
7261 else if (VECTORP (matrix) && ASIZE (matrix) >= 9)
7263 for (i = 0; i < 9 && NUMBERP (AREF (matrix, i)); ++i)
7264 trans[i] = XFLOATINT (AREF (matrix, i));
7267 if (NILP (color_adjust))
7268 color_adjust = make_number (0xffff / 2);
7270 if (i == 9 && NUMBERP (color_adjust))
7271 x_detect_edges (f, img, trans, (int) XFLOATINT (color_adjust));
7275 /* Transform image IMG on frame F so that it looks disabled. */
7277 static void
7278 x_disable_image (f, img)
7279 struct frame *f;
7280 struct image *img;
7282 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
7284 if (dpyinfo->n_planes >= 2)
7286 /* Color (or grayscale). Convert to gray, and equalize. Just
7287 drawing such images with a stipple can look very odd, so
7288 we're using this method instead. */
7289 XColor *colors = x_to_xcolors (f, img, 1);
7290 XColor *p, *end;
7291 const int h = 15000;
7292 const int l = 30000;
7294 for (p = colors, end = colors + img->width * img->height;
7295 p < end;
7296 ++p)
7298 int i = COLOR_INTENSITY (p->red, p->green, p->blue);
7299 int i2 = (0xffff - h - l) * i / 0xffff + l;
7300 p->red = p->green = p->blue = i2;
7303 x_from_xcolors (f, img, colors);
7306 /* Draw a cross over the disabled image, if we must or if we
7307 should. */
7308 if (dpyinfo->n_planes < 2 || cross_disabled_images)
7310 Display *dpy = FRAME_X_DISPLAY (f);
7311 GC gc;
7313 gc = XCreateGC (dpy, img->pixmap, 0, NULL);
7314 XSetForeground (dpy, gc, BLACK_PIX_DEFAULT (f));
7315 XDrawLine (dpy, img->pixmap, gc, 0, 0,
7316 img->width - 1, img->height - 1);
7317 XDrawLine (dpy, img->pixmap, gc, 0, img->height - 1,
7318 img->width - 1, 0);
7319 XFreeGC (dpy, gc);
7321 if (img->mask)
7323 gc = XCreateGC (dpy, img->mask, 0, NULL);
7324 XSetForeground (dpy, gc, WHITE_PIX_DEFAULT (f));
7325 XDrawLine (dpy, img->mask, gc, 0, 0,
7326 img->width - 1, img->height - 1);
7327 XDrawLine (dpy, img->mask, gc, 0, img->height - 1,
7328 img->width - 1, 0);
7329 XFreeGC (dpy, gc);
7335 /* Build a mask for image IMG which is used on frame F. FILE is the
7336 name of an image file, for error messages. HOW determines how to
7337 determine the background color of IMG. If it is a list '(R G B)',
7338 with R, G, and B being integers >= 0, take that as the color of the
7339 background. Otherwise, determine the background color of IMG
7340 heuristically. Value is non-zero if successful. */
7342 static int
7343 x_build_heuristic_mask (f, img, how)
7344 struct frame *f;
7345 struct image *img;
7346 Lisp_Object how;
7348 Display *dpy = FRAME_X_DISPLAY (f);
7349 XImage *ximg, *mask_img;
7350 int x, y, rc, use_img_background;
7351 unsigned long bg = 0;
7353 if (img->mask)
7355 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
7356 img->mask = None;
7357 img->background_transparent_valid = 0;
7360 /* Create an image and pixmap serving as mask. */
7361 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1,
7362 &mask_img, &img->mask);
7363 if (!rc)
7364 return 0;
7366 /* Get the X image of IMG->pixmap. */
7367 ximg = XGetImage (dpy, img->pixmap, 0, 0, img->width, img->height,
7368 ~0, ZPixmap);
7370 /* Determine the background color of ximg. If HOW is `(R G B)'
7371 take that as color. Otherwise, use the image's background color. */
7372 use_img_background = 1;
7374 if (CONSP (how))
7376 int rgb[3], i;
7378 for (i = 0; i < 3 && CONSP (how) && NATNUMP (XCAR (how)); ++i)
7380 rgb[i] = XFASTINT (XCAR (how)) & 0xffff;
7381 how = XCDR (how);
7384 if (i == 3 && NILP (how))
7386 char color_name[30];
7387 sprintf (color_name, "#%04x%04x%04x", rgb[0], rgb[1], rgb[2]);
7388 bg = x_alloc_image_color (f, img, build_string (color_name), 0);
7389 use_img_background = 0;
7393 if (use_img_background)
7394 bg = four_corners_best (ximg, img->width, img->height);
7396 /* Set all bits in mask_img to 1 whose color in ximg is different
7397 from the background color bg. */
7398 for (y = 0; y < img->height; ++y)
7399 for (x = 0; x < img->width; ++x)
7400 XPutPixel (mask_img, x, y, XGetPixel (ximg, x, y) != bg);
7402 /* Fill in the background_transparent field while we have the mask handy. */
7403 image_background_transparent (img, f, mask_img);
7405 /* Put mask_img into img->mask. */
7406 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
7407 x_destroy_x_image (mask_img);
7408 XDestroyImage (ximg);
7410 return 1;
7415 /***********************************************************************
7416 PBM (mono, gray, color)
7417 ***********************************************************************/
7419 static int pbm_image_p P_ ((Lisp_Object object));
7420 static int pbm_load P_ ((struct frame *f, struct image *img));
7421 static int pbm_scan_number P_ ((unsigned char **, unsigned char *));
7423 /* The symbol `pbm' identifying images of this type. */
7425 Lisp_Object Qpbm;
7427 /* Indices of image specification fields in gs_format, below. */
7429 enum pbm_keyword_index
7431 PBM_TYPE,
7432 PBM_FILE,
7433 PBM_DATA,
7434 PBM_ASCENT,
7435 PBM_MARGIN,
7436 PBM_RELIEF,
7437 PBM_ALGORITHM,
7438 PBM_HEURISTIC_MASK,
7439 PBM_MASK,
7440 PBM_FOREGROUND,
7441 PBM_BACKGROUND,
7442 PBM_LAST
7445 /* Vector of image_keyword structures describing the format
7446 of valid user-defined image specifications. */
7448 static struct image_keyword pbm_format[PBM_LAST] =
7450 {":type", IMAGE_SYMBOL_VALUE, 1},
7451 {":file", IMAGE_STRING_VALUE, 0},
7452 {":data", IMAGE_STRING_VALUE, 0},
7453 {":ascent", IMAGE_ASCENT_VALUE, 0},
7454 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
7455 {":relief", IMAGE_INTEGER_VALUE, 0},
7456 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7457 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7458 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7459 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
7460 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
7463 /* Structure describing the image type `pbm'. */
7465 static struct image_type pbm_type =
7467 &Qpbm,
7468 pbm_image_p,
7469 pbm_load,
7470 x_clear_image,
7471 NULL
7475 /* Return non-zero if OBJECT is a valid PBM image specification. */
7477 static int
7478 pbm_image_p (object)
7479 Lisp_Object object;
7481 struct image_keyword fmt[PBM_LAST];
7483 bcopy (pbm_format, fmt, sizeof fmt);
7485 if (!parse_image_spec (object, fmt, PBM_LAST, Qpbm))
7486 return 0;
7488 /* Must specify either :data or :file. */
7489 return fmt[PBM_DATA].count + fmt[PBM_FILE].count == 1;
7493 /* Scan a decimal number from *S and return it. Advance *S while
7494 reading the number. END is the end of the string. Value is -1 at
7495 end of input. */
7497 static int
7498 pbm_scan_number (s, end)
7499 unsigned char **s, *end;
7501 int c = 0, val = -1;
7503 while (*s < end)
7505 /* Skip white-space. */
7506 while (*s < end && (c = *(*s)++, isspace (c)))
7509 if (c == '#')
7511 /* Skip comment to end of line. */
7512 while (*s < end && (c = *(*s)++, c != '\n'))
7515 else if (isdigit (c))
7517 /* Read decimal number. */
7518 val = c - '0';
7519 while (*s < end && (c = *(*s)++, isdigit (c)))
7520 val = 10 * val + c - '0';
7521 break;
7523 else
7524 break;
7527 return val;
7531 /* Load PBM image IMG for use on frame F. */
7533 static int
7534 pbm_load (f, img)
7535 struct frame *f;
7536 struct image *img;
7538 int raw_p, x, y;
7539 int width, height, max_color_idx = 0;
7540 XImage *ximg;
7541 Lisp_Object file, specified_file;
7542 enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type;
7543 struct gcpro gcpro1;
7544 unsigned char *contents = NULL;
7545 unsigned char *end, *p;
7546 int size;
7548 specified_file = image_spec_value (img->spec, QCfile, NULL);
7549 file = Qnil;
7550 GCPRO1 (file);
7552 if (STRINGP (specified_file))
7554 file = x_find_image_file (specified_file);
7555 if (!STRINGP (file))
7557 image_error ("Cannot find image file `%s'", specified_file, Qnil);
7558 UNGCPRO;
7559 return 0;
7562 contents = slurp_file (SDATA (file), &size);
7563 if (contents == NULL)
7565 image_error ("Error reading `%s'", file, Qnil);
7566 UNGCPRO;
7567 return 0;
7570 p = contents;
7571 end = contents + size;
7573 else
7575 Lisp_Object data;
7576 data = image_spec_value (img->spec, QCdata, NULL);
7577 p = SDATA (data);
7578 end = p + SBYTES (data);
7581 /* Check magic number. */
7582 if (end - p < 2 || *p++ != 'P')
7584 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
7585 error:
7586 xfree (contents);
7587 UNGCPRO;
7588 return 0;
7591 switch (*p++)
7593 case '1':
7594 raw_p = 0, type = PBM_MONO;
7595 break;
7597 case '2':
7598 raw_p = 0, type = PBM_GRAY;
7599 break;
7601 case '3':
7602 raw_p = 0, type = PBM_COLOR;
7603 break;
7605 case '4':
7606 raw_p = 1, type = PBM_MONO;
7607 break;
7609 case '5':
7610 raw_p = 1, type = PBM_GRAY;
7611 break;
7613 case '6':
7614 raw_p = 1, type = PBM_COLOR;
7615 break;
7617 default:
7618 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
7619 goto error;
7622 /* Read width, height, maximum color-component. Characters
7623 starting with `#' up to the end of a line are ignored. */
7624 width = pbm_scan_number (&p, end);
7625 height = pbm_scan_number (&p, end);
7627 if (type != PBM_MONO)
7629 max_color_idx = pbm_scan_number (&p, end);
7630 if (raw_p && max_color_idx > 255)
7631 max_color_idx = 255;
7634 if (width < 0
7635 || height < 0
7636 || (type != PBM_MONO && max_color_idx < 0))
7637 goto error;
7639 if (!x_create_x_image_and_pixmap (f, width, height, 0,
7640 &ximg, &img->pixmap))
7641 goto error;
7643 /* Initialize the color hash table. */
7644 init_color_table ();
7646 if (type == PBM_MONO)
7648 int c = 0, g;
7649 struct image_keyword fmt[PBM_LAST];
7650 unsigned long fg = FRAME_FOREGROUND_PIXEL (f);
7651 unsigned long bg = FRAME_BACKGROUND_PIXEL (f);
7653 /* Parse the image specification. */
7654 bcopy (pbm_format, fmt, sizeof fmt);
7655 parse_image_spec (img->spec, fmt, PBM_LAST, Qpbm);
7657 /* Get foreground and background colors, maybe allocate colors. */
7658 if (fmt[PBM_FOREGROUND].count
7659 && STRINGP (fmt[PBM_FOREGROUND].value))
7660 fg = x_alloc_image_color (f, img, fmt[PBM_FOREGROUND].value, fg);
7661 if (fmt[PBM_BACKGROUND].count
7662 && STRINGP (fmt[PBM_BACKGROUND].value))
7664 bg = x_alloc_image_color (f, img, fmt[PBM_BACKGROUND].value, bg);
7665 img->background = bg;
7666 img->background_valid = 1;
7669 for (y = 0; y < height; ++y)
7670 for (x = 0; x < width; ++x)
7672 if (raw_p)
7674 if ((x & 7) == 0)
7675 c = *p++;
7676 g = c & 0x80;
7677 c <<= 1;
7679 else
7680 g = pbm_scan_number (&p, end);
7682 XPutPixel (ximg, x, y, g ? fg : bg);
7685 else
7687 for (y = 0; y < height; ++y)
7688 for (x = 0; x < width; ++x)
7690 int r, g, b;
7692 if (type == PBM_GRAY)
7693 r = g = b = raw_p ? *p++ : pbm_scan_number (&p, end);
7694 else if (raw_p)
7696 r = *p++;
7697 g = *p++;
7698 b = *p++;
7700 else
7702 r = pbm_scan_number (&p, end);
7703 g = pbm_scan_number (&p, end);
7704 b = pbm_scan_number (&p, end);
7707 if (r < 0 || g < 0 || b < 0)
7709 xfree (ximg->data);
7710 ximg->data = NULL;
7711 XDestroyImage (ximg);
7712 image_error ("Invalid pixel value in image `%s'",
7713 img->spec, Qnil);
7714 goto error;
7717 /* RGB values are now in the range 0..max_color_idx.
7718 Scale this to the range 0..0xffff supported by X. */
7719 r = (double) r * 65535 / max_color_idx;
7720 g = (double) g * 65535 / max_color_idx;
7721 b = (double) b * 65535 / max_color_idx;
7722 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
7726 /* Store in IMG->colors the colors allocated for the image, and
7727 free the color table. */
7728 img->colors = colors_in_color_table (&img->ncolors);
7729 free_color_table ();
7731 /* Maybe fill in the background field while we have ximg handy. */
7732 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
7733 IMAGE_BACKGROUND (img, f, ximg);
7735 /* Put the image into a pixmap. */
7736 x_put_x_image (f, ximg, img->pixmap, width, height);
7737 x_destroy_x_image (ximg);
7739 img->width = width;
7740 img->height = height;
7742 UNGCPRO;
7743 xfree (contents);
7744 return 1;
7749 /***********************************************************************
7751 ***********************************************************************/
7753 #if HAVE_PNG
7755 #if defined HAVE_LIBPNG_PNG_H
7756 # include <libpng/png.h>
7757 #else
7758 # include <png.h>
7759 #endif
7761 /* Function prototypes. */
7763 static int png_image_p P_ ((Lisp_Object object));
7764 static int png_load P_ ((struct frame *f, struct image *img));
7766 /* The symbol `png' identifying images of this type. */
7768 Lisp_Object Qpng;
7770 /* Indices of image specification fields in png_format, below. */
7772 enum png_keyword_index
7774 PNG_TYPE,
7775 PNG_DATA,
7776 PNG_FILE,
7777 PNG_ASCENT,
7778 PNG_MARGIN,
7779 PNG_RELIEF,
7780 PNG_ALGORITHM,
7781 PNG_HEURISTIC_MASK,
7782 PNG_MASK,
7783 PNG_BACKGROUND,
7784 PNG_LAST
7787 /* Vector of image_keyword structures describing the format
7788 of valid user-defined image specifications. */
7790 static struct image_keyword png_format[PNG_LAST] =
7792 {":type", IMAGE_SYMBOL_VALUE, 1},
7793 {":data", IMAGE_STRING_VALUE, 0},
7794 {":file", IMAGE_STRING_VALUE, 0},
7795 {":ascent", IMAGE_ASCENT_VALUE, 0},
7796 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
7797 {":relief", IMAGE_INTEGER_VALUE, 0},
7798 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7799 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7800 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7801 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
7804 /* Structure describing the image type `png'. */
7806 static struct image_type png_type =
7808 &Qpng,
7809 png_image_p,
7810 png_load,
7811 x_clear_image,
7812 NULL
7816 /* Return non-zero if OBJECT is a valid PNG image specification. */
7818 static int
7819 png_image_p (object)
7820 Lisp_Object object;
7822 struct image_keyword fmt[PNG_LAST];
7823 bcopy (png_format, fmt, sizeof fmt);
7825 if (!parse_image_spec (object, fmt, PNG_LAST, Qpng))
7826 return 0;
7828 /* Must specify either the :data or :file keyword. */
7829 return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
7833 /* Error and warning handlers installed when the PNG library
7834 is initialized. */
7836 static void
7837 my_png_error (png_ptr, msg)
7838 png_struct *png_ptr;
7839 char *msg;
7841 xassert (png_ptr != NULL);
7842 image_error ("PNG error: %s", build_string (msg), Qnil);
7843 longjmp (png_ptr->jmpbuf, 1);
7847 static void
7848 my_png_warning (png_ptr, msg)
7849 png_struct *png_ptr;
7850 char *msg;
7852 xassert (png_ptr != NULL);
7853 image_error ("PNG warning: %s", build_string (msg), Qnil);
7856 /* Memory source for PNG decoding. */
7858 struct png_memory_storage
7860 unsigned char *bytes; /* The data */
7861 size_t len; /* How big is it? */
7862 int index; /* Where are we? */
7866 /* Function set as reader function when reading PNG image from memory.
7867 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
7868 bytes from the input to DATA. */
7870 static void
7871 png_read_from_memory (png_ptr, data, length)
7872 png_structp png_ptr;
7873 png_bytep data;
7874 png_size_t length;
7876 struct png_memory_storage *tbr
7877 = (struct png_memory_storage *) png_get_io_ptr (png_ptr);
7879 if (length > tbr->len - tbr->index)
7880 png_error (png_ptr, "Read error");
7882 bcopy (tbr->bytes + tbr->index, data, length);
7883 tbr->index = tbr->index + length;
7886 /* Load PNG image IMG for use on frame F. Value is non-zero if
7887 successful. */
7889 static int
7890 png_load (f, img)
7891 struct frame *f;
7892 struct image *img;
7894 Lisp_Object file, specified_file;
7895 Lisp_Object specified_data;
7896 int x, y, i;
7897 XImage *ximg, *mask_img = NULL;
7898 struct gcpro gcpro1;
7899 png_struct *png_ptr = NULL;
7900 png_info *info_ptr = NULL, *end_info = NULL;
7901 FILE *volatile fp = NULL;
7902 png_byte sig[8];
7903 png_byte * volatile pixels = NULL;
7904 png_byte ** volatile rows = NULL;
7905 png_uint_32 width, height;
7906 int bit_depth, color_type, interlace_type;
7907 png_byte channels;
7908 png_uint_32 row_bytes;
7909 int transparent_p;
7910 double screen_gamma;
7911 struct png_memory_storage tbr; /* Data to be read */
7913 /* Find out what file to load. */
7914 specified_file = image_spec_value (img->spec, QCfile, NULL);
7915 specified_data = image_spec_value (img->spec, QCdata, NULL);
7916 file = Qnil;
7917 GCPRO1 (file);
7919 if (NILP (specified_data))
7921 file = x_find_image_file (specified_file);
7922 if (!STRINGP (file))
7924 image_error ("Cannot find image file `%s'", specified_file, Qnil);
7925 UNGCPRO;
7926 return 0;
7929 /* Open the image file. */
7930 fp = fopen (SDATA (file), "rb");
7931 if (!fp)
7933 image_error ("Cannot open image file `%s'", file, Qnil);
7934 UNGCPRO;
7935 fclose (fp);
7936 return 0;
7939 /* Check PNG signature. */
7940 if (fread (sig, 1, sizeof sig, fp) != sizeof sig
7941 || !png_check_sig (sig, sizeof sig))
7943 image_error ("Not a PNG file: `%s'", file, Qnil);
7944 UNGCPRO;
7945 fclose (fp);
7946 return 0;
7949 else
7951 /* Read from memory. */
7952 tbr.bytes = SDATA (specified_data);
7953 tbr.len = SBYTES (specified_data);
7954 tbr.index = 0;
7956 /* Check PNG signature. */
7957 if (tbr.len < sizeof sig
7958 || !png_check_sig (tbr.bytes, sizeof sig))
7960 image_error ("Not a PNG image: `%s'", img->spec, Qnil);
7961 UNGCPRO;
7962 return 0;
7965 /* Need to skip past the signature. */
7966 tbr.bytes += sizeof (sig);
7969 /* Initialize read and info structs for PNG lib. */
7970 png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL,
7971 my_png_error, my_png_warning);
7972 if (!png_ptr)
7974 if (fp) fclose (fp);
7975 UNGCPRO;
7976 return 0;
7979 info_ptr = png_create_info_struct (png_ptr);
7980 if (!info_ptr)
7982 png_destroy_read_struct (&png_ptr, NULL, NULL);
7983 if (fp) fclose (fp);
7984 UNGCPRO;
7985 return 0;
7988 end_info = png_create_info_struct (png_ptr);
7989 if (!end_info)
7991 png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
7992 if (fp) fclose (fp);
7993 UNGCPRO;
7994 return 0;
7997 /* Set error jump-back. We come back here when the PNG library
7998 detects an error. */
7999 if (setjmp (png_ptr->jmpbuf))
8001 error:
8002 if (png_ptr)
8003 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
8004 xfree (pixels);
8005 xfree (rows);
8006 if (fp) fclose (fp);
8007 UNGCPRO;
8008 return 0;
8011 /* Read image info. */
8012 if (!NILP (specified_data))
8013 png_set_read_fn (png_ptr, (void *) &tbr, png_read_from_memory);
8014 else
8015 png_init_io (png_ptr, fp);
8017 png_set_sig_bytes (png_ptr, sizeof sig);
8018 png_read_info (png_ptr, info_ptr);
8019 png_get_IHDR (png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
8020 &interlace_type, NULL, NULL);
8022 /* If image contains simply transparency data, we prefer to
8023 construct a clipping mask. */
8024 if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
8025 transparent_p = 1;
8026 else
8027 transparent_p = 0;
8029 /* This function is easier to write if we only have to handle
8030 one data format: RGB or RGBA with 8 bits per channel. Let's
8031 transform other formats into that format. */
8033 /* Strip more than 8 bits per channel. */
8034 if (bit_depth == 16)
8035 png_set_strip_16 (png_ptr);
8037 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8038 if available. */
8039 png_set_expand (png_ptr);
8041 /* Convert grayscale images to RGB. */
8042 if (color_type == PNG_COLOR_TYPE_GRAY
8043 || color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
8044 png_set_gray_to_rgb (png_ptr);
8046 screen_gamma = (f->gamma ? 1 / f->gamma / 0.45455 : 2.2);
8048 #if 0 /* Avoid double gamma correction for PNG images. */
8049 { /* Tell the PNG lib to handle gamma correction for us. */
8050 int intent;
8051 double image_gamma;
8052 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8053 if (png_get_sRGB (png_ptr, info_ptr, &intent))
8054 /* The libpng documentation says this is right in this case. */
8055 png_set_gamma (png_ptr, screen_gamma, 0.45455);
8056 else
8057 #endif
8058 if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
8059 /* Image contains gamma information. */
8060 png_set_gamma (png_ptr, screen_gamma, image_gamma);
8061 else
8062 /* Use the standard default for the image gamma. */
8063 png_set_gamma (png_ptr, screen_gamma, 0.45455);
8065 #endif /* if 0 */
8067 /* Handle alpha channel by combining the image with a background
8068 color. Do this only if a real alpha channel is supplied. For
8069 simple transparency, we prefer a clipping mask. */
8070 if (!transparent_p)
8072 png_color_16 *image_bg;
8073 Lisp_Object specified_bg
8074 = image_spec_value (img->spec, QCbackground, NULL);
8076 if (STRINGP (specified_bg))
8077 /* The user specified `:background', use that. */
8079 XColor color;
8080 if (x_defined_color (f, SDATA (specified_bg), &color, 0))
8082 png_color_16 user_bg;
8084 bzero (&user_bg, sizeof user_bg);
8085 user_bg.red = color.red;
8086 user_bg.green = color.green;
8087 user_bg.blue = color.blue;
8089 png_set_background (png_ptr, &user_bg,
8090 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
8093 else if (png_get_bKGD (png_ptr, info_ptr, &image_bg))
8094 /* Image contains a background color with which to
8095 combine the image. */
8096 png_set_background (png_ptr, image_bg,
8097 PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
8098 else
8100 /* Image does not contain a background color with which
8101 to combine the image data via an alpha channel. Use
8102 the frame's background instead. */
8103 XColor color;
8104 Colormap cmap;
8105 png_color_16 frame_background;
8107 cmap = FRAME_X_COLORMAP (f);
8108 color.pixel = FRAME_BACKGROUND_PIXEL (f);
8109 x_query_color (f, &color);
8111 bzero (&frame_background, sizeof frame_background);
8112 frame_background.red = color.red;
8113 frame_background.green = color.green;
8114 frame_background.blue = color.blue;
8116 png_set_background (png_ptr, &frame_background,
8117 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
8121 /* Update info structure. */
8122 png_read_update_info (png_ptr, info_ptr);
8124 /* Get number of channels. Valid values are 1 for grayscale images
8125 and images with a palette, 2 for grayscale images with transparency
8126 information (alpha channel), 3 for RGB images, and 4 for RGB
8127 images with alpha channel, i.e. RGBA. If conversions above were
8128 sufficient we should only have 3 or 4 channels here. */
8129 channels = png_get_channels (png_ptr, info_ptr);
8130 xassert (channels == 3 || channels == 4);
8132 /* Number of bytes needed for one row of the image. */
8133 row_bytes = png_get_rowbytes (png_ptr, info_ptr);
8135 /* Allocate memory for the image. */
8136 pixels = (png_byte *) xmalloc (row_bytes * height * sizeof *pixels);
8137 rows = (png_byte **) xmalloc (height * sizeof *rows);
8138 for (i = 0; i < height; ++i)
8139 rows[i] = pixels + i * row_bytes;
8141 /* Read the entire image. */
8142 png_read_image (png_ptr, rows);
8143 png_read_end (png_ptr, info_ptr);
8144 if (fp)
8146 fclose (fp);
8147 fp = NULL;
8150 /* Create the X image and pixmap. */
8151 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
8152 &img->pixmap))
8153 goto error;
8155 /* Create an image and pixmap serving as mask if the PNG image
8156 contains an alpha channel. */
8157 if (channels == 4
8158 && !transparent_p
8159 && !x_create_x_image_and_pixmap (f, width, height, 1,
8160 &mask_img, &img->mask))
8162 x_destroy_x_image (ximg);
8163 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
8164 img->pixmap = None;
8165 goto error;
8168 /* Fill the X image and mask from PNG data. */
8169 init_color_table ();
8171 for (y = 0; y < height; ++y)
8173 png_byte *p = rows[y];
8175 for (x = 0; x < width; ++x)
8177 unsigned r, g, b;
8179 r = *p++ << 8;
8180 g = *p++ << 8;
8181 b = *p++ << 8;
8182 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
8184 /* An alpha channel, aka mask channel, associates variable
8185 transparency with an image. Where other image formats
8186 support binary transparency---fully transparent or fully
8187 opaque---PNG allows up to 254 levels of partial transparency.
8188 The PNG library implements partial transparency by combining
8189 the image with a specified background color.
8191 I'm not sure how to handle this here nicely: because the
8192 background on which the image is displayed may change, for
8193 real alpha channel support, it would be necessary to create
8194 a new image for each possible background.
8196 What I'm doing now is that a mask is created if we have
8197 boolean transparency information. Otherwise I'm using
8198 the frame's background color to combine the image with. */
8200 if (channels == 4)
8202 if (mask_img)
8203 XPutPixel (mask_img, x, y, *p > 0);
8204 ++p;
8209 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
8210 /* Set IMG's background color from the PNG image, unless the user
8211 overrode it. */
8213 png_color_16 *bg;
8214 if (png_get_bKGD (png_ptr, info_ptr, &bg))
8216 img->background = lookup_rgb_color (f, bg->red, bg->green, bg->blue);
8217 img->background_valid = 1;
8221 /* Remember colors allocated for this image. */
8222 img->colors = colors_in_color_table (&img->ncolors);
8223 free_color_table ();
8225 /* Clean up. */
8226 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
8227 xfree (rows);
8228 xfree (pixels);
8230 img->width = width;
8231 img->height = height;
8233 /* Maybe fill in the background field while we have ximg handy. */
8234 IMAGE_BACKGROUND (img, f, ximg);
8236 /* Put the image into the pixmap, then free the X image and its buffer. */
8237 x_put_x_image (f, ximg, img->pixmap, width, height);
8238 x_destroy_x_image (ximg);
8240 /* Same for the mask. */
8241 if (mask_img)
8243 /* Fill in the background_transparent field while we have the mask
8244 handy. */
8245 image_background_transparent (img, f, mask_img);
8247 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
8248 x_destroy_x_image (mask_img);
8251 UNGCPRO;
8252 return 1;
8255 #endif /* HAVE_PNG != 0 */
8259 /***********************************************************************
8260 JPEG
8261 ***********************************************************************/
8263 #if HAVE_JPEG
8265 /* Work around a warning about HAVE_STDLIB_H being redefined in
8266 jconfig.h. */
8267 #ifdef HAVE_STDLIB_H
8268 #define HAVE_STDLIB_H_1
8269 #undef HAVE_STDLIB_H
8270 #endif /* HAVE_STLIB_H */
8272 #include <jpeglib.h>
8273 #include <jerror.h>
8274 #include <setjmp.h>
8276 #ifdef HAVE_STLIB_H_1
8277 #define HAVE_STDLIB_H 1
8278 #endif
8280 static int jpeg_image_p P_ ((Lisp_Object object));
8281 static int jpeg_load P_ ((struct frame *f, struct image *img));
8283 /* The symbol `jpeg' identifying images of this type. */
8285 Lisp_Object Qjpeg;
8287 /* Indices of image specification fields in gs_format, below. */
8289 enum jpeg_keyword_index
8291 JPEG_TYPE,
8292 JPEG_DATA,
8293 JPEG_FILE,
8294 JPEG_ASCENT,
8295 JPEG_MARGIN,
8296 JPEG_RELIEF,
8297 JPEG_ALGORITHM,
8298 JPEG_HEURISTIC_MASK,
8299 JPEG_MASK,
8300 JPEG_BACKGROUND,
8301 JPEG_LAST
8304 /* Vector of image_keyword structures describing the format
8305 of valid user-defined image specifications. */
8307 static struct image_keyword jpeg_format[JPEG_LAST] =
8309 {":type", IMAGE_SYMBOL_VALUE, 1},
8310 {":data", IMAGE_STRING_VALUE, 0},
8311 {":file", IMAGE_STRING_VALUE, 0},
8312 {":ascent", IMAGE_ASCENT_VALUE, 0},
8313 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
8314 {":relief", IMAGE_INTEGER_VALUE, 0},
8315 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8316 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8317 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8318 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
8321 /* Structure describing the image type `jpeg'. */
8323 static struct image_type jpeg_type =
8325 &Qjpeg,
8326 jpeg_image_p,
8327 jpeg_load,
8328 x_clear_image,
8329 NULL
8333 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8335 static int
8336 jpeg_image_p (object)
8337 Lisp_Object object;
8339 struct image_keyword fmt[JPEG_LAST];
8341 bcopy (jpeg_format, fmt, sizeof fmt);
8343 if (!parse_image_spec (object, fmt, JPEG_LAST, Qjpeg))
8344 return 0;
8346 /* Must specify either the :data or :file keyword. */
8347 return fmt[JPEG_FILE].count + fmt[JPEG_DATA].count == 1;
8351 struct my_jpeg_error_mgr
8353 struct jpeg_error_mgr pub;
8354 jmp_buf setjmp_buffer;
8358 static void
8359 my_error_exit (cinfo)
8360 j_common_ptr cinfo;
8362 struct my_jpeg_error_mgr *mgr = (struct my_jpeg_error_mgr *) cinfo->err;
8363 longjmp (mgr->setjmp_buffer, 1);
8367 /* Init source method for JPEG data source manager. Called by
8368 jpeg_read_header() before any data is actually read. See
8369 libjpeg.doc from the JPEG lib distribution. */
8371 static void
8372 our_init_source (cinfo)
8373 j_decompress_ptr cinfo;
8378 /* Fill input buffer method for JPEG data source manager. Called
8379 whenever more data is needed. We read the whole image in one step,
8380 so this only adds a fake end of input marker at the end. */
8382 static boolean
8383 our_fill_input_buffer (cinfo)
8384 j_decompress_ptr cinfo;
8386 /* Insert a fake EOI marker. */
8387 struct jpeg_source_mgr *src = cinfo->src;
8388 static JOCTET buffer[2];
8390 buffer[0] = (JOCTET) 0xFF;
8391 buffer[1] = (JOCTET) JPEG_EOI;
8393 src->next_input_byte = buffer;
8394 src->bytes_in_buffer = 2;
8395 return TRUE;
8399 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8400 is the JPEG data source manager. */
8402 static void
8403 our_skip_input_data (cinfo, num_bytes)
8404 j_decompress_ptr cinfo;
8405 long num_bytes;
8407 struct jpeg_source_mgr *src = (struct jpeg_source_mgr *) cinfo->src;
8409 if (src)
8411 if (num_bytes > src->bytes_in_buffer)
8412 ERREXIT (cinfo, JERR_INPUT_EOF);
8414 src->bytes_in_buffer -= num_bytes;
8415 src->next_input_byte += num_bytes;
8420 /* Method to terminate data source. Called by
8421 jpeg_finish_decompress() after all data has been processed. */
8423 static void
8424 our_term_source (cinfo)
8425 j_decompress_ptr cinfo;
8430 /* Set up the JPEG lib for reading an image from DATA which contains
8431 LEN bytes. CINFO is the decompression info structure created for
8432 reading the image. */
8434 static void
8435 jpeg_memory_src (cinfo, data, len)
8436 j_decompress_ptr cinfo;
8437 JOCTET *data;
8438 unsigned int len;
8440 struct jpeg_source_mgr *src;
8442 if (cinfo->src == NULL)
8444 /* First time for this JPEG object? */
8445 cinfo->src = (struct jpeg_source_mgr *)
8446 (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,
8447 sizeof (struct jpeg_source_mgr));
8448 src = (struct jpeg_source_mgr *) cinfo->src;
8449 src->next_input_byte = data;
8452 src = (struct jpeg_source_mgr *) cinfo->src;
8453 src->init_source = our_init_source;
8454 src->fill_input_buffer = our_fill_input_buffer;
8455 src->skip_input_data = our_skip_input_data;
8456 src->resync_to_restart = jpeg_resync_to_restart; /* Use default method. */
8457 src->term_source = our_term_source;
8458 src->bytes_in_buffer = len;
8459 src->next_input_byte = data;
8463 /* Load image IMG for use on frame F. Patterned after example.c
8464 from the JPEG lib. */
8466 static int
8467 jpeg_load (f, img)
8468 struct frame *f;
8469 struct image *img;
8471 struct jpeg_decompress_struct cinfo;
8472 struct my_jpeg_error_mgr mgr;
8473 Lisp_Object file, specified_file;
8474 Lisp_Object specified_data;
8475 FILE * volatile fp = NULL;
8476 JSAMPARRAY buffer;
8477 int row_stride, x, y;
8478 XImage *ximg = NULL;
8479 int rc;
8480 unsigned long *colors;
8481 int width, height;
8482 struct gcpro gcpro1;
8484 /* Open the JPEG file. */
8485 specified_file = image_spec_value (img->spec, QCfile, NULL);
8486 specified_data = image_spec_value (img->spec, QCdata, NULL);
8487 file = Qnil;
8488 GCPRO1 (file);
8490 if (NILP (specified_data))
8492 file = x_find_image_file (specified_file);
8493 if (!STRINGP (file))
8495 image_error ("Cannot find image file `%s'", specified_file, Qnil);
8496 UNGCPRO;
8497 return 0;
8500 fp = fopen (SDATA (file), "r");
8501 if (fp == NULL)
8503 image_error ("Cannot open `%s'", file, Qnil);
8504 UNGCPRO;
8505 return 0;
8509 /* Customize libjpeg's error handling to call my_error_exit when an
8510 error is detected. This function will perform a longjmp. */
8511 cinfo.err = jpeg_std_error (&mgr.pub);
8512 mgr.pub.error_exit = my_error_exit;
8514 if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
8516 if (rc == 1)
8518 /* Called from my_error_exit. Display a JPEG error. */
8519 char buffer[JMSG_LENGTH_MAX];
8520 cinfo.err->format_message ((j_common_ptr) &cinfo, buffer);
8521 image_error ("Error reading JPEG image `%s': %s", img->spec,
8522 build_string (buffer));
8525 /* Close the input file and destroy the JPEG object. */
8526 if (fp)
8527 fclose ((FILE *) fp);
8528 jpeg_destroy_decompress (&cinfo);
8530 /* If we already have an XImage, free that. */
8531 x_destroy_x_image (ximg);
8533 /* Free pixmap and colors. */
8534 x_clear_image (f, img);
8536 UNGCPRO;
8537 return 0;
8540 /* Create the JPEG decompression object. Let it read from fp.
8541 Read the JPEG image header. */
8542 jpeg_create_decompress (&cinfo);
8544 if (NILP (specified_data))
8545 jpeg_stdio_src (&cinfo, (FILE *) fp);
8546 else
8547 jpeg_memory_src (&cinfo, SDATA (specified_data),
8548 SBYTES (specified_data));
8550 jpeg_read_header (&cinfo, TRUE);
8552 /* Customize decompression so that color quantization will be used.
8553 Start decompression. */
8554 cinfo.quantize_colors = TRUE;
8555 jpeg_start_decompress (&cinfo);
8556 width = img->width = cinfo.output_width;
8557 height = img->height = cinfo.output_height;
8559 /* Create X image and pixmap. */
8560 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
8561 longjmp (mgr.setjmp_buffer, 2);
8563 /* Allocate colors. When color quantization is used,
8564 cinfo.actual_number_of_colors has been set with the number of
8565 colors generated, and cinfo.colormap is a two-dimensional array
8566 of color indices in the range 0..cinfo.actual_number_of_colors.
8567 No more than 255 colors will be generated. */
8569 int i, ir, ig, ib;
8571 if (cinfo.out_color_components > 2)
8572 ir = 0, ig = 1, ib = 2;
8573 else if (cinfo.out_color_components > 1)
8574 ir = 0, ig = 1, ib = 0;
8575 else
8576 ir = 0, ig = 0, ib = 0;
8578 /* Use the color table mechanism because it handles colors that
8579 cannot be allocated nicely. Such colors will be replaced with
8580 a default color, and we don't have to care about which colors
8581 can be freed safely, and which can't. */
8582 init_color_table ();
8583 colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
8584 * sizeof *colors);
8586 for (i = 0; i < cinfo.actual_number_of_colors; ++i)
8588 /* Multiply RGB values with 255 because X expects RGB values
8589 in the range 0..0xffff. */
8590 int r = cinfo.colormap[ir][i] << 8;
8591 int g = cinfo.colormap[ig][i] << 8;
8592 int b = cinfo.colormap[ib][i] << 8;
8593 colors[i] = lookup_rgb_color (f, r, g, b);
8596 /* Remember those colors actually allocated. */
8597 img->colors = colors_in_color_table (&img->ncolors);
8598 free_color_table ();
8601 /* Read pixels. */
8602 row_stride = width * cinfo.output_components;
8603 buffer = cinfo.mem->alloc_sarray ((j_common_ptr) &cinfo, JPOOL_IMAGE,
8604 row_stride, 1);
8605 for (y = 0; y < height; ++y)
8607 jpeg_read_scanlines (&cinfo, buffer, 1);
8608 for (x = 0; x < cinfo.output_width; ++x)
8609 XPutPixel (ximg, x, y, colors[buffer[0][x]]);
8612 /* Clean up. */
8613 jpeg_finish_decompress (&cinfo);
8614 jpeg_destroy_decompress (&cinfo);
8615 if (fp)
8616 fclose ((FILE *) fp);
8618 /* Maybe fill in the background field while we have ximg handy. */
8619 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
8620 IMAGE_BACKGROUND (img, f, ximg);
8622 /* Put the image into the pixmap. */
8623 x_put_x_image (f, ximg, img->pixmap, width, height);
8624 x_destroy_x_image (ximg);
8625 UNGCPRO;
8626 return 1;
8629 #endif /* HAVE_JPEG */
8633 /***********************************************************************
8634 TIFF
8635 ***********************************************************************/
8637 #if HAVE_TIFF
8639 #include <tiffio.h>
8641 static int tiff_image_p P_ ((Lisp_Object object));
8642 static int tiff_load P_ ((struct frame *f, struct image *img));
8644 /* The symbol `tiff' identifying images of this type. */
8646 Lisp_Object Qtiff;
8648 /* Indices of image specification fields in tiff_format, below. */
8650 enum tiff_keyword_index
8652 TIFF_TYPE,
8653 TIFF_DATA,
8654 TIFF_FILE,
8655 TIFF_ASCENT,
8656 TIFF_MARGIN,
8657 TIFF_RELIEF,
8658 TIFF_ALGORITHM,
8659 TIFF_HEURISTIC_MASK,
8660 TIFF_MASK,
8661 TIFF_BACKGROUND,
8662 TIFF_LAST
8665 /* Vector of image_keyword structures describing the format
8666 of valid user-defined image specifications. */
8668 static struct image_keyword tiff_format[TIFF_LAST] =
8670 {":type", IMAGE_SYMBOL_VALUE, 1},
8671 {":data", IMAGE_STRING_VALUE, 0},
8672 {":file", IMAGE_STRING_VALUE, 0},
8673 {":ascent", IMAGE_ASCENT_VALUE, 0},
8674 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
8675 {":relief", IMAGE_INTEGER_VALUE, 0},
8676 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8677 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8678 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8679 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
8682 /* Structure describing the image type `tiff'. */
8684 static struct image_type tiff_type =
8686 &Qtiff,
8687 tiff_image_p,
8688 tiff_load,
8689 x_clear_image,
8690 NULL
8694 /* Return non-zero if OBJECT is a valid TIFF image specification. */
8696 static int
8697 tiff_image_p (object)
8698 Lisp_Object object;
8700 struct image_keyword fmt[TIFF_LAST];
8701 bcopy (tiff_format, fmt, sizeof fmt);
8703 if (!parse_image_spec (object, fmt, TIFF_LAST, Qtiff))
8704 return 0;
8706 /* Must specify either the :data or :file keyword. */
8707 return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
8711 /* Reading from a memory buffer for TIFF images Based on the PNG
8712 memory source, but we have to provide a lot of extra functions.
8713 Blah.
8715 We really only need to implement read and seek, but I am not
8716 convinced that the TIFF library is smart enough not to destroy
8717 itself if we only hand it the function pointers we need to
8718 override. */
8720 typedef struct
8722 unsigned char *bytes;
8723 size_t len;
8724 int index;
8726 tiff_memory_source;
8729 static size_t
8730 tiff_read_from_memory (data, buf, size)
8731 thandle_t data;
8732 tdata_t buf;
8733 tsize_t size;
8735 tiff_memory_source *src = (tiff_memory_source *) data;
8737 if (size > src->len - src->index)
8738 return (size_t) -1;
8739 bcopy (src->bytes + src->index, buf, size);
8740 src->index += size;
8741 return size;
8745 static size_t
8746 tiff_write_from_memory (data, buf, size)
8747 thandle_t data;
8748 tdata_t buf;
8749 tsize_t size;
8751 return (size_t) -1;
8755 static toff_t
8756 tiff_seek_in_memory (data, off, whence)
8757 thandle_t data;
8758 toff_t off;
8759 int whence;
8761 tiff_memory_source *src = (tiff_memory_source *) data;
8762 int idx;
8764 switch (whence)
8766 case SEEK_SET: /* Go from beginning of source. */
8767 idx = off;
8768 break;
8770 case SEEK_END: /* Go from end of source. */
8771 idx = src->len + off;
8772 break;
8774 case SEEK_CUR: /* Go from current position. */
8775 idx = src->index + off;
8776 break;
8778 default: /* Invalid `whence'. */
8779 return -1;
8782 if (idx > src->len || idx < 0)
8783 return -1;
8785 src->index = idx;
8786 return src->index;
8790 static int
8791 tiff_close_memory (data)
8792 thandle_t data;
8794 /* NOOP */
8795 return 0;
8799 static int
8800 tiff_mmap_memory (data, pbase, psize)
8801 thandle_t data;
8802 tdata_t *pbase;
8803 toff_t *psize;
8805 /* It is already _IN_ memory. */
8806 return 0;
8810 static void
8811 tiff_unmap_memory (data, base, size)
8812 thandle_t data;
8813 tdata_t base;
8814 toff_t size;
8816 /* We don't need to do this. */
8820 static toff_t
8821 tiff_size_of_memory (data)
8822 thandle_t data;
8824 return ((tiff_memory_source *) data)->len;
8828 static void
8829 tiff_error_handler (title, format, ap)
8830 const char *title, *format;
8831 va_list ap;
8833 char buf[512];
8834 int len;
8836 len = sprintf (buf, "TIFF error: %s ", title);
8837 vsprintf (buf + len, format, ap);
8838 add_to_log (buf, Qnil, Qnil);
8842 static void
8843 tiff_warning_handler (title, format, ap)
8844 const char *title, *format;
8845 va_list ap;
8847 char buf[512];
8848 int len;
8850 len = sprintf (buf, "TIFF warning: %s ", title);
8851 vsprintf (buf + len, format, ap);
8852 add_to_log (buf, Qnil, Qnil);
8856 /* Load TIFF image IMG for use on frame F. Value is non-zero if
8857 successful. */
8859 static int
8860 tiff_load (f, img)
8861 struct frame *f;
8862 struct image *img;
8864 Lisp_Object file, specified_file;
8865 Lisp_Object specified_data;
8866 TIFF *tiff;
8867 int width, height, x, y;
8868 uint32 *buf;
8869 int rc;
8870 XImage *ximg;
8871 struct gcpro gcpro1;
8872 tiff_memory_source memsrc;
8874 specified_file = image_spec_value (img->spec, QCfile, NULL);
8875 specified_data = image_spec_value (img->spec, QCdata, NULL);
8876 file = Qnil;
8877 GCPRO1 (file);
8879 TIFFSetErrorHandler (tiff_error_handler);
8880 TIFFSetWarningHandler (tiff_warning_handler);
8882 if (NILP (specified_data))
8884 /* Read from a file */
8885 file = x_find_image_file (specified_file);
8886 if (!STRINGP (file))
8888 image_error ("Cannot find image file `%s'", file, Qnil);
8889 UNGCPRO;
8890 return 0;
8893 /* Try to open the image file. */
8894 tiff = TIFFOpen (SDATA (file), "r");
8895 if (tiff == NULL)
8897 image_error ("Cannot open `%s'", file, Qnil);
8898 UNGCPRO;
8899 return 0;
8902 else
8904 /* Memory source! */
8905 memsrc.bytes = SDATA (specified_data);
8906 memsrc.len = SBYTES (specified_data);
8907 memsrc.index = 0;
8909 tiff = TIFFClientOpen ("memory_source", "r", &memsrc,
8910 (TIFFReadWriteProc) tiff_read_from_memory,
8911 (TIFFReadWriteProc) tiff_write_from_memory,
8912 tiff_seek_in_memory,
8913 tiff_close_memory,
8914 tiff_size_of_memory,
8915 tiff_mmap_memory,
8916 tiff_unmap_memory);
8918 if (!tiff)
8920 image_error ("Cannot open memory source for `%s'", img->spec, Qnil);
8921 UNGCPRO;
8922 return 0;
8926 /* Get width and height of the image, and allocate a raster buffer
8927 of width x height 32-bit values. */
8928 TIFFGetField (tiff, TIFFTAG_IMAGEWIDTH, &width);
8929 TIFFGetField (tiff, TIFFTAG_IMAGELENGTH, &height);
8930 buf = (uint32 *) xmalloc (width * height * sizeof *buf);
8932 rc = TIFFReadRGBAImage (tiff, width, height, buf, 0);
8933 TIFFClose (tiff);
8934 if (!rc)
8936 image_error ("Error reading TIFF image `%s'", img->spec, Qnil);
8937 xfree (buf);
8938 UNGCPRO;
8939 return 0;
8942 /* Create the X image and pixmap. */
8943 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
8945 xfree (buf);
8946 UNGCPRO;
8947 return 0;
8950 /* Initialize the color table. */
8951 init_color_table ();
8953 /* Process the pixel raster. Origin is in the lower-left corner. */
8954 for (y = 0; y < height; ++y)
8956 uint32 *row = buf + y * width;
8958 for (x = 0; x < width; ++x)
8960 uint32 abgr = row[x];
8961 int r = TIFFGetR (abgr) << 8;
8962 int g = TIFFGetG (abgr) << 8;
8963 int b = TIFFGetB (abgr) << 8;
8964 XPutPixel (ximg, x, height - 1 - y, lookup_rgb_color (f, r, g, b));
8968 /* Remember the colors allocated for the image. Free the color table. */
8969 img->colors = colors_in_color_table (&img->ncolors);
8970 free_color_table ();
8972 img->width = width;
8973 img->height = height;
8975 /* Maybe fill in the background field while we have ximg handy. */
8976 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
8977 IMAGE_BACKGROUND (img, f, ximg);
8979 /* Put the image into the pixmap, then free the X image and its buffer. */
8980 x_put_x_image (f, ximg, img->pixmap, width, height);
8981 x_destroy_x_image (ximg);
8982 xfree (buf);
8984 UNGCPRO;
8985 return 1;
8988 #endif /* HAVE_TIFF != 0 */
8992 /***********************************************************************
8994 ***********************************************************************/
8996 #if HAVE_GIF
8998 #include <gif_lib.h>
9000 static int gif_image_p P_ ((Lisp_Object object));
9001 static int gif_load P_ ((struct frame *f, struct image *img));
9003 /* The symbol `gif' identifying images of this type. */
9005 Lisp_Object Qgif;
9007 /* Indices of image specification fields in gif_format, below. */
9009 enum gif_keyword_index
9011 GIF_TYPE,
9012 GIF_DATA,
9013 GIF_FILE,
9014 GIF_ASCENT,
9015 GIF_MARGIN,
9016 GIF_RELIEF,
9017 GIF_ALGORITHM,
9018 GIF_HEURISTIC_MASK,
9019 GIF_MASK,
9020 GIF_IMAGE,
9021 GIF_BACKGROUND,
9022 GIF_LAST
9025 /* Vector of image_keyword structures describing the format
9026 of valid user-defined image specifications. */
9028 static struct image_keyword gif_format[GIF_LAST] =
9030 {":type", IMAGE_SYMBOL_VALUE, 1},
9031 {":data", IMAGE_STRING_VALUE, 0},
9032 {":file", IMAGE_STRING_VALUE, 0},
9033 {":ascent", IMAGE_ASCENT_VALUE, 0},
9034 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
9035 {":relief", IMAGE_INTEGER_VALUE, 0},
9036 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9037 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9038 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9039 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
9040 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
9043 /* Structure describing the image type `gif'. */
9045 static struct image_type gif_type =
9047 &Qgif,
9048 gif_image_p,
9049 gif_load,
9050 x_clear_image,
9051 NULL
9055 /* Return non-zero if OBJECT is a valid GIF image specification. */
9057 static int
9058 gif_image_p (object)
9059 Lisp_Object object;
9061 struct image_keyword fmt[GIF_LAST];
9062 bcopy (gif_format, fmt, sizeof fmt);
9064 if (!parse_image_spec (object, fmt, GIF_LAST, Qgif))
9065 return 0;
9067 /* Must specify either the :data or :file keyword. */
9068 return fmt[GIF_FILE].count + fmt[GIF_DATA].count == 1;
9072 /* Reading a GIF image from memory
9073 Based on the PNG memory stuff to a certain extent. */
9075 typedef struct
9077 unsigned char *bytes;
9078 size_t len;
9079 int index;
9081 gif_memory_source;
9084 /* Make the current memory source available to gif_read_from_memory.
9085 It's done this way because not all versions of libungif support
9086 a UserData field in the GifFileType structure. */
9087 static gif_memory_source *current_gif_memory_src;
9089 static int
9090 gif_read_from_memory (file, buf, len)
9091 GifFileType *file;
9092 GifByteType *buf;
9093 int len;
9095 gif_memory_source *src = current_gif_memory_src;
9097 if (len > src->len - src->index)
9098 return -1;
9100 bcopy (src->bytes + src->index, buf, len);
9101 src->index += len;
9102 return len;
9106 /* Load GIF image IMG for use on frame F. Value is non-zero if
9107 successful. */
9109 static int
9110 gif_load (f, img)
9111 struct frame *f;
9112 struct image *img;
9114 Lisp_Object file, specified_file;
9115 Lisp_Object specified_data;
9116 int rc, width, height, x, y, i;
9117 XImage *ximg;
9118 ColorMapObject *gif_color_map;
9119 unsigned long pixel_colors[256];
9120 GifFileType *gif;
9121 struct gcpro gcpro1;
9122 Lisp_Object image;
9123 int ino, image_left, image_top, image_width, image_height;
9124 gif_memory_source memsrc;
9125 unsigned char *raster;
9127 specified_file = image_spec_value (img->spec, QCfile, NULL);
9128 specified_data = image_spec_value (img->spec, QCdata, NULL);
9129 file = Qnil;
9130 GCPRO1 (file);
9132 if (NILP (specified_data))
9134 file = x_find_image_file (specified_file);
9135 if (!STRINGP (file))
9137 image_error ("Cannot find image file `%s'", specified_file, Qnil);
9138 UNGCPRO;
9139 return 0;
9142 /* Open the GIF file. */
9143 gif = DGifOpenFileName (SDATA (file));
9144 if (gif == NULL)
9146 image_error ("Cannot open `%s'", file, Qnil);
9147 UNGCPRO;
9148 return 0;
9151 else
9153 /* Read from memory! */
9154 current_gif_memory_src = &memsrc;
9155 memsrc.bytes = SDATA (specified_data);
9156 memsrc.len = SBYTES (specified_data);
9157 memsrc.index = 0;
9159 gif = DGifOpen(&memsrc, gif_read_from_memory);
9160 if (!gif)
9162 image_error ("Cannot open memory source `%s'", img->spec, Qnil);
9163 UNGCPRO;
9164 return 0;
9168 /* Read entire contents. */
9169 rc = DGifSlurp (gif);
9170 if (rc == GIF_ERROR)
9172 image_error ("Error reading `%s'", img->spec, Qnil);
9173 DGifCloseFile (gif);
9174 UNGCPRO;
9175 return 0;
9178 image = image_spec_value (img->spec, QCindex, NULL);
9179 ino = INTEGERP (image) ? XFASTINT (image) : 0;
9180 if (ino >= gif->ImageCount)
9182 image_error ("Invalid image number `%s' in image `%s'",
9183 image, img->spec);
9184 DGifCloseFile (gif);
9185 UNGCPRO;
9186 return 0;
9189 width = img->width = max (gif->SWidth, gif->Image.Left + gif->Image.Width);
9190 height = img->height = max (gif->SHeight, gif->Image.Top + gif->Image.Height);
9192 /* Create the X image and pixmap. */
9193 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
9195 DGifCloseFile (gif);
9196 UNGCPRO;
9197 return 0;
9200 /* Allocate colors. */
9201 gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap;
9202 if (!gif_color_map)
9203 gif_color_map = gif->SColorMap;
9204 init_color_table ();
9205 bzero (pixel_colors, sizeof pixel_colors);
9207 for (i = 0; i < gif_color_map->ColorCount; ++i)
9209 int r = gif_color_map->Colors[i].Red << 8;
9210 int g = gif_color_map->Colors[i].Green << 8;
9211 int b = gif_color_map->Colors[i].Blue << 8;
9212 pixel_colors[i] = lookup_rgb_color (f, r, g, b);
9215 img->colors = colors_in_color_table (&img->ncolors);
9216 free_color_table ();
9218 /* Clear the part of the screen image that are not covered by
9219 the image from the GIF file. Full animated GIF support
9220 requires more than can be done here (see the gif89 spec,
9221 disposal methods). Let's simply assume that the part
9222 not covered by a sub-image is in the frame's background color. */
9223 image_top = gif->SavedImages[ino].ImageDesc.Top;
9224 image_left = gif->SavedImages[ino].ImageDesc.Left;
9225 image_width = gif->SavedImages[ino].ImageDesc.Width;
9226 image_height = gif->SavedImages[ino].ImageDesc.Height;
9228 for (y = 0; y < image_top; ++y)
9229 for (x = 0; x < width; ++x)
9230 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9232 for (y = image_top + image_height; y < height; ++y)
9233 for (x = 0; x < width; ++x)
9234 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9236 for (y = image_top; y < image_top + image_height; ++y)
9238 for (x = 0; x < image_left; ++x)
9239 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9240 for (x = image_left + image_width; x < width; ++x)
9241 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9244 /* Read the GIF image into the X image. We use a local variable
9245 `raster' here because RasterBits below is a char *, and invites
9246 problems with bytes >= 0x80. */
9247 raster = (unsigned char *) gif->SavedImages[ino].RasterBits;
9249 if (gif->SavedImages[ino].ImageDesc.Interlace)
9251 static int interlace_start[] = {0, 4, 2, 1};
9252 static int interlace_increment[] = {8, 8, 4, 2};
9253 int pass;
9254 int row = interlace_start[0];
9256 pass = 0;
9258 for (y = 0; y < image_height; y++)
9260 if (row >= image_height)
9262 row = interlace_start[++pass];
9263 while (row >= image_height)
9264 row = interlace_start[++pass];
9267 for (x = 0; x < image_width; x++)
9269 int i = raster[(y * image_width) + x];
9270 XPutPixel (ximg, x + image_left, row + image_top,
9271 pixel_colors[i]);
9274 row += interlace_increment[pass];
9277 else
9279 for (y = 0; y < image_height; ++y)
9280 for (x = 0; x < image_width; ++x)
9282 int i = raster[y * image_width + x];
9283 XPutPixel (ximg, x + image_left, y + image_top, pixel_colors[i]);
9287 DGifCloseFile (gif);
9289 /* Maybe fill in the background field while we have ximg handy. */
9290 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
9291 IMAGE_BACKGROUND (img, f, ximg);
9293 /* Put the image into the pixmap, then free the X image and its buffer. */
9294 x_put_x_image (f, ximg, img->pixmap, width, height);
9295 x_destroy_x_image (ximg);
9297 UNGCPRO;
9298 return 1;
9301 #endif /* HAVE_GIF != 0 */
9305 /***********************************************************************
9306 Ghostscript
9307 ***********************************************************************/
9309 static int gs_image_p P_ ((Lisp_Object object));
9310 static int gs_load P_ ((struct frame *f, struct image *img));
9311 static void gs_clear_image P_ ((struct frame *f, struct image *img));
9313 /* The symbol `postscript' identifying images of this type. */
9315 Lisp_Object Qpostscript;
9317 /* Keyword symbols. */
9319 Lisp_Object QCloader, QCbounding_box, QCpt_width, QCpt_height;
9321 /* Indices of image specification fields in gs_format, below. */
9323 enum gs_keyword_index
9325 GS_TYPE,
9326 GS_PT_WIDTH,
9327 GS_PT_HEIGHT,
9328 GS_FILE,
9329 GS_LOADER,
9330 GS_BOUNDING_BOX,
9331 GS_ASCENT,
9332 GS_MARGIN,
9333 GS_RELIEF,
9334 GS_ALGORITHM,
9335 GS_HEURISTIC_MASK,
9336 GS_MASK,
9337 GS_BACKGROUND,
9338 GS_LAST
9341 /* Vector of image_keyword structures describing the format
9342 of valid user-defined image specifications. */
9344 static struct image_keyword gs_format[GS_LAST] =
9346 {":type", IMAGE_SYMBOL_VALUE, 1},
9347 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE, 1},
9348 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE, 1},
9349 {":file", IMAGE_STRING_VALUE, 1},
9350 {":loader", IMAGE_FUNCTION_VALUE, 0},
9351 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE, 1},
9352 {":ascent", IMAGE_ASCENT_VALUE, 0},
9353 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
9354 {":relief", IMAGE_INTEGER_VALUE, 0},
9355 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9356 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9357 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9358 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
9361 /* Structure describing the image type `ghostscript'. */
9363 static struct image_type gs_type =
9365 &Qpostscript,
9366 gs_image_p,
9367 gs_load,
9368 gs_clear_image,
9369 NULL
9373 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9375 static void
9376 gs_clear_image (f, img)
9377 struct frame *f;
9378 struct image *img;
9380 /* IMG->data.ptr_val may contain a recorded colormap. */
9381 xfree (img->data.ptr_val);
9382 x_clear_image (f, img);
9386 /* Return non-zero if OBJECT is a valid Ghostscript image
9387 specification. */
9389 static int
9390 gs_image_p (object)
9391 Lisp_Object object;
9393 struct image_keyword fmt[GS_LAST];
9394 Lisp_Object tem;
9395 int i;
9397 bcopy (gs_format, fmt, sizeof fmt);
9399 if (!parse_image_spec (object, fmt, GS_LAST, Qpostscript))
9400 return 0;
9402 /* Bounding box must be a list or vector containing 4 integers. */
9403 tem = fmt[GS_BOUNDING_BOX].value;
9404 if (CONSP (tem))
9406 for (i = 0; i < 4; ++i, tem = XCDR (tem))
9407 if (!CONSP (tem) || !INTEGERP (XCAR (tem)))
9408 return 0;
9409 if (!NILP (tem))
9410 return 0;
9412 else if (VECTORP (tem))
9414 if (XVECTOR (tem)->size != 4)
9415 return 0;
9416 for (i = 0; i < 4; ++i)
9417 if (!INTEGERP (XVECTOR (tem)->contents[i]))
9418 return 0;
9420 else
9421 return 0;
9423 return 1;
9427 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9428 if successful. */
9430 static int
9431 gs_load (f, img)
9432 struct frame *f;
9433 struct image *img;
9435 char buffer[100];
9436 Lisp_Object window_and_pixmap_id = Qnil, loader, pt_height, pt_width;
9437 struct gcpro gcpro1, gcpro2;
9438 Lisp_Object frame;
9439 double in_width, in_height;
9440 Lisp_Object pixel_colors = Qnil;
9442 /* Compute pixel size of pixmap needed from the given size in the
9443 image specification. Sizes in the specification are in pt. 1 pt
9444 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9445 info. */
9446 pt_width = image_spec_value (img->spec, QCpt_width, NULL);
9447 in_width = XFASTINT (pt_width) / 72.0;
9448 img->width = in_width * FRAME_X_DISPLAY_INFO (f)->resx;
9449 pt_height = image_spec_value (img->spec, QCpt_height, NULL);
9450 in_height = XFASTINT (pt_height) / 72.0;
9451 img->height = in_height * FRAME_X_DISPLAY_INFO (f)->resy;
9453 /* Create the pixmap. */
9454 xassert (img->pixmap == None);
9455 img->pixmap = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9456 img->width, img->height,
9457 DefaultDepthOfScreen (FRAME_X_SCREEN (f)));
9459 if (!img->pixmap)
9461 image_error ("Unable to create pixmap for `%s'", img->spec, Qnil);
9462 return 0;
9465 /* Call the loader to fill the pixmap. It returns a process object
9466 if successful. We do not record_unwind_protect here because
9467 other places in redisplay like calling window scroll functions
9468 don't either. Let the Lisp loader use `unwind-protect' instead. */
9469 GCPRO2 (window_and_pixmap_id, pixel_colors);
9471 sprintf (buffer, "%lu %lu",
9472 (unsigned long) FRAME_X_WINDOW (f),
9473 (unsigned long) img->pixmap);
9474 window_and_pixmap_id = build_string (buffer);
9476 sprintf (buffer, "%lu %lu",
9477 FRAME_FOREGROUND_PIXEL (f),
9478 FRAME_BACKGROUND_PIXEL (f));
9479 pixel_colors = build_string (buffer);
9481 XSETFRAME (frame, f);
9482 loader = image_spec_value (img->spec, QCloader, NULL);
9483 if (NILP (loader))
9484 loader = intern ("gs-load-image");
9486 img->data.lisp_val = call6 (loader, frame, img->spec,
9487 make_number (img->width),
9488 make_number (img->height),
9489 window_and_pixmap_id,
9490 pixel_colors);
9491 UNGCPRO;
9492 return PROCESSP (img->data.lisp_val);
9496 /* Kill the Ghostscript process that was started to fill PIXMAP on
9497 frame F. Called from XTread_socket when receiving an event
9498 telling Emacs that Ghostscript has finished drawing. */
9500 void
9501 x_kill_gs_process (pixmap, f)
9502 Pixmap pixmap;
9503 struct frame *f;
9505 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
9506 int class, i;
9507 struct image *img;
9509 /* Find the image containing PIXMAP. */
9510 for (i = 0; i < c->used; ++i)
9511 if (c->images[i]->pixmap == pixmap)
9512 break;
9514 /* Should someone in between have cleared the image cache, for
9515 instance, give up. */
9516 if (i == c->used)
9517 return;
9519 /* Kill the GS process. We should have found PIXMAP in the image
9520 cache and its image should contain a process object. */
9521 img = c->images[i];
9522 xassert (PROCESSP (img->data.lisp_val));
9523 Fkill_process (img->data.lisp_val, Qnil);
9524 img->data.lisp_val = Qnil;
9526 /* On displays with a mutable colormap, figure out the colors
9527 allocated for the image by looking at the pixels of an XImage for
9528 img->pixmap. */
9529 class = FRAME_X_VISUAL (f)->class;
9530 if (class != StaticColor && class != StaticGray && class != TrueColor)
9532 XImage *ximg;
9534 BLOCK_INPUT;
9536 /* Try to get an XImage for img->pixmep. */
9537 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
9538 0, 0, img->width, img->height, ~0, ZPixmap);
9539 if (ximg)
9541 int x, y;
9543 /* Initialize the color table. */
9544 init_color_table ();
9546 /* For each pixel of the image, look its color up in the
9547 color table. After having done so, the color table will
9548 contain an entry for each color used by the image. */
9549 for (y = 0; y < img->height; ++y)
9550 for (x = 0; x < img->width; ++x)
9552 unsigned long pixel = XGetPixel (ximg, x, y);
9553 lookup_pixel_color (f, pixel);
9556 /* Record colors in the image. Free color table and XImage. */
9557 img->colors = colors_in_color_table (&img->ncolors);
9558 free_color_table ();
9559 XDestroyImage (ximg);
9561 #if 0 /* This doesn't seem to be the case. If we free the colors
9562 here, we get a BadAccess later in x_clear_image when
9563 freeing the colors. */
9564 /* We have allocated colors once, but Ghostscript has also
9565 allocated colors on behalf of us. So, to get the
9566 reference counts right, free them once. */
9567 if (img->ncolors)
9568 x_free_colors (f, img->colors, img->ncolors);
9569 #endif
9571 else
9572 image_error ("Cannot get X image of `%s'; colors will not be freed",
9573 img->spec, Qnil);
9575 UNBLOCK_INPUT;
9578 /* Now that we have the pixmap, compute mask and transform the
9579 image if requested. */
9580 BLOCK_INPUT;
9581 postprocess_image (f, img);
9582 UNBLOCK_INPUT;
9587 /***********************************************************************
9588 Window properties
9589 ***********************************************************************/
9591 DEFUN ("x-change-window-property", Fx_change_window_property,
9592 Sx_change_window_property, 2, 3, 0,
9593 doc: /* Change window property PROP to VALUE on the X window of FRAME.
9594 PROP and VALUE must be strings. FRAME nil or omitted means use the
9595 selected frame. Value is VALUE. */)
9596 (prop, value, frame)
9597 Lisp_Object frame, prop, value;
9599 struct frame *f = check_x_frame (frame);
9600 Atom prop_atom;
9602 CHECK_STRING (prop);
9603 CHECK_STRING (value);
9605 BLOCK_INPUT;
9606 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
9607 XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9608 prop_atom, XA_STRING, 8, PropModeReplace,
9609 SDATA (value), SCHARS (value));
9611 /* Make sure the property is set when we return. */
9612 XFlush (FRAME_X_DISPLAY (f));
9613 UNBLOCK_INPUT;
9615 return value;
9619 DEFUN ("x-delete-window-property", Fx_delete_window_property,
9620 Sx_delete_window_property, 1, 2, 0,
9621 doc: /* Remove window property PROP from X window of FRAME.
9622 FRAME nil or omitted means use the selected frame. Value is PROP. */)
9623 (prop, frame)
9624 Lisp_Object prop, frame;
9626 struct frame *f = check_x_frame (frame);
9627 Atom prop_atom;
9629 CHECK_STRING (prop);
9630 BLOCK_INPUT;
9631 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
9632 XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), prop_atom);
9634 /* Make sure the property is removed when we return. */
9635 XFlush (FRAME_X_DISPLAY (f));
9636 UNBLOCK_INPUT;
9638 return prop;
9642 DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
9643 1, 2, 0,
9644 doc: /* Value is the value of window property PROP on FRAME.
9645 If FRAME is nil or omitted, use the selected frame. Value is nil
9646 if FRAME hasn't a property with name PROP or if PROP has no string
9647 value. */)
9648 (prop, frame)
9649 Lisp_Object prop, frame;
9651 struct frame *f = check_x_frame (frame);
9652 Atom prop_atom;
9653 int rc;
9654 Lisp_Object prop_value = Qnil;
9655 char *tmp_data = NULL;
9656 Atom actual_type;
9657 int actual_format;
9658 unsigned long actual_size, bytes_remaining;
9660 CHECK_STRING (prop);
9661 BLOCK_INPUT;
9662 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
9663 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9664 prop_atom, 0, 0, False, XA_STRING,
9665 &actual_type, &actual_format, &actual_size,
9666 &bytes_remaining, (unsigned char **) &tmp_data);
9667 if (rc == Success)
9669 int size = bytes_remaining;
9671 XFree (tmp_data);
9672 tmp_data = NULL;
9674 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9675 prop_atom, 0, bytes_remaining,
9676 False, XA_STRING,
9677 &actual_type, &actual_format,
9678 &actual_size, &bytes_remaining,
9679 (unsigned char **) &tmp_data);
9680 if (rc == Success && tmp_data)
9681 prop_value = make_string (tmp_data, size);
9683 XFree (tmp_data);
9686 UNBLOCK_INPUT;
9687 return prop_value;
9692 /***********************************************************************
9693 Busy cursor
9694 ***********************************************************************/
9696 /* If non-null, an asynchronous timer that, when it expires, displays
9697 an hourglass cursor on all frames. */
9699 static struct atimer *hourglass_atimer;
9701 /* Non-zero means an hourglass cursor is currently shown. */
9703 static int hourglass_shown_p;
9705 /* Number of seconds to wait before displaying an hourglass cursor. */
9707 static Lisp_Object Vhourglass_delay;
9709 /* Default number of seconds to wait before displaying an hourglass
9710 cursor. */
9712 #define DEFAULT_HOURGLASS_DELAY 1
9714 /* Function prototypes. */
9716 static void show_hourglass P_ ((struct atimer *));
9717 static void hide_hourglass P_ ((void));
9720 /* Cancel a currently active hourglass timer, and start a new one. */
9722 void
9723 start_hourglass ()
9725 EMACS_TIME delay;
9726 int secs, usecs = 0;
9728 cancel_hourglass ();
9730 if (INTEGERP (Vhourglass_delay)
9731 && XINT (Vhourglass_delay) > 0)
9732 secs = XFASTINT (Vhourglass_delay);
9733 else if (FLOATP (Vhourglass_delay)
9734 && XFLOAT_DATA (Vhourglass_delay) > 0)
9736 Lisp_Object tem;
9737 tem = Ftruncate (Vhourglass_delay, Qnil);
9738 secs = XFASTINT (tem);
9739 usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
9741 else
9742 secs = DEFAULT_HOURGLASS_DELAY;
9744 EMACS_SET_SECS_USECS (delay, secs, usecs);
9745 hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
9746 show_hourglass, NULL);
9750 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
9751 shown. */
9753 void
9754 cancel_hourglass ()
9756 if (hourglass_atimer)
9758 cancel_atimer (hourglass_atimer);
9759 hourglass_atimer = NULL;
9762 if (hourglass_shown_p)
9763 hide_hourglass ();
9767 /* Timer function of hourglass_atimer. TIMER is equal to
9768 hourglass_atimer.
9770 Display an hourglass pointer on all frames by mapping the frames'
9771 hourglass_window. Set the hourglass_p flag in the frames'
9772 output_data.x structure to indicate that an hourglass cursor is
9773 shown on the frames. */
9775 static void
9776 show_hourglass (timer)
9777 struct atimer *timer;
9779 /* The timer implementation will cancel this timer automatically
9780 after this function has run. Set hourglass_atimer to null
9781 so that we know the timer doesn't have to be canceled. */
9782 hourglass_atimer = NULL;
9784 if (!hourglass_shown_p)
9786 Lisp_Object rest, frame;
9788 BLOCK_INPUT;
9790 FOR_EACH_FRAME (rest, frame)
9792 struct frame *f = XFRAME (frame);
9794 if (FRAME_LIVE_P (f) && FRAME_X_P (f) && FRAME_X_DISPLAY (f))
9796 Display *dpy = FRAME_X_DISPLAY (f);
9798 #ifdef USE_X_TOOLKIT
9799 if (f->output_data.x->widget)
9800 #else
9801 if (FRAME_OUTER_WINDOW (f))
9802 #endif
9804 f->output_data.x->hourglass_p = 1;
9806 if (!f->output_data.x->hourglass_window)
9808 unsigned long mask = CWCursor;
9809 XSetWindowAttributes attrs;
9811 attrs.cursor = f->output_data.x->hourglass_cursor;
9813 f->output_data.x->hourglass_window
9814 = XCreateWindow (dpy, FRAME_OUTER_WINDOW (f),
9815 0, 0, 32000, 32000, 0, 0,
9816 InputOnly,
9817 CopyFromParent,
9818 mask, &attrs);
9821 XMapRaised (dpy, f->output_data.x->hourglass_window);
9822 XFlush (dpy);
9827 hourglass_shown_p = 1;
9828 UNBLOCK_INPUT;
9833 /* Hide the hourglass pointer on all frames, if it is currently
9834 shown. */
9836 static void
9837 hide_hourglass ()
9839 if (hourglass_shown_p)
9841 Lisp_Object rest, frame;
9843 BLOCK_INPUT;
9844 FOR_EACH_FRAME (rest, frame)
9846 struct frame *f = XFRAME (frame);
9848 if (FRAME_X_P (f)
9849 /* Watch out for newly created frames. */
9850 && f->output_data.x->hourglass_window)
9852 XUnmapWindow (FRAME_X_DISPLAY (f),
9853 f->output_data.x->hourglass_window);
9854 /* Sync here because XTread_socket looks at the
9855 hourglass_p flag that is reset to zero below. */
9856 XSync (FRAME_X_DISPLAY (f), False);
9857 f->output_data.x->hourglass_p = 0;
9861 hourglass_shown_p = 0;
9862 UNBLOCK_INPUT;
9868 /***********************************************************************
9869 Tool tips
9870 ***********************************************************************/
9872 static Lisp_Object x_create_tip_frame P_ ((struct x_display_info *,
9873 Lisp_Object, Lisp_Object));
9874 static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
9875 Lisp_Object, int, int, int *, int *));
9877 /* The frame of a currently visible tooltip. */
9879 Lisp_Object tip_frame;
9881 /* If non-nil, a timer started that hides the last tooltip when it
9882 fires. */
9884 Lisp_Object tip_timer;
9885 Window tip_window;
9887 /* If non-nil, a vector of 3 elements containing the last args
9888 with which x-show-tip was called. See there. */
9890 Lisp_Object last_show_tip_args;
9892 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
9894 Lisp_Object Vx_max_tooltip_size;
9897 static Lisp_Object
9898 unwind_create_tip_frame (frame)
9899 Lisp_Object frame;
9901 Lisp_Object deleted;
9903 deleted = unwind_create_frame (frame);
9904 if (EQ (deleted, Qt))
9906 tip_window = None;
9907 tip_frame = Qnil;
9910 return deleted;
9914 /* Create a frame for a tooltip on the display described by DPYINFO.
9915 PARMS is a list of frame parameters. TEXT is the string to
9916 display in the tip frame. Value is the frame.
9918 Note that functions called here, esp. x_default_parameter can
9919 signal errors, for instance when a specified color name is
9920 undefined. We have to make sure that we're in a consistent state
9921 when this happens. */
9923 static Lisp_Object
9924 x_create_tip_frame (dpyinfo, parms, text)
9925 struct x_display_info *dpyinfo;
9926 Lisp_Object parms, text;
9928 struct frame *f;
9929 Lisp_Object frame, tem;
9930 Lisp_Object name;
9931 long window_prompting = 0;
9932 int width, height;
9933 int count = SPECPDL_INDEX ();
9934 struct gcpro gcpro1, gcpro2, gcpro3;
9935 struct kboard *kb;
9936 int face_change_count_before = face_change_count;
9937 Lisp_Object buffer;
9938 struct buffer *old_buffer;
9940 check_x ();
9942 /* Use this general default value to start with until we know if
9943 this frame has a specified name. */
9944 Vx_resource_name = Vinvocation_name;
9946 #ifdef MULTI_KBOARD
9947 kb = dpyinfo->kboard;
9948 #else
9949 kb = &the_only_kboard;
9950 #endif
9952 /* Get the name of the frame to use for resource lookup. */
9953 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
9954 if (!STRINGP (name)
9955 && !EQ (name, Qunbound)
9956 && !NILP (name))
9957 error ("Invalid frame name--not a string or nil");
9958 Vx_resource_name = name;
9960 frame = Qnil;
9961 GCPRO3 (parms, name, frame);
9962 f = make_frame (1);
9963 XSETFRAME (frame, f);
9965 buffer = Fget_buffer_create (build_string (" *tip*"));
9966 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil);
9967 old_buffer = current_buffer;
9968 set_buffer_internal_1 (XBUFFER (buffer));
9969 current_buffer->truncate_lines = Qnil;
9970 Ferase_buffer ();
9971 Finsert (1, &text);
9972 set_buffer_internal_1 (old_buffer);
9974 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
9975 record_unwind_protect (unwind_create_tip_frame, frame);
9977 /* By setting the output method, we're essentially saying that
9978 the frame is live, as per FRAME_LIVE_P. If we get a signal
9979 from this point on, x_destroy_window might screw up reference
9980 counts etc. */
9981 f->output_method = output_x_window;
9982 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
9983 bzero (f->output_data.x, sizeof (struct x_output));
9984 f->output_data.x->icon_bitmap = -1;
9985 FRAME_FONTSET (f) = -1;
9986 f->output_data.x->scroll_bar_foreground_pixel = -1;
9987 f->output_data.x->scroll_bar_background_pixel = -1;
9988 #ifdef USE_TOOLKIT_SCROLL_BARS
9989 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
9990 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
9991 #endif /* USE_TOOLKIT_SCROLL_BARS */
9992 f->icon_name = Qnil;
9993 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
9994 #if GLYPH_DEBUG
9995 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
9996 dpyinfo_refcount = dpyinfo->reference_count;
9997 #endif /* GLYPH_DEBUG */
9998 #ifdef MULTI_KBOARD
9999 FRAME_KBOARD (f) = kb;
10000 #endif
10001 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
10002 f->output_data.x->explicit_parent = 0;
10004 /* These colors will be set anyway later, but it's important
10005 to get the color reference counts right, so initialize them! */
10007 Lisp_Object black;
10008 struct gcpro gcpro1;
10010 black = build_string ("black");
10011 GCPRO1 (black);
10012 f->output_data.x->foreground_pixel
10013 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10014 f->output_data.x->background_pixel
10015 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10016 f->output_data.x->cursor_pixel
10017 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10018 f->output_data.x->cursor_foreground_pixel
10019 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10020 f->output_data.x->border_pixel
10021 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10022 f->output_data.x->mouse_pixel
10023 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10024 UNGCPRO;
10027 /* Set the name; the functions to which we pass f expect the name to
10028 be set. */
10029 if (EQ (name, Qunbound) || NILP (name))
10031 f->name = build_string (dpyinfo->x_id_name);
10032 f->explicit_name = 0;
10034 else
10036 f->name = name;
10037 f->explicit_name = 1;
10038 /* use the frame's title when getting resources for this frame. */
10039 specbind (Qx_resource_name, name);
10042 /* Extract the window parameters from the supplied values that are
10043 needed to determine window geometry. */
10045 Lisp_Object font;
10047 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
10049 BLOCK_INPUT;
10050 /* First, try whatever font the caller has specified. */
10051 if (STRINGP (font))
10053 tem = Fquery_fontset (font, Qnil);
10054 if (STRINGP (tem))
10055 font = x_new_fontset (f, SDATA (tem));
10056 else
10057 font = x_new_font (f, SDATA (font));
10060 /* Try out a font which we hope has bold and italic variations. */
10061 if (!STRINGP (font))
10062 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10063 if (!STRINGP (font))
10064 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10065 if (! STRINGP (font))
10066 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10067 if (! STRINGP (font))
10068 /* This was formerly the first thing tried, but it finds too many fonts
10069 and takes too long. */
10070 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10071 /* If those didn't work, look for something which will at least work. */
10072 if (! STRINGP (font))
10073 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10074 UNBLOCK_INPUT;
10075 if (! STRINGP (font))
10076 font = build_string ("fixed");
10078 x_default_parameter (f, parms, Qfont, font,
10079 "font", "Font", RES_TYPE_STRING);
10082 x_default_parameter (f, parms, Qborder_width, make_number (2),
10083 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
10085 /* This defaults to 2 in order to match xterm. We recognize either
10086 internalBorderWidth or internalBorder (which is what xterm calls
10087 it). */
10088 if (NILP (Fassq (Qinternal_border_width, parms)))
10090 Lisp_Object value;
10092 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
10093 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
10094 if (! EQ (value, Qunbound))
10095 parms = Fcons (Fcons (Qinternal_border_width, value),
10096 parms);
10099 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
10100 "internalBorderWidth", "internalBorderWidth",
10101 RES_TYPE_NUMBER);
10103 /* Also do the stuff which must be set before the window exists. */
10104 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
10105 "foreground", "Foreground", RES_TYPE_STRING);
10106 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
10107 "background", "Background", RES_TYPE_STRING);
10108 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
10109 "pointerColor", "Foreground", RES_TYPE_STRING);
10110 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
10111 "cursorColor", "Foreground", RES_TYPE_STRING);
10112 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
10113 "borderColor", "BorderColor", RES_TYPE_STRING);
10115 /* Init faces before x_default_parameter is called for scroll-bar
10116 parameters because that function calls x_set_scroll_bar_width,
10117 which calls change_frame_size, which calls Fset_window_buffer,
10118 which runs hooks, which call Fvertical_motion. At the end, we
10119 end up in init_iterator with a null face cache, which should not
10120 happen. */
10121 init_frame_faces (f);
10123 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
10125 window_prompting = x_figure_window_size (f, parms, 0);
10128 XSetWindowAttributes attrs;
10129 unsigned long mask;
10131 BLOCK_INPUT;
10132 mask = CWBackPixel | CWOverrideRedirect | CWEventMask;
10133 if (DoesSaveUnders (dpyinfo->screen))
10134 mask |= CWSaveUnder;
10136 /* Window managers look at the override-redirect flag to determine
10137 whether or net to give windows a decoration (Xlib spec, chapter
10138 3.2.8). */
10139 attrs.override_redirect = True;
10140 attrs.save_under = True;
10141 attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f);
10142 /* Arrange for getting MapNotify and UnmapNotify events. */
10143 attrs.event_mask = StructureNotifyMask;
10144 tip_window
10145 = FRAME_X_WINDOW (f)
10146 = XCreateWindow (FRAME_X_DISPLAY (f),
10147 FRAME_X_DISPLAY_INFO (f)->root_window,
10148 /* x, y, width, height */
10149 0, 0, 1, 1,
10150 /* Border. */
10152 CopyFromParent, InputOutput, CopyFromParent,
10153 mask, &attrs);
10154 UNBLOCK_INPUT;
10157 x_make_gc (f);
10159 x_default_parameter (f, parms, Qauto_raise, Qnil,
10160 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
10161 x_default_parameter (f, parms, Qauto_lower, Qnil,
10162 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
10163 x_default_parameter (f, parms, Qcursor_type, Qbox,
10164 "cursorType", "CursorType", RES_TYPE_SYMBOL);
10166 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
10167 Change will not be effected unless different from the current
10168 FRAME_LINES (f). */
10169 width = FRAME_COLS (f);
10170 height = FRAME_LINES (f);
10171 SET_FRAME_COLS (f, 0);
10172 FRAME_LINES (f) = 0;
10173 change_frame_size (f, height, width, 1, 0, 0);
10175 /* Add `tooltip' frame parameter's default value. */
10176 if (NILP (Fframe_parameter (frame, intern ("tooltip"))))
10177 Fmodify_frame_parameters (frame, Fcons (Fcons (intern ("tooltip"), Qt),
10178 Qnil));
10180 /* Set up faces after all frame parameters are known. This call
10181 also merges in face attributes specified for new frames.
10183 Frame parameters may be changed if .Xdefaults contains
10184 specifications for the default font. For example, if there is an
10185 `Emacs.default.attributeBackground: pink', the `background-color'
10186 attribute of the frame get's set, which let's the internal border
10187 of the tooltip frame appear in pink. Prevent this. */
10189 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
10191 /* Set tip_frame here, so that */
10192 tip_frame = frame;
10193 call1 (Qface_set_after_frame_default, frame);
10195 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
10196 Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
10197 Qnil));
10200 f->no_split = 1;
10202 UNGCPRO;
10204 /* It is now ok to make the frame official even if we get an error
10205 below. And the frame needs to be on Vframe_list or making it
10206 visible won't work. */
10207 Vframe_list = Fcons (frame, Vframe_list);
10209 /* Now that the frame is official, it counts as a reference to
10210 its display. */
10211 FRAME_X_DISPLAY_INFO (f)->reference_count++;
10213 /* Setting attributes of faces of the tooltip frame from resources
10214 and similar will increment face_change_count, which leads to the
10215 clearing of all current matrices. Since this isn't necessary
10216 here, avoid it by resetting face_change_count to the value it
10217 had before we created the tip frame. */
10218 face_change_count = face_change_count_before;
10220 /* Discard the unwind_protect. */
10221 return unbind_to (count, frame);
10225 /* Compute where to display tip frame F. PARMS is the list of frame
10226 parameters for F. DX and DY are specified offsets from the current
10227 location of the mouse. WIDTH and HEIGHT are the width and height
10228 of the tooltip. Return coordinates relative to the root window of
10229 the display in *ROOT_X, and *ROOT_Y. */
10231 static void
10232 compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
10233 struct frame *f;
10234 Lisp_Object parms, dx, dy;
10235 int width, height;
10236 int *root_x, *root_y;
10238 Lisp_Object left, top;
10239 int win_x, win_y;
10240 Window root, child;
10241 unsigned pmask;
10243 /* User-specified position? */
10244 left = Fcdr (Fassq (Qleft, parms));
10245 top = Fcdr (Fassq (Qtop, parms));
10247 /* Move the tooltip window where the mouse pointer is. Resize and
10248 show it. */
10249 if (!INTEGERP (left) || !INTEGERP (top))
10251 BLOCK_INPUT;
10252 XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
10253 &root, &child, root_x, root_y, &win_x, &win_y, &pmask);
10254 UNBLOCK_INPUT;
10257 if (INTEGERP (top))
10258 *root_y = XINT (top);
10259 else if (*root_y + XINT (dy) - height < 0)
10260 *root_y -= XINT (dy);
10261 else
10263 *root_y -= height;
10264 *root_y += XINT (dy);
10267 if (INTEGERP (left))
10268 *root_x = XINT (left);
10269 else if (*root_x + XINT (dx) + width <= FRAME_X_DISPLAY_INFO (f)->width)
10270 /* It fits to the right of the pointer. */
10271 *root_x += XINT (dx);
10272 else if (width + XINT (dx) <= *root_x)
10273 /* It fits to the left of the pointer. */
10274 *root_x -= width + XINT (dx);
10275 else
10276 /* Put it left-justified on the screen--it ought to fit that way. */
10277 *root_x = 0;
10281 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
10282 doc: /* Show STRING in a "tooltip" window on frame FRAME.
10283 A tooltip window is a small X window displaying a string.
10285 FRAME nil or omitted means use the selected frame.
10287 PARMS is an optional list of frame parameters which can be used to
10288 change the tooltip's appearance.
10290 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
10291 means use the default timeout of 5 seconds.
10293 If the list of frame parameters PARAMS contains a `left' parameters,
10294 the tooltip is displayed at that x-position. Otherwise it is
10295 displayed at the mouse position, with offset DX added (default is 5 if
10296 DX isn't specified). Likewise for the y-position; if a `top' frame
10297 parameter is specified, it determines the y-position of the tooltip
10298 window, otherwise it is displayed at the mouse position, with offset
10299 DY added (default is -10).
10301 A tooltip's maximum size is specified by `x-max-tooltip-size'.
10302 Text larger than the specified size is clipped. */)
10303 (string, frame, parms, timeout, dx, dy)
10304 Lisp_Object string, frame, parms, timeout, dx, dy;
10306 struct frame *f;
10307 struct window *w;
10308 int root_x, root_y;
10309 struct buffer *old_buffer;
10310 struct text_pos pos;
10311 int i, width, height;
10312 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
10313 int old_windows_or_buffers_changed = windows_or_buffers_changed;
10314 int count = SPECPDL_INDEX ();
10316 specbind (Qinhibit_redisplay, Qt);
10318 GCPRO4 (string, parms, frame, timeout);
10320 CHECK_STRING (string);
10321 f = check_x_frame (frame);
10322 if (NILP (timeout))
10323 timeout = make_number (5);
10324 else
10325 CHECK_NATNUM (timeout);
10327 if (NILP (dx))
10328 dx = make_number (5);
10329 else
10330 CHECK_NUMBER (dx);
10332 if (NILP (dy))
10333 dy = make_number (-10);
10334 else
10335 CHECK_NUMBER (dy);
10337 if (NILP (last_show_tip_args))
10338 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
10340 if (!NILP (tip_frame))
10342 Lisp_Object last_string = AREF (last_show_tip_args, 0);
10343 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
10344 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
10346 if (EQ (frame, last_frame)
10347 && !NILP (Fequal (last_string, string))
10348 && !NILP (Fequal (last_parms, parms)))
10350 struct frame *f = XFRAME (tip_frame);
10352 /* Only DX and DY have changed. */
10353 if (!NILP (tip_timer))
10355 Lisp_Object timer = tip_timer;
10356 tip_timer = Qnil;
10357 call1 (Qcancel_timer, timer);
10360 BLOCK_INPUT;
10361 compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f),
10362 FRAME_PIXEL_HEIGHT (f), &root_x, &root_y);
10363 XMoveWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10364 root_x, root_y);
10365 UNBLOCK_INPUT;
10366 goto start_timer;
10370 /* Hide a previous tip, if any. */
10371 Fx_hide_tip ();
10373 ASET (last_show_tip_args, 0, string);
10374 ASET (last_show_tip_args, 1, frame);
10375 ASET (last_show_tip_args, 2, parms);
10377 /* Add default values to frame parameters. */
10378 if (NILP (Fassq (Qname, parms)))
10379 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
10380 if (NILP (Fassq (Qinternal_border_width, parms)))
10381 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
10382 if (NILP (Fassq (Qborder_width, parms)))
10383 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
10384 if (NILP (Fassq (Qborder_color, parms)))
10385 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
10386 if (NILP (Fassq (Qbackground_color, parms)))
10387 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
10388 parms);
10390 /* Create a frame for the tooltip, and record it in the global
10391 variable tip_frame. */
10392 frame = x_create_tip_frame (FRAME_X_DISPLAY_INFO (f), parms, string);
10393 f = XFRAME (frame);
10395 /* Set up the frame's root window. */
10396 w = XWINDOW (FRAME_ROOT_WINDOW (f));
10397 w->left_col = w->top_line = make_number (0);
10399 if (CONSP (Vx_max_tooltip_size)
10400 && INTEGERP (XCAR (Vx_max_tooltip_size))
10401 && XINT (XCAR (Vx_max_tooltip_size)) > 0
10402 && INTEGERP (XCDR (Vx_max_tooltip_size))
10403 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
10405 w->total_cols = XCAR (Vx_max_tooltip_size);
10406 w->total_lines = XCDR (Vx_max_tooltip_size);
10408 else
10410 w->total_cols = make_number (80);
10411 w->total_lines = make_number (40);
10414 FRAME_TOTAL_COLS (f) = XINT (w->total_cols);
10415 adjust_glyphs (f);
10416 w->pseudo_window_p = 1;
10418 /* Display the tooltip text in a temporary buffer. */
10419 old_buffer = current_buffer;
10420 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
10421 current_buffer->truncate_lines = Qnil;
10422 clear_glyph_matrix (w->desired_matrix);
10423 clear_glyph_matrix (w->current_matrix);
10424 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
10425 try_window (FRAME_ROOT_WINDOW (f), pos);
10427 /* Compute width and height of the tooltip. */
10428 width = height = 0;
10429 for (i = 0; i < w->desired_matrix->nrows; ++i)
10431 struct glyph_row *row = &w->desired_matrix->rows[i];
10432 struct glyph *last;
10433 int row_width;
10435 /* Stop at the first empty row at the end. */
10436 if (!row->enabled_p || !row->displays_text_p)
10437 break;
10439 /* Let the row go over the full width of the frame. */
10440 row->full_width_p = 1;
10442 /* There's a glyph at the end of rows that is used to place
10443 the cursor there. Don't include the width of this glyph. */
10444 if (row->used[TEXT_AREA])
10446 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
10447 row_width = row->pixel_width - last->pixel_width;
10449 else
10450 row_width = row->pixel_width;
10452 height += row->height;
10453 width = max (width, row_width);
10456 /* Add the frame's internal border to the width and height the X
10457 window should have. */
10458 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
10459 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
10461 /* Move the tooltip window where the mouse pointer is. Resize and
10462 show it. */
10463 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
10465 BLOCK_INPUT;
10466 XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10467 root_x, root_y, width, height);
10468 XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
10469 UNBLOCK_INPUT;
10471 /* Draw into the window. */
10472 w->must_be_updated_p = 1;
10473 update_single_window (w, 1);
10475 /* Restore original current buffer. */
10476 set_buffer_internal_1 (old_buffer);
10477 windows_or_buffers_changed = old_windows_or_buffers_changed;
10479 start_timer:
10480 /* Let the tip disappear after timeout seconds. */
10481 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
10482 intern ("x-hide-tip"));
10484 UNGCPRO;
10485 return unbind_to (count, Qnil);
10489 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
10490 doc: /* Hide the current tooltip window, if there is any.
10491 Value is t if tooltip was open, nil otherwise. */)
10494 int count;
10495 Lisp_Object deleted, frame, timer;
10496 struct gcpro gcpro1, gcpro2;
10498 /* Return quickly if nothing to do. */
10499 if (NILP (tip_timer) && NILP (tip_frame))
10500 return Qnil;
10502 frame = tip_frame;
10503 timer = tip_timer;
10504 GCPRO2 (frame, timer);
10505 tip_frame = tip_timer = deleted = Qnil;
10507 count = SPECPDL_INDEX ();
10508 specbind (Qinhibit_redisplay, Qt);
10509 specbind (Qinhibit_quit, Qt);
10511 if (!NILP (timer))
10512 call1 (Qcancel_timer, timer);
10514 if (FRAMEP (frame))
10516 Fdelete_frame (frame, Qnil);
10517 deleted = Qt;
10519 #ifdef USE_LUCID
10520 /* Bloodcurdling hack alert: The Lucid menu bar widget's
10521 redisplay procedure is not called when a tip frame over menu
10522 items is unmapped. Redisplay the menu manually... */
10524 struct frame *f = SELECTED_FRAME ();
10525 Widget w = f->output_data.x->menubar_widget;
10526 extern void xlwmenu_redisplay P_ ((Widget));
10528 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f)->screen)
10529 && w != NULL)
10531 BLOCK_INPUT;
10532 xlwmenu_redisplay (w);
10533 UNBLOCK_INPUT;
10536 #endif /* USE_LUCID */
10539 UNGCPRO;
10540 return unbind_to (count, deleted);
10545 /***********************************************************************
10546 File selection dialog
10547 ***********************************************************************/
10549 #ifdef USE_MOTIF
10551 /* Callback for "OK" and "Cancel" on file selection dialog. */
10553 static void
10554 file_dialog_cb (widget, client_data, call_data)
10555 Widget widget;
10556 XtPointer call_data, client_data;
10558 int *result = (int *) client_data;
10559 XmAnyCallbackStruct *cb = (XmAnyCallbackStruct *) call_data;
10560 *result = cb->reason;
10564 /* Callback for unmapping a file selection dialog. This is used to
10565 capture the case where a dialog is closed via a window manager's
10566 closer button, for example. Using a XmNdestroyCallback didn't work
10567 in this case. */
10569 static void
10570 file_dialog_unmap_cb (widget, client_data, call_data)
10571 Widget widget;
10572 XtPointer call_data, client_data;
10574 int *result = (int *) client_data;
10575 *result = XmCR_CANCEL;
10579 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
10580 doc: /* Read file name, prompting with PROMPT in directory DIR.
10581 Use a file selection dialog.
10582 Select DEFAULT-FILENAME in the dialog's file selection box, if
10583 specified. Don't let the user enter a file name in the file
10584 selection dialog's entry field, if MUSTMATCH is non-nil. */)
10585 (prompt, dir, default_filename, mustmatch)
10586 Lisp_Object prompt, dir, default_filename, mustmatch;
10588 int result;
10589 struct frame *f = SELECTED_FRAME ();
10590 Lisp_Object file = Qnil;
10591 Widget dialog, text, list, help;
10592 Arg al[10];
10593 int ac = 0;
10594 extern XtAppContext Xt_app_con;
10595 XmString dir_xmstring, pattern_xmstring;
10596 int count = SPECPDL_INDEX ();
10597 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
10599 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
10600 CHECK_STRING (prompt);
10601 CHECK_STRING (dir);
10603 /* Prevent redisplay. */
10604 specbind (Qinhibit_redisplay, Qt);
10606 BLOCK_INPUT;
10608 /* Create the dialog with PROMPT as title, using DIR as initial
10609 directory and using "*" as pattern. */
10610 dir = Fexpand_file_name (dir, Qnil);
10611 dir_xmstring = XmStringCreateLocalized (SDATA (dir));
10612 pattern_xmstring = XmStringCreateLocalized ("*");
10614 XtSetArg (al[ac], XmNtitle, SDATA (prompt)); ++ac;
10615 XtSetArg (al[ac], XmNdirectory, dir_xmstring); ++ac;
10616 XtSetArg (al[ac], XmNpattern, pattern_xmstring); ++ac;
10617 XtSetArg (al[ac], XmNresizePolicy, XmRESIZE_GROW); ++ac;
10618 XtSetArg (al[ac], XmNdialogStyle, XmDIALOG_APPLICATION_MODAL); ++ac;
10619 dialog = XmCreateFileSelectionDialog (f->output_data.x->widget,
10620 "fsb", al, ac);
10621 XmStringFree (dir_xmstring);
10622 XmStringFree (pattern_xmstring);
10624 /* Add callbacks for OK and Cancel. */
10625 XtAddCallback (dialog, XmNokCallback, file_dialog_cb,
10626 (XtPointer) &result);
10627 XtAddCallback (dialog, XmNcancelCallback, file_dialog_cb,
10628 (XtPointer) &result);
10629 XtAddCallback (dialog, XmNunmapCallback, file_dialog_unmap_cb,
10630 (XtPointer) &result);
10632 /* Disable the help button since we can't display help. */
10633 help = XmFileSelectionBoxGetChild (dialog, XmDIALOG_HELP_BUTTON);
10634 XtSetSensitive (help, False);
10636 /* Mark OK button as default. */
10637 XtVaSetValues (XmFileSelectionBoxGetChild (dialog, XmDIALOG_OK_BUTTON),
10638 XmNshowAsDefault, True, NULL);
10640 /* If MUSTMATCH is non-nil, disable the file entry field of the
10641 dialog, so that the user must select a file from the files list
10642 box. We can't remove it because we wouldn't have a way to get at
10643 the result file name, then. */
10644 text = XmFileSelectionBoxGetChild (dialog, XmDIALOG_TEXT);
10645 if (!NILP (mustmatch))
10647 Widget label;
10648 label = XmFileSelectionBoxGetChild (dialog, XmDIALOG_SELECTION_LABEL);
10649 XtSetSensitive (text, False);
10650 XtSetSensitive (label, False);
10653 /* Manage the dialog, so that list boxes get filled. */
10654 XtManageChild (dialog);
10656 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
10657 must include the path for this to work. */
10658 list = XmFileSelectionBoxGetChild (dialog, XmDIALOG_LIST);
10659 if (STRINGP (default_filename))
10661 XmString default_xmstring;
10662 int item_pos;
10664 default_xmstring
10665 = XmStringCreateLocalized (SDATA (default_filename));
10667 if (!XmListItemExists (list, default_xmstring))
10669 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10670 XmListAddItem (list, default_xmstring, 0);
10671 item_pos = 0;
10673 else
10674 item_pos = XmListItemPos (list, default_xmstring);
10675 XmStringFree (default_xmstring);
10677 /* Select the item and scroll it into view. */
10678 XmListSelectPos (list, item_pos, True);
10679 XmListSetPos (list, item_pos);
10682 /* Process events until the user presses Cancel or OK. */
10683 result = 0;
10684 while (result == 0)
10686 XEvent event;
10687 XtAppNextEvent (Xt_app_con, &event);
10688 (void) x_dispatch_event (&event, FRAME_X_DISPLAY (f) );
10691 /* Get the result. */
10692 if (result == XmCR_OK)
10694 XmString text;
10695 String data;
10697 XtVaGetValues (dialog, XmNtextString, &text, NULL);
10698 XmStringGetLtoR (text, XmFONTLIST_DEFAULT_TAG, &data);
10699 XmStringFree (text);
10700 file = build_string (data);
10701 XtFree (data);
10703 else
10704 file = Qnil;
10706 /* Clean up. */
10707 XtUnmanageChild (dialog);
10708 XtDestroyWidget (dialog);
10709 UNBLOCK_INPUT;
10710 UNGCPRO;
10712 /* Make "Cancel" equivalent to C-g. */
10713 if (NILP (file))
10714 Fsignal (Qquit, Qnil);
10716 return unbind_to (count, file);
10719 #endif /* USE_MOTIF */
10721 #ifdef USE_GTK
10723 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
10724 "Read file name, prompting with PROMPT in directory DIR.\n\
10725 Use a file selection dialog.\n\
10726 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
10727 specified. Don't let the user enter a file name in the file\n\
10728 selection dialog's entry field, if MUSTMATCH is non-nil.")
10729 (prompt, dir, default_filename, mustmatch)
10730 Lisp_Object prompt, dir, default_filename, mustmatch;
10732 FRAME_PTR f = SELECTED_FRAME ();
10733 char *fn;
10734 Lisp_Object file = Qnil;
10735 int count = specpdl_ptr - specpdl;
10736 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
10737 char *cdef_file;
10738 char *cprompt;
10740 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
10741 CHECK_STRING (prompt);
10742 CHECK_STRING (dir);
10744 /* Prevent redisplay. */
10745 specbind (Qinhibit_redisplay, Qt);
10747 BLOCK_INPUT;
10749 if (STRINGP (default_filename))
10750 cdef_file = SDATA (default_filename);
10751 else
10752 cdef_file = SDATA (dir);
10754 fn = xg_get_file_name (f, SDATA (prompt), cdef_file, ! NILP (mustmatch));
10756 if (fn)
10758 file = build_string (fn);
10759 xfree (fn);
10762 UNBLOCK_INPUT;
10763 UNGCPRO;
10765 /* Make "Cancel" equivalent to C-g. */
10766 if (NILP (file))
10767 Fsignal (Qquit, Qnil);
10769 return unbind_to (count, file);
10772 #endif /* USE_GTK */
10775 /***********************************************************************
10776 Keyboard
10777 ***********************************************************************/
10779 #ifdef HAVE_XKBGETKEYBOARD
10780 #include <X11/XKBlib.h>
10781 #include <X11/keysym.h>
10782 #endif
10784 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p,
10785 Sx_backspace_delete_keys_p, 0, 1, 0,
10786 doc: /* Check if both Backspace and Delete keys are on the keyboard of FRAME.
10787 FRAME nil means use the selected frame.
10788 Value is t if we know that both keys are present, and are mapped to the
10789 usual X keysyms. */)
10790 (frame)
10791 Lisp_Object frame;
10793 #ifdef HAVE_XKBGETKEYBOARD
10794 XkbDescPtr kb;
10795 struct frame *f = check_x_frame (frame);
10796 Display *dpy = FRAME_X_DISPLAY (f);
10797 Lisp_Object have_keys;
10798 int major, minor, op, event, error;
10800 BLOCK_INPUT;
10802 /* Check library version in case we're dynamically linked. */
10803 major = XkbMajorVersion;
10804 minor = XkbMinorVersion;
10805 if (!XkbLibraryVersion (&major, &minor))
10807 UNBLOCK_INPUT;
10808 return Qnil;
10811 /* Check that the server supports XKB. */
10812 major = XkbMajorVersion;
10813 minor = XkbMinorVersion;
10814 if (!XkbQueryExtension (dpy, &op, &event, &error, &major, &minor))
10816 UNBLOCK_INPUT;
10817 return Qnil;
10820 have_keys = Qnil;
10821 kb = XkbGetMap (dpy, XkbAllMapComponentsMask, XkbUseCoreKbd);
10822 if (kb)
10824 int delete_keycode = 0, backspace_keycode = 0, i;
10826 if (XkbGetNames (dpy, XkbAllNamesMask, kb) == Success)
10828 for (i = kb->min_key_code;
10829 (i < kb->max_key_code
10830 && (delete_keycode == 0 || backspace_keycode == 0));
10831 ++i)
10833 /* The XKB symbolic key names can be seen most easily in
10834 the PS file generated by `xkbprint -label name
10835 $DISPLAY'. */
10836 if (bcmp ("DELE", kb->names->keys[i].name, 4) == 0)
10837 delete_keycode = i;
10838 else if (bcmp ("BKSP", kb->names->keys[i].name, 4) == 0)
10839 backspace_keycode = i;
10842 XkbFreeNames (kb, 0, True);
10845 XkbFreeClientMap (kb, 0, True);
10847 if (delete_keycode
10848 && backspace_keycode
10849 && XKeysymToKeycode (dpy, XK_Delete) == delete_keycode
10850 && XKeysymToKeycode (dpy, XK_BackSpace) == backspace_keycode)
10851 have_keys = Qt;
10853 UNBLOCK_INPUT;
10854 return have_keys;
10855 #else /* not HAVE_XKBGETKEYBOARD */
10856 return Qnil;
10857 #endif /* not HAVE_XKBGETKEYBOARD */
10862 /***********************************************************************
10863 Initialization
10864 ***********************************************************************/
10866 /* Keep this list in the same order as frame_parms in frame.c.
10867 Use 0 for unsupported frame parameters. */
10869 frame_parm_handler x_frame_parm_handlers[] =
10871 x_set_autoraise,
10872 x_set_autolower,
10873 x_set_background_color,
10874 x_set_border_color,
10875 x_set_border_width,
10876 x_set_cursor_color,
10877 x_set_cursor_type,
10878 x_set_font,
10879 x_set_foreground_color,
10880 x_set_icon_name,
10881 x_set_icon_type,
10882 x_set_internal_border_width,
10883 x_set_menu_bar_lines,
10884 x_set_mouse_color,
10885 x_explicitly_set_name,
10886 x_set_scroll_bar_width,
10887 x_set_title,
10888 x_set_unsplittable,
10889 x_set_vertical_scroll_bars,
10890 x_set_visibility,
10891 x_set_tool_bar_lines,
10892 x_set_scroll_bar_foreground,
10893 x_set_scroll_bar_background,
10894 x_set_screen_gamma,
10895 x_set_line_spacing,
10896 x_set_fringe_width,
10897 x_set_fringe_width,
10898 x_set_wait_for_wm,
10899 x_set_fullscreen,
10902 void
10903 syms_of_xfns ()
10905 /* This is zero if not using X windows. */
10906 x_in_use = 0;
10908 /* The section below is built by the lisp expression at the top of the file,
10909 just above where these variables are declared. */
10910 /*&&& init symbols here &&&*/
10911 Qnone = intern ("none");
10912 staticpro (&Qnone);
10913 Qsuppress_icon = intern ("suppress-icon");
10914 staticpro (&Qsuppress_icon);
10915 Qundefined_color = intern ("undefined-color");
10916 staticpro (&Qundefined_color);
10917 Qcenter = intern ("center");
10918 staticpro (&Qcenter);
10919 Qcompound_text = intern ("compound-text");
10920 staticpro (&Qcompound_text);
10921 Qcancel_timer = intern ("cancel-timer");
10922 staticpro (&Qcancel_timer);
10923 /* This is the end of symbol initialization. */
10925 /* Text property `display' should be nonsticky by default. */
10926 Vtext_property_default_nonsticky
10927 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
10930 Qlaplace = intern ("laplace");
10931 staticpro (&Qlaplace);
10932 Qemboss = intern ("emboss");
10933 staticpro (&Qemboss);
10934 Qedge_detection = intern ("edge-detection");
10935 staticpro (&Qedge_detection);
10936 Qheuristic = intern ("heuristic");
10937 staticpro (&Qheuristic);
10938 QCmatrix = intern (":matrix");
10939 staticpro (&QCmatrix);
10940 QCcolor_adjustment = intern (":color-adjustment");
10941 staticpro (&QCcolor_adjustment);
10942 QCmask = intern (":mask");
10943 staticpro (&QCmask);
10945 Fput (Qundefined_color, Qerror_conditions,
10946 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
10947 Fput (Qundefined_color, Qerror_message,
10948 build_string ("Undefined color"));
10950 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images,
10951 doc: /* Non-nil means always draw a cross over disabled images.
10952 Disabled images are those having an `:conversion disabled' property.
10953 A cross is always drawn on black & white displays. */);
10954 cross_disabled_images = 0;
10956 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
10957 doc: /* List of directories to search for window system bitmap files. */);
10958 Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
10960 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
10961 doc: /* The shape of the pointer when over text.
10962 Changing the value does not affect existing frames
10963 unless you set the mouse color. */);
10964 Vx_pointer_shape = Qnil;
10966 #if 0 /* This doesn't really do anything. */
10967 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
10968 doc: /* The shape of the pointer when not over text.
10969 This variable takes effect when you create a new frame
10970 or when you set the mouse color. */);
10971 #endif
10972 Vx_nontext_pointer_shape = Qnil;
10974 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
10975 doc: /* The shape of the pointer when Emacs is busy.
10976 This variable takes effect when you create a new frame
10977 or when you set the mouse color. */);
10978 Vx_hourglass_pointer_shape = Qnil;
10980 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
10981 doc: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
10982 display_hourglass_p = 1;
10984 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
10985 doc: /* *Seconds to wait before displaying an hourglass pointer.
10986 Value must be an integer or float. */);
10987 Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
10989 #if 0 /* This doesn't really do anything. */
10990 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
10991 doc: /* The shape of the pointer when over the mode line.
10992 This variable takes effect when you create a new frame
10993 or when you set the mouse color. */);
10994 #endif
10995 Vx_mode_pointer_shape = Qnil;
10997 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
10998 &Vx_sensitive_text_pointer_shape,
10999 doc: /* The shape of the pointer when over mouse-sensitive text.
11000 This variable takes effect when you create a new frame
11001 or when you set the mouse color. */);
11002 Vx_sensitive_text_pointer_shape = Qnil;
11004 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
11005 &Vx_window_horizontal_drag_shape,
11006 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
11007 This variable takes effect when you create a new frame
11008 or when you set the mouse color. */);
11009 Vx_window_horizontal_drag_shape = Qnil;
11011 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
11012 doc: /* A string indicating the foreground color of the cursor box. */);
11013 Vx_cursor_fore_pixel = Qnil;
11015 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
11016 doc: /* Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).
11017 Text larger than this is clipped. */);
11018 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
11020 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
11021 doc: /* Non-nil if no X window manager is in use.
11022 Emacs doesn't try to figure this out; this is always nil
11023 unless you set it to something else. */);
11024 /* We don't have any way to find this out, so set it to nil
11025 and maybe the user would like to set it to t. */
11026 Vx_no_window_manager = Qnil;
11028 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11029 &Vx_pixel_size_width_font_regexp,
11030 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
11032 Since Emacs gets width of a font matching with this regexp from
11033 PIXEL_SIZE field of the name, font finding mechanism gets faster for
11034 such a font. This is especially effective for such large fonts as
11035 Chinese, Japanese, and Korean. */);
11036 Vx_pixel_size_width_font_regexp = Qnil;
11038 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay,
11039 doc: /* Time after which cached images are removed from the cache.
11040 When an image has not been displayed this many seconds, remove it
11041 from the image cache. Value must be an integer or nil with nil
11042 meaning don't clear the cache. */);
11043 Vimage_cache_eviction_delay = make_number (30 * 60);
11045 #ifdef USE_X_TOOLKIT
11046 Fprovide (intern ("x-toolkit"), Qnil);
11047 #ifdef USE_MOTIF
11048 Fprovide (intern ("motif"), Qnil);
11050 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string,
11051 doc: /* Version info for LessTif/Motif. */);
11052 Vmotif_version_string = build_string (XmVERSION_STRING);
11053 #endif /* USE_MOTIF */
11054 #endif /* USE_X_TOOLKIT */
11056 #ifdef USE_GTK
11057 Fprovide (intern ("gtk"), Qnil);
11059 DEFVAR_LISP ("gtk-version-string", &Vgtk_version_string,
11060 doc: /* Version info for GTK+. */);
11062 char gtk_version[40];
11063 g_snprintf (gtk_version, sizeof (gtk_version), "%u.%u.%u",
11064 GTK_MAJOR_VERSION, GTK_MINOR_VERSION, GTK_MICRO_VERSION);
11065 Vgtk_version_string = build_string (gtk_version);
11067 #endif /* USE_GTK */
11069 /* X window properties. */
11070 defsubr (&Sx_change_window_property);
11071 defsubr (&Sx_delete_window_property);
11072 defsubr (&Sx_window_property);
11074 defsubr (&Sxw_display_color_p);
11075 defsubr (&Sx_display_grayscale_p);
11076 defsubr (&Sxw_color_defined_p);
11077 defsubr (&Sxw_color_values);
11078 defsubr (&Sx_server_max_request_size);
11079 defsubr (&Sx_server_vendor);
11080 defsubr (&Sx_server_version);
11081 defsubr (&Sx_display_pixel_width);
11082 defsubr (&Sx_display_pixel_height);
11083 defsubr (&Sx_display_mm_width);
11084 defsubr (&Sx_display_mm_height);
11085 defsubr (&Sx_display_screens);
11086 defsubr (&Sx_display_planes);
11087 defsubr (&Sx_display_color_cells);
11088 defsubr (&Sx_display_visual_class);
11089 defsubr (&Sx_display_backing_store);
11090 defsubr (&Sx_display_save_under);
11091 defsubr (&Sx_create_frame);
11092 defsubr (&Sx_open_connection);
11093 defsubr (&Sx_close_connection);
11094 defsubr (&Sx_display_list);
11095 defsubr (&Sx_synchronize);
11096 defsubr (&Sx_send_client_message);
11097 defsubr (&Sx_focus_frame);
11098 defsubr (&Sx_backspace_delete_keys_p);
11100 /* Setting callback functions for fontset handler. */
11101 get_font_info_func = x_get_font_info;
11103 #if 0 /* This function pointer doesn't seem to be used anywhere.
11104 And the pointer assigned has the wrong type, anyway. */
11105 list_fonts_func = x_list_fonts;
11106 #endif
11108 load_font_func = x_load_font;
11109 find_ccl_program_func = x_find_ccl_program;
11110 query_font_func = x_query_font;
11111 set_frame_fontset_func = x_set_font;
11112 check_window_system_func = check_x;
11114 /* Images. */
11115 Qxbm = intern ("xbm");
11116 staticpro (&Qxbm);
11117 QCconversion = intern (":conversion");
11118 staticpro (&QCconversion);
11119 QCheuristic_mask = intern (":heuristic-mask");
11120 staticpro (&QCheuristic_mask);
11121 QCcolor_symbols = intern (":color-symbols");
11122 staticpro (&QCcolor_symbols);
11123 QCascent = intern (":ascent");
11124 staticpro (&QCascent);
11125 QCmargin = intern (":margin");
11126 staticpro (&QCmargin);
11127 QCrelief = intern (":relief");
11128 staticpro (&QCrelief);
11129 Qpostscript = intern ("postscript");
11130 staticpro (&Qpostscript);
11131 QCloader = intern (":loader");
11132 staticpro (&QCloader);
11133 QCbounding_box = intern (":bounding-box");
11134 staticpro (&QCbounding_box);
11135 QCpt_width = intern (":pt-width");
11136 staticpro (&QCpt_width);
11137 QCpt_height = intern (":pt-height");
11138 staticpro (&QCpt_height);
11139 QCindex = intern (":index");
11140 staticpro (&QCindex);
11141 Qpbm = intern ("pbm");
11142 staticpro (&Qpbm);
11144 #if HAVE_XPM
11145 Qxpm = intern ("xpm");
11146 staticpro (&Qxpm);
11147 #endif
11149 #if HAVE_JPEG
11150 Qjpeg = intern ("jpeg");
11151 staticpro (&Qjpeg);
11152 #endif
11154 #if HAVE_TIFF
11155 Qtiff = intern ("tiff");
11156 staticpro (&Qtiff);
11157 #endif
11159 #if HAVE_GIF
11160 Qgif = intern ("gif");
11161 staticpro (&Qgif);
11162 #endif
11164 #if HAVE_PNG
11165 Qpng = intern ("png");
11166 staticpro (&Qpng);
11167 #endif
11169 defsubr (&Sclear_image_cache);
11170 defsubr (&Simage_size);
11171 defsubr (&Simage_mask_p);
11173 hourglass_atimer = NULL;
11174 hourglass_shown_p = 0;
11176 defsubr (&Sx_show_tip);
11177 defsubr (&Sx_hide_tip);
11178 tip_timer = Qnil;
11179 staticpro (&tip_timer);
11180 tip_frame = Qnil;
11181 staticpro (&tip_frame);
11183 last_show_tip_args = Qnil;
11184 staticpro (&last_show_tip_args);
11186 #ifdef USE_MOTIF
11187 defsubr (&Sx_file_dialog);
11188 #endif
11192 void
11193 init_xfns ()
11195 image_types = NULL;
11196 Vimage_types = Qnil;
11198 define_image_type (&xbm_type);
11199 define_image_type (&gs_type);
11200 define_image_type (&pbm_type);
11202 #if HAVE_XPM
11203 define_image_type (&xpm_type);
11204 #endif
11206 #if HAVE_JPEG
11207 define_image_type (&jpeg_type);
11208 #endif
11210 #if HAVE_TIFF
11211 define_image_type (&tiff_type);
11212 #endif
11214 #if HAVE_GIF
11215 define_image_type (&gif_type);
11216 #endif
11218 #if HAVE_PNG
11219 define_image_type (&png_type);
11220 #endif
11223 #endif /* HAVE_X_WINDOWS */
11225 /* arch-tag: 55040d02-5485-4d58-8b22-95a7a05f3288
11226 (do not change this comment) */