1 /* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 1997, 1998, 1999, 2000, 2001
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)
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. */
27 /* This makes the fields of a Display accessible, in Xlib header files. */
29 #define XLIB_ILLEGAL_ACCESS
36 #include "intervals.h"
37 #include "dispextern.h"
39 #include "blockinput.h"
45 #include "termhooks.h"
51 #include <sys/types.h>
55 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
56 #include "bitmaps/gray.xbm"
58 #include <X11/bitmaps/gray>
61 #include "[.bitmaps]gray.xbm"
65 #include <X11/Shell.h>
68 #include <X11/Xaw/Paned.h>
69 #include <X11/Xaw/Label.h>
70 #endif /* USE_MOTIF */
73 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
82 #include "../lwlib/lwlib.h"
86 #include <Xm/DialogS.h>
87 #include <Xm/FileSB.h>
90 /* Do the EDITRES protocol if running X11R5
91 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
93 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
95 extern void _XEditResCheckMessages ();
96 #endif /* R5 + Athena */
98 /* Unique id counter for widgets created by the Lucid Widget Library. */
100 extern LWLIB_ID widget_id_tick
;
103 /* This is part of a kludge--see lwlib/xlwmenu.c. */
104 extern XFontStruct
*xlwmenu_default_font
;
107 extern void free_frame_menubar ();
108 extern double atof ();
112 /* LessTif/Motif version info. */
114 static Lisp_Object Vmotif_version_string
;
116 #endif /* USE_MOTIF */
118 #endif /* USE_X_TOOLKIT */
121 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
123 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
126 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
127 it, and including `bitmaps/gray' more than once is a problem when
128 config.h defines `static' as an empty replacement string. */
130 int gray_bitmap_width
= gray_width
;
131 int gray_bitmap_height
= gray_height
;
132 char *gray_bitmap_bits
= gray_bits
;
134 /* The name we're using in resource queries. Most often "emacs". */
136 Lisp_Object Vx_resource_name
;
138 /* The application class we're using in resource queries.
141 Lisp_Object Vx_resource_class
;
143 /* Non-zero means we're allowed to display an hourglass cursor. */
145 int display_hourglass_p
;
147 /* The background and shape of the mouse pointer, and shape when not
148 over text or in the modeline. */
150 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
151 Lisp_Object Vx_hourglass_pointer_shape
;
153 /* The shape when over mouse-sensitive text. */
155 Lisp_Object Vx_sensitive_text_pointer_shape
;
157 /* If non-nil, the pointer shape to indicate that windows can be
158 dragged horizontally. */
160 Lisp_Object Vx_window_horizontal_drag_shape
;
162 /* Color of chars displayed in cursor box. */
164 Lisp_Object Vx_cursor_fore_pixel
;
166 /* Nonzero if using X. */
170 /* Non nil if no window manager is in use. */
172 Lisp_Object Vx_no_window_manager
;
174 /* Search path for bitmap files. */
176 Lisp_Object Vx_bitmap_file_path
;
178 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
180 Lisp_Object Vx_pixel_size_width_font_regexp
;
182 Lisp_Object Qauto_raise
;
183 Lisp_Object Qauto_lower
;
185 Lisp_Object Qborder_color
;
186 Lisp_Object Qborder_width
;
188 Lisp_Object Qcursor_color
;
189 Lisp_Object Qcursor_type
;
190 Lisp_Object Qgeometry
;
191 Lisp_Object Qicon_left
;
192 Lisp_Object Qicon_top
;
193 Lisp_Object Qicon_type
;
194 Lisp_Object Qicon_name
;
195 Lisp_Object Qinternal_border_width
;
198 Lisp_Object Qmouse_color
;
200 Lisp_Object Qouter_window_id
;
201 Lisp_Object Qparent_id
;
202 Lisp_Object Qscroll_bar_width
;
203 Lisp_Object Qsuppress_icon
;
204 extern Lisp_Object Qtop
;
205 Lisp_Object Qundefined_color
;
206 Lisp_Object Qvertical_scroll_bars
;
207 Lisp_Object Qvisibility
;
208 Lisp_Object Qwindow_id
;
209 Lisp_Object Qx_frame_parameter
;
210 Lisp_Object Qx_resource_name
;
211 Lisp_Object Quser_position
;
212 Lisp_Object Quser_size
;
213 extern Lisp_Object Qdisplay
;
214 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
215 Lisp_Object Qscreen_gamma
, Qline_spacing
, Qcenter
;
216 Lisp_Object Qcompound_text
, Qcancel_timer
;
217 Lisp_Object Qwait_for_wm
;
219 /* The below are defined in frame.c. */
221 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
222 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
223 extern Lisp_Object Qtool_bar_lines
;
225 extern Lisp_Object Vwindow_system_version
;
227 Lisp_Object Qface_set_after_frame_default
;
230 int image_cache_refcount
, dpyinfo_refcount
;
235 /* Error if we are not connected to X. */
241 error ("X windows are not in use or not initialized");
244 /* Nonzero if we can use mouse menus.
245 You should not call this unless HAVE_MENUS is defined. */
253 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
254 and checking validity for X. */
257 check_x_frame (frame
)
263 frame
= selected_frame
;
264 CHECK_LIVE_FRAME (frame
, 0);
267 error ("Non-X frame used");
271 /* Let the user specify an X display with a frame.
272 nil stands for the selected frame--or, if that is not an X frame,
273 the first X display on the list. */
275 static struct x_display_info
*
276 check_x_display_info (frame
)
279 struct x_display_info
*dpyinfo
= NULL
;
283 struct frame
*sf
= XFRAME (selected_frame
);
285 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
286 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
287 else if (x_display_list
!= 0)
288 dpyinfo
= x_display_list
;
290 error ("X windows are not in use or not initialized");
292 else if (STRINGP (frame
))
293 dpyinfo
= x_display_info_for_name (frame
);
298 CHECK_LIVE_FRAME (frame
, 0);
301 error ("Non-X frame used");
302 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
309 /* Return the Emacs frame-object corresponding to an X window.
310 It could be the frame's main window or an icon window. */
312 /* This function can be called during GC, so use GC_xxx type test macros. */
315 x_window_to_frame (dpyinfo
, wdesc
)
316 struct x_display_info
*dpyinfo
;
319 Lisp_Object tail
, frame
;
322 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
325 if (!GC_FRAMEP (frame
))
328 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
330 if (f
->output_data
.x
->hourglass_window
== wdesc
)
333 if ((f
->output_data
.x
->edit_widget
334 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
335 /* A tooltip frame? */
336 || (!f
->output_data
.x
->edit_widget
337 && FRAME_X_WINDOW (f
) == wdesc
)
338 || f
->output_data
.x
->icon_desc
== wdesc
)
340 #else /* not USE_X_TOOLKIT */
341 if (FRAME_X_WINDOW (f
) == wdesc
342 || f
->output_data
.x
->icon_desc
== wdesc
)
344 #endif /* not USE_X_TOOLKIT */
350 /* Like x_window_to_frame but also compares the window with the widget's
354 x_any_window_to_frame (dpyinfo
, wdesc
)
355 struct x_display_info
*dpyinfo
;
358 Lisp_Object tail
, frame
;
359 struct frame
*f
, *found
;
363 for (tail
= Vframe_list
; GC_CONSP (tail
) && !found
; tail
= XCDR (tail
))
366 if (!GC_FRAMEP (frame
))
370 if (FRAME_X_P (f
) && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
)
372 /* This frame matches if the window is any of its widgets. */
373 x
= f
->output_data
.x
;
374 if (x
->hourglass_window
== wdesc
)
378 if (wdesc
== XtWindow (x
->widget
)
379 || wdesc
== XtWindow (x
->column_widget
)
380 || wdesc
== XtWindow (x
->edit_widget
))
382 /* Match if the window is this frame's menubar. */
383 else if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
386 else if (FRAME_X_WINDOW (f
) == wdesc
)
387 /* A tooltip frame. */
395 /* Likewise, but exclude the menu bar widget. */
398 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
399 struct x_display_info
*dpyinfo
;
402 Lisp_Object tail
, frame
;
406 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
409 if (!GC_FRAMEP (frame
))
412 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
414 x
= f
->output_data
.x
;
415 /* This frame matches if the window is any of its widgets. */
416 if (x
->hourglass_window
== wdesc
)
420 if (wdesc
== XtWindow (x
->widget
)
421 || wdesc
== XtWindow (x
->column_widget
)
422 || wdesc
== XtWindow (x
->edit_widget
))
425 else if (FRAME_X_WINDOW (f
) == wdesc
)
426 /* A tooltip frame. */
432 /* Likewise, but consider only the menu bar widget. */
435 x_menubar_window_to_frame (dpyinfo
, wdesc
)
436 struct x_display_info
*dpyinfo
;
439 Lisp_Object tail
, frame
;
443 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
446 if (!GC_FRAMEP (frame
))
449 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
451 x
= f
->output_data
.x
;
452 /* Match if the window is this frame's menubar. */
453 if (x
->menubar_widget
454 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
460 /* Return the frame whose principal (outermost) window is WDESC.
461 If WDESC is some other (smaller) window, we return 0. */
464 x_top_window_to_frame (dpyinfo
, wdesc
)
465 struct x_display_info
*dpyinfo
;
468 Lisp_Object tail
, frame
;
472 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
475 if (!GC_FRAMEP (frame
))
478 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
480 x
= f
->output_data
.x
;
484 /* This frame matches if the window is its topmost widget. */
485 if (wdesc
== XtWindow (x
->widget
))
487 #if 0 /* I don't know why it did this,
488 but it seems logically wrong,
489 and it causes trouble for MapNotify events. */
490 /* Match if the window is this frame's menubar. */
491 if (x
->menubar_widget
492 && wdesc
== XtWindow (x
->menubar_widget
))
496 else if (FRAME_X_WINDOW (f
) == wdesc
)
502 #endif /* USE_X_TOOLKIT */
506 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
507 id, which is just an int that this section returns. Bitmaps are
508 reference counted so they can be shared among frames.
510 Bitmap indices are guaranteed to be > 0, so a negative number can
511 be used to indicate no bitmap.
513 If you use x_create_bitmap_from_data, then you must keep track of
514 the bitmaps yourself. That is, creating a bitmap from the same
515 data more than once will not be caught. */
518 /* Functions to access the contents of a bitmap, given an id. */
521 x_bitmap_height (f
, id
)
525 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
529 x_bitmap_width (f
, id
)
533 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
537 x_bitmap_pixmap (f
, id
)
541 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
545 /* Allocate a new bitmap record. Returns index of new record. */
548 x_allocate_bitmap_record (f
)
551 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
554 if (dpyinfo
->bitmaps
== NULL
)
556 dpyinfo
->bitmaps_size
= 10;
558 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
559 dpyinfo
->bitmaps_last
= 1;
563 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
564 return ++dpyinfo
->bitmaps_last
;
566 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
567 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
570 dpyinfo
->bitmaps_size
*= 2;
572 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
573 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
574 return ++dpyinfo
->bitmaps_last
;
577 /* Add one reference to the reference count of the bitmap with id ID. */
580 x_reference_bitmap (f
, id
)
584 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
587 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
590 x_create_bitmap_from_data (f
, bits
, width
, height
)
593 unsigned int width
, height
;
595 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
599 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
600 bits
, width
, height
);
605 id
= x_allocate_bitmap_record (f
);
606 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
607 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
608 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
609 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
610 dpyinfo
->bitmaps
[id
- 1].height
= height
;
611 dpyinfo
->bitmaps
[id
- 1].width
= width
;
616 /* Create bitmap from file FILE for frame F. */
619 x_create_bitmap_from_file (f
, file
)
623 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
624 unsigned int width
, height
;
626 int xhot
, yhot
, result
, id
;
631 /* Look for an existing bitmap with the same name. */
632 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
634 if (dpyinfo
->bitmaps
[id
].refcount
635 && dpyinfo
->bitmaps
[id
].file
636 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
638 ++dpyinfo
->bitmaps
[id
].refcount
;
643 /* Search bitmap-file-path for the file, if appropriate. */
644 fd
= openp (Vx_bitmap_file_path
, file
, Qnil
, &found
, 0);
649 filename
= (char *) XSTRING (found
)->data
;
651 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
652 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
653 if (result
!= BitmapSuccess
)
656 id
= x_allocate_bitmap_record (f
);
657 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
658 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
659 dpyinfo
->bitmaps
[id
- 1].file
660 = (char *) xmalloc (STRING_BYTES (XSTRING (file
)) + 1);
661 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
662 dpyinfo
->bitmaps
[id
- 1].height
= height
;
663 dpyinfo
->bitmaps
[id
- 1].width
= width
;
664 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
669 /* Remove reference to bitmap with id number ID. */
672 x_destroy_bitmap (f
, id
)
676 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
680 --dpyinfo
->bitmaps
[id
- 1].refcount
;
681 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
684 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
685 if (dpyinfo
->bitmaps
[id
- 1].file
)
687 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
688 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
695 /* Free all the bitmaps for the display specified by DPYINFO. */
698 x_destroy_all_bitmaps (dpyinfo
)
699 struct x_display_info
*dpyinfo
;
702 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
703 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
705 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
706 if (dpyinfo
->bitmaps
[i
].file
)
707 xfree (dpyinfo
->bitmaps
[i
].file
);
709 dpyinfo
->bitmaps_last
= 0;
712 /* Connect the frame-parameter names for X frames
713 to the ways of passing the parameter values to the window system.
715 The name of a parameter, as a Lisp symbol,
716 has an `x-frame-parameter' property which is an integer in Lisp
717 that is an index in this table. */
719 struct x_frame_parm_table
722 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
725 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
726 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
727 static void x_change_window_heights
P_ ((Lisp_Object
, int));
728 static void x_disable_image
P_ ((struct frame
*, struct image
*));
729 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
730 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
731 static void x_set_wait_for_wm
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
732 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
733 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
734 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
735 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
736 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
737 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
738 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
739 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
740 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
741 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
743 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
744 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
745 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
746 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
748 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
749 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
750 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
751 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
752 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
753 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
754 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
756 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
758 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
763 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
764 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
766 static void init_color_table
P_ ((void));
767 static void free_color_table
P_ ((void));
768 static unsigned long *colors_in_color_table
P_ ((int *n
));
769 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
770 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
774 static struct x_frame_parm_table x_frame_parms
[] =
776 "auto-raise", x_set_autoraise
,
777 "auto-lower", x_set_autolower
,
778 "background-color", x_set_background_color
,
779 "border-color", x_set_border_color
,
780 "border-width", x_set_border_width
,
781 "cursor-color", x_set_cursor_color
,
782 "cursor-type", x_set_cursor_type
,
784 "foreground-color", x_set_foreground_color
,
785 "icon-name", x_set_icon_name
,
786 "icon-type", x_set_icon_type
,
787 "internal-border-width", x_set_internal_border_width
,
788 "menu-bar-lines", x_set_menu_bar_lines
,
789 "mouse-color", x_set_mouse_color
,
790 "name", x_explicitly_set_name
,
791 "scroll-bar-width", x_set_scroll_bar_width
,
792 "title", x_set_title
,
793 "unsplittable", x_set_unsplittable
,
794 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
795 "visibility", x_set_visibility
,
796 "tool-bar-lines", x_set_tool_bar_lines
,
797 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
798 "scroll-bar-background", x_set_scroll_bar_background
,
799 "screen-gamma", x_set_screen_gamma
,
800 "line-spacing", x_set_line_spacing
,
801 "wait-for-wm", x_set_wait_for_wm
804 /* Attach the `x-frame-parameter' properties to
805 the Lisp symbol names of parameters relevant to X. */
808 init_x_parm_symbols ()
812 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
813 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
817 /* Change the parameters of frame F as specified by ALIST.
818 If a parameter is not specially recognized, do nothing special;
819 otherwise call the `x_set_...' function for that parameter.
820 Except for certain geometry properties, always call store_frame_param
821 to store the new value in the parameter alist. */
824 x_set_frame_parameters (f
, alist
)
830 /* If both of these parameters are present, it's more efficient to
831 set them both at once. So we wait until we've looked at the
832 entire list before we set them. */
836 Lisp_Object left
, top
;
838 /* Same with these. */
839 Lisp_Object icon_left
, icon_top
;
841 /* Record in these vectors all the parms specified. */
845 int left_no_change
= 0, top_no_change
= 0;
846 int icon_left_no_change
= 0, icon_top_no_change
= 0;
848 struct gcpro gcpro1
, gcpro2
;
851 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
854 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
855 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
857 /* Extract parm names and values into those vectors. */
860 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
865 parms
[i
] = Fcar (elt
);
866 values
[i
] = Fcdr (elt
);
869 /* TAIL and ALIST are not used again below here. */
872 GCPRO2 (*parms
, *values
);
876 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
877 because their values appear in VALUES and strings are not valid. */
878 top
= left
= Qunbound
;
879 icon_left
= icon_top
= Qunbound
;
881 /* Provide default values for HEIGHT and WIDTH. */
882 if (FRAME_NEW_WIDTH (f
))
883 width
= FRAME_NEW_WIDTH (f
);
885 width
= FRAME_WIDTH (f
);
887 if (FRAME_NEW_HEIGHT (f
))
888 height
= FRAME_NEW_HEIGHT (f
);
890 height
= FRAME_HEIGHT (f
);
892 /* Process foreground_color and background_color before anything else.
893 They are independent of other properties, but other properties (e.g.,
894 cursor_color) are dependent upon them. */
895 for (p
= 0; p
< i
; p
++)
897 Lisp_Object prop
, val
;
901 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
903 register Lisp_Object param_index
, old_value
;
905 param_index
= Fget (prop
, Qx_frame_parameter
);
906 old_value
= get_frame_param (f
, prop
);
907 store_frame_param (f
, prop
, val
);
908 if (NATNUMP (param_index
)
909 && (XFASTINT (param_index
)
910 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
911 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
915 /* Now process them in reverse of specified order. */
916 for (i
--; i
>= 0; i
--)
918 Lisp_Object prop
, val
;
923 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
924 width
= XFASTINT (val
);
925 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
926 height
= XFASTINT (val
);
927 else if (EQ (prop
, Qtop
))
929 else if (EQ (prop
, Qleft
))
931 else if (EQ (prop
, Qicon_top
))
933 else if (EQ (prop
, Qicon_left
))
935 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
936 /* Processed above. */
940 register Lisp_Object param_index
, old_value
;
942 param_index
= Fget (prop
, Qx_frame_parameter
);
943 old_value
= get_frame_param (f
, prop
);
944 store_frame_param (f
, prop
, val
);
945 if (NATNUMP (param_index
)
946 && (XFASTINT (param_index
)
947 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
948 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
952 /* Don't die if just one of these was set. */
953 if (EQ (left
, Qunbound
))
956 if (f
->output_data
.x
->left_pos
< 0)
957 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
959 XSETINT (left
, f
->output_data
.x
->left_pos
);
961 if (EQ (top
, Qunbound
))
964 if (f
->output_data
.x
->top_pos
< 0)
965 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
967 XSETINT (top
, f
->output_data
.x
->top_pos
);
970 /* If one of the icon positions was not set, preserve or default it. */
971 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
973 icon_left_no_change
= 1;
974 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
975 if (NILP (icon_left
))
976 XSETINT (icon_left
, 0);
978 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
980 icon_top_no_change
= 1;
981 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
983 XSETINT (icon_top
, 0);
986 /* Don't set these parameters unless they've been explicitly
987 specified. The window might be mapped or resized while we're in
988 this function, and we don't want to override that unless the lisp
989 code has asked for it.
991 Don't set these parameters unless they actually differ from the
992 window's current parameters; the window may not actually exist
997 check_frame_size (f
, &height
, &width
);
999 XSETFRAME (frame
, f
);
1001 if (width
!= FRAME_WIDTH (f
)
1002 || height
!= FRAME_HEIGHT (f
)
1003 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1004 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1006 if ((!NILP (left
) || !NILP (top
))
1007 && ! (left_no_change
&& top_no_change
)
1008 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1009 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1014 /* Record the signs. */
1015 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1016 if (EQ (left
, Qminus
))
1017 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1018 else if (INTEGERP (left
))
1020 leftpos
= XINT (left
);
1022 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1024 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1025 && CONSP (XCDR (left
))
1026 && INTEGERP (XCAR (XCDR (left
))))
1028 leftpos
= - XINT (XCAR (XCDR (left
)));
1029 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1031 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1032 && CONSP (XCDR (left
))
1033 && INTEGERP (XCAR (XCDR (left
))))
1035 leftpos
= XINT (XCAR (XCDR (left
)));
1038 if (EQ (top
, Qminus
))
1039 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1040 else if (INTEGERP (top
))
1042 toppos
= XINT (top
);
1044 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1046 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1047 && CONSP (XCDR (top
))
1048 && INTEGERP (XCAR (XCDR (top
))))
1050 toppos
= - XINT (XCAR (XCDR (top
)));
1051 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1053 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1054 && CONSP (XCDR (top
))
1055 && INTEGERP (XCAR (XCDR (top
))))
1057 toppos
= XINT (XCAR (XCDR (top
)));
1061 /* Store the numeric value of the position. */
1062 f
->output_data
.x
->top_pos
= toppos
;
1063 f
->output_data
.x
->left_pos
= leftpos
;
1065 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1067 /* Actually set that position, and convert to absolute. */
1068 x_set_offset (f
, leftpos
, toppos
, -1);
1071 if ((!NILP (icon_left
) || !NILP (icon_top
))
1072 && ! (icon_left_no_change
&& icon_top_no_change
))
1073 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1079 /* Store the screen positions of frame F into XPTR and YPTR.
1080 These are the positions of the containing window manager window,
1081 not Emacs's own window. */
1084 x_real_positions (f
, xptr
, yptr
)
1091 /* This is pretty gross, but seems to be the easiest way out of
1092 the problem that arises when restarting window-managers. */
1094 #ifdef USE_X_TOOLKIT
1095 Window outer
= (f
->output_data
.x
->widget
1096 ? XtWindow (f
->output_data
.x
->widget
)
1097 : FRAME_X_WINDOW (f
));
1099 Window outer
= f
->output_data
.x
->window_desc
;
1101 Window tmp_root_window
;
1102 Window
*tmp_children
;
1103 unsigned int tmp_nchildren
;
1107 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1108 Window outer_window
;
1110 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1111 &f
->output_data
.x
->parent_desc
,
1112 &tmp_children
, &tmp_nchildren
);
1113 XFree ((char *) tmp_children
);
1117 /* Find the position of the outside upper-left corner of
1118 the inner window, with respect to the outer window. */
1119 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1120 outer_window
= f
->output_data
.x
->parent_desc
;
1122 outer_window
= outer
;
1124 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1126 /* From-window, to-window. */
1128 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1130 /* From-position, to-position. */
1131 0, 0, &win_x
, &win_y
,
1136 /* It is possible for the window returned by the XQueryNotify
1137 to become invalid by the time we call XTranslateCoordinates.
1138 That can happen when you restart some window managers.
1139 If so, we get an error in XTranslateCoordinates.
1140 Detect that and try the whole thing over. */
1141 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1143 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1147 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1154 /* Insert a description of internally-recorded parameters of frame X
1155 into the parameter alist *ALISTPTR that is to be given to the user.
1156 Only parameters that are specific to the X window system
1157 and whose values are not correctly recorded in the frame's
1158 param_alist need to be considered here. */
1161 x_report_frame_params (f
, alistptr
)
1163 Lisp_Object
*alistptr
;
1168 /* Represent negative positions (off the top or left screen edge)
1169 in a way that Fmodify_frame_parameters will understand correctly. */
1170 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1171 if (f
->output_data
.x
->left_pos
>= 0)
1172 store_in_alist (alistptr
, Qleft
, tem
);
1174 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1176 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1177 if (f
->output_data
.x
->top_pos
>= 0)
1178 store_in_alist (alistptr
, Qtop
, tem
);
1180 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1182 store_in_alist (alistptr
, Qborder_width
,
1183 make_number (f
->output_data
.x
->border_width
));
1184 store_in_alist (alistptr
, Qinternal_border_width
,
1185 make_number (f
->output_data
.x
->internal_border_width
));
1186 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1187 store_in_alist (alistptr
, Qwindow_id
,
1188 build_string (buf
));
1189 #ifdef USE_X_TOOLKIT
1190 /* Tooltip frame may not have this widget. */
1191 if (f
->output_data
.x
->widget
)
1193 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1194 store_in_alist (alistptr
, Qouter_window_id
,
1195 build_string (buf
));
1196 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1197 FRAME_SAMPLE_VISIBILITY (f
);
1198 store_in_alist (alistptr
, Qvisibility
,
1199 (FRAME_VISIBLE_P (f
) ? Qt
1200 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1201 store_in_alist (alistptr
, Qdisplay
,
1202 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1204 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1207 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1208 store_in_alist (alistptr
, Qparent_id
, tem
);
1213 /* Gamma-correct COLOR on frame F. */
1216 gamma_correct (f
, color
)
1222 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1223 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1224 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1229 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1230 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1231 allocate the color. Value is zero if COLOR_NAME is invalid, or
1232 no color could be allocated. */
1235 x_defined_color (f
, color_name
, color
, alloc_p
)
1242 Display
*dpy
= FRAME_X_DISPLAY (f
);
1243 Colormap cmap
= FRAME_X_COLORMAP (f
);
1246 success_p
= XParseColor (dpy
, cmap
, color_name
, color
);
1247 if (success_p
&& alloc_p
)
1248 success_p
= x_alloc_nearest_color (f
, cmap
, color
);
1255 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1256 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1257 Signal an error if color can't be allocated. */
1260 x_decode_color (f
, color_name
, mono_color
)
1262 Lisp_Object color_name
;
1267 CHECK_STRING (color_name
, 0);
1269 #if 0 /* Don't do this. It's wrong when we're not using the default
1270 colormap, it makes freeing difficult, and it's probably not
1271 an important optimization. */
1272 if (strcmp (XSTRING (color_name
)->data
, "black") == 0)
1273 return BLACK_PIX_DEFAULT (f
);
1274 else if (strcmp (XSTRING (color_name
)->data
, "white") == 0)
1275 return WHITE_PIX_DEFAULT (f
);
1278 /* Return MONO_COLOR for monochrome frames. */
1279 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1282 /* x_defined_color is responsible for coping with failures
1283 by looking for a near-miss. */
1284 if (x_defined_color (f
, XSTRING (color_name
)->data
, &cdef
, 1))
1287 Fsignal (Qerror
, Fcons (build_string ("Undefined color"),
1288 Fcons (color_name
, Qnil
)));
1294 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1295 the previous value of that parameter, NEW_VALUE is the new value. */
1298 x_set_line_spacing (f
, new_value
, old_value
)
1300 Lisp_Object new_value
, old_value
;
1302 if (NILP (new_value
))
1303 f
->extra_line_spacing
= 0;
1304 else if (NATNUMP (new_value
))
1305 f
->extra_line_spacing
= XFASTINT (new_value
);
1307 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1308 Fcons (new_value
, Qnil
)));
1309 if (FRAME_VISIBLE_P (f
))
1314 /* Change the `wait-for-wm' frame parameter of frame F. OLD_VALUE is
1315 the previous value of that parameter, NEW_VALUE is the new value.
1316 See also the comment of wait_for_wm in struct x_output. */
1319 x_set_wait_for_wm (f
, new_value
, old_value
)
1321 Lisp_Object new_value
, old_value
;
1323 f
->output_data
.x
->wait_for_wm
= !NILP (new_value
);
1327 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1328 the previous value of that parameter, NEW_VALUE is the new
1332 x_set_screen_gamma (f
, new_value
, old_value
)
1334 Lisp_Object new_value
, old_value
;
1336 if (NILP (new_value
))
1338 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1339 /* The value 0.4545 is the normal viewing gamma. */
1340 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1342 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1343 Fcons (new_value
, Qnil
)));
1345 clear_face_cache (0);
1349 /* Functions called only from `x_set_frame_param'
1350 to set individual parameters.
1352 If FRAME_X_WINDOW (f) is 0,
1353 the frame is being created and its X-window does not exist yet.
1354 In that case, just record the parameter's new value
1355 in the standard place; do not attempt to change the window. */
1358 x_set_foreground_color (f
, arg
, oldval
)
1360 Lisp_Object arg
, oldval
;
1362 struct x_output
*x
= f
->output_data
.x
;
1363 unsigned long fg
, old_fg
;
1365 fg
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1366 old_fg
= x
->foreground_pixel
;
1367 x
->foreground_pixel
= fg
;
1369 if (FRAME_X_WINDOW (f
) != 0)
1371 Display
*dpy
= FRAME_X_DISPLAY (f
);
1374 XSetForeground (dpy
, x
->normal_gc
, fg
);
1375 XSetBackground (dpy
, x
->reverse_gc
, fg
);
1377 if (x
->cursor_pixel
== old_fg
)
1379 unload_color (f
, x
->cursor_pixel
);
1380 x
->cursor_pixel
= x_copy_color (f
, fg
);
1381 XSetBackground (dpy
, x
->cursor_gc
, x
->cursor_pixel
);
1386 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1388 if (FRAME_VISIBLE_P (f
))
1392 unload_color (f
, old_fg
);
1396 x_set_background_color (f
, arg
, oldval
)
1398 Lisp_Object arg
, oldval
;
1400 struct x_output
*x
= f
->output_data
.x
;
1403 bg
= x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1404 unload_color (f
, x
->background_pixel
);
1405 x
->background_pixel
= bg
;
1407 if (FRAME_X_WINDOW (f
) != 0)
1409 Display
*dpy
= FRAME_X_DISPLAY (f
);
1412 XSetBackground (dpy
, x
->normal_gc
, bg
);
1413 XSetForeground (dpy
, x
->reverse_gc
, bg
);
1414 XSetWindowBackground (dpy
, FRAME_X_WINDOW (f
), bg
);
1415 XSetForeground (dpy
, x
->cursor_gc
, bg
);
1417 #ifndef USE_TOOLKIT_SCROLL_BARS /* Turns out to be annoying with
1418 toolkit scroll bars. */
1421 for (bar
= FRAME_SCROLL_BARS (f
);
1423 bar
= XSCROLL_BAR (bar
)->next
)
1425 Window window
= SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
));
1426 XSetWindowBackground (dpy
, window
, bg
);
1429 #endif /* USE_TOOLKIT_SCROLL_BARS */
1432 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1434 if (FRAME_VISIBLE_P (f
))
1440 x_set_mouse_color (f
, arg
, oldval
)
1442 Lisp_Object arg
, oldval
;
1444 struct x_output
*x
= f
->output_data
.x
;
1445 Display
*dpy
= FRAME_X_DISPLAY (f
);
1446 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1447 Cursor hourglass_cursor
, horizontal_drag_cursor
;
1449 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1450 unsigned long mask_color
= x
->background_pixel
;
1452 /* Don't let pointers be invisible. */
1453 if (mask_color
== pixel
)
1455 x_free_colors (f
, &pixel
, 1);
1456 pixel
= x_copy_color (f
, x
->foreground_pixel
);
1459 unload_color (f
, x
->mouse_pixel
);
1460 x
->mouse_pixel
= pixel
;
1464 /* It's not okay to crash if the user selects a screwy cursor. */
1465 count
= x_catch_errors (dpy
);
1467 if (!NILP (Vx_pointer_shape
))
1469 CHECK_NUMBER (Vx_pointer_shape
, 0);
1470 cursor
= XCreateFontCursor (dpy
, XINT (Vx_pointer_shape
));
1473 cursor
= XCreateFontCursor (dpy
, XC_xterm
);
1474 x_check_errors (dpy
, "bad text pointer cursor: %s");
1476 if (!NILP (Vx_nontext_pointer_shape
))
1478 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1480 = XCreateFontCursor (dpy
, XINT (Vx_nontext_pointer_shape
));
1483 nontext_cursor
= XCreateFontCursor (dpy
, XC_left_ptr
);
1484 x_check_errors (dpy
, "bad nontext pointer cursor: %s");
1486 if (!NILP (Vx_hourglass_pointer_shape
))
1488 CHECK_NUMBER (Vx_hourglass_pointer_shape
, 0);
1490 = XCreateFontCursor (dpy
, XINT (Vx_hourglass_pointer_shape
));
1493 hourglass_cursor
= XCreateFontCursor (dpy
, XC_watch
);
1494 x_check_errors (dpy
, "bad hourglass pointer cursor: %s");
1496 x_check_errors (dpy
, "bad nontext pointer cursor: %s");
1497 if (!NILP (Vx_mode_pointer_shape
))
1499 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1500 mode_cursor
= XCreateFontCursor (dpy
, XINT (Vx_mode_pointer_shape
));
1503 mode_cursor
= XCreateFontCursor (dpy
, XC_xterm
);
1504 x_check_errors (dpy
, "bad modeline pointer cursor: %s");
1506 if (!NILP (Vx_sensitive_text_pointer_shape
))
1508 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1510 = XCreateFontCursor (dpy
, XINT (Vx_sensitive_text_pointer_shape
));
1513 cross_cursor
= XCreateFontCursor (dpy
, XC_crosshair
);
1515 if (!NILP (Vx_window_horizontal_drag_shape
))
1517 CHECK_NUMBER (Vx_window_horizontal_drag_shape
, 0);
1518 horizontal_drag_cursor
1519 = XCreateFontCursor (dpy
, XINT (Vx_window_horizontal_drag_shape
));
1522 horizontal_drag_cursor
1523 = XCreateFontCursor (dpy
, XC_sb_h_double_arrow
);
1525 /* Check and report errors with the above calls. */
1526 x_check_errors (dpy
, "can't set cursor shape: %s");
1527 x_uncatch_errors (dpy
, count
);
1530 XColor fore_color
, back_color
;
1532 fore_color
.pixel
= x
->mouse_pixel
;
1533 x_query_color (f
, &fore_color
);
1534 back_color
.pixel
= mask_color
;
1535 x_query_color (f
, &back_color
);
1537 XRecolorCursor (dpy
, cursor
, &fore_color
, &back_color
);
1538 XRecolorCursor (dpy
, nontext_cursor
, &fore_color
, &back_color
);
1539 XRecolorCursor (dpy
, mode_cursor
, &fore_color
, &back_color
);
1540 XRecolorCursor (dpy
, cross_cursor
, &fore_color
, &back_color
);
1541 XRecolorCursor (dpy
, hourglass_cursor
, &fore_color
, &back_color
);
1542 XRecolorCursor (dpy
, horizontal_drag_cursor
, &fore_color
, &back_color
);
1545 if (FRAME_X_WINDOW (f
) != 0)
1546 XDefineCursor (dpy
, FRAME_X_WINDOW (f
), cursor
);
1548 if (cursor
!= x
->text_cursor
1549 && x
->text_cursor
!= 0)
1550 XFreeCursor (dpy
, x
->text_cursor
);
1551 x
->text_cursor
= cursor
;
1553 if (nontext_cursor
!= x
->nontext_cursor
1554 && x
->nontext_cursor
!= 0)
1555 XFreeCursor (dpy
, x
->nontext_cursor
);
1556 x
->nontext_cursor
= nontext_cursor
;
1558 if (hourglass_cursor
!= x
->hourglass_cursor
1559 && x
->hourglass_cursor
!= 0)
1560 XFreeCursor (dpy
, x
->hourglass_cursor
);
1561 x
->hourglass_cursor
= hourglass_cursor
;
1563 if (mode_cursor
!= x
->modeline_cursor
1564 && x
->modeline_cursor
!= 0)
1565 XFreeCursor (dpy
, f
->output_data
.x
->modeline_cursor
);
1566 x
->modeline_cursor
= mode_cursor
;
1568 if (cross_cursor
!= x
->cross_cursor
1569 && x
->cross_cursor
!= 0)
1570 XFreeCursor (dpy
, x
->cross_cursor
);
1571 x
->cross_cursor
= cross_cursor
;
1573 if (horizontal_drag_cursor
!= x
->horizontal_drag_cursor
1574 && x
->horizontal_drag_cursor
!= 0)
1575 XFreeCursor (dpy
, x
->horizontal_drag_cursor
);
1576 x
->horizontal_drag_cursor
= horizontal_drag_cursor
;
1581 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1585 x_set_cursor_color (f
, arg
, oldval
)
1587 Lisp_Object arg
, oldval
;
1589 unsigned long fore_pixel
, pixel
;
1590 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1591 struct x_output
*x
= f
->output_data
.x
;
1593 if (!NILP (Vx_cursor_fore_pixel
))
1595 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1596 WHITE_PIX_DEFAULT (f
));
1597 fore_pixel_allocated_p
= 1;
1600 fore_pixel
= x
->background_pixel
;
1602 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1603 pixel_allocated_p
= 1;
1605 /* Make sure that the cursor color differs from the background color. */
1606 if (pixel
== x
->background_pixel
)
1608 if (pixel_allocated_p
)
1610 x_free_colors (f
, &pixel
, 1);
1611 pixel_allocated_p
= 0;
1614 pixel
= x
->mouse_pixel
;
1615 if (pixel
== fore_pixel
)
1617 if (fore_pixel_allocated_p
)
1619 x_free_colors (f
, &fore_pixel
, 1);
1620 fore_pixel_allocated_p
= 0;
1622 fore_pixel
= x
->background_pixel
;
1626 unload_color (f
, x
->cursor_foreground_pixel
);
1627 if (!fore_pixel_allocated_p
)
1628 fore_pixel
= x_copy_color (f
, fore_pixel
);
1629 x
->cursor_foreground_pixel
= fore_pixel
;
1631 unload_color (f
, x
->cursor_pixel
);
1632 if (!pixel_allocated_p
)
1633 pixel
= x_copy_color (f
, pixel
);
1634 x
->cursor_pixel
= pixel
;
1636 if (FRAME_X_WINDOW (f
) != 0)
1639 XSetBackground (FRAME_X_DISPLAY (f
), x
->cursor_gc
, x
->cursor_pixel
);
1640 XSetForeground (FRAME_X_DISPLAY (f
), x
->cursor_gc
, fore_pixel
);
1643 if (FRAME_VISIBLE_P (f
))
1645 x_update_cursor (f
, 0);
1646 x_update_cursor (f
, 1);
1650 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1653 /* Set the border-color of frame F to value described by ARG.
1654 ARG can be a string naming a color.
1655 The border-color is used for the border that is drawn by the X server.
1656 Note that this does not fully take effect if done before
1657 F has an x-window; it must be redone when the window is created.
1659 Note: this is done in two routines because of the way X10 works.
1661 Note: under X11, this is normally the province of the window manager,
1662 and so emacs' border colors may be overridden. */
1665 x_set_border_color (f
, arg
, oldval
)
1667 Lisp_Object arg
, oldval
;
1671 CHECK_STRING (arg
, 0);
1672 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1673 x_set_border_pixel (f
, pix
);
1674 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1677 /* Set the border-color of frame F to pixel value PIX.
1678 Note that this does not fully take effect if done before
1679 F has an x-window. */
1682 x_set_border_pixel (f
, pix
)
1686 unload_color (f
, f
->output_data
.x
->border_pixel
);
1687 f
->output_data
.x
->border_pixel
= pix
;
1689 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1692 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1693 (unsigned long)pix
);
1696 if (FRAME_VISIBLE_P (f
))
1702 /* Value is the internal representation of the specified cursor type
1703 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1704 of the bar cursor. */
1706 enum text_cursor_kinds
1707 x_specified_cursor_type (arg
, width
)
1711 enum text_cursor_kinds type
;
1718 else if (CONSP (arg
)
1719 && EQ (XCAR (arg
), Qbar
)
1720 && INTEGERP (XCDR (arg
))
1721 && XINT (XCDR (arg
)) >= 0)
1724 *width
= XINT (XCDR (arg
));
1726 else if (NILP (arg
))
1729 /* Treat anything unknown as "box cursor".
1730 It was bad to signal an error; people have trouble fixing
1731 .Xdefaults with Emacs, when it has something bad in it. */
1732 type
= FILLED_BOX_CURSOR
;
1738 x_set_cursor_type (f
, arg
, oldval
)
1740 Lisp_Object arg
, oldval
;
1744 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1745 f
->output_data
.x
->cursor_width
= width
;
1747 /* Make sure the cursor gets redrawn. This is overkill, but how
1748 often do people change cursor types? */
1749 update_mode_lines
++;
1753 x_set_icon_type (f
, arg
, oldval
)
1755 Lisp_Object arg
, oldval
;
1761 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1764 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1769 result
= x_text_icon (f
,
1770 (char *) XSTRING ((!NILP (f
->icon_name
)
1774 result
= x_bitmap_icon (f
, arg
);
1779 error ("No icon window available");
1782 XFlush (FRAME_X_DISPLAY (f
));
1786 /* Return non-nil if frame F wants a bitmap icon. */
1794 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1802 x_set_icon_name (f
, arg
, oldval
)
1804 Lisp_Object arg
, oldval
;
1810 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1813 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1818 if (f
->output_data
.x
->icon_bitmap
!= 0)
1823 result
= x_text_icon (f
,
1824 (char *) XSTRING ((!NILP (f
->icon_name
)
1833 error ("No icon window available");
1836 XFlush (FRAME_X_DISPLAY (f
));
1841 x_set_font (f
, arg
, oldval
)
1843 Lisp_Object arg
, oldval
;
1846 Lisp_Object fontset_name
;
1848 int old_fontset
= f
->output_data
.x
->fontset
;
1850 CHECK_STRING (arg
, 1);
1852 fontset_name
= Fquery_fontset (arg
, Qnil
);
1855 result
= (STRINGP (fontset_name
)
1856 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1857 : x_new_font (f
, XSTRING (arg
)->data
));
1860 if (EQ (result
, Qnil
))
1861 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1862 else if (EQ (result
, Qt
))
1863 error ("The characters of the given font have varying widths");
1864 else if (STRINGP (result
))
1866 if (STRINGP (fontset_name
))
1868 /* Fontset names are built from ASCII font names, so the
1869 names may be equal despite there was a change. */
1870 if (old_fontset
== f
->output_data
.x
->fontset
)
1873 else if (!NILP (Fequal (result
, oldval
)))
1876 store_frame_param (f
, Qfont
, result
);
1877 recompute_basic_faces (f
);
1882 do_pending_window_change (0);
1884 /* Don't call `face-set-after-frame-default' when faces haven't been
1885 initialized yet. This is the case when called from
1886 Fx_create_frame. In that case, the X widget or window doesn't
1887 exist either, and we can end up in x_report_frame_params with a
1888 null widget which gives a segfault. */
1889 if (FRAME_FACE_CACHE (f
))
1891 XSETFRAME (frame
, f
);
1892 call1 (Qface_set_after_frame_default
, frame
);
1897 x_set_border_width (f
, arg
, oldval
)
1899 Lisp_Object arg
, oldval
;
1901 CHECK_NUMBER (arg
, 0);
1903 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1906 if (FRAME_X_WINDOW (f
) != 0)
1907 error ("Cannot change the border width of a window");
1909 f
->output_data
.x
->border_width
= XINT (arg
);
1913 x_set_internal_border_width (f
, arg
, oldval
)
1915 Lisp_Object arg
, oldval
;
1917 int old
= f
->output_data
.x
->internal_border_width
;
1919 CHECK_NUMBER (arg
, 0);
1920 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1921 if (f
->output_data
.x
->internal_border_width
< 0)
1922 f
->output_data
.x
->internal_border_width
= 0;
1924 #ifdef USE_X_TOOLKIT
1925 if (f
->output_data
.x
->edit_widget
)
1926 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1929 if (f
->output_data
.x
->internal_border_width
== old
)
1932 if (FRAME_X_WINDOW (f
) != 0)
1934 x_set_window_size (f
, 0, f
->width
, f
->height
);
1935 SET_FRAME_GARBAGED (f
);
1936 do_pending_window_change (0);
1941 x_set_visibility (f
, value
, oldval
)
1943 Lisp_Object value
, oldval
;
1946 XSETFRAME (frame
, f
);
1949 Fmake_frame_invisible (frame
, Qt
);
1950 else if (EQ (value
, Qicon
))
1951 Ficonify_frame (frame
);
1953 Fmake_frame_visible (frame
);
1957 /* Change window heights in windows rooted in WINDOW by N lines. */
1960 x_change_window_heights (window
, n
)
1964 struct window
*w
= XWINDOW (window
);
1966 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1967 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1969 if (INTEGERP (w
->orig_top
))
1970 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
1971 if (INTEGERP (w
->orig_height
))
1972 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
1974 /* Handle just the top child in a vertical split. */
1975 if (!NILP (w
->vchild
))
1976 x_change_window_heights (w
->vchild
, n
);
1978 /* Adjust all children in a horizontal split. */
1979 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1981 w
= XWINDOW (window
);
1982 x_change_window_heights (window
, n
);
1987 x_set_menu_bar_lines (f
, value
, oldval
)
1989 Lisp_Object value
, oldval
;
1992 #ifndef USE_X_TOOLKIT
1993 int olines
= FRAME_MENU_BAR_LINES (f
);
1996 /* Right now, menu bars don't work properly in minibuf-only frames;
1997 most of the commands try to apply themselves to the minibuffer
1998 frame itself, and get an error because you can't switch buffers
1999 in or split the minibuffer window. */
2000 if (FRAME_MINIBUF_ONLY_P (f
))
2003 if (INTEGERP (value
))
2004 nlines
= XINT (value
);
2008 /* Make sure we redisplay all windows in this frame. */
2009 windows_or_buffers_changed
++;
2011 #ifdef USE_X_TOOLKIT
2012 FRAME_MENU_BAR_LINES (f
) = 0;
2015 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2016 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
2017 /* Make sure next redisplay shows the menu bar. */
2018 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
2022 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2023 free_frame_menubar (f
);
2024 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2026 f
->output_data
.x
->menubar_widget
= 0;
2028 #else /* not USE_X_TOOLKIT */
2029 FRAME_MENU_BAR_LINES (f
) = nlines
;
2030 x_change_window_heights (f
->root_window
, nlines
- olines
);
2031 #endif /* not USE_X_TOOLKIT */
2036 /* Set the number of lines used for the tool bar of frame F to VALUE.
2037 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2038 is the old number of tool bar lines. This function changes the
2039 height of all windows on frame F to match the new tool bar height.
2040 The frame's height doesn't change. */
2043 x_set_tool_bar_lines (f
, value
, oldval
)
2045 Lisp_Object value
, oldval
;
2047 int delta
, nlines
, root_height
;
2048 Lisp_Object root_window
;
2050 /* Treat tool bars like menu bars. */
2051 if (FRAME_MINIBUF_ONLY_P (f
))
2054 /* Use VALUE only if an integer >= 0. */
2055 if (INTEGERP (value
) && XINT (value
) >= 0)
2056 nlines
= XFASTINT (value
);
2060 /* Make sure we redisplay all windows in this frame. */
2061 ++windows_or_buffers_changed
;
2063 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2065 /* Don't resize the tool-bar to more than we have room for. */
2066 root_window
= FRAME_ROOT_WINDOW (f
);
2067 root_height
= XINT (XWINDOW (root_window
)->height
);
2068 if (root_height
- delta
< 1)
2070 delta
= root_height
- 1;
2071 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2074 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2075 x_change_window_heights (root_window
, delta
);
2078 /* We also have to make sure that the internal border at the top of
2079 the frame, below the menu bar or tool bar, is redrawn when the
2080 tool bar disappears. This is so because the internal border is
2081 below the tool bar if one is displayed, but is below the menu bar
2082 if there isn't a tool bar. The tool bar draws into the area
2083 below the menu bar. */
2084 if (FRAME_X_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2088 clear_current_matrices (f
);
2089 updating_frame
= NULL
;
2092 /* If the tool bar gets smaller, the internal border below it
2093 has to be cleared. It was formerly part of the display
2094 of the larger tool bar, and updating windows won't clear it. */
2097 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2098 int width
= PIXEL_WIDTH (f
);
2099 int y
= nlines
* CANON_Y_UNIT (f
);
2102 x_clear_area (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2103 0, y
, width
, height
, False
);
2106 if (WINDOWP (f
->tool_bar_window
))
2107 clear_glyph_matrix (XWINDOW (f
->tool_bar_window
)->current_matrix
);
2112 /* Set the foreground color for scroll bars on frame F to VALUE.
2113 VALUE should be a string, a color name. If it isn't a string or
2114 isn't a valid color name, do nothing. OLDVAL is the old value of
2115 the frame parameter. */
2118 x_set_scroll_bar_foreground (f
, value
, oldval
)
2120 Lisp_Object value
, oldval
;
2122 unsigned long pixel
;
2124 if (STRINGP (value
))
2125 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2129 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2130 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2132 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2133 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2135 /* Remove all scroll bars because they have wrong colors. */
2136 if (condemn_scroll_bars_hook
)
2137 (*condemn_scroll_bars_hook
) (f
);
2138 if (judge_scroll_bars_hook
)
2139 (*judge_scroll_bars_hook
) (f
);
2141 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2147 /* Set the background color for scroll bars on frame F to VALUE VALUE
2148 should be a string, a color name. If it isn't a string or isn't a
2149 valid color name, do nothing. OLDVAL is the old value of the frame
2153 x_set_scroll_bar_background (f
, value
, oldval
)
2155 Lisp_Object value
, oldval
;
2157 unsigned long pixel
;
2159 if (STRINGP (value
))
2160 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2164 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2165 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2167 #ifdef USE_TOOLKIT_SCROLL_BARS
2168 /* Scrollbar shadow colors. */
2169 if (f
->output_data
.x
->scroll_bar_top_shadow_pixel
!= -1)
2171 unload_color (f
, f
->output_data
.x
->scroll_bar_top_shadow_pixel
);
2172 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
2174 if (f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
!= -1)
2176 unload_color (f
, f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
);
2177 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
2179 #endif /* USE_TOOLKIT_SCROLL_BARS */
2181 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2182 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2184 /* Remove all scroll bars because they have wrong colors. */
2185 if (condemn_scroll_bars_hook
)
2186 (*condemn_scroll_bars_hook
) (f
);
2187 if (judge_scroll_bars_hook
)
2188 (*judge_scroll_bars_hook
) (f
);
2190 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2196 /* Encode Lisp string STRING as a text in a format appropriate for
2197 XICCC (X Inter Client Communication Conventions).
2199 If STRING contains only ASCII characters, do no conversion and
2200 return the string data of STRING. Otherwise, encode the text by
2201 CODING_SYSTEM, and return a newly allocated memory area which
2202 should be freed by `xfree' by a caller.
2204 Store the byte length of resulting text in *TEXT_BYTES.
2206 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2207 which means that the `encoding' of the result can be `STRING'.
2208 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2209 the result should be `COMPOUND_TEXT'. */
2212 x_encode_text (string
, coding_system
, text_bytes
, stringp
)
2213 Lisp_Object string
, coding_system
;
2214 int *text_bytes
, *stringp
;
2216 unsigned char *str
= XSTRING (string
)->data
;
2217 int chars
= XSTRING (string
)->size
;
2218 int bytes
= STRING_BYTES (XSTRING (string
));
2222 struct coding_system coding
;
2224 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2225 if (charset_info
== 0)
2227 /* No multibyte character in OBJ. We need not encode it. */
2228 *text_bytes
= bytes
;
2233 setup_coding_system (coding_system
, &coding
);
2234 coding
.src_multibyte
= 1;
2235 coding
.dst_multibyte
= 0;
2236 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2237 if (coding
.type
== coding_type_iso2022
)
2238 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2239 /* We suppress producing escape sequences for composition. */
2240 coding
.composing
= COMPOSITION_DISABLED
;
2241 bufsize
= encoding_buffer_size (&coding
, bytes
);
2242 buf
= (unsigned char *) xmalloc (bufsize
);
2243 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2244 *text_bytes
= coding
.produced
;
2245 *stringp
= (charset_info
== 1 || !EQ (coding_system
, Qcompound_text
));
2250 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2253 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2254 name; if NAME is a string, set F's name to NAME and set
2255 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2257 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2258 suggesting a new name, which lisp code should override; if
2259 F->explicit_name is set, ignore the new name; otherwise, set it. */
2262 x_set_name (f
, name
, explicit)
2267 /* Make sure that requests from lisp code override requests from
2268 Emacs redisplay code. */
2271 /* If we're switching from explicit to implicit, we had better
2272 update the mode lines and thereby update the title. */
2273 if (f
->explicit_name
&& NILP (name
))
2274 update_mode_lines
= 1;
2276 f
->explicit_name
= ! NILP (name
);
2278 else if (f
->explicit_name
)
2281 /* If NAME is nil, set the name to the x_id_name. */
2284 /* Check for no change needed in this very common case
2285 before we do any consing. */
2286 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2287 XSTRING (f
->name
)->data
))
2289 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2292 CHECK_STRING (name
, 0);
2294 /* Don't change the name if it's already NAME. */
2295 if (! NILP (Fstring_equal (name
, f
->name
)))
2300 /* For setting the frame title, the title parameter should override
2301 the name parameter. */
2302 if (! NILP (f
->title
))
2305 if (FRAME_X_WINDOW (f
))
2310 XTextProperty text
, icon
;
2312 Lisp_Object coding_system
;
2314 coding_system
= Vlocale_coding_system
;
2315 if (NILP (coding_system
))
2316 coding_system
= Qcompound_text
;
2317 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2318 text
.encoding
= (stringp
? XA_STRING
2319 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2321 text
.nitems
= bytes
;
2323 if (NILP (f
->icon_name
))
2329 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2331 icon
.encoding
= (stringp
? XA_STRING
2332 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2334 icon
.nitems
= bytes
;
2336 #ifdef USE_X_TOOLKIT
2337 XSetWMName (FRAME_X_DISPLAY (f
),
2338 XtWindow (f
->output_data
.x
->widget
), &text
);
2339 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2341 #else /* not USE_X_TOOLKIT */
2342 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2343 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2344 #endif /* not USE_X_TOOLKIT */
2345 if (!NILP (f
->icon_name
)
2346 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2348 if (text
.value
!= XSTRING (name
)->data
)
2351 #else /* not HAVE_X11R4 */
2352 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2353 XSTRING (name
)->data
);
2354 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2355 XSTRING (name
)->data
);
2356 #endif /* not HAVE_X11R4 */
2361 /* This function should be called when the user's lisp code has
2362 specified a name for the frame; the name will override any set by the
2365 x_explicitly_set_name (f
, arg
, oldval
)
2367 Lisp_Object arg
, oldval
;
2369 x_set_name (f
, arg
, 1);
2372 /* This function should be called by Emacs redisplay code to set the
2373 name; names set this way will never override names set by the user's
2376 x_implicitly_set_name (f
, arg
, oldval
)
2378 Lisp_Object arg
, oldval
;
2380 x_set_name (f
, arg
, 0);
2383 /* Change the title of frame F to NAME.
2384 If NAME is nil, use the frame name as the title.
2386 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2387 name; if NAME is a string, set F's name to NAME and set
2388 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2390 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2391 suggesting a new name, which lisp code should override; if
2392 F->explicit_name is set, ignore the new name; otherwise, set it. */
2395 x_set_title (f
, name
, old_name
)
2397 Lisp_Object name
, old_name
;
2399 /* Don't change the title if it's already NAME. */
2400 if (EQ (name
, f
->title
))
2403 update_mode_lines
= 1;
2410 CHECK_STRING (name
, 0);
2412 if (FRAME_X_WINDOW (f
))
2417 XTextProperty text
, icon
;
2419 Lisp_Object coding_system
;
2421 coding_system
= Vlocale_coding_system
;
2422 if (NILP (coding_system
))
2423 coding_system
= Qcompound_text
;
2424 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2425 text
.encoding
= (stringp
? XA_STRING
2426 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2428 text
.nitems
= bytes
;
2430 if (NILP (f
->icon_name
))
2436 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2438 icon
.encoding
= (stringp
? XA_STRING
2439 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2441 icon
.nitems
= bytes
;
2443 #ifdef USE_X_TOOLKIT
2444 XSetWMName (FRAME_X_DISPLAY (f
),
2445 XtWindow (f
->output_data
.x
->widget
), &text
);
2446 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2448 #else /* not USE_X_TOOLKIT */
2449 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2450 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2451 #endif /* not USE_X_TOOLKIT */
2452 if (!NILP (f
->icon_name
)
2453 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2455 if (text
.value
!= XSTRING (name
)->data
)
2458 #else /* not HAVE_X11R4 */
2459 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2460 XSTRING (name
)->data
);
2461 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2462 XSTRING (name
)->data
);
2463 #endif /* not HAVE_X11R4 */
2469 x_set_autoraise (f
, arg
, oldval
)
2471 Lisp_Object arg
, oldval
;
2473 f
->auto_raise
= !EQ (Qnil
, arg
);
2477 x_set_autolower (f
, arg
, oldval
)
2479 Lisp_Object arg
, oldval
;
2481 f
->auto_lower
= !EQ (Qnil
, arg
);
2485 x_set_unsplittable (f
, arg
, oldval
)
2487 Lisp_Object arg
, oldval
;
2489 f
->no_split
= !NILP (arg
);
2493 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2495 Lisp_Object arg
, oldval
;
2497 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2498 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2499 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2500 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2502 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2504 ? vertical_scroll_bar_none
2506 ? vertical_scroll_bar_right
2507 : vertical_scroll_bar_left
);
2509 /* We set this parameter before creating the X window for the
2510 frame, so we can get the geometry right from the start.
2511 However, if the window hasn't been created yet, we shouldn't
2512 call x_set_window_size. */
2513 if (FRAME_X_WINDOW (f
))
2514 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2515 do_pending_window_change (0);
2520 x_set_scroll_bar_width (f
, arg
, oldval
)
2522 Lisp_Object arg
, oldval
;
2524 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2528 #ifdef USE_TOOLKIT_SCROLL_BARS
2529 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2530 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2531 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2532 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2534 /* Make the actual width at least 14 pixels and a multiple of a
2536 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2538 /* Use all of that space (aside from required margins) for the
2540 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2543 if (FRAME_X_WINDOW (f
))
2544 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2545 do_pending_window_change (0);
2547 else if (INTEGERP (arg
) && XINT (arg
) > 0
2548 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2550 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2551 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2553 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2554 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2555 if (FRAME_X_WINDOW (f
))
2556 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2559 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2560 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2561 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2566 /* Subroutines of creating an X frame. */
2568 /* Make sure that Vx_resource_name is set to a reasonable value.
2569 Fix it up, or set it to `emacs' if it is too hopeless. */
2572 validate_x_resource_name ()
2575 /* Number of valid characters in the resource name. */
2577 /* Number of invalid characters in the resource name. */
2582 if (!STRINGP (Vx_resource_class
))
2583 Vx_resource_class
= build_string (EMACS_CLASS
);
2585 if (STRINGP (Vx_resource_name
))
2587 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2590 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2592 /* Only letters, digits, - and _ are valid in resource names.
2593 Count the valid characters and count the invalid ones. */
2594 for (i
= 0; i
< len
; i
++)
2597 if (! ((c
>= 'a' && c
<= 'z')
2598 || (c
>= 'A' && c
<= 'Z')
2599 || (c
>= '0' && c
<= '9')
2600 || c
== '-' || c
== '_'))
2607 /* Not a string => completely invalid. */
2608 bad_count
= 5, good_count
= 0;
2610 /* If name is valid already, return. */
2614 /* If name is entirely invalid, or nearly so, use `emacs'. */
2616 || (good_count
== 1 && bad_count
> 0))
2618 Vx_resource_name
= build_string ("emacs");
2622 /* Name is partly valid. Copy it and replace the invalid characters
2623 with underscores. */
2625 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2627 for (i
= 0; i
< len
; i
++)
2629 int c
= XSTRING (new)->data
[i
];
2630 if (! ((c
>= 'a' && c
<= 'z')
2631 || (c
>= 'A' && c
<= 'Z')
2632 || (c
>= '0' && c
<= '9')
2633 || c
== '-' || c
== '_'))
2634 XSTRING (new)->data
[i
] = '_';
2639 extern char *x_get_string_resource ();
2641 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2642 doc
: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
2643 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
2644 class, where INSTANCE is the name under which Emacs was invoked, or
2645 the name specified by the `-name' or `-rn' command-line arguments.
2647 The optional arguments COMPONENT and SUBCLASS add to the key and the
2648 class, respectively. You must specify both of them or neither.
2649 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
2650 and the class is `Emacs.CLASS.SUBCLASS'. */)
2651 (attribute
, class, component
, subclass
)
2652 Lisp_Object attribute
, class, component
, subclass
;
2654 register char *value
;
2660 CHECK_STRING (attribute
, 0);
2661 CHECK_STRING (class, 0);
2663 if (!NILP (component
))
2664 CHECK_STRING (component
, 1);
2665 if (!NILP (subclass
))
2666 CHECK_STRING (subclass
, 2);
2667 if (NILP (component
) != NILP (subclass
))
2668 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2670 validate_x_resource_name ();
2672 /* Allocate space for the components, the dots which separate them,
2673 and the final '\0'. Make them big enough for the worst case. */
2674 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2675 + (STRINGP (component
)
2676 ? STRING_BYTES (XSTRING (component
)) : 0)
2677 + STRING_BYTES (XSTRING (attribute
))
2680 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2681 + STRING_BYTES (XSTRING (class))
2682 + (STRINGP (subclass
)
2683 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2686 /* Start with emacs.FRAMENAME for the name (the specific one)
2687 and with `Emacs' for the class key (the general one). */
2688 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2689 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2691 strcat (class_key
, ".");
2692 strcat (class_key
, XSTRING (class)->data
);
2694 if (!NILP (component
))
2696 strcat (class_key
, ".");
2697 strcat (class_key
, XSTRING (subclass
)->data
);
2699 strcat (name_key
, ".");
2700 strcat (name_key
, XSTRING (component
)->data
);
2703 strcat (name_key
, ".");
2704 strcat (name_key
, XSTRING (attribute
)->data
);
2706 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2707 name_key
, class_key
);
2709 if (value
!= (char *) 0)
2710 return build_string (value
);
2715 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2718 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2719 struct x_display_info
*dpyinfo
;
2720 Lisp_Object attribute
, class, component
, subclass
;
2722 register char *value
;
2726 CHECK_STRING (attribute
, 0);
2727 CHECK_STRING (class, 0);
2729 if (!NILP (component
))
2730 CHECK_STRING (component
, 1);
2731 if (!NILP (subclass
))
2732 CHECK_STRING (subclass
, 2);
2733 if (NILP (component
) != NILP (subclass
))
2734 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2736 validate_x_resource_name ();
2738 /* Allocate space for the components, the dots which separate them,
2739 and the final '\0'. Make them big enough for the worst case. */
2740 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2741 + (STRINGP (component
)
2742 ? STRING_BYTES (XSTRING (component
)) : 0)
2743 + STRING_BYTES (XSTRING (attribute
))
2746 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2747 + STRING_BYTES (XSTRING (class))
2748 + (STRINGP (subclass
)
2749 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2752 /* Start with emacs.FRAMENAME for the name (the specific one)
2753 and with `Emacs' for the class key (the general one). */
2754 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2755 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2757 strcat (class_key
, ".");
2758 strcat (class_key
, XSTRING (class)->data
);
2760 if (!NILP (component
))
2762 strcat (class_key
, ".");
2763 strcat (class_key
, XSTRING (subclass
)->data
);
2765 strcat (name_key
, ".");
2766 strcat (name_key
, XSTRING (component
)->data
);
2769 strcat (name_key
, ".");
2770 strcat (name_key
, XSTRING (attribute
)->data
);
2772 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2774 if (value
!= (char *) 0)
2775 return build_string (value
);
2780 /* Used when C code wants a resource value. */
2783 x_get_resource_string (attribute
, class)
2784 char *attribute
, *class;
2788 struct frame
*sf
= SELECTED_FRAME ();
2790 /* Allocate space for the components, the dots which separate them,
2791 and the final '\0'. */
2792 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2793 + strlen (attribute
) + 2);
2794 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2795 + strlen (class) + 2);
2797 sprintf (name_key
, "%s.%s",
2798 XSTRING (Vinvocation_name
)->data
,
2800 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2802 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2803 name_key
, class_key
);
2806 /* Types we might convert a resource string into. */
2816 /* Return the value of parameter PARAM.
2818 First search ALIST, then Vdefault_frame_alist, then the X defaults
2819 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2821 Convert the resource to the type specified by desired_type.
2823 If no default is specified, return Qunbound. If you call
2824 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2825 and don't let it get stored in any Lisp-visible variables! */
2828 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2829 struct x_display_info
*dpyinfo
;
2830 Lisp_Object alist
, param
;
2833 enum resource_types type
;
2835 register Lisp_Object tem
;
2837 tem
= Fassq (param
, alist
);
2839 tem
= Fassq (param
, Vdefault_frame_alist
);
2845 tem
= display_x_get_resource (dpyinfo
,
2846 build_string (attribute
),
2847 build_string (class),
2855 case RES_TYPE_NUMBER
:
2856 return make_number (atoi (XSTRING (tem
)->data
));
2858 case RES_TYPE_FLOAT
:
2859 return make_float (atof (XSTRING (tem
)->data
));
2861 case RES_TYPE_BOOLEAN
:
2862 tem
= Fdowncase (tem
);
2863 if (!strcmp (XSTRING (tem
)->data
, "on")
2864 || !strcmp (XSTRING (tem
)->data
, "true"))
2869 case RES_TYPE_STRING
:
2872 case RES_TYPE_SYMBOL
:
2873 /* As a special case, we map the values `true' and `on'
2874 to Qt, and `false' and `off' to Qnil. */
2877 lower
= Fdowncase (tem
);
2878 if (!strcmp (XSTRING (lower
)->data
, "on")
2879 || !strcmp (XSTRING (lower
)->data
, "true"))
2881 else if (!strcmp (XSTRING (lower
)->data
, "off")
2882 || !strcmp (XSTRING (lower
)->data
, "false"))
2885 return Fintern (tem
, Qnil
);
2898 /* Like x_get_arg, but also record the value in f->param_alist. */
2901 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2903 Lisp_Object alist
, param
;
2906 enum resource_types type
;
2910 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2911 attribute
, class, type
);
2913 store_frame_param (f
, param
, value
);
2918 /* Record in frame F the specified or default value according to ALIST
2919 of the parameter named PROP (a Lisp symbol).
2920 If no value is specified for PROP, look for an X default for XPROP
2921 on the frame named NAME.
2922 If that is not found either, use the value DEFLT. */
2925 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2932 enum resource_types type
;
2936 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2937 if (EQ (tem
, Qunbound
))
2939 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2944 /* Record in frame F the specified or default value according to ALIST
2945 of the parameter named PROP (a Lisp symbol). If no value is
2946 specified for PROP, look for an X default for XPROP on the frame
2947 named NAME. If that is not found either, use the value DEFLT. */
2950 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2959 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2962 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2963 if (EQ (tem
, Qunbound
))
2965 #ifdef USE_TOOLKIT_SCROLL_BARS
2967 /* See if an X resource for the scroll bar color has been
2969 tem
= display_x_get_resource (dpyinfo
,
2970 build_string (foreground_p
2974 build_string ("verticalScrollBar"),
2978 /* If nothing has been specified, scroll bars will use a
2979 toolkit-dependent default. Because these defaults are
2980 difficult to get at without actually creating a scroll
2981 bar, use nil to indicate that no color has been
2986 #else /* not USE_TOOLKIT_SCROLL_BARS */
2990 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2993 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2999 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
3000 doc
: /* Parse an X-style geometry string STRING.
3001 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3002 The properties returned may include `top', `left', `height', and `width'.
3003 The value of `left' or `top' may be an integer,
3004 or a list (+ N) meaning N pixels relative to top/left corner,
3005 or a list (- N) meaning -N pixels relative to bottom/right corner. */)
3010 unsigned int width
, height
;
3013 CHECK_STRING (string
, 0);
3015 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
3016 &x
, &y
, &width
, &height
);
3019 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
3020 error ("Must specify both x and y position, or neither");
3024 if (geometry
& XValue
)
3026 Lisp_Object element
;
3028 if (x
>= 0 && (geometry
& XNegative
))
3029 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
3030 else if (x
< 0 && ! (geometry
& XNegative
))
3031 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
3033 element
= Fcons (Qleft
, make_number (x
));
3034 result
= Fcons (element
, result
);
3037 if (geometry
& YValue
)
3039 Lisp_Object element
;
3041 if (y
>= 0 && (geometry
& YNegative
))
3042 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3043 else if (y
< 0 && ! (geometry
& YNegative
))
3044 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3046 element
= Fcons (Qtop
, make_number (y
));
3047 result
= Fcons (element
, result
);
3050 if (geometry
& WidthValue
)
3051 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3052 if (geometry
& HeightValue
)
3053 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3058 /* Calculate the desired size and position of this window,
3059 and return the flags saying which aspects were specified.
3061 This function does not make the coordinates positive. */
3063 #define DEFAULT_ROWS 40
3064 #define DEFAULT_COLS 80
3067 x_figure_window_size (f
, parms
)
3071 register Lisp_Object tem0
, tem1
, tem2
;
3072 long window_prompting
= 0;
3073 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3075 /* Default values if we fall through.
3076 Actually, if that happens we should get
3077 window manager prompting. */
3078 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3079 f
->height
= DEFAULT_ROWS
;
3080 /* Window managers expect that if program-specified
3081 positions are not (0,0), they're intentional, not defaults. */
3082 f
->output_data
.x
->top_pos
= 0;
3083 f
->output_data
.x
->left_pos
= 0;
3085 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3086 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3087 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3088 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3090 if (!EQ (tem0
, Qunbound
))
3092 CHECK_NUMBER (tem0
, 0);
3093 f
->height
= XINT (tem0
);
3095 if (!EQ (tem1
, Qunbound
))
3097 CHECK_NUMBER (tem1
, 0);
3098 SET_FRAME_WIDTH (f
, XINT (tem1
));
3100 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3101 window_prompting
|= USSize
;
3103 window_prompting
|= PSize
;
3106 f
->output_data
.x
->vertical_scroll_bar_extra
3107 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3109 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3110 f
->output_data
.x
->flags_areas_extra
3111 = FRAME_FLAGS_AREA_WIDTH (f
);
3112 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3113 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3115 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3116 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3117 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3118 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3120 if (EQ (tem0
, Qminus
))
3122 f
->output_data
.x
->top_pos
= 0;
3123 window_prompting
|= YNegative
;
3125 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3126 && CONSP (XCDR (tem0
))
3127 && INTEGERP (XCAR (XCDR (tem0
))))
3129 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3130 window_prompting
|= YNegative
;
3132 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3133 && CONSP (XCDR (tem0
))
3134 && INTEGERP (XCAR (XCDR (tem0
))))
3136 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3138 else if (EQ (tem0
, Qunbound
))
3139 f
->output_data
.x
->top_pos
= 0;
3142 CHECK_NUMBER (tem0
, 0);
3143 f
->output_data
.x
->top_pos
= XINT (tem0
);
3144 if (f
->output_data
.x
->top_pos
< 0)
3145 window_prompting
|= YNegative
;
3148 if (EQ (tem1
, Qminus
))
3150 f
->output_data
.x
->left_pos
= 0;
3151 window_prompting
|= XNegative
;
3153 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3154 && CONSP (XCDR (tem1
))
3155 && INTEGERP (XCAR (XCDR (tem1
))))
3157 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3158 window_prompting
|= XNegative
;
3160 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3161 && CONSP (XCDR (tem1
))
3162 && INTEGERP (XCAR (XCDR (tem1
))))
3164 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3166 else if (EQ (tem1
, Qunbound
))
3167 f
->output_data
.x
->left_pos
= 0;
3170 CHECK_NUMBER (tem1
, 0);
3171 f
->output_data
.x
->left_pos
= XINT (tem1
);
3172 if (f
->output_data
.x
->left_pos
< 0)
3173 window_prompting
|= XNegative
;
3176 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3177 window_prompting
|= USPosition
;
3179 window_prompting
|= PPosition
;
3182 return window_prompting
;
3185 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3188 XSetWMProtocols (dpy
, w
, protocols
, count
)
3195 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3196 if (prop
== None
) return False
;
3197 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3198 (unsigned char *) protocols
, count
);
3201 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3203 #ifdef USE_X_TOOLKIT
3205 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3206 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3207 already be present because of the toolkit (Motif adds some of them,
3208 for example, but Xt doesn't). */
3211 hack_wm_protocols (f
, widget
)
3215 Display
*dpy
= XtDisplay (widget
);
3216 Window w
= XtWindow (widget
);
3217 int need_delete
= 1;
3223 Atom type
, *atoms
= 0;
3225 unsigned long nitems
= 0;
3226 unsigned long bytes_after
;
3228 if ((XGetWindowProperty (dpy
, w
,
3229 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3230 (long)0, (long)100, False
, XA_ATOM
,
3231 &type
, &format
, &nitems
, &bytes_after
,
3232 (unsigned char **) &atoms
)
3234 && format
== 32 && type
== XA_ATOM
)
3238 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3240 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3242 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3245 if (atoms
) XFree ((char *) atoms
);
3251 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3253 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3255 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3257 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3258 XA_ATOM
, 32, PropModeAppend
,
3259 (unsigned char *) props
, count
);
3267 /* Support routines for XIC (X Input Context). */
3271 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3272 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3275 /* Supported XIM styles, ordered by preferenc. */
3277 static XIMStyle supported_xim_styles
[] =
3279 XIMPreeditPosition
| XIMStatusArea
,
3280 XIMPreeditPosition
| XIMStatusNothing
,
3281 XIMPreeditPosition
| XIMStatusNone
,
3282 XIMPreeditNothing
| XIMStatusArea
,
3283 XIMPreeditNothing
| XIMStatusNothing
,
3284 XIMPreeditNothing
| XIMStatusNone
,
3285 XIMPreeditNone
| XIMStatusArea
,
3286 XIMPreeditNone
| XIMStatusNothing
,
3287 XIMPreeditNone
| XIMStatusNone
,
3292 /* Create an X fontset on frame F with base font name
3296 xic_create_xfontset (f
, base_fontname
)
3298 char *base_fontname
;
3301 char **missing_list
;
3305 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3306 base_fontname
, &missing_list
,
3307 &missing_count
, &def_string
);
3309 XFreeStringList (missing_list
);
3311 /* No need to free def_string. */
3316 /* Value is the best input style, given user preferences USER (already
3317 checked to be supported by Emacs), and styles supported by the
3318 input method XIM. */
3321 best_xim_style (user
, xim
)
3327 for (i
= 0; i
< user
->count_styles
; ++i
)
3328 for (j
= 0; j
< xim
->count_styles
; ++j
)
3329 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3330 return user
->supported_styles
[i
];
3332 /* Return the default style. */
3333 return XIMPreeditNothing
| XIMStatusNothing
;
3336 /* Create XIC for frame F. */
3338 static XIMStyle xic_style
;
3341 create_frame_xic (f
)
3346 XFontSet xfs
= NULL
;
3351 xim
= FRAME_X_XIM (f
);
3356 XVaNestedList preedit_attr
;
3357 XVaNestedList status_attr
;
3358 char *base_fontname
;
3361 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3362 spot
.x
= 0; spot
.y
= 1;
3363 /* Create X fontset. */
3364 fontset
= FRAME_FONTSET (f
);
3366 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3369 /* Determine the base fontname from the ASCII font name of
3371 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3372 char *p
= ascii_font
;
3375 for (i
= 0; *p
; p
++)
3378 /* As the font name doesn't conform to XLFD, we can't
3379 modify it to get a suitable base fontname for the
3381 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3384 int len
= strlen (ascii_font
) + 1;
3387 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3396 base_fontname
= (char *) alloca (len
);
3397 bzero (base_fontname
, len
);
3398 strcpy (base_fontname
, "-*-*-");
3399 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3400 strcat (base_fontname
, "*-*-*-*-*-*-*");
3403 xfs
= xic_create_xfontset (f
, base_fontname
);
3405 /* Determine XIC style. */
3408 XIMStyles supported_list
;
3409 supported_list
.count_styles
= (sizeof supported_xim_styles
3410 / sizeof supported_xim_styles
[0]);
3411 supported_list
.supported_styles
= supported_xim_styles
;
3412 xic_style
= best_xim_style (&supported_list
,
3413 FRAME_X_XIM_STYLES (f
));
3416 preedit_attr
= XVaCreateNestedList (0,
3419 FRAME_FOREGROUND_PIXEL (f
),
3421 FRAME_BACKGROUND_PIXEL (f
),
3422 (xic_style
& XIMPreeditPosition
3427 status_attr
= XVaCreateNestedList (0,
3433 FRAME_FOREGROUND_PIXEL (f
),
3435 FRAME_BACKGROUND_PIXEL (f
),
3438 xic
= XCreateIC (xim
,
3439 XNInputStyle
, xic_style
,
3440 XNClientWindow
, FRAME_X_WINDOW(f
),
3441 XNFocusWindow
, FRAME_X_WINDOW(f
),
3442 XNStatusAttributes
, status_attr
,
3443 XNPreeditAttributes
, preedit_attr
,
3445 XFree (preedit_attr
);
3446 XFree (status_attr
);
3449 FRAME_XIC (f
) = xic
;
3450 FRAME_XIC_STYLE (f
) = xic_style
;
3451 FRAME_XIC_FONTSET (f
) = xfs
;
3455 /* Destroy XIC and free XIC fontset of frame F, if any. */
3461 if (FRAME_XIC (f
) == NULL
)
3464 XDestroyIC (FRAME_XIC (f
));
3465 if (FRAME_XIC_FONTSET (f
))
3466 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3468 FRAME_XIC (f
) = NULL
;
3469 FRAME_XIC_FONTSET (f
) = NULL
;
3473 /* Place preedit area for XIC of window W's frame to specified
3474 pixel position X/Y. X and Y are relative to window W. */
3477 xic_set_preeditarea (w
, x
, y
)
3481 struct frame
*f
= XFRAME (w
->frame
);
3485 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3486 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3487 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3488 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3493 /* Place status area for XIC in bottom right corner of frame F.. */
3496 xic_set_statusarea (f
)
3499 XIC xic
= FRAME_XIC (f
);
3504 /* Negotiate geometry of status area. If input method has existing
3505 status area, use its current size. */
3506 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3507 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3508 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3511 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3512 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3515 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3517 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3518 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3522 area
.width
= needed
->width
;
3523 area
.height
= needed
->height
;
3524 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3525 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3526 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3529 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3530 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3535 /* Set X fontset for XIC of frame F, using base font name
3536 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3539 xic_set_xfontset (f
, base_fontname
)
3541 char *base_fontname
;
3546 xfs
= xic_create_xfontset (f
, base_fontname
);
3548 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3549 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3550 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3551 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3552 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3555 if (FRAME_XIC_FONTSET (f
))
3556 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3557 FRAME_XIC_FONTSET (f
) = xfs
;
3560 #endif /* HAVE_X_I18N */
3564 #ifdef USE_X_TOOLKIT
3566 /* Create and set up the X widget for frame F. */
3569 x_window (f
, window_prompting
, minibuffer_only
)
3571 long window_prompting
;
3572 int minibuffer_only
;
3574 XClassHint class_hints
;
3575 XSetWindowAttributes attributes
;
3576 unsigned long attribute_mask
;
3577 Widget shell_widget
;
3579 Widget frame_widget
;
3585 /* Use the resource name as the top-level widget name
3586 for looking up resources. Make a non-Lisp copy
3587 for the window manager, so GC relocation won't bother it.
3589 Elsewhere we specify the window name for the window manager. */
3592 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3593 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3594 strcpy (f
->namebuf
, str
);
3598 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3599 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3600 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3601 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3602 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3603 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3604 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3605 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3606 applicationShellWidgetClass
,
3607 FRAME_X_DISPLAY (f
), al
, ac
);
3609 f
->output_data
.x
->widget
= shell_widget
;
3610 /* maybe_set_screen_title_format (shell_widget); */
3612 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3613 (widget_value
*) NULL
,
3614 shell_widget
, False
,
3618 (lw_callback
) NULL
);
3621 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3622 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3623 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3624 XtSetValues (pane_widget
, al
, ac
);
3625 f
->output_data
.x
->column_widget
= pane_widget
;
3627 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3628 the emacs screen when changing menubar. This reduces flickering. */
3631 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3632 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3633 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3634 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3635 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3636 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3637 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3638 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3639 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3642 f
->output_data
.x
->edit_widget
= frame_widget
;
3644 XtManageChild (frame_widget
);
3646 /* Do some needed geometry management. */
3649 char *tem
, shell_position
[32];
3652 int extra_borders
= 0;
3654 = (f
->output_data
.x
->menubar_widget
3655 ? (f
->output_data
.x
->menubar_widget
->core
.height
3656 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3659 #if 0 /* Experimentally, we now get the right results
3660 for -geometry -0-0 without this. 24 Aug 96, rms. */
3661 if (FRAME_EXTERNAL_MENU_BAR (f
))
3664 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3665 menubar_size
+= ibw
;
3669 f
->output_data
.x
->menubar_height
= menubar_size
;
3672 /* Motif seems to need this amount added to the sizes
3673 specified for the shell widget. The Athena/Lucid widgets don't.
3674 Both conclusions reached experimentally. -- rms. */
3675 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3676 &extra_borders
, NULL
);
3680 /* Convert our geometry parameters into a geometry string
3682 Note that we do not specify here whether the position
3683 is a user-specified or program-specified one.
3684 We pass that information later, in x_wm_set_size_hints. */
3686 int left
= f
->output_data
.x
->left_pos
;
3687 int xneg
= window_prompting
& XNegative
;
3688 int top
= f
->output_data
.x
->top_pos
;
3689 int yneg
= window_prompting
& YNegative
;
3695 if (window_prompting
& USPosition
)
3696 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3697 PIXEL_WIDTH (f
) + extra_borders
,
3698 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3699 (xneg
? '-' : '+'), left
,
3700 (yneg
? '-' : '+'), top
);
3702 sprintf (shell_position
, "=%dx%d",
3703 PIXEL_WIDTH (f
) + extra_borders
,
3704 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3707 len
= strlen (shell_position
) + 1;
3708 /* We don't free this because we don't know whether
3709 it is safe to free it while the frame exists.
3710 It isn't worth the trouble of arranging to free it
3711 when the frame is deleted. */
3712 tem
= (char *) xmalloc (len
);
3713 strncpy (tem
, shell_position
, len
);
3714 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3715 XtSetValues (shell_widget
, al
, ac
);
3718 XtManageChild (pane_widget
);
3719 XtRealizeWidget (shell_widget
);
3721 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3723 validate_x_resource_name ();
3725 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3726 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3727 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3730 FRAME_XIC (f
) = NULL
;
3732 create_frame_xic (f
);
3736 f
->output_data
.x
->wm_hints
.input
= True
;
3737 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3738 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3739 &f
->output_data
.x
->wm_hints
);
3741 hack_wm_protocols (f
, shell_widget
);
3744 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3747 /* Do a stupid property change to force the server to generate a
3748 PropertyNotify event so that the event_stream server timestamp will
3749 be initialized to something relevant to the time we created the window.
3751 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3752 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3753 XA_ATOM
, 32, PropModeAppend
,
3754 (unsigned char*) NULL
, 0);
3756 /* Make all the standard events reach the Emacs frame. */
3757 attributes
.event_mask
= STANDARD_EVENT_SET
;
3762 /* XIM server might require some X events. */
3763 unsigned long fevent
= NoEventMask
;
3764 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3765 attributes
.event_mask
|= fevent
;
3767 #endif /* HAVE_X_I18N */
3769 attribute_mask
= CWEventMask
;
3770 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3771 attribute_mask
, &attributes
);
3773 XtMapWidget (frame_widget
);
3775 /* x_set_name normally ignores requests to set the name if the
3776 requested name is the same as the current name. This is the one
3777 place where that assumption isn't correct; f->name is set, but
3778 the X server hasn't been told. */
3781 int explicit = f
->explicit_name
;
3783 f
->explicit_name
= 0;
3786 x_set_name (f
, name
, explicit);
3789 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3790 f
->output_data
.x
->text_cursor
);
3794 /* This is a no-op, except under Motif. Make sure main areas are
3795 set to something reasonable, in case we get an error later. */
3796 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3799 #else /* not USE_X_TOOLKIT */
3801 /* Create and set up the X window for frame F. */
3808 XClassHint class_hints
;
3809 XSetWindowAttributes attributes
;
3810 unsigned long attribute_mask
;
3812 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3813 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3814 attributes
.bit_gravity
= StaticGravity
;
3815 attributes
.backing_store
= NotUseful
;
3816 attributes
.save_under
= True
;
3817 attributes
.event_mask
= STANDARD_EVENT_SET
;
3818 attributes
.colormap
= FRAME_X_COLORMAP (f
);
3819 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
3824 = XCreateWindow (FRAME_X_DISPLAY (f
),
3825 f
->output_data
.x
->parent_desc
,
3826 f
->output_data
.x
->left_pos
,
3827 f
->output_data
.x
->top_pos
,
3828 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3829 f
->output_data
.x
->border_width
,
3830 CopyFromParent
, /* depth */
3831 InputOutput
, /* class */
3833 attribute_mask
, &attributes
);
3837 create_frame_xic (f
);
3840 /* XIM server might require some X events. */
3841 unsigned long fevent
= NoEventMask
;
3842 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3843 attributes
.event_mask
|= fevent
;
3844 attribute_mask
= CWEventMask
;
3845 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3846 attribute_mask
, &attributes
);
3849 #endif /* HAVE_X_I18N */
3851 validate_x_resource_name ();
3853 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3854 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3855 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3857 /* The menubar is part of the ordinary display;
3858 it does not count in addition to the height of the window. */
3859 f
->output_data
.x
->menubar_height
= 0;
3861 /* This indicates that we use the "Passive Input" input model.
3862 Unless we do this, we don't get the Focus{In,Out} events that we
3863 need to draw the cursor correctly. Accursed bureaucrats.
3864 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3866 f
->output_data
.x
->wm_hints
.input
= True
;
3867 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3868 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3869 &f
->output_data
.x
->wm_hints
);
3870 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3872 /* Request "save yourself" and "delete window" commands from wm. */
3875 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3876 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3877 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3880 /* x_set_name normally ignores requests to set the name if the
3881 requested name is the same as the current name. This is the one
3882 place where that assumption isn't correct; f->name is set, but
3883 the X server hasn't been told. */
3886 int explicit = f
->explicit_name
;
3888 f
->explicit_name
= 0;
3891 x_set_name (f
, name
, explicit);
3894 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3895 f
->output_data
.x
->text_cursor
);
3899 if (FRAME_X_WINDOW (f
) == 0)
3900 error ("Unable to create window");
3903 #endif /* not USE_X_TOOLKIT */
3905 /* Handle the icon stuff for this window. Perhaps later we might
3906 want an x_set_icon_position which can be called interactively as
3914 Lisp_Object icon_x
, icon_y
;
3915 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3917 /* Set the position of the icon. Note that twm groups all
3918 icons in an icon window. */
3919 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3920 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3921 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3923 CHECK_NUMBER (icon_x
, 0);
3924 CHECK_NUMBER (icon_y
, 0);
3926 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3927 error ("Both left and top icon corners of icon must be specified");
3931 if (! EQ (icon_x
, Qunbound
))
3932 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3934 /* Start up iconic or window? */
3935 x_wm_set_window_state
3936 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3941 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3948 /* Make the GCs needed for this window, setting the
3949 background, border and mouse colors; also create the
3950 mouse cursor and the gray border tile. */
3952 static char cursor_bits
[] =
3954 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3955 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3956 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3957 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3964 XGCValues gc_values
;
3968 /* Create the GCs of this frame.
3969 Note that many default values are used. */
3972 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3973 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3974 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3975 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3976 f
->output_data
.x
->normal_gc
3977 = XCreateGC (FRAME_X_DISPLAY (f
),
3979 GCLineWidth
| GCFont
| GCForeground
| GCBackground
,
3982 /* Reverse video style. */
3983 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3984 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3985 f
->output_data
.x
->reverse_gc
3986 = XCreateGC (FRAME_X_DISPLAY (f
),
3988 GCFont
| GCForeground
| GCBackground
| GCLineWidth
,
3991 /* Cursor has cursor-color background, background-color foreground. */
3992 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3993 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3994 gc_values
.fill_style
= FillOpaqueStippled
;
3996 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3997 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3998 cursor_bits
, 16, 16);
3999 f
->output_data
.x
->cursor_gc
4000 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4001 (GCFont
| GCForeground
| GCBackground
4002 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
4006 f
->output_data
.x
->white_relief
.gc
= 0;
4007 f
->output_data
.x
->black_relief
.gc
= 0;
4009 /* Create the gray border tile used when the pointer is not in
4010 the frame. Since this depends on the frame's pixel values,
4011 this must be done on a per-frame basis. */
4012 f
->output_data
.x
->border_tile
4013 = (XCreatePixmapFromBitmapData
4014 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
4015 gray_bits
, gray_width
, gray_height
,
4016 f
->output_data
.x
->foreground_pixel
,
4017 f
->output_data
.x
->background_pixel
,
4018 DefaultDepth (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
))));
4024 /* Free what was was allocated in x_make_gc. */
4030 Display
*dpy
= FRAME_X_DISPLAY (f
);
4034 if (f
->output_data
.x
->normal_gc
)
4036 XFreeGC (dpy
, f
->output_data
.x
->normal_gc
);
4037 f
->output_data
.x
->normal_gc
= 0;
4040 if (f
->output_data
.x
->reverse_gc
)
4042 XFreeGC (dpy
, f
->output_data
.x
->reverse_gc
);
4043 f
->output_data
.x
->reverse_gc
= 0;
4046 if (f
->output_data
.x
->cursor_gc
)
4048 XFreeGC (dpy
, f
->output_data
.x
->cursor_gc
);
4049 f
->output_data
.x
->cursor_gc
= 0;
4052 if (f
->output_data
.x
->border_tile
)
4054 XFreePixmap (dpy
, f
->output_data
.x
->border_tile
);
4055 f
->output_data
.x
->border_tile
= 0;
4062 /* Handler for signals raised during x_create_frame and
4063 x_create_top_frame. FRAME is the frame which is partially
4067 unwind_create_frame (frame
)
4070 struct frame
*f
= XFRAME (frame
);
4072 /* If frame is ``official'', nothing to do. */
4073 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4076 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4079 x_free_frame_resources (f
);
4081 /* Check that reference counts are indeed correct. */
4082 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4083 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4091 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4093 doc
: /* Make a new X window, which is called a "frame" in Emacs terms.
4094 Returns an Emacs frame object.
4095 ALIST is an alist of frame parameters.
4096 If the parameters specify that the frame should not have a minibuffer,
4097 and do not specify a specific minibuffer window to use,
4098 then `default-minibuffer-frame' must be a frame whose minibuffer can
4099 be shared by the new frame.
4101 This function is an internal primitive--use `make-frame' instead. */)
4106 Lisp_Object frame
, tem
;
4108 int minibuffer_only
= 0;
4109 long window_prompting
= 0;
4111 int count
= BINDING_STACK_SIZE ();
4112 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4113 Lisp_Object display
;
4114 struct x_display_info
*dpyinfo
= NULL
;
4120 /* Use this general default value to start with
4121 until we know if this frame has a specified name. */
4122 Vx_resource_name
= Vinvocation_name
;
4124 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4125 if (EQ (display
, Qunbound
))
4127 dpyinfo
= check_x_display_info (display
);
4129 kb
= dpyinfo
->kboard
;
4131 kb
= &the_only_kboard
;
4134 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
4136 && ! EQ (name
, Qunbound
)
4138 error ("Invalid frame name--not a string or nil");
4141 Vx_resource_name
= name
;
4143 /* See if parent window is specified. */
4144 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4145 if (EQ (parent
, Qunbound
))
4147 if (! NILP (parent
))
4148 CHECK_NUMBER (parent
, 0);
4150 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4151 /* No need to protect DISPLAY because that's not used after passing
4152 it to make_frame_without_minibuffer. */
4154 GCPRO4 (parms
, parent
, name
, frame
);
4155 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4157 if (EQ (tem
, Qnone
) || NILP (tem
))
4158 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4159 else if (EQ (tem
, Qonly
))
4161 f
= make_minibuffer_frame ();
4162 minibuffer_only
= 1;
4164 else if (WINDOWP (tem
))
4165 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4169 XSETFRAME (frame
, f
);
4171 /* Note that X Windows does support scroll bars. */
4172 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4174 f
->output_method
= output_x_window
;
4175 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4176 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4177 f
->output_data
.x
->icon_bitmap
= -1;
4178 f
->output_data
.x
->fontset
= -1;
4179 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4180 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4181 #ifdef USE_TOOLKIT_SCROLL_BARS
4182 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
4183 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
4184 #endif /* USE_TOOLKIT_SCROLL_BARS */
4185 record_unwind_protect (unwind_create_frame
, frame
);
4188 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4190 if (! STRINGP (f
->icon_name
))
4191 f
->icon_name
= Qnil
;
4193 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4195 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
4196 dpyinfo_refcount
= dpyinfo
->reference_count
;
4197 #endif /* GLYPH_DEBUG */
4199 FRAME_KBOARD (f
) = kb
;
4202 /* These colors will be set anyway later, but it's important
4203 to get the color reference counts right, so initialize them! */
4206 struct gcpro gcpro1
;
4208 /* Function x_decode_color can signal an error. Make
4209 sure to initialize color slots so that we won't try
4210 to free colors we haven't allocated. */
4211 f
->output_data
.x
->foreground_pixel
= -1;
4212 f
->output_data
.x
->background_pixel
= -1;
4213 f
->output_data
.x
->cursor_pixel
= -1;
4214 f
->output_data
.x
->cursor_foreground_pixel
= -1;
4215 f
->output_data
.x
->border_pixel
= -1;
4216 f
->output_data
.x
->mouse_pixel
= -1;
4218 black
= build_string ("black");
4220 f
->output_data
.x
->foreground_pixel
4221 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4222 f
->output_data
.x
->background_pixel
4223 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4224 f
->output_data
.x
->cursor_pixel
4225 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4226 f
->output_data
.x
->cursor_foreground_pixel
4227 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4228 f
->output_data
.x
->border_pixel
4229 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4230 f
->output_data
.x
->mouse_pixel
4231 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4235 /* Specify the parent under which to make this X window. */
4239 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4240 f
->output_data
.x
->explicit_parent
= 1;
4244 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4245 f
->output_data
.x
->explicit_parent
= 0;
4248 /* Set the name; the functions to which we pass f expect the name to
4250 if (EQ (name
, Qunbound
) || NILP (name
))
4252 f
->name
= build_string (dpyinfo
->x_id_name
);
4253 f
->explicit_name
= 0;
4258 f
->explicit_name
= 1;
4259 /* use the frame's title when getting resources for this frame. */
4260 specbind (Qx_resource_name
, name
);
4263 /* Extract the window parameters from the supplied values
4264 that are needed to determine window geometry. */
4268 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4271 /* First, try whatever font the caller has specified. */
4274 tem
= Fquery_fontset (font
, Qnil
);
4276 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4278 font
= x_new_font (f
, XSTRING (font
)->data
);
4281 /* Try out a font which we hope has bold and italic variations. */
4282 if (!STRINGP (font
))
4283 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4284 if (!STRINGP (font
))
4285 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4286 if (! STRINGP (font
))
4287 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4288 if (! STRINGP (font
))
4289 /* This was formerly the first thing tried, but it finds too many fonts
4290 and takes too long. */
4291 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4292 /* If those didn't work, look for something which will at least work. */
4293 if (! STRINGP (font
))
4294 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4296 if (! STRINGP (font
))
4297 font
= build_string ("fixed");
4299 x_default_parameter (f
, parms
, Qfont
, font
,
4300 "font", "Font", RES_TYPE_STRING
);
4304 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4305 whereby it fails to get any font. */
4306 xlwmenu_default_font
= f
->output_data
.x
->font
;
4309 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4310 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4312 /* This defaults to 2 in order to match xterm. We recognize either
4313 internalBorderWidth or internalBorder (which is what xterm calls
4315 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4319 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4320 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4321 if (! EQ (value
, Qunbound
))
4322 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4325 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4326 "internalBorderWidth", "internalBorderWidth",
4328 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4329 "verticalScrollBars", "ScrollBars",
4332 /* Also do the stuff which must be set before the window exists. */
4333 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4334 "foreground", "Foreground", RES_TYPE_STRING
);
4335 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4336 "background", "Background", RES_TYPE_STRING
);
4337 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4338 "pointerColor", "Foreground", RES_TYPE_STRING
);
4339 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4340 "cursorColor", "Foreground", RES_TYPE_STRING
);
4341 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4342 "borderColor", "BorderColor", RES_TYPE_STRING
);
4343 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4344 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4345 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4346 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4348 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4349 "scrollBarForeground",
4350 "ScrollBarForeground", 1);
4351 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4352 "scrollBarBackground",
4353 "ScrollBarBackground", 0);
4355 /* Init faces before x_default_parameter is called for scroll-bar
4356 parameters because that function calls x_set_scroll_bar_width,
4357 which calls change_frame_size, which calls Fset_window_buffer,
4358 which runs hooks, which call Fvertical_motion. At the end, we
4359 end up in init_iterator with a null face cache, which should not
4361 init_frame_faces (f
);
4363 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4364 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4365 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4366 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4367 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4368 "bufferPredicate", "BufferPredicate",
4370 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4371 "title", "Title", RES_TYPE_STRING
);
4372 x_default_parameter (f
, parms
, Qwait_for_wm
, Qt
,
4373 "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN
);
4375 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4377 /* Add the tool-bar height to the initial frame height so that the
4378 user gets a text display area of the size he specified with -g or
4379 via .Xdefaults. Later changes of the tool-bar height don't
4380 change the frame size. This is done so that users can create
4381 tall Emacs frames without having to guess how tall the tool-bar
4383 if (FRAME_TOOL_BAR_LINES (f
))
4385 int margin
, relief
, bar_height
;
4387 relief
= (tool_bar_button_relief
> 0
4388 ? tool_bar_button_relief
4389 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
4391 if (INTEGERP (Vtool_bar_button_margin
)
4392 && XINT (Vtool_bar_button_margin
) > 0)
4393 margin
= XFASTINT (Vtool_bar_button_margin
);
4394 else if (CONSP (Vtool_bar_button_margin
)
4395 && INTEGERP (XCDR (Vtool_bar_button_margin
))
4396 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
4397 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
4401 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
4402 f
->height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
4405 /* Compute the size of the X window. */
4406 window_prompting
= x_figure_window_size (f
, parms
);
4408 if (window_prompting
& XNegative
)
4410 if (window_prompting
& YNegative
)
4411 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4413 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4417 if (window_prompting
& YNegative
)
4418 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4420 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4423 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4425 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4426 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4428 /* Create the X widget or window. */
4429 #ifdef USE_X_TOOLKIT
4430 x_window (f
, window_prompting
, minibuffer_only
);
4438 /* Now consider the frame official. */
4439 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4440 Vframe_list
= Fcons (frame
, Vframe_list
);
4442 /* We need to do this after creating the X window, so that the
4443 icon-creation functions can say whose icon they're describing. */
4444 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4445 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4447 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4448 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4449 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4450 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4451 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4452 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4453 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4454 "scrollBarWidth", "ScrollBarWidth",
4457 /* Dimensions, especially f->height, must be done via change_frame_size.
4458 Change will not be effected unless different from the current
4464 SET_FRAME_WIDTH (f
, 0);
4465 change_frame_size (f
, height
, width
, 1, 0, 0);
4467 /* Set up faces after all frame parameters are known. This call
4468 also merges in face attributes specified for new frames. If we
4469 don't do this, the `menu' face for instance won't have the right
4470 colors, and the menu bar won't appear in the specified colors for
4472 call1 (Qface_set_after_frame_default
, frame
);
4474 #ifdef USE_X_TOOLKIT
4475 /* Create the menu bar. */
4476 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4478 /* If this signals an error, we haven't set size hints for the
4479 frame and we didn't make it visible. */
4480 initialize_frame_menubar (f
);
4482 /* This is a no-op, except under Motif where it arranges the
4483 main window for the widgets on it. */
4484 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4485 f
->output_data
.x
->menubar_widget
,
4486 f
->output_data
.x
->edit_widget
);
4488 #endif /* USE_X_TOOLKIT */
4490 /* Tell the server what size and position, etc, we want, and how
4491 badly we want them. This should be done after we have the menu
4492 bar so that its size can be taken into account. */
4494 x_wm_set_size_hint (f
, window_prompting
, 0);
4497 /* Make the window appear on the frame and enable display, unless
4498 the caller says not to. However, with explicit parent, Emacs
4499 cannot control visibility, so don't try. */
4500 if (! f
->output_data
.x
->explicit_parent
)
4502 Lisp_Object visibility
;
4504 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4506 if (EQ (visibility
, Qunbound
))
4509 if (EQ (visibility
, Qicon
))
4510 x_iconify_frame (f
);
4511 else if (! NILP (visibility
))
4512 x_make_frame_visible (f
);
4514 /* Must have been Qnil. */
4520 /* Make sure windows on this frame appear in calls to next-window
4521 and similar functions. */
4522 Vwindow_list
= Qnil
;
4524 return unbind_to (count
, frame
);
4528 /* FRAME is used only to get a handle on the X display. We don't pass the
4529 display info directly because we're called from frame.c, which doesn't
4530 know about that structure. */
4533 x_get_focus_frame (frame
)
4534 struct frame
*frame
;
4536 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4538 if (! dpyinfo
->x_focus_frame
)
4541 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4546 /* In certain situations, when the window manager follows a
4547 click-to-focus policy, there seems to be no way around calling
4548 XSetInputFocus to give another frame the input focus .
4550 In an ideal world, XSetInputFocus should generally be avoided so
4551 that applications don't interfere with the window manager's focus
4552 policy. But I think it's okay to use when it's clearly done
4553 following a user-command. */
4555 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4556 doc
: /* Set the input focus to FRAME.
4557 FRAME nil means use the selected frame. */)
4561 struct frame
*f
= check_x_frame (frame
);
4562 Display
*dpy
= FRAME_X_DISPLAY (f
);
4566 count
= x_catch_errors (dpy
);
4567 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4568 RevertToParent
, CurrentTime
);
4569 x_uncatch_errors (dpy
, count
);
4576 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4577 doc
: /* Internal function called by `color-defined-p', which see. */)
4579 Lisp_Object color
, frame
;
4582 FRAME_PTR f
= check_x_frame (frame
);
4584 CHECK_STRING (color
, 1);
4586 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4592 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4593 doc
: /* Internal function called by `color-values', which see. */)
4595 Lisp_Object color
, frame
;
4598 FRAME_PTR f
= check_x_frame (frame
);
4600 CHECK_STRING (color
, 1);
4602 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4606 rgb
[0] = make_number (foo
.red
);
4607 rgb
[1] = make_number (foo
.green
);
4608 rgb
[2] = make_number (foo
.blue
);
4609 return Flist (3, rgb
);
4615 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4616 doc
: /* Internal function called by `display-color-p', which see. */)
4618 Lisp_Object display
;
4620 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4622 if (dpyinfo
->n_planes
<= 2)
4625 switch (dpyinfo
->visual
->class)
4638 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4640 doc
: /* Return t if the X display supports shades of gray.
4641 Note that color displays do support shades of gray.
4642 The optional argument DISPLAY specifies which display to ask about.
4643 DISPLAY should be either a frame or a display name (a string).
4644 If omitted or nil, that stands for the selected frame's display. */)
4646 Lisp_Object display
;
4648 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4650 if (dpyinfo
->n_planes
<= 1)
4653 switch (dpyinfo
->visual
->class)
4668 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4670 doc
: /* Returns the width in pixels of the X display DISPLAY.
4671 The optional argument DISPLAY specifies which display to ask about.
4672 DISPLAY should be either a frame or a display name (a string).
4673 If omitted or nil, that stands for the selected frame's display. */)
4675 Lisp_Object display
;
4677 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4679 return make_number (dpyinfo
->width
);
4682 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4683 Sx_display_pixel_height
, 0, 1, 0,
4684 doc
: /* Returns the height in pixels of the X display DISPLAY.
4685 The optional argument DISPLAY specifies which display to ask about.
4686 DISPLAY should be either a frame or a display name (a string).
4687 If omitted or nil, that stands for the selected frame's display. */)
4689 Lisp_Object display
;
4691 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4693 return make_number (dpyinfo
->height
);
4696 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4698 doc
: /* Returns the number of bitplanes of the X display DISPLAY.
4699 The optional argument DISPLAY specifies which display to ask about.
4700 DISPLAY should be either a frame or a display name (a string).
4701 If omitted or nil, that stands for the selected frame's display. */)
4703 Lisp_Object display
;
4705 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4707 return make_number (dpyinfo
->n_planes
);
4710 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4712 doc
: /* Returns the number of color cells of the X display DISPLAY.
4713 The optional argument DISPLAY specifies which display to ask about.
4714 DISPLAY should be either a frame or a display name (a string).
4715 If omitted or nil, that stands for the selected frame's display. */)
4717 Lisp_Object display
;
4719 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4721 return make_number (DisplayCells (dpyinfo
->display
,
4722 XScreenNumberOfScreen (dpyinfo
->screen
)));
4725 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4726 Sx_server_max_request_size
,
4728 doc
: /* Returns the maximum request size of the X server of display DISPLAY.
4729 The optional argument DISPLAY specifies which display to ask about.
4730 DISPLAY should be either a frame or a display name (a string).
4731 If omitted or nil, that stands for the selected frame's display. */)
4733 Lisp_Object display
;
4735 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4737 return make_number (MAXREQUEST (dpyinfo
->display
));
4740 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4741 doc
: /* Returns the vendor ID string of the X server of display DISPLAY.
4742 The optional argument DISPLAY specifies which display to ask about.
4743 DISPLAY should be either a frame or a display name (a string).
4744 If omitted or nil, that stands for the selected frame's display. */)
4746 Lisp_Object display
;
4748 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4749 char *vendor
= ServerVendor (dpyinfo
->display
);
4751 if (! vendor
) vendor
= "";
4752 return build_string (vendor
);
4755 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4756 doc
: /* Returns the version numbers of the X server of display DISPLAY.
4757 The value is a list of three integers: the major and minor
4758 version numbers of the X Protocol in use, and the vendor-specific release
4759 number. See also the function `x-server-vendor'.
4761 The optional argument DISPLAY specifies which display to ask about.
4762 DISPLAY should be either a frame or a display name (a string).
4763 If omitted or nil, that stands for the selected frame's display. */)
4765 Lisp_Object display
;
4767 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4768 Display
*dpy
= dpyinfo
->display
;
4770 return Fcons (make_number (ProtocolVersion (dpy
)),
4771 Fcons (make_number (ProtocolRevision (dpy
)),
4772 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4775 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4776 doc
: /* Return the number of screens on the X server of display DISPLAY.
4777 The optional argument DISPLAY specifies which display to ask about.
4778 DISPLAY should be either a frame or a display name (a string).
4779 If omitted or nil, that stands for the selected frame's display. */)
4781 Lisp_Object display
;
4783 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4785 return make_number (ScreenCount (dpyinfo
->display
));
4788 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4789 doc
: /* Return the height in millimeters of the X display DISPLAY.
4790 The optional argument DISPLAY specifies which display to ask about.
4791 DISPLAY should be either a frame or a display name (a string).
4792 If omitted or nil, that stands for the selected frame's display. */)
4794 Lisp_Object display
;
4796 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4798 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4801 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4802 doc
: /* Return the width in millimeters of the X display DISPLAY.
4803 The optional argument DISPLAY specifies which display to ask about.
4804 DISPLAY should be either a frame or a display name (a string).
4805 If omitted or nil, that stands for the selected frame's display. */)
4807 Lisp_Object display
;
4809 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4811 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4814 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4815 Sx_display_backing_store
, 0, 1, 0,
4816 doc
: /* Returns an indication of whether X display DISPLAY does backing store.
4817 The value may be `always', `when-mapped', or `not-useful'.
4818 The optional argument DISPLAY specifies which display to ask about.
4819 DISPLAY should be either a frame or a display name (a string).
4820 If omitted or nil, that stands for the selected frame's display. */)
4822 Lisp_Object display
;
4824 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4827 switch (DoesBackingStore (dpyinfo
->screen
))
4830 result
= intern ("always");
4834 result
= intern ("when-mapped");
4838 result
= intern ("not-useful");
4842 error ("Strange value for BackingStore parameter of screen");
4849 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4850 Sx_display_visual_class
, 0, 1, 0,
4851 doc
: /* Return the visual class of the X display DISPLAY.
4852 The value is one of the symbols `static-gray', `gray-scale',
4853 `static-color', `pseudo-color', `true-color', or `direct-color'.
4855 The optional argument DISPLAY specifies which display to ask about.
4856 DISPLAY should be either a frame or a display name (a string).
4857 If omitted or nil, that stands for the selected frame's display. */)
4859 Lisp_Object display
;
4861 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4864 switch (dpyinfo
->visual
->class)
4867 result
= intern ("static-gray");
4870 result
= intern ("gray-scale");
4873 result
= intern ("static-color");
4876 result
= intern ("pseudo-color");
4879 result
= intern ("true-color");
4882 result
= intern ("direct-color");
4885 error ("Display has an unknown visual class");
4892 DEFUN ("x-display-save-under", Fx_display_save_under
,
4893 Sx_display_save_under
, 0, 1, 0,
4894 doc
: /* Returns t if the X display DISPLAY supports the save-under feature.
4895 The optional argument DISPLAY specifies which display to ask about.
4896 DISPLAY should be either a frame or a display name (a string).
4897 If omitted or nil, that stands for the selected frame's display. */)
4899 Lisp_Object display
;
4901 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4903 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4911 register struct frame
*f
;
4913 return PIXEL_WIDTH (f
);
4918 register struct frame
*f
;
4920 return PIXEL_HEIGHT (f
);
4925 register struct frame
*f
;
4927 return FONT_WIDTH (f
->output_data
.x
->font
);
4932 register struct frame
*f
;
4934 return f
->output_data
.x
->line_height
;
4939 register struct frame
*f
;
4941 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4946 /************************************************************************
4948 ************************************************************************/
4951 /* Mapping visual names to visuals. */
4953 static struct visual_class
4960 {"StaticGray", StaticGray
},
4961 {"GrayScale", GrayScale
},
4962 {"StaticColor", StaticColor
},
4963 {"PseudoColor", PseudoColor
},
4964 {"TrueColor", TrueColor
},
4965 {"DirectColor", DirectColor
},
4970 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4972 /* Value is the screen number of screen SCR. This is a substitute for
4973 the X function with the same name when that doesn't exist. */
4976 XScreenNumberOfScreen (scr
)
4977 register Screen
*scr
;
4979 Display
*dpy
= scr
->display
;
4982 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4983 if (scr
== dpy
->screens
+ i
)
4989 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4992 /* Select the visual that should be used on display DPYINFO. Set
4993 members of DPYINFO appropriately. Called from x_term_init. */
4996 select_visual (dpyinfo
)
4997 struct x_display_info
*dpyinfo
;
4999 Display
*dpy
= dpyinfo
->display
;
5000 Screen
*screen
= dpyinfo
->screen
;
5003 /* See if a visual is specified. */
5004 value
= display_x_get_resource (dpyinfo
,
5005 build_string ("visualClass"),
5006 build_string ("VisualClass"),
5008 if (STRINGP (value
))
5010 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
5011 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
5012 depth, a decimal number. NAME is compared with case ignored. */
5013 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
5018 strcpy (s
, XSTRING (value
)->data
);
5019 dash
= index (s
, '-');
5022 dpyinfo
->n_planes
= atoi (dash
+ 1);
5026 /* We won't find a matching visual with depth 0, so that
5027 an error will be printed below. */
5028 dpyinfo
->n_planes
= 0;
5030 /* Determine the visual class. */
5031 for (i
= 0; visual_classes
[i
].name
; ++i
)
5032 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
5034 class = visual_classes
[i
].class;
5038 /* Look up a matching visual for the specified class. */
5040 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
5041 dpyinfo
->n_planes
, class, &vinfo
))
5042 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
5044 dpyinfo
->visual
= vinfo
.visual
;
5049 XVisualInfo
*vinfo
, vinfo_template
;
5051 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
5054 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
5056 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
5058 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5059 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
5060 &vinfo_template
, &n_visuals
);
5062 fatal ("Can't get proper X visual info");
5064 dpyinfo
->n_planes
= vinfo
->depth
;
5065 XFree ((char *) vinfo
);
5070 /* Return the X display structure for the display named NAME.
5071 Open a new connection if necessary. */
5073 struct x_display_info
*
5074 x_display_info_for_name (name
)
5078 struct x_display_info
*dpyinfo
;
5080 CHECK_STRING (name
, 0);
5082 if (! EQ (Vwindow_system
, intern ("x")))
5083 error ("Not using X Windows");
5085 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5087 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5090 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5095 /* Use this general default value to start with. */
5096 Vx_resource_name
= Vinvocation_name
;
5098 validate_x_resource_name ();
5100 dpyinfo
= x_term_init (name
, (char *)0,
5101 (char *) XSTRING (Vx_resource_name
)->data
);
5104 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5107 XSETFASTINT (Vwindow_system_version
, 11);
5113 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5115 doc
: /* Open a connection to an X server.
5116 DISPLAY is the name of the display to connect to.
5117 Optional second arg XRM-STRING is a string of resources in xrdb format.
5118 If the optional third arg MUST-SUCCEED is non-nil,
5119 terminate Emacs if we can't open the connection. */)
5120 (display
, xrm_string
, must_succeed
)
5121 Lisp_Object display
, xrm_string
, must_succeed
;
5123 unsigned char *xrm_option
;
5124 struct x_display_info
*dpyinfo
;
5126 CHECK_STRING (display
, 0);
5127 if (! NILP (xrm_string
))
5128 CHECK_STRING (xrm_string
, 1);
5130 if (! EQ (Vwindow_system
, intern ("x")))
5131 error ("Not using X Windows");
5133 if (! NILP (xrm_string
))
5134 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5136 xrm_option
= (unsigned char *) 0;
5138 validate_x_resource_name ();
5140 /* This is what opens the connection and sets x_current_display.
5141 This also initializes many symbols, such as those used for input. */
5142 dpyinfo
= x_term_init (display
, xrm_option
,
5143 (char *) XSTRING (Vx_resource_name
)->data
);
5147 if (!NILP (must_succeed
))
5148 fatal ("Cannot connect to X server %s.\n\
5149 Check the DISPLAY environment variable or use `-d'.\n\
5150 Also use the `xhost' program to verify that it is set to permit\n\
5151 connections from your machine.\n",
5152 XSTRING (display
)->data
);
5154 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5159 XSETFASTINT (Vwindow_system_version
, 11);
5163 DEFUN ("x-close-connection", Fx_close_connection
,
5164 Sx_close_connection
, 1, 1, 0,
5165 doc
: /* Close the connection to DISPLAY's X server.
5166 For DISPLAY, specify either a frame or a display name (a string).
5167 If DISPLAY is nil, that stands for the selected frame's display. */)
5169 Lisp_Object display
;
5171 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5174 if (dpyinfo
->reference_count
> 0)
5175 error ("Display still has frames on it");
5178 /* Free the fonts in the font table. */
5179 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5180 if (dpyinfo
->font_table
[i
].name
)
5182 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
5183 xfree (dpyinfo
->font_table
[i
].full_name
);
5184 xfree (dpyinfo
->font_table
[i
].name
);
5185 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5188 x_destroy_all_bitmaps (dpyinfo
);
5189 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5191 #ifdef USE_X_TOOLKIT
5192 XtCloseDisplay (dpyinfo
->display
);
5194 XCloseDisplay (dpyinfo
->display
);
5197 x_delete_display (dpyinfo
);
5203 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5204 doc
: /* Return the list of display names that Emacs has connections to. */)
5207 Lisp_Object tail
, result
;
5210 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5211 result
= Fcons (XCAR (XCAR (tail
)), result
);
5216 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5217 doc
: /* If ON is non-nil, report X errors as soon as the erring request is made.
5218 If ON is nil, allow buffering of requests.
5219 Turning on synchronization prohibits the Xlib routines from buffering
5220 requests and seriously degrades performance, but makes debugging much
5222 The optional second argument DISPLAY specifies which display to act on.
5223 DISPLAY should be either a frame or a display name (a string).
5224 If DISPLAY is omitted or nil, that stands for the selected frame's display. */)
5226 Lisp_Object display
, on
;
5228 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5230 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5235 /* Wait for responses to all X commands issued so far for frame F. */
5242 XSync (FRAME_X_DISPLAY (f
), False
);
5247 /***********************************************************************
5249 ***********************************************************************/
5251 /* Value is the number of elements of vector VECTOR. */
5253 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5255 /* List of supported image types. Use define_image_type to add new
5256 types. Use lookup_image_type to find a type for a given symbol. */
5258 static struct image_type
*image_types
;
5260 /* The symbol `image' which is the car of the lists used to represent
5263 extern Lisp_Object Qimage
;
5265 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5271 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5272 extern Lisp_Object QCdata
;
5273 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
5274 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
5275 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5277 /* Other symbols. */
5279 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5281 /* Time in seconds after which images should be removed from the cache
5282 if not displayed. */
5284 Lisp_Object Vimage_cache_eviction_delay
;
5286 /* Function prototypes. */
5288 static void define_image_type
P_ ((struct image_type
*type
));
5289 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5290 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5291 static void x_laplace
P_ ((struct frame
*, struct image
*));
5292 static void x_emboss
P_ ((struct frame
*, struct image
*));
5293 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5297 /* Define a new image type from TYPE. This adds a copy of TYPE to
5298 image_types and adds the symbol *TYPE->type to Vimage_types. */
5301 define_image_type (type
)
5302 struct image_type
*type
;
5304 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5305 The initialized data segment is read-only. */
5306 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5307 bcopy (type
, p
, sizeof *p
);
5308 p
->next
= image_types
;
5310 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5314 /* Look up image type SYMBOL, and return a pointer to its image_type
5315 structure. Value is null if SYMBOL is not a known image type. */
5317 static INLINE
struct image_type
*
5318 lookup_image_type (symbol
)
5321 struct image_type
*type
;
5323 for (type
= image_types
; type
; type
= type
->next
)
5324 if (EQ (symbol
, *type
->type
))
5331 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5332 valid image specification is a list whose car is the symbol
5333 `image', and whose rest is a property list. The property list must
5334 contain a value for key `:type'. That value must be the name of a
5335 supported image type. The rest of the property list depends on the
5339 valid_image_p (object
)
5344 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5348 for (tem
= XCDR (object
); CONSP (tem
); tem
= XCDR (tem
))
5349 if (EQ (XCAR (tem
), QCtype
))
5352 if (CONSP (tem
) && SYMBOLP (XCAR (tem
)))
5354 struct image_type
*type
;
5355 type
= lookup_image_type (XCAR (tem
));
5357 valid_p
= type
->valid_p (object
);
5368 /* Log error message with format string FORMAT and argument ARG.
5369 Signaling an error, e.g. when an image cannot be loaded, is not a
5370 good idea because this would interrupt redisplay, and the error
5371 message display would lead to another redisplay. This function
5372 therefore simply displays a message. */
5375 image_error (format
, arg1
, arg2
)
5377 Lisp_Object arg1
, arg2
;
5379 add_to_log (format
, arg1
, arg2
);
5384 /***********************************************************************
5385 Image specifications
5386 ***********************************************************************/
5388 enum image_value_type
5390 IMAGE_DONT_CHECK_VALUE_TYPE
,
5392 IMAGE_STRING_OR_NIL_VALUE
,
5394 IMAGE_POSITIVE_INTEGER_VALUE
,
5395 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
5396 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5398 IMAGE_INTEGER_VALUE
,
5399 IMAGE_FUNCTION_VALUE
,
5404 /* Structure used when parsing image specifications. */
5406 struct image_keyword
5408 /* Name of keyword. */
5411 /* The type of value allowed. */
5412 enum image_value_type type
;
5414 /* Non-zero means key must be present. */
5417 /* Used to recognize duplicate keywords in a property list. */
5420 /* The value that was found. */
5425 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5427 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5430 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5431 has the format (image KEYWORD VALUE ...). One of the keyword/
5432 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5433 image_keywords structures of size NKEYWORDS describing other
5434 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5437 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5439 struct image_keyword
*keywords
;
5446 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5449 plist
= XCDR (spec
);
5450 while (CONSP (plist
))
5452 Lisp_Object key
, value
;
5454 /* First element of a pair must be a symbol. */
5456 plist
= XCDR (plist
);
5460 /* There must follow a value. */
5463 value
= XCAR (plist
);
5464 plist
= XCDR (plist
);
5466 /* Find key in KEYWORDS. Error if not found. */
5467 for (i
= 0; i
< nkeywords
; ++i
)
5468 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5474 /* Record that we recognized the keyword. If a keywords
5475 was found more than once, it's an error. */
5476 keywords
[i
].value
= value
;
5477 ++keywords
[i
].count
;
5479 if (keywords
[i
].count
> 1)
5482 /* Check type of value against allowed type. */
5483 switch (keywords
[i
].type
)
5485 case IMAGE_STRING_VALUE
:
5486 if (!STRINGP (value
))
5490 case IMAGE_STRING_OR_NIL_VALUE
:
5491 if (!STRINGP (value
) && !NILP (value
))
5495 case IMAGE_SYMBOL_VALUE
:
5496 if (!SYMBOLP (value
))
5500 case IMAGE_POSITIVE_INTEGER_VALUE
:
5501 if (!INTEGERP (value
) || XINT (value
) <= 0)
5505 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
5506 if (INTEGERP (value
) && XINT (value
) >= 0)
5509 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
5510 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
5514 case IMAGE_ASCENT_VALUE
:
5515 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5517 else if (INTEGERP (value
)
5518 && XINT (value
) >= 0
5519 && XINT (value
) <= 100)
5523 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5524 if (!INTEGERP (value
) || XINT (value
) < 0)
5528 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5531 case IMAGE_FUNCTION_VALUE
:
5532 value
= indirect_function (value
);
5534 || COMPILEDP (value
)
5535 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5539 case IMAGE_NUMBER_VALUE
:
5540 if (!INTEGERP (value
) && !FLOATP (value
))
5544 case IMAGE_INTEGER_VALUE
:
5545 if (!INTEGERP (value
))
5549 case IMAGE_BOOL_VALUE
:
5550 if (!NILP (value
) && !EQ (value
, Qt
))
5559 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5563 /* Check that all mandatory fields are present. */
5564 for (i
= 0; i
< nkeywords
; ++i
)
5565 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5568 return NILP (plist
);
5572 /* Return the value of KEY in image specification SPEC. Value is nil
5573 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5574 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5577 image_spec_value (spec
, key
, found
)
5578 Lisp_Object spec
, key
;
5583 xassert (valid_image_p (spec
));
5585 for (tail
= XCDR (spec
);
5586 CONSP (tail
) && CONSP (XCDR (tail
));
5587 tail
= XCDR (XCDR (tail
)))
5589 if (EQ (XCAR (tail
), key
))
5593 return XCAR (XCDR (tail
));
5603 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5604 doc
: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
5605 PIXELS non-nil means return the size in pixels, otherwise return the
5606 size in canonical character units.
5607 FRAME is the frame on which the image will be displayed. FRAME nil
5608 or omitted means use the selected frame. */)
5609 (spec
, pixels
, frame
)
5610 Lisp_Object spec
, pixels
, frame
;
5615 if (valid_image_p (spec
))
5617 struct frame
*f
= check_x_frame (frame
);
5618 int id
= lookup_image (f
, spec
);
5619 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5620 int width
= img
->width
+ 2 * img
->hmargin
;
5621 int height
= img
->height
+ 2 * img
->vmargin
;
5624 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5625 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5627 size
= Fcons (make_number (width
), make_number (height
));
5630 error ("Invalid image specification");
5636 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5637 doc
: /* Return t if image SPEC has a mask bitmap.
5638 FRAME is the frame on which the image will be displayed. FRAME nil
5639 or omitted means use the selected frame. */)
5641 Lisp_Object spec
, frame
;
5646 if (valid_image_p (spec
))
5648 struct frame
*f
= check_x_frame (frame
);
5649 int id
= lookup_image (f
, spec
);
5650 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5655 error ("Invalid image specification");
5662 /***********************************************************************
5663 Image type independent image structures
5664 ***********************************************************************/
5666 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5667 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5670 /* Allocate and return a new image structure for image specification
5671 SPEC. SPEC has a hash value of HASH. */
5673 static struct image
*
5674 make_image (spec
, hash
)
5678 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5680 xassert (valid_image_p (spec
));
5681 bzero (img
, sizeof *img
);
5682 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5683 xassert (img
->type
!= NULL
);
5685 img
->data
.lisp_val
= Qnil
;
5686 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5692 /* Free image IMG which was used on frame F, including its resources. */
5701 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5703 /* Remove IMG from the hash table of its cache. */
5705 img
->prev
->next
= img
->next
;
5707 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5710 img
->next
->prev
= img
->prev
;
5712 c
->images
[img
->id
] = NULL
;
5714 /* Free resources, then free IMG. */
5715 img
->type
->free (f
, img
);
5721 /* Prepare image IMG for display on frame F. Must be called before
5722 drawing an image. */
5725 prepare_image_for_display (f
, img
)
5731 /* We're about to display IMG, so set its timestamp to `now'. */
5733 img
->timestamp
= EMACS_SECS (t
);
5735 /* If IMG doesn't have a pixmap yet, load it now, using the image
5736 type dependent loader function. */
5737 if (img
->pixmap
== None
&& !img
->load_failed_p
)
5738 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5742 /* Value is the number of pixels for the ascent of image IMG when
5743 drawn in face FACE. */
5746 image_ascent (img
, face
)
5750 int height
= img
->height
+ img
->vmargin
;
5753 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5756 /* This expression is arranged so that if the image can't be
5757 exactly centered, it will be moved slightly up. This is
5758 because a typical font is `top-heavy' (due to the presence
5759 uppercase letters), so the image placement should err towards
5760 being top-heavy too. It also just generally looks better. */
5761 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
5763 ascent
= height
/ 2;
5766 ascent
= height
* img
->ascent
/ 100.0;
5772 /* Image background colors. */
5774 static unsigned long
5775 four_corners_best (ximg
, width
, height
)
5777 unsigned long width
, height
;
5779 unsigned long corners
[4], best
;
5782 /* Get the colors at the corners of ximg. */
5783 corners
[0] = XGetPixel (ximg
, 0, 0);
5784 corners
[1] = XGetPixel (ximg
, width
- 1, 0);
5785 corners
[2] = XGetPixel (ximg
, width
- 1, height
- 1);
5786 corners
[3] = XGetPixel (ximg
, 0, height
- 1);
5788 /* Choose the most frequently found color as background. */
5789 for (i
= best_count
= 0; i
< 4; ++i
)
5793 for (j
= n
= 0; j
< 4; ++j
)
5794 if (corners
[i
] == corners
[j
])
5798 best
= corners
[i
], best_count
= n
;
5804 /* Return the `background' field of IMG. If IMG doesn't have one yet,
5805 it is guessed heuristically. If non-zero, XIMG is an existing XImage
5806 object to use for the heuristic. */
5809 image_background (img
, f
, ximg
)
5814 if (! img
->background_valid
)
5815 /* IMG doesn't have a background yet, try to guess a reasonable value. */
5817 int free_ximg
= !ximg
;
5820 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
5821 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
5823 img
->background
= four_corners_best (ximg
, img
->width
, img
->height
);
5826 XDestroyImage (ximg
);
5828 img
->background_valid
= 1;
5831 return img
->background
;
5834 /* Return the `background_transparent' field of IMG. If IMG doesn't
5835 have one yet, it is guessed heuristically. If non-zero, MASK is an
5836 existing XImage object to use for the heuristic. */
5839 image_background_transparent (img
, f
, mask
)
5844 if (! img
->background_transparent_valid
)
5845 /* IMG doesn't have a background yet, try to guess a reasonable value. */
5849 int free_mask
= !mask
;
5852 mask
= XGetImage (FRAME_X_DISPLAY (f
), img
->mask
,
5853 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
5855 img
->background_transparent
5856 = !four_corners_best (mask
, img
->width
, img
->height
);
5859 XDestroyImage (mask
);
5862 img
->background_transparent
= 0;
5864 img
->background_transparent_valid
= 1;
5867 return img
->background_transparent
;
5871 /***********************************************************************
5872 Helper functions for X image types
5873 ***********************************************************************/
5875 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
5877 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5878 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5880 Lisp_Object color_name
,
5881 unsigned long dflt
));
5884 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5885 free the pixmap if any. MASK_P non-zero means clear the mask
5886 pixmap if any. COLORS_P non-zero means free colors allocated for
5887 the image, if any. */
5890 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
5893 int pixmap_p
, mask_p
, colors_p
;
5895 if (pixmap_p
&& img
->pixmap
)
5897 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5899 img
->background_valid
= 0;
5902 if (mask_p
&& img
->mask
)
5904 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5906 img
->background_transparent_valid
= 0;
5909 if (colors_p
&& img
->ncolors
)
5911 x_free_colors (f
, img
->colors
, img
->ncolors
);
5912 xfree (img
->colors
);
5918 /* Free X resources of image IMG which is used on frame F. */
5921 x_clear_image (f
, img
)
5926 x_clear_image_1 (f
, img
, 1, 1, 1);
5931 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5932 cannot be allocated, use DFLT. Add a newly allocated color to
5933 IMG->colors, so that it can be freed again. Value is the pixel
5936 static unsigned long
5937 x_alloc_image_color (f
, img
, color_name
, dflt
)
5940 Lisp_Object color_name
;
5944 unsigned long result
;
5946 xassert (STRINGP (color_name
));
5948 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5950 /* This isn't called frequently so we get away with simply
5951 reallocating the color vector to the needed size, here. */
5954 (unsigned long *) xrealloc (img
->colors
,
5955 img
->ncolors
* sizeof *img
->colors
);
5956 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5957 result
= color
.pixel
;
5967 /***********************************************************************
5969 ***********************************************************************/
5971 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5972 static void postprocess_image
P_ ((struct frame
*, struct image
*));
5975 /* Return a new, initialized image cache that is allocated from the
5976 heap. Call free_image_cache to free an image cache. */
5978 struct image_cache
*
5981 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5984 bzero (c
, sizeof *c
);
5986 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5987 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5988 c
->buckets
= (struct image
**) xmalloc (size
);
5989 bzero (c
->buckets
, size
);
5994 /* Free image cache of frame F. Be aware that X frames share images
5998 free_image_cache (f
)
6001 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6006 /* Cache should not be referenced by any frame when freed. */
6007 xassert (c
->refcount
== 0);
6009 for (i
= 0; i
< c
->used
; ++i
)
6010 free_image (f
, c
->images
[i
]);
6014 FRAME_X_IMAGE_CACHE (f
) = NULL
;
6019 /* Clear image cache of frame F. FORCE_P non-zero means free all
6020 images. FORCE_P zero means clear only images that haven't been
6021 displayed for some time. Should be called from time to time to
6022 reduce the number of loaded images. If image-eviction-seconds is
6023 non-nil, this frees images in the cache which weren't displayed for
6024 at least that many seconds. */
6027 clear_image_cache (f
, force_p
)
6031 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6033 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
6040 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
6042 /* Block input so that we won't be interrupted by a SIGIO
6043 while being in an inconsistent state. */
6046 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
6048 struct image
*img
= c
->images
[i
];
6050 && (force_p
|| img
->timestamp
< old
))
6052 free_image (f
, img
);
6057 /* We may be clearing the image cache because, for example,
6058 Emacs was iconified for a longer period of time. In that
6059 case, current matrices may still contain references to
6060 images freed above. So, clear these matrices. */
6063 Lisp_Object tail
, frame
;
6065 FOR_EACH_FRAME (tail
, frame
)
6067 struct frame
*f
= XFRAME (frame
);
6069 && FRAME_X_IMAGE_CACHE (f
) == c
)
6070 clear_current_matrices (f
);
6073 ++windows_or_buffers_changed
;
6081 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
6083 doc
: /* Clear the image cache of FRAME.
6084 FRAME nil or omitted means use the selected frame.
6085 FRAME t means clear the image caches of all frames. */)
6093 FOR_EACH_FRAME (tail
, frame
)
6094 if (FRAME_X_P (XFRAME (frame
)))
6095 clear_image_cache (XFRAME (frame
), 1);
6098 clear_image_cache (check_x_frame (frame
), 1);
6104 /* Compute masks and transform image IMG on frame F, as specified
6105 by the image's specification, */
6108 postprocess_image (f
, img
)
6112 /* Manipulation of the image's mask. */
6115 Lisp_Object conversion
, spec
;
6120 /* `:heuristic-mask t'
6122 means build a mask heuristically.
6123 `:heuristic-mask (R G B)'
6124 `:mask (heuristic (R G B))'
6125 means build a mask from color (R G B) in the
6128 means remove a mask, if any. */
6130 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6132 x_build_heuristic_mask (f
, img
, mask
);
6137 mask
= image_spec_value (spec
, QCmask
, &found_p
);
6139 if (EQ (mask
, Qheuristic
))
6140 x_build_heuristic_mask (f
, img
, Qt
);
6141 else if (CONSP (mask
)
6142 && EQ (XCAR (mask
), Qheuristic
))
6144 if (CONSP (XCDR (mask
)))
6145 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
6147 x_build_heuristic_mask (f
, img
, XCDR (mask
));
6149 else if (NILP (mask
) && found_p
&& img
->mask
)
6151 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6157 /* Should we apply an image transformation algorithm? */
6158 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
6159 if (EQ (conversion
, Qdisabled
))
6160 x_disable_image (f
, img
);
6161 else if (EQ (conversion
, Qlaplace
))
6163 else if (EQ (conversion
, Qemboss
))
6165 else if (CONSP (conversion
)
6166 && EQ (XCAR (conversion
), Qedge_detection
))
6169 tem
= XCDR (conversion
);
6171 x_edge_detection (f
, img
,
6172 Fplist_get (tem
, QCmatrix
),
6173 Fplist_get (tem
, QCcolor_adjustment
));
6179 /* Return the id of image with Lisp specification SPEC on frame F.
6180 SPEC must be a valid Lisp image specification (see valid_image_p). */
6183 lookup_image (f
, spec
)
6187 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6191 struct gcpro gcpro1
;
6194 /* F must be a window-system frame, and SPEC must be a valid image
6196 xassert (FRAME_WINDOW_P (f
));
6197 xassert (valid_image_p (spec
));
6201 /* Look up SPEC in the hash table of the image cache. */
6202 hash
= sxhash (spec
, 0);
6203 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6205 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6206 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6209 /* If not found, create a new image and cache it. */
6212 extern Lisp_Object Qpostscript
;
6215 img
= make_image (spec
, hash
);
6216 cache_image (f
, img
);
6217 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6219 /* If we can't load the image, and we don't have a width and
6220 height, use some arbitrary width and height so that we can
6221 draw a rectangle for it. */
6222 if (img
->load_failed_p
)
6226 value
= image_spec_value (spec
, QCwidth
, NULL
);
6227 img
->width
= (INTEGERP (value
)
6228 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6229 value
= image_spec_value (spec
, QCheight
, NULL
);
6230 img
->height
= (INTEGERP (value
)
6231 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6235 /* Handle image type independent image attributes
6236 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF',
6237 `:background COLOR'. */
6238 Lisp_Object ascent
, margin
, relief
, bg
;
6240 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6241 if (INTEGERP (ascent
))
6242 img
->ascent
= XFASTINT (ascent
);
6243 else if (EQ (ascent
, Qcenter
))
6244 img
->ascent
= CENTERED_IMAGE_ASCENT
;
6246 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6247 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6248 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
6249 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
6250 && INTEGERP (XCDR (margin
)))
6252 if (XINT (XCAR (margin
)) > 0)
6253 img
->hmargin
= XFASTINT (XCAR (margin
));
6254 if (XINT (XCDR (margin
)) > 0)
6255 img
->vmargin
= XFASTINT (XCDR (margin
));
6258 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6259 if (INTEGERP (relief
))
6261 img
->relief
= XINT (relief
);
6262 img
->hmargin
+= abs (img
->relief
);
6263 img
->vmargin
+= abs (img
->relief
);
6266 if (! img
->background_valid
)
6268 bg
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6272 = x_alloc_image_color (f
, img
, bg
,
6273 FRAME_BACKGROUND_PIXEL (f
));
6274 img
->background_valid
= 1;
6278 /* Do image transformations and compute masks, unless we
6279 don't have the image yet. */
6280 if (!EQ (*img
->type
->type
, Qpostscript
))
6281 postprocess_image (f
, img
);
6285 xassert (!interrupt_input_blocked
);
6288 /* We're using IMG, so set its timestamp to `now'. */
6289 EMACS_GET_TIME (now
);
6290 img
->timestamp
= EMACS_SECS (now
);
6294 /* Value is the image id. */
6299 /* Cache image IMG in the image cache of frame F. */
6302 cache_image (f
, img
)
6306 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6309 /* Find a free slot in c->images. */
6310 for (i
= 0; i
< c
->used
; ++i
)
6311 if (c
->images
[i
] == NULL
)
6314 /* If no free slot found, maybe enlarge c->images. */
6315 if (i
== c
->used
&& c
->used
== c
->size
)
6318 c
->images
= (struct image
**) xrealloc (c
->images
,
6319 c
->size
* sizeof *c
->images
);
6322 /* Add IMG to c->images, and assign IMG an id. */
6328 /* Add IMG to the cache's hash table. */
6329 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6330 img
->next
= c
->buckets
[i
];
6332 img
->next
->prev
= img
;
6334 c
->buckets
[i
] = img
;
6338 /* Call FN on every image in the image cache of frame F. Used to mark
6339 Lisp Objects in the image cache. */
6342 forall_images_in_image_cache (f
, fn
)
6344 void (*fn
) P_ ((struct image
*img
));
6346 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6348 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6352 for (i
= 0; i
< c
->used
; ++i
)
6361 /***********************************************************************
6363 ***********************************************************************/
6365 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6366 XImage
**, Pixmap
*));
6367 static void x_destroy_x_image
P_ ((XImage
*));
6368 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6371 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6372 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6373 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6374 via xmalloc. Print error messages via image_error if an error
6375 occurs. Value is non-zero if successful. */
6378 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6380 int width
, height
, depth
;
6384 Display
*display
= FRAME_X_DISPLAY (f
);
6385 Screen
*screen
= FRAME_X_SCREEN (f
);
6386 Window window
= FRAME_X_WINDOW (f
);
6388 xassert (interrupt_input_blocked
);
6391 depth
= DefaultDepthOfScreen (screen
);
6392 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6393 depth
, ZPixmap
, 0, NULL
, width
, height
,
6394 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6397 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6401 /* Allocate image raster. */
6402 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6404 /* Allocate a pixmap of the same size. */
6405 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6406 if (*pixmap
== None
)
6408 x_destroy_x_image (*ximg
);
6410 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6418 /* Destroy XImage XIMG. Free XIMG->data. */
6421 x_destroy_x_image (ximg
)
6424 xassert (interrupt_input_blocked
);
6429 XDestroyImage (ximg
);
6434 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6435 are width and height of both the image and pixmap. */
6438 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6445 xassert (interrupt_input_blocked
);
6446 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6447 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6448 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6453 /***********************************************************************
6455 ***********************************************************************/
6457 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6458 static char *slurp_file
P_ ((char *, int *));
6461 /* Find image file FILE. Look in data-directory, then
6462 x-bitmap-file-path. Value is the full name of the file found, or
6463 nil if not found. */
6466 x_find_image_file (file
)
6469 Lisp_Object file_found
, search_path
;
6470 struct gcpro gcpro1
, gcpro2
;
6474 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6475 GCPRO2 (file_found
, search_path
);
6477 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6478 fd
= openp (search_path
, file
, Qnil
, &file_found
, 0);
6490 /* Read FILE into memory. Value is a pointer to a buffer allocated
6491 with xmalloc holding FILE's contents. Value is null if an error
6492 occurred. *SIZE is set to the size of the file. */
6495 slurp_file (file
, size
)
6503 if (stat (file
, &st
) == 0
6504 && (fp
= fopen (file
, "r")) != NULL
6505 && (buf
= (char *) xmalloc (st
.st_size
),
6506 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6527 /***********************************************************************
6529 ***********************************************************************/
6531 static int xbm_scan
P_ ((char **, char *, char *, int *));
6532 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6533 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6535 static int xbm_image_p
P_ ((Lisp_Object object
));
6536 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6538 static int xbm_file_p
P_ ((Lisp_Object
));
6541 /* Indices of image specification fields in xbm_format, below. */
6543 enum xbm_keyword_index
6561 /* Vector of image_keyword structures describing the format
6562 of valid XBM image specifications. */
6564 static struct image_keyword xbm_format
[XBM_LAST
] =
6566 {":type", IMAGE_SYMBOL_VALUE
, 1},
6567 {":file", IMAGE_STRING_VALUE
, 0},
6568 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6569 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6570 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6571 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
6572 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0},
6573 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6574 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6575 {":relief", IMAGE_INTEGER_VALUE
, 0},
6576 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6577 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6578 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6581 /* Structure describing the image type XBM. */
6583 static struct image_type xbm_type
=
6592 /* Tokens returned from xbm_scan. */
6601 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6602 A valid specification is a list starting with the symbol `image'
6603 The rest of the list is a property list which must contain an
6606 If the specification specifies a file to load, it must contain
6607 an entry `:file FILENAME' where FILENAME is a string.
6609 If the specification is for a bitmap loaded from memory it must
6610 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6611 WIDTH and HEIGHT are integers > 0. DATA may be:
6613 1. a string large enough to hold the bitmap data, i.e. it must
6614 have a size >= (WIDTH + 7) / 8 * HEIGHT
6616 2. a bool-vector of size >= WIDTH * HEIGHT
6618 3. a vector of strings or bool-vectors, one for each line of the
6621 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6622 may not be specified in this case because they are defined in the
6625 Both the file and data forms may contain the additional entries
6626 `:background COLOR' and `:foreground COLOR'. If not present,
6627 foreground and background of the frame on which the image is
6628 displayed is used. */
6631 xbm_image_p (object
)
6634 struct image_keyword kw
[XBM_LAST
];
6636 bcopy (xbm_format
, kw
, sizeof kw
);
6637 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6640 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6642 if (kw
[XBM_FILE
].count
)
6644 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6647 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6649 /* In-memory XBM file. */
6650 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6658 /* Entries for `:width', `:height' and `:data' must be present. */
6659 if (!kw
[XBM_WIDTH
].count
6660 || !kw
[XBM_HEIGHT
].count
6661 || !kw
[XBM_DATA
].count
)
6664 data
= kw
[XBM_DATA
].value
;
6665 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6666 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6668 /* Check type of data, and width and height against contents of
6674 /* Number of elements of the vector must be >= height. */
6675 if (XVECTOR (data
)->size
< height
)
6678 /* Each string or bool-vector in data must be large enough
6679 for one line of the image. */
6680 for (i
= 0; i
< height
; ++i
)
6682 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6686 if (XSTRING (elt
)->size
6687 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6690 else if (BOOL_VECTOR_P (elt
))
6692 if (XBOOL_VECTOR (elt
)->size
< width
)
6699 else if (STRINGP (data
))
6701 if (XSTRING (data
)->size
6702 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6705 else if (BOOL_VECTOR_P (data
))
6707 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6718 /* Scan a bitmap file. FP is the stream to read from. Value is
6719 either an enumerator from enum xbm_token, or a character for a
6720 single-character token, or 0 at end of file. If scanning an
6721 identifier, store the lexeme of the identifier in SVAL. If
6722 scanning a number, store its value in *IVAL. */
6725 xbm_scan (s
, end
, sval
, ival
)
6734 /* Skip white space. */
6735 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6740 else if (isdigit (c
))
6742 int value
= 0, digit
;
6744 if (c
== '0' && *s
< end
)
6747 if (c
== 'x' || c
== 'X')
6754 else if (c
>= 'a' && c
<= 'f')
6755 digit
= c
- 'a' + 10;
6756 else if (c
>= 'A' && c
<= 'F')
6757 digit
= c
- 'A' + 10;
6760 value
= 16 * value
+ digit
;
6763 else if (isdigit (c
))
6767 && (c
= *(*s
)++, isdigit (c
)))
6768 value
= 8 * value
+ c
- '0';
6775 && (c
= *(*s
)++, isdigit (c
)))
6776 value
= 10 * value
+ c
- '0';
6784 else if (isalpha (c
) || c
== '_')
6788 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6795 else if (c
== '/' && **s
== '*')
6797 /* C-style comment. */
6799 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
6812 /* Replacement for XReadBitmapFileData which isn't available under old
6813 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6814 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6815 the image. Return in *DATA the bitmap data allocated with xmalloc.
6816 Value is non-zero if successful. DATA null means just test if
6817 CONTENTS looks like an in-memory XBM file. */
6820 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6821 char *contents
, *end
;
6822 int *width
, *height
;
6823 unsigned char **data
;
6826 char buffer
[BUFSIZ
];
6829 int bytes_per_line
, i
, nbytes
;
6835 LA1 = xbm_scan (&s, end, buffer, &value)
6837 #define expect(TOKEN) \
6838 if (LA1 != (TOKEN)) \
6843 #define expect_ident(IDENT) \
6844 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6849 *width
= *height
= -1;
6852 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6854 /* Parse defines for width, height and hot-spots. */
6858 expect_ident ("define");
6859 expect (XBM_TK_IDENT
);
6861 if (LA1
== XBM_TK_NUMBER
);
6863 char *p
= strrchr (buffer
, '_');
6864 p
= p
? p
+ 1 : buffer
;
6865 if (strcmp (p
, "width") == 0)
6867 else if (strcmp (p
, "height") == 0)
6870 expect (XBM_TK_NUMBER
);
6873 if (*width
< 0 || *height
< 0)
6875 else if (data
== NULL
)
6878 /* Parse bits. Must start with `static'. */
6879 expect_ident ("static");
6880 if (LA1
== XBM_TK_IDENT
)
6882 if (strcmp (buffer
, "unsigned") == 0)
6885 expect_ident ("char");
6887 else if (strcmp (buffer
, "short") == 0)
6891 if (*width
% 16 && *width
% 16 < 9)
6894 else if (strcmp (buffer
, "char") == 0)
6902 expect (XBM_TK_IDENT
);
6908 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6909 nbytes
= bytes_per_line
* *height
;
6910 p
= *data
= (char *) xmalloc (nbytes
);
6914 for (i
= 0; i
< nbytes
; i
+= 2)
6917 expect (XBM_TK_NUMBER
);
6920 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6923 if (LA1
== ',' || LA1
== '}')
6931 for (i
= 0; i
< nbytes
; ++i
)
6934 expect (XBM_TK_NUMBER
);
6938 if (LA1
== ',' || LA1
== '}')
6963 /* Load XBM image IMG which will be displayed on frame F from buffer
6964 CONTENTS. END is the end of the buffer. Value is non-zero if
6968 xbm_load_image (f
, img
, contents
, end
)
6971 char *contents
, *end
;
6974 unsigned char *data
;
6977 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6980 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6981 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6982 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6985 xassert (img
->width
> 0 && img
->height
> 0);
6987 /* Get foreground and background colors, maybe allocate colors. */
6988 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6990 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6991 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6994 background
= x_alloc_image_color (f
, img
, value
, background
);
6995 img
->background
= background
;
6996 img
->background_valid
= 1;
7000 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7003 img
->width
, img
->height
,
7004 foreground
, background
,
7008 if (img
->pixmap
== None
)
7010 x_clear_image (f
, img
);
7011 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
7017 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
7023 /* Value is non-zero if DATA looks like an in-memory XBM file. */
7030 return (STRINGP (data
)
7031 && xbm_read_bitmap_data (XSTRING (data
)->data
,
7032 (XSTRING (data
)->data
7033 + STRING_BYTES (XSTRING (data
))),
7038 /* Fill image IMG which is used on frame F with pixmap data. Value is
7039 non-zero if successful. */
7047 Lisp_Object file_name
;
7049 xassert (xbm_image_p (img
->spec
));
7051 /* If IMG->spec specifies a file name, create a non-file spec from it. */
7052 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
7053 if (STRINGP (file_name
))
7058 struct gcpro gcpro1
;
7060 file
= x_find_image_file (file_name
);
7062 if (!STRINGP (file
))
7064 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
7069 contents
= slurp_file (XSTRING (file
)->data
, &size
);
7070 if (contents
== NULL
)
7072 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
7077 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
7082 struct image_keyword fmt
[XBM_LAST
];
7085 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
7086 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
7089 int in_memory_file_p
= 0;
7091 /* See if data looks like an in-memory XBM file. */
7092 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
7093 in_memory_file_p
= xbm_file_p (data
);
7095 /* Parse the image specification. */
7096 bcopy (xbm_format
, fmt
, sizeof fmt
);
7097 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
7100 /* Get specified width, and height. */
7101 if (!in_memory_file_p
)
7103 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
7104 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
7105 xassert (img
->width
> 0 && img
->height
> 0);
7108 /* Get foreground and background colors, maybe allocate colors. */
7109 if (fmt
[XBM_FOREGROUND
].count
7110 && STRINGP (fmt
[XBM_FOREGROUND
].value
))
7111 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
7113 if (fmt
[XBM_BACKGROUND
].count
7114 && STRINGP (fmt
[XBM_BACKGROUND
].value
))
7115 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
7118 if (in_memory_file_p
)
7119 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
7120 (XSTRING (data
)->data
7121 + STRING_BYTES (XSTRING (data
))));
7128 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
7130 p
= bits
= (char *) alloca (nbytes
* img
->height
);
7131 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
7133 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
7135 bcopy (XSTRING (line
)->data
, p
, nbytes
);
7137 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
7140 else if (STRINGP (data
))
7141 bits
= XSTRING (data
)->data
;
7143 bits
= XBOOL_VECTOR (data
)->data
;
7145 /* Create the pixmap. */
7146 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
7148 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7151 img
->width
, img
->height
,
7152 foreground
, background
,
7158 image_error ("Unable to create pixmap for XBM image `%s'",
7160 x_clear_image (f
, img
);
7170 /***********************************************************************
7172 ***********************************************************************/
7176 static int xpm_image_p
P_ ((Lisp_Object object
));
7177 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
7178 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
7180 #include "X11/xpm.h"
7182 /* The symbol `xpm' identifying XPM-format images. */
7186 /* Indices of image specification fields in xpm_format, below. */
7188 enum xpm_keyword_index
7204 /* Vector of image_keyword structures describing the format
7205 of valid XPM image specifications. */
7207 static struct image_keyword xpm_format
[XPM_LAST
] =
7209 {":type", IMAGE_SYMBOL_VALUE
, 1},
7210 {":file", IMAGE_STRING_VALUE
, 0},
7211 {":data", IMAGE_STRING_VALUE
, 0},
7212 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7213 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
7214 {":relief", IMAGE_INTEGER_VALUE
, 0},
7215 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7216 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7217 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7218 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7219 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
7222 /* Structure describing the image type XBM. */
7224 static struct image_type xpm_type
=
7234 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
7235 functions for allocating image colors. Our own functions handle
7236 color allocation failures more gracefully than the ones on the XPM
7239 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
7240 #define ALLOC_XPM_COLORS
7243 #ifdef ALLOC_XPM_COLORS
7245 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
7246 static void xpm_free_color_cache
P_ ((void));
7247 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
7248 static int xpm_color_bucket
P_ ((char *));
7249 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
7252 /* An entry in a hash table used to cache color definitions of named
7253 colors. This cache is necessary to speed up XPM image loading in
7254 case we do color allocations ourselves. Without it, we would need
7255 a call to XParseColor per pixel in the image. */
7257 struct xpm_cached_color
7259 /* Next in collision chain. */
7260 struct xpm_cached_color
*next
;
7262 /* Color definition (RGB and pixel color). */
7269 /* The hash table used for the color cache, and its bucket vector
7272 #define XPM_COLOR_CACHE_BUCKETS 1001
7273 struct xpm_cached_color
**xpm_color_cache
;
7275 /* Initialize the color cache. */
7278 xpm_init_color_cache (f
, attrs
)
7280 XpmAttributes
*attrs
;
7282 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
7283 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
7284 memset (xpm_color_cache
, 0, nbytes
);
7285 init_color_table ();
7287 if (attrs
->valuemask
& XpmColorSymbols
)
7292 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
7293 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7294 attrs
->colorsymbols
[i
].value
, &color
))
7296 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
7298 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
7304 /* Free the color cache. */
7307 xpm_free_color_cache ()
7309 struct xpm_cached_color
*p
, *next
;
7312 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
7313 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
7319 xfree (xpm_color_cache
);
7320 xpm_color_cache
= NULL
;
7321 free_color_table ();
7325 /* Return the bucket index for color named COLOR_NAME in the color
7329 xpm_color_bucket (color_name
)
7335 for (s
= color_name
; *s
; ++s
)
7337 return h
%= XPM_COLOR_CACHE_BUCKETS
;
7341 /* On frame F, cache values COLOR for color with name COLOR_NAME.
7342 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7345 static struct xpm_cached_color
*
7346 xpm_cache_color (f
, color_name
, color
, bucket
)
7353 struct xpm_cached_color
*p
;
7356 bucket
= xpm_color_bucket (color_name
);
7358 nbytes
= sizeof *p
+ strlen (color_name
);
7359 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
7360 strcpy (p
->name
, color_name
);
7362 p
->next
= xpm_color_cache
[bucket
];
7363 xpm_color_cache
[bucket
] = p
;
7368 /* Look up color COLOR_NAME for frame F in the color cache. If found,
7369 return the cached definition in *COLOR. Otherwise, make a new
7370 entry in the cache and allocate the color. Value is zero if color
7371 allocation failed. */
7374 xpm_lookup_color (f
, color_name
, color
)
7379 struct xpm_cached_color
*p
;
7380 int h
= xpm_color_bucket (color_name
);
7382 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7383 if (strcmp (p
->name
, color_name
) == 0)
7388 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7391 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7393 p
= xpm_cache_color (f
, color_name
, color
, h
);
7400 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7401 CLOSURE is a pointer to the frame on which we allocate the
7402 color. Return in *COLOR the allocated color. Value is non-zero
7406 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7413 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7417 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7418 is a pointer to the frame on which we allocate the color. Value is
7419 non-zero if successful. */
7422 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7432 #endif /* ALLOC_XPM_COLORS */
7435 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7436 for XPM images. Such a list must consist of conses whose car and
7440 xpm_valid_color_symbols_p (color_symbols
)
7441 Lisp_Object color_symbols
;
7443 while (CONSP (color_symbols
))
7445 Lisp_Object sym
= XCAR (color_symbols
);
7447 || !STRINGP (XCAR (sym
))
7448 || !STRINGP (XCDR (sym
)))
7450 color_symbols
= XCDR (color_symbols
);
7453 return NILP (color_symbols
);
7457 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7460 xpm_image_p (object
)
7463 struct image_keyword fmt
[XPM_LAST
];
7464 bcopy (xpm_format
, fmt
, sizeof fmt
);
7465 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7466 /* Either `:file' or `:data' must be present. */
7467 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7468 /* Either no `:color-symbols' or it's a list of conses
7469 whose car and cdr are strings. */
7470 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7471 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7475 /* Load image IMG which will be displayed on frame F. Value is
7476 non-zero if successful. */
7484 XpmAttributes attrs
;
7485 Lisp_Object specified_file
, color_symbols
;
7487 /* Configure the XPM lib. Use the visual of frame F. Allocate
7488 close colors. Return colors allocated. */
7489 bzero (&attrs
, sizeof attrs
);
7490 attrs
.visual
= FRAME_X_VISUAL (f
);
7491 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7492 attrs
.valuemask
|= XpmVisual
;
7493 attrs
.valuemask
|= XpmColormap
;
7495 #ifdef ALLOC_XPM_COLORS
7496 /* Allocate colors with our own functions which handle
7497 failing color allocation more gracefully. */
7498 attrs
.color_closure
= f
;
7499 attrs
.alloc_color
= xpm_alloc_color
;
7500 attrs
.free_colors
= xpm_free_colors
;
7501 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7502 #else /* not ALLOC_XPM_COLORS */
7503 /* Let the XPM lib allocate colors. */
7504 attrs
.valuemask
|= XpmReturnAllocPixels
;
7505 #ifdef XpmAllocCloseColors
7506 attrs
.alloc_close_colors
= 1;
7507 attrs
.valuemask
|= XpmAllocCloseColors
;
7508 #else /* not XpmAllocCloseColors */
7509 attrs
.closeness
= 600;
7510 attrs
.valuemask
|= XpmCloseness
;
7511 #endif /* not XpmAllocCloseColors */
7512 #endif /* ALLOC_XPM_COLORS */
7514 /* If image specification contains symbolic color definitions, add
7515 these to `attrs'. */
7516 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7517 if (CONSP (color_symbols
))
7520 XpmColorSymbol
*xpm_syms
;
7523 attrs
.valuemask
|= XpmColorSymbols
;
7525 /* Count number of symbols. */
7526 attrs
.numsymbols
= 0;
7527 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7530 /* Allocate an XpmColorSymbol array. */
7531 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7532 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7533 bzero (xpm_syms
, size
);
7534 attrs
.colorsymbols
= xpm_syms
;
7536 /* Fill the color symbol array. */
7537 for (tail
= color_symbols
, i
= 0;
7539 ++i
, tail
= XCDR (tail
))
7541 Lisp_Object name
= XCAR (XCAR (tail
));
7542 Lisp_Object color
= XCDR (XCAR (tail
));
7543 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7544 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7545 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7546 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7550 /* Create a pixmap for the image, either from a file, or from a
7551 string buffer containing data in the same format as an XPM file. */
7552 #ifdef ALLOC_XPM_COLORS
7553 xpm_init_color_cache (f
, &attrs
);
7556 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7557 if (STRINGP (specified_file
))
7559 Lisp_Object file
= x_find_image_file (specified_file
);
7560 if (!STRINGP (file
))
7562 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7566 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7567 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7572 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7573 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7574 XSTRING (buffer
)->data
,
7575 &img
->pixmap
, &img
->mask
,
7579 if (rc
== XpmSuccess
)
7581 #ifdef ALLOC_XPM_COLORS
7582 img
->colors
= colors_in_color_table (&img
->ncolors
);
7583 #else /* not ALLOC_XPM_COLORS */
7586 img
->ncolors
= attrs
.nalloc_pixels
;
7587 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7588 * sizeof *img
->colors
);
7589 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7591 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7592 #ifdef DEBUG_X_COLORS
7593 register_color (img
->colors
[i
]);
7596 #endif /* not ALLOC_XPM_COLORS */
7598 img
->width
= attrs
.width
;
7599 img
->height
= attrs
.height
;
7600 xassert (img
->width
> 0 && img
->height
> 0);
7602 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7603 XpmFreeAttributes (&attrs
);
7610 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7613 case XpmFileInvalid
:
7614 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7618 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7621 case XpmColorFailed
:
7622 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7626 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7631 #ifdef ALLOC_XPM_COLORS
7632 xpm_free_color_cache ();
7634 return rc
== XpmSuccess
;
7637 #endif /* HAVE_XPM != 0 */
7640 /***********************************************************************
7642 ***********************************************************************/
7644 /* An entry in the color table mapping an RGB color to a pixel color. */
7649 unsigned long pixel
;
7651 /* Next in color table collision list. */
7652 struct ct_color
*next
;
7655 /* The bucket vector size to use. Must be prime. */
7659 /* Value is a hash of the RGB color given by R, G, and B. */
7661 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7663 /* The color hash table. */
7665 struct ct_color
**ct_table
;
7667 /* Number of entries in the color table. */
7669 int ct_colors_allocated
;
7671 /* Initialize the color table. */
7676 int size
= CT_SIZE
* sizeof (*ct_table
);
7677 ct_table
= (struct ct_color
**) xmalloc (size
);
7678 bzero (ct_table
, size
);
7679 ct_colors_allocated
= 0;
7683 /* Free memory associated with the color table. */
7689 struct ct_color
*p
, *next
;
7691 for (i
= 0; i
< CT_SIZE
; ++i
)
7692 for (p
= ct_table
[i
]; p
; p
= next
)
7703 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7704 entry for that color already is in the color table, return the
7705 pixel color of that entry. Otherwise, allocate a new color for R,
7706 G, B, and make an entry in the color table. */
7708 static unsigned long
7709 lookup_rgb_color (f
, r
, g
, b
)
7713 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7714 int i
= hash
% CT_SIZE
;
7717 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7718 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7731 cmap
= FRAME_X_COLORMAP (f
);
7732 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7736 ++ct_colors_allocated
;
7738 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7742 p
->pixel
= color
.pixel
;
7743 p
->next
= ct_table
[i
];
7747 return FRAME_FOREGROUND_PIXEL (f
);
7754 /* Look up pixel color PIXEL which is used on frame F in the color
7755 table. If not already present, allocate it. Value is PIXEL. */
7757 static unsigned long
7758 lookup_pixel_color (f
, pixel
)
7760 unsigned long pixel
;
7762 int i
= pixel
% CT_SIZE
;
7765 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7766 if (p
->pixel
== pixel
)
7775 cmap
= FRAME_X_COLORMAP (f
);
7776 color
.pixel
= pixel
;
7777 x_query_color (f
, &color
);
7778 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7782 ++ct_colors_allocated
;
7784 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7789 p
->next
= ct_table
[i
];
7793 return FRAME_FOREGROUND_PIXEL (f
);
7800 /* Value is a vector of all pixel colors contained in the color table,
7801 allocated via xmalloc. Set *N to the number of colors. */
7803 static unsigned long *
7804 colors_in_color_table (n
)
7809 unsigned long *colors
;
7811 if (ct_colors_allocated
== 0)
7818 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7820 *n
= ct_colors_allocated
;
7822 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7823 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7824 colors
[j
++] = p
->pixel
;
7832 /***********************************************************************
7834 ***********************************************************************/
7836 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
7837 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
7838 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
7840 /* Non-zero means draw a cross on images having `:conversion
7843 int cross_disabled_images
;
7845 /* Edge detection matrices for different edge-detection
7848 static int emboss_matrix
[9] = {
7850 2, -1, 0, /* y - 1 */
7852 0, 1, -2 /* y + 1 */
7855 static int laplace_matrix
[9] = {
7857 1, 0, 0, /* y - 1 */
7859 0, 0, -1 /* y + 1 */
7862 /* Value is the intensity of the color whose red/green/blue values
7865 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7868 /* On frame F, return an array of XColor structures describing image
7869 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7870 non-zero means also fill the red/green/blue members of the XColor
7871 structures. Value is a pointer to the array of XColors structures,
7872 allocated with xmalloc; it must be freed by the caller. */
7875 x_to_xcolors (f
, img
, rgb_p
)
7884 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
7886 /* Get the X image IMG->pixmap. */
7887 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7888 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7890 /* Fill the `pixel' members of the XColor array. I wished there
7891 were an easy and portable way to circumvent XGetPixel. */
7893 for (y
= 0; y
< img
->height
; ++y
)
7897 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7898 p
->pixel
= XGetPixel (ximg
, x
, y
);
7901 x_query_colors (f
, row
, img
->width
);
7904 XDestroyImage (ximg
);
7909 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7910 RGB members are set. F is the frame on which this all happens.
7911 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7914 x_from_xcolors (f
, img
, colors
)
7924 init_color_table ();
7926 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7929 for (y
= 0; y
< img
->height
; ++y
)
7930 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7932 unsigned long pixel
;
7933 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
7934 XPutPixel (oimg
, x
, y
, pixel
);
7938 x_clear_image_1 (f
, img
, 1, 0, 1);
7940 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7941 x_destroy_x_image (oimg
);
7942 img
->pixmap
= pixmap
;
7943 img
->colors
= colors_in_color_table (&img
->ncolors
);
7944 free_color_table ();
7948 /* On frame F, perform edge-detection on image IMG.
7950 MATRIX is a nine-element array specifying the transformation
7951 matrix. See emboss_matrix for an example.
7953 COLOR_ADJUST is a color adjustment added to each pixel of the
7957 x_detect_edges (f
, img
, matrix
, color_adjust
)
7960 int matrix
[9], color_adjust
;
7962 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7966 for (i
= sum
= 0; i
< 9; ++i
)
7967 sum
+= abs (matrix
[i
]);
7969 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7971 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
7973 for (y
= 0; y
< img
->height
; ++y
)
7975 p
= COLOR (new, 0, y
);
7976 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7977 p
= COLOR (new, img
->width
- 1, y
);
7978 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7981 for (x
= 1; x
< img
->width
- 1; ++x
)
7983 p
= COLOR (new, x
, 0);
7984 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7985 p
= COLOR (new, x
, img
->height
- 1);
7986 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7989 for (y
= 1; y
< img
->height
- 1; ++y
)
7991 p
= COLOR (new, 1, y
);
7993 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
7995 int r
, g
, b
, y1
, x1
;
7998 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
7999 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
8002 XColor
*t
= COLOR (colors
, x1
, y1
);
8003 r
+= matrix
[i
] * t
->red
;
8004 g
+= matrix
[i
] * t
->green
;
8005 b
+= matrix
[i
] * t
->blue
;
8008 r
= (r
/ sum
+ color_adjust
) & 0xffff;
8009 g
= (g
/ sum
+ color_adjust
) & 0xffff;
8010 b
= (b
/ sum
+ color_adjust
) & 0xffff;
8011 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
8016 x_from_xcolors (f
, img
, new);
8022 /* Perform the pre-defined `emboss' edge-detection on image IMG
8030 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
8034 /* Perform the pre-defined `laplace' edge-detection on image IMG
8042 x_detect_edges (f
, img
, laplace_matrix
, 45000);
8046 /* Perform edge-detection on image IMG on frame F, with specified
8047 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
8049 MATRIX must be either
8051 - a list of at least 9 numbers in row-major form
8052 - a vector of at least 9 numbers
8054 COLOR_ADJUST nil means use a default; otherwise it must be a
8058 x_edge_detection (f
, img
, matrix
, color_adjust
)
8061 Lisp_Object matrix
, color_adjust
;
8069 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
8070 ++i
, matrix
= XCDR (matrix
))
8071 trans
[i
] = XFLOATINT (XCAR (matrix
));
8073 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
8075 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
8076 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
8079 if (NILP (color_adjust
))
8080 color_adjust
= make_number (0xffff / 2);
8082 if (i
== 9 && NUMBERP (color_adjust
))
8083 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
8087 /* Transform image IMG on frame F so that it looks disabled. */
8090 x_disable_image (f
, img
)
8094 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
8096 if (dpyinfo
->n_planes
>= 2)
8098 /* Color (or grayscale). Convert to gray, and equalize. Just
8099 drawing such images with a stipple can look very odd, so
8100 we're using this method instead. */
8101 XColor
*colors
= x_to_xcolors (f
, img
, 1);
8103 const int h
= 15000;
8104 const int l
= 30000;
8106 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
8110 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
8111 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
8112 p
->red
= p
->green
= p
->blue
= i2
;
8115 x_from_xcolors (f
, img
, colors
);
8118 /* Draw a cross over the disabled image, if we must or if we
8120 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
8122 Display
*dpy
= FRAME_X_DISPLAY (f
);
8125 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
8126 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
8127 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
8128 img
->width
- 1, img
->height
- 1);
8129 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
8135 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
8136 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
8137 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
8138 img
->width
- 1, img
->height
- 1);
8139 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
8147 /* Build a mask for image IMG which is used on frame F. FILE is the
8148 name of an image file, for error messages. HOW determines how to
8149 determine the background color of IMG. If it is a list '(R G B)',
8150 with R, G, and B being integers >= 0, take that as the color of the
8151 background. Otherwise, determine the background color of IMG
8152 heuristically. Value is non-zero if successful. */
8155 x_build_heuristic_mask (f
, img
, how
)
8160 Display
*dpy
= FRAME_X_DISPLAY (f
);
8161 XImage
*ximg
, *mask_img
;
8162 int x
, y
, rc
, use_img_background
;
8163 unsigned long bg
= 0;
8167 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
8169 img
->background_transparent_valid
= 0;
8172 /* Create an image and pixmap serving as mask. */
8173 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
8174 &mask_img
, &img
->mask
);
8178 /* Get the X image of IMG->pixmap. */
8179 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
8182 /* Determine the background color of ximg. If HOW is `(R G B)'
8183 take that as color. Otherwise, use the image's background color. */
8184 use_img_background
= 1;
8190 for (i
= 0; i
< 3 && CONSP (how
) && NATNUMP (XCAR (how
)); ++i
)
8192 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
8196 if (i
== 3 && NILP (how
))
8198 char color_name
[30];
8199 XColor exact
, color
;
8202 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
8204 cmap
= FRAME_X_COLORMAP (f
);
8205 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
8208 use_img_background
= 0;
8213 if (use_img_background
)
8214 bg
= IMAGE_BACKGROUND (img
, f
, ximg
);
8216 /* Set all bits in mask_img to 1 whose color in ximg is different
8217 from the background color bg. */
8218 for (y
= 0; y
< img
->height
; ++y
)
8219 for (x
= 0; x
< img
->width
; ++x
)
8220 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
8222 /* Fill in the background_transparent field while we have the mask handy. */
8223 image_background_transparent (img
, f
, mask_img
);
8225 /* Put mask_img into img->mask. */
8226 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8227 x_destroy_x_image (mask_img
);
8228 XDestroyImage (ximg
);
8235 /***********************************************************************
8236 PBM (mono, gray, color)
8237 ***********************************************************************/
8239 static int pbm_image_p
P_ ((Lisp_Object object
));
8240 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
8241 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
8243 /* The symbol `pbm' identifying images of this type. */
8247 /* Indices of image specification fields in gs_format, below. */
8249 enum pbm_keyword_index
8265 /* Vector of image_keyword structures describing the format
8266 of valid user-defined image specifications. */
8268 static struct image_keyword pbm_format
[PBM_LAST
] =
8270 {":type", IMAGE_SYMBOL_VALUE
, 1},
8271 {":file", IMAGE_STRING_VALUE
, 0},
8272 {":data", IMAGE_STRING_VALUE
, 0},
8273 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8274 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8275 {":relief", IMAGE_INTEGER_VALUE
, 0},
8276 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8277 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8278 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8279 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
8280 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
8283 /* Structure describing the image type `pbm'. */
8285 static struct image_type pbm_type
=
8295 /* Return non-zero if OBJECT is a valid PBM image specification. */
8298 pbm_image_p (object
)
8301 struct image_keyword fmt
[PBM_LAST
];
8303 bcopy (pbm_format
, fmt
, sizeof fmt
);
8305 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
8308 /* Must specify either :data or :file. */
8309 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
8313 /* Scan a decimal number from *S and return it. Advance *S while
8314 reading the number. END is the end of the string. Value is -1 at
8318 pbm_scan_number (s
, end
)
8319 unsigned char **s
, *end
;
8321 int c
= 0, val
= -1;
8325 /* Skip white-space. */
8326 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8331 /* Skip comment to end of line. */
8332 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
8335 else if (isdigit (c
))
8337 /* Read decimal number. */
8339 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
8340 val
= 10 * val
+ c
- '0';
8351 /* Load PBM image IMG for use on frame F. */
8359 int width
, height
, max_color_idx
= 0;
8361 Lisp_Object file
, specified_file
;
8362 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8363 struct gcpro gcpro1
;
8364 unsigned char *contents
= NULL
;
8365 unsigned char *end
, *p
;
8368 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8372 if (STRINGP (specified_file
))
8374 file
= x_find_image_file (specified_file
);
8375 if (!STRINGP (file
))
8377 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8382 contents
= slurp_file (XSTRING (file
)->data
, &size
);
8383 if (contents
== NULL
)
8385 image_error ("Error reading `%s'", file
, Qnil
);
8391 end
= contents
+ size
;
8396 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8397 p
= XSTRING (data
)->data
;
8398 end
= p
+ STRING_BYTES (XSTRING (data
));
8401 /* Check magic number. */
8402 if (end
- p
< 2 || *p
++ != 'P')
8404 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8414 raw_p
= 0, type
= PBM_MONO
;
8418 raw_p
= 0, type
= PBM_GRAY
;
8422 raw_p
= 0, type
= PBM_COLOR
;
8426 raw_p
= 1, type
= PBM_MONO
;
8430 raw_p
= 1, type
= PBM_GRAY
;
8434 raw_p
= 1, type
= PBM_COLOR
;
8438 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8442 /* Read width, height, maximum color-component. Characters
8443 starting with `#' up to the end of a line are ignored. */
8444 width
= pbm_scan_number (&p
, end
);
8445 height
= pbm_scan_number (&p
, end
);
8447 if (type
!= PBM_MONO
)
8449 max_color_idx
= pbm_scan_number (&p
, end
);
8450 if (raw_p
&& max_color_idx
> 255)
8451 max_color_idx
= 255;
8456 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8459 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8460 &ximg
, &img
->pixmap
))
8463 /* Initialize the color hash table. */
8464 init_color_table ();
8466 if (type
== PBM_MONO
)
8469 struct image_keyword fmt
[PBM_LAST
];
8470 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8471 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8473 /* Parse the image specification. */
8474 bcopy (pbm_format
, fmt
, sizeof fmt
);
8475 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8477 /* Get foreground and background colors, maybe allocate colors. */
8478 if (fmt
[PBM_FOREGROUND
].count
8479 && STRINGP (fmt
[PBM_FOREGROUND
].value
))
8480 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8481 if (fmt
[PBM_BACKGROUND
].count
8482 && STRINGP (fmt
[PBM_BACKGROUND
].value
))
8484 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8485 img
->background
= bg
;
8486 img
->background_valid
= 1;
8489 for (y
= 0; y
< height
; ++y
)
8490 for (x
= 0; x
< width
; ++x
)
8500 g
= pbm_scan_number (&p
, end
);
8502 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8507 for (y
= 0; y
< height
; ++y
)
8508 for (x
= 0; x
< width
; ++x
)
8512 if (type
== PBM_GRAY
)
8513 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8522 r
= pbm_scan_number (&p
, end
);
8523 g
= pbm_scan_number (&p
, end
);
8524 b
= pbm_scan_number (&p
, end
);
8527 if (r
< 0 || g
< 0 || b
< 0)
8531 XDestroyImage (ximg
);
8532 image_error ("Invalid pixel value in image `%s'",
8537 /* RGB values are now in the range 0..max_color_idx.
8538 Scale this to the range 0..0xffff supported by X. */
8539 r
= (double) r
* 65535 / max_color_idx
;
8540 g
= (double) g
* 65535 / max_color_idx
;
8541 b
= (double) b
* 65535 / max_color_idx
;
8542 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8546 /* Store in IMG->colors the colors allocated for the image, and
8547 free the color table. */
8548 img
->colors
= colors_in_color_table (&img
->ncolors
);
8549 free_color_table ();
8551 /* Maybe fill in the background field while we have ximg handy. */
8552 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
8553 IMAGE_BACKGROUND (img
, f
, ximg
);
8555 /* Put the image into a pixmap. */
8556 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8557 x_destroy_x_image (ximg
);
8560 img
->height
= height
;
8569 /***********************************************************************
8571 ***********************************************************************/
8577 /* Function prototypes. */
8579 static int png_image_p
P_ ((Lisp_Object object
));
8580 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8582 /* The symbol `png' identifying images of this type. */
8586 /* Indices of image specification fields in png_format, below. */
8588 enum png_keyword_index
8603 /* Vector of image_keyword structures describing the format
8604 of valid user-defined image specifications. */
8606 static struct image_keyword png_format
[PNG_LAST
] =
8608 {":type", IMAGE_SYMBOL_VALUE
, 1},
8609 {":data", IMAGE_STRING_VALUE
, 0},
8610 {":file", IMAGE_STRING_VALUE
, 0},
8611 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8612 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8613 {":relief", IMAGE_INTEGER_VALUE
, 0},
8614 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8615 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8616 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8617 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
8620 /* Structure describing the image type `png'. */
8622 static struct image_type png_type
=
8632 /* Return non-zero if OBJECT is a valid PNG image specification. */
8635 png_image_p (object
)
8638 struct image_keyword fmt
[PNG_LAST
];
8639 bcopy (png_format
, fmt
, sizeof fmt
);
8641 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8644 /* Must specify either the :data or :file keyword. */
8645 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8649 /* Error and warning handlers installed when the PNG library
8653 my_png_error (png_ptr
, msg
)
8654 png_struct
*png_ptr
;
8657 xassert (png_ptr
!= NULL
);
8658 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8659 longjmp (png_ptr
->jmpbuf
, 1);
8664 my_png_warning (png_ptr
, msg
)
8665 png_struct
*png_ptr
;
8668 xassert (png_ptr
!= NULL
);
8669 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8672 /* Memory source for PNG decoding. */
8674 struct png_memory_storage
8676 unsigned char *bytes
; /* The data */
8677 size_t len
; /* How big is it? */
8678 int index
; /* Where are we? */
8682 /* Function set as reader function when reading PNG image from memory.
8683 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8684 bytes from the input to DATA. */
8687 png_read_from_memory (png_ptr
, data
, length
)
8688 png_structp png_ptr
;
8692 struct png_memory_storage
*tbr
8693 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8695 if (length
> tbr
->len
- tbr
->index
)
8696 png_error (png_ptr
, "Read error");
8698 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8699 tbr
->index
= tbr
->index
+ length
;
8702 /* Load PNG image IMG for use on frame F. Value is non-zero if
8710 Lisp_Object file
, specified_file
;
8711 Lisp_Object specified_data
;
8713 XImage
*ximg
, *mask_img
= NULL
;
8714 struct gcpro gcpro1
;
8715 png_struct
*png_ptr
= NULL
;
8716 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8717 FILE *volatile fp
= NULL
;
8719 png_byte
* volatile pixels
= NULL
;
8720 png_byte
** volatile rows
= NULL
;
8721 png_uint_32 width
, height
;
8722 int bit_depth
, color_type
, interlace_type
;
8724 png_uint_32 row_bytes
;
8727 double screen_gamma
, image_gamma
;
8729 struct png_memory_storage tbr
; /* Data to be read */
8731 /* Find out what file to load. */
8732 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8733 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8737 if (NILP (specified_data
))
8739 file
= x_find_image_file (specified_file
);
8740 if (!STRINGP (file
))
8742 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8747 /* Open the image file. */
8748 fp
= fopen (XSTRING (file
)->data
, "rb");
8751 image_error ("Cannot open image file `%s'", file
, Qnil
);
8757 /* Check PNG signature. */
8758 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8759 || !png_check_sig (sig
, sizeof sig
))
8761 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8769 /* Read from memory. */
8770 tbr
.bytes
= XSTRING (specified_data
)->data
;
8771 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8774 /* Check PNG signature. */
8775 if (tbr
.len
< sizeof sig
8776 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8778 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8783 /* Need to skip past the signature. */
8784 tbr
.bytes
+= sizeof (sig
);
8787 /* Initialize read and info structs for PNG lib. */
8788 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8789 my_png_error
, my_png_warning
);
8792 if (fp
) fclose (fp
);
8797 info_ptr
= png_create_info_struct (png_ptr
);
8800 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8801 if (fp
) fclose (fp
);
8806 end_info
= png_create_info_struct (png_ptr
);
8809 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8810 if (fp
) fclose (fp
);
8815 /* Set error jump-back. We come back here when the PNG library
8816 detects an error. */
8817 if (setjmp (png_ptr
->jmpbuf
))
8821 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8824 if (fp
) fclose (fp
);
8829 /* Read image info. */
8830 if (!NILP (specified_data
))
8831 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8833 png_init_io (png_ptr
, fp
);
8835 png_set_sig_bytes (png_ptr
, sizeof sig
);
8836 png_read_info (png_ptr
, info_ptr
);
8837 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8838 &interlace_type
, NULL
, NULL
);
8840 /* If image contains simply transparency data, we prefer to
8841 construct a clipping mask. */
8842 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8847 /* This function is easier to write if we only have to handle
8848 one data format: RGB or RGBA with 8 bits per channel. Let's
8849 transform other formats into that format. */
8851 /* Strip more than 8 bits per channel. */
8852 if (bit_depth
== 16)
8853 png_set_strip_16 (png_ptr
);
8855 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8857 png_set_expand (png_ptr
);
8859 /* Convert grayscale images to RGB. */
8860 if (color_type
== PNG_COLOR_TYPE_GRAY
8861 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8862 png_set_gray_to_rgb (png_ptr
);
8864 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8865 gamma_str
= getenv ("SCREEN_GAMMA");
8866 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8868 /* Tell the PNG lib to handle gamma correction for us. */
8870 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8871 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8872 /* There is a special chunk in the image specifying the gamma. */
8873 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8876 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8877 /* Image contains gamma information. */
8878 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8880 /* Use a default of 0.5 for the image gamma. */
8881 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8883 /* Handle alpha channel by combining the image with a background
8884 color. Do this only if a real alpha channel is supplied. For
8885 simple transparency, we prefer a clipping mask. */
8888 png_color_16
*image_bg
;
8889 Lisp_Object specified_bg
8890 = image_spec_value (img
->spec
, QCbackground
, NULL
);
8892 if (STRINGP (specified_bg
))
8893 /* The user specified `:background', use that. */
8896 if (x_defined_color (f
, XSTRING (specified_bg
)->data
, &color
, 0))
8898 png_color_16 user_bg
;
8900 bzero (&user_bg
, sizeof user_bg
);
8901 user_bg
.red
= color
.red
;
8902 user_bg
.green
= color
.green
;
8903 user_bg
.blue
= color
.blue
;
8905 png_set_background (png_ptr
, &user_bg
,
8906 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8909 else if (png_get_bKGD (png_ptr
, info_ptr
, &image_bg
))
8910 /* Image contains a background color with which to
8911 combine the image. */
8912 png_set_background (png_ptr
, image_bg
,
8913 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8916 /* Image does not contain a background color with which
8917 to combine the image data via an alpha channel. Use
8918 the frame's background instead. */
8921 png_color_16 frame_background
;
8923 cmap
= FRAME_X_COLORMAP (f
);
8924 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8925 x_query_color (f
, &color
);
8927 bzero (&frame_background
, sizeof frame_background
);
8928 frame_background
.red
= color
.red
;
8929 frame_background
.green
= color
.green
;
8930 frame_background
.blue
= color
.blue
;
8932 png_set_background (png_ptr
, &frame_background
,
8933 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8937 /* Update info structure. */
8938 png_read_update_info (png_ptr
, info_ptr
);
8940 /* Get number of channels. Valid values are 1 for grayscale images
8941 and images with a palette, 2 for grayscale images with transparency
8942 information (alpha channel), 3 for RGB images, and 4 for RGB
8943 images with alpha channel, i.e. RGBA. If conversions above were
8944 sufficient we should only have 3 or 4 channels here. */
8945 channels
= png_get_channels (png_ptr
, info_ptr
);
8946 xassert (channels
== 3 || channels
== 4);
8948 /* Number of bytes needed for one row of the image. */
8949 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8951 /* Allocate memory for the image. */
8952 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8953 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8954 for (i
= 0; i
< height
; ++i
)
8955 rows
[i
] = pixels
+ i
* row_bytes
;
8957 /* Read the entire image. */
8958 png_read_image (png_ptr
, rows
);
8959 png_read_end (png_ptr
, info_ptr
);
8966 /* Create the X image and pixmap. */
8967 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8971 /* Create an image and pixmap serving as mask if the PNG image
8972 contains an alpha channel. */
8975 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8976 &mask_img
, &img
->mask
))
8978 x_destroy_x_image (ximg
);
8979 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8984 /* Fill the X image and mask from PNG data. */
8985 init_color_table ();
8987 for (y
= 0; y
< height
; ++y
)
8989 png_byte
*p
= rows
[y
];
8991 for (x
= 0; x
< width
; ++x
)
8998 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
9000 /* An alpha channel, aka mask channel, associates variable
9001 transparency with an image. Where other image formats
9002 support binary transparency---fully transparent or fully
9003 opaque---PNG allows up to 254 levels of partial transparency.
9004 The PNG library implements partial transparency by combining
9005 the image with a specified background color.
9007 I'm not sure how to handle this here nicely: because the
9008 background on which the image is displayed may change, for
9009 real alpha channel support, it would be necessary to create
9010 a new image for each possible background.
9012 What I'm doing now is that a mask is created if we have
9013 boolean transparency information. Otherwise I'm using
9014 the frame's background color to combine the image with. */
9019 XPutPixel (mask_img
, x
, y
, *p
> 0);
9025 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
9026 /* Set IMG's background color from the PNG image, unless the user
9030 if (png_get_bKGD (png_ptr
, info_ptr
, &bg
))
9032 img
->background
= lookup_rgb_color (f
, bg
->red
, bg
->green
, bg
->blue
);
9033 img
->background_valid
= 1;
9037 /* Remember colors allocated for this image. */
9038 img
->colors
= colors_in_color_table (&img
->ncolors
);
9039 free_color_table ();
9042 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
9047 img
->height
= height
;
9049 /* Maybe fill in the background field while we have ximg handy. */
9050 IMAGE_BACKGROUND (img
, f
, ximg
);
9052 /* Put the image into the pixmap, then free the X image and its buffer. */
9053 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9054 x_destroy_x_image (ximg
);
9056 /* Same for the mask. */
9059 /* Fill in the background_transparent field while we have the mask
9061 image_background_transparent (img
, f
, mask_img
);
9063 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
9064 x_destroy_x_image (mask_img
);
9071 #endif /* HAVE_PNG != 0 */
9075 /***********************************************************************
9077 ***********************************************************************/
9081 /* Work around a warning about HAVE_STDLIB_H being redefined in
9083 #ifdef HAVE_STDLIB_H
9084 #define HAVE_STDLIB_H_1
9085 #undef HAVE_STDLIB_H
9086 #endif /* HAVE_STLIB_H */
9088 #include <jpeglib.h>
9092 #ifdef HAVE_STLIB_H_1
9093 #define HAVE_STDLIB_H 1
9096 static int jpeg_image_p
P_ ((Lisp_Object object
));
9097 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
9099 /* The symbol `jpeg' identifying images of this type. */
9103 /* Indices of image specification fields in gs_format, below. */
9105 enum jpeg_keyword_index
9114 JPEG_HEURISTIC_MASK
,
9120 /* Vector of image_keyword structures describing the format
9121 of valid user-defined image specifications. */
9123 static struct image_keyword jpeg_format
[JPEG_LAST
] =
9125 {":type", IMAGE_SYMBOL_VALUE
, 1},
9126 {":data", IMAGE_STRING_VALUE
, 0},
9127 {":file", IMAGE_STRING_VALUE
, 0},
9128 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9129 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9130 {":relief", IMAGE_INTEGER_VALUE
, 0},
9131 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9132 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9133 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9134 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9137 /* Structure describing the image type `jpeg'. */
9139 static struct image_type jpeg_type
=
9149 /* Return non-zero if OBJECT is a valid JPEG image specification. */
9152 jpeg_image_p (object
)
9155 struct image_keyword fmt
[JPEG_LAST
];
9157 bcopy (jpeg_format
, fmt
, sizeof fmt
);
9159 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
9162 /* Must specify either the :data or :file keyword. */
9163 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
9167 struct my_jpeg_error_mgr
9169 struct jpeg_error_mgr pub
;
9170 jmp_buf setjmp_buffer
;
9175 my_error_exit (cinfo
)
9178 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
9179 longjmp (mgr
->setjmp_buffer
, 1);
9183 /* Init source method for JPEG data source manager. Called by
9184 jpeg_read_header() before any data is actually read. See
9185 libjpeg.doc from the JPEG lib distribution. */
9188 our_init_source (cinfo
)
9189 j_decompress_ptr cinfo
;
9194 /* Fill input buffer method for JPEG data source manager. Called
9195 whenever more data is needed. We read the whole image in one step,
9196 so this only adds a fake end of input marker at the end. */
9199 our_fill_input_buffer (cinfo
)
9200 j_decompress_ptr cinfo
;
9202 /* Insert a fake EOI marker. */
9203 struct jpeg_source_mgr
*src
= cinfo
->src
;
9204 static JOCTET buffer
[2];
9206 buffer
[0] = (JOCTET
) 0xFF;
9207 buffer
[1] = (JOCTET
) JPEG_EOI
;
9209 src
->next_input_byte
= buffer
;
9210 src
->bytes_in_buffer
= 2;
9215 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
9216 is the JPEG data source manager. */
9219 our_skip_input_data (cinfo
, num_bytes
)
9220 j_decompress_ptr cinfo
;
9223 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9227 if (num_bytes
> src
->bytes_in_buffer
)
9228 ERREXIT (cinfo
, JERR_INPUT_EOF
);
9230 src
->bytes_in_buffer
-= num_bytes
;
9231 src
->next_input_byte
+= num_bytes
;
9236 /* Method to terminate data source. Called by
9237 jpeg_finish_decompress() after all data has been processed. */
9240 our_term_source (cinfo
)
9241 j_decompress_ptr cinfo
;
9246 /* Set up the JPEG lib for reading an image from DATA which contains
9247 LEN bytes. CINFO is the decompression info structure created for
9248 reading the image. */
9251 jpeg_memory_src (cinfo
, data
, len
)
9252 j_decompress_ptr cinfo
;
9256 struct jpeg_source_mgr
*src
;
9258 if (cinfo
->src
== NULL
)
9260 /* First time for this JPEG object? */
9261 cinfo
->src
= (struct jpeg_source_mgr
*)
9262 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
9263 sizeof (struct jpeg_source_mgr
));
9264 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9265 src
->next_input_byte
= data
;
9268 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9269 src
->init_source
= our_init_source
;
9270 src
->fill_input_buffer
= our_fill_input_buffer
;
9271 src
->skip_input_data
= our_skip_input_data
;
9272 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
9273 src
->term_source
= our_term_source
;
9274 src
->bytes_in_buffer
= len
;
9275 src
->next_input_byte
= data
;
9279 /* Load image IMG for use on frame F. Patterned after example.c
9280 from the JPEG lib. */
9287 struct jpeg_decompress_struct cinfo
;
9288 struct my_jpeg_error_mgr mgr
;
9289 Lisp_Object file
, specified_file
;
9290 Lisp_Object specified_data
;
9291 FILE * volatile fp
= NULL
;
9293 int row_stride
, x
, y
;
9294 XImage
*ximg
= NULL
;
9296 unsigned long *colors
;
9298 struct gcpro gcpro1
;
9300 /* Open the JPEG file. */
9301 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9302 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9306 if (NILP (specified_data
))
9308 file
= x_find_image_file (specified_file
);
9309 if (!STRINGP (file
))
9311 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9316 fp
= fopen (XSTRING (file
)->data
, "r");
9319 image_error ("Cannot open `%s'", file
, Qnil
);
9325 /* Customize libjpeg's error handling to call my_error_exit when an
9326 error is detected. This function will perform a longjmp. */
9327 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
9328 mgr
.pub
.error_exit
= my_error_exit
;
9330 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
9334 /* Called from my_error_exit. Display a JPEG error. */
9335 char buffer
[JMSG_LENGTH_MAX
];
9336 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
9337 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
9338 build_string (buffer
));
9341 /* Close the input file and destroy the JPEG object. */
9343 fclose ((FILE *) fp
);
9344 jpeg_destroy_decompress (&cinfo
);
9346 /* If we already have an XImage, free that. */
9347 x_destroy_x_image (ximg
);
9349 /* Free pixmap and colors. */
9350 x_clear_image (f
, img
);
9356 /* Create the JPEG decompression object. Let it read from fp.
9357 Read the JPEG image header. */
9358 jpeg_create_decompress (&cinfo
);
9360 if (NILP (specified_data
))
9361 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
9363 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
9364 STRING_BYTES (XSTRING (specified_data
)));
9366 jpeg_read_header (&cinfo
, TRUE
);
9368 /* Customize decompression so that color quantization will be used.
9369 Start decompression. */
9370 cinfo
.quantize_colors
= TRUE
;
9371 jpeg_start_decompress (&cinfo
);
9372 width
= img
->width
= cinfo
.output_width
;
9373 height
= img
->height
= cinfo
.output_height
;
9375 /* Create X image and pixmap. */
9376 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9377 longjmp (mgr
.setjmp_buffer
, 2);
9379 /* Allocate colors. When color quantization is used,
9380 cinfo.actual_number_of_colors has been set with the number of
9381 colors generated, and cinfo.colormap is a two-dimensional array
9382 of color indices in the range 0..cinfo.actual_number_of_colors.
9383 No more than 255 colors will be generated. */
9387 if (cinfo
.out_color_components
> 2)
9388 ir
= 0, ig
= 1, ib
= 2;
9389 else if (cinfo
.out_color_components
> 1)
9390 ir
= 0, ig
= 1, ib
= 0;
9392 ir
= 0, ig
= 0, ib
= 0;
9394 /* Use the color table mechanism because it handles colors that
9395 cannot be allocated nicely. Such colors will be replaced with
9396 a default color, and we don't have to care about which colors
9397 can be freed safely, and which can't. */
9398 init_color_table ();
9399 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9402 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9404 /* Multiply RGB values with 255 because X expects RGB values
9405 in the range 0..0xffff. */
9406 int r
= cinfo
.colormap
[ir
][i
] << 8;
9407 int g
= cinfo
.colormap
[ig
][i
] << 8;
9408 int b
= cinfo
.colormap
[ib
][i
] << 8;
9409 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9412 /* Remember those colors actually allocated. */
9413 img
->colors
= colors_in_color_table (&img
->ncolors
);
9414 free_color_table ();
9418 row_stride
= width
* cinfo
.output_components
;
9419 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9421 for (y
= 0; y
< height
; ++y
)
9423 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9424 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9425 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9429 jpeg_finish_decompress (&cinfo
);
9430 jpeg_destroy_decompress (&cinfo
);
9432 fclose ((FILE *) fp
);
9434 /* Maybe fill in the background field while we have ximg handy. */
9435 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
9436 IMAGE_BACKGROUND (img
, f
, ximg
);
9438 /* Put the image into the pixmap. */
9439 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9440 x_destroy_x_image (ximg
);
9445 #endif /* HAVE_JPEG */
9449 /***********************************************************************
9451 ***********************************************************************/
9457 static int tiff_image_p
P_ ((Lisp_Object object
));
9458 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9460 /* The symbol `tiff' identifying images of this type. */
9464 /* Indices of image specification fields in tiff_format, below. */
9466 enum tiff_keyword_index
9475 TIFF_HEURISTIC_MASK
,
9481 /* Vector of image_keyword structures describing the format
9482 of valid user-defined image specifications. */
9484 static struct image_keyword tiff_format
[TIFF_LAST
] =
9486 {":type", IMAGE_SYMBOL_VALUE
, 1},
9487 {":data", IMAGE_STRING_VALUE
, 0},
9488 {":file", IMAGE_STRING_VALUE
, 0},
9489 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9490 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9491 {":relief", IMAGE_INTEGER_VALUE
, 0},
9492 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9493 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9494 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9495 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9498 /* Structure describing the image type `tiff'. */
9500 static struct image_type tiff_type
=
9510 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9513 tiff_image_p (object
)
9516 struct image_keyword fmt
[TIFF_LAST
];
9517 bcopy (tiff_format
, fmt
, sizeof fmt
);
9519 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9522 /* Must specify either the :data or :file keyword. */
9523 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9527 /* Reading from a memory buffer for TIFF images Based on the PNG
9528 memory source, but we have to provide a lot of extra functions.
9531 We really only need to implement read and seek, but I am not
9532 convinced that the TIFF library is smart enough not to destroy
9533 itself if we only hand it the function pointers we need to
9538 unsigned char *bytes
;
9546 tiff_read_from_memory (data
, buf
, size
)
9551 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9553 if (size
> src
->len
- src
->index
)
9555 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9562 tiff_write_from_memory (data
, buf
, size
)
9572 tiff_seek_in_memory (data
, off
, whence
)
9577 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9582 case SEEK_SET
: /* Go from beginning of source. */
9586 case SEEK_END
: /* Go from end of source. */
9587 idx
= src
->len
+ off
;
9590 case SEEK_CUR
: /* Go from current position. */
9591 idx
= src
->index
+ off
;
9594 default: /* Invalid `whence'. */
9598 if (idx
> src
->len
|| idx
< 0)
9607 tiff_close_memory (data
)
9616 tiff_mmap_memory (data
, pbase
, psize
)
9621 /* It is already _IN_ memory. */
9627 tiff_unmap_memory (data
, base
, size
)
9632 /* We don't need to do this. */
9637 tiff_size_of_memory (data
)
9640 return ((tiff_memory_source
*) data
)->len
;
9645 tiff_error_handler (title
, format
, ap
)
9646 const char *title
, *format
;
9652 len
= sprintf (buf
, "TIFF error: %s ", title
);
9653 vsprintf (buf
+ len
, format
, ap
);
9654 add_to_log (buf
, Qnil
, Qnil
);
9659 tiff_warning_handler (title
, format
, ap
)
9660 const char *title
, *format
;
9666 len
= sprintf (buf
, "TIFF warning: %s ", title
);
9667 vsprintf (buf
+ len
, format
, ap
);
9668 add_to_log (buf
, Qnil
, Qnil
);
9672 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9680 Lisp_Object file
, specified_file
;
9681 Lisp_Object specified_data
;
9683 int width
, height
, x
, y
;
9687 struct gcpro gcpro1
;
9688 tiff_memory_source memsrc
;
9690 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9691 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9695 TIFFSetErrorHandler (tiff_error_handler
);
9696 TIFFSetWarningHandler (tiff_warning_handler
);
9698 if (NILP (specified_data
))
9700 /* Read from a file */
9701 file
= x_find_image_file (specified_file
);
9702 if (!STRINGP (file
))
9704 image_error ("Cannot find image file `%s'", file
, Qnil
);
9709 /* Try to open the image file. */
9710 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9713 image_error ("Cannot open `%s'", file
, Qnil
);
9720 /* Memory source! */
9721 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9722 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9725 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9726 (TIFFReadWriteProc
) tiff_read_from_memory
,
9727 (TIFFReadWriteProc
) tiff_write_from_memory
,
9728 tiff_seek_in_memory
,
9730 tiff_size_of_memory
,
9736 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9742 /* Get width and height of the image, and allocate a raster buffer
9743 of width x height 32-bit values. */
9744 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9745 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9746 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9748 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9752 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9758 /* Create the X image and pixmap. */
9759 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9766 /* Initialize the color table. */
9767 init_color_table ();
9769 /* Process the pixel raster. Origin is in the lower-left corner. */
9770 for (y
= 0; y
< height
; ++y
)
9772 uint32
*row
= buf
+ y
* width
;
9774 for (x
= 0; x
< width
; ++x
)
9776 uint32 abgr
= row
[x
];
9777 int r
= TIFFGetR (abgr
) << 8;
9778 int g
= TIFFGetG (abgr
) << 8;
9779 int b
= TIFFGetB (abgr
) << 8;
9780 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9784 /* Remember the colors allocated for the image. Free the color table. */
9785 img
->colors
= colors_in_color_table (&img
->ncolors
);
9786 free_color_table ();
9789 img
->height
= height
;
9791 /* Maybe fill in the background field while we have ximg handy. */
9792 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
9793 IMAGE_BACKGROUND (img
, f
, ximg
);
9795 /* Put the image into the pixmap, then free the X image and its buffer. */
9796 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9797 x_destroy_x_image (ximg
);
9804 #endif /* HAVE_TIFF != 0 */
9808 /***********************************************************************
9810 ***********************************************************************/
9814 #include <gif_lib.h>
9816 static int gif_image_p
P_ ((Lisp_Object object
));
9817 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9819 /* The symbol `gif' identifying images of this type. */
9823 /* Indices of image specification fields in gif_format, below. */
9825 enum gif_keyword_index
9841 /* Vector of image_keyword structures describing the format
9842 of valid user-defined image specifications. */
9844 static struct image_keyword gif_format
[GIF_LAST
] =
9846 {":type", IMAGE_SYMBOL_VALUE
, 1},
9847 {":data", IMAGE_STRING_VALUE
, 0},
9848 {":file", IMAGE_STRING_VALUE
, 0},
9849 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9850 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9851 {":relief", IMAGE_INTEGER_VALUE
, 0},
9852 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9853 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9854 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9855 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9856 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9859 /* Structure describing the image type `gif'. */
9861 static struct image_type gif_type
=
9871 /* Return non-zero if OBJECT is a valid GIF image specification. */
9874 gif_image_p (object
)
9877 struct image_keyword fmt
[GIF_LAST
];
9878 bcopy (gif_format
, fmt
, sizeof fmt
);
9880 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
9883 /* Must specify either the :data or :file keyword. */
9884 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9888 /* Reading a GIF image from memory
9889 Based on the PNG memory stuff to a certain extent. */
9893 unsigned char *bytes
;
9900 /* Make the current memory source available to gif_read_from_memory.
9901 It's done this way because not all versions of libungif support
9902 a UserData field in the GifFileType structure. */
9903 static gif_memory_source
*current_gif_memory_src
;
9906 gif_read_from_memory (file
, buf
, len
)
9911 gif_memory_source
*src
= current_gif_memory_src
;
9913 if (len
> src
->len
- src
->index
)
9916 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9922 /* Load GIF image IMG for use on frame F. Value is non-zero if
9930 Lisp_Object file
, specified_file
;
9931 Lisp_Object specified_data
;
9932 int rc
, width
, height
, x
, y
, i
;
9934 ColorMapObject
*gif_color_map
;
9935 unsigned long pixel_colors
[256];
9937 struct gcpro gcpro1
;
9939 int ino
, image_left
, image_top
, image_width
, image_height
;
9940 gif_memory_source memsrc
;
9941 unsigned char *raster
;
9943 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9944 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9948 if (NILP (specified_data
))
9950 file
= x_find_image_file (specified_file
);
9951 if (!STRINGP (file
))
9953 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9958 /* Open the GIF file. */
9959 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9962 image_error ("Cannot open `%s'", file
, Qnil
);
9969 /* Read from memory! */
9970 current_gif_memory_src
= &memsrc
;
9971 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9972 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9975 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9978 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9984 /* Read entire contents. */
9985 rc
= DGifSlurp (gif
);
9986 if (rc
== GIF_ERROR
)
9988 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9989 DGifCloseFile (gif
);
9994 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9995 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9996 if (ino
>= gif
->ImageCount
)
9998 image_error ("Invalid image number `%s' in image `%s'",
10000 DGifCloseFile (gif
);
10005 width
= img
->width
= gif
->SWidth
;
10006 height
= img
->height
= gif
->SHeight
;
10008 /* Create the X image and pixmap. */
10009 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
10011 DGifCloseFile (gif
);
10016 /* Allocate colors. */
10017 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
10018 if (!gif_color_map
)
10019 gif_color_map
= gif
->SColorMap
;
10020 init_color_table ();
10021 bzero (pixel_colors
, sizeof pixel_colors
);
10023 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
10025 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
10026 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
10027 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
10028 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
10031 img
->colors
= colors_in_color_table (&img
->ncolors
);
10032 free_color_table ();
10034 /* Clear the part of the screen image that are not covered by
10035 the image from the GIF file. Full animated GIF support
10036 requires more than can be done here (see the gif89 spec,
10037 disposal methods). Let's simply assume that the part
10038 not covered by a sub-image is in the frame's background color. */
10039 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
10040 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
10041 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
10042 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
10044 for (y
= 0; y
< image_top
; ++y
)
10045 for (x
= 0; x
< width
; ++x
)
10046 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10048 for (y
= image_top
+ image_height
; y
< height
; ++y
)
10049 for (x
= 0; x
< width
; ++x
)
10050 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10052 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
10054 for (x
= 0; x
< image_left
; ++x
)
10055 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10056 for (x
= image_left
+ image_width
; x
< width
; ++x
)
10057 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10060 /* Read the GIF image into the X image. We use a local variable
10061 `raster' here because RasterBits below is a char *, and invites
10062 problems with bytes >= 0x80. */
10063 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
10065 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
10067 static int interlace_start
[] = {0, 4, 2, 1};
10068 static int interlace_increment
[] = {8, 8, 4, 2};
10070 int row
= interlace_start
[0];
10074 for (y
= 0; y
< image_height
; y
++)
10076 if (row
>= image_height
)
10078 row
= interlace_start
[++pass
];
10079 while (row
>= image_height
)
10080 row
= interlace_start
[++pass
];
10083 for (x
= 0; x
< image_width
; x
++)
10085 int i
= raster
[(y
* image_width
) + x
];
10086 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
10090 row
+= interlace_increment
[pass
];
10095 for (y
= 0; y
< image_height
; ++y
)
10096 for (x
= 0; x
< image_width
; ++x
)
10098 int i
= raster
[y
* image_width
+ x
];
10099 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
10103 DGifCloseFile (gif
);
10105 /* Maybe fill in the background field while we have ximg handy. */
10106 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
10107 IMAGE_BACKGROUND (img
, f
, ximg
);
10109 /* Put the image into the pixmap, then free the X image and its buffer. */
10110 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
10111 x_destroy_x_image (ximg
);
10117 #endif /* HAVE_GIF != 0 */
10121 /***********************************************************************
10123 ***********************************************************************/
10125 static int gs_image_p
P_ ((Lisp_Object object
));
10126 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
10127 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
10129 /* The symbol `postscript' identifying images of this type. */
10131 Lisp_Object Qpostscript
;
10133 /* Keyword symbols. */
10135 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
10137 /* Indices of image specification fields in gs_format, below. */
10139 enum gs_keyword_index
10157 /* Vector of image_keyword structures describing the format
10158 of valid user-defined image specifications. */
10160 static struct image_keyword gs_format
[GS_LAST
] =
10162 {":type", IMAGE_SYMBOL_VALUE
, 1},
10163 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
10164 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
10165 {":file", IMAGE_STRING_VALUE
, 1},
10166 {":loader", IMAGE_FUNCTION_VALUE
, 0},
10167 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
10168 {":ascent", IMAGE_ASCENT_VALUE
, 0},
10169 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10170 {":relief", IMAGE_INTEGER_VALUE
, 0},
10171 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10172 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10173 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10174 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10177 /* Structure describing the image type `ghostscript'. */
10179 static struct image_type gs_type
=
10189 /* Free X resources of Ghostscript image IMG which is used on frame F. */
10192 gs_clear_image (f
, img
)
10196 /* IMG->data.ptr_val may contain a recorded colormap. */
10197 xfree (img
->data
.ptr_val
);
10198 x_clear_image (f
, img
);
10202 /* Return non-zero if OBJECT is a valid Ghostscript image
10206 gs_image_p (object
)
10207 Lisp_Object object
;
10209 struct image_keyword fmt
[GS_LAST
];
10213 bcopy (gs_format
, fmt
, sizeof fmt
);
10215 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
10218 /* Bounding box must be a list or vector containing 4 integers. */
10219 tem
= fmt
[GS_BOUNDING_BOX
].value
;
10222 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
10223 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
10228 else if (VECTORP (tem
))
10230 if (XVECTOR (tem
)->size
!= 4)
10232 for (i
= 0; i
< 4; ++i
)
10233 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
10243 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
10252 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
10253 struct gcpro gcpro1
, gcpro2
;
10255 double in_width
, in_height
;
10256 Lisp_Object pixel_colors
= Qnil
;
10258 /* Compute pixel size of pixmap needed from the given size in the
10259 image specification. Sizes in the specification are in pt. 1 pt
10260 = 1/72 in, xdpi and ydpi are stored in the frame's X display
10262 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
10263 in_width
= XFASTINT (pt_width
) / 72.0;
10264 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
10265 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
10266 in_height
= XFASTINT (pt_height
) / 72.0;
10267 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
10269 /* Create the pixmap. */
10270 xassert (img
->pixmap
== None
);
10271 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10272 img
->width
, img
->height
,
10273 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
10277 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
10281 /* Call the loader to fill the pixmap. It returns a process object
10282 if successful. We do not record_unwind_protect here because
10283 other places in redisplay like calling window scroll functions
10284 don't either. Let the Lisp loader use `unwind-protect' instead. */
10285 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
10287 sprintf (buffer
, "%lu %lu",
10288 (unsigned long) FRAME_X_WINDOW (f
),
10289 (unsigned long) img
->pixmap
);
10290 window_and_pixmap_id
= build_string (buffer
);
10292 sprintf (buffer
, "%lu %lu",
10293 FRAME_FOREGROUND_PIXEL (f
),
10294 FRAME_BACKGROUND_PIXEL (f
));
10295 pixel_colors
= build_string (buffer
);
10297 XSETFRAME (frame
, f
);
10298 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
10300 loader
= intern ("gs-load-image");
10302 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
10303 make_number (img
->width
),
10304 make_number (img
->height
),
10305 window_and_pixmap_id
,
10308 return PROCESSP (img
->data
.lisp_val
);
10312 /* Kill the Ghostscript process that was started to fill PIXMAP on
10313 frame F. Called from XTread_socket when receiving an event
10314 telling Emacs that Ghostscript has finished drawing. */
10317 x_kill_gs_process (pixmap
, f
)
10321 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
10325 /* Find the image containing PIXMAP. */
10326 for (i
= 0; i
< c
->used
; ++i
)
10327 if (c
->images
[i
]->pixmap
== pixmap
)
10330 /* Should someone in between have cleared the image cache, for
10331 instance, give up. */
10335 /* Kill the GS process. We should have found PIXMAP in the image
10336 cache and its image should contain a process object. */
10337 img
= c
->images
[i
];
10338 xassert (PROCESSP (img
->data
.lisp_val
));
10339 Fkill_process (img
->data
.lisp_val
, Qnil
);
10340 img
->data
.lisp_val
= Qnil
;
10342 /* On displays with a mutable colormap, figure out the colors
10343 allocated for the image by looking at the pixels of an XImage for
10345 class = FRAME_X_VISUAL (f
)->class;
10346 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
10352 /* Try to get an XImage for img->pixmep. */
10353 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10354 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10359 /* Initialize the color table. */
10360 init_color_table ();
10362 /* For each pixel of the image, look its color up in the
10363 color table. After having done so, the color table will
10364 contain an entry for each color used by the image. */
10365 for (y
= 0; y
< img
->height
; ++y
)
10366 for (x
= 0; x
< img
->width
; ++x
)
10368 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
10369 lookup_pixel_color (f
, pixel
);
10372 /* Record colors in the image. Free color table and XImage. */
10373 img
->colors
= colors_in_color_table (&img
->ncolors
);
10374 free_color_table ();
10375 XDestroyImage (ximg
);
10377 #if 0 /* This doesn't seem to be the case. If we free the colors
10378 here, we get a BadAccess later in x_clear_image when
10379 freeing the colors. */
10380 /* We have allocated colors once, but Ghostscript has also
10381 allocated colors on behalf of us. So, to get the
10382 reference counts right, free them once. */
10384 x_free_colors (f
, img
->colors
, img
->ncolors
);
10388 image_error ("Cannot get X image of `%s'; colors will not be freed",
10394 /* Now that we have the pixmap, compute mask and transform the
10395 image if requested. */
10397 postprocess_image (f
, img
);
10403 /***********************************************************************
10405 ***********************************************************************/
10407 DEFUN ("x-change-window-property", Fx_change_window_property
,
10408 Sx_change_window_property
, 2, 3, 0,
10409 doc
: /* Change window property PROP to VALUE on the X window of FRAME.
10410 PROP and VALUE must be strings. FRAME nil or omitted means use the
10411 selected frame. Value is VALUE. */)
10412 (prop
, value
, frame
)
10413 Lisp_Object frame
, prop
, value
;
10415 struct frame
*f
= check_x_frame (frame
);
10418 CHECK_STRING (prop
, 1);
10419 CHECK_STRING (value
, 2);
10422 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10423 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10424 prop_atom
, XA_STRING
, 8, PropModeReplace
,
10425 XSTRING (value
)->data
, XSTRING (value
)->size
);
10427 /* Make sure the property is set when we return. */
10428 XFlush (FRAME_X_DISPLAY (f
));
10435 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
10436 Sx_delete_window_property
, 1, 2, 0,
10437 doc
: /* Remove window property PROP from X window of FRAME.
10438 FRAME nil or omitted means use the selected frame. Value is PROP. */)
10440 Lisp_Object prop
, frame
;
10442 struct frame
*f
= check_x_frame (frame
);
10445 CHECK_STRING (prop
, 1);
10447 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10448 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
10450 /* Make sure the property is removed when we return. */
10451 XFlush (FRAME_X_DISPLAY (f
));
10458 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10460 doc
: /* Value is the value of window property PROP on FRAME.
10461 If FRAME is nil or omitted, use the selected frame. Value is nil
10462 if FRAME hasn't a property with name PROP or if PROP has no string
10465 Lisp_Object prop
, frame
;
10467 struct frame
*f
= check_x_frame (frame
);
10470 Lisp_Object prop_value
= Qnil
;
10471 char *tmp_data
= NULL
;
10474 unsigned long actual_size
, bytes_remaining
;
10476 CHECK_STRING (prop
, 1);
10478 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10479 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10480 prop_atom
, 0, 0, False
, XA_STRING
,
10481 &actual_type
, &actual_format
, &actual_size
,
10482 &bytes_remaining
, (unsigned char **) &tmp_data
);
10485 int size
= bytes_remaining
;
10490 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10491 prop_atom
, 0, bytes_remaining
,
10493 &actual_type
, &actual_format
,
10494 &actual_size
, &bytes_remaining
,
10495 (unsigned char **) &tmp_data
);
10496 if (rc
== Success
&& tmp_data
)
10497 prop_value
= make_string (tmp_data
, size
);
10508 /***********************************************************************
10510 ***********************************************************************/
10512 /* If non-null, an asynchronous timer that, when it expires, displays
10513 an hourglass cursor on all frames. */
10515 static struct atimer
*hourglass_atimer
;
10517 /* Non-zero means an hourglass cursor is currently shown. */
10519 static int hourglass_shown_p
;
10521 /* Number of seconds to wait before displaying an hourglass cursor. */
10523 static Lisp_Object Vhourglass_delay
;
10525 /* Default number of seconds to wait before displaying an hourglass
10528 #define DEFAULT_HOURGLASS_DELAY 1
10530 /* Function prototypes. */
10532 static void show_hourglass
P_ ((struct atimer
*));
10533 static void hide_hourglass
P_ ((void));
10536 /* Cancel a currently active hourglass timer, and start a new one. */
10542 int secs
, usecs
= 0;
10544 cancel_hourglass ();
10546 if (INTEGERP (Vhourglass_delay
)
10547 && XINT (Vhourglass_delay
) > 0)
10548 secs
= XFASTINT (Vhourglass_delay
);
10549 else if (FLOATP (Vhourglass_delay
)
10550 && XFLOAT_DATA (Vhourglass_delay
) > 0)
10553 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
10554 secs
= XFASTINT (tem
);
10555 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
10558 secs
= DEFAULT_HOURGLASS_DELAY
;
10560 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10561 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10562 show_hourglass
, NULL
);
10566 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
10570 cancel_hourglass ()
10572 if (hourglass_atimer
)
10574 cancel_atimer (hourglass_atimer
);
10575 hourglass_atimer
= NULL
;
10578 if (hourglass_shown_p
)
10583 /* Timer function of hourglass_atimer. TIMER is equal to
10586 Display an hourglass pointer on all frames by mapping the frames'
10587 hourglass_window. Set the hourglass_p flag in the frames'
10588 output_data.x structure to indicate that an hourglass cursor is
10589 shown on the frames. */
10592 show_hourglass (timer
)
10593 struct atimer
*timer
;
10595 /* The timer implementation will cancel this timer automatically
10596 after this function has run. Set hourglass_atimer to null
10597 so that we know the timer doesn't have to be canceled. */
10598 hourglass_atimer
= NULL
;
10600 if (!hourglass_shown_p
)
10602 Lisp_Object rest
, frame
;
10606 FOR_EACH_FRAME (rest
, frame
)
10608 struct frame
*f
= XFRAME (frame
);
10610 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
) && FRAME_X_DISPLAY (f
))
10612 Display
*dpy
= FRAME_X_DISPLAY (f
);
10614 #ifdef USE_X_TOOLKIT
10615 if (f
->output_data
.x
->widget
)
10617 if (FRAME_OUTER_WINDOW (f
))
10620 f
->output_data
.x
->hourglass_p
= 1;
10622 if (!f
->output_data
.x
->hourglass_window
)
10624 unsigned long mask
= CWCursor
;
10625 XSetWindowAttributes attrs
;
10627 attrs
.cursor
= f
->output_data
.x
->hourglass_cursor
;
10629 f
->output_data
.x
->hourglass_window
10630 = XCreateWindow (dpy
, FRAME_OUTER_WINDOW (f
),
10631 0, 0, 32000, 32000, 0, 0,
10637 XMapRaised (dpy
, f
->output_data
.x
->hourglass_window
);
10643 hourglass_shown_p
= 1;
10649 /* Hide the hourglass pointer on all frames, if it is currently
10655 if (hourglass_shown_p
)
10657 Lisp_Object rest
, frame
;
10660 FOR_EACH_FRAME (rest
, frame
)
10662 struct frame
*f
= XFRAME (frame
);
10665 /* Watch out for newly created frames. */
10666 && f
->output_data
.x
->hourglass_window
)
10668 XUnmapWindow (FRAME_X_DISPLAY (f
),
10669 f
->output_data
.x
->hourglass_window
);
10670 /* Sync here because XTread_socket looks at the
10671 hourglass_p flag that is reset to zero below. */
10672 XSync (FRAME_X_DISPLAY (f
), False
);
10673 f
->output_data
.x
->hourglass_p
= 0;
10677 hourglass_shown_p
= 0;
10684 /***********************************************************************
10686 ***********************************************************************/
10688 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10689 Lisp_Object
, Lisp_Object
));
10690 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
10691 Lisp_Object
, int, int, int *, int *));
10693 /* The frame of a currently visible tooltip. */
10695 Lisp_Object tip_frame
;
10697 /* If non-nil, a timer started that hides the last tooltip when it
10700 Lisp_Object tip_timer
;
10703 /* If non-nil, a vector of 3 elements containing the last args
10704 with which x-show-tip was called. See there. */
10706 Lisp_Object last_show_tip_args
;
10708 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
10710 Lisp_Object Vx_max_tooltip_size
;
10714 unwind_create_tip_frame (frame
)
10717 Lisp_Object deleted
;
10719 deleted
= unwind_create_frame (frame
);
10720 if (EQ (deleted
, Qt
))
10730 /* Create a frame for a tooltip on the display described by DPYINFO.
10731 PARMS is a list of frame parameters. TEXT is the string to
10732 display in the tip frame. Value is the frame.
10734 Note that functions called here, esp. x_default_parameter can
10735 signal errors, for instance when a specified color name is
10736 undefined. We have to make sure that we're in a consistent state
10737 when this happens. */
10740 x_create_tip_frame (dpyinfo
, parms
, text
)
10741 struct x_display_info
*dpyinfo
;
10742 Lisp_Object parms
, text
;
10745 Lisp_Object frame
, tem
;
10747 long window_prompting
= 0;
10749 int count
= BINDING_STACK_SIZE ();
10750 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10752 int face_change_count_before
= face_change_count
;
10753 Lisp_Object buffer
;
10754 struct buffer
*old_buffer
;
10758 /* Use this general default value to start with until we know if
10759 this frame has a specified name. */
10760 Vx_resource_name
= Vinvocation_name
;
10762 #ifdef MULTI_KBOARD
10763 kb
= dpyinfo
->kboard
;
10765 kb
= &the_only_kboard
;
10768 /* Get the name of the frame to use for resource lookup. */
10769 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10770 if (!STRINGP (name
)
10771 && !EQ (name
, Qunbound
)
10773 error ("Invalid frame name--not a string or nil");
10774 Vx_resource_name
= name
;
10777 GCPRO3 (parms
, name
, frame
);
10778 f
= make_frame (1);
10779 XSETFRAME (frame
, f
);
10781 buffer
= Fget_buffer_create (build_string (" *tip*"));
10782 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10783 old_buffer
= current_buffer
;
10784 set_buffer_internal_1 (XBUFFER (buffer
));
10785 current_buffer
->truncate_lines
= Qnil
;
10787 Finsert (1, &text
);
10788 set_buffer_internal_1 (old_buffer
);
10790 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10791 record_unwind_protect (unwind_create_tip_frame
, frame
);
10793 /* By setting the output method, we're essentially saying that
10794 the frame is live, as per FRAME_LIVE_P. If we get a signal
10795 from this point on, x_destroy_window might screw up reference
10797 f
->output_method
= output_x_window
;
10798 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10799 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10800 f
->output_data
.x
->icon_bitmap
= -1;
10801 f
->output_data
.x
->fontset
= -1;
10802 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
10803 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
10804 #ifdef USE_TOOLKIT_SCROLL_BARS
10805 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
10806 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
10807 #endif /* USE_TOOLKIT_SCROLL_BARS */
10808 f
->icon_name
= Qnil
;
10809 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10811 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
10812 dpyinfo_refcount
= dpyinfo
->reference_count
;
10813 #endif /* GLYPH_DEBUG */
10814 #ifdef MULTI_KBOARD
10815 FRAME_KBOARD (f
) = kb
;
10817 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10818 f
->output_data
.x
->explicit_parent
= 0;
10820 /* These colors will be set anyway later, but it's important
10821 to get the color reference counts right, so initialize them! */
10824 struct gcpro gcpro1
;
10826 black
= build_string ("black");
10828 f
->output_data
.x
->foreground_pixel
10829 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10830 f
->output_data
.x
->background_pixel
10831 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10832 f
->output_data
.x
->cursor_pixel
10833 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10834 f
->output_data
.x
->cursor_foreground_pixel
10835 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10836 f
->output_data
.x
->border_pixel
10837 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10838 f
->output_data
.x
->mouse_pixel
10839 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10843 /* Set the name; the functions to which we pass f expect the name to
10845 if (EQ (name
, Qunbound
) || NILP (name
))
10847 f
->name
= build_string (dpyinfo
->x_id_name
);
10848 f
->explicit_name
= 0;
10853 f
->explicit_name
= 1;
10854 /* use the frame's title when getting resources for this frame. */
10855 specbind (Qx_resource_name
, name
);
10858 /* Extract the window parameters from the supplied values that are
10859 needed to determine window geometry. */
10863 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10866 /* First, try whatever font the caller has specified. */
10867 if (STRINGP (font
))
10869 tem
= Fquery_fontset (font
, Qnil
);
10871 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10873 font
= x_new_font (f
, XSTRING (font
)->data
);
10876 /* Try out a font which we hope has bold and italic variations. */
10877 if (!STRINGP (font
))
10878 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10879 if (!STRINGP (font
))
10880 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10881 if (! STRINGP (font
))
10882 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10883 if (! STRINGP (font
))
10884 /* This was formerly the first thing tried, but it finds too many fonts
10885 and takes too long. */
10886 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10887 /* If those didn't work, look for something which will at least work. */
10888 if (! STRINGP (font
))
10889 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10891 if (! STRINGP (font
))
10892 font
= build_string ("fixed");
10894 x_default_parameter (f
, parms
, Qfont
, font
,
10895 "font", "Font", RES_TYPE_STRING
);
10898 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10899 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10901 /* This defaults to 2 in order to match xterm. We recognize either
10902 internalBorderWidth or internalBorder (which is what xterm calls
10904 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10908 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10909 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10910 if (! EQ (value
, Qunbound
))
10911 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10915 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10916 "internalBorderWidth", "internalBorderWidth",
10919 /* Also do the stuff which must be set before the window exists. */
10920 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10921 "foreground", "Foreground", RES_TYPE_STRING
);
10922 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10923 "background", "Background", RES_TYPE_STRING
);
10924 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10925 "pointerColor", "Foreground", RES_TYPE_STRING
);
10926 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10927 "cursorColor", "Foreground", RES_TYPE_STRING
);
10928 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10929 "borderColor", "BorderColor", RES_TYPE_STRING
);
10931 /* Init faces before x_default_parameter is called for scroll-bar
10932 parameters because that function calls x_set_scroll_bar_width,
10933 which calls change_frame_size, which calls Fset_window_buffer,
10934 which runs hooks, which call Fvertical_motion. At the end, we
10935 end up in init_iterator with a null face cache, which should not
10937 init_frame_faces (f
);
10939 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10940 window_prompting
= x_figure_window_size (f
, parms
);
10942 if (window_prompting
& XNegative
)
10944 if (window_prompting
& YNegative
)
10945 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10947 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10951 if (window_prompting
& YNegative
)
10952 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10954 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10957 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10959 XSetWindowAttributes attrs
;
10960 unsigned long mask
;
10963 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
10964 if (DoesSaveUnders (dpyinfo
->screen
))
10965 mask
|= CWSaveUnder
;
10967 /* Window managers look at the override-redirect flag to determine
10968 whether or net to give windows a decoration (Xlib spec, chapter
10970 attrs
.override_redirect
= True
;
10971 attrs
.save_under
= True
;
10972 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10973 /* Arrange for getting MapNotify and UnmapNotify events. */
10974 attrs
.event_mask
= StructureNotifyMask
;
10976 = FRAME_X_WINDOW (f
)
10977 = XCreateWindow (FRAME_X_DISPLAY (f
),
10978 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10979 /* x, y, width, height */
10983 CopyFromParent
, InputOutput
, CopyFromParent
,
10990 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10991 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10992 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10993 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10994 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10995 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10997 /* Dimensions, especially f->height, must be done via change_frame_size.
10998 Change will not be effected unless different from the current
11001 height
= f
->height
;
11003 SET_FRAME_WIDTH (f
, 0);
11004 change_frame_size (f
, height
, width
, 1, 0, 0);
11006 /* Set up faces after all frame parameters are known. This call
11007 also merges in face attributes specified for new frames.
11009 Frame parameters may be changed if .Xdefaults contains
11010 specifications for the default font. For example, if there is an
11011 `Emacs.default.attributeBackground: pink', the `background-color'
11012 attribute of the frame get's set, which let's the internal border
11013 of the tooltip frame appear in pink. Prevent this. */
11015 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
11017 /* Set tip_frame here, so that */
11019 call1 (Qface_set_after_frame_default
, frame
);
11021 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
11022 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
11030 /* It is now ok to make the frame official even if we get an error
11031 below. And the frame needs to be on Vframe_list or making it
11032 visible won't work. */
11033 Vframe_list
= Fcons (frame
, Vframe_list
);
11035 /* Now that the frame is official, it counts as a reference to
11037 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
11039 /* Setting attributes of faces of the tooltip frame from resources
11040 and similar will increment face_change_count, which leads to the
11041 clearing of all current matrices. Since this isn't necessary
11042 here, avoid it by resetting face_change_count to the value it
11043 had before we created the tip frame. */
11044 face_change_count
= face_change_count_before
;
11046 /* Discard the unwind_protect. */
11047 return unbind_to (count
, frame
);
11051 /* Compute where to display tip frame F. PARMS is the list of frame
11052 parameters for F. DX and DY are specified offsets from the current
11053 location of the mouse. WIDTH and HEIGHT are the width and height
11054 of the tooltip. Return coordinates relative to the root window of
11055 the display in *ROOT_X, and *ROOT_Y. */
11058 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
11060 Lisp_Object parms
, dx
, dy
;
11062 int *root_x
, *root_y
;
11064 Lisp_Object left
, top
;
11066 Window root
, child
;
11069 /* User-specified position? */
11070 left
= Fcdr (Fassq (Qleft
, parms
));
11071 top
= Fcdr (Fassq (Qtop
, parms
));
11073 /* Move the tooltip window where the mouse pointer is. Resize and
11075 if (!INTEGERP (left
) && !INTEGERP (top
))
11078 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
11079 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
11083 if (INTEGERP (top
))
11084 *root_y
= XINT (top
);
11085 else if (*root_y
+ XINT (dy
) - height
< 0)
11086 *root_y
-= XINT (dy
);
11090 *root_y
+= XINT (dy
);
11093 if (INTEGERP (left
))
11094 *root_x
= XINT (left
);
11095 else if (*root_x
+ XINT (dx
) + width
> FRAME_X_DISPLAY_INFO (f
)->width
)
11096 *root_x
-= width
+ XINT (dx
);
11098 *root_x
+= XINT (dx
);
11102 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
11103 doc
: /* Show STRING in a "tooltip" window on frame FRAME.
11104 A tooltip window is a small X window displaying a string.
11106 FRAME nil or omitted means use the selected frame.
11108 PARMS is an optional list of frame parameters which can be used to
11109 change the tooltip's appearance.
11111 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
11112 means use the default timeout of 5 seconds.
11114 If the list of frame parameters PARAMS contains a `left' parameters,
11115 the tooltip is displayed at that x-position. Otherwise it is
11116 displayed at the mouse position, with offset DX added (default is 5 if
11117 DX isn't specified). Likewise for the y-position; if a `top' frame
11118 parameter is specified, it determines the y-position of the tooltip
11119 window, otherwise it is displayed at the mouse position, with offset
11120 DY added (default is -10).
11122 A tooltip's maximum size is specified by `x-max-tooltip-size'.
11123 Text larger than the specified size is clipped. */)
11124 (string
, frame
, parms
, timeout
, dx
, dy
)
11125 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
11129 int root_x
, root_y
;
11130 struct buffer
*old_buffer
;
11131 struct text_pos pos
;
11132 int i
, width
, height
;
11133 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
11134 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
11135 int count
= BINDING_STACK_SIZE ();
11137 specbind (Qinhibit_redisplay
, Qt
);
11139 GCPRO4 (string
, parms
, frame
, timeout
);
11141 CHECK_STRING (string
, 0);
11142 f
= check_x_frame (frame
);
11143 if (NILP (timeout
))
11144 timeout
= make_number (5);
11146 CHECK_NATNUM (timeout
, 2);
11149 dx
= make_number (5);
11151 CHECK_NUMBER (dx
, 5);
11154 dy
= make_number (-10);
11156 CHECK_NUMBER (dy
, 6);
11158 if (NILP (last_show_tip_args
))
11159 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
11161 if (!NILP (tip_frame
))
11163 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
11164 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
11165 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
11167 if (EQ (frame
, last_frame
)
11168 && !NILP (Fequal (last_string
, string
))
11169 && !NILP (Fequal (last_parms
, parms
)))
11171 struct frame
*f
= XFRAME (tip_frame
);
11173 /* Only DX and DY have changed. */
11174 if (!NILP (tip_timer
))
11176 Lisp_Object timer
= tip_timer
;
11178 call1 (Qcancel_timer
, timer
);
11182 compute_tip_xy (f
, parms
, dx
, dy
, PIXEL_WIDTH (f
),
11183 PIXEL_HEIGHT (f
), &root_x
, &root_y
);
11184 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11191 /* Hide a previous tip, if any. */
11194 ASET (last_show_tip_args
, 0, string
);
11195 ASET (last_show_tip_args
, 1, frame
);
11196 ASET (last_show_tip_args
, 2, parms
);
11198 /* Add default values to frame parameters. */
11199 if (NILP (Fassq (Qname
, parms
)))
11200 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
11201 if (NILP (Fassq (Qinternal_border_width
, parms
)))
11202 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
11203 if (NILP (Fassq (Qborder_width
, parms
)))
11204 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
11205 if (NILP (Fassq (Qborder_color
, parms
)))
11206 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
11207 if (NILP (Fassq (Qbackground_color
, parms
)))
11208 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
11211 /* Create a frame for the tooltip, and record it in the global
11212 variable tip_frame. */
11213 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
, string
);
11214 f
= XFRAME (frame
);
11216 /* Set up the frame's root window. */
11217 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
11218 w
->left
= w
->top
= make_number (0);
11220 if (CONSP (Vx_max_tooltip_size
)
11221 && INTEGERP (XCAR (Vx_max_tooltip_size
))
11222 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
11223 && INTEGERP (XCDR (Vx_max_tooltip_size
))
11224 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
11226 w
->width
= XCAR (Vx_max_tooltip_size
);
11227 w
->height
= XCDR (Vx_max_tooltip_size
);
11231 w
->width
= make_number (80);
11232 w
->height
= make_number (40);
11235 f
->window_width
= XINT (w
->width
);
11237 w
->pseudo_window_p
= 1;
11239 /* Display the tooltip text in a temporary buffer. */
11240 old_buffer
= current_buffer
;
11241 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
11242 current_buffer
->truncate_lines
= Qnil
;
11243 clear_glyph_matrix (w
->desired_matrix
);
11244 clear_glyph_matrix (w
->current_matrix
);
11245 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
11246 try_window (FRAME_ROOT_WINDOW (f
), pos
);
11248 /* Compute width and height of the tooltip. */
11249 width
= height
= 0;
11250 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
11252 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
11253 struct glyph
*last
;
11256 /* Stop at the first empty row at the end. */
11257 if (!row
->enabled_p
|| !row
->displays_text_p
)
11260 /* Let the row go over the full width of the frame. */
11261 row
->full_width_p
= 1;
11263 /* There's a glyph at the end of rows that is used to place
11264 the cursor there. Don't include the width of this glyph. */
11265 if (row
->used
[TEXT_AREA
])
11267 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
11268 row_width
= row
->pixel_width
- last
->pixel_width
;
11271 row_width
= row
->pixel_width
;
11273 height
+= row
->height
;
11274 width
= max (width
, row_width
);
11277 /* Add the frame's internal border to the width and height the X
11278 window should have. */
11279 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11280 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11282 /* Move the tooltip window where the mouse pointer is. Resize and
11284 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
11287 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11288 root_x
, root_y
, width
, height
);
11289 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
11292 /* Draw into the window. */
11293 w
->must_be_updated_p
= 1;
11294 update_single_window (w
, 1);
11296 /* Restore original current buffer. */
11297 set_buffer_internal_1 (old_buffer
);
11298 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
11301 /* Let the tip disappear after timeout seconds. */
11302 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
11303 intern ("x-hide-tip"));
11306 return unbind_to (count
, Qnil
);
11310 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
11311 doc
: /* Hide the current tooltip window, if there is any.
11312 Value is t if tooltip was open, nil otherwise. */)
11316 Lisp_Object deleted
, frame
, timer
;
11317 struct gcpro gcpro1
, gcpro2
;
11319 /* Return quickly if nothing to do. */
11320 if (NILP (tip_timer
) && NILP (tip_frame
))
11325 GCPRO2 (frame
, timer
);
11326 tip_frame
= tip_timer
= deleted
= Qnil
;
11328 count
= BINDING_STACK_SIZE ();
11329 specbind (Qinhibit_redisplay
, Qt
);
11330 specbind (Qinhibit_quit
, Qt
);
11333 call1 (Qcancel_timer
, timer
);
11335 if (FRAMEP (frame
))
11337 Fdelete_frame (frame
, Qnil
);
11341 /* Bloodcurdling hack alert: The Lucid menu bar widget's
11342 redisplay procedure is not called when a tip frame over menu
11343 items is unmapped. Redisplay the menu manually... */
11345 struct frame
*f
= SELECTED_FRAME ();
11346 Widget w
= f
->output_data
.x
->menubar_widget
;
11347 extern void xlwmenu_redisplay
P_ ((Widget
));
11349 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f
)->screen
)
11353 xlwmenu_redisplay (w
);
11357 #endif /* USE_LUCID */
11361 return unbind_to (count
, deleted
);
11366 /***********************************************************************
11367 File selection dialog
11368 ***********************************************************************/
11372 /* Callback for "OK" and "Cancel" on file selection dialog. */
11375 file_dialog_cb (widget
, client_data
, call_data
)
11377 XtPointer call_data
, client_data
;
11379 int *result
= (int *) client_data
;
11380 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
11381 *result
= cb
->reason
;
11385 /* Callback for unmapping a file selection dialog. This is used to
11386 capture the case where a dialog is closed via a window manager's
11387 closer button, for example. Using a XmNdestroyCallback didn't work
11391 file_dialog_unmap_cb (widget
, client_data
, call_data
)
11393 XtPointer call_data
, client_data
;
11395 int *result
= (int *) client_data
;
11396 *result
= XmCR_CANCEL
;
11400 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
11401 doc
: /* Read file name, prompting with PROMPT in directory DIR.
11402 Use a file selection dialog.
11403 Select DEFAULT-FILENAME in the dialog's file selection box, if
11404 specified. Don't let the user enter a file name in the file
11405 selection dialog's entry field, if MUSTMATCH is non-nil. */)
11406 (prompt
, dir
, default_filename
, mustmatch
)
11407 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
11410 struct frame
*f
= SELECTED_FRAME ();
11411 Lisp_Object file
= Qnil
;
11412 Widget dialog
, text
, list
, help
;
11415 extern XtAppContext Xt_app_con
;
11416 XmString dir_xmstring
, pattern_xmstring
;
11417 int count
= specpdl_ptr
- specpdl
;
11418 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11420 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11421 CHECK_STRING (prompt
, 0);
11422 CHECK_STRING (dir
, 1);
11424 /* Prevent redisplay. */
11425 specbind (Qinhibit_redisplay
, Qt
);
11429 /* Create the dialog with PROMPT as title, using DIR as initial
11430 directory and using "*" as pattern. */
11431 dir
= Fexpand_file_name (dir
, Qnil
);
11432 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
11433 pattern_xmstring
= XmStringCreateLocalized ("*");
11435 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
11436 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
11437 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
11438 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
11439 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
11440 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
11442 XmStringFree (dir_xmstring
);
11443 XmStringFree (pattern_xmstring
);
11445 /* Add callbacks for OK and Cancel. */
11446 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
11447 (XtPointer
) &result
);
11448 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
11449 (XtPointer
) &result
);
11450 XtAddCallback (dialog
, XmNunmapCallback
, file_dialog_unmap_cb
,
11451 (XtPointer
) &result
);
11453 /* Disable the help button since we can't display help. */
11454 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
11455 XtSetSensitive (help
, False
);
11457 /* Mark OK button as default. */
11458 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
11459 XmNshowAsDefault
, True
, NULL
);
11461 /* If MUSTMATCH is non-nil, disable the file entry field of the
11462 dialog, so that the user must select a file from the files list
11463 box. We can't remove it because we wouldn't have a way to get at
11464 the result file name, then. */
11465 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
11466 if (!NILP (mustmatch
))
11469 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
11470 XtSetSensitive (text
, False
);
11471 XtSetSensitive (label
, False
);
11474 /* Manage the dialog, so that list boxes get filled. */
11475 XtManageChild (dialog
);
11477 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11478 must include the path for this to work. */
11479 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
11480 if (STRINGP (default_filename
))
11482 XmString default_xmstring
;
11486 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
11488 if (!XmListItemExists (list
, default_xmstring
))
11490 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11491 XmListAddItem (list
, default_xmstring
, 0);
11495 item_pos
= XmListItemPos (list
, default_xmstring
);
11496 XmStringFree (default_xmstring
);
11498 /* Select the item and scroll it into view. */
11499 XmListSelectPos (list
, item_pos
, True
);
11500 XmListSetPos (list
, item_pos
);
11503 /* Process events until the user presses Cancel or OK. Block
11504 and unblock input here so that we get a chance of processing
11508 while (result
== 0)
11511 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
11516 /* Get the result. */
11517 if (result
== XmCR_OK
)
11522 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
11523 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
11524 XmStringFree (text
);
11525 file
= build_string (data
);
11532 XtUnmanageChild (dialog
);
11533 XtDestroyWidget (dialog
);
11537 /* Make "Cancel" equivalent to C-g. */
11539 Fsignal (Qquit
, Qnil
);
11541 return unbind_to (count
, file
);
11544 #endif /* USE_MOTIF */
11548 /***********************************************************************
11550 ***********************************************************************/
11552 #ifdef HAVE_XKBGETKEYBOARD
11553 #include <X11/XKBlib.h>
11554 #include <X11/keysym.h>
11557 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p
,
11558 Sx_backspace_delete_keys_p
, 0, 1, 0,
11559 doc
: /* Check if both Backspace and Delete keys are on the keyboard of FRAME.
11560 FRAME nil means use the selected frame.
11561 Value is t if we know that both keys are present, and are mapped to the
11562 usual X keysyms. */)
11566 #ifdef HAVE_XKBGETKEYBOARD
11568 struct frame
*f
= check_x_frame (frame
);
11569 Display
*dpy
= FRAME_X_DISPLAY (f
);
11570 Lisp_Object have_keys
;
11571 int major
, minor
, op
, event
, error
;
11575 /* Check library version in case we're dynamically linked. */
11576 major
= XkbMajorVersion
;
11577 minor
= XkbMinorVersion
;
11578 if (!XkbLibraryVersion (&major
, &minor
))
11584 /* Check that the server supports XKB. */
11585 major
= XkbMajorVersion
;
11586 minor
= XkbMinorVersion
;
11587 if (!XkbQueryExtension (dpy
, &op
, &event
, &error
, &major
, &minor
))
11594 kb
= XkbGetMap (dpy
, XkbAllMapComponentsMask
, XkbUseCoreKbd
);
11597 int delete_keycode
= 0, backspace_keycode
= 0, i
;
11599 if (XkbGetNames (dpy
, XkbAllNamesMask
, kb
) == Success
)
11601 for (i
= kb
->min_key_code
;
11602 (i
< kb
->max_key_code
11603 && (delete_keycode
== 0 || backspace_keycode
== 0));
11606 /* The XKB symbolic key names can be seen most easily in
11607 the PS file generated by `xkbprint -label name
11609 if (bcmp ("DELE", kb
->names
->keys
[i
].name
, 4) == 0)
11610 delete_keycode
= i
;
11611 else if (bcmp ("BKSP", kb
->names
->keys
[i
].name
, 4) == 0)
11612 backspace_keycode
= i
;
11615 XkbFreeNames (kb
, 0, True
);
11618 XkbFreeClientMap (kb
, 0, True
);
11621 && backspace_keycode
11622 && XKeysymToKeycode (dpy
, XK_Delete
) == delete_keycode
11623 && XKeysymToKeycode (dpy
, XK_BackSpace
) == backspace_keycode
)
11628 #else /* not HAVE_XKBGETKEYBOARD */
11630 #endif /* not HAVE_XKBGETKEYBOARD */
11635 /***********************************************************************
11637 ***********************************************************************/
11642 /* This is zero if not using X windows. */
11645 /* The section below is built by the lisp expression at the top of the file,
11646 just above where these variables are declared. */
11647 /*&&& init symbols here &&&*/
11648 Qauto_raise
= intern ("auto-raise");
11649 staticpro (&Qauto_raise
);
11650 Qauto_lower
= intern ("auto-lower");
11651 staticpro (&Qauto_lower
);
11652 Qbar
= intern ("bar");
11654 Qborder_color
= intern ("border-color");
11655 staticpro (&Qborder_color
);
11656 Qborder_width
= intern ("border-width");
11657 staticpro (&Qborder_width
);
11658 Qbox
= intern ("box");
11660 Qcursor_color
= intern ("cursor-color");
11661 staticpro (&Qcursor_color
);
11662 Qcursor_type
= intern ("cursor-type");
11663 staticpro (&Qcursor_type
);
11664 Qgeometry
= intern ("geometry");
11665 staticpro (&Qgeometry
);
11666 Qicon_left
= intern ("icon-left");
11667 staticpro (&Qicon_left
);
11668 Qicon_top
= intern ("icon-top");
11669 staticpro (&Qicon_top
);
11670 Qicon_type
= intern ("icon-type");
11671 staticpro (&Qicon_type
);
11672 Qicon_name
= intern ("icon-name");
11673 staticpro (&Qicon_name
);
11674 Qinternal_border_width
= intern ("internal-border-width");
11675 staticpro (&Qinternal_border_width
);
11676 Qleft
= intern ("left");
11677 staticpro (&Qleft
);
11678 Qright
= intern ("right");
11679 staticpro (&Qright
);
11680 Qmouse_color
= intern ("mouse-color");
11681 staticpro (&Qmouse_color
);
11682 Qnone
= intern ("none");
11683 staticpro (&Qnone
);
11684 Qparent_id
= intern ("parent-id");
11685 staticpro (&Qparent_id
);
11686 Qscroll_bar_width
= intern ("scroll-bar-width");
11687 staticpro (&Qscroll_bar_width
);
11688 Qsuppress_icon
= intern ("suppress-icon");
11689 staticpro (&Qsuppress_icon
);
11690 Qundefined_color
= intern ("undefined-color");
11691 staticpro (&Qundefined_color
);
11692 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
11693 staticpro (&Qvertical_scroll_bars
);
11694 Qvisibility
= intern ("visibility");
11695 staticpro (&Qvisibility
);
11696 Qwindow_id
= intern ("window-id");
11697 staticpro (&Qwindow_id
);
11698 Qouter_window_id
= intern ("outer-window-id");
11699 staticpro (&Qouter_window_id
);
11700 Qx_frame_parameter
= intern ("x-frame-parameter");
11701 staticpro (&Qx_frame_parameter
);
11702 Qx_resource_name
= intern ("x-resource-name");
11703 staticpro (&Qx_resource_name
);
11704 Quser_position
= intern ("user-position");
11705 staticpro (&Quser_position
);
11706 Quser_size
= intern ("user-size");
11707 staticpro (&Quser_size
);
11708 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
11709 staticpro (&Qscroll_bar_foreground
);
11710 Qscroll_bar_background
= intern ("scroll-bar-background");
11711 staticpro (&Qscroll_bar_background
);
11712 Qscreen_gamma
= intern ("screen-gamma");
11713 staticpro (&Qscreen_gamma
);
11714 Qline_spacing
= intern ("line-spacing");
11715 staticpro (&Qline_spacing
);
11716 Qcenter
= intern ("center");
11717 staticpro (&Qcenter
);
11718 Qcompound_text
= intern ("compound-text");
11719 staticpro (&Qcompound_text
);
11720 Qcancel_timer
= intern ("cancel-timer");
11721 staticpro (&Qcancel_timer
);
11722 Qwait_for_wm
= intern ("wait-for-wm");
11723 staticpro (&Qwait_for_wm
);
11724 /* This is the end of symbol initialization. */
11726 /* Text property `display' should be nonsticky by default. */
11727 Vtext_property_default_nonsticky
11728 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
11731 Qlaplace
= intern ("laplace");
11732 staticpro (&Qlaplace
);
11733 Qemboss
= intern ("emboss");
11734 staticpro (&Qemboss
);
11735 Qedge_detection
= intern ("edge-detection");
11736 staticpro (&Qedge_detection
);
11737 Qheuristic
= intern ("heuristic");
11738 staticpro (&Qheuristic
);
11739 QCmatrix
= intern (":matrix");
11740 staticpro (&QCmatrix
);
11741 QCcolor_adjustment
= intern (":color-adjustment");
11742 staticpro (&QCcolor_adjustment
);
11743 QCmask
= intern (":mask");
11744 staticpro (&QCmask
);
11746 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
11747 staticpro (&Qface_set_after_frame_default
);
11749 Fput (Qundefined_color
, Qerror_conditions
,
11750 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
11751 Fput (Qundefined_color
, Qerror_message
,
11752 build_string ("Undefined color"));
11754 init_x_parm_symbols ();
11756 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
11757 doc
: /* Non-nil means always draw a cross over disabled images.
11758 Disabled images are those having an `:conversion disabled' property.
11759 A cross is always drawn on black & white displays. */);
11760 cross_disabled_images
= 0;
11762 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
11763 doc
: /* List of directories to search for bitmap files for X. */);
11764 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
11766 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
11767 doc
: /* The shape of the pointer when over text.
11768 Changing the value does not affect existing frames
11769 unless you set the mouse color. */);
11770 Vx_pointer_shape
= Qnil
;
11772 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
11773 doc
: /* The name Emacs uses to look up X resources.
11774 `x-get-resource' uses this as the first component of the instance name
11775 when requesting resource values.
11776 Emacs initially sets `x-resource-name' to the name under which Emacs
11777 was invoked, or to the value specified with the `-name' or `-rn'
11778 switches, if present.
11780 It may be useful to bind this variable locally around a call
11781 to `x-get-resource'. See also the variable `x-resource-class'. */);
11782 Vx_resource_name
= Qnil
;
11784 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
11785 doc
: /* The class Emacs uses to look up X resources.
11786 `x-get-resource' uses this as the first component of the instance class
11787 when requesting resource values.
11789 Emacs initially sets `x-resource-class' to "Emacs".
11791 Setting this variable permanently is not a reasonable thing to do,
11792 but binding this variable locally around a call to `x-get-resource'
11793 is a reasonable practice. See also the variable `x-resource-name'. */);
11794 Vx_resource_class
= build_string (EMACS_CLASS
);
11796 #if 0 /* This doesn't really do anything. */
11797 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
11798 doc
: /* The shape of the pointer when not over text.
11799 This variable takes effect when you create a new frame
11800 or when you set the mouse color. */);
11802 Vx_nontext_pointer_shape
= Qnil
;
11804 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
11805 doc
: /* The shape of the pointer when Emacs is busy.
11806 This variable takes effect when you create a new frame
11807 or when you set the mouse color. */);
11808 Vx_hourglass_pointer_shape
= Qnil
;
11810 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
11811 doc
: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
11812 display_hourglass_p
= 1;
11814 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
11815 doc
: /* *Seconds to wait before displaying an hourglass pointer.
11816 Value must be an integer or float. */);
11817 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
11819 #if 0 /* This doesn't really do anything. */
11820 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
11821 doc
: /* The shape of the pointer when over the mode line.
11822 This variable takes effect when you create a new frame
11823 or when you set the mouse color. */);
11825 Vx_mode_pointer_shape
= Qnil
;
11827 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11828 &Vx_sensitive_text_pointer_shape
,
11829 doc
: /* The shape of the pointer when over mouse-sensitive text.
11830 This variable takes effect when you create a new frame
11831 or when you set the mouse color. */);
11832 Vx_sensitive_text_pointer_shape
= Qnil
;
11834 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
11835 &Vx_window_horizontal_drag_shape
,
11836 doc
: /* Pointer shape to use for indicating a window can be dragged horizontally.
11837 This variable takes effect when you create a new frame
11838 or when you set the mouse color. */);
11839 Vx_window_horizontal_drag_shape
= Qnil
;
11841 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
11842 doc
: /* A string indicating the foreground color of the cursor box. */);
11843 Vx_cursor_fore_pixel
= Qnil
;
11845 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
11846 doc
: /* Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).
11847 Text larger than this is clipped. */);
11848 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
11850 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
11851 doc
: /* Non-nil if no X window manager is in use.
11852 Emacs doesn't try to figure this out; this is always nil
11853 unless you set it to something else. */);
11854 /* We don't have any way to find this out, so set it to nil
11855 and maybe the user would like to set it to t. */
11856 Vx_no_window_manager
= Qnil
;
11858 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11859 &Vx_pixel_size_width_font_regexp
,
11860 doc
: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
11862 Since Emacs gets width of a font matching with this regexp from
11863 PIXEL_SIZE field of the name, font finding mechanism gets faster for
11864 such a font. This is especially effective for such large fonts as
11865 Chinese, Japanese, and Korean. */);
11866 Vx_pixel_size_width_font_regexp
= Qnil
;
11868 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
11869 doc
: /* Time after which cached images are removed from the cache.
11870 When an image has not been displayed this many seconds, remove it
11871 from the image cache. Value must be an integer or nil with nil
11872 meaning don't clear the cache. */);
11873 Vimage_cache_eviction_delay
= make_number (30 * 60);
11875 #ifdef USE_X_TOOLKIT
11876 Fprovide (intern ("x-toolkit"), Qnil
);
11878 Fprovide (intern ("motif"), Qnil
);
11880 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string
,
11881 doc
: /* Version info for LessTif/Motif. */);
11882 Vmotif_version_string
= build_string (XmVERSION_STRING
);
11883 #endif /* USE_MOTIF */
11884 #endif /* USE_X_TOOLKIT */
11886 defsubr (&Sx_get_resource
);
11888 /* X window properties. */
11889 defsubr (&Sx_change_window_property
);
11890 defsubr (&Sx_delete_window_property
);
11891 defsubr (&Sx_window_property
);
11893 defsubr (&Sxw_display_color_p
);
11894 defsubr (&Sx_display_grayscale_p
);
11895 defsubr (&Sxw_color_defined_p
);
11896 defsubr (&Sxw_color_values
);
11897 defsubr (&Sx_server_max_request_size
);
11898 defsubr (&Sx_server_vendor
);
11899 defsubr (&Sx_server_version
);
11900 defsubr (&Sx_display_pixel_width
);
11901 defsubr (&Sx_display_pixel_height
);
11902 defsubr (&Sx_display_mm_width
);
11903 defsubr (&Sx_display_mm_height
);
11904 defsubr (&Sx_display_screens
);
11905 defsubr (&Sx_display_planes
);
11906 defsubr (&Sx_display_color_cells
);
11907 defsubr (&Sx_display_visual_class
);
11908 defsubr (&Sx_display_backing_store
);
11909 defsubr (&Sx_display_save_under
);
11910 defsubr (&Sx_parse_geometry
);
11911 defsubr (&Sx_create_frame
);
11912 defsubr (&Sx_open_connection
);
11913 defsubr (&Sx_close_connection
);
11914 defsubr (&Sx_display_list
);
11915 defsubr (&Sx_synchronize
);
11916 defsubr (&Sx_focus_frame
);
11917 defsubr (&Sx_backspace_delete_keys_p
);
11919 /* Setting callback functions for fontset handler. */
11920 get_font_info_func
= x_get_font_info
;
11922 #if 0 /* This function pointer doesn't seem to be used anywhere.
11923 And the pointer assigned has the wrong type, anyway. */
11924 list_fonts_func
= x_list_fonts
;
11927 load_font_func
= x_load_font
;
11928 find_ccl_program_func
= x_find_ccl_program
;
11929 query_font_func
= x_query_font
;
11930 set_frame_fontset_func
= x_set_font
;
11931 check_window_system_func
= check_x
;
11934 Qxbm
= intern ("xbm");
11936 QCtype
= intern (":type");
11937 staticpro (&QCtype
);
11938 QCconversion
= intern (":conversion");
11939 staticpro (&QCconversion
);
11940 QCheuristic_mask
= intern (":heuristic-mask");
11941 staticpro (&QCheuristic_mask
);
11942 QCcolor_symbols
= intern (":color-symbols");
11943 staticpro (&QCcolor_symbols
);
11944 QCascent
= intern (":ascent");
11945 staticpro (&QCascent
);
11946 QCmargin
= intern (":margin");
11947 staticpro (&QCmargin
);
11948 QCrelief
= intern (":relief");
11949 staticpro (&QCrelief
);
11950 Qpostscript
= intern ("postscript");
11951 staticpro (&Qpostscript
);
11952 QCloader
= intern (":loader");
11953 staticpro (&QCloader
);
11954 QCbounding_box
= intern (":bounding-box");
11955 staticpro (&QCbounding_box
);
11956 QCpt_width
= intern (":pt-width");
11957 staticpro (&QCpt_width
);
11958 QCpt_height
= intern (":pt-height");
11959 staticpro (&QCpt_height
);
11960 QCindex
= intern (":index");
11961 staticpro (&QCindex
);
11962 Qpbm
= intern ("pbm");
11966 Qxpm
= intern ("xpm");
11971 Qjpeg
= intern ("jpeg");
11972 staticpro (&Qjpeg
);
11976 Qtiff
= intern ("tiff");
11977 staticpro (&Qtiff
);
11981 Qgif
= intern ("gif");
11986 Qpng
= intern ("png");
11990 defsubr (&Sclear_image_cache
);
11991 defsubr (&Simage_size
);
11992 defsubr (&Simage_mask_p
);
11994 hourglass_atimer
= NULL
;
11995 hourglass_shown_p
= 0;
11997 defsubr (&Sx_show_tip
);
11998 defsubr (&Sx_hide_tip
);
12000 staticpro (&tip_timer
);
12002 staticpro (&tip_frame
);
12004 last_show_tip_args
= Qnil
;
12005 staticpro (&last_show_tip_args
);
12008 defsubr (&Sx_file_dialog
);
12016 image_types
= NULL
;
12017 Vimage_types
= Qnil
;
12019 define_image_type (&xbm_type
);
12020 define_image_type (&gs_type
);
12021 define_image_type (&pbm_type
);
12024 define_image_type (&xpm_type
);
12028 define_image_type (&jpeg_type
);
12032 define_image_type (&tiff_type
);
12036 define_image_type (&gif_type
);
12040 define_image_type (&png_type
);
12044 #endif /* HAVE_X_WINDOWS */