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 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2643 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2644 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2645 the name specified by the `-name' or `-rn' command-line arguments.\n\
2647 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2648 class, respectively. You must specify both of them or neither.\n\
2649 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
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 "Parse an X-style geometry string STRING.\n\
3001 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
3002 The properties returned may include `top', `left', `height', and `width'.\n\
3003 The value of `left' or `top' may be an integer,\n\
3004 or a list (+ N) meaning N pixels relative to top/left corner,\n\
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 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
4094 Returns an Emacs frame object.\n\
4095 ALIST is an alist of frame parameters.\n\
4096 If the parameters specify that the frame should not have a minibuffer,\n\
4097 and do not specify a specific minibuffer window to use,\n\
4098 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
4099 be shared by the new frame.\n\
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 "Set the input focus to FRAME.\n\
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 "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 "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 "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 "Return t if the X display supports shades of gray.\n\
4641 Note that color displays do support shades of gray.\n\
4642 The optional argument DISPLAY specifies which display to ask about.\n\
4643 DISPLAY should be either a frame or a display name (a string).\n\
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 "Returns the width in pixels of the X display DISPLAY.\n\
4671 The optional argument DISPLAY specifies which display to ask about.\n\
4672 DISPLAY should be either a frame or a display name (a string).\n\
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 "Returns the height in pixels of the X display DISPLAY.\n\
4685 The optional argument DISPLAY specifies which display to ask about.\n\
4686 DISPLAY should be either a frame or a display name (a string).\n\
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 "Returns the number of bitplanes of the X display DISPLAY.\n\
4699 The optional argument DISPLAY specifies which display to ask about.\n\
4700 DISPLAY should be either a frame or a display name (a string).\n\
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 "Returns the number of color cells of the X display DISPLAY.\n\
4713 The optional argument DISPLAY specifies which display to ask about.\n\
4714 DISPLAY should be either a frame or a display name (a string).\n\
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 "Returns the maximum request size of the X server of display DISPLAY.\n\
4729 The optional argument DISPLAY specifies which display to ask about.\n\
4730 DISPLAY should be either a frame or a display name (a string).\n\
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 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4742 The optional argument DISPLAY specifies which display to ask about.\n\
4743 DISPLAY should be either a frame or a display name (a string).\n\
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 "Returns the version numbers of the X server of display DISPLAY.\n\
4757 The value is a list of three integers: the major and minor\n\
4758 version numbers of the X Protocol in use, and the vendor-specific release\n\
4759 number. See also the function `x-server-vendor'.\n\n\
4760 The optional argument DISPLAY specifies which display to ask about.\n\
4761 DISPLAY should be either a frame or a display name (a string).\n\
4762 If omitted or nil, that stands for the selected frame's display.")
4764 Lisp_Object display
;
4766 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4767 Display
*dpy
= dpyinfo
->display
;
4769 return Fcons (make_number (ProtocolVersion (dpy
)),
4770 Fcons (make_number (ProtocolRevision (dpy
)),
4771 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4774 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4775 "Returns the number of screens on the X server of display DISPLAY.\n\
4776 The optional argument DISPLAY specifies which display to ask about.\n\
4777 DISPLAY should be either a frame or a display name (a string).\n\
4778 If omitted or nil, that stands for the selected frame's display.")
4780 Lisp_Object display
;
4782 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4784 return make_number (ScreenCount (dpyinfo
->display
));
4787 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4788 "Returns the height in millimeters of the X display DISPLAY.\n\
4789 The optional argument DISPLAY specifies which display to ask about.\n\
4790 DISPLAY should be either a frame or a display name (a string).\n\
4791 If omitted or nil, that stands for the selected frame's display.")
4793 Lisp_Object display
;
4795 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4797 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4800 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4801 "Returns the width in millimeters of the X display DISPLAY.\n\
4802 The optional argument DISPLAY specifies which display to ask about.\n\
4803 DISPLAY should be either a frame or a display name (a string).\n\
4804 If omitted or nil, that stands for the selected frame's display.")
4806 Lisp_Object display
;
4808 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4810 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4813 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4814 Sx_display_backing_store
, 0, 1, 0,
4815 "Returns an indication of whether X display DISPLAY does backing store.\n\
4816 The value may be `always', `when-mapped', or `not-useful'.\n\
4817 The optional argument DISPLAY specifies which display to ask about.\n\
4818 DISPLAY should be either a frame or a display name (a string).\n\
4819 If omitted or nil, that stands for the selected frame's display.")
4821 Lisp_Object display
;
4823 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4826 switch (DoesBackingStore (dpyinfo
->screen
))
4829 result
= intern ("always");
4833 result
= intern ("when-mapped");
4837 result
= intern ("not-useful");
4841 error ("Strange value for BackingStore parameter of screen");
4848 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4849 Sx_display_visual_class
, 0, 1, 0,
4850 "Returns the visual class of the X display DISPLAY.\n\
4851 The value is one of the symbols `static-gray', `gray-scale',\n\
4852 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4853 The optional argument DISPLAY specifies which display to ask about.\n\
4854 DISPLAY should be either a frame or a display name (a string).\n\
4855 If omitted or nil, that stands for the selected frame's display.")
4857 Lisp_Object display
;
4859 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4862 switch (dpyinfo
->visual
->class)
4865 result
= intern ("static-gray");
4868 result
= intern ("gray-scale");
4871 result
= intern ("static-color");
4874 result
= intern ("pseudo-color");
4877 result
= intern ("true-color");
4880 result
= intern ("direct-color");
4883 error ("Display has an unknown visual class");
4890 DEFUN ("x-display-save-under", Fx_display_save_under
,
4891 Sx_display_save_under
, 0, 1, 0,
4892 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4893 The optional argument DISPLAY specifies which display to ask about.\n\
4894 DISPLAY should be either a frame or a display name (a string).\n\
4895 If omitted or nil, that stands for the selected frame's display.")
4897 Lisp_Object display
;
4899 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4901 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4909 register struct frame
*f
;
4911 return PIXEL_WIDTH (f
);
4916 register struct frame
*f
;
4918 return PIXEL_HEIGHT (f
);
4923 register struct frame
*f
;
4925 return FONT_WIDTH (f
->output_data
.x
->font
);
4930 register struct frame
*f
;
4932 return f
->output_data
.x
->line_height
;
4937 register struct frame
*f
;
4939 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4944 /************************************************************************
4946 ************************************************************************/
4949 /* Mapping visual names to visuals. */
4951 static struct visual_class
4958 {"StaticGray", StaticGray
},
4959 {"GrayScale", GrayScale
},
4960 {"StaticColor", StaticColor
},
4961 {"PseudoColor", PseudoColor
},
4962 {"TrueColor", TrueColor
},
4963 {"DirectColor", DirectColor
},
4968 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4970 /* Value is the screen number of screen SCR. This is a substitute for
4971 the X function with the same name when that doesn't exist. */
4974 XScreenNumberOfScreen (scr
)
4975 register Screen
*scr
;
4977 Display
*dpy
= scr
->display
;
4980 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4981 if (scr
== dpy
->screens
[i
])
4987 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4990 /* Select the visual that should be used on display DPYINFO. Set
4991 members of DPYINFO appropriately. Called from x_term_init. */
4994 select_visual (dpyinfo
)
4995 struct x_display_info
*dpyinfo
;
4997 Display
*dpy
= dpyinfo
->display
;
4998 Screen
*screen
= dpyinfo
->screen
;
5001 /* See if a visual is specified. */
5002 value
= display_x_get_resource (dpyinfo
,
5003 build_string ("visualClass"),
5004 build_string ("VisualClass"),
5006 if (STRINGP (value
))
5008 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
5009 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
5010 depth, a decimal number. NAME is compared with case ignored. */
5011 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
5016 strcpy (s
, XSTRING (value
)->data
);
5017 dash
= index (s
, '-');
5020 dpyinfo
->n_planes
= atoi (dash
+ 1);
5024 /* We won't find a matching visual with depth 0, so that
5025 an error will be printed below. */
5026 dpyinfo
->n_planes
= 0;
5028 /* Determine the visual class. */
5029 for (i
= 0; visual_classes
[i
].name
; ++i
)
5030 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
5032 class = visual_classes
[i
].class;
5036 /* Look up a matching visual for the specified class. */
5038 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
5039 dpyinfo
->n_planes
, class, &vinfo
))
5040 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
5042 dpyinfo
->visual
= vinfo
.visual
;
5047 XVisualInfo
*vinfo
, vinfo_template
;
5049 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
5052 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
5054 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
5056 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5057 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
5058 &vinfo_template
, &n_visuals
);
5060 fatal ("Can't get proper X visual info");
5062 dpyinfo
->n_planes
= vinfo
->depth
;
5063 XFree ((char *) vinfo
);
5068 /* Return the X display structure for the display named NAME.
5069 Open a new connection if necessary. */
5071 struct x_display_info
*
5072 x_display_info_for_name (name
)
5076 struct x_display_info
*dpyinfo
;
5078 CHECK_STRING (name
, 0);
5080 if (! EQ (Vwindow_system
, intern ("x")))
5081 error ("Not using X Windows");
5083 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5085 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5088 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5093 /* Use this general default value to start with. */
5094 Vx_resource_name
= Vinvocation_name
;
5096 validate_x_resource_name ();
5098 dpyinfo
= x_term_init (name
, (char *)0,
5099 (char *) XSTRING (Vx_resource_name
)->data
);
5102 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5105 XSETFASTINT (Vwindow_system_version
, 11);
5111 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5112 1, 3, 0, "Open a connection to an X server.\n\
5113 DISPLAY is the name of the display to connect to.\n\
5114 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5115 If the optional third arg MUST-SUCCEED is non-nil,\n\
5116 terminate Emacs if we can't open the connection.")
5117 (display
, xrm_string
, must_succeed
)
5118 Lisp_Object display
, xrm_string
, must_succeed
;
5120 unsigned char *xrm_option
;
5121 struct x_display_info
*dpyinfo
;
5123 CHECK_STRING (display
, 0);
5124 if (! NILP (xrm_string
))
5125 CHECK_STRING (xrm_string
, 1);
5127 if (! EQ (Vwindow_system
, intern ("x")))
5128 error ("Not using X Windows");
5130 if (! NILP (xrm_string
))
5131 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5133 xrm_option
= (unsigned char *) 0;
5135 validate_x_resource_name ();
5137 /* This is what opens the connection and sets x_current_display.
5138 This also initializes many symbols, such as those used for input. */
5139 dpyinfo
= x_term_init (display
, xrm_option
,
5140 (char *) XSTRING (Vx_resource_name
)->data
);
5144 if (!NILP (must_succeed
))
5145 fatal ("Cannot connect to X server %s.\n\
5146 Check the DISPLAY environment variable or use `-d'.\n\
5147 Also use the `xhost' program to verify that it is set to permit\n\
5148 connections from your machine.\n",
5149 XSTRING (display
)->data
);
5151 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5156 XSETFASTINT (Vwindow_system_version
, 11);
5160 DEFUN ("x-close-connection", Fx_close_connection
,
5161 Sx_close_connection
, 1, 1, 0,
5162 "Close the connection to DISPLAY's X server.\n\
5163 For DISPLAY, specify either a frame or a display name (a string).\n\
5164 If DISPLAY is nil, that stands for the selected frame's display.")
5166 Lisp_Object display
;
5168 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5171 if (dpyinfo
->reference_count
> 0)
5172 error ("Display still has frames on it");
5175 /* Free the fonts in the font table. */
5176 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5177 if (dpyinfo
->font_table
[i
].name
)
5179 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
5180 xfree (dpyinfo
->font_table
[i
].full_name
);
5181 xfree (dpyinfo
->font_table
[i
].name
);
5182 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5185 x_destroy_all_bitmaps (dpyinfo
);
5186 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5188 #ifdef USE_X_TOOLKIT
5189 XtCloseDisplay (dpyinfo
->display
);
5191 XCloseDisplay (dpyinfo
->display
);
5194 x_delete_display (dpyinfo
);
5200 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5201 "Return the list of display names that Emacs has connections to.")
5204 Lisp_Object tail
, result
;
5207 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5208 result
= Fcons (XCAR (XCAR (tail
)), result
);
5213 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5214 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5215 If ON is nil, allow buffering of requests.\n\
5216 Turning on synchronization prohibits the Xlib routines from buffering\n\
5217 requests and seriously degrades performance, but makes debugging much\n\
5219 The optional second argument DISPLAY specifies which display to act on.\n\
5220 DISPLAY should be either a frame or a display name (a string).\n\
5221 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5223 Lisp_Object display
, on
;
5225 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5227 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5232 /* Wait for responses to all X commands issued so far for frame F. */
5239 XSync (FRAME_X_DISPLAY (f
), False
);
5244 /***********************************************************************
5246 ***********************************************************************/
5248 /* Value is the number of elements of vector VECTOR. */
5250 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5252 /* List of supported image types. Use define_image_type to add new
5253 types. Use lookup_image_type to find a type for a given symbol. */
5255 static struct image_type
*image_types
;
5257 /* The symbol `image' which is the car of the lists used to represent
5260 extern Lisp_Object Qimage
;
5262 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5268 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5269 extern Lisp_Object QCdata
;
5270 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
5271 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
5272 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5274 /* Other symbols. */
5276 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5278 /* Time in seconds after which images should be removed from the cache
5279 if not displayed. */
5281 Lisp_Object Vimage_cache_eviction_delay
;
5283 /* Function prototypes. */
5285 static void define_image_type
P_ ((struct image_type
*type
));
5286 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5287 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5288 static void x_laplace
P_ ((struct frame
*, struct image
*));
5289 static void x_emboss
P_ ((struct frame
*, struct image
*));
5290 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5294 /* Define a new image type from TYPE. This adds a copy of TYPE to
5295 image_types and adds the symbol *TYPE->type to Vimage_types. */
5298 define_image_type (type
)
5299 struct image_type
*type
;
5301 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5302 The initialized data segment is read-only. */
5303 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5304 bcopy (type
, p
, sizeof *p
);
5305 p
->next
= image_types
;
5307 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5311 /* Look up image type SYMBOL, and return a pointer to its image_type
5312 structure. Value is null if SYMBOL is not a known image type. */
5314 static INLINE
struct image_type
*
5315 lookup_image_type (symbol
)
5318 struct image_type
*type
;
5320 for (type
= image_types
; type
; type
= type
->next
)
5321 if (EQ (symbol
, *type
->type
))
5328 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5329 valid image specification is a list whose car is the symbol
5330 `image', and whose rest is a property list. The property list must
5331 contain a value for key `:type'. That value must be the name of a
5332 supported image type. The rest of the property list depends on the
5336 valid_image_p (object
)
5341 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5345 for (tem
= XCDR (object
); CONSP (tem
); tem
= XCDR (tem
))
5346 if (EQ (XCAR (tem
), QCtype
))
5349 if (CONSP (tem
) && SYMBOLP (XCAR (tem
)))
5351 struct image_type
*type
;
5352 type
= lookup_image_type (XCAR (tem
));
5354 valid_p
= type
->valid_p (object
);
5365 /* Log error message with format string FORMAT and argument ARG.
5366 Signaling an error, e.g. when an image cannot be loaded, is not a
5367 good idea because this would interrupt redisplay, and the error
5368 message display would lead to another redisplay. This function
5369 therefore simply displays a message. */
5372 image_error (format
, arg1
, arg2
)
5374 Lisp_Object arg1
, arg2
;
5376 add_to_log (format
, arg1
, arg2
);
5381 /***********************************************************************
5382 Image specifications
5383 ***********************************************************************/
5385 enum image_value_type
5387 IMAGE_DONT_CHECK_VALUE_TYPE
,
5389 IMAGE_STRING_OR_NIL_VALUE
,
5391 IMAGE_POSITIVE_INTEGER_VALUE
,
5392 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
5393 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5395 IMAGE_INTEGER_VALUE
,
5396 IMAGE_FUNCTION_VALUE
,
5401 /* Structure used when parsing image specifications. */
5403 struct image_keyword
5405 /* Name of keyword. */
5408 /* The type of value allowed. */
5409 enum image_value_type type
;
5411 /* Non-zero means key must be present. */
5414 /* Used to recognize duplicate keywords in a property list. */
5417 /* The value that was found. */
5422 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5424 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5427 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5428 has the format (image KEYWORD VALUE ...). One of the keyword/
5429 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5430 image_keywords structures of size NKEYWORDS describing other
5431 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5434 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5436 struct image_keyword
*keywords
;
5443 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5446 plist
= XCDR (spec
);
5447 while (CONSP (plist
))
5449 Lisp_Object key
, value
;
5451 /* First element of a pair must be a symbol. */
5453 plist
= XCDR (plist
);
5457 /* There must follow a value. */
5460 value
= XCAR (plist
);
5461 plist
= XCDR (plist
);
5463 /* Find key in KEYWORDS. Error if not found. */
5464 for (i
= 0; i
< nkeywords
; ++i
)
5465 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5471 /* Record that we recognized the keyword. If a keywords
5472 was found more than once, it's an error. */
5473 keywords
[i
].value
= value
;
5474 ++keywords
[i
].count
;
5476 if (keywords
[i
].count
> 1)
5479 /* Check type of value against allowed type. */
5480 switch (keywords
[i
].type
)
5482 case IMAGE_STRING_VALUE
:
5483 if (!STRINGP (value
))
5487 case IMAGE_STRING_OR_NIL_VALUE
:
5488 if (!STRINGP (value
) && !NILP (value
))
5492 case IMAGE_SYMBOL_VALUE
:
5493 if (!SYMBOLP (value
))
5497 case IMAGE_POSITIVE_INTEGER_VALUE
:
5498 if (!INTEGERP (value
) || XINT (value
) <= 0)
5502 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
5503 if (INTEGERP (value
) && XINT (value
) >= 0)
5506 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
5507 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
5511 case IMAGE_ASCENT_VALUE
:
5512 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5514 else if (INTEGERP (value
)
5515 && XINT (value
) >= 0
5516 && XINT (value
) <= 100)
5520 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5521 if (!INTEGERP (value
) || XINT (value
) < 0)
5525 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5528 case IMAGE_FUNCTION_VALUE
:
5529 value
= indirect_function (value
);
5531 || COMPILEDP (value
)
5532 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5536 case IMAGE_NUMBER_VALUE
:
5537 if (!INTEGERP (value
) && !FLOATP (value
))
5541 case IMAGE_INTEGER_VALUE
:
5542 if (!INTEGERP (value
))
5546 case IMAGE_BOOL_VALUE
:
5547 if (!NILP (value
) && !EQ (value
, Qt
))
5556 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5560 /* Check that all mandatory fields are present. */
5561 for (i
= 0; i
< nkeywords
; ++i
)
5562 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5565 return NILP (plist
);
5569 /* Return the value of KEY in image specification SPEC. Value is nil
5570 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5571 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5574 image_spec_value (spec
, key
, found
)
5575 Lisp_Object spec
, key
;
5580 xassert (valid_image_p (spec
));
5582 for (tail
= XCDR (spec
);
5583 CONSP (tail
) && CONSP (XCDR (tail
));
5584 tail
= XCDR (XCDR (tail
)))
5586 if (EQ (XCAR (tail
), key
))
5590 return XCAR (XCDR (tail
));
5600 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5601 "Return the size of image SPEC as pair (WIDTH . HEIGHT).\n\
5602 PIXELS non-nil means return the size in pixels, otherwise return the\n\
5603 size in canonical character units.\n\
5604 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5605 or omitted means use the selected frame.")
5606 (spec
, pixels
, frame
)
5607 Lisp_Object spec
, pixels
, frame
;
5612 if (valid_image_p (spec
))
5614 struct frame
*f
= check_x_frame (frame
);
5615 int id
= lookup_image (f
, spec
);
5616 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5617 int width
= img
->width
+ 2 * img
->hmargin
;
5618 int height
= img
->height
+ 2 * img
->vmargin
;
5621 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5622 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5624 size
= Fcons (make_number (width
), make_number (height
));
5627 error ("Invalid image specification");
5633 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5634 "Return t if image SPEC has a mask bitmap.\n\
5635 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5636 or omitted means use the selected frame.")
5638 Lisp_Object spec
, frame
;
5643 if (valid_image_p (spec
))
5645 struct frame
*f
= check_x_frame (frame
);
5646 int id
= lookup_image (f
, spec
);
5647 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5652 error ("Invalid image specification");
5659 /***********************************************************************
5660 Image type independent image structures
5661 ***********************************************************************/
5663 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5664 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5667 /* Allocate and return a new image structure for image specification
5668 SPEC. SPEC has a hash value of HASH. */
5670 static struct image
*
5671 make_image (spec
, hash
)
5675 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5677 xassert (valid_image_p (spec
));
5678 bzero (img
, sizeof *img
);
5679 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5680 xassert (img
->type
!= NULL
);
5682 img
->data
.lisp_val
= Qnil
;
5683 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5689 /* Free image IMG which was used on frame F, including its resources. */
5698 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5700 /* Remove IMG from the hash table of its cache. */
5702 img
->prev
->next
= img
->next
;
5704 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5707 img
->next
->prev
= img
->prev
;
5709 c
->images
[img
->id
] = NULL
;
5711 /* Free resources, then free IMG. */
5712 img
->type
->free (f
, img
);
5718 /* Prepare image IMG for display on frame F. Must be called before
5719 drawing an image. */
5722 prepare_image_for_display (f
, img
)
5728 /* We're about to display IMG, so set its timestamp to `now'. */
5730 img
->timestamp
= EMACS_SECS (t
);
5732 /* If IMG doesn't have a pixmap yet, load it now, using the image
5733 type dependent loader function. */
5734 if (img
->pixmap
== None
&& !img
->load_failed_p
)
5735 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5739 /* Value is the number of pixels for the ascent of image IMG when
5740 drawn in face FACE. */
5743 image_ascent (img
, face
)
5747 int height
= img
->height
+ img
->vmargin
;
5750 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5753 /* This expression is arranged so that if the image can't be
5754 exactly centered, it will be moved slightly up. This is
5755 because a typical font is `top-heavy' (due to the presence
5756 uppercase letters), so the image placement should err towards
5757 being top-heavy too. It also just generally looks better. */
5758 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
5760 ascent
= height
/ 2;
5763 ascent
= height
* img
->ascent
/ 100.0;
5770 /***********************************************************************
5771 Helper functions for X image types
5772 ***********************************************************************/
5774 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
5776 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5777 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5779 Lisp_Object color_name
,
5780 unsigned long dflt
));
5783 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5784 free the pixmap if any. MASK_P non-zero means clear the mask
5785 pixmap if any. COLORS_P non-zero means free colors allocated for
5786 the image, if any. */
5789 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
5792 int pixmap_p
, mask_p
, colors_p
;
5794 if (pixmap_p
&& img
->pixmap
)
5796 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5800 if (mask_p
&& img
->mask
)
5802 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5806 if (colors_p
&& img
->ncolors
)
5808 x_free_colors (f
, img
->colors
, img
->ncolors
);
5809 xfree (img
->colors
);
5815 /* Free X resources of image IMG which is used on frame F. */
5818 x_clear_image (f
, img
)
5823 x_clear_image_1 (f
, img
, 1, 1, 1);
5828 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5829 cannot be allocated, use DFLT. Add a newly allocated color to
5830 IMG->colors, so that it can be freed again. Value is the pixel
5833 static unsigned long
5834 x_alloc_image_color (f
, img
, color_name
, dflt
)
5837 Lisp_Object color_name
;
5841 unsigned long result
;
5843 xassert (STRINGP (color_name
));
5845 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5847 /* This isn't called frequently so we get away with simply
5848 reallocating the color vector to the needed size, here. */
5851 (unsigned long *) xrealloc (img
->colors
,
5852 img
->ncolors
* sizeof *img
->colors
);
5853 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5854 result
= color
.pixel
;
5864 /***********************************************************************
5866 ***********************************************************************/
5868 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5869 static void postprocess_image
P_ ((struct frame
*, struct image
*));
5872 /* Return a new, initialized image cache that is allocated from the
5873 heap. Call free_image_cache to free an image cache. */
5875 struct image_cache
*
5878 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5881 bzero (c
, sizeof *c
);
5883 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5884 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5885 c
->buckets
= (struct image
**) xmalloc (size
);
5886 bzero (c
->buckets
, size
);
5891 /* Free image cache of frame F. Be aware that X frames share images
5895 free_image_cache (f
)
5898 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5903 /* Cache should not be referenced by any frame when freed. */
5904 xassert (c
->refcount
== 0);
5906 for (i
= 0; i
< c
->used
; ++i
)
5907 free_image (f
, c
->images
[i
]);
5911 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5916 /* Clear image cache of frame F. FORCE_P non-zero means free all
5917 images. FORCE_P zero means clear only images that haven't been
5918 displayed for some time. Should be called from time to time to
5919 reduce the number of loaded images. If image-eviction-seconds is
5920 non-nil, this frees images in the cache which weren't displayed for
5921 at least that many seconds. */
5924 clear_image_cache (f
, force_p
)
5928 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5930 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5937 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5939 /* Block input so that we won't be interrupted by a SIGIO
5940 while being in an inconsistent state. */
5943 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
5945 struct image
*img
= c
->images
[i
];
5947 && (force_p
|| img
->timestamp
< old
))
5949 free_image (f
, img
);
5954 /* We may be clearing the image cache because, for example,
5955 Emacs was iconified for a longer period of time. In that
5956 case, current matrices may still contain references to
5957 images freed above. So, clear these matrices. */
5960 Lisp_Object tail
, frame
;
5962 FOR_EACH_FRAME (tail
, frame
)
5964 struct frame
*f
= XFRAME (frame
);
5966 && FRAME_X_IMAGE_CACHE (f
) == c
)
5967 clear_current_matrices (f
);
5970 ++windows_or_buffers_changed
;
5978 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5980 "Clear the image cache of FRAME.\n\
5981 FRAME nil or omitted means use the selected frame.\n\
5982 FRAME t means clear the image caches of all frames.")
5990 FOR_EACH_FRAME (tail
, frame
)
5991 if (FRAME_X_P (XFRAME (frame
)))
5992 clear_image_cache (XFRAME (frame
), 1);
5995 clear_image_cache (check_x_frame (frame
), 1);
6001 /* Compute masks and transform image IMG on frame F, as specified
6002 by the image's specification, */
6005 postprocess_image (f
, img
)
6009 /* Manipulation of the image's mask. */
6012 Lisp_Object conversion
, spec
;
6017 /* `:heuristic-mask t'
6019 means build a mask heuristically.
6020 `:heuristic-mask (R G B)'
6021 `:mask (heuristic (R G B))'
6022 means build a mask from color (R G B) in the
6025 means remove a mask, if any. */
6027 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6029 x_build_heuristic_mask (f
, img
, mask
);
6034 mask
= image_spec_value (spec
, QCmask
, &found_p
);
6036 if (EQ (mask
, Qheuristic
))
6037 x_build_heuristic_mask (f
, img
, Qt
);
6038 else if (CONSP (mask
)
6039 && EQ (XCAR (mask
), Qheuristic
))
6041 if (CONSP (XCDR (mask
)))
6042 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
6044 x_build_heuristic_mask (f
, img
, XCDR (mask
));
6046 else if (NILP (mask
) && found_p
&& img
->mask
)
6048 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6054 /* Should we apply an image transformation algorithm? */
6055 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
6056 if (EQ (conversion
, Qdisabled
))
6057 x_disable_image (f
, img
);
6058 else if (EQ (conversion
, Qlaplace
))
6060 else if (EQ (conversion
, Qemboss
))
6062 else if (CONSP (conversion
)
6063 && EQ (XCAR (conversion
), Qedge_detection
))
6066 tem
= XCDR (conversion
);
6068 x_edge_detection (f
, img
,
6069 Fplist_get (tem
, QCmatrix
),
6070 Fplist_get (tem
, QCcolor_adjustment
));
6076 /* Return the id of image with Lisp specification SPEC on frame F.
6077 SPEC must be a valid Lisp image specification (see valid_image_p). */
6080 lookup_image (f
, spec
)
6084 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6088 struct gcpro gcpro1
;
6091 /* F must be a window-system frame, and SPEC must be a valid image
6093 xassert (FRAME_WINDOW_P (f
));
6094 xassert (valid_image_p (spec
));
6098 /* Look up SPEC in the hash table of the image cache. */
6099 hash
= sxhash (spec
, 0);
6100 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6102 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6103 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6106 /* If not found, create a new image and cache it. */
6109 extern Lisp_Object Qpostscript
;
6112 img
= make_image (spec
, hash
);
6113 cache_image (f
, img
);
6114 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6116 /* If we can't load the image, and we don't have a width and
6117 height, use some arbitrary width and height so that we can
6118 draw a rectangle for it. */
6119 if (img
->load_failed_p
)
6123 value
= image_spec_value (spec
, QCwidth
, NULL
);
6124 img
->width
= (INTEGERP (value
)
6125 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6126 value
= image_spec_value (spec
, QCheight
, NULL
);
6127 img
->height
= (INTEGERP (value
)
6128 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6132 /* Handle image type independent image attributes
6133 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
6134 Lisp_Object ascent
, margin
, relief
;
6136 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6137 if (INTEGERP (ascent
))
6138 img
->ascent
= XFASTINT (ascent
);
6139 else if (EQ (ascent
, Qcenter
))
6140 img
->ascent
= CENTERED_IMAGE_ASCENT
;
6142 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6143 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6144 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
6145 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
6146 && INTEGERP (XCDR (margin
)))
6148 if (XINT (XCAR (margin
)) > 0)
6149 img
->hmargin
= XFASTINT (XCAR (margin
));
6150 if (XINT (XCDR (margin
)) > 0)
6151 img
->vmargin
= XFASTINT (XCDR (margin
));
6154 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6155 if (INTEGERP (relief
))
6157 img
->relief
= XINT (relief
);
6158 img
->hmargin
+= abs (img
->relief
);
6159 img
->vmargin
+= abs (img
->relief
);
6162 /* Do image transformations and compute masks, unless we
6163 don't have the image yet. */
6164 if (!EQ (*img
->type
->type
, Qpostscript
))
6165 postprocess_image (f
, img
);
6169 xassert (!interrupt_input_blocked
);
6172 /* We're using IMG, so set its timestamp to `now'. */
6173 EMACS_GET_TIME (now
);
6174 img
->timestamp
= EMACS_SECS (now
);
6178 /* Value is the image id. */
6183 /* Cache image IMG in the image cache of frame F. */
6186 cache_image (f
, img
)
6190 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6193 /* Find a free slot in c->images. */
6194 for (i
= 0; i
< c
->used
; ++i
)
6195 if (c
->images
[i
] == NULL
)
6198 /* If no free slot found, maybe enlarge c->images. */
6199 if (i
== c
->used
&& c
->used
== c
->size
)
6202 c
->images
= (struct image
**) xrealloc (c
->images
,
6203 c
->size
* sizeof *c
->images
);
6206 /* Add IMG to c->images, and assign IMG an id. */
6212 /* Add IMG to the cache's hash table. */
6213 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6214 img
->next
= c
->buckets
[i
];
6216 img
->next
->prev
= img
;
6218 c
->buckets
[i
] = img
;
6222 /* Call FN on every image in the image cache of frame F. Used to mark
6223 Lisp Objects in the image cache. */
6226 forall_images_in_image_cache (f
, fn
)
6228 void (*fn
) P_ ((struct image
*img
));
6230 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6232 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6236 for (i
= 0; i
< c
->used
; ++i
)
6245 /***********************************************************************
6247 ***********************************************************************/
6249 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6250 XImage
**, Pixmap
*));
6251 static void x_destroy_x_image
P_ ((XImage
*));
6252 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6255 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6256 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6257 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6258 via xmalloc. Print error messages via image_error if an error
6259 occurs. Value is non-zero if successful. */
6262 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6264 int width
, height
, depth
;
6268 Display
*display
= FRAME_X_DISPLAY (f
);
6269 Screen
*screen
= FRAME_X_SCREEN (f
);
6270 Window window
= FRAME_X_WINDOW (f
);
6272 xassert (interrupt_input_blocked
);
6275 depth
= DefaultDepthOfScreen (screen
);
6276 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6277 depth
, ZPixmap
, 0, NULL
, width
, height
,
6278 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6281 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6285 /* Allocate image raster. */
6286 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6288 /* Allocate a pixmap of the same size. */
6289 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6290 if (*pixmap
== None
)
6292 x_destroy_x_image (*ximg
);
6294 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6302 /* Destroy XImage XIMG. Free XIMG->data. */
6305 x_destroy_x_image (ximg
)
6308 xassert (interrupt_input_blocked
);
6313 XDestroyImage (ximg
);
6318 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6319 are width and height of both the image and pixmap. */
6322 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6329 xassert (interrupt_input_blocked
);
6330 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6331 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6332 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6337 /***********************************************************************
6339 ***********************************************************************/
6341 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6342 static char *slurp_file
P_ ((char *, int *));
6345 /* Find image file FILE. Look in data-directory, then
6346 x-bitmap-file-path. Value is the full name of the file found, or
6347 nil if not found. */
6350 x_find_image_file (file
)
6353 Lisp_Object file_found
, search_path
;
6354 struct gcpro gcpro1
, gcpro2
;
6358 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6359 GCPRO2 (file_found
, search_path
);
6361 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6362 fd
= openp (search_path
, file
, Qnil
, &file_found
, 0);
6374 /* Read FILE into memory. Value is a pointer to a buffer allocated
6375 with xmalloc holding FILE's contents. Value is null if an error
6376 occurred. *SIZE is set to the size of the file. */
6379 slurp_file (file
, size
)
6387 if (stat (file
, &st
) == 0
6388 && (fp
= fopen (file
, "r")) != NULL
6389 && (buf
= (char *) xmalloc (st
.st_size
),
6390 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6411 /***********************************************************************
6413 ***********************************************************************/
6415 static int xbm_scan
P_ ((char **, char *, char *, int *));
6416 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6417 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6419 static int xbm_image_p
P_ ((Lisp_Object object
));
6420 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6422 static int xbm_file_p
P_ ((Lisp_Object
));
6425 /* Indices of image specification fields in xbm_format, below. */
6427 enum xbm_keyword_index
6445 /* Vector of image_keyword structures describing the format
6446 of valid XBM image specifications. */
6448 static struct image_keyword xbm_format
[XBM_LAST
] =
6450 {":type", IMAGE_SYMBOL_VALUE
, 1},
6451 {":file", IMAGE_STRING_VALUE
, 0},
6452 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6453 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6454 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6455 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
6456 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0},
6457 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6458 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6459 {":relief", IMAGE_INTEGER_VALUE
, 0},
6460 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6461 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6462 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6465 /* Structure describing the image type XBM. */
6467 static struct image_type xbm_type
=
6476 /* Tokens returned from xbm_scan. */
6485 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6486 A valid specification is a list starting with the symbol `image'
6487 The rest of the list is a property list which must contain an
6490 If the specification specifies a file to load, it must contain
6491 an entry `:file FILENAME' where FILENAME is a string.
6493 If the specification is for a bitmap loaded from memory it must
6494 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6495 WIDTH and HEIGHT are integers > 0. DATA may be:
6497 1. a string large enough to hold the bitmap data, i.e. it must
6498 have a size >= (WIDTH + 7) / 8 * HEIGHT
6500 2. a bool-vector of size >= WIDTH * HEIGHT
6502 3. a vector of strings or bool-vectors, one for each line of the
6505 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6506 may not be specified in this case because they are defined in the
6509 Both the file and data forms may contain the additional entries
6510 `:background COLOR' and `:foreground COLOR'. If not present,
6511 foreground and background of the frame on which the image is
6512 displayed is used. */
6515 xbm_image_p (object
)
6518 struct image_keyword kw
[XBM_LAST
];
6520 bcopy (xbm_format
, kw
, sizeof kw
);
6521 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6524 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6526 if (kw
[XBM_FILE
].count
)
6528 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6531 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6533 /* In-memory XBM file. */
6534 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6542 /* Entries for `:width', `:height' and `:data' must be present. */
6543 if (!kw
[XBM_WIDTH
].count
6544 || !kw
[XBM_HEIGHT
].count
6545 || !kw
[XBM_DATA
].count
)
6548 data
= kw
[XBM_DATA
].value
;
6549 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6550 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6552 /* Check type of data, and width and height against contents of
6558 /* Number of elements of the vector must be >= height. */
6559 if (XVECTOR (data
)->size
< height
)
6562 /* Each string or bool-vector in data must be large enough
6563 for one line of the image. */
6564 for (i
= 0; i
< height
; ++i
)
6566 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6570 if (XSTRING (elt
)->size
6571 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6574 else if (BOOL_VECTOR_P (elt
))
6576 if (XBOOL_VECTOR (elt
)->size
< width
)
6583 else if (STRINGP (data
))
6585 if (XSTRING (data
)->size
6586 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6589 else if (BOOL_VECTOR_P (data
))
6591 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6602 /* Scan a bitmap file. FP is the stream to read from. Value is
6603 either an enumerator from enum xbm_token, or a character for a
6604 single-character token, or 0 at end of file. If scanning an
6605 identifier, store the lexeme of the identifier in SVAL. If
6606 scanning a number, store its value in *IVAL. */
6609 xbm_scan (s
, end
, sval
, ival
)
6618 /* Skip white space. */
6619 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6624 else if (isdigit (c
))
6626 int value
= 0, digit
;
6628 if (c
== '0' && *s
< end
)
6631 if (c
== 'x' || c
== 'X')
6638 else if (c
>= 'a' && c
<= 'f')
6639 digit
= c
- 'a' + 10;
6640 else if (c
>= 'A' && c
<= 'F')
6641 digit
= c
- 'A' + 10;
6644 value
= 16 * value
+ digit
;
6647 else if (isdigit (c
))
6651 && (c
= *(*s
)++, isdigit (c
)))
6652 value
= 8 * value
+ c
- '0';
6659 && (c
= *(*s
)++, isdigit (c
)))
6660 value
= 10 * value
+ c
- '0';
6668 else if (isalpha (c
) || c
== '_')
6672 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6679 else if (c
== '/' && **s
== '*')
6681 /* C-style comment. */
6683 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
6696 /* Replacement for XReadBitmapFileData which isn't available under old
6697 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6698 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6699 the image. Return in *DATA the bitmap data allocated with xmalloc.
6700 Value is non-zero if successful. DATA null means just test if
6701 CONTENTS looks like an in-memory XBM file. */
6704 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6705 char *contents
, *end
;
6706 int *width
, *height
;
6707 unsigned char **data
;
6710 char buffer
[BUFSIZ
];
6713 int bytes_per_line
, i
, nbytes
;
6719 LA1 = xbm_scan (&s, end, buffer, &value)
6721 #define expect(TOKEN) \
6722 if (LA1 != (TOKEN)) \
6727 #define expect_ident(IDENT) \
6728 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6733 *width
= *height
= -1;
6736 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6738 /* Parse defines for width, height and hot-spots. */
6742 expect_ident ("define");
6743 expect (XBM_TK_IDENT
);
6745 if (LA1
== XBM_TK_NUMBER
);
6747 char *p
= strrchr (buffer
, '_');
6748 p
= p
? p
+ 1 : buffer
;
6749 if (strcmp (p
, "width") == 0)
6751 else if (strcmp (p
, "height") == 0)
6754 expect (XBM_TK_NUMBER
);
6757 if (*width
< 0 || *height
< 0)
6759 else if (data
== NULL
)
6762 /* Parse bits. Must start with `static'. */
6763 expect_ident ("static");
6764 if (LA1
== XBM_TK_IDENT
)
6766 if (strcmp (buffer
, "unsigned") == 0)
6769 expect_ident ("char");
6771 else if (strcmp (buffer
, "short") == 0)
6775 if (*width
% 16 && *width
% 16 < 9)
6778 else if (strcmp (buffer
, "char") == 0)
6786 expect (XBM_TK_IDENT
);
6792 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6793 nbytes
= bytes_per_line
* *height
;
6794 p
= *data
= (char *) xmalloc (nbytes
);
6798 for (i
= 0; i
< nbytes
; i
+= 2)
6801 expect (XBM_TK_NUMBER
);
6804 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6807 if (LA1
== ',' || LA1
== '}')
6815 for (i
= 0; i
< nbytes
; ++i
)
6818 expect (XBM_TK_NUMBER
);
6822 if (LA1
== ',' || LA1
== '}')
6847 /* Load XBM image IMG which will be displayed on frame F from buffer
6848 CONTENTS. END is the end of the buffer. Value is non-zero if
6852 xbm_load_image (f
, img
, contents
, end
)
6855 char *contents
, *end
;
6858 unsigned char *data
;
6861 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6864 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6865 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6866 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6869 xassert (img
->width
> 0 && img
->height
> 0);
6871 /* Get foreground and background colors, maybe allocate colors. */
6872 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6874 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6876 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6878 background
= x_alloc_image_color (f
, img
, value
, background
);
6881 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6884 img
->width
, img
->height
,
6885 foreground
, background
,
6889 if (img
->pixmap
== None
)
6891 x_clear_image (f
, img
);
6892 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
6898 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6904 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6911 return (STRINGP (data
)
6912 && xbm_read_bitmap_data (XSTRING (data
)->data
,
6913 (XSTRING (data
)->data
6914 + STRING_BYTES (XSTRING (data
))),
6919 /* Fill image IMG which is used on frame F with pixmap data. Value is
6920 non-zero if successful. */
6928 Lisp_Object file_name
;
6930 xassert (xbm_image_p (img
->spec
));
6932 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6933 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6934 if (STRINGP (file_name
))
6939 struct gcpro gcpro1
;
6941 file
= x_find_image_file (file_name
);
6943 if (!STRINGP (file
))
6945 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
6950 contents
= slurp_file (XSTRING (file
)->data
, &size
);
6951 if (contents
== NULL
)
6953 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6958 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
6963 struct image_keyword fmt
[XBM_LAST
];
6966 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6967 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6970 int in_memory_file_p
= 0;
6972 /* See if data looks like an in-memory XBM file. */
6973 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
6974 in_memory_file_p
= xbm_file_p (data
);
6976 /* Parse the image specification. */
6977 bcopy (xbm_format
, fmt
, sizeof fmt
);
6978 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6981 /* Get specified width, and height. */
6982 if (!in_memory_file_p
)
6984 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6985 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6986 xassert (img
->width
> 0 && img
->height
> 0);
6989 /* Get foreground and background colors, maybe allocate colors. */
6990 if (fmt
[XBM_FOREGROUND
].count
6991 && STRINGP (fmt
[XBM_FOREGROUND
].value
))
6992 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6994 if (fmt
[XBM_BACKGROUND
].count
6995 && STRINGP (fmt
[XBM_BACKGROUND
].value
))
6996 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6999 if (in_memory_file_p
)
7000 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
7001 (XSTRING (data
)->data
7002 + STRING_BYTES (XSTRING (data
))));
7009 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
7011 p
= bits
= (char *) alloca (nbytes
* img
->height
);
7012 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
7014 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
7016 bcopy (XSTRING (line
)->data
, p
, nbytes
);
7018 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
7021 else if (STRINGP (data
))
7022 bits
= XSTRING (data
)->data
;
7024 bits
= XBOOL_VECTOR (data
)->data
;
7026 /* Create the pixmap. */
7027 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
7029 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7032 img
->width
, img
->height
,
7033 foreground
, background
,
7039 image_error ("Unable to create pixmap for XBM image `%s'",
7041 x_clear_image (f
, img
);
7051 /***********************************************************************
7053 ***********************************************************************/
7057 static int xpm_image_p
P_ ((Lisp_Object object
));
7058 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
7059 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
7061 #include "X11/xpm.h"
7063 /* The symbol `xpm' identifying XPM-format images. */
7067 /* Indices of image specification fields in xpm_format, below. */
7069 enum xpm_keyword_index
7084 /* Vector of image_keyword structures describing the format
7085 of valid XPM image specifications. */
7087 static struct image_keyword xpm_format
[XPM_LAST
] =
7089 {":type", IMAGE_SYMBOL_VALUE
, 1},
7090 {":file", IMAGE_STRING_VALUE
, 0},
7091 {":data", IMAGE_STRING_VALUE
, 0},
7092 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7093 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
7094 {":relief", IMAGE_INTEGER_VALUE
, 0},
7095 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7096 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7097 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7098 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7101 /* Structure describing the image type XBM. */
7103 static struct image_type xpm_type
=
7113 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
7114 functions for allocating image colors. Our own functions handle
7115 color allocation failures more gracefully than the ones on the XPM
7118 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
7119 #define ALLOC_XPM_COLORS
7122 #ifdef ALLOC_XPM_COLORS
7124 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
7125 static void xpm_free_color_cache
P_ ((void));
7126 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
7127 static int xpm_color_bucket
P_ ((char *));
7128 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
7131 /* An entry in a hash table used to cache color definitions of named
7132 colors. This cache is necessary to speed up XPM image loading in
7133 case we do color allocations ourselves. Without it, we would need
7134 a call to XParseColor per pixel in the image. */
7136 struct xpm_cached_color
7138 /* Next in collision chain. */
7139 struct xpm_cached_color
*next
;
7141 /* Color definition (RGB and pixel color). */
7148 /* The hash table used for the color cache, and its bucket vector
7151 #define XPM_COLOR_CACHE_BUCKETS 1001
7152 struct xpm_cached_color
**xpm_color_cache
;
7154 /* Initialize the color cache. */
7157 xpm_init_color_cache (f
, attrs
)
7159 XpmAttributes
*attrs
;
7161 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
7162 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
7163 memset (xpm_color_cache
, 0, nbytes
);
7164 init_color_table ();
7166 if (attrs
->valuemask
& XpmColorSymbols
)
7171 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
7172 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7173 attrs
->colorsymbols
[i
].value
, &color
))
7175 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
7177 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
7183 /* Free the color cache. */
7186 xpm_free_color_cache ()
7188 struct xpm_cached_color
*p
, *next
;
7191 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
7192 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
7198 xfree (xpm_color_cache
);
7199 xpm_color_cache
= NULL
;
7200 free_color_table ();
7204 /* Return the bucket index for color named COLOR_NAME in the color
7208 xpm_color_bucket (color_name
)
7214 for (s
= color_name
; *s
; ++s
)
7216 return h
%= XPM_COLOR_CACHE_BUCKETS
;
7220 /* On frame F, cache values COLOR for color with name COLOR_NAME.
7221 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7224 static struct xpm_cached_color
*
7225 xpm_cache_color (f
, color_name
, color
, bucket
)
7232 struct xpm_cached_color
*p
;
7235 bucket
= xpm_color_bucket (color_name
);
7237 nbytes
= sizeof *p
+ strlen (color_name
);
7238 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
7239 strcpy (p
->name
, color_name
);
7241 p
->next
= xpm_color_cache
[bucket
];
7242 xpm_color_cache
[bucket
] = p
;
7247 /* Look up color COLOR_NAME for frame F in the color cache. If found,
7248 return the cached definition in *COLOR. Otherwise, make a new
7249 entry in the cache and allocate the color. Value is zero if color
7250 allocation failed. */
7253 xpm_lookup_color (f
, color_name
, color
)
7258 struct xpm_cached_color
*p
;
7259 int h
= xpm_color_bucket (color_name
);
7261 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7262 if (strcmp (p
->name
, color_name
) == 0)
7267 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7270 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7272 p
= xpm_cache_color (f
, color_name
, color
, h
);
7279 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7280 CLOSURE is a pointer to the frame on which we allocate the
7281 color. Return in *COLOR the allocated color. Value is non-zero
7285 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7292 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7296 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7297 is a pointer to the frame on which we allocate the color. Value is
7298 non-zero if successful. */
7301 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7311 #endif /* ALLOC_XPM_COLORS */
7314 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7315 for XPM images. Such a list must consist of conses whose car and
7319 xpm_valid_color_symbols_p (color_symbols
)
7320 Lisp_Object color_symbols
;
7322 while (CONSP (color_symbols
))
7324 Lisp_Object sym
= XCAR (color_symbols
);
7326 || !STRINGP (XCAR (sym
))
7327 || !STRINGP (XCDR (sym
)))
7329 color_symbols
= XCDR (color_symbols
);
7332 return NILP (color_symbols
);
7336 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7339 xpm_image_p (object
)
7342 struct image_keyword fmt
[XPM_LAST
];
7343 bcopy (xpm_format
, fmt
, sizeof fmt
);
7344 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7345 /* Either `:file' or `:data' must be present. */
7346 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7347 /* Either no `:color-symbols' or it's a list of conses
7348 whose car and cdr are strings. */
7349 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7350 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7354 /* Load image IMG which will be displayed on frame F. Value is
7355 non-zero if successful. */
7363 XpmAttributes attrs
;
7364 Lisp_Object specified_file
, color_symbols
;
7366 /* Configure the XPM lib. Use the visual of frame F. Allocate
7367 close colors. Return colors allocated. */
7368 bzero (&attrs
, sizeof attrs
);
7369 attrs
.visual
= FRAME_X_VISUAL (f
);
7370 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7371 attrs
.valuemask
|= XpmVisual
;
7372 attrs
.valuemask
|= XpmColormap
;
7374 #ifdef ALLOC_XPM_COLORS
7375 /* Allocate colors with our own functions which handle
7376 failing color allocation more gracefully. */
7377 attrs
.color_closure
= f
;
7378 attrs
.alloc_color
= xpm_alloc_color
;
7379 attrs
.free_colors
= xpm_free_colors
;
7380 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7381 #else /* not ALLOC_XPM_COLORS */
7382 /* Let the XPM lib allocate colors. */
7383 attrs
.valuemask
|= XpmReturnAllocPixels
;
7384 #ifdef XpmAllocCloseColors
7385 attrs
.alloc_close_colors
= 1;
7386 attrs
.valuemask
|= XpmAllocCloseColors
;
7387 #else /* not XpmAllocCloseColors */
7388 attrs
.closeness
= 600;
7389 attrs
.valuemask
|= XpmCloseness
;
7390 #endif /* not XpmAllocCloseColors */
7391 #endif /* ALLOC_XPM_COLORS */
7393 /* If image specification contains symbolic color definitions, add
7394 these to `attrs'. */
7395 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7396 if (CONSP (color_symbols
))
7399 XpmColorSymbol
*xpm_syms
;
7402 attrs
.valuemask
|= XpmColorSymbols
;
7404 /* Count number of symbols. */
7405 attrs
.numsymbols
= 0;
7406 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7409 /* Allocate an XpmColorSymbol array. */
7410 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7411 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7412 bzero (xpm_syms
, size
);
7413 attrs
.colorsymbols
= xpm_syms
;
7415 /* Fill the color symbol array. */
7416 for (tail
= color_symbols
, i
= 0;
7418 ++i
, tail
= XCDR (tail
))
7420 Lisp_Object name
= XCAR (XCAR (tail
));
7421 Lisp_Object color
= XCDR (XCAR (tail
));
7422 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7423 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7424 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7425 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7429 /* Create a pixmap for the image, either from a file, or from a
7430 string buffer containing data in the same format as an XPM file. */
7431 #ifdef ALLOC_XPM_COLORS
7432 xpm_init_color_cache (f
, &attrs
);
7435 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7436 if (STRINGP (specified_file
))
7438 Lisp_Object file
= x_find_image_file (specified_file
);
7439 if (!STRINGP (file
))
7441 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7445 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7446 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7451 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7452 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7453 XSTRING (buffer
)->data
,
7454 &img
->pixmap
, &img
->mask
,
7458 if (rc
== XpmSuccess
)
7460 #ifdef ALLOC_XPM_COLORS
7461 img
->colors
= colors_in_color_table (&img
->ncolors
);
7462 #else /* not ALLOC_XPM_COLORS */
7465 img
->ncolors
= attrs
.nalloc_pixels
;
7466 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7467 * sizeof *img
->colors
);
7468 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7470 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7471 #ifdef DEBUG_X_COLORS
7472 register_color (img
->colors
[i
]);
7475 #endif /* not ALLOC_XPM_COLORS */
7477 img
->width
= attrs
.width
;
7478 img
->height
= attrs
.height
;
7479 xassert (img
->width
> 0 && img
->height
> 0);
7481 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7482 XpmFreeAttributes (&attrs
);
7489 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7492 case XpmFileInvalid
:
7493 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7497 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7500 case XpmColorFailed
:
7501 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7505 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7510 #ifdef ALLOC_XPM_COLORS
7511 xpm_free_color_cache ();
7513 return rc
== XpmSuccess
;
7516 #endif /* HAVE_XPM != 0 */
7519 /***********************************************************************
7521 ***********************************************************************/
7523 /* An entry in the color table mapping an RGB color to a pixel color. */
7528 unsigned long pixel
;
7530 /* Next in color table collision list. */
7531 struct ct_color
*next
;
7534 /* The bucket vector size to use. Must be prime. */
7538 /* Value is a hash of the RGB color given by R, G, and B. */
7540 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7542 /* The color hash table. */
7544 struct ct_color
**ct_table
;
7546 /* Number of entries in the color table. */
7548 int ct_colors_allocated
;
7550 /* Initialize the color table. */
7555 int size
= CT_SIZE
* sizeof (*ct_table
);
7556 ct_table
= (struct ct_color
**) xmalloc (size
);
7557 bzero (ct_table
, size
);
7558 ct_colors_allocated
= 0;
7562 /* Free memory associated with the color table. */
7568 struct ct_color
*p
, *next
;
7570 for (i
= 0; i
< CT_SIZE
; ++i
)
7571 for (p
= ct_table
[i
]; p
; p
= next
)
7582 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7583 entry for that color already is in the color table, return the
7584 pixel color of that entry. Otherwise, allocate a new color for R,
7585 G, B, and make an entry in the color table. */
7587 static unsigned long
7588 lookup_rgb_color (f
, r
, g
, b
)
7592 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7593 int i
= hash
% CT_SIZE
;
7596 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7597 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7610 cmap
= FRAME_X_COLORMAP (f
);
7611 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7615 ++ct_colors_allocated
;
7617 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7621 p
->pixel
= color
.pixel
;
7622 p
->next
= ct_table
[i
];
7626 return FRAME_FOREGROUND_PIXEL (f
);
7633 /* Look up pixel color PIXEL which is used on frame F in the color
7634 table. If not already present, allocate it. Value is PIXEL. */
7636 static unsigned long
7637 lookup_pixel_color (f
, pixel
)
7639 unsigned long pixel
;
7641 int i
= pixel
% CT_SIZE
;
7644 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7645 if (p
->pixel
== pixel
)
7654 cmap
= FRAME_X_COLORMAP (f
);
7655 color
.pixel
= pixel
;
7656 x_query_color (f
, &color
);
7657 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7661 ++ct_colors_allocated
;
7663 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7668 p
->next
= ct_table
[i
];
7672 return FRAME_FOREGROUND_PIXEL (f
);
7679 /* Value is a vector of all pixel colors contained in the color table,
7680 allocated via xmalloc. Set *N to the number of colors. */
7682 static unsigned long *
7683 colors_in_color_table (n
)
7688 unsigned long *colors
;
7690 if (ct_colors_allocated
== 0)
7697 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7699 *n
= ct_colors_allocated
;
7701 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7702 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7703 colors
[j
++] = p
->pixel
;
7711 /***********************************************************************
7713 ***********************************************************************/
7715 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7716 int, XImage
*, int));
7717 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7718 XColor
*, int, XImage
*, int));
7719 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
7720 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
7721 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
7723 /* Non-zero means draw a cross on images having `:conversion
7726 int cross_disabled_images
;
7728 /* Edge detection matrices for different edge-detection
7731 static int emboss_matrix
[9] = {
7733 2, -1, 0, /* y - 1 */
7735 0, 1, -2 /* y + 1 */
7738 static int laplace_matrix
[9] = {
7740 1, 0, 0, /* y - 1 */
7742 0, 0, -1 /* y + 1 */
7745 /* Value is the intensity of the color whose red/green/blue values
7748 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7751 /* On frame F, return an array of XColor structures describing image
7752 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7753 non-zero means also fill the red/green/blue members of the XColor
7754 structures. Value is a pointer to the array of XColors structures,
7755 allocated with xmalloc; it must be freed by the caller. */
7758 x_to_xcolors (f
, img
, rgb_p
)
7767 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
7769 /* Get the X image IMG->pixmap. */
7770 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7771 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7773 /* Fill the `pixel' members of the XColor array. I wished there
7774 were an easy and portable way to circumvent XGetPixel. */
7776 for (y
= 0; y
< img
->height
; ++y
)
7780 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7781 p
->pixel
= XGetPixel (ximg
, x
, y
);
7784 x_query_colors (f
, row
, img
->width
);
7787 XDestroyImage (ximg
);
7792 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7793 RGB members are set. F is the frame on which this all happens.
7794 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7797 x_from_xcolors (f
, img
, colors
)
7807 init_color_table ();
7809 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7812 for (y
= 0; y
< img
->height
; ++y
)
7813 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7815 unsigned long pixel
;
7816 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
7817 XPutPixel (oimg
, x
, y
, pixel
);
7821 x_clear_image_1 (f
, img
, 1, 0, 1);
7823 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7824 x_destroy_x_image (oimg
);
7825 img
->pixmap
= pixmap
;
7826 img
->colors
= colors_in_color_table (&img
->ncolors
);
7827 free_color_table ();
7831 /* On frame F, perform edge-detection on image IMG.
7833 MATRIX is a nine-element array specifying the transformation
7834 matrix. See emboss_matrix for an example.
7836 COLOR_ADJUST is a color adjustment added to each pixel of the
7840 x_detect_edges (f
, img
, matrix
, color_adjust
)
7843 int matrix
[9], color_adjust
;
7845 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7849 for (i
= sum
= 0; i
< 9; ++i
)
7850 sum
+= abs (matrix
[i
]);
7852 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7854 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
7856 for (y
= 0; y
< img
->height
; ++y
)
7858 p
= COLOR (new, 0, y
);
7859 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7860 p
= COLOR (new, img
->width
- 1, y
);
7861 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7864 for (x
= 1; x
< img
->width
- 1; ++x
)
7866 p
= COLOR (new, x
, 0);
7867 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7868 p
= COLOR (new, x
, img
->height
- 1);
7869 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7872 for (y
= 1; y
< img
->height
- 1; ++y
)
7874 p
= COLOR (new, 1, y
);
7876 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
7878 int r
, g
, b
, y1
, x1
;
7881 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
7882 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
7885 XColor
*t
= COLOR (colors
, x1
, y1
);
7886 r
+= matrix
[i
] * t
->red
;
7887 g
+= matrix
[i
] * t
->green
;
7888 b
+= matrix
[i
] * t
->blue
;
7891 r
= (r
/ sum
+ color_adjust
) & 0xffff;
7892 g
= (g
/ sum
+ color_adjust
) & 0xffff;
7893 b
= (b
/ sum
+ color_adjust
) & 0xffff;
7894 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
7899 x_from_xcolors (f
, img
, new);
7905 /* Perform the pre-defined `emboss' edge-detection on image IMG
7913 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
7917 /* Perform the pre-defined `laplace' edge-detection on image IMG
7925 x_detect_edges (f
, img
, laplace_matrix
, 45000);
7929 /* Perform edge-detection on image IMG on frame F, with specified
7930 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7932 MATRIX must be either
7934 - a list of at least 9 numbers in row-major form
7935 - a vector of at least 9 numbers
7937 COLOR_ADJUST nil means use a default; otherwise it must be a
7941 x_edge_detection (f
, img
, matrix
, color_adjust
)
7944 Lisp_Object matrix
, color_adjust
;
7952 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
7953 ++i
, matrix
= XCDR (matrix
))
7954 trans
[i
] = XFLOATINT (XCAR (matrix
));
7956 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
7958 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
7959 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
7962 if (NILP (color_adjust
))
7963 color_adjust
= make_number (0xffff / 2);
7965 if (i
== 9 && NUMBERP (color_adjust
))
7966 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
7970 /* Transform image IMG on frame F so that it looks disabled. */
7973 x_disable_image (f
, img
)
7977 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
7979 if (dpyinfo
->n_planes
>= 2)
7981 /* Color (or grayscale). Convert to gray, and equalize. Just
7982 drawing such images with a stipple can look very odd, so
7983 we're using this method instead. */
7984 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7986 const int h
= 15000;
7987 const int l
= 30000;
7989 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
7993 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
7994 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
7995 p
->red
= p
->green
= p
->blue
= i2
;
7998 x_from_xcolors (f
, img
, colors
);
8001 /* Draw a cross over the disabled image, if we must or if we
8003 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
8005 Display
*dpy
= FRAME_X_DISPLAY (f
);
8008 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
8009 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
8010 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
8011 img
->width
- 1, img
->height
- 1);
8012 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
8018 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
8019 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
8020 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
8021 img
->width
- 1, img
->height
- 1);
8022 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
8030 /* Build a mask for image IMG which is used on frame F. FILE is the
8031 name of an image file, for error messages. HOW determines how to
8032 determine the background color of IMG. If it is a list '(R G B)',
8033 with R, G, and B being integers >= 0, take that as the color of the
8034 background. Otherwise, determine the background color of IMG
8035 heuristically. Value is non-zero if successful. */
8038 x_build_heuristic_mask (f
, img
, how
)
8043 Display
*dpy
= FRAME_X_DISPLAY (f
);
8044 XImage
*ximg
, *mask_img
;
8045 int x
, y
, rc
, look_at_corners_p
;
8046 unsigned long bg
= 0;
8050 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
8054 /* Create an image and pixmap serving as mask. */
8055 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
8056 &mask_img
, &img
->mask
);
8060 /* Get the X image of IMG->pixmap. */
8061 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
8064 /* Determine the background color of ximg. If HOW is `(R G B)'
8065 take that as color. Otherwise, try to determine the color
8067 look_at_corners_p
= 1;
8075 && NATNUMP (XCAR (how
)))
8077 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
8081 if (i
== 3 && NILP (how
))
8083 char color_name
[30];
8084 XColor exact
, color
;
8087 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
8089 cmap
= FRAME_X_COLORMAP (f
);
8090 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
8093 look_at_corners_p
= 0;
8098 if (look_at_corners_p
)
8100 unsigned long corners
[4];
8103 /* Get the colors at the corners of ximg. */
8104 corners
[0] = XGetPixel (ximg
, 0, 0);
8105 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
8106 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
8107 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
8109 /* Choose the most frequently found color as background. */
8110 for (i
= best_count
= 0; i
< 4; ++i
)
8114 for (j
= n
= 0; j
< 4; ++j
)
8115 if (corners
[i
] == corners
[j
])
8119 bg
= corners
[i
], best_count
= n
;
8123 /* Set all bits in mask_img to 1 whose color in ximg is different
8124 from the background color bg. */
8125 for (y
= 0; y
< img
->height
; ++y
)
8126 for (x
= 0; x
< img
->width
; ++x
)
8127 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
8129 /* Put mask_img into img->mask. */
8130 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8131 x_destroy_x_image (mask_img
);
8132 XDestroyImage (ximg
);
8139 /***********************************************************************
8140 PBM (mono, gray, color)
8141 ***********************************************************************/
8143 static int pbm_image_p
P_ ((Lisp_Object object
));
8144 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
8145 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
8147 /* The symbol `pbm' identifying images of this type. */
8151 /* Indices of image specification fields in gs_format, below. */
8153 enum pbm_keyword_index
8169 /* Vector of image_keyword structures describing the format
8170 of valid user-defined image specifications. */
8172 static struct image_keyword pbm_format
[PBM_LAST
] =
8174 {":type", IMAGE_SYMBOL_VALUE
, 1},
8175 {":file", IMAGE_STRING_VALUE
, 0},
8176 {":data", IMAGE_STRING_VALUE
, 0},
8177 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8178 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8179 {":relief", IMAGE_INTEGER_VALUE
, 0},
8180 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8181 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8182 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8183 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
8184 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
8187 /* Structure describing the image type `pbm'. */
8189 static struct image_type pbm_type
=
8199 /* Return non-zero if OBJECT is a valid PBM image specification. */
8202 pbm_image_p (object
)
8205 struct image_keyword fmt
[PBM_LAST
];
8207 bcopy (pbm_format
, fmt
, sizeof fmt
);
8209 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
8212 /* Must specify either :data or :file. */
8213 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
8217 /* Scan a decimal number from *S and return it. Advance *S while
8218 reading the number. END is the end of the string. Value is -1 at
8222 pbm_scan_number (s
, end
)
8223 unsigned char **s
, *end
;
8225 int c
= 0, val
= -1;
8229 /* Skip white-space. */
8230 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8235 /* Skip comment to end of line. */
8236 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
8239 else if (isdigit (c
))
8241 /* Read decimal number. */
8243 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
8244 val
= 10 * val
+ c
- '0';
8255 /* Load PBM image IMG for use on frame F. */
8263 int width
, height
, max_color_idx
= 0;
8265 Lisp_Object file
, specified_file
;
8266 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8267 struct gcpro gcpro1
;
8268 unsigned char *contents
= NULL
;
8269 unsigned char *end
, *p
;
8272 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8276 if (STRINGP (specified_file
))
8278 file
= x_find_image_file (specified_file
);
8279 if (!STRINGP (file
))
8281 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8286 contents
= slurp_file (XSTRING (file
)->data
, &size
);
8287 if (contents
== NULL
)
8289 image_error ("Error reading `%s'", file
, Qnil
);
8295 end
= contents
+ size
;
8300 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8301 p
= XSTRING (data
)->data
;
8302 end
= p
+ STRING_BYTES (XSTRING (data
));
8305 /* Check magic number. */
8306 if (end
- p
< 2 || *p
++ != 'P')
8308 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8318 raw_p
= 0, type
= PBM_MONO
;
8322 raw_p
= 0, type
= PBM_GRAY
;
8326 raw_p
= 0, type
= PBM_COLOR
;
8330 raw_p
= 1, type
= PBM_MONO
;
8334 raw_p
= 1, type
= PBM_GRAY
;
8338 raw_p
= 1, type
= PBM_COLOR
;
8342 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8346 /* Read width, height, maximum color-component. Characters
8347 starting with `#' up to the end of a line are ignored. */
8348 width
= pbm_scan_number (&p
, end
);
8349 height
= pbm_scan_number (&p
, end
);
8351 if (type
!= PBM_MONO
)
8353 max_color_idx
= pbm_scan_number (&p
, end
);
8354 if (raw_p
&& max_color_idx
> 255)
8355 max_color_idx
= 255;
8360 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8363 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8364 &ximg
, &img
->pixmap
))
8367 /* Initialize the color hash table. */
8368 init_color_table ();
8370 if (type
== PBM_MONO
)
8373 struct image_keyword fmt
[PBM_LAST
];
8374 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8375 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8377 /* Parse the image specification. */
8378 bcopy (pbm_format
, fmt
, sizeof fmt
);
8379 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8381 /* Get foreground and background colors, maybe allocate colors. */
8382 if (fmt
[PBM_FOREGROUND
].count
8383 && STRINGP (fmt
[PBM_FOREGROUND
].value
))
8384 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8385 if (fmt
[PBM_BACKGROUND
].count
8386 && STRINGP (fmt
[PBM_BACKGROUND
].value
))
8387 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8389 for (y
= 0; y
< height
; ++y
)
8390 for (x
= 0; x
< width
; ++x
)
8400 g
= pbm_scan_number (&p
, end
);
8402 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8407 for (y
= 0; y
< height
; ++y
)
8408 for (x
= 0; x
< width
; ++x
)
8412 if (type
== PBM_GRAY
)
8413 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8422 r
= pbm_scan_number (&p
, end
);
8423 g
= pbm_scan_number (&p
, end
);
8424 b
= pbm_scan_number (&p
, end
);
8427 if (r
< 0 || g
< 0 || b
< 0)
8431 XDestroyImage (ximg
);
8432 image_error ("Invalid pixel value in image `%s'",
8437 /* RGB values are now in the range 0..max_color_idx.
8438 Scale this to the range 0..0xffff supported by X. */
8439 r
= (double) r
* 65535 / max_color_idx
;
8440 g
= (double) g
* 65535 / max_color_idx
;
8441 b
= (double) b
* 65535 / max_color_idx
;
8442 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8446 /* Store in IMG->colors the colors allocated for the image, and
8447 free the color table. */
8448 img
->colors
= colors_in_color_table (&img
->ncolors
);
8449 free_color_table ();
8451 /* Put the image into a pixmap. */
8452 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8453 x_destroy_x_image (ximg
);
8456 img
->height
= height
;
8465 /***********************************************************************
8467 ***********************************************************************/
8473 /* Function prototypes. */
8475 static int png_image_p
P_ ((Lisp_Object object
));
8476 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8478 /* The symbol `png' identifying images of this type. */
8482 /* Indices of image specification fields in png_format, below. */
8484 enum png_keyword_index
8498 /* Vector of image_keyword structures describing the format
8499 of valid user-defined image specifications. */
8501 static struct image_keyword png_format
[PNG_LAST
] =
8503 {":type", IMAGE_SYMBOL_VALUE
, 1},
8504 {":data", IMAGE_STRING_VALUE
, 0},
8505 {":file", IMAGE_STRING_VALUE
, 0},
8506 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8507 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8508 {":relief", IMAGE_INTEGER_VALUE
, 0},
8509 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8510 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8511 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8514 /* Structure describing the image type `png'. */
8516 static struct image_type png_type
=
8526 /* Return non-zero if OBJECT is a valid PNG image specification. */
8529 png_image_p (object
)
8532 struct image_keyword fmt
[PNG_LAST
];
8533 bcopy (png_format
, fmt
, sizeof fmt
);
8535 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8538 /* Must specify either the :data or :file keyword. */
8539 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8543 /* Error and warning handlers installed when the PNG library
8547 my_png_error (png_ptr
, msg
)
8548 png_struct
*png_ptr
;
8551 xassert (png_ptr
!= NULL
);
8552 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8553 longjmp (png_ptr
->jmpbuf
, 1);
8558 my_png_warning (png_ptr
, msg
)
8559 png_struct
*png_ptr
;
8562 xassert (png_ptr
!= NULL
);
8563 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8566 /* Memory source for PNG decoding. */
8568 struct png_memory_storage
8570 unsigned char *bytes
; /* The data */
8571 size_t len
; /* How big is it? */
8572 int index
; /* Where are we? */
8576 /* Function set as reader function when reading PNG image from memory.
8577 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8578 bytes from the input to DATA. */
8581 png_read_from_memory (png_ptr
, data
, length
)
8582 png_structp png_ptr
;
8586 struct png_memory_storage
*tbr
8587 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8589 if (length
> tbr
->len
- tbr
->index
)
8590 png_error (png_ptr
, "Read error");
8592 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8593 tbr
->index
= tbr
->index
+ length
;
8596 /* Load PNG image IMG for use on frame F. Value is non-zero if
8604 Lisp_Object file
, specified_file
;
8605 Lisp_Object specified_data
;
8607 XImage
*ximg
, *mask_img
= NULL
;
8608 struct gcpro gcpro1
;
8609 png_struct
*png_ptr
= NULL
;
8610 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8611 FILE *volatile fp
= NULL
;
8613 png_byte
* volatile pixels
= NULL
;
8614 png_byte
** volatile rows
= NULL
;
8615 png_uint_32 width
, height
;
8616 int bit_depth
, color_type
, interlace_type
;
8618 png_uint_32 row_bytes
;
8621 double screen_gamma
, image_gamma
;
8623 struct png_memory_storage tbr
; /* Data to be read */
8625 /* Find out what file to load. */
8626 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8627 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8631 if (NILP (specified_data
))
8633 file
= x_find_image_file (specified_file
);
8634 if (!STRINGP (file
))
8636 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8641 /* Open the image file. */
8642 fp
= fopen (XSTRING (file
)->data
, "rb");
8645 image_error ("Cannot open image file `%s'", file
, Qnil
);
8651 /* Check PNG signature. */
8652 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8653 || !png_check_sig (sig
, sizeof sig
))
8655 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8663 /* Read from memory. */
8664 tbr
.bytes
= XSTRING (specified_data
)->data
;
8665 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8668 /* Check PNG signature. */
8669 if (tbr
.len
< sizeof sig
8670 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8672 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8677 /* Need to skip past the signature. */
8678 tbr
.bytes
+= sizeof (sig
);
8681 /* Initialize read and info structs for PNG lib. */
8682 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8683 my_png_error
, my_png_warning
);
8686 if (fp
) fclose (fp
);
8691 info_ptr
= png_create_info_struct (png_ptr
);
8694 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8695 if (fp
) fclose (fp
);
8700 end_info
= png_create_info_struct (png_ptr
);
8703 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8704 if (fp
) fclose (fp
);
8709 /* Set error jump-back. We come back here when the PNG library
8710 detects an error. */
8711 if (setjmp (png_ptr
->jmpbuf
))
8715 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8718 if (fp
) fclose (fp
);
8723 /* Read image info. */
8724 if (!NILP (specified_data
))
8725 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8727 png_init_io (png_ptr
, fp
);
8729 png_set_sig_bytes (png_ptr
, sizeof sig
);
8730 png_read_info (png_ptr
, info_ptr
);
8731 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8732 &interlace_type
, NULL
, NULL
);
8734 /* If image contains simply transparency data, we prefer to
8735 construct a clipping mask. */
8736 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8741 /* This function is easier to write if we only have to handle
8742 one data format: RGB or RGBA with 8 bits per channel. Let's
8743 transform other formats into that format. */
8745 /* Strip more than 8 bits per channel. */
8746 if (bit_depth
== 16)
8747 png_set_strip_16 (png_ptr
);
8749 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8751 png_set_expand (png_ptr
);
8753 /* Convert grayscale images to RGB. */
8754 if (color_type
== PNG_COLOR_TYPE_GRAY
8755 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8756 png_set_gray_to_rgb (png_ptr
);
8758 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8759 gamma_str
= getenv ("SCREEN_GAMMA");
8760 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8762 /* Tell the PNG lib to handle gamma correction for us. */
8764 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8765 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8766 /* There is a special chunk in the image specifying the gamma. */
8767 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8770 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8771 /* Image contains gamma information. */
8772 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8774 /* Use a default of 0.5 for the image gamma. */
8775 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8777 /* Handle alpha channel by combining the image with a background
8778 color. Do this only if a real alpha channel is supplied. For
8779 simple transparency, we prefer a clipping mask. */
8782 png_color_16
*image_background
;
8784 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8785 /* Image contains a background color with which to
8786 combine the image. */
8787 png_set_background (png_ptr
, image_background
,
8788 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8791 /* Image does not contain a background color with which
8792 to combine the image data via an alpha channel. Use
8793 the frame's background instead. */
8796 png_color_16 frame_background
;
8798 cmap
= FRAME_X_COLORMAP (f
);
8799 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8800 x_query_color (f
, &color
);
8802 bzero (&frame_background
, sizeof frame_background
);
8803 frame_background
.red
= color
.red
;
8804 frame_background
.green
= color
.green
;
8805 frame_background
.blue
= color
.blue
;
8807 png_set_background (png_ptr
, &frame_background
,
8808 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8812 /* Update info structure. */
8813 png_read_update_info (png_ptr
, info_ptr
);
8815 /* Get number of channels. Valid values are 1 for grayscale images
8816 and images with a palette, 2 for grayscale images with transparency
8817 information (alpha channel), 3 for RGB images, and 4 for RGB
8818 images with alpha channel, i.e. RGBA. If conversions above were
8819 sufficient we should only have 3 or 4 channels here. */
8820 channels
= png_get_channels (png_ptr
, info_ptr
);
8821 xassert (channels
== 3 || channels
== 4);
8823 /* Number of bytes needed for one row of the image. */
8824 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8826 /* Allocate memory for the image. */
8827 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8828 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8829 for (i
= 0; i
< height
; ++i
)
8830 rows
[i
] = pixels
+ i
* row_bytes
;
8832 /* Read the entire image. */
8833 png_read_image (png_ptr
, rows
);
8834 png_read_end (png_ptr
, info_ptr
);
8841 /* Create the X image and pixmap. */
8842 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8846 /* Create an image and pixmap serving as mask if the PNG image
8847 contains an alpha channel. */
8850 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8851 &mask_img
, &img
->mask
))
8853 x_destroy_x_image (ximg
);
8854 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8859 /* Fill the X image and mask from PNG data. */
8860 init_color_table ();
8862 for (y
= 0; y
< height
; ++y
)
8864 png_byte
*p
= rows
[y
];
8866 for (x
= 0; x
< width
; ++x
)
8873 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8875 /* An alpha channel, aka mask channel, associates variable
8876 transparency with an image. Where other image formats
8877 support binary transparency---fully transparent or fully
8878 opaque---PNG allows up to 254 levels of partial transparency.
8879 The PNG library implements partial transparency by combining
8880 the image with a specified background color.
8882 I'm not sure how to handle this here nicely: because the
8883 background on which the image is displayed may change, for
8884 real alpha channel support, it would be necessary to create
8885 a new image for each possible background.
8887 What I'm doing now is that a mask is created if we have
8888 boolean transparency information. Otherwise I'm using
8889 the frame's background color to combine the image with. */
8894 XPutPixel (mask_img
, x
, y
, *p
> 0);
8900 /* Remember colors allocated for this image. */
8901 img
->colors
= colors_in_color_table (&img
->ncolors
);
8902 free_color_table ();
8905 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8910 img
->height
= height
;
8912 /* Put the image into the pixmap, then free the X image and its buffer. */
8913 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8914 x_destroy_x_image (ximg
);
8916 /* Same for the mask. */
8919 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8920 x_destroy_x_image (mask_img
);
8927 #endif /* HAVE_PNG != 0 */
8931 /***********************************************************************
8933 ***********************************************************************/
8937 /* Work around a warning about HAVE_STDLIB_H being redefined in
8939 #ifdef HAVE_STDLIB_H
8940 #define HAVE_STDLIB_H_1
8941 #undef HAVE_STDLIB_H
8942 #endif /* HAVE_STLIB_H */
8944 #include <jpeglib.h>
8948 #ifdef HAVE_STLIB_H_1
8949 #define HAVE_STDLIB_H 1
8952 static int jpeg_image_p
P_ ((Lisp_Object object
));
8953 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8955 /* The symbol `jpeg' identifying images of this type. */
8959 /* Indices of image specification fields in gs_format, below. */
8961 enum jpeg_keyword_index
8970 JPEG_HEURISTIC_MASK
,
8975 /* Vector of image_keyword structures describing the format
8976 of valid user-defined image specifications. */
8978 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8980 {":type", IMAGE_SYMBOL_VALUE
, 1},
8981 {":data", IMAGE_STRING_VALUE
, 0},
8982 {":file", IMAGE_STRING_VALUE
, 0},
8983 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8984 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8985 {":relief", IMAGE_INTEGER_VALUE
, 0},
8986 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8987 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8988 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8991 /* Structure describing the image type `jpeg'. */
8993 static struct image_type jpeg_type
=
9003 /* Return non-zero if OBJECT is a valid JPEG image specification. */
9006 jpeg_image_p (object
)
9009 struct image_keyword fmt
[JPEG_LAST
];
9011 bcopy (jpeg_format
, fmt
, sizeof fmt
);
9013 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
9016 /* Must specify either the :data or :file keyword. */
9017 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
9021 struct my_jpeg_error_mgr
9023 struct jpeg_error_mgr pub
;
9024 jmp_buf setjmp_buffer
;
9029 my_error_exit (cinfo
)
9032 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
9033 longjmp (mgr
->setjmp_buffer
, 1);
9037 /* Init source method for JPEG data source manager. Called by
9038 jpeg_read_header() before any data is actually read. See
9039 libjpeg.doc from the JPEG lib distribution. */
9042 our_init_source (cinfo
)
9043 j_decompress_ptr cinfo
;
9048 /* Fill input buffer method for JPEG data source manager. Called
9049 whenever more data is needed. We read the whole image in one step,
9050 so this only adds a fake end of input marker at the end. */
9053 our_fill_input_buffer (cinfo
)
9054 j_decompress_ptr cinfo
;
9056 /* Insert a fake EOI marker. */
9057 struct jpeg_source_mgr
*src
= cinfo
->src
;
9058 static JOCTET buffer
[2];
9060 buffer
[0] = (JOCTET
) 0xFF;
9061 buffer
[1] = (JOCTET
) JPEG_EOI
;
9063 src
->next_input_byte
= buffer
;
9064 src
->bytes_in_buffer
= 2;
9069 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
9070 is the JPEG data source manager. */
9073 our_skip_input_data (cinfo
, num_bytes
)
9074 j_decompress_ptr cinfo
;
9077 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9081 if (num_bytes
> src
->bytes_in_buffer
)
9082 ERREXIT (cinfo
, JERR_INPUT_EOF
);
9084 src
->bytes_in_buffer
-= num_bytes
;
9085 src
->next_input_byte
+= num_bytes
;
9090 /* Method to terminate data source. Called by
9091 jpeg_finish_decompress() after all data has been processed. */
9094 our_term_source (cinfo
)
9095 j_decompress_ptr cinfo
;
9100 /* Set up the JPEG lib for reading an image from DATA which contains
9101 LEN bytes. CINFO is the decompression info structure created for
9102 reading the image. */
9105 jpeg_memory_src (cinfo
, data
, len
)
9106 j_decompress_ptr cinfo
;
9110 struct jpeg_source_mgr
*src
;
9112 if (cinfo
->src
== NULL
)
9114 /* First time for this JPEG object? */
9115 cinfo
->src
= (struct jpeg_source_mgr
*)
9116 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
9117 sizeof (struct jpeg_source_mgr
));
9118 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9119 src
->next_input_byte
= data
;
9122 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9123 src
->init_source
= our_init_source
;
9124 src
->fill_input_buffer
= our_fill_input_buffer
;
9125 src
->skip_input_data
= our_skip_input_data
;
9126 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
9127 src
->term_source
= our_term_source
;
9128 src
->bytes_in_buffer
= len
;
9129 src
->next_input_byte
= data
;
9133 /* Load image IMG for use on frame F. Patterned after example.c
9134 from the JPEG lib. */
9141 struct jpeg_decompress_struct cinfo
;
9142 struct my_jpeg_error_mgr mgr
;
9143 Lisp_Object file
, specified_file
;
9144 Lisp_Object specified_data
;
9145 FILE * volatile fp
= NULL
;
9147 int row_stride
, x
, y
;
9148 XImage
*ximg
= NULL
;
9150 unsigned long *colors
;
9152 struct gcpro gcpro1
;
9154 /* Open the JPEG file. */
9155 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9156 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9160 if (NILP (specified_data
))
9162 file
= x_find_image_file (specified_file
);
9163 if (!STRINGP (file
))
9165 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9170 fp
= fopen (XSTRING (file
)->data
, "r");
9173 image_error ("Cannot open `%s'", file
, Qnil
);
9179 /* Customize libjpeg's error handling to call my_error_exit when an
9180 error is detected. This function will perform a longjmp. */
9181 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
9182 mgr
.pub
.error_exit
= my_error_exit
;
9184 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
9188 /* Called from my_error_exit. Display a JPEG error. */
9189 char buffer
[JMSG_LENGTH_MAX
];
9190 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
9191 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
9192 build_string (buffer
));
9195 /* Close the input file and destroy the JPEG object. */
9197 fclose ((FILE *) fp
);
9198 jpeg_destroy_decompress (&cinfo
);
9200 /* If we already have an XImage, free that. */
9201 x_destroy_x_image (ximg
);
9203 /* Free pixmap and colors. */
9204 x_clear_image (f
, img
);
9210 /* Create the JPEG decompression object. Let it read from fp.
9211 Read the JPEG image header. */
9212 jpeg_create_decompress (&cinfo
);
9214 if (NILP (specified_data
))
9215 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
9217 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
9218 STRING_BYTES (XSTRING (specified_data
)));
9220 jpeg_read_header (&cinfo
, TRUE
);
9222 /* Customize decompression so that color quantization will be used.
9223 Start decompression. */
9224 cinfo
.quantize_colors
= TRUE
;
9225 jpeg_start_decompress (&cinfo
);
9226 width
= img
->width
= cinfo
.output_width
;
9227 height
= img
->height
= cinfo
.output_height
;
9229 /* Create X image and pixmap. */
9230 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9231 longjmp (mgr
.setjmp_buffer
, 2);
9233 /* Allocate colors. When color quantization is used,
9234 cinfo.actual_number_of_colors has been set with the number of
9235 colors generated, and cinfo.colormap is a two-dimensional array
9236 of color indices in the range 0..cinfo.actual_number_of_colors.
9237 No more than 255 colors will be generated. */
9241 if (cinfo
.out_color_components
> 2)
9242 ir
= 0, ig
= 1, ib
= 2;
9243 else if (cinfo
.out_color_components
> 1)
9244 ir
= 0, ig
= 1, ib
= 0;
9246 ir
= 0, ig
= 0, ib
= 0;
9248 /* Use the color table mechanism because it handles colors that
9249 cannot be allocated nicely. Such colors will be replaced with
9250 a default color, and we don't have to care about which colors
9251 can be freed safely, and which can't. */
9252 init_color_table ();
9253 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9256 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9258 /* Multiply RGB values with 255 because X expects RGB values
9259 in the range 0..0xffff. */
9260 int r
= cinfo
.colormap
[ir
][i
] << 8;
9261 int g
= cinfo
.colormap
[ig
][i
] << 8;
9262 int b
= cinfo
.colormap
[ib
][i
] << 8;
9263 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9266 /* Remember those colors actually allocated. */
9267 img
->colors
= colors_in_color_table (&img
->ncolors
);
9268 free_color_table ();
9272 row_stride
= width
* cinfo
.output_components
;
9273 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9275 for (y
= 0; y
< height
; ++y
)
9277 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9278 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9279 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9283 jpeg_finish_decompress (&cinfo
);
9284 jpeg_destroy_decompress (&cinfo
);
9286 fclose ((FILE *) fp
);
9288 /* Put the image into the pixmap. */
9289 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9290 x_destroy_x_image (ximg
);
9295 #endif /* HAVE_JPEG */
9299 /***********************************************************************
9301 ***********************************************************************/
9307 static int tiff_image_p
P_ ((Lisp_Object object
));
9308 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9310 /* The symbol `tiff' identifying images of this type. */
9314 /* Indices of image specification fields in tiff_format, below. */
9316 enum tiff_keyword_index
9325 TIFF_HEURISTIC_MASK
,
9330 /* Vector of image_keyword structures describing the format
9331 of valid user-defined image specifications. */
9333 static struct image_keyword tiff_format
[TIFF_LAST
] =
9335 {":type", IMAGE_SYMBOL_VALUE
, 1},
9336 {":data", IMAGE_STRING_VALUE
, 0},
9337 {":file", IMAGE_STRING_VALUE
, 0},
9338 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9339 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9340 {":relief", IMAGE_INTEGER_VALUE
, 0},
9341 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9342 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9343 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9346 /* Structure describing the image type `tiff'. */
9348 static struct image_type tiff_type
=
9358 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9361 tiff_image_p (object
)
9364 struct image_keyword fmt
[TIFF_LAST
];
9365 bcopy (tiff_format
, fmt
, sizeof fmt
);
9367 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9370 /* Must specify either the :data or :file keyword. */
9371 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9375 /* Reading from a memory buffer for TIFF images Based on the PNG
9376 memory source, but we have to provide a lot of extra functions.
9379 We really only need to implement read and seek, but I am not
9380 convinced that the TIFF library is smart enough not to destroy
9381 itself if we only hand it the function pointers we need to
9386 unsigned char *bytes
;
9394 tiff_read_from_memory (data
, buf
, size
)
9399 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9401 if (size
> src
->len
- src
->index
)
9403 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9410 tiff_write_from_memory (data
, buf
, size
)
9420 tiff_seek_in_memory (data
, off
, whence
)
9425 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9430 case SEEK_SET
: /* Go from beginning of source. */
9434 case SEEK_END
: /* Go from end of source. */
9435 idx
= src
->len
+ off
;
9438 case SEEK_CUR
: /* Go from current position. */
9439 idx
= src
->index
+ off
;
9442 default: /* Invalid `whence'. */
9446 if (idx
> src
->len
|| idx
< 0)
9455 tiff_close_memory (data
)
9464 tiff_mmap_memory (data
, pbase
, psize
)
9469 /* It is already _IN_ memory. */
9475 tiff_unmap_memory (data
, base
, size
)
9480 /* We don't need to do this. */
9485 tiff_size_of_memory (data
)
9488 return ((tiff_memory_source
*) data
)->len
;
9493 tiff_error_handler (title
, format
, ap
)
9494 const char *title
, *format
;
9500 len
= sprintf (buf
, "TIFF error: %s ", title
);
9501 vsprintf (buf
+ len
, format
, ap
);
9502 add_to_log (buf
, Qnil
, Qnil
);
9507 tiff_warning_handler (title
, format
, ap
)
9508 const char *title
, *format
;
9514 len
= sprintf (buf
, "TIFF warning: %s ", title
);
9515 vsprintf (buf
+ len
, format
, ap
);
9516 add_to_log (buf
, Qnil
, Qnil
);
9520 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9528 Lisp_Object file
, specified_file
;
9529 Lisp_Object specified_data
;
9531 int width
, height
, x
, y
;
9535 struct gcpro gcpro1
;
9536 tiff_memory_source memsrc
;
9538 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9539 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9543 TIFFSetErrorHandler (tiff_error_handler
);
9544 TIFFSetWarningHandler (tiff_warning_handler
);
9546 if (NILP (specified_data
))
9548 /* Read from a file */
9549 file
= x_find_image_file (specified_file
);
9550 if (!STRINGP (file
))
9552 image_error ("Cannot find image file `%s'", file
, Qnil
);
9557 /* Try to open the image file. */
9558 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9561 image_error ("Cannot open `%s'", file
, Qnil
);
9568 /* Memory source! */
9569 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9570 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9573 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9574 (TIFFReadWriteProc
) tiff_read_from_memory
,
9575 (TIFFReadWriteProc
) tiff_write_from_memory
,
9576 tiff_seek_in_memory
,
9578 tiff_size_of_memory
,
9584 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9590 /* Get width and height of the image, and allocate a raster buffer
9591 of width x height 32-bit values. */
9592 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9593 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9594 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9596 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9600 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9606 /* Create the X image and pixmap. */
9607 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9614 /* Initialize the color table. */
9615 init_color_table ();
9617 /* Process the pixel raster. Origin is in the lower-left corner. */
9618 for (y
= 0; y
< height
; ++y
)
9620 uint32
*row
= buf
+ y
* width
;
9622 for (x
= 0; x
< width
; ++x
)
9624 uint32 abgr
= row
[x
];
9625 int r
= TIFFGetR (abgr
) << 8;
9626 int g
= TIFFGetG (abgr
) << 8;
9627 int b
= TIFFGetB (abgr
) << 8;
9628 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9632 /* Remember the colors allocated for the image. Free the color table. */
9633 img
->colors
= colors_in_color_table (&img
->ncolors
);
9634 free_color_table ();
9636 /* Put the image into the pixmap, then free the X image and its buffer. */
9637 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9638 x_destroy_x_image (ximg
);
9642 img
->height
= height
;
9648 #endif /* HAVE_TIFF != 0 */
9652 /***********************************************************************
9654 ***********************************************************************/
9658 #include <gif_lib.h>
9660 static int gif_image_p
P_ ((Lisp_Object object
));
9661 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9663 /* The symbol `gif' identifying images of this type. */
9667 /* Indices of image specification fields in gif_format, below. */
9669 enum gif_keyword_index
9684 /* Vector of image_keyword structures describing the format
9685 of valid user-defined image specifications. */
9687 static struct image_keyword gif_format
[GIF_LAST
] =
9689 {":type", IMAGE_SYMBOL_VALUE
, 1},
9690 {":data", IMAGE_STRING_VALUE
, 0},
9691 {":file", IMAGE_STRING_VALUE
, 0},
9692 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9693 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9694 {":relief", IMAGE_INTEGER_VALUE
, 0},
9695 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9696 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9697 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9698 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
9701 /* Structure describing the image type `gif'. */
9703 static struct image_type gif_type
=
9713 /* Return non-zero if OBJECT is a valid GIF image specification. */
9716 gif_image_p (object
)
9719 struct image_keyword fmt
[GIF_LAST
];
9720 bcopy (gif_format
, fmt
, sizeof fmt
);
9722 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
9725 /* Must specify either the :data or :file keyword. */
9726 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9730 /* Reading a GIF image from memory
9731 Based on the PNG memory stuff to a certain extent. */
9735 unsigned char *bytes
;
9742 /* Make the current memory source available to gif_read_from_memory.
9743 It's done this way because not all versions of libungif support
9744 a UserData field in the GifFileType structure. */
9745 static gif_memory_source
*current_gif_memory_src
;
9748 gif_read_from_memory (file
, buf
, len
)
9753 gif_memory_source
*src
= current_gif_memory_src
;
9755 if (len
> src
->len
- src
->index
)
9758 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9764 /* Load GIF image IMG for use on frame F. Value is non-zero if
9772 Lisp_Object file
, specified_file
;
9773 Lisp_Object specified_data
;
9774 int rc
, width
, height
, x
, y
, i
;
9776 ColorMapObject
*gif_color_map
;
9777 unsigned long pixel_colors
[256];
9779 struct gcpro gcpro1
;
9781 int ino
, image_left
, image_top
, image_width
, image_height
;
9782 gif_memory_source memsrc
;
9783 unsigned char *raster
;
9785 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9786 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9790 if (NILP (specified_data
))
9792 file
= x_find_image_file (specified_file
);
9793 if (!STRINGP (file
))
9795 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9800 /* Open the GIF file. */
9801 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9804 image_error ("Cannot open `%s'", file
, Qnil
);
9811 /* Read from memory! */
9812 current_gif_memory_src
= &memsrc
;
9813 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9814 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9817 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9820 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9826 /* Read entire contents. */
9827 rc
= DGifSlurp (gif
);
9828 if (rc
== GIF_ERROR
)
9830 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9831 DGifCloseFile (gif
);
9836 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9837 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9838 if (ino
>= gif
->ImageCount
)
9840 image_error ("Invalid image number `%s' in image `%s'",
9842 DGifCloseFile (gif
);
9847 width
= img
->width
= gif
->SWidth
;
9848 height
= img
->height
= gif
->SHeight
;
9850 /* Create the X image and pixmap. */
9851 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9853 DGifCloseFile (gif
);
9858 /* Allocate colors. */
9859 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
9861 gif_color_map
= gif
->SColorMap
;
9862 init_color_table ();
9863 bzero (pixel_colors
, sizeof pixel_colors
);
9865 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
9867 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
9868 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
9869 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
9870 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9873 img
->colors
= colors_in_color_table (&img
->ncolors
);
9874 free_color_table ();
9876 /* Clear the part of the screen image that are not covered by
9877 the image from the GIF file. Full animated GIF support
9878 requires more than can be done here (see the gif89 spec,
9879 disposal methods). Let's simply assume that the part
9880 not covered by a sub-image is in the frame's background color. */
9881 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
9882 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
9883 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
9884 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
9886 for (y
= 0; y
< image_top
; ++y
)
9887 for (x
= 0; x
< width
; ++x
)
9888 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9890 for (y
= image_top
+ image_height
; y
< height
; ++y
)
9891 for (x
= 0; x
< width
; ++x
)
9892 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9894 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
9896 for (x
= 0; x
< image_left
; ++x
)
9897 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9898 for (x
= image_left
+ image_width
; x
< width
; ++x
)
9899 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9902 /* Read the GIF image into the X image. We use a local variable
9903 `raster' here because RasterBits below is a char *, and invites
9904 problems with bytes >= 0x80. */
9905 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
9907 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
9909 static int interlace_start
[] = {0, 4, 2, 1};
9910 static int interlace_increment
[] = {8, 8, 4, 2};
9912 int row
= interlace_start
[0];
9916 for (y
= 0; y
< image_height
; y
++)
9918 if (row
>= image_height
)
9920 row
= interlace_start
[++pass
];
9921 while (row
>= image_height
)
9922 row
= interlace_start
[++pass
];
9925 for (x
= 0; x
< image_width
; x
++)
9927 int i
= raster
[(y
* image_width
) + x
];
9928 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
9932 row
+= interlace_increment
[pass
];
9937 for (y
= 0; y
< image_height
; ++y
)
9938 for (x
= 0; x
< image_width
; ++x
)
9940 int i
= raster
[y
* image_width
+ x
];
9941 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
9945 DGifCloseFile (gif
);
9947 /* Put the image into the pixmap, then free the X image and its buffer. */
9948 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9949 x_destroy_x_image (ximg
);
9955 #endif /* HAVE_GIF != 0 */
9959 /***********************************************************************
9961 ***********************************************************************/
9963 static int gs_image_p
P_ ((Lisp_Object object
));
9964 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9965 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9967 /* The symbol `postscript' identifying images of this type. */
9969 Lisp_Object Qpostscript
;
9971 /* Keyword symbols. */
9973 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9975 /* Indices of image specification fields in gs_format, below. */
9977 enum gs_keyword_index
9994 /* Vector of image_keyword structures describing the format
9995 of valid user-defined image specifications. */
9997 static struct image_keyword gs_format
[GS_LAST
] =
9999 {":type", IMAGE_SYMBOL_VALUE
, 1},
10000 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
10001 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
10002 {":file", IMAGE_STRING_VALUE
, 1},
10003 {":loader", IMAGE_FUNCTION_VALUE
, 0},
10004 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
10005 {":ascent", IMAGE_ASCENT_VALUE
, 0},
10006 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10007 {":relief", IMAGE_INTEGER_VALUE
, 0},
10008 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10009 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10010 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
10013 /* Structure describing the image type `ghostscript'. */
10015 static struct image_type gs_type
=
10025 /* Free X resources of Ghostscript image IMG which is used on frame F. */
10028 gs_clear_image (f
, img
)
10032 /* IMG->data.ptr_val may contain a recorded colormap. */
10033 xfree (img
->data
.ptr_val
);
10034 x_clear_image (f
, img
);
10038 /* Return non-zero if OBJECT is a valid Ghostscript image
10042 gs_image_p (object
)
10043 Lisp_Object object
;
10045 struct image_keyword fmt
[GS_LAST
];
10049 bcopy (gs_format
, fmt
, sizeof fmt
);
10051 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
10054 /* Bounding box must be a list or vector containing 4 integers. */
10055 tem
= fmt
[GS_BOUNDING_BOX
].value
;
10058 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
10059 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
10064 else if (VECTORP (tem
))
10066 if (XVECTOR (tem
)->size
!= 4)
10068 for (i
= 0; i
< 4; ++i
)
10069 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
10079 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
10088 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
10089 struct gcpro gcpro1
, gcpro2
;
10091 double in_width
, in_height
;
10092 Lisp_Object pixel_colors
= Qnil
;
10094 /* Compute pixel size of pixmap needed from the given size in the
10095 image specification. Sizes in the specification are in pt. 1 pt
10096 = 1/72 in, xdpi and ydpi are stored in the frame's X display
10098 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
10099 in_width
= XFASTINT (pt_width
) / 72.0;
10100 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
10101 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
10102 in_height
= XFASTINT (pt_height
) / 72.0;
10103 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
10105 /* Create the pixmap. */
10106 xassert (img
->pixmap
== None
);
10107 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10108 img
->width
, img
->height
,
10109 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
10113 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
10117 /* Call the loader to fill the pixmap. It returns a process object
10118 if successful. We do not record_unwind_protect here because
10119 other places in redisplay like calling window scroll functions
10120 don't either. Let the Lisp loader use `unwind-protect' instead. */
10121 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
10123 sprintf (buffer
, "%lu %lu",
10124 (unsigned long) FRAME_X_WINDOW (f
),
10125 (unsigned long) img
->pixmap
);
10126 window_and_pixmap_id
= build_string (buffer
);
10128 sprintf (buffer
, "%lu %lu",
10129 FRAME_FOREGROUND_PIXEL (f
),
10130 FRAME_BACKGROUND_PIXEL (f
));
10131 pixel_colors
= build_string (buffer
);
10133 XSETFRAME (frame
, f
);
10134 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
10136 loader
= intern ("gs-load-image");
10138 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
10139 make_number (img
->width
),
10140 make_number (img
->height
),
10141 window_and_pixmap_id
,
10144 return PROCESSP (img
->data
.lisp_val
);
10148 /* Kill the Ghostscript process that was started to fill PIXMAP on
10149 frame F. Called from XTread_socket when receiving an event
10150 telling Emacs that Ghostscript has finished drawing. */
10153 x_kill_gs_process (pixmap
, f
)
10157 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
10161 /* Find the image containing PIXMAP. */
10162 for (i
= 0; i
< c
->used
; ++i
)
10163 if (c
->images
[i
]->pixmap
== pixmap
)
10166 /* Should someone in between have cleared the image cache, for
10167 instance, give up. */
10171 /* Kill the GS process. We should have found PIXMAP in the image
10172 cache and its image should contain a process object. */
10173 img
= c
->images
[i
];
10174 xassert (PROCESSP (img
->data
.lisp_val
));
10175 Fkill_process (img
->data
.lisp_val
, Qnil
);
10176 img
->data
.lisp_val
= Qnil
;
10178 /* On displays with a mutable colormap, figure out the colors
10179 allocated for the image by looking at the pixels of an XImage for
10181 class = FRAME_X_VISUAL (f
)->class;
10182 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
10188 /* Try to get an XImage for img->pixmep. */
10189 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10190 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10195 /* Initialize the color table. */
10196 init_color_table ();
10198 /* For each pixel of the image, look its color up in the
10199 color table. After having done so, the color table will
10200 contain an entry for each color used by the image. */
10201 for (y
= 0; y
< img
->height
; ++y
)
10202 for (x
= 0; x
< img
->width
; ++x
)
10204 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
10205 lookup_pixel_color (f
, pixel
);
10208 /* Record colors in the image. Free color table and XImage. */
10209 img
->colors
= colors_in_color_table (&img
->ncolors
);
10210 free_color_table ();
10211 XDestroyImage (ximg
);
10213 #if 0 /* This doesn't seem to be the case. If we free the colors
10214 here, we get a BadAccess later in x_clear_image when
10215 freeing the colors. */
10216 /* We have allocated colors once, but Ghostscript has also
10217 allocated colors on behalf of us. So, to get the
10218 reference counts right, free them once. */
10220 x_free_colors (f
, img
->colors
, img
->ncolors
);
10224 image_error ("Cannot get X image of `%s'; colors will not be freed",
10230 /* Now that we have the pixmap, compute mask and transform the
10231 image if requested. */
10233 postprocess_image (f
, img
);
10239 /***********************************************************************
10241 ***********************************************************************/
10243 DEFUN ("x-change-window-property", Fx_change_window_property
,
10244 Sx_change_window_property
, 2, 3, 0,
10245 "Change window property PROP to VALUE on the X window of FRAME.\n\
10246 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
10247 selected frame. Value is VALUE.")
10248 (prop
, value
, frame
)
10249 Lisp_Object frame
, prop
, value
;
10251 struct frame
*f
= check_x_frame (frame
);
10254 CHECK_STRING (prop
, 1);
10255 CHECK_STRING (value
, 2);
10258 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10259 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10260 prop_atom
, XA_STRING
, 8, PropModeReplace
,
10261 XSTRING (value
)->data
, XSTRING (value
)->size
);
10263 /* Make sure the property is set when we return. */
10264 XFlush (FRAME_X_DISPLAY (f
));
10271 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
10272 Sx_delete_window_property
, 1, 2, 0,
10273 "Remove window property PROP from X window of FRAME.\n\
10274 FRAME nil or omitted means use the selected frame. Value is PROP.")
10276 Lisp_Object prop
, frame
;
10278 struct frame
*f
= check_x_frame (frame
);
10281 CHECK_STRING (prop
, 1);
10283 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10284 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
10286 /* Make sure the property is removed when we return. */
10287 XFlush (FRAME_X_DISPLAY (f
));
10294 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10296 "Value is the value of window property PROP on FRAME.\n\
10297 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
10298 if FRAME hasn't a property with name PROP or if PROP has no string\n\
10301 Lisp_Object prop
, frame
;
10303 struct frame
*f
= check_x_frame (frame
);
10306 Lisp_Object prop_value
= Qnil
;
10307 char *tmp_data
= NULL
;
10310 unsigned long actual_size
, bytes_remaining
;
10312 CHECK_STRING (prop
, 1);
10314 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10315 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10316 prop_atom
, 0, 0, False
, XA_STRING
,
10317 &actual_type
, &actual_format
, &actual_size
,
10318 &bytes_remaining
, (unsigned char **) &tmp_data
);
10321 int size
= bytes_remaining
;
10326 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10327 prop_atom
, 0, bytes_remaining
,
10329 &actual_type
, &actual_format
,
10330 &actual_size
, &bytes_remaining
,
10331 (unsigned char **) &tmp_data
);
10332 if (rc
== Success
&& tmp_data
)
10333 prop_value
= make_string (tmp_data
, size
);
10344 /***********************************************************************
10346 ***********************************************************************/
10348 /* If non-null, an asynchronous timer that, when it expires, displays
10349 an hourglass cursor on all frames. */
10351 static struct atimer
*hourglass_atimer
;
10353 /* Non-zero means an hourglass cursor is currently shown. */
10355 static int hourglass_shown_p
;
10357 /* Number of seconds to wait before displaying an hourglass cursor. */
10359 static Lisp_Object Vhourglass_delay
;
10361 /* Default number of seconds to wait before displaying an hourglass
10364 #define DEFAULT_HOURGLASS_DELAY 1
10366 /* Function prototypes. */
10368 static void show_hourglass
P_ ((struct atimer
*));
10369 static void hide_hourglass
P_ ((void));
10372 /* Cancel a currently active hourglass timer, and start a new one. */
10378 int secs
, usecs
= 0;
10380 cancel_hourglass ();
10382 if (INTEGERP (Vhourglass_delay
)
10383 && XINT (Vhourglass_delay
) > 0)
10384 secs
= XFASTINT (Vhourglass_delay
);
10385 else if (FLOATP (Vhourglass_delay
)
10386 && XFLOAT_DATA (Vhourglass_delay
) > 0)
10389 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
10390 secs
= XFASTINT (tem
);
10391 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
10394 secs
= DEFAULT_HOURGLASS_DELAY
;
10396 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10397 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10398 show_hourglass
, NULL
);
10402 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
10406 cancel_hourglass ()
10408 if (hourglass_atimer
)
10410 cancel_atimer (hourglass_atimer
);
10411 hourglass_atimer
= NULL
;
10414 if (hourglass_shown_p
)
10419 /* Timer function of hourglass_atimer. TIMER is equal to
10422 Display an hourglass pointer on all frames by mapping the frames'
10423 hourglass_window. Set the hourglass_p flag in the frames'
10424 output_data.x structure to indicate that an hourglass cursor is
10425 shown on the frames. */
10428 show_hourglass (timer
)
10429 struct atimer
*timer
;
10431 /* The timer implementation will cancel this timer automatically
10432 after this function has run. Set hourglass_atimer to null
10433 so that we know the timer doesn't have to be canceled. */
10434 hourglass_atimer
= NULL
;
10436 if (!hourglass_shown_p
)
10438 Lisp_Object rest
, frame
;
10442 FOR_EACH_FRAME (rest
, frame
)
10444 struct frame
*f
= XFRAME (frame
);
10446 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
) && FRAME_X_DISPLAY (f
))
10448 Display
*dpy
= FRAME_X_DISPLAY (f
);
10450 #ifdef USE_X_TOOLKIT
10451 if (f
->output_data
.x
->widget
)
10453 if (FRAME_OUTER_WINDOW (f
))
10456 f
->output_data
.x
->hourglass_p
= 1;
10458 if (!f
->output_data
.x
->hourglass_window
)
10460 unsigned long mask
= CWCursor
;
10461 XSetWindowAttributes attrs
;
10463 attrs
.cursor
= f
->output_data
.x
->hourglass_cursor
;
10465 f
->output_data
.x
->hourglass_window
10466 = XCreateWindow (dpy
, FRAME_OUTER_WINDOW (f
),
10467 0, 0, 32000, 32000, 0, 0,
10473 XMapRaised (dpy
, f
->output_data
.x
->hourglass_window
);
10479 hourglass_shown_p
= 1;
10485 /* Hide the hourglass pointer on all frames, if it is currently
10491 if (hourglass_shown_p
)
10493 Lisp_Object rest
, frame
;
10496 FOR_EACH_FRAME (rest
, frame
)
10498 struct frame
*f
= XFRAME (frame
);
10501 /* Watch out for newly created frames. */
10502 && f
->output_data
.x
->hourglass_window
)
10504 XUnmapWindow (FRAME_X_DISPLAY (f
),
10505 f
->output_data
.x
->hourglass_window
);
10506 /* Sync here because XTread_socket looks at the
10507 hourglass_p flag that is reset to zero below. */
10508 XSync (FRAME_X_DISPLAY (f
), False
);
10509 f
->output_data
.x
->hourglass_p
= 0;
10513 hourglass_shown_p
= 0;
10520 /***********************************************************************
10522 ***********************************************************************/
10524 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10525 Lisp_Object
, Lisp_Object
));
10526 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
10527 Lisp_Object
, int, int, int *, int *));
10529 /* The frame of a currently visible tooltip. */
10531 Lisp_Object tip_frame
;
10533 /* If non-nil, a timer started that hides the last tooltip when it
10536 Lisp_Object tip_timer
;
10539 /* If non-nil, a vector of 3 elements containing the last args
10540 with which x-show-tip was called. See there. */
10542 Lisp_Object last_show_tip_args
;
10544 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
10546 Lisp_Object Vx_max_tooltip_size
;
10550 unwind_create_tip_frame (frame
)
10553 Lisp_Object deleted
;
10555 deleted
= unwind_create_frame (frame
);
10556 if (EQ (deleted
, Qt
))
10566 /* Create a frame for a tooltip on the display described by DPYINFO.
10567 PARMS is a list of frame parameters. TEXT is the string to
10568 display in the tip frame. Value is the frame.
10570 Note that functions called here, esp. x_default_parameter can
10571 signal errors, for instance when a specified color name is
10572 undefined. We have to make sure that we're in a consistent state
10573 when this happens. */
10576 x_create_tip_frame (dpyinfo
, parms
, text
)
10577 struct x_display_info
*dpyinfo
;
10578 Lisp_Object parms
, text
;
10581 Lisp_Object frame
, tem
;
10583 long window_prompting
= 0;
10585 int count
= BINDING_STACK_SIZE ();
10586 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10588 int face_change_count_before
= face_change_count
;
10589 Lisp_Object buffer
;
10590 struct buffer
*old_buffer
;
10594 /* Use this general default value to start with until we know if
10595 this frame has a specified name. */
10596 Vx_resource_name
= Vinvocation_name
;
10598 #ifdef MULTI_KBOARD
10599 kb
= dpyinfo
->kboard
;
10601 kb
= &the_only_kboard
;
10604 /* Get the name of the frame to use for resource lookup. */
10605 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10606 if (!STRINGP (name
)
10607 && !EQ (name
, Qunbound
)
10609 error ("Invalid frame name--not a string or nil");
10610 Vx_resource_name
= name
;
10613 GCPRO3 (parms
, name
, frame
);
10614 f
= make_frame (1);
10615 XSETFRAME (frame
, f
);
10617 buffer
= Fget_buffer_create (build_string (" *tip*"));
10618 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10619 old_buffer
= current_buffer
;
10620 set_buffer_internal_1 (XBUFFER (buffer
));
10621 current_buffer
->truncate_lines
= Qnil
;
10623 Finsert (1, &text
);
10624 set_buffer_internal_1 (old_buffer
);
10626 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10627 record_unwind_protect (unwind_create_tip_frame
, frame
);
10629 /* By setting the output method, we're essentially saying that
10630 the frame is live, as per FRAME_LIVE_P. If we get a signal
10631 from this point on, x_destroy_window might screw up reference
10633 f
->output_method
= output_x_window
;
10634 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10635 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10636 f
->output_data
.x
->icon_bitmap
= -1;
10637 f
->output_data
.x
->fontset
= -1;
10638 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
10639 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
10640 #ifdef USE_TOOLKIT_SCROLL_BARS
10641 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
10642 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
10643 #endif /* USE_TOOLKIT_SCROLL_BARS */
10644 f
->icon_name
= Qnil
;
10645 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10647 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
10648 dpyinfo_refcount
= dpyinfo
->reference_count
;
10649 #endif /* GLYPH_DEBUG */
10650 #ifdef MULTI_KBOARD
10651 FRAME_KBOARD (f
) = kb
;
10653 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10654 f
->output_data
.x
->explicit_parent
= 0;
10656 /* These colors will be set anyway later, but it's important
10657 to get the color reference counts right, so initialize them! */
10660 struct gcpro gcpro1
;
10662 black
= build_string ("black");
10664 f
->output_data
.x
->foreground_pixel
10665 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10666 f
->output_data
.x
->background_pixel
10667 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10668 f
->output_data
.x
->cursor_pixel
10669 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10670 f
->output_data
.x
->cursor_foreground_pixel
10671 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10672 f
->output_data
.x
->border_pixel
10673 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10674 f
->output_data
.x
->mouse_pixel
10675 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10679 /* Set the name; the functions to which we pass f expect the name to
10681 if (EQ (name
, Qunbound
) || NILP (name
))
10683 f
->name
= build_string (dpyinfo
->x_id_name
);
10684 f
->explicit_name
= 0;
10689 f
->explicit_name
= 1;
10690 /* use the frame's title when getting resources for this frame. */
10691 specbind (Qx_resource_name
, name
);
10694 /* Extract the window parameters from the supplied values that are
10695 needed to determine window geometry. */
10699 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10702 /* First, try whatever font the caller has specified. */
10703 if (STRINGP (font
))
10705 tem
= Fquery_fontset (font
, Qnil
);
10707 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10709 font
= x_new_font (f
, XSTRING (font
)->data
);
10712 /* Try out a font which we hope has bold and italic variations. */
10713 if (!STRINGP (font
))
10714 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10715 if (!STRINGP (font
))
10716 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10717 if (! STRINGP (font
))
10718 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10719 if (! STRINGP (font
))
10720 /* This was formerly the first thing tried, but it finds too many fonts
10721 and takes too long. */
10722 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10723 /* If those didn't work, look for something which will at least work. */
10724 if (! STRINGP (font
))
10725 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10727 if (! STRINGP (font
))
10728 font
= build_string ("fixed");
10730 x_default_parameter (f
, parms
, Qfont
, font
,
10731 "font", "Font", RES_TYPE_STRING
);
10734 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10735 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10737 /* This defaults to 2 in order to match xterm. We recognize either
10738 internalBorderWidth or internalBorder (which is what xterm calls
10740 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10744 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10745 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10746 if (! EQ (value
, Qunbound
))
10747 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10751 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10752 "internalBorderWidth", "internalBorderWidth",
10755 /* Also do the stuff which must be set before the window exists. */
10756 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10757 "foreground", "Foreground", RES_TYPE_STRING
);
10758 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10759 "background", "Background", RES_TYPE_STRING
);
10760 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10761 "pointerColor", "Foreground", RES_TYPE_STRING
);
10762 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10763 "cursorColor", "Foreground", RES_TYPE_STRING
);
10764 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10765 "borderColor", "BorderColor", RES_TYPE_STRING
);
10767 /* Init faces before x_default_parameter is called for scroll-bar
10768 parameters because that function calls x_set_scroll_bar_width,
10769 which calls change_frame_size, which calls Fset_window_buffer,
10770 which runs hooks, which call Fvertical_motion. At the end, we
10771 end up in init_iterator with a null face cache, which should not
10773 init_frame_faces (f
);
10775 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10776 window_prompting
= x_figure_window_size (f
, parms
);
10778 if (window_prompting
& XNegative
)
10780 if (window_prompting
& YNegative
)
10781 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10783 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10787 if (window_prompting
& YNegative
)
10788 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10790 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10793 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10795 XSetWindowAttributes attrs
;
10796 unsigned long mask
;
10799 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
10800 if (DoesSaveUnders (dpyinfo
->screen
))
10801 mask
|= CWSaveUnder
;
10803 /* Window managers look at the override-redirect flag to determine
10804 whether or net to give windows a decoration (Xlib spec, chapter
10806 attrs
.override_redirect
= True
;
10807 attrs
.save_under
= True
;
10808 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10809 /* Arrange for getting MapNotify and UnmapNotify events. */
10810 attrs
.event_mask
= StructureNotifyMask
;
10812 = FRAME_X_WINDOW (f
)
10813 = XCreateWindow (FRAME_X_DISPLAY (f
),
10814 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10815 /* x, y, width, height */
10819 CopyFromParent
, InputOutput
, CopyFromParent
,
10826 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10827 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10828 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10829 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10830 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10831 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10833 /* Dimensions, especially f->height, must be done via change_frame_size.
10834 Change will not be effected unless different from the current
10837 height
= f
->height
;
10839 SET_FRAME_WIDTH (f
, 0);
10840 change_frame_size (f
, height
, width
, 1, 0, 0);
10842 /* Set up faces after all frame parameters are known. This call
10843 also merges in face attributes specified for new frames.
10845 Frame parameters may be changed if .Xdefaults contains
10846 specifications for the default font. For example, if there is an
10847 `Emacs.default.attributeBackground: pink', the `background-color'
10848 attribute of the frame get's set, which let's the internal border
10849 of the tooltip frame appear in pink. Prevent this. */
10851 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
10853 /* Set tip_frame here, so that */
10855 call1 (Qface_set_after_frame_default
, frame
);
10857 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
10858 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
10866 /* It is now ok to make the frame official even if we get an error
10867 below. And the frame needs to be on Vframe_list or making it
10868 visible won't work. */
10869 Vframe_list
= Fcons (frame
, Vframe_list
);
10871 /* Now that the frame is official, it counts as a reference to
10873 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
10875 /* Setting attributes of faces of the tooltip frame from resources
10876 and similar will increment face_change_count, which leads to the
10877 clearing of all current matrices. Since this isn't necessary
10878 here, avoid it by resetting face_change_count to the value it
10879 had before we created the tip frame. */
10880 face_change_count
= face_change_count_before
;
10882 /* Discard the unwind_protect. */
10883 return unbind_to (count
, frame
);
10887 /* Compute where to display tip frame F. PARMS is the list of frame
10888 parameters for F. DX and DY are specified offsets from the current
10889 location of the mouse. WIDTH and HEIGHT are the width and height
10890 of the tooltip. Return coordinates relative to the root window of
10891 the display in *ROOT_X, and *ROOT_Y. */
10894 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
10896 Lisp_Object parms
, dx
, dy
;
10898 int *root_x
, *root_y
;
10900 Lisp_Object left
, top
;
10902 Window root
, child
;
10905 /* User-specified position? */
10906 left
= Fcdr (Fassq (Qleft
, parms
));
10907 top
= Fcdr (Fassq (Qtop
, parms
));
10909 /* Move the tooltip window where the mouse pointer is. Resize and
10911 if (!INTEGERP (left
) && !INTEGERP (top
))
10914 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
10915 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
10919 if (INTEGERP (top
))
10920 *root_y
= XINT (top
);
10921 else if (*root_y
+ XINT (dy
) - height
< 0)
10922 *root_y
-= XINT (dy
);
10926 *root_y
+= XINT (dy
);
10929 if (INTEGERP (left
))
10930 *root_x
= XINT (left
);
10931 else if (*root_x
+ XINT (dx
) + width
> FRAME_X_DISPLAY_INFO (f
)->width
)
10932 *root_x
-= width
+ XINT (dx
);
10934 *root_x
+= XINT (dx
);
10938 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
10939 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
10940 A tooltip window is a small X window displaying a string.\n\
10942 FRAME nil or omitted means use the selected frame.\n\
10944 PARMS is an optional list of frame parameters which can be\n\
10945 used to change the tooltip's appearance.\n\
10947 Automatically hide the tooltip after TIMEOUT seconds.\n\
10948 TIMEOUT nil means use the default timeout of 5 seconds.\n\
10950 If the list of frame parameters PARAMS contains a `left' parameters,\n\
10951 the tooltip is displayed at that x-position. Otherwise it is\n\
10952 displayed at the mouse position, with offset DX added (default is 5 if\n\
10953 DX isn't specified). Likewise for the y-position; if a `top' frame\n\
10954 parameter is specified, it determines the y-position of the tooltip\n\
10955 window, otherwise it is displayed at the mouse position, with offset\n\
10956 DY added (default is -10).\n\
10958 A tooltip's maximum size is specified by `x-max-tooltip-size'.\n\
10959 Text larger than the specified size is clipped.")
10960 (string
, frame
, parms
, timeout
, dx
, dy
)
10961 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
10965 Lisp_Object buffer
, top
, left
, max_width
, max_height
;
10966 int root_x
, root_y
;
10967 struct buffer
*old_buffer
;
10968 struct text_pos pos
;
10969 int i
, width
, height
;
10970 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
10971 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
10972 int count
= BINDING_STACK_SIZE ();
10974 specbind (Qinhibit_redisplay
, Qt
);
10976 GCPRO4 (string
, parms
, frame
, timeout
);
10978 CHECK_STRING (string
, 0);
10979 f
= check_x_frame (frame
);
10980 if (NILP (timeout
))
10981 timeout
= make_number (5);
10983 CHECK_NATNUM (timeout
, 2);
10986 dx
= make_number (5);
10988 CHECK_NUMBER (dx
, 5);
10991 dy
= make_number (-10);
10993 CHECK_NUMBER (dy
, 6);
10995 if (NILP (last_show_tip_args
))
10996 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
10998 if (!NILP (tip_frame
))
11000 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
11001 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
11002 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
11004 if (EQ (frame
, last_frame
)
11005 && !NILP (Fequal (last_string
, string
))
11006 && !NILP (Fequal (last_parms
, parms
)))
11008 struct frame
*f
= XFRAME (tip_frame
);
11010 /* Only DX and DY have changed. */
11011 if (!NILP (tip_timer
))
11013 Lisp_Object timer
= tip_timer
;
11015 call1 (Qcancel_timer
, timer
);
11019 compute_tip_xy (f
, parms
, dx
, dy
, PIXEL_WIDTH (f
),
11020 PIXEL_HEIGHT (f
), &root_x
, &root_y
);
11021 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11028 /* Hide a previous tip, if any. */
11031 ASET (last_show_tip_args
, 0, string
);
11032 ASET (last_show_tip_args
, 1, frame
);
11033 ASET (last_show_tip_args
, 2, parms
);
11035 /* Add default values to frame parameters. */
11036 if (NILP (Fassq (Qname
, parms
)))
11037 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
11038 if (NILP (Fassq (Qinternal_border_width
, parms
)))
11039 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
11040 if (NILP (Fassq (Qborder_width
, parms
)))
11041 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
11042 if (NILP (Fassq (Qborder_color
, parms
)))
11043 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
11044 if (NILP (Fassq (Qbackground_color
, parms
)))
11045 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
11048 /* Create a frame for the tooltip, and record it in the global
11049 variable tip_frame. */
11050 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
, string
);
11051 f
= XFRAME (frame
);
11053 /* Set up the frame's root window. */
11054 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
11055 w
->left
= w
->top
= make_number (0);
11057 if (CONSP (Vx_max_tooltip_size
)
11058 && INTEGERP (XCAR (Vx_max_tooltip_size
))
11059 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
11060 && INTEGERP (XCDR (Vx_max_tooltip_size
))
11061 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
11063 w
->width
= XCAR (Vx_max_tooltip_size
);
11064 w
->height
= XCDR (Vx_max_tooltip_size
);
11068 w
->width
= make_number (80);
11069 w
->height
= make_number (40);
11072 f
->window_width
= XINT (w
->width
);
11074 w
->pseudo_window_p
= 1;
11076 /* Display the tooltip text in a temporary buffer. */
11077 old_buffer
= current_buffer
;
11078 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
11079 current_buffer
->truncate_lines
= Qnil
;
11080 clear_glyph_matrix (w
->desired_matrix
);
11081 clear_glyph_matrix (w
->current_matrix
);
11082 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
11083 try_window (FRAME_ROOT_WINDOW (f
), pos
);
11085 /* Compute width and height of the tooltip. */
11086 width
= height
= 0;
11087 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
11089 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
11090 struct glyph
*last
;
11093 /* Stop at the first empty row at the end. */
11094 if (!row
->enabled_p
|| !row
->displays_text_p
)
11097 /* Let the row go over the full width of the frame. */
11098 row
->full_width_p
= 1;
11100 /* There's a glyph at the end of rows that is used to place
11101 the cursor there. Don't include the width of this glyph. */
11102 if (row
->used
[TEXT_AREA
])
11104 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
11105 row_width
= row
->pixel_width
- last
->pixel_width
;
11108 row_width
= row
->pixel_width
;
11110 height
+= row
->height
;
11111 width
= max (width
, row_width
);
11114 /* Add the frame's internal border to the width and height the X
11115 window should have. */
11116 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11117 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11119 /* Move the tooltip window where the mouse pointer is. Resize and
11121 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
11124 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11125 root_x
, root_y
, width
, height
);
11126 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
11129 /* Draw into the window. */
11130 w
->must_be_updated_p
= 1;
11131 update_single_window (w
, 1);
11133 /* Restore original current buffer. */
11134 set_buffer_internal_1 (old_buffer
);
11135 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
11138 /* Let the tip disappear after timeout seconds. */
11139 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
11140 intern ("x-hide-tip"));
11143 return unbind_to (count
, Qnil
);
11147 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
11148 "Hide the current tooltip window, if there is any.\n\
11149 Value is t if tooltip was open, nil otherwise.")
11153 Lisp_Object deleted
, frame
, timer
;
11154 struct gcpro gcpro1
, gcpro2
;
11156 /* Return quickly if nothing to do. */
11157 if (NILP (tip_timer
) && NILP (tip_frame
))
11162 GCPRO2 (frame
, timer
);
11163 tip_frame
= tip_timer
= deleted
= Qnil
;
11165 count
= BINDING_STACK_SIZE ();
11166 specbind (Qinhibit_redisplay
, Qt
);
11167 specbind (Qinhibit_quit
, Qt
);
11170 call1 (Qcancel_timer
, timer
);
11172 if (FRAMEP (frame
))
11174 Fdelete_frame (frame
, Qnil
);
11178 /* Bloodcurdling hack alert: The Lucid menu bar widget's
11179 redisplay procedure is not called when a tip frame over menu
11180 items is unmapped. Redisplay the menu manually... */
11182 struct frame
*f
= SELECTED_FRAME ();
11183 Widget w
= f
->output_data
.x
->menubar_widget
;
11184 extern void xlwmenu_redisplay
P_ ((Widget
));
11186 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f
)->screen
)
11190 xlwmenu_redisplay (w
);
11194 #endif /* USE_LUCID */
11198 return unbind_to (count
, deleted
);
11203 /***********************************************************************
11204 File selection dialog
11205 ***********************************************************************/
11209 /* Callback for "OK" and "Cancel" on file selection dialog. */
11212 file_dialog_cb (widget
, client_data
, call_data
)
11214 XtPointer call_data
, client_data
;
11216 int *result
= (int *) client_data
;
11217 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
11218 *result
= cb
->reason
;
11222 /* Callback for unmapping a file selection dialog. This is used to
11223 capture the case where a dialog is closed via a window manager's
11224 closer button, for example. Using a XmNdestroyCallback didn't work
11228 file_dialog_unmap_cb (widget
, client_data
, call_data
)
11230 XtPointer call_data
, client_data
;
11232 int *result
= (int *) client_data
;
11233 *result
= XmCR_CANCEL
;
11237 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
11238 "Read file name, prompting with PROMPT in directory DIR.\n\
11239 Use a file selection dialog.\n\
11240 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
11241 specified. Don't let the user enter a file name in the file\n\
11242 selection dialog's entry field, if MUSTMATCH is non-nil.")
11243 (prompt
, dir
, default_filename
, mustmatch
)
11244 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
11247 struct frame
*f
= SELECTED_FRAME ();
11248 Lisp_Object file
= Qnil
;
11249 Widget dialog
, text
, list
, help
;
11252 extern XtAppContext Xt_app_con
;
11253 XmString dir_xmstring
, pattern_xmstring
;
11254 int count
= specpdl_ptr
- specpdl
;
11255 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11257 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11258 CHECK_STRING (prompt
, 0);
11259 CHECK_STRING (dir
, 1);
11261 /* Prevent redisplay. */
11262 specbind (Qinhibit_redisplay
, Qt
);
11266 /* Create the dialog with PROMPT as title, using DIR as initial
11267 directory and using "*" as pattern. */
11268 dir
= Fexpand_file_name (dir
, Qnil
);
11269 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
11270 pattern_xmstring
= XmStringCreateLocalized ("*");
11272 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
11273 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
11274 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
11275 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
11276 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
11277 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
11279 XmStringFree (dir_xmstring
);
11280 XmStringFree (pattern_xmstring
);
11282 /* Add callbacks for OK and Cancel. */
11283 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
11284 (XtPointer
) &result
);
11285 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
11286 (XtPointer
) &result
);
11287 XtAddCallback (dialog
, XmNunmapCallback
, file_dialog_unmap_cb
,
11288 (XtPointer
) &result
);
11290 /* Disable the help button since we can't display help. */
11291 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
11292 XtSetSensitive (help
, False
);
11294 /* Mark OK button as default. */
11295 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
11296 XmNshowAsDefault
, True
, NULL
);
11298 /* If MUSTMATCH is non-nil, disable the file entry field of the
11299 dialog, so that the user must select a file from the files list
11300 box. We can't remove it because we wouldn't have a way to get at
11301 the result file name, then. */
11302 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
11303 if (!NILP (mustmatch
))
11306 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
11307 XtSetSensitive (text
, False
);
11308 XtSetSensitive (label
, False
);
11311 /* Manage the dialog, so that list boxes get filled. */
11312 XtManageChild (dialog
);
11314 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11315 must include the path for this to work. */
11316 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
11317 if (STRINGP (default_filename
))
11319 XmString default_xmstring
;
11323 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
11325 if (!XmListItemExists (list
, default_xmstring
))
11327 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11328 XmListAddItem (list
, default_xmstring
, 0);
11332 item_pos
= XmListItemPos (list
, default_xmstring
);
11333 XmStringFree (default_xmstring
);
11335 /* Select the item and scroll it into view. */
11336 XmListSelectPos (list
, item_pos
, True
);
11337 XmListSetPos (list
, item_pos
);
11340 /* Process events until the user presses Cancel or OK. Block
11341 and unblock input here so that we get a chance of processing
11345 while (result
== 0)
11348 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
11353 /* Get the result. */
11354 if (result
== XmCR_OK
)
11359 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
11360 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
11361 XmStringFree (text
);
11362 file
= build_string (data
);
11369 XtUnmanageChild (dialog
);
11370 XtDestroyWidget (dialog
);
11374 /* Make "Cancel" equivalent to C-g. */
11376 Fsignal (Qquit
, Qnil
);
11378 return unbind_to (count
, file
);
11381 #endif /* USE_MOTIF */
11385 /***********************************************************************
11387 ***********************************************************************/
11389 #ifdef HAVE_XKBGETKEYBOARD
11390 #include <X11/XKBlib.h>
11391 #include <X11/keysym.h>
11394 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p
,
11395 Sx_backspace_delete_keys_p
, 0, 1, 0,
11396 "Check if both Backspace and Delete keys are on the keyboard of FRAME.\n\
11397 FRAME nil means use the selected frame.\n\
11398 Value is t if we know that both keys are present, and are mapped to the\n\
11403 #ifdef HAVE_XKBGETKEYBOARD
11405 struct frame
*f
= check_x_frame (frame
);
11406 Display
*dpy
= FRAME_X_DISPLAY (f
);
11407 Lisp_Object have_keys
;
11408 int major
, minor
, op
, event
, error
;
11412 /* Check library version in case we're dynamically linked. */
11413 major
= XkbMajorVersion
;
11414 minor
= XkbMinorVersion
;
11415 if (!XkbLibraryVersion (&major
, &minor
))
11421 /* Check that the server supports XKB. */
11422 major
= XkbMajorVersion
;
11423 minor
= XkbMinorVersion
;
11424 if (!XkbQueryExtension (dpy
, &op
, &event
, &error
, &major
, &minor
))
11431 kb
= XkbGetMap (dpy
, XkbAllMapComponentsMask
, XkbUseCoreKbd
);
11434 int delete_keycode
= 0, backspace_keycode
= 0, i
;
11436 if (XkbGetNames (dpy
, XkbAllNamesMask
, kb
) == Success
)
11438 for (i
= kb
->min_key_code
;
11439 (i
< kb
->max_key_code
11440 && (delete_keycode
== 0 || backspace_keycode
== 0));
11443 /* The XKB symbolic key names can be seen most easily in
11444 the PS file generated by `xkbprint -label name
11446 if (bcmp ("DELE", kb
->names
->keys
[i
].name
, 4) == 0)
11447 delete_keycode
= i
;
11448 else if (bcmp ("BKSP", kb
->names
->keys
[i
].name
, 4) == 0)
11449 backspace_keycode
= i
;
11452 XkbFreeNames (kb
, 0, True
);
11455 XkbFreeClientMap (kb
, 0, True
);
11458 && backspace_keycode
11459 && XKeysymToKeycode (dpy
, XK_Delete
) == delete_keycode
11460 && XKeysymToKeycode (dpy
, XK_BackSpace
) == backspace_keycode
)
11465 #else /* not HAVE_XKBGETKEYBOARD */
11467 #endif /* not HAVE_XKBGETKEYBOARD */
11472 /***********************************************************************
11474 ***********************************************************************/
11479 /* This is zero if not using X windows. */
11482 /* The section below is built by the lisp expression at the top of the file,
11483 just above where these variables are declared. */
11484 /*&&& init symbols here &&&*/
11485 Qauto_raise
= intern ("auto-raise");
11486 staticpro (&Qauto_raise
);
11487 Qauto_lower
= intern ("auto-lower");
11488 staticpro (&Qauto_lower
);
11489 Qbar
= intern ("bar");
11491 Qborder_color
= intern ("border-color");
11492 staticpro (&Qborder_color
);
11493 Qborder_width
= intern ("border-width");
11494 staticpro (&Qborder_width
);
11495 Qbox
= intern ("box");
11497 Qcursor_color
= intern ("cursor-color");
11498 staticpro (&Qcursor_color
);
11499 Qcursor_type
= intern ("cursor-type");
11500 staticpro (&Qcursor_type
);
11501 Qgeometry
= intern ("geometry");
11502 staticpro (&Qgeometry
);
11503 Qicon_left
= intern ("icon-left");
11504 staticpro (&Qicon_left
);
11505 Qicon_top
= intern ("icon-top");
11506 staticpro (&Qicon_top
);
11507 Qicon_type
= intern ("icon-type");
11508 staticpro (&Qicon_type
);
11509 Qicon_name
= intern ("icon-name");
11510 staticpro (&Qicon_name
);
11511 Qinternal_border_width
= intern ("internal-border-width");
11512 staticpro (&Qinternal_border_width
);
11513 Qleft
= intern ("left");
11514 staticpro (&Qleft
);
11515 Qright
= intern ("right");
11516 staticpro (&Qright
);
11517 Qmouse_color
= intern ("mouse-color");
11518 staticpro (&Qmouse_color
);
11519 Qnone
= intern ("none");
11520 staticpro (&Qnone
);
11521 Qparent_id
= intern ("parent-id");
11522 staticpro (&Qparent_id
);
11523 Qscroll_bar_width
= intern ("scroll-bar-width");
11524 staticpro (&Qscroll_bar_width
);
11525 Qsuppress_icon
= intern ("suppress-icon");
11526 staticpro (&Qsuppress_icon
);
11527 Qundefined_color
= intern ("undefined-color");
11528 staticpro (&Qundefined_color
);
11529 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
11530 staticpro (&Qvertical_scroll_bars
);
11531 Qvisibility
= intern ("visibility");
11532 staticpro (&Qvisibility
);
11533 Qwindow_id
= intern ("window-id");
11534 staticpro (&Qwindow_id
);
11535 Qouter_window_id
= intern ("outer-window-id");
11536 staticpro (&Qouter_window_id
);
11537 Qx_frame_parameter
= intern ("x-frame-parameter");
11538 staticpro (&Qx_frame_parameter
);
11539 Qx_resource_name
= intern ("x-resource-name");
11540 staticpro (&Qx_resource_name
);
11541 Quser_position
= intern ("user-position");
11542 staticpro (&Quser_position
);
11543 Quser_size
= intern ("user-size");
11544 staticpro (&Quser_size
);
11545 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
11546 staticpro (&Qscroll_bar_foreground
);
11547 Qscroll_bar_background
= intern ("scroll-bar-background");
11548 staticpro (&Qscroll_bar_background
);
11549 Qscreen_gamma
= intern ("screen-gamma");
11550 staticpro (&Qscreen_gamma
);
11551 Qline_spacing
= intern ("line-spacing");
11552 staticpro (&Qline_spacing
);
11553 Qcenter
= intern ("center");
11554 staticpro (&Qcenter
);
11555 Qcompound_text
= intern ("compound-text");
11556 staticpro (&Qcompound_text
);
11557 Qcancel_timer
= intern ("cancel-timer");
11558 staticpro (&Qcancel_timer
);
11559 Qwait_for_wm
= intern ("wait-for-wm");
11560 staticpro (&Qwait_for_wm
);
11561 /* This is the end of symbol initialization. */
11563 /* Text property `display' should be nonsticky by default. */
11564 Vtext_property_default_nonsticky
11565 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
11568 Qlaplace
= intern ("laplace");
11569 staticpro (&Qlaplace
);
11570 Qemboss
= intern ("emboss");
11571 staticpro (&Qemboss
);
11572 Qedge_detection
= intern ("edge-detection");
11573 staticpro (&Qedge_detection
);
11574 Qheuristic
= intern ("heuristic");
11575 staticpro (&Qheuristic
);
11576 QCmatrix
= intern (":matrix");
11577 staticpro (&QCmatrix
);
11578 QCcolor_adjustment
= intern (":color-adjustment");
11579 staticpro (&QCcolor_adjustment
);
11580 QCmask
= intern (":mask");
11581 staticpro (&QCmask
);
11583 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
11584 staticpro (&Qface_set_after_frame_default
);
11586 Fput (Qundefined_color
, Qerror_conditions
,
11587 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
11588 Fput (Qundefined_color
, Qerror_message
,
11589 build_string ("Undefined color"));
11591 init_x_parm_symbols ();
11593 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
11594 "Non-nil means always draw a cross over disabled images.\n\
11595 Disabled images are those having an `:conversion disabled' property.\n\
11596 A cross is always drawn on black & white displays.");
11597 cross_disabled_images
= 0;
11599 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
11600 "List of directories to search for bitmap files for X.");
11601 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
11603 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
11604 "The shape of the pointer when over text.\n\
11605 Changing the value does not affect existing frames\n\
11606 unless you set the mouse color.");
11607 Vx_pointer_shape
= Qnil
;
11609 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
11610 "The name Emacs uses to look up X resources.\n\
11611 `x-get-resource' uses this as the first component of the instance name\n\
11612 when requesting resource values.\n\
11613 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
11614 was invoked, or to the value specified with the `-name' or `-rn'\n\
11615 switches, if present.\n\
11617 It may be useful to bind this variable locally around a call\n\
11618 to `x-get-resource'. See also the variable `x-resource-class'.");
11619 Vx_resource_name
= Qnil
;
11621 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
11622 "The class Emacs uses to look up X resources.\n\
11623 `x-get-resource' uses this as the first component of the instance class\n\
11624 when requesting resource values.\n\
11625 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
11627 Setting this variable permanently is not a reasonable thing to do,\n\
11628 but binding this variable locally around a call to `x-get-resource'\n\
11629 is a reasonable practice. See also the variable `x-resource-name'.");
11630 Vx_resource_class
= build_string (EMACS_CLASS
);
11632 #if 0 /* This doesn't really do anything. */
11633 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
11634 "The shape of the pointer when not over text.\n\
11635 This variable takes effect when you create a new frame\n\
11636 or when you set the mouse color.");
11638 Vx_nontext_pointer_shape
= Qnil
;
11640 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
11641 "The shape of the pointer when Emacs is busy.\n\
11642 This variable takes effect when you create a new frame\n\
11643 or when you set the mouse color.");
11644 Vx_hourglass_pointer_shape
= Qnil
;
11646 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
11647 "Non-zero means Emacs displays an hourglass pointer on window systems.");
11648 display_hourglass_p
= 1;
11650 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
11651 "*Seconds to wait before displaying an hourglass pointer.\n\
11652 Value must be an integer or float.");
11653 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
11655 #if 0 /* This doesn't really do anything. */
11656 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
11657 "The shape of the pointer when over the mode line.\n\
11658 This variable takes effect when you create a new frame\n\
11659 or when you set the mouse color.");
11661 Vx_mode_pointer_shape
= Qnil
;
11663 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11664 &Vx_sensitive_text_pointer_shape
,
11665 "The shape of the pointer when over mouse-sensitive text.\n\
11666 This variable takes effect when you create a new frame\n\
11667 or when you set the mouse color.");
11668 Vx_sensitive_text_pointer_shape
= Qnil
;
11670 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
11671 &Vx_window_horizontal_drag_shape
,
11672 "Pointer shape to use for indicating a window can be dragged horizontally.\n\
11673 This variable takes effect when you create a new frame\n\
11674 or when you set the mouse color.");
11675 Vx_window_horizontal_drag_shape
= Qnil
;
11677 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
11678 "A string indicating the foreground color of the cursor box.");
11679 Vx_cursor_fore_pixel
= Qnil
;
11681 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
11682 "Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).\n\
11683 Text larger than this is clipped.");
11684 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
11686 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
11687 "Non-nil if no X window manager is in use.\n\
11688 Emacs doesn't try to figure this out; this is always nil\n\
11689 unless you set it to something else.");
11690 /* We don't have any way to find this out, so set it to nil
11691 and maybe the user would like to set it to t. */
11692 Vx_no_window_manager
= Qnil
;
11694 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11695 &Vx_pixel_size_width_font_regexp
,
11696 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
11698 Since Emacs gets width of a font matching with this regexp from\n\
11699 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
11700 such a font. This is especially effective for such large fonts as\n\
11701 Chinese, Japanese, and Korean.");
11702 Vx_pixel_size_width_font_regexp
= Qnil
;
11704 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
11705 "Time after which cached images are removed from the cache.\n\
11706 When an image has not been displayed this many seconds, remove it\n\
11707 from the image cache. Value must be an integer or nil with nil\n\
11708 meaning don't clear the cache.");
11709 Vimage_cache_eviction_delay
= make_number (30 * 60);
11711 #ifdef USE_X_TOOLKIT
11712 Fprovide (intern ("x-toolkit"), Qnil
);
11714 Fprovide (intern ("motif"), Qnil
);
11716 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string
,
11717 "Version info for LessTif/Motif.");
11718 Vmotif_version_string
= build_string (XmVERSION_STRING
);
11719 #endif /* USE_MOTIF */
11720 #endif /* USE_X_TOOLKIT */
11722 defsubr (&Sx_get_resource
);
11724 /* X window properties. */
11725 defsubr (&Sx_change_window_property
);
11726 defsubr (&Sx_delete_window_property
);
11727 defsubr (&Sx_window_property
);
11729 defsubr (&Sxw_display_color_p
);
11730 defsubr (&Sx_display_grayscale_p
);
11731 defsubr (&Sxw_color_defined_p
);
11732 defsubr (&Sxw_color_values
);
11733 defsubr (&Sx_server_max_request_size
);
11734 defsubr (&Sx_server_vendor
);
11735 defsubr (&Sx_server_version
);
11736 defsubr (&Sx_display_pixel_width
);
11737 defsubr (&Sx_display_pixel_height
);
11738 defsubr (&Sx_display_mm_width
);
11739 defsubr (&Sx_display_mm_height
);
11740 defsubr (&Sx_display_screens
);
11741 defsubr (&Sx_display_planes
);
11742 defsubr (&Sx_display_color_cells
);
11743 defsubr (&Sx_display_visual_class
);
11744 defsubr (&Sx_display_backing_store
);
11745 defsubr (&Sx_display_save_under
);
11746 defsubr (&Sx_parse_geometry
);
11747 defsubr (&Sx_create_frame
);
11748 defsubr (&Sx_open_connection
);
11749 defsubr (&Sx_close_connection
);
11750 defsubr (&Sx_display_list
);
11751 defsubr (&Sx_synchronize
);
11752 defsubr (&Sx_focus_frame
);
11753 defsubr (&Sx_backspace_delete_keys_p
);
11755 /* Setting callback functions for fontset handler. */
11756 get_font_info_func
= x_get_font_info
;
11758 #if 0 /* This function pointer doesn't seem to be used anywhere.
11759 And the pointer assigned has the wrong type, anyway. */
11760 list_fonts_func
= x_list_fonts
;
11763 load_font_func
= x_load_font
;
11764 find_ccl_program_func
= x_find_ccl_program
;
11765 query_font_func
= x_query_font
;
11766 set_frame_fontset_func
= x_set_font
;
11767 check_window_system_func
= check_x
;
11770 Qxbm
= intern ("xbm");
11772 QCtype
= intern (":type");
11773 staticpro (&QCtype
);
11774 QCconversion
= intern (":conversion");
11775 staticpro (&QCconversion
);
11776 QCheuristic_mask
= intern (":heuristic-mask");
11777 staticpro (&QCheuristic_mask
);
11778 QCcolor_symbols
= intern (":color-symbols");
11779 staticpro (&QCcolor_symbols
);
11780 QCascent
= intern (":ascent");
11781 staticpro (&QCascent
);
11782 QCmargin
= intern (":margin");
11783 staticpro (&QCmargin
);
11784 QCrelief
= intern (":relief");
11785 staticpro (&QCrelief
);
11786 Qpostscript
= intern ("postscript");
11787 staticpro (&Qpostscript
);
11788 QCloader
= intern (":loader");
11789 staticpro (&QCloader
);
11790 QCbounding_box
= intern (":bounding-box");
11791 staticpro (&QCbounding_box
);
11792 QCpt_width
= intern (":pt-width");
11793 staticpro (&QCpt_width
);
11794 QCpt_height
= intern (":pt-height");
11795 staticpro (&QCpt_height
);
11796 QCindex
= intern (":index");
11797 staticpro (&QCindex
);
11798 Qpbm
= intern ("pbm");
11802 Qxpm
= intern ("xpm");
11807 Qjpeg
= intern ("jpeg");
11808 staticpro (&Qjpeg
);
11812 Qtiff
= intern ("tiff");
11813 staticpro (&Qtiff
);
11817 Qgif
= intern ("gif");
11822 Qpng
= intern ("png");
11826 defsubr (&Sclear_image_cache
);
11827 defsubr (&Simage_size
);
11828 defsubr (&Simage_mask_p
);
11830 hourglass_atimer
= NULL
;
11831 hourglass_shown_p
= 0;
11833 defsubr (&Sx_show_tip
);
11834 defsubr (&Sx_hide_tip
);
11836 staticpro (&tip_timer
);
11838 staticpro (&tip_frame
);
11840 last_show_tip_args
= Qnil
;
11841 staticpro (&last_show_tip_args
);
11844 defsubr (&Sx_file_dialog
);
11852 image_types
= NULL
;
11853 Vimage_types
= Qnil
;
11855 define_image_type (&xbm_type
);
11856 define_image_type (&gs_type
);
11857 define_image_type (&pbm_type
);
11860 define_image_type (&xpm_type
);
11864 define_image_type (&jpeg_type
);
11868 define_image_type (&tiff_type
);
11872 define_image_type (&gif_type
);
11876 define_image_type (&png_type
);
11880 #endif /* HAVE_X_WINDOWS */